Comparative C64 ROM Disassembly Study Guide

revision 8a58c2b

By Michael Steil. See github.com/mist64/c64rom for information on how this was created and how to contribute.


Disassembly Microsoft BASIC for 6502 Original Source 64 intern (Data Becker) Lee Davison Bob Sander-Cederlof (Apple II)
.:A000 94 E3
Start-Vektor $E394
BASIC cold start entry point

.:A002 7B E3
NMI-Vektor $E37B

BASIC warm start entry point



.:A004 43 42 4D 42 41 53 49 43
PAGE

DISPATCH TABLES, RESERVED WORDS, AND ERROR TEXTS.


        ORG     ROMLOC

'cbmbasic'

Adressen der BASIC-Befehle -1

(Interpreterkode Adresse Befehl)

'cbmbasic', ROM name, unreferenced

action addresses for primary commands

these are called by pushing the address onto the stack and doing an RTS so the
actual address -1 needs to be pushed
'cbmbasic'

BRANCH TABLE FOR TOKENS

.:A00C 30 A8 STMDSP: ADR(END-1)
$80 $A831 END
perform END $80
$80 $A831 END
.:A00E 41 A7         ADR(FOR-1)
$81 $A742 FOR
perform FOR $81
$81 $A742 FOR
.:A010 1D AD         ADR(NEXT-1)
$82 $AD1E NEXT
perform NEXT $82
$82 $AD1E NEXT
.:A012 F7 A8         ADR(DATA-1)
IFN     EXTIO,<
$83 $A8F8 DATA
perform DATA $83
$83 $A8F8 DATA
.:A014 A4 AB         ADR(INPUTN-1)>
$84 $ABA5 INPUT#
perform INPUT# $84
$84 $ABA5 INPUT#
.:A016 BE AB         ADR(INPUT-1)
$85 $ABBF INPUT
perform INPUT $85
$85 $ABBF INPUT
.:A018 80 B0         ADR(DIM-1)
$86 $B081 DIM
perform DIM $86
$86 $B081 DIM
.:A01A 05 AC         ADR(READ-1)
$87 $AC06 READ
perform READ $87
$87 $AC06 READ
.:A01C A4 A9         ADR(LET-1)
$88 $A9A5 LET
perform LET $88
$88 $A9A5 LET
.:A01E 9F A8         ADR(GOTO-1)
$89 $A8A0 GOTO
perform GOTO $89
$89 $A8A0 GOTO
.:A020 70 A8         ADR(RUN-1)
$8A $A871 RUN
perform RUN $8A
$8A $A871 RUN
.:A022 27 A9         ADR(IF-1)
$8B $A928 IF
perform IF $8B
$8B $A928 IF
.:A024 1C A8         ADR(RESTORE-1)
$8C $A81D RESTORE
perform RESTORE $8C
$8C $A81D RESTORE
.:A026 82 A8         ADR(GOSUB-1)
$8D $A883 GOSUB
perform GOSUB $8D
$8D $A883 GOSUB
.:A028 D1 A8         ADR(RETURN-1)
$8E $A8D2 RETURN
perform RETURN $8E
$8E $A8D2 RETURN
.:A02A 3A A9         ADR(REM-1)
$8F $A93B REM
perform REM $8F
$8F $A93B REM
.:A02C 2E A8         ADR(STOP-1)
$90 $A82F STOP
perform STOP $90
$90 $A82F STOP
.:A02E 4A A9         ADR(ONGOTO-1)
IFN     NULCMD,<
        ADR(NULL-1)>
$91 $A94B ON
perform ON $91
$91 $A94B ON
.:A030 2C B8         ADR(FNWAIT-1)
IFN     DISKO,<
IFE     REALIO-3,<
$92 $B82D WAIT
perform WAIT $92
$92 $B82D WAIT
.:A032 67 E1         ADR(CQLOAD-1)
$93 $E168 LOAD
perform LOAD $93
$93 $E168 LOAD
.:A034 55 E1         ADR(CQSAVE-1)
$94 $E156 SAVE
perform SAVE $94
$94 $E156 SAVE
.:A036 64 E1         ADR(CQVERF-1)>
IFN     REALIO,<
IFN     REALIO-2,<
IFN     REALIO-3,<
IFN     REALIO-5,<
        ADR(LOAD-1)
        ADR(SAVE-1)>>>>
IFN     REALIO-1,<
IFN     REALIO-3,<
IFN     REALIO-4,<
        ADR(511)                ;ADDRESS OF LOAD
        ADR(511)>>>> ;ADDRESS OF SAVE
$95 $E165 VERIFY
perform VERIFY $95
$95 $E165 VERIFY
.:A038 B2 B3         ADR(DEF-1)
$96 $B3B3 DEF
perform DEF $96
$96 $B3B3 DEF
.:A03A 23 B8         ADR(POKE-1)
IFN     EXTIO,<
$97 $B824 POKE
perform POKE $97
$97 $B824 POKE
.:A03C 7F AA         ADR(PRINTN-1)>
$98 $AA80 PRINT#
perform PRINT# $98
$98 $AA80 PRINT#
.:A03E 9F AA         ADR(PRINT-1)
$99 $AAA0 PRINT
perform PRINT $99
$99 $AAA0 PRINT
.:A040 56 A8         ADR(CONT-1)
IFE     REALIO,<
        ADR(DDT-1)>
$9A $A857 CONT
perform CONT $9A
$9A $A857 CONT
.:A042 9B A6         ADR(LIST-1)
$9B $A69C LIST
perform LIST $9B
$9B $A69C LIST
.:A044 5D A6         ADR(CLEAR-1)
IFN     EXTIO,<
$9C $A65E CLR
perform CLR $9C
$9C $A65E CLR
.:A046 85 AA         ADR(CMD-1)
$9D $AA86 CMD
perform CMD $9D
$9D $AA86 CMD
.:A048 29 E1         ADR(CQSYS-1)
$9E $E12A SYS
perform SYS $9E
$9E $E12A SYS
.:A04A BD E1         ADR(CQOPEN-1)
$9F $E1BE OPEN
perform OPEN $9F
$9F $E1BE OPEN
.:A04C C6 E1         ADR(CQCLOS-1)>
IFN     GETCMD,<
$A0 $E1C7 CLOSE
perform CLOSE $A0
$A0 $E1C7 CLOSE
.:A04E 7A AB         ADR(GET-1)> ;FILL W/ GET ADDR.
$A1 $AB7B GET
perform GET $A1
$A1 $AB7B GET
.:A050 41 A6         ADR(SCRATH-1)

$A2 $A642 NEW

Adressen der BASIC-Funktionen

perform NEW $A2

action addresses for functions

$A2 $A642 NEW

.:A052 39 BC FUNDSP: ADR(SGN)
$B4 $BC39 SGN
perform SGN $B4
$B4 $BC39 SGN
.:A054 CC BC         ADR(INT)
$B5 $BCCC INT
perform INT $B5
$B5 $BCCC INT
.:A056 58 BC         ADR(ABS)
IFE     ROMSW,<
USRLOC: ADR(FCERR)> ;INITIALLY NO USER ROUTINE.
IFN     ROMSW,<
$B6 $BC58 ABS
perform ABS $B6
$B6 $BC58 ABS
.:A058 10 03 USRLOC: ADR(USRPOK)>
$B7 $0310 USR
perform USR $B7
$B7 $0310 USR
.:A05A 7D B3         ADR(FRE)
$B8 $B37D FRE
perform FRE $B8
$B8 $B37D FRE
.:A05C 9E B3         ADR(POS)
$B9 $B39E POS
perform POS $B9
$B9 $B39E POS
.:A05E 71 BF         ADR(SQR)
$BA $BF71 SQR
perform SQR $BA
$BA $BF71 SQR
.:A060 97 E0         ADR(RND)
$BB $E097 RND
perform RND $BB
$BB $E097 RND
.:A062 EA B9         ADR(LOG)
$BC $B9EA LOG
perform LOG $BC
$BC $B9EA LOG
.:A064 ED BF         ADR(EXP)
IFN     KIMROM,<
REPEAT  4,<
        ADR(FCERR)>>
IFE     KIMROM,<
$BD $BFED EXP
perform EXP $BD
$BD $BFED EXP
.:A066 64 E2 COSFIX: ADR(COS)
$BE $E264 COS
perform COS $BE
$BE $E264 COS
.:A068 6B E2 SINFIX: ADR(SIN)
$BF $E26B SIN
perform SIN $BF
$BF $E26B SIN
.:A06A B4 E2 TANFIX: ADR(TAN)
$C0 $E2B4 TAN
perform TAN $C0
$C0 $E2B4 TAN
.:A06C 0E E3 ATNFIX: ADR(ATN)>
$C1 $E30E ATN
perform ATN $C1
$C1 $E30E ATN
.:A06E 0D B8         ADR(PEEK)
$C2 $B80D PEEK
perform PEEK $C2
$C2 $B80D PEEK
.:A070 7C B7         ADR(LEN)
$C3 $B77C LEN
perform LEN $C3
$C3 $B77C LEN
.:A072 65 B4         ADR(STR)
$C4 $B465 STR$
perform STR$ $C4
$C4 $B465 STR$
.:A074 AD B7         ADR(VAL)
$C5 $B7AD VAL
perform VAL $C5
$C5 $B7AD VAL
.:A076 8B B7         ADR(ASC)
$C6 $B78B ASC
perform ASC $C6
$C6 $B78B ASC
.:A078 EC B6         ADR(CHR)
$C7 $B6EC CHR$
perform CHR$ $C7
$C7 $B6EC CHR$
.:A07A 00 B7         ADR(LEFT)
$C8 $B700 LEFT$
perform LEFT$ $C8
$C8 $B700 LEFT$
.:A07C 2C B7         ADR(RIGHT)
$C9 $B72C RIGHT$
perform RIGHT$ $C9
$C9 $B72C RIGHT$
.:A07E 37 B7         ADR(MID)
$CA $B737 MID$

Hierachiecodes und

Adressen-1 der Operatoren

perform MID$ $CA

precedence byte and action addresses for operators

like the primary commands these are called by pushing the address onto the stack
and doing an RTS, so again the actual address -1 needs to be pushed
$CA $B737 MID$

MATH OPERATOR BRANCH TABLE

ONE-BYTE PRECEDENCE CODE
TWO-BYTE ADDRESS
.:A080 79 69 B8 OPTAB:  121
$79, $B86A Addition
+
$79, $B86A +
.:A083 79 52 B8         ADR(FADDT-1)
        121
$79, $B853 Subtraktion
-
$79, $B853 -
.:A086 7B 2A BA         ADR(FSUBT-1)
        123
$7B, $BA2B Multiplikation
*
$7B, $BA2B *
.:A089 7B 11 BB         ADR(FMULTT-1)
        123
$7B, $BB12 Division
/
$7B, $BB12 /
.:A08C 7F 7A BF         ADR(FDIVT-1)
        127
$7F, $BF7B Potenzierung
^
$7F, $BF7B ^
.:A08F 50 E8 AF         ADR(FPWRT-1)
        80
$50, $AFE9 AND
AND
$50, $AFE9 AND
.:A092 46 E5 AF         ADR(ANDOP-1)
        70
$46, $AFE6 OR
OR
$46, $AFE6 OR (LOWEST PRECEDENCE)
.:A095 7D B3 BF         ADR(OROP-1)
NEGTAB: 125
$7D, $BFB4 Vorzeichenwechsel
>
$7D, $BFB4 >
.:A098 5A D3 AE         ADR(NEGOP-1)
NOTTAB: 90
$5A, $AED4 NOT
=
$5A, $AED4 =
.:A09B 64 15 B0         ADR(NOTOP-1)
PTDORL: 100                     ;PRECEDENCE.
$64, $B016 Vergleich


BASIC-Befehlsworte

<

BASIC keywords

each word has b7 set in it's last character as an end marker, even
the one character keywords such as "<" or "="
first are the primary command keywords, only these can start a statement
$64, $B016 <

TOKEN NAME TABLE

.:A09E 45 4E         ADR     (DOREL-1)       ;OPERATOR ADDRESS.
;
; TOKENS FOR RESERVED WORDS ALWAYS HAVE THE MOST
; SIGNIFICANT BIT ON.
; THE LIST OF RESERVED WORDS:
;
Q=128-1
DEFINE  DCI(A),<Q=Q+1
        DC(A)>
RESLST: DCI"END"
end
end
end
.:A0A0 C4 46 4F D2 4E 45 58 D4         ENDTK==Q
for next
for next
for next
.:A0A8 44 41 54 C1 49 4E 50 55         DCI"FOR"
data input#
data input#
data input#
.:A0B0 54 A3 49 4E 50 55 D4 44         FORTK==Q
input dim
input dim
input dim
.:A0B8 49 CD 52 45 41 C4 4C 45         DCI"NEXT"
read let
read let
read let
.:A0C0 D4 47 4F 54 CF 52 55 CE         DCI"DATA"
goto run
goto run
goto run
.:A0C8 49 C6 52 45 53 54 4F 52         DATATK==Q
if restore
if restore
if restore
.:A0D0 C5 47 4F 53 55 C2 52 45 IFN     EXTIO,<
gosub return
gosub return
gosub return
.:A0D8 54 55 52 CE 52 45 CD 53         DCI"INPUT#">
rem stop
rem stop
rem stop
.:A0E0 54 4F D0 4F CE 57 41 49         DCI"INPUT"
on wait
on wait
on wait
.:A0E8 D4 4C 4F 41 C4 53 41 56         DCI"DIM"
load save
load save
load save
.:A0F0 C5 56 45 52 49 46 D9 44         DCI"READ"
verify def
verify def
verify def
.:A0F8 45 C6 50 4F 4B C5 50 52         DCI"LET"
poke print#
poke print#
poke print#
.:A100 49 4E 54 A3 50 52 49 4E         DCI"GOTO"
print
print
print
.:A108 D4 43 4F 4E D4 4C 49 53         GOTOTK==Q
cont list
cont list
cont list
.:A110 D4 43 4C D2 43 4D C4 53         DCI"RUN"
clr cmd sys
clr cmd sys
clr cmd sys
.:A118 59 D3 4F 50 45 CE 43 4C         DCI"IF"
open close
open close
open close
.:A120 4F 53 C5 47 45 D4 4E 45         DCI"RESTORE"
get new
get new

next are the secondary command keywords, these can not start a statement
get new
.:A128 D7 54 41 42 A8 54 CF 46         DCI"GOSUB"
tab( to
tab( to
tab( to
.:A130 CE 53 50 43 A8 54 48 45         GOSUTK=Q
spc( then
spc( then
spc( then
.:A138 CE 4E 4F D4 53 54 45 D0         DCI"RETURN"
not stop
not stop
next are the operators
not stop
.:A140 AB AD AA AF DE 41 4E C4         DCI"REM"
+ - * / ' and
+ - * / ' and
+ - * / ' and
.:A148 4F D2 BE BD BC 53 47 CE         REMTK=Q
or <=> sgn
or <=>
or <=>
.:A150 49 4E D4 41 42 D3 55 53         DCI"STOP"
int abs usr
sgn

and finally the functions
int abs usr
sgn
int abs usr
.:A158 D2 46 52 C5 50 4F D3 53         DCI"ON"
fre pos sqr
fre pos sqr
fre pos sqr
.:A160 51 D2 52 4E C4 4C 4F C7 IFN     NULCMD,<
rnd log
rnd log
rnd log
.:A168 45 58 D0 43 4F D3 53 49         DCI"NULL">
exp cos sin
exp cos sin
exp cos sin
.:A170 CE 54 41 CE 41 54 CE 50         DCI"WAIT"
tan atn peek
tan atn peek
tan atn peek
.:A178 45 45 CB 4C 45 CE 53 54 IFN     DISKO,<
len str$
len str$
len str$
.:A180 52 A4 56 41 CC 41 53 C3         DCI"LOAD"
val asc
val asc
val asc
.:A188 43 48 52 A4 4C 45 46 54         DCI"SAVE"
chr$ left$
chr$ left$
chr$ left$
.:A190 A4 52 49 47 48 54 A4 4D IFE     REALIO-3,<
right$ mid$
right$ mid$

lastly is GO, this is an add on so that GO TO, as well as GOTO, will work
right$ mid$
.:A198 49 44 A4 47 CF 00         DCI"VERIFY">>
go

BASIC-Fehlermeldungen

go
go
.:A1A0 54 4F         DCI"DEF"
        DCI"POKE"
IFN     EXTIO,<
        DCI"PRINT#">
        DCI"PRINT"
        PRINTK==Q
        DCI"CONT"
IFE     REALIO,<
        DCI"DDT">
        DCI"LIST"
IFN     REALIO-3,<
        DCI"CLEAR">
IFE     REALIO-3,<
        DCI"CLR">
IFN     EXTIO,<
        DCI"CMD"
        DCI"SYS"
        DCI"OPEN"
        DCI"CLOSE">
IFN     GETCMD,<
        DCI"GET">
        DCI"NEW"
        SCRATK=Q
; END OF COMMAND LIST.
        "T"
        "A"
        "B"
        "("+128
        Q=Q+1
        TABTK=Q
        DCI"TO"
        TOTK==Q
        DCI"FN"
        FNTK==Q
        "S"
        "P"
        "C"
        "("+128                 ;MACRO DOESNT LIKE ('S IN ARGUMENTS.
        Q=Q+1
        SPCTK==Q
        DCI"THEN"
        THENTK=Q
        DCI"NOT"
        NOTTK==Q
        DCI"STEP"
        STEPTK=Q
        DCI"+"
        PLUSTK=Q
        DCI"-"
        MINUTK=Q
        DCI"*"
        DCI"/"
        DCI"^"
        DCI"AND"
        DCI"OR"
        190                     ;A GREATER THAN SIGN
        Q=Q+1
        GREATK=Q
        DCI"="
        EQULTK=Q
        188
        Q=Q+1                   ;A LESS THAN SIGN
        LESSTK=Q
;
; NOTE DANGER OF ONE RESERVED WORD BEING A PART
; OF ANOTHER:
; IE . . IF 2 GREATER THAN F OR T=5 THEN...
; WILL NOT WORK!!! SINCE "FOR" WILL BE CRUNCHED!!
; IN ANY CASE MAKE SURE THE SMALLER WORD APPEARS
; SECOND IN THE RESERVED WORD TABLE ("INP" AND "INPUT")
; ANOTHER EXAMPLE: IF T OR Q THEN ... "TO" IS CRUNCHED
;
        DCI"SGN"
        ONEFUN=Q
        DCI"INT"
        DCI"ABS"
        DCI"USR"
        DCI"FRE"
        DCI"POS"
        DCI"SQR"
        DCI"RND"
        DCI"LOG"
        DCI"EXP"
        DCI"COS"
        DCI"SIN"
        DCI"TAN"
        DCI"ATN"
        DCI"PEEK"
        DCI"LEN"
        DCI"STR$"
        DCI"VAL"
        DCI"ASC"
        DCI"CHR$"
LASNUM==Q                       ;NUMBER OF LAST FUNCTION
                                ;THAT TAKES ONE ARG
        DCI"LEFT$"
        DCI"RIGHT$"
        DCI"MID$"
        DCI"GO"
GOTK==Q
        0                       ;MARKS END OF RESERVED WORD LIST

IFE LNGERR,<
Q=0-2
DEFINE  DCE(X),<Q=Q+2
        DC(X)>
ERRTAB: DCE"NF"
        ERRNF==Q                ;NEXT WITHOUT FOR.
        DCE"SN"
        ERRSN==Q                ;SYNTAX
        DCE"RG"
        ERRRG==Q                ;RETURN WITHOUT GOSUB.
        DCE"OD"
        ERROD==Q                ;OUT OF DATA.
        DCE"FC"
        ERRFC==Q                ;ILLEGAL QUANTITY.
        DCE"OV"
        ERROV==Q                ;OVERFLOW.
        DCE"OM"
        ERROM==Q                ;OUT OF MEMORY.
        DCE"US"
        ERRUS==Q                ;UNDEFINED STATEMENT.
        DCE"BS"
        ERRBS==Q                ;BAD SUBSCRIPT.
        DCE"DD"
        ERRDD==Q                ;REDIMENSIONED ARRAY.
        DCE"/0"
        ERRDV0==Q               ;DIVISION BY ZERO.
        DCE"ID"
        ERRID==Q                ;ILLEGAL DIRECT.
        DCE"TM"
        ERRTM==Q                ;TYPE MISMATCH.
        DCE"LS"
        ERRLS==Q                ;STRING TOO LONG.
IFN     EXTIO,<
        DCE"FD"                 ;FILE DATA.
        ERRBD==Q>
        DCE"ST"
        ERRST==Q                ;STRING FORMULA TOO COMPLEX.
        DCE"CN"
        ERRCN==Q                ;CAN'T CONTINUE.
        DCE"UF"
        ERRUF==Q> ;UNDEFINED FUNCTION.

IFN LNGERR,<
Q=0
; NOTE: THIS ERROR COUNT TECHNIQUE WILL NOT WORK IF THERE ARE MORE
; THAN 256 CHARACTERS OF ERROR MESSAGES
ERRTAB: DC"NEXT WITHOUT FOR"
1 too many files

end marker

BASIC error messages

1 too many files

END OF TOKEN NAME TABLE

ERROR MESSAGES

1 too many files

.:A1A0 4F 20 4D 41 4E 59 20 46
.:A1A8 49 4C 45 D3 46 49 4C 45         ERRNF==Q
2 file open
2 file open
2 file open
.:A1B0 20 4F 50 45 CE 46 49 4C         Q=Q+16
3 file not open
3 file not open
3 file not open
.:A1B8 45 20 4E 4F 54 20 4F 50         DC"SYNTAX"



.:A1C0 45 CE 46 49 4C 45 20 4E         ERRSN==Q
4 file not found
4 file not found
4 file not found
.:A1C8 4F 54 20 46 4F 55 4E C4         Q=Q+6
5 device not present
5 device not present
5 device not present
.:A1D0 44 45 56 49 43 45 20 4E         DC"RETURN WITHOUT GOSUB"



.:A1D8 4F 54 20 50 52 45 53 45         ERRRG==Q



.:A1E0 4E D4 4E 4F 54 20 49 4E         Q=Q+20
6 not input file
6 not input file
6 not input file
.:A1E8 50 55 54 20 46 49 4C C5         DC"OUT OF DATA"



.:A1F0 4E 4F 54 20 4F 55 54 50         ERROD==Q
7 not output file
7 not output file
7 not output file
.:A1F8 55 54 20 46 49 4C C5 4D         Q=Q+11



.:A200 49 53 53 49 4E 47 20 46         DC"ILLEGAL QUANTITY"
8 missing filename
8 missing filename
8 missing filename
.:A208 49 4C 45 20 4E 41 4D C5         ERRFC==Q



.:A210 49 4C 4C 45 47 41 4C 20         Q=Q+16
9 illegal device number
9 illegal device number
9 illegal device number
.:A218 44 45 56 49 43 45 20 4E         DC"OVERFLOW"



.:A220 55 4D 42 45 D2 4E 45 58         ERROV==Q
10 next without for
10 next without for
10 next without for
.:A228 54 20 57 49 54 48 4F 55         Q=Q+8



.:A230 54 20 46 4F D2 53 59 4E         DC"OUT OF MEMORY"
11 syntax
11 syntax
11 syntax
.:A238 54 41 D8 52 45 54 55 52         ERROM==Q
12 return without gosub
12 return without gosub
12 return without gosub
.:A240 4E 20 57 49 54 48 4F 55         Q=Q+13



.:A248 54 20 47 4F 53 55 C2 4F         DC"UNDEF'D STATEMENT"
13 out of data
13 out of data
13 out of data
.:A250 55 54 20 4F 46 20 44 41         ERRUS==Q



.:A258 54 C1 49 4C 4C 45 47 41         Q=Q+17
14 illegal quantity
14 illegal quantity
14 illegal quantity
.:A260 4C 20 51 55 41 4E 54 49         DC"BAD SUBSCRIPT"



.:A268 54 D9 4F 56 45 52 46 4C         ERRBS==Q
15 overflow
15 overflow
15 overflow
.:A270 4F D7 4F 55 54 20 4F 46         Q=Q+13
16 out of memory
16 out of memory
16 out of memory
.:A278 20 4D 45 4D 4F 52 D9 55         DC"REDIM'D ARRAY"
17 undef'd statement
17 undef'd statement
17 undef'd statement
.:A280 4E 44 45 46 27 44 20 53         ERRDD==Q



.:A288 54 41 54 45 4D 45 4E D4         Q=Q+13



.:A290 42 41 44 20 53 55 42 53         DC"DIVISION BY ZERO"
18 bad subscript
18 bad subscript
18 bad subscript
.:A298 43 52 49 50 D4 52 45 44         ERRDV0==Q
19 redim'd array
19 redim'd array
19 redim'd array
.:A2A0 49 4D 27 44 20 41 52 52         Q=Q+16



.:A2A8 41 D9 44 49 56 49 53 49         DC"ILLEGAL DIRECT"
20 division by zero
20 division by zero
20 division by zero
.:A2B0 4F 4E 20 42 59 20 5A 45         ERRID==Q



.:A2B8 52 CF 49 4C 4C 45 47 41         Q=Q+14
21 illegal direct
21 illegal direct
21 illegal direct
.:A2C0 4C 20 44 49 52 45 43 D4         DC"TYPE MISMATCH"



.:A2C8 54 59 50 45 20 4D 49 53         ERRTM==Q
22 type mismatch
22 type mismatch
22 type mismatch
.:A2D0 4D 41 54 43 C8 53 54 52         Q=Q+13
23 string too long
23 string too long
23 string too long
.:A2D8 49 4E 47 20 54 4F 4F 20         DC"STRING TOO LONG"



.:A2E0 4C 4F 4E C7 46 49 4C 45         ERRLS==Q
24 file data
24 file data
24 file data
.:A2E8 20 44 41 54 C1 46 4F 52         Q=Q+15
25 formula too complex
25 formula too complex
25 formula too complex
.:A2F0 4D 55 4C 41 20 54 4F 4F IFN     EXTIO,<



.:A2F8 20 43 4F 4D 50 4C 45 D8         DC"FILE DATA"



.:A300 43 41 4E 27 54 20 43 4F         ERRBD==Q
26 can't continue
26 can't continue
26 can't continue
.:A308 4E 54 49 4E 55 C5 55 4E         Q=Q+9>
27 undef'd function
27 undef'd function
27 undef'd function
.:A310 44 45 46 27 44 20 46 55         DC"FORMULA TOO COMPLEX"



.:A318 4E 43 54 49 4F CE 56 45         ERRST==Q
28 verify
28 verify
28 verify
.:A320 52 49 46 D9 4C 4F 41 C4         Q=Q+19
        DC"CAN'T CONTINUE"
        ERRCN==Q
        Q=Q+14
        DC"UNDEF'D FUNCTION"
        ERRUF==Q>

29 load

Adressen der Fehlermeldungen

29 load

error message pointer table

29 load

.:A328 9E A1 AC A1 B5 A1 C2 A1



.:A330 D0 A1 E2 A1 F0 A1 FF A1



.:A338 10 A2 25 A2 35 A2 3B A2



.:A340 4F A2 5A A2 6A A2 72 A2



.:A348 7F A2 90 A2 9D A2 AA A2



.:A350 BA A2 C8 A2 D5 A2 E4 A2



.:A358 ED A2 00 A3 0E A3 1E A3



.:A360 24 A3 83 A3

;
; NEEDED FOR MESSAGES IN ALL VERSIONS.
;


Meldungen des Interpreters



BASIC messages



.:A364 0D 4F 4B 0D ERR:    DT" ERROR"
OK
OK
OK
.:A368 00 20 20 45 52 52 4F 52         0
ERROR
ERROR
ERROR
.:A370 00 20 49 4E 20 00 0D 0A INTXT:  DT" IN "
IN
IN
IN
.:A378 52 45 41 44 59 2E 0D 0A         0
READY.
READY.
READY.
.:A380 00 0D 0A 42 52 45 41 4B REDDY:  ACRLF
BREAK
BREAK
BREAK
.:A388 00 A0 IFE REALIO-3,<
        DT"READY.">
IFN REALIO-3,<
        DT"OK">
        ACRLF
        0
BRKTXT: ACRLF
        DT"BREAK"
        0
PAGE

GENERAL STORAGE MANAGEMENT ROUTINES.

;
; FIND A "FOR" ENTRY ON THE STACK VIA "VARPNT".
;
FORSIZ==2*ADDPRC+16


Stapelsuch-Routine für

FOR-NEXT- und GOSUB-Befehl



spare byte, not referenced



.,A38A BA       TSX FNDFOR: TSX                     ;LOAD XREG WITH STK PNTR.
Stapelzeiger in X-Register
unused

search the stack for FOR or GOSUB activity

return Zb=1 if FOR variable found
copy stack pointer

CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH

THE STACK FOR A FRAME WITH THE SAME VARIABLE.

(FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
= $XXFF IF CALLED FROM "RETURN"
<<< BUG: SHOULD BE $FFXX >>>

RETURNS .NE. IF VARIABLE NOT FOUND,
(X) = STACK PNTR AFTER SKIPPING ALL FRAMES

.EQ. IF FOUND
(X) = STACK PNTR OF FRAME FOUND

.,A38B E8       INX         REPEAT  4,<INX> ;IGNORE ADR(NEWSTT) AND RTS ADDR.
4 mal erhöhen
+1 pass return address

.,A38C E8       INX
(nächsten zwei Rücksprung-
+2 pass return address

.,A38D E8       INX
adressen, Interpreter und
+3 pass calling routine return address

.,A38E E8       INX
Routine, übergehen)
+4 pass calling routine return address

.,A38F BD 01 01 LDA $0101,X FFLOOP: LDA     257,X           ;GET STACK ENTRY.
nächstes Byte hoten
get the token byte from the stack
"FOR" FRAME HERE?
.,A392 C9 81    CMP #$81         CMPI    FORTK           ;IS IT A "FOR" TOKEN?
Ist es FOR-Code ?
is it the FOR token

.,A394 D0 21    BNE $A3B7         BNE     FFRTS           ;NO, NO "FOR" LOOPS WITH THIS PNTR.
Nein: dann RTS
if not FOR token just exit
it was the FOR token
NO
.,A396 A5 4A    LDA $4A         LDA     FORPNT+1        ;GET HIGH.
Variablenzeiger holen
get FOR/NEXT variable pointer high byte
YES -- "NEXT" WITH NO VARIABLE?
.,A398 D0 0A    BNE $A3A4         BNE     CMPFOR
keine Variable (NEXT):$A3A4
branch if not null
NO, VARIABLE SPECIFIED
.,A39A BD 02 01 LDA $0102,X         LDA     258,X           ;PNTR IS ZERO, SO ASSUME THIS ONE.
Variablenzeiger aus
get FOR variable pointer low byte
YES, SO USE THIS FRAME
.,A39D 85 49    STA $49         STA     FORPNT
Stapel nach $49/4A
save FOR/NEXT variable pointer low byte

.,A39F BD 03 01 LDA $0103,X         LDA     259,X
(Variablenzeiger)
get FOR variable pointer high byte

.,A3A2 85 4A    STA $4A         STA     FORPNT+1
holen
save FOR/NEXT variable pointer high byte

.,A3A4 DD 03 01 CMP $0103,X CMPFOR: CMP     259,X
Mit Zeiger im Stapel vergl.
compare variable pointer with stacked variable pointer
high byte
IS VARIABLE IN THIS FRAME?
.,A3A7 D0 07    BNE $A3B0         BNE     ADDFRS          ;NOT THIS ONE.
Ungleich: nächste Schleife
branch if no match
NO
.,A3A9 A5 49    LDA $49         LDA     FORPNT          ;GET DOWN.
Zeiger wieder holen
get FOR/NEXT variable pointer low byte
LOOK AT 2ND BYTE TOO
.,A3AB DD 02 01 CMP $0102,X         CMP     258,X
Mit Zeiger im Stapel vergl.
compare variable pointer with stacked variable pointer
low byte
SAME VARIABLE?
.,A3AE F0 07    BEQ $A3B7         BEQ     FFRTS           ;WE GOT IT! WE GOT IT!
Gleich: Schleife gefunden,RTS
exit if match found
YES
.,A3B0 8A       TXA ADDFRS: TXA
Suchzeiger in Akku
copy index
NO, SO TRY NEXT FRAME (IF ANY)
.,A3B1 18       CLC         CLC                     ;ADD 16 TO X.
Carry für Addition löschen
clear carry for add
18 BYTES PER FRAME
.,A3B2 69 12    ADC #$12         ADCI    FORSIZ
Suchzeiger um 18 erhöhen
add FOR stack use size

.,A3B4 AA       TAX         TAX                     ;RESULT BACK INTO X.
und wieder zurück ins X-Rg.
copy back to index

.,A3B5 D0 D8    BNE $A38F         BNE     FFLOOP
nächste Schleife prüfen
loop if not at start of stack
...ALWAYS?
.,A3B7 60       RTS FFRTS:  RTS                     ;RETURN TO CALLER.

;
; THIS IS THE BLOCK TRANSFER ROUTINE.
; IT MAKES SPACE BY SHOVING EVERYTHING FORWARD.
;
; ON ENTRY:
; [Y,A]=[HIGHDS] (FOR REASON).
; [HIGHDS]= DESTINATION OF [HIGH ADDRESS].
; [LOWTR]= LOWEST ADDR TO BE TRANSFERRED.
; [HIGHTR]= HIGHEST ADDR TO BE TRANSFERRED.
;
; A CHECK IS MADE TO ASCERTAIN THAT A REASONABLE
; AMOUNT OF SPACE REMAINS BETWEEN THE BOTTOM
; OF THE STRINGS AND THE HIGHEST LOCATION TRANSFERRED INTO.
;
; ON EXIT:
; [LOWTR] ARE UNCHANGED.
; [HIGHTR]=[LOWTR]-200 OCTAL.
; [HIGHDS]=LOWEST ADDR TRANSFERRED INTO MINUS 200 OCTAL.
;
Rücksprung

Block-Verschiebe-Routine



open up a space in the memory, set the end of arrays



MOVE BLOCK OF MEMORY UP

ON ENTRY:
(Y,A) = (HIGHDS) = DESTINATION END+1
(LOWTR) = LOWEST ADDRESS OF SOURCE
(HIGHTR) = HIGHEST SOURCE ADDRESS+1
.,A3B8 20 08 A4 JSR $A408 BLTU:   JSR     REASON          ;ASCERTAIN THAT STRING SPACE WON'T
                                ;BE OVERRUN.
prüft auf Platz im Speicher
check available memory, do out of memory error if no room
BE SURE (Y,A) < FRETOP
.,A3BB 85 31    STA $31         STWD    STREND
Ende des Arraybereichs
set end of arrays low byte
NEW TOP OF ARRAY STORAGE
.,A3BD 84 32    STY $32
als Beginn für freien Platz
set end of arrays high byte
open up a space in the memory, don't set the array end

.,A3BF 38       SEC BLTUC:  SEC                     ;PREPARE TO SUBTRACT.
Carry löschen (Subtraktion)
set carry for subtract

.,A3C0 A5 5A    LDA $5A         LDA     HIGHTR
Startadresse von Endad. des
get block end low byte
COMPUTE # OF BYTES TO BE MOVED
.,A3C2 E5 5F    SBC $5F         SBC     LOWTR           ;COMPUTE NUMBER OF THINGS TO MOVE.
Bereichs abziehen (LOW)
subtract block start low byte
(FROM LOWTR THRU HIGHTR-1)
.,A3C4 85 22    STA $22         STA     INDEX           ;SAVE FOR LATER.
Ergebnis (=Länge) speichern
save MOD(block length/$100) byte
PARTIAL PAGE AMOUNT
.,A3C6 A8       TAY         TAY
Gleiches System für HIGH:
copy MOD(block length/$100) byte to Y

.,A3C7 A5 5B    LDA $5B         LDA     HIGHTR+1
Altes Blockende (HIGH) und
get block end high byte

.,A3C9 E5 60    SBC $60         SBC     LOWTR+1
davon alter Blockanfang sub
subtract block start high byte

.,A3CB AA       TAX         TAX                     ;PUT IT IN A COUNTER REGISTER.
Länge nach X bringen
copy block length high byte to X
# OF WHOLE PAGES IN X-REG
.,A3CC E8       INX         INX                     ;SO THAT COUNTER ALGORITHM WORKS.
Ist ein Rest ( Länge nicht
+1 to allow for count=0 exit

.,A3CD 98       TYA         TYA                     ;SEE IF LOW PART OF COUNT IS ZERO.
256 Bytes)?
copy block length low byte to A
# BYTES IN PARTIAL PAGE
.,A3CE F0 23    BEQ $A3F3         BEQ     DECBLT          ;YES, GO START MOVING BLOCKS.
Nein: dann nur ganze Blöcke
branch if length low byte=0
block is (X-1)*256+Y bytes, do the Y bytes first
NO PARTIAL PAGE
.,A3D0 A5 5A    LDA $5A         LDA     HIGHTR          ;NO, MUST MODIFY BASE ADDR.
Alte Endadresse (LOW) und
get block end low byte
BACK UP HIGHTR # BYTES IN PARTIAL PAGE
.,A3D2 38       SEC         SEC
davon Länge des Restab-
set carry for subtract

.,A3D3 E5 22    SBC $22         SBC     INDEX           ;BORROW IS OFF SINCE [HIGHTR].GT.[LOWTR].
schnitts subtrahieren ergibt
Adresse des
subtract MOD(block length/$100) byte

.,A3D5 85 5A    STA $5A         STA     HIGHTR          ;SAVE MODIFIED BASE ADDR.
Restabschnitts
save corrected old block end low byte

.,A3D7 B0 03    BCS $A3DC         BCS     BLT1            ;IF NO BORROW, GO SHOVE IT.
Berechnung für HIGH umgehen
branch if no underflow

.,A3D9 C6 5B    DEC $5B         DEC     HIGHTR+1        ;BORROW IMPLIES SUB 1 FROM HIGH ORDER.
Dasselbe System für HIGH
else decrement block end high byte

.,A3DB 38       SEC         SEC
Carry setzen (Subtraktion)
set carry for subtract

.,A3DC A5 58    LDA $58 BLT1:   LDA     HIGHDS          ;MOD BASE OF DEST ADDR.
Alte Endadresse (HIGH) und
get destination end low byte
BACK UP HIGHDS # BYTES IN PARTIAL PAGE
.,A3DE E5 22    SBC $22         SBC     INDEX
davon Länge des Rests sub-
subtract MOD(block length/$100) byte

.,A3E0 85 58    STA $58         STA     HIGHDS
trahieren ergibt neue Adresse
save modified new block end low byte

.,A3E2 B0 08    BCS $A3EC         BCS     MOREN1          ;NO BORROW.
Unbedingter Sprung zur
branch if no underflow

.,A3E4 C6 59    DEC $59         DEC     HIGHDS+1        ;DECREMENT HIGH ORDER BYTE.
Kopierroutine für ganze
else decrement block end high byte

.,A3E6 90 04    BCC $A3EC         BCC     MOREN1          ;ALWAYS SKIP.
Blöcke
branch always
...ALWAYS
.,A3E8 B1 5A    LDA ($5A),Y BLTLP:  LDADY   HIGHTR          ;FETCH BYTE TO MOVE
Kopierroutine für Rest-
get byte from source
MOVE THE BYTES
.,A3EA 91 58    STA ($58),Y         STADY   HIGHDS          ;MOVE IT IN, MOVE IT OUT.
abschnitt
copy byte to destination

.,A3EC 88       DEY MOREN1: DEY
Zähler vermindern
decrement index

.,A3ED D0 F9    BNE $A3E8         BNE     BLTLP
Alles? wenn nicht: weiter
loop until Y=0
now do Y=0 indexed byte
LOOP TO END OF THIS 256 BYTES
.,A3EF B1 5A    LDA ($5A),Y         LDADY   HIGHTR          ;MOVE LAST OF THE BLOCK.
Kopierroutine für ganze
get byte from source
MOVE ONE MORE BYTE
.,A3F1 91 58    STA ($58),Y         STADY   HIGHDS
Blöcke
save byte to destination

.,A3F3 C6 5B    DEC $5B DECBLT: DEC     HIGHTR+1
Adresszähler vermindern
decrement source pointer high byte
DOWN TO NEXT BLOCK OF 256
.,A3F5 C6 59    DEC $59         DEC     HIGHDS+1        ;START ON NEW BLOCKS.
Adresszähler vermindern
decrement destination pointer high byte

.,A3F7 CA       DEX         DEX
Zähler vermindern
decrement block count
ANOTHER BLOCK OF 256 TO MOVE?
.,A3F8 D0 F2    BNE $A3EC         BNE     MOREN1
Alles? Wenn nicht: weiter
loop until count = $0
YES
.,A3FA 60       RTS         RTS                     ;RETURN TO CALLER.

;
; THIS ROUTINE IS USED TO ASCERTAIN THAT A GIVEN
; NUMBER OF LOCS REMAIN AVAILABLE FOR THE STACK.
; THE CALL IS:
; LDAI NUMBER OF 2-BYTE ENTRIES NEEDED.
; JSR GETSTK
;
; THIS ROUTINE MUST BE CALLED BY ANY ROUTINE WHICH PUTS
; AN ARBITRARY AMOUNT OF STUFF ON THE STACK,
; I.E., ANY RECURSIVE ROUTINE LIKE "FRMEVL".
; IT IS ALSO CALLED BY ROUTINES SUCH AS "GOSUB" AND "FOR"
; WHICH MAKE PERMANENT ENTRIES ON THE STACK.
;
; ROUTINES WHICH MERELY USE AND FREE UP THE GUARANTEED
; NUMLEV LOCATIONS NEED NOT CALL THIS.
;
;
; ON EXIT:
; [A] AND [X] HAVE BEEN MODIFIED.
;
sonst Rücksprung

Prüfung auf Platz im Stapel



check room on stack for A bytes

if stack too deep do out of memory error
NO, FINISHED

CHECK IF ENOUGH ROOM LEFT ON STACK

FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION

.,A3FB 0A       ASL GETSTK: ASL     A,              ;MULT [A] BY 2. NB, CLEARS C BIT.
Akku muß die halbe Zahl an
*2

.,A3FC 69 3E    ADC #$3E         ADCI    2*NUMLEV+<3*ADDPRC>+13 ;MAKE SURE 2*NUMLEV+13 LOCS
                                ;(13 BECAUSE OF FBUFFR)
erforderlichem Platz haben
need at least $3E bytes free

.,A3FE B0 35    BCS $A435         BCS     OMERR           ;WILL REMAIN IN STACK.
gibt 'OUT OF MEMORY'
if overflow go do out of memory error then warm start
...MEM FULL ERR
.,A400 85 22    STA $22         STA     INDEX
Wert merken
save result in temp byte

.,A402 BA       TSX         TSX                     ;GET STACKED.
Ist Stapelzeiger kleiner
copy stack

.,A403 E4 22    CPX $22         CPX     INDEX           ;COMPARE.
(2 * Akku + 62)?
compare new limit with stack

.,A405 90 2E    BCC $A435         BCC     OMERR           ;IF STACK.LE.INDEX1, OM.
Wenn ja, dann OUT OF MEMORY
if stack < limit do out of memory error then warm start
...MEM FULL ERR
.,A407 60       RTS         RTS

;
; [Y,A] IS A CERTAIN ADDRESS. "REASON" MAKES SURE
; IT IS LESS THAN [FRETOP].
;
Rücksprung

Schafft Platz im Speicher



check available memory, do out of memory error if no room



CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS

(Y,A) = ADDR ARRAYS NEED TO GROW TO
.,A408 C4 34    CPY $34 REASON: CPY     FRETOP+1
für Zeileneinfügung
compare with bottom of string space high byte
HIGH BYTE
.,A40A 90 28    BCC $A434         BCC     REARTS
und Variablen
if less then exit (is ok)
PLENTY OF ROOM
.,A40C D0 04    BNE $A412         BNE     TRYMOR          ;GO GARB COLLECT.
A/Y = Adresse, bis zu der
skip next test if greater (tested <)
high byte was =, now do low byte
NOT ENOUGH, TRY GARBAGE COLLECTION
.,A40E C5 33    CMP $33         CMP     FRETOP
Platz benötigt wird.
compare with bottom of string space low byte
LOW BYTE
.,A410 90 22    BCC $A434         BCC     REARTS
Kleiner als Stringzeiger
if less then exit (is ok)
address is > string storage ptr (oops!)
ENOUGH ROOM

.,A412 48       PHA TRYMOR: PHA
Akku Zwischenspeichern
push address low byte
SAVE (Y,A), TEMP1, AND TEMP2
.,A413 A2 09    LDX #$09         LDXI    8+ADDPRC        ;IF TEMPF2 HAS ZERO IN BETWEEN.
Zähler setzen
set index to save $57 to $60 inclusive

.,A415 98       TYA         TYA
Y-Register auf
copy address high byte (to push on stack)
save misc numeric work area

.,A416 48       PHA REASAV: PHA
Stapel retten
push byte

.,A417 B5 57    LDA $57,X         LDA     HIGHDS-1,X      ;SAVE HIGHDS ON STACK.
Ab $57 Zwischenspeichern
get byte from $57 to $60

.,A419 CA       DEX         DEX
Zähler vermindern
decrement index

.,A41A 10 FA    BPL $A416         BPL     REASAV          ;PUT 8 OF THEM ON STK.
Alle? sonstweiter
loop until all done

.,A41C 20 26 B5 JSR $B526         JSR     GARBA2          ;GO GARB COLLECT.
Garbage Collection
do garbage collection routine
restore misc numeric work area
MAKE AS MUCH ROOM AS POSSIBLE
.,A41F A2 F7    LDX #$F7         LDXI    256-8-ADDPRC
Zähler setzen, um
set index to restore bytes
RESTORE TEMP1 AND TEMP2
.,A421 68       PLA REASTO: PLA
Akku, Y-Register und andere
pop byte
AND (Y,A)
.,A422 95 61    STA $61,X         STA     HIGHDS+8+ADDPRC,X       ;RESTORE AFTER GARB COLLECT.
Register zurückholen
save byte to $57 to $60

.,A424 E8       INX         INX
Zähler vermindern
increment index

.,A425 30 FA    BMI $A421         BMI     REASTO
Fertig? Nein, dann weiter
loop while -ve

.,A427 68       PLA         PLA
Y-Register von Stapel
pop address high byte

.,A428 A8       TAY         TAY
zurückholen
copy back to Y

.,A429 68       PLA         PLA                     ;RESTORE A AND Y.
Akku holen
pop address low byte
DID WE FIND ENOUGH ROOM?
.,A42A C4 34    CPY $34         CPY     FRETOP+1        ;COMPARE HIGHS
Ist jetzt genügend Platz?
compare with bottom of string space high byte
HIGH BYTE
.,A42C 90 06    BCC $A434         BCC     REARTS
Ja, dann Rücksprung
if less then exit (is ok)
YES, AT LEAST A PAGE
.,A42E D0 05    BNE $A435         BNE     OMERR           ;HIGHER IS BAD.
kein Platz, dann Fehler-
if greater do out of memory error then warm start
high byte was =, now do low byte
NO, MEM FULL ERR
.,A430 C5 33    CMP $33         CMP     FRETOP          ;AND THE LOWS.
meldung 1 out of memory 1
compare with bottom of string space low byte
LOW BYTE
.,A432 B0 01    BCS $A435         BCS     OMERR
ausgeben
if >= do out of memory error then warm start
ok exit, carry clear
NO, MEM FULL ERR
.,A434 60       RTS REARTS: RTS

PAGE

ERROR HANDLER, READY, TERMINAL INPUT, COMPACTIFY, NEW, REINIT.

Rücksprung


do out of memory error then warm start

YES, RETURN

.,A435 A2 10    LDX #$10 OMERR:  LDXI    ERROM
Fehlernummer 'out of memory'

Fehlereinsprung

error code $10, out of memory error
do error #X then warm start


HANDLE AN ERROR

(X)=OFFSET IN ERROR MESSAGE TABLE
(ERRFLG) > 128 IF "ON ERR" TURNED ON
(CURLIN+1) = $FF IF IN DIRECT MODE

WARM RESTART ENTRY

COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G
.,A437 6C 00 03 JMP ($0300) ERROR:
Zum BASIC-Warmstart ($E38B)

Fehlermeldung ausgeben

do error message

do error #X then warm start, the error message vector is initialised to point here


.,A43A 8A       TXA IFN     REALIO,<
Fehlernummer im X-Register
copy error number

.,A43B 0A       ASL         LSR     CNTWFL> ;FORCE OUTPUT.
Akku * 2
*2

.,A43C AA       TAX IFN     EXTIO,<
Akku als Zeiger nach X
copy to index

.,A43D BD 26 A3 LDA $A326,X         LDA     CHANNL          ;CLOSE NON-TERMINAL CHANNEL.
und Adresse der
get error message pointer low byte

.,A440 85 22    STA $22         BEQ     ERRCRD
Fehlernummer aus Tabelle
save it

.,A442 BD 27 A3 LDA $A327,X         JSR     CQCCHN          ;CLOSE IT.
holen und
get error message pointer high byte

.,A445 85 23    STA $23         LDAI    0
abspeichern
save it

.,A447 20 CC FF JSR $FFCC         STA     CHANNL>
I/O Kanäle zurücksetzen
close input and output channels

.,A44A A9 00    LDA #$00
und Eingabekanal auf
clear A

.,A44C 85 13    STA $13
Tastatur setzen
clear current I/O channel, flag default

.,A44E 20 D7 AA JSR $AAD7 ERRCRD: JSR     CRDO            ;OUTPUT CRLF.
(CR) und (LF) ausgeben
print CR/LF

.,A451 20 45 AB JSR $AB45         JSR     OUTQST          ;PRINT A QUESTION MARK
IFE LNGERR,<
        LDA     ERRTAB,X,       ;GET FIRST CHR OF ERR MSG.
        JSR     OUTDO           ;OUTPUT IT.
        LDA     ERRTAB+1,X,     ;GET SECOND CHR.
        JSR     OUTDO> ;OUTPUT IT.
'?' ausgeben
print "?"

.,A454 A0 00    LDY #$00 IFN LNGERR,<
Zeiger setzen
clear index

.,A456 B1 22    LDA ($22),Y GETERR: LDA     ERRTAB,X
Fehlermeldungstext holen
get byte from message

.,A458 48       PHA         PHA
Akku retten
save status

.,A459 29 7F    AND #$7F         ANDI    127             ;GET RID OF HIGH BIT.
Bit 7 löschen und
mask 0xxx xxxx, clear b7

.,A45B 20 47 AB JSR $AB47         JSR     OUTDO           ;OUTPUT IT.
Fehlermeldung ausgeben
output character

.,A45E C8       INY         INX
Zähler vermindern
increment index

.,A45F 68       PLA         PLA                     ;LAST CHAR OF MESSAGE?
Akku zurückholen
restore status

.,A460 10 F4    BPL $A456         BPL     GETERR> ;NO. GO GET NEXT AND OUTPUT IT.
Fertig? Nein, dann weiter
loop if character was not end marker

.,A462 20 7A A6 JSR $A67A TYPERR: JSR     STKINI          ;RESET THE STACK AND FLAGS.
BASIC-Zeiger initialisieren
flush BASIC stack and clear continue pointer

.,A465 A9 69    LDA #$69         LDWDI   ERR             ;GET PNTR TO " ERROR".
Zeiger A/Y auf Error-
set " ERROR" pointer low byte

.,A467 A0 A3    LDY #$A3
meldung stellen
set " ERROR" pointer high byte

print string and do warm start, break entry


.,A469 20 1E AB JSR $AB1E ERRFIN: JSR     STROUT          ;OUTPUT IT.
String ausgeben
print null terminated string

.,A46C A4 3A    LDY $3A         LDY     CURLIN+1
Auf Programmodus
get current line number high byte

.,A46E C8       INY         INY                     ;WAS NUMBER 64000?
(prog/direkt) prüfen
increment it

.,A46F F0 03    BEQ $A474         BEQ     READY           ;YES, DON'T TYPE LINE NUMBER.
Direkt: dann ausgeben
branch if was in immediate mode

.,A471 20 C2 BD JSR $BDC2         JSR     INPRT
READY:
IFN     REALIO,<
        LSR     CNTWFL> ;TURN OUTPUT BACK ON IF SUPRESSED
'in Zeilennummer' ausgeben
do " IN " line number message

do warm start


.,A474 A9 76    LDA #$76         LDWDI   REDDY           ;SAY "OK".
Zeiger auf Ready-Modus
set "READY." pointer low byte

.,A476 A0 A3    LDY #$A3
IFN     REALIO-3,<
        JSR     RDYJSR> ;OR GO TO INIT IF INIT ERROR.
IFE     REALIO-3,<
setzen und
set "READY." pointer high byte

.,A478 20 1E AB JSR $AB1E         JSR     STROUT> ;NO INIT ERRORS POSSIBLE.
String ausgeben
print null terminated string

.,A47B A9 80    LDA #$80
Wert für Direktmodus laden
set for control messages only

.,A47D 20 90 FF JSR $FF90
und Flag setzen

Eingabe-Warteschleife

control kernal messages

.,A480 6C 02 03 JMP ($0302)
JMP $A483
do BASIC warm start

BASIC warm start, the warm start vector is initialised to point here


.,A483 20 60 A5 JSR $A560 MAIN:   JSR     INLIN           ;GET A LINE FROM TERMINAL.
BASIC-Zeile nach
Eingabepuffer
call for BASIC input
READ A LINE
.,A486 86 7A    STX $7A         STXY    TXTPTR
CHRGET Zeiger auf
save BASIC execute pointer low byte
SET UP CHRGET TO SCAN THE LINE
.,A488 84 7B    STY $7B
Eingabepuffer
save BASIC execute pointer high byte

.,A48A 20 73 00 JSR $0073         JSR     CHRGET
nächstes Zeichen holen
increment and scan memory

.,A48D AA       TAX         TAX                     ;SET ZERO FLAG BASED ON [A]
                                ;THIS DISTINGUISHES ":" AND 0
Puffer leer?
copy byte to set flags

.,A48E F0 F0    BEQ $A480         BEQ     MAIN            ;IF BLANK LINE, GET ANOTHER.
Ja: dann weiter warten
loop if no input
got to interpret the input line now ....
EMPTY LINE
.,A490 A2 FF    LDX #$FF         LDXI    255             ;SET DIRECT LINE NUMBER.
Wert für
current line high byte to -1, indicates immediate mode
$FF IN HI-BYTE OF CURLIN MEANS
.,A492 86 3A    STX $3A         STX     CURLIN+1
Kennzeichen für Direktmodus
set current line number high byte
WE ARE IN DIRECT MODE
.,A494 90 06    BCC $A49C         BCC     MAIN1           ;IS A LINE NUMBER. NOT DIRECT.
Ziffer? als Zeile einfügen
if numeric character go handle new BASIC line
no line number .. immediate mode
CHRGET SAW DIGIT, NUMBERED LINE
.,A496 20 79 A5 JSR $A579         JSR     CRUNCH          ;COMPACTIFY.
BASIC-Zeile in Code wandeln
crunch keywords into BASIC tokens
NO NUMBER, SO PARSE IT
.,A499 4C E1 A7 JMP $A7E1         JMP     GONE            ;EXECUTE IT.
Befehl ausführen

Löschen und Einfügen von

Programmzeilen

go scan and interpret code

handle new BASIC line

AND TRY EXECUTING IT

HANDLE NUMBERED LINE

.,A49C 20 6B A9 JSR $A96B MAIN1:  JSR     LINGET          ;READ LINE NUMBER INTO "LINNUM".
Zeilenr. nach Adressformat
get fixed-point number into temporary integer

.,A49F 20 79 A5 JSR $A579         JSR     CRUNCH
BASIC-Zeile in Code wandeln
crunch keywords into BASIC tokens

.,A4A2 84 0B    STY $0B         STY     COUNT           ;RETAIN CHARACTER COUNT.
Zeiger in Eingabepuffer
save index pointer to end of crunched line
SAVE INDEX TO INPUT BUFFER
.,A4A4 20 13 A6 JSR $A613         JSR     FNDLIN
Zeilenadresse berechnen
search BASIC for temporary integer line number
IS THIS LINE # ALREADY IN PROGRAM?
.,A4A7 90 44    BCC $A4ED         BCC     NODEL           ;NO MATCH, SO DON'T DELETE.
Vorhanden? Ja: löschen

Programmzeile löschen

if not found skip the line delete
line # already exists so delete it
NO
.,A4A9 A0 01    LDY #$01         LDYI    1
Zeiger setzen
set index to next line pointer high byte
YES, SO DELETE IT
.,A4AB B1 5F    LDA ($5F),Y         LDADY   LOWTR
Startadresse der nächsten
get next line pointer high byte
LOWTR POINTS AT LINE
.,A4AD 85 23    STA $23         STA     INDEX1+1
Zeile (HIGH) setzen
save it
GET HIGH BYTE OF FORWARD PNTR
.,A4AF A5 2D    LDA $2D         LDA     VARTAB
Variablenanfangszeiger
get start of variables low byte

.,A4B1 85 22    STA $22         STA     INDEX1
(LOW) setzen
save it

.,A4B3 A5 60    LDA $60         LDA     LOWTR+1         ;SET TRANSFER TO.
Startadresse der zu
get found line pointer high byte

.,A4B5 85 25    STA $25         STA     INDEX2+1
löschenden Zeile (HIGH)
save it

.,A4B7 A5 5F    LDA $5F         LDA     LOWTR
Startadresse der zu
get found line pointer low byte

.,A4B9 88       DEY         DEY
löschenden Zeile (LOW)
decrement index

.,A4BA F1 5F    SBC ($5F),Y         SBCDY   LOWTR           ;COMPUTE NEGATIVE LENGTH.
Startadresse der nächsten
subtract next line pointer low byte

.,A4BC 18       CLC         CLC
Zeile (LOW)
clear carry for add

.,A4BD 65 2D    ADC $2D         ADC     VARTAB          ;COMPUTE NEW VARTAB.
Variablenanfangszeiger (LOW)
add start of variables low byte

.,A4BF 85 2D    STA $2D         STA     VARTAB
ergibt neuen Variablenan-
set start of variables low byte

.,A4C1 85 24    STA $24         STA     INDEX2          ;SET LOW OF TRANS TO.
fangszeiger (LOW)
save destination pointer low byte

.,A4C3 A5 2E    LDA $2E         LDA     VARTAB+1
Gleiches System für
get start of variables high byte

.,A4C5 69 FF    ADC #$FF         ADCI    255
HIGH-Byte des Variablenan-
-1 + carry

.,A4C7 85 2E    STA $2E         STA     VARTAB+1        ;COMPUTE HIGH OF VARTAB.
fangszeigers
set start of variables high byte

.,A4C9 E5 60    SBC $60         SBC     LOWTR+1         ;COMPUTE NUMBER OF BLOCKS TO MOVE.
minus Startadresse der zu
subtract found line pointer high byte

.,A4CB AA       TAX         TAX
löschenden Zeile (LOW) ergibt
copy to block count

.,A4CC 38       SEC         SEC
die zu verschiebenden Blöcke
set carry for subtract

.,A4CD A5 5F    LDA $5F         LDA     LOWTR
Startadresse (LOW) minus
get found line pointer low byte

.,A4CF E5 2D    SBC $2D         SBC     VARTAB          ;COMPUTE OFFSET.
Variablenanfangszeiger (LOW)
subtract start of variables low byte

.,A4D1 A8       TAY         TAY
ergibt Länge des Restabschn.
copy to bytes in first block count

.,A4D2 B0 03    BCS $A4D7         BCS     QDECT1          ;IF VARTAB.LE.LOWTR,
Größer als 255? Nein: $A4D7
branch if no underflow

.,A4D4 E8       INX         INX                     ;DECR DUE TO CARRY, AND
Zähler für Blöcke erhöhen
increment block count, correct for = 0 loop exit

.,A4D5 C6 25    DEC $25         DEC     INDEX2+1        ;DECREMENT STORE SO CARRY WORKS.
Transportzeiger vermindern
decrement destination high byte

.,A4D7 18       CLC QDECT1: CLC
Carry löschen
clear carry for add

.,A4D8 65 22    ADC $22         ADC     INDEX1
Anfangszeiger (LOW)
add source pointer low byte

.,A4DA 90 03    BCC $A4DF         BCC     MLOOP
Verminderung überspringen
branch if no overflow

.,A4DC C6 23    DEC $23         DEC     INDEX1+1
Zeiger um 1 vermindern
else decrement source pointer high byte

.,A4DE 18       CLC         CLC                     ;FOR LATER ADCQ
Carry löschen
clear carry
close up memory to delete old line


.,A4DF B1 22    LDA ($22),Y MLOOP:  LDADY   INDEX1
Verschiebeschleife
get byte from source
MOVE HIGHER LINES OF PROGRAM
.,A4E1 91 24    STA ($24),Y         STADY   INDEX2
Wert abspeichern
copy to destination
DOWN OVER THE DELETED LINE.
.,A4E3 C8       INY         INY
Zähler um 1 erhöhen
increment index

.,A4E4 D0 F9    BNE $A4DF         BNE     MLOOP           ;BLOCK DONE?
Block fertig? Nein: weiter
while <> 0 do this block

.,A4E6 E6 23    INC $23         INC     INDEX1+1
1.Adreßzeiger erhöhen (LOW)
increment source pointer high byte

.,A4E8 E6 25    INC $25         INC     INDEX2+1
2.Adreßzeiger erhöhen (LOW)
increment destination pointer high byte

.,A4EA CA       DEX         DEX
Blockzähter um 1 vermindern
decrement block count

.,A4EB D0 F2    BNE $A4DF         BNE     MLOOP           ;DO ANOTHER BLOCK. ALWAYS.
Alle Blöcke? Nein: weiter

Programmzeile einfügen

loop until all done
got new line in buffer and no existing same #


.,A4ED 20 59 A6 JSR $A659 NODEL:  JSR     RUNC            ;RESET ALL VARIABLE INFO SO GARBAGE
                                ;COLLECTION CAUSED BY REASON WILL WORK
CLR-Befehl
reset execution to start, clear variables, flush stack
and return

.,A4F0 20 33 A5 JSR $A533         JSR     LNKPRG          ;FIX UP THE LINKS
Programmzeilen neu binden
rebuild BASIC line chaining

.,A4F3 AD 00 02 LDA $0200         LDA     BUF             ;SEE IF ANYTHNG THERE
Zeichen im Puffer ?
get first byte from buffer
ANY CHARACTERS AFTER LINE #?
.,A4F6 F0 88    BEQ $A480         BEQ     MAIN
nein, dann zur Warteschleife
if no line go do BASIC warm start
else insert line into memory
NO, SO NOTHING TO INSERT.
.,A4F8 18       CLC         CLC
Carry löschen
clear carry for add

.,A4F9 A5 2D    LDA $2D         LDA     VARTAB
Variablenanfangszeiger (LOW)
get start of variables low byte
SET UP BLTU SUBROUTINE
.,A4FB 85 5A    STA $5A         STA     HIGHTR          ;SETUP HIGHTR.
als Endadresse (Quellbereich)
save as source end pointer low byte
INSERT NEW LINE.
.,A4FD 65 0B    ADC $0B         ADC     COUNT           ;ADD LENGTH OF LINE TO INSERT.
+ Länge der Zeile als End-
add index pointer to end of crunched line

.,A4FF 85 58    STA $58         STA     HIGHDS          ;THIS GIVES DEST ADDR.
adresse des Zielbereichs LOW
save as destination end pointer low byte

.,A501 A4 2E    LDY $2E         LDY     VARTAB+1
Variablenanfangszeiger als
get start of variables high byte

.,A503 84 5B    STY $5B         STY     HIGHTR+1        ;SAME FOR HIGH ORDERS.
Endadr. des Quellbereichs LOW
save as source end pointer high byte

.,A505 90 01    BCC $A508         BCC     NODELC
Kein Übertrag? dann $A508
branch if no carry to high byte

.,A507 C8       INY         INY
Übertrag addieren
else increment high byte

.,A508 84 59    STY $59 NODELC: STY     HIGHDS+1
Als Endadresse
des Zielbereichs
save as destination end pointer high byte

.,A50A 20 B8 A3 JSR $A3B8         JSR     BLTU
IFN     BUFPAG,<
BASIC-Zeilen verschieben
open up space in memory
most of what remains to do is copy the crunched line into the space opened up in memory,
however, before the crunched line comes the next line pointer and the line number. the
line number is retrieved from the temporary integer and stored in memory, this
overwrites the bottom two bytes on the stack. next the line is copied and the next line
pointer is filled with whatever was in two bytes above the line number in the stack.
this is ok because the line pointer gets fixed in the line chain re-build.
MAKE ROOM FOR THE LINE
.,A50D A5 14    LDA $14         LDWD    LINNUM          ;POSITION THE BINARY LINE NUMBER
Zeilennummer aus
get line number low byte
PUT LINE NUMBER IN LINE IMAGE
.,A50F A4 15    LDY $15
$14/15 vor
get line number high byte

.,A511 8D FE 01 STA $01FE         STWD    BUF-2> ;IN FRONT OF BUF
BASIC-Eingabepuffer setzen
save line number low byte before crunched line

.,A514 8C FF 01 STY $01FF
(ab $0200)
save line number high byte before crunched line

.,A517 A5 31    LDA $31         LDWD    STREND
Neuer Variablen-
get end of arrays low byte

.,A519 A4 32    LDY $32
endzeiger
get end of arrays high byte

.,A51B 85 2D    STA $2D         STWD    VARTAB
als Zeiger auf Programm-
set start of variables low byte

.,A51D 84 2E    STY $2E
ende speichern
set start of variables high byte

.,A51F A4 0B    LDY $0B         LDY     COUNT
Zeilenlänge holen
get index to end of crunched line

.,A521 88       DEY         DEY
und um 1 vermindern
-1


COPY LINE INTO PROGRAM
.,A522 B9 FC 01 LDA $01FC,Y STOLOP: LDA     BUF-4,Y
Zeile aus Eingabepuffer
get byte from crunched line

.,A525 91 5F    STA ($5F),Y         STADY   LOWTR
ins Programm kopieren
save byte to memory

.,A527 88       DEY         DEY
Schon alle Zeichen?
decrement index

.,A528 10 F8    BPL $A522         BPL     STOLOP
Nein: dann weiterkopieren
loop while more to do
reset execution, clear variables, flush stack, rebuild BASIC chain and do warm start


CLEAR ALL VARIABLES

RE-ESTABLISH ALL FORWARD LINKS
.,A52A 20 59 A6 JSR $A659 FINI:   JSR     RUNC            ;DO CLEAR & SET UP STACK.
                                ;AND SET [TXTPTR] TO [TXTTAB]-1.
CLR-Befehl
reset execution to start, clear variables and flush stack
CLEAR ALL VARIABLES
.,A52D 20 33 A5 JSR $A533         JSR     LNKPRG          ;FIX UP PROGRAM LINKS
Programmzeilen neu binden
rebuild BASIC line chaining

.,A530 4C 80 A4 JMP $A480         JMP     MAIN
zur Eingabe-Warteschleife

BASIC-Zeilen neu binden

go do BASIC warm start

rebuild BASIC line chaining


.,A533 A5 2B    LDA $2B LNKPRG: LDWD    TXTTAB          ;SET [INDEX] TO [TXTTAB].
Zeiger auf BASIC-Programm-
get start of memory low byte
POINT INDEX AT START OF PROGRAM
.,A535 A4 2C    LDY $2C
start holen und
get start of memory high byte

.,A537 85 22    STA $22         STWD    INDEX
und als Suchzeiger nach
set line start pointer low byte

.,A539 84 23    STY $23
$22/23 speichern
set line start pointer high byte

.,A53B 18       CLC         CLC
;
; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES
; UP ALL THE LINKS. THE END OF EACH LINE IS FOUND
; BY SEARCHING FOR THE ZERO AT THE END.
; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM.
;
Carry löschen
clear carry for add

.,A53C A0 01    LDY #$01 CHEAD:  LDYI    1
Zeiger laden
set index to pointer to next line high byte
HI-BYTE OF NEXT FORWARD PNTR
.,A53E B1 22    LDA ($22),Y         LDADY   INDEX           ;ARRIVED AT DOUBLE ZEROES?
Zeilenadresse holen
get pointer to next line high byte
END OF PROGRAM YET?
.,A540 F0 1D    BEQ $A55F         BEQ     LNKRTS
=0? Ja: dann RTS
exit if null, [EOT]

.,A542 A0 04    LDY #$04         LDYI    4
Zeiger auf erstes BASIC-
point to first code byte of line
there is always 1 byte + [EOL] as null entries are deleted
FIND END OF THIS LINE
.,A544 C8       INY CZLOOP: INY                     ;THERE IS AT LEAST ONE BYTE.
zeichen setzen
next code byte
(NOTE MAXIMUM LENGTH < 256)
.,A545 B1 22    LDA ($22),Y         LDADY   INDEX
Zeichen holen
get byte

.,A547 D0 FB    BNE $A544         BNE     CZLOOP          ;NO, CONTINUE SEARCHING.
=0? (Zeilenende) nein: weiter
loop if not [EOL]

.,A549 C8       INY         INY                     ;GO ONE BEYOND.
Zeilenlänge nach
point to byte past [EOL], start of next line
COMPUTE ADDRESS OF NEXT LINE
.,A54A 98       TYA         TYA
Akku schieben
copy it

.,A54B 65 22    ADC $22         ADC     INDEX
+ Zeiger auf aktuelle Zeile
add line start pointer low byte

.,A54D AA       TAX         TAX
(LOW) ins X-Register
copy to X

.,A54E A0 00    LDY #$00         LDYI    0
Zeiger laden
clear index, point to this line's next line pointer
STORE FORWARD PNTR IN THIS LINE
.,A550 91 22    STA ($22),Y         STADY   INDEX
Akku als Adr.zeiger (LOW)
set next line pointer low byte

.,A552 A5 23    LDA $23         LDA     INDEX+1
Zeiger auf aktuelle
Zeile (HIGH)
get line start pointer high byte

.,A554 69 00    ADC #$00         ADCI    0
Übertrag addieren
add any overflow
(NOTE: THIS CLEARS CARRY)
.,A556 C8       INY         INY
Zähler um 1 erhöhen
increment index to high byte

.,A557 91 22    STA ($22),Y         STADY   INDEX
Adresszeiger (HIGH) speichern
set next line pointer high byte

.,A559 86 22    STX $22         STX     INDEX
Startadresse der nächsten
set line start pointer low byte

.,A55B 85 23    STA $23         STA     INDEX+1
Zeile abspeichern
set line start pointer high byte

.,A55D 90 DD    BCC $A53C         BCCA    CHEAD           ;ALWAYS BRANCHES.
Zum Zeilenanfang
go do next line, branch always
...ALWAYS
.,A55F 60       RTS LNKRTS: RTS
;
; THIS IS THE LINE INPUT ROUTINE.
; IT READS CHARACTERS INTO BUF USING BACKARROW (UNDERSCORE, OR
; SHIFT O) AS THE DELETE CHARACTER AND @ AS THE
; LINE DELETE CHARACTER. IF MORE THAN BUFLEN CHARACTERS
; ARE TYPED, NO ECHOING IS DONE UNTIL A BACKARROW OR @ OR CR
; IS TYPED. CONTROL-G WILL BE TYPED FOR EACH EXTRA CHARACTER.
; THE ROUTINE IS ENTERED AT INLIN.
;
IFE     REALIO-4,<
INLIN:  LDXI    128             ;NO PROMPT CHARACTER
        STX     CQPRMP
        JSR     CQINLN          ;GET A LINE ONTO PAGE 2
        CPXI    BUFLEN-1
        BCS     GDBUFS          ;NOT TOO MANY CHARACTERS
        LDXI    BUFLEN-1
GDBUFS: LDAI    0               ;PUT A ZERO AT THE END
        STA     BUF,X
        TXA
        BEQ     NOCHR
LOPBHT: LDA     BUF-1,X
        ANDI    127
        STA     BUF-1,X
        DEX
        BNE     LOPBHT
NOCHR:  LDAI    0
        LDXYI   <BUF-1> ;POINT AT THE BEGINNING
        RTS>
IFN     REALIO-4,<
IFN     REALIO-3,<
LINLIN: IFE     REALIO-2,<
        JSR     OUTDO> ;ECHO IT.
        DEX                     ;BACKARROW SO BACKUP PNTR AND
        BPL     INLINC          ;GET ANOTHER IF COUNT IS POSITIVE.
INLINN: IFE     REALIO-2,<
        JSR     OUTDO> ;PRINT THE @ OR A SECOND BACKARROW
                                ;IF THERE WERE TOO MANY.
        JSR     CRDO>
Rücksprung

Eingabe einer Zeile


call for BASIC input


.,A560 A2 00    LDX #$00 INLIN:  LDXI    0
Zeiger setzen
set channel $00, keyboard

.,A562 20 12 E1 JSR $E112 INLINC: JSR     INCHR           ;GET A CHARACTER.
IFN REALIO-3,<
        CMPI    7               ;IS IT BOB ALBRECHT RINGING THE BELL
                                ;FOR SCHOOL KIDS?
        BEQ     GOODCH>
ein Zeichen holen
input character from channel with error check

.,A565 C9 0D    CMP #$0D         CMPI    13              ;CARRIAGE RETURN?
RETURN-Taste ?
compare with [CR]

.,A567 F0 0D    BEQ $A576         BEQ     FININ1          ;YES, FINISH UP.
IFN     REALIO-3,<
        CMPI    32              ;CHECK FOR FUNNY CHARACTERS.
        BCC     INLINC
        CMPI    125             ;IS IT TILDA OR DELETE?
        BCS     INLINC          ;BIG BAD ONES TOO.
        CMPI    "@"             ;LINE DELETE?
        BEQ     INLINN          ;YES.
        CMPI    "_"             ;CHARACTER DELETE?
        BEQ     LINLIN> ;YES.
GOODCH:
IFN     REALIO-3,<
        CPXI    BUFLEN-1        ;LEAVE ROOM FOR NULL.
                        ;COMMO ASSURES US NEVER MORE THAN BUFLEN.
        BCS     OUTBEL>
ja, dann Eingabe beenden
if [CR] set XY to $200 - 1, print [CR] and exit
character was not [CR]

.,A569 9D 00 02 STA $0200,X         STA     BUF,X
Zeichen nach Eingabepuffer
save character to buffer

.,A56C E8       INX         INX
Zeiger um 1 erhöhen
increment buffer index

.,A56D E0 59    CPX #$59 IFE     REALIO-2,<SKIP2>
89. Zeichen ?
compare with max+1

.,A56F 90 F1    BCC $A562 IFN     REALIO-2,<BNE INLINC>
nein, weitere Zeichen holen
branch if < max+1

.,A571 A2 17    LDX #$17 IFN REALIO-3,<
Nummer für 'string too long'
error $17, string too long error

.,A573 4C 37 A4 JMP $A437 OUTBEL: LDAI    7
Fehlermeldung ausgeben
do error #X then warm start

.,A576 4C CA AA JMP $AACA IFN     REALIO,<
Puffer mit $0 abschließen, CR

Umwandlung einer Zeile in den

Interpreter-Code

set XY to $200 - 1 and print [CR]

crunch BASIC tokens vector


.,A579 6C 04 03 JMP ($0304)         JSR     OUTDO> ;ECHO IT.
        BNE     INLINC> ;CYCLE ALWAYS.
FININ1: JMP     FININL> ;GO TO FININL FAR, FAR AWAY.
INCHR:
IFE     REALIO-3,<
        JSR     CQINCH> ;FOR COMMODORE.
IFE     REALIO-2,<
INCHRL: LDA     ^O176000
        REPEAT  4,<NOP>
        LSR     A,
        BCC     INCHRL
        LDA     ^O176001        ;GET THE CHARACTER.
        REPEAT  4,<NOP>
        ANDI    127>
IFE     REALIO-1,<
        JSR     ^O17132> ;1E5A FOR MOS TECH.
IFE     REALIO-4,<
        JSR     CQINCH          ;FD0C FOR APPLE COMPUTER.
        ANDI    127>
IFE     REALIO,<
        TJSR    INSIM##> ;GET A CHARACTER FROM SIMULATOR

IFN     REALIO,<
IFN     EXTIO,<
        LDY     CHANNL          ;CNT-O HAS NO EFFECT IF NOT FROM TERM.
        BNE     INCRTS>
        CMPI    CONTW           ;SUPPRESS OUTPUT CHARACTER (^W).
        BNE     INCRTS          ;NO, RETURN.
        PHA
        COM     CNTWFL          ;COMPLEMENT ITS STATE.
        PLA>
INCRTS: RTS                     ;END OF INCHR.

;
; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE
; BYTES WITH THE MSB ON. THIS SAVES SPACE AND TIME
; BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION.
; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE
; RESERVED WORD LIST IN THE SAME ORDER THEY
; APPEAR IN STMDSP.
;
BUFOFS=0                        ;THE AMOUNT TO OFFSET THE LOW BYTE
                                ;OF THE TEXT POINTER TO GET TO BUF
                                ;AFTER TXTPTR HAS BEEN SETUP TO POINT INTO BUF
IFN     BUFPAG,<
BUFOFS=<BUF/256>*256>
JMP $A57C
do crunch BASIC tokens

crunch BASIC tokens, the crunch BASIC tokens vector is initialised to point here



TOKENIZE THE INPUT LINE

.,A57C A6 7A    LDX $7A CRUNCH: LDX     TXTPTR          ;SET SOURCE POINTER.
Zeiger setzen, erstes Zeichen
get BASIC execute pointer low byte
INDEX INTO UNPARSED LINE
.,A57E A0 04    LDY #$04         LDYI    4               ;SET DESTINATION OFFSET.
Wert für codierte Zeile
set save index
INDEX TO PARSED OUTPUT LINE
.,A580 84 0F    STY $0F         STY     DORES           ;ALLOW CRUNCHING.
Flag für Hochkomma
clear open quote/DATA flag
CLEAR SIGN-BIT OF DATAFLG
.,A582 BD 00 02 LDA $0200,X KLOOP:  LDA     BUFOFS,X
IFE     REALIO-3,<
Zeichen aus Puffer holen
get a byte from the input buffer

.,A585 10 07    BPL $A58E         BPL     CMPSPC          ;GO LOOK AT SPACES.
kein BASIC-Code ? kleiner 128
if b7 clear go do crunching

.,A587 C9 FF    CMP #$FF         CMPI    PI              ;PI??
Code für Pi ?
compare with the token for PI, this toke is input
directly from the keyboard as the PI character

.,A589 F0 3E    BEQ $A5C9         BEQ     STUFFH          ;GO SAVE IT.
Ja: dann speichern
if PI save byte then continue crunching
this is the bit of code that stops you being able to enter
some keywords as just single shifted characters. If this
dropped through you would be able to enter GOTO as just
[SHIFT]G

.,A58B E8       INX         INX                     ;SKIP NO PRINTING.
Zeiger erhöhen
increment read index

.,A58C D0 F4    BNE $A582         BNE     KLOOP> ;ALWAYS GOES.
nächstes Zeichen überprüfen
loop if more to do, branch always

.,A58E C9 20    CMP #$20 CMPSPC: CMPI    " "             ;IS IT A SPACE TO SAVE?
' ' Leerzeichen?
compare with [SPACE]
IGNORE BLANKS
.,A590 F0 37    BEQ $A5C9         BEQ     STUFFH          ;YES, GO SAVE IT.
Ja: dann speichern
if [SPACE] save byte then continue crunching

.,A592 85 08    STA $08         STA     ENDCHR          ;IF IT'S A QUOTE, THIS WILL
                                ;STOP LOOP WHEN OTHER QUOTE APPEARS.
in Hochkomma-Flag speichern
save buffer byte as search character

.,A594 C9 22    CMP #$22         CMPI    34              ;QUOTE SIGN?
"'" Hochkomma?
compare with quote character
START OF QUOTATION?
.,A596 F0 56    BEQ $A5EE         BEQ     STRNG           ;YES, DO SPECIAL STRING HANDLING.
Ja: dann speichern
if quote go copy quoted string

.,A598 24 0F    BIT $0F         BIT     DORES           ;TEST FLAG.
Überprüft auf Bit 6
get open quote/DATA token flag

.,A59A 70 2D    BVS $A5C9         BVS     STUFFH          ;NO CRUNCH, JUST STORE.
gesetzt: ASCII speichern
branch if b6 of Oquote set, was DATA
go save byte then continue crunching
BRANCH IF IN "DATA" STATEMENT
.,A59C C9 3F    CMP #$3F         CMPI    "?"             ;A QMARK?
'?' Fragezeichen?
compare with "?" character
SHORTHAND FOR "PRINT"?
.,A59E D0 04    BNE $A5A4         BNE     KLOOP1
Nein: dann weiter prüfen
if not "?" continue crunching
NO
.,A5A0 A9 99    LDA #$99         LDAI    PRINTK          ;YES, STUFF A "PRINT" TOKEN.
PRINT-Code für ? laden
else the keyword token is $99, PRINT
YES, REPLACE WITH "PRINT" TOKEN
.,A5A2 D0 25    BNE $A5C9         BNE     STUFFH          ;ALWAYS GO TO STUFFH.
und abspeichern
go save byte then continue crunching, branch always
...ALWAYS
.,A5A4 C9 30    CMP #$30 KLOOP1: CMPI    "0"             ;SKIP NUMERICS.
Kleiner $30 ? (Code für 0)
compare with "0"
IS IT A DIGIT, COLON, OR SEMI-COLON?
.,A5A6 90 04    BCC $A5AC         BCC     MUSTCR
Ja: dann $A5AC
branch if <, continue crunching
NO, PUNCTUATION !"#$%&amp;'()*+,-./
.,A5A8 C9 3C    CMP #$3C         CMPI    60              ;":" AND ";" ARE ENTERED STRAIGHTAWAY.
Mit $3C vergleichen
compare with "<"

.,A5AA 90 1D    BCC $A5C9         BCC     STUFFH
wenn größer, dann $A5C9
if <, 0123456789:; go save byte then continue crunching
gets here with next character not numeric, ";" or ":"
YES, NOT A TOKEN

SEARCH TOKEN NAME TABLE FOR MATCH STARTING

WITH CURRENT CHAR FROM INPUT LINE

.,A5AC 84 71    STY $71 MUSTCR: STY     BUFPTR          ;SAVE BUFFER POINTER.
Zeiger Zwischenspeichern
copy save index
SAVE INDEX TO OUTPUT LINE
.,A5AE A0 00    LDY #$00         LDYI    0               ;LOAD RESLST POINTER.
Zähler für Tokentabelle
clear table pointer
USE Y-REG WITH (FAC) TO ADDRESS TABLE
.,A5B0 84 0B    STY $0B         STY     COUNT           ;ALSO CLEAR COUNT.
initialisieren
clear word index
HOLDS CURRENT TOKEN-$80
.,A5B2 88       DEY         DEY

e increment loop
PREPARE FOR "INY" A FEW LINES DOWN
.,A5B3 86 7A    STX $7A         STX     TXTPTR          ;SAVE TEXT POINTER FOR LATER USE.
Zeiger auf Eingabepuffer
save BASIC execute pointer low byte, buffer index
SAVE POSITION IN INPUT LINE
.,A5B5 CA       DEX         DEX
zwischenspeichern
adjust for pre increment loop
PREPARE FOR "INX" A FEW LINES DOWN
.,A5B6 C8       INY RESER:  INY
X- und Y-Register
next table byte
ADVANCE POINTER TO TOKEN TABLE
.,A5B7 E8       INX RESPUL: INX
um 1 erhöhen
next buffer byte

.,A5B8 BD 00 02 LDA $0200,X RESCON: LDA     BUFOFS,X
Zeichen aus Puffer laden
get byte from input buffer
NEXT CHAR FROM INPUT LINE
.,A5BB 38       SEC         SEC                     ;PREPARE TO SUBSTARCT.
Carry für Subtr. löschen
set carry for subtract
NO, COMPARE TO CHAR IN TABLE
.,A5BC F9 9E A0 SBC $A09E,Y         SBC     RESLST,Y        ;CHARACTERS EQUAL?
Zeichen mit Befehlswort vergleichen
subtract table byte
SAME AS NEXT CHAR OF TOKEN NAME?
.,A5BF F0 F5    BEQ $A5B6         BEQ     RESER           ;YES, CONTINUE SEARCH.
Gefunden? Ja: nächstes Zeich.
go compare next if match
YES, CONTINUE MATCHING
.,A5C1 C9 80    CMP #$80         CMPI    128             ;NO BUT MAYBE THE END IS HERE.
mit $80 (128) vergleichen
was it end marker match ?
MAYBE; WAS IT SAME EXCEPT FOR BIT 7?
.,A5C3 D0 30    BNE $A5F5         BNE     NTHIS           ;NO, TRULY UNEQUAL.
Befehl nicht gefunden: $A5F5
branch if not, not found keyword
actually this works even if the input buffer byte is the
end marker, i.e. a shifted character. As you can't enter
any keywords as a single shifted character, see above,
you can enter keywords in shorthand by shifting any
character after the first. so RETURN can be entered as
R[SHIFT]E, RE[SHIFT]T, RET[SHIFT]U or RETU[SHIFT]R.
RETUR[SHIFT]N however will not work because the [SHIFT]N
will match the RETURN end marker so the routine will try
to match the next character.
else found keyword
NO, SKIP TO NEXT TOKEN
.,A5C5 05 0B    ORA $0B         ORA     COUNT
BASIC-Code gleich Zähler +$80
OR with word index, +$80 in A makes token
YES, END OF TOKEN; GET TOKEN #
.,A5C7 A4 71    LDY $71 GETBPT: LDY     BUFPTR          ;GET BUFFER PNTR.
Zeiger auf cod. Zeile holen
restore save index
save byte then continue crunching
GET INDEX TO OUTPUT LINE IN Y-REG
.,A5C9 E8       INX STUFFH: INX

fer read index
ADVANCE INPUT INDEX
.,A5CA C8       INY         INY
Zeiger erhöhen
increment save index
ADVANCE OUTPUT INDEX
.,A5CB 99 FB 01 STA $01FB,Y         STA     BUF-5,Y
BASIC-Code speichern
save byte to output
STORE CHAR OR TOKEN
.,A5CE B9 FB 01 LDA $01FB,Y         LDA     BUF-5,Y
und Statusregister setzen
get byte from output, set flags
TEST FOR EOL OR EOS
.,A5D1 F0 36    BEQ $A609         BEQ     CRDONE          ;NULL IMPLIES END OF LINE.
=0 (Ende): dann fertig
branch if was null [EOL]
A holds the token here
END OF LINE
.,A5D3 38       SEC         SEC                     ;PREPARE TO SUBSTARCT.
Carry setzen (Subtraktion)
set carry for subtract

.,A5D4 E9 3A    SBC #$3A         SBCI    ":"             ;IS IT A ":"?
':' Trennzeichen?
subtract ":"
END OF STATEMENT?
.,A5D6 F0 04    BEQ $A5DC         BEQ     COLIS           ;YES, ALLOW CRUNCHING AGAIN.
Ja: dann $A5DC
branch if it was (is now $00)
A now holds token-':'
YES, CLEAR DATAFLG
.,A5D8 C9 49    CMP #$49         CMPI    DATATK-":"      ;IS IT A DATATK?
DATA-Code ?
compare with the token for DATA-':'
"DATA" TOKEN?
.,A5DA D0 02    BNE $A5DE         BNE     NODATT          ;NO, SEE IF IT IS REM TOKEN.
Nein: Speichern überspringen
if not DATA go try REM
token was : or DATA
NO, LEAVE DATAFLG ALONE
.,A5DC 85 0F    STA $0F COLIS:  STA     DORES           ;SETUP FLAG.
nach Hochkomma-Flag speichern
save the token-$3A
DATAFLG = 0 OR $83-$3A = $49
.,A5DE 38       SEC NODATT: SEC                     ;PREP TO SBCQ
Carry setzen
set carry for subtract
IS IT A "REM" TOKEN?
.,A5DF E9 55    SBC #$55         SBCI    REMTK-":"       ;REM ONLY STOPS ON NULL.
REM-Code ?
subtract the token for REM-':'

.,A5E1 D0 9F    BNE $A582         BNE     KLOOP           ;NO, CONTINUE CRUNCHING.
Nein: zum Schleifenanfang
if wasn't REM crunch next bit of line
NO, CONTINUE PARSING LINE
.,A5E3 85 08    STA $08         STA     ENDCHR          ;REM STOPS ONLY ON NULL, NOT : OR ".
0 in Hochkomma-Flag
else was REM so set search for [EOL]
loop for "..." etc.
YES, CLEAR LITERAL FLAG

HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,

BY COPYING CHARS UP TO ENDCHR.

.,A5E5 BD 00 02 LDA $0200,X STR1:   LDA     BUFOFS,X
nächstes Zeichen holen
get byte from input buffer

.,A5E8 F0 DF    BEQ $A5C9         BEQ     STUFFH          ;YES, END OF LINE, SO DONE.
=0 (Ende)? Ja: dann $A5C9
if null [EOL] save byte then continue crunching
END OF LINE
.,A5EA C5 08    CMP $08         CMP     ENDCHR          ;END OF GOBBLE?
Als ASCII speichern?
compare with stored character

.,A5EC F0 DB    BEQ $A5C9         BEQ     STUFFH          ;YES, DONE WITH STRING.
Nein: dann $A5C9
if match save byte then continue crunching
FOUND ENDCHR
.,A5EE C8       INY STRNG:  INY                     ;INCREMENT BUFFER POINTER.
Zeiger erhöhen
increment save index
NEXT OUTPUT CHAR
.,A5EF 99 FB 01 STA $01FB,Y         STA     BUF-5,Y
Code abspeichern
save byte to output

.,A5F2 E8       INX         INX
Zeiger erhöhen
increment buffer index
NEXT INPUT CHAR
.,A5F3 D0 F0    BNE $A5E5         BNE     STR1            ;PROCESS NEXT CHARACTER.
Zum Schleifenanfang
loop while <> 0, should never reach 0
not found keyword this go
...ALWAYS

ADVANCE POINTER TO NEXT TOKEN NAME

.,A5F5 A6 7A    LDX $7A NTHIS:  LDX     TXTPTR          ;RESTORE TEXT POINTER.
Zeiger wieder auf Eingabep.
restore BASIC execute pointer low byte
GET POINTER TO INPUT LINE IN X-REG
.,A5F7 E6 0B    INC $0B         INC     COUNT           ;INCREMENT RES WORD COUNT.
Suchzähler erhöhen
increment word index (next word)
now find end of this word in the table
BUMP (TOKEN # - $80)
.,A5F9 C8       INY NTHIS1: INY
Zähler erhöhen
increment table index
NEXT TOKEN ONE BEYOND THAT
.,A5FA B9 9D A0 LDA $A09D,Y         LDA     RESLST-1,Y,     ;GET RES CHARACTER.
nächsten Befehl suchen
get table byte
YES, AT NEXT NAME. END OF TABLE?
.,A5FD 10 FA    BPL $A5F9         BPL     NTHIS1          ;END OF ENTRY?
Gefunden? Nein: weitersuchen
loop if not end of word yet

.,A5FF B9 9E A0 LDA $A09E,Y         LDA     RESLST,Y,       ;YES. IS IT THE END?
Ende der Tabelle?
get byte from keyword table

.,A602 D0 B4    BNE $A5B8         BNE     RESCON          ;NO, TRY THE NEXT WORD.
Nein: dann weiter
go test next word if not zero byte, end of table
reached end of table with no match
NO, NOT END OF TABLE
.,A604 BD 00 02 LDA $0200,X         LDA     BUFOFS,X        ;YES, END OF TABLE. GET 1ST CHR.
nächstes Zeichen holen
restore byte from input buffer
YES, SO NOT A KEYWORD
.,A607 10 BE    BPL $A5C7         BPL     GETBPT          ;STORE IT AWAY (ALWAYS BRANCHES).
kleiner $80? Ja: $A5C7
branch always, all unmatched bytes in the buffer are
$00 to $7F, go save byte in output and continue crunching
reached [EOL]
...ALWAYS, COPY CHAR AS IS

END OF LINE
.,A609 99 FD 01 STA $01FD,Y CRDONE: STA     BUF-3,Y,        ;SO THAT IF THIS IS A DIR STATEMENT
                                ;ITS END WILL LOOK LIKE END OF PROGRAM.
IFN     <<BUF+BUFLEN>/256>-<<BUF-1>/256>,<
im Eingabepuffer speichern
save [EOL]
STORE ANOTHER 00 ON END
.,A60C C6 7B    DEC $7B         DEC     TXTPTR+1>
CHRGET-Zeiger zurücksetzen
decrement BASIC execute pointer high byte
SET TXTPTR = INPUT.BUFFER-1
.,A60E A9 FF    LDA #$FF         LDAI    <BUF&255>-1 ;MAKE TXTPTR POINT TO
Zeiger auf Eingabepuffer -1
point to start of buffer-1

.,A610 85 7A    STA $7A         STA     TXTPTR          ;CRUNCHED LINE.
setzen (LOW)
set BASIC execute pointer low byte

.,A612 60       RTS LISTRT: RTS                     ;RETURN TO CALLER.
;
; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE
; WHOSE NUMBER IS PASSED IN "LINNUM".
; THERE ARE TWO POSSIBLE RETURNS:
;
; 1) CARRY SET.
; LOWTR POINTS TO THE LINK FIELD IN THE LINE
; WHICH IS THE ONE SEARCHED FOR.
;
; 2) CARRY NOT SET.
; LINE NOT FOUND. [LOWTR] POINTS TO THE LINE IN THE
; PROGRAM GREATER THAN THE ONE SOUGHT AFTER.
;
Rücksprung

Startadresse einer

Programmzeile berechnen



search BASIC for temporary integer line number



SEARCH FOR LINE

(LINNUM) = LINE # TO FIND
IF NOT FOUND: CARRY = 0
LOWTR POINTS AT NEXT LINE
IF FOUND: CARRY = 1
LOWTR POINTS AT LINE
.,A613 A5 2B    LDA $2B FNDLIN: LDWX    TXTTAB          ;LOAD [X,A] WITH [TXTTAB]
Zeiger auf BASIC-
get start of memory low byte
SEARCH FROM BEGINNING OF PROGRAM
.,A615 A6 2C    LDX $2C
Programmstart laden
get start of memory high byte

search Basic for temp integer line number from AX

returns carry set if found

.,A617 A0 01    LDY #$01 FNDLNC: LDYI    1
Zähler setzen
set index to next line pointer high byte
SEARCH FROM (X,A)
.,A619 85 5F    STA $5F         STWX    LOWTR           ;STORE [X,A] INTO LOWTR
BASIC-Programmstart als
save low byte as current

.,A61B 86 60    STX $60
Zeiger nach $5F/60
save high byte as current

.,A61D B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;SEE IF LINK IS 0
Link-Adresse holen (HIGH)
get next line pointer high byte from address

.,A61F F0 1F    BEQ $A640         BEQ     FLINRT
gleich null: dann Ende
pointer was zero so done, exit
END OF PROGRAM, AND NOT FOUND
.,A621 C8       INY         INY
Zähler 2 mal erhöhen ( LOW-
increment index ...

.,A622 C8       INY         INY
Byte übergehen)
... to line # high byte

.,A623 A5 15    LDA $15         LDA     LINNUM+1        ;COMP HIGH ORDERS OF LINE NUMBERS.
gesuchte Zeilennummer (HIGH)
get temporary integer high byte

.,A625 D1 5F    CMP ($5F),Y         CMPDY   LOWTR
mit aktueller vergleichen
compare with line # high byte

.,A627 90 18    BCC $A641         BCC     FLNRTS          ;NO SUCH LINE NUMBER.
kleiner: dann nicht gefunden
exit if temp < this line, target line passed
IF NOT FOUND
.,A629 F0 03    BEQ $A62E         BEQ     FNDLO1
gleich: Nummer LOW prüfen
go check low byte if =

.,A62B 88       DEY         DEY
Zähler um 1 vermindern
else decrement index

.,A62C D0 09    BNE $A637         BNE     AFFRTS          ;ALWAYS BRANCH.
unbedingter Sprung
branch always

.,A62E A5 14    LDA $14 FNDLO1: LDA     LINNUM
gesuchte Zeilennummer (LOW)
get temporary integer low byte

.,A630 88       DEY         DEY
Zeiger um 1 vermindern
decrement index to line # low byte

.,A631 D1 5F    CMP ($5F),Y         CMPDY   LOWTR           ;COMPARE LOW ORDERS.
Zeilennummer LOW vergleichen
compare with line # low byte

.,A633 90 0C    BCC $A641         BCC     FLNRTS          ;NO SUCH NUMBER.
kleiner: Zeile nicht gefunden
exit if temp < this line, target line passed
PAST LINE, NOT FOUND
.,A635 F0 0A    BEQ $A641         BEQ     FLNRTS          ;GO TIT.
oder gleich: C=1 und RTS
exit if temp = (found line#)
not quite there yet
IF FOUND
.,A637 88       DEY AFFRTS: DEY
Y-Register auf 1 setzen
decrement index to next line pointer high byte

.,A638 B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;FETCH LINK.
Adresse der nächsten Zeile
get next line pointer high byte

.,A63A AA       TAX         TAX
in das X-Register laden
copy to X

.,A63B 88       DEY         DEY
Register vermindern (auf 0)
decrement index to next line pointer low byte

.,A63C B1 5F    LDA ($5F),Y         LDADY   LOWTR
Link-Adresse holen (LOW)
get next line pointer low byte

.,A63E B0 D7    BCS $A617         BCS     FNDLNC          ;ALWAYS BRANCHES.
weiter suchen
go search for line # in temporary integer
from AX, carry always set
ALWAYS
.,A640 18       CLC FLINRT: CLC                     ;C MAY BE HIGH.
Carry löschen
clear found flag
RETURN CARRY = 0
.,A641 60       RTS FLNRTS: RTS                     ;RETURN TO CALLER.
;
; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL
; AS VARIABLE SPACE.
;
Rücksprung

BASIC-Befehl NEW



perform NEW



"NEW" STATEMENT

.,A642 D0 FD    BNE $A641 SCRATH: BNE     FLNRTS          ;MAKE SURE THERE IS A TERMINATOR.
Kein Trennzeichen: SYNTAX
ERROR
exit if following byte to allow syntax error
IGNORE IF MORE TO THE STATEMENT
.,A644 A9 00    LDA #$00 SCRTCH: LDAI    0               ;GET A CLEARER.
Nullcode laden
clear A

.,A646 A8       TAY         TAY                     ;SET UP INDEX.
und als Zähler ins Y-Reg.
clear index

.,A647 91 2B    STA ($2B),Y         STADY   TXTTAB          ;CLEAR FIRST LINK.
Nullcode an Programmanfang
clear pointer to next line low byte

.,A649 C8       INY         INY
Zähler erhöhen
increment index

.,A64A 91 2B    STA ($2B),Y         STADY   TXTTAB
noch einen Nullcode dahinter
clear pointer to next line high byte, erase program

.,A64C A5 2B    LDA $2B         LDA     TXTTAB
Zeiger auf Programmst. (LOW)
get start of memory low byte

.,A64E 18       CLC         CLC
Carry löschen
clear carry for add

.,A64F 69 02    ADC #$02         ADCI    2
Programmstart + 2 ergibt
add null program length

.,A651 85 2D    STA $2D         STA     VARTAB          ;SETUP [VARTAB].
neuen Variablenstart (LOW)
set start of variables low byte

.,A653 A5 2C    LDA $2C         LDA     TXTTAB+1
Zeiger auf Programmst. (HIGH)
get start of memory high byte

.,A655 69 00    ADC #$00         ADCI    0
+ Übertrag ergibt neuen
add carry

.,A657 85 2E    STA $2E         STA     VARTAB+1
Variablenstart (HIGH)
set start of variables high byte

reset execute pointer and do CLR



.,A659 20 8E A6 JSR $A68E RUNC:   JSR     STXTPT
CHRGET, Routine neu setzen
set BASIC execute pointer to start of memory - 1
SET TXTPTR TO TXTTAB - 1
.,A65C A9 00    LDA #$00         LDAI    0               ;SET ZERO FLAG
;
; THIS CODE IS FOR THE CLEAR COMMAND.
;
Zero-Flag für CLR = 1 setzen

BASIC-Befehl CLR

set Zb for CLR entry

perform CLR

(THIS COULD HAVE BEEN ".HS 2C")

"CLEAR" STATEMENT

.,A65E D0 2D    BNE $A68D CLEAR:  BNE     STKRTS          ;SYNTAX ERROR IF NO TERMINATOR.
;
; CLEAR INITIALIZES THE VARIABLE AND
; ARRAY SPACE BY RESETING ARYTAB (THE END OF SIMPLE VARIABLE SPACE)
; AND STREND (THE END OF ARRAY STORAGE). IT FALLS INTO "STKINI"
; WHICH RESETS THE STACK.
Kein Trennzeichen: SYNTAX
ERROR
exit if following byte to allow syntax error
IGNORE IF NOT AT END OF STATEMENT
.,A660 20 E7 FF JSR $FFE7 ;
alle I/O Kanäle zurücksetzen
close all channels and files

.,A663 A5 37    LDA $37 CLEARC: LDWD    MEMSIZ          ;FREE UP STRING SPACE.
Zeiger auf BASIC-RAM-Ende
get end of memory low byte
CLEAR STRING AREA
.,A665 A4 38    LDY $38
(LOW/HIGH) laden
get end of memory high byte

.,A667 85 33    STA $33         STWD    FRETOP
String-Start auf BASIC-
set bottom of string space low byte, clear strings

.,A669 84 34    STY $34 IFN     EXTIO,<
        JSR     CQCALL> ;CLOSE ALL OPEN FILES.
RAM-Ende setzen
set bottom of string space high byte

.,A66B A5 2D    LDA $2D         LDWD    VARTAB          ;LIBERATE THE
Zeiger auf Variablen-
get start of variables low byte
CLEAR ARRAY AREA
.,A66D A4 2E    LDY $2E
start laden
get start of variables high byte

.,A66F 85 2F    STA $2F         STWD    ARYTAB          ;VARIABLES AND
und in Array-Anfangs-
set end of variables low byte, clear variables

.,A671 84 30    STY $30
zeiger setzen
set end of variables high byte

.,A673 85 31    STA $31         STWD    STREND          ;ARRAYS.
und in Zeiger auf Array-
set end of arrays low byte, clear arrays
LOW END OF FREE SPACE
.,A675 84 32    STY $32
Ende speichern
set end of arrays high byte

do RESTORE and clear stack


.,A677 20 1D A8 JSR $A81D FLOAD:  JSR     RESTOR          ;RESTORE DATA.
;
; STKINI RESETS THE STACK POINTER ELIMINATING
; GOSUB AND FOR CONTEXT. STRING TEMPORARIES ARE FREED
; UP, SUBFLG IS RESET. CONTINUING IS PROHIBITED.
; AND A DUMMY ENTRY IS LEFT AT THE BOTTOM OF THE STACK SO "FNDFOR" WILL ALWAYS
; FIND A NON-"FOR" ENTRY AT THE BOTTOM OF THE STACK.
;
RESTORE-Befehl
perform RESTORE

flush BASIC stack and clear the continue pointer

SET "DATA" POINTER TO BEGINNING

.,A67A A2 19    LDX #$19 STKINI: LDXI    TEMPST          ;INITIALIZE STRING TEMPORARIES.
Wert laden und String-
get the descriptor stack start

.,A67C 86 16    STX $16         STX     TEMPPT
Descriptor-Index zurücksetzen
set the descriptor stack pointer

.,A67E 68       PLA         PLA                     ;SETUP RETURN ADDRESS.
2 Bytes vom Stapel in das
pull the return address low byte
SAVE RETURN ADDRESS
.,A67F A8       TAY         TAY
Y-Register und den
copy it

.,A680 68       PLA         PLA
Akku holen
pull the return address high byte

.,A681 A2 FA    LDX #$FA         LDXI    STKEND-257
Wert laden und damit
set the cleared stack pointer
START STACK AT $F8,
.,A683 9A       TXS         TXS
Stapelzeiger initialisieren
set the stack
LEAVING ROOM FOR PARSING LINES
.,A684 48       PHA         PHA
2 Bytes aus dem Y-Register
push the return address high byte
RESTORE RETURN ADDRESS
.,A685 98       TYA         TYA
und dem Akku wieder auf
restore the return address low byte

.,A686 48       PHA         PHA
den Stapel schieben
push the return address low byte

.,A687 A9 00    LDA #$00         LDAI    0
Wert laden und damit
clear A

.,A689 85 3E    STA $3E         STA     OLDTXT+1        ;DISALLOWING CONTINUING
CONT sperren
clear the continue pointer high byte

.,A68B 85 10    STA $10         STA     SUBFLG          ;ALLOW SUBSCRIPTS.
und in FN-Flag speichern
clear the subscript/FNX flag

.,A68D 60       RTS STKRTS: RTS

Rücksprung

Programmzeiger auf

BASIC-Start



set BASIC execute pointer to start of memory - 1



SET TXTPTR TO BEGINNING OF PROGRAM

.,A68E 18       CLC STXTPT: CLC
Carry löschen (Addition)
clear carry for add
TXTPTR = TXTTAB - 1
.,A68F A5 2B    LDA $2B         LDA     TXTTAB
Zeiger auf Programmstart (LOW)
get start of memory low byte

.,A691 69 FF    ADC #$FF         ADCI    255
minus 1 ergibt
add -1 low byte

.,A693 85 7A    STA $7A         STA     TXTPTR
neuen CHRGET-Zeiger (LOW)
set BASIC execute pointer low byte

.,A695 A5 2C    LDA $2C         LDA     TXTTAB+1
Programmstart (HIGH)
get start of memory high byte

.,A697 69 FF    ADC #$FF         ADCI    255
minus 1 ergibt
add -1 high byte

.,A699 85 7B    STA $7B         STA     TXTPTR+1        ;SETUP TEXT POINTER.
CHRGET-Zeiger (HIGH)
save BASIC execute pointer high byte

.,A69B 60       RTS         RTS
PAGE

THE "LIST" COMMAND.


Rücksprung

BASIC Befehl LIST



perform LIST



"LIST" STATEMENT

.,A69C 90 06    BCC $A6A4 LIST:   BCC     GOLST           ;IT IS A DIGIT.
Ziffer ? (Zeilennummer)
branch if next character not token (LIST n...)
NO LINE # SPECIFIED
.,A69E F0 04    BEQ $A6A4         BEQ     GOLST           ;IT IS A TERMINATOR.
nur LIST ?
branch if next character [NULL] (LIST)
---DITTO---
.,A6A0 C9 AB    CMP #$AB         CMPI    MINUTK          ;DASH PRECEDING?
Code für '-'?
compare with token for -
IF DASH OR COMMA, START AT LINE 0
.,A6A2 D0 E9    BNE $A68D         BNE     STKRTS          ;NO, SO SYNTAX ERROR.
anderer Code, dann SYNTAX ERR
exit if not - (LIST -m)
LIST [[n][-m]]
this bit sets the n , if present, as the start and end
NO, ERROR
.,A6A4 20 6B A9 JSR $A96B GOLST:  JSR     LINGET          ;GET LINE NUMBER INTO NUMLIN.
Zeilennummer holen
get fixed-point number into temporary integer
CONVERT LINE NUMBER IF ANY
.,A6A7 20 13 A6 JSR $A613         JSR     FNDLIN          ;FIND LINE .GE. [NUMLIN].
Startadresse berechnen
search BASIC for temporary integer line number
POINT LOWTR TO 1ST LINE
.,A6AA 20 79 00 JSR $0079         JSR     CHRGOT          ;GET LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
RANGE SPECIFIED?
.,A6AD F0 0C    BEQ $A6BB         BEQ     LSTEND          ;IF END OF LINE, # IS THE END.
keine Zeilennummer
branch if no more chrs
this bit checks the - is present
NO
.,A6AF C9 AB    CMP #$AB         CMPI    MINUTK          ;DASH?
Code für '-'?
compare with token for -

.,A6B1 D0 8E    BNE $A641         BNE     FLNRTS          ;IF NOT, SYNTAX ERROR.
nein: SYNTAX ERROR
return if not "-" (will be SN error)
LIST [n]-m
the - was there so set m as the end value

.,A6B3 20 73 00 JSR $0073         JSR     CHRGET          ;GET NEXT CHAR.
CHRGET nächstes Zeichen holen
increment and scan memory
GET NEXT CHAR
.,A6B6 20 6B A9 JSR $A96B         JSR     LINGET          ;GET END #.
Zeilennummer holen
get fixed-point number into temporary integer
CONVERT SECOND LINE #
.,A6B9 D0 86    BNE $A641         BNE     FLNRTS          ;IF NOT TERMINATOR, ERROR.
kein Trennzeichen: SYNTAX ERR
exit if not ok
BRANCH IF SYNTAX ERR
.,A6BB 68       PLA LSTEND: PLA
2 Bytes von Stapel holen
dump return address low byte, exit via warm start
POP RETURN ADRESS
.,A6BC 68       PLA         PLA                     ;GET RID OF "NEWSTT" RTS ADDR.
(Rücksprungadresse übergehen)
dump return address high byte
(GET BACK BY "JMP NEWSTT")
.,A6BD A5 14    LDA $14         LDA     LINNUM          ;SEE IF IT WAS EXISTENT.
zweite Zeilennummer laden
get temporary integer low byte
IF NO SECOND NUMBER, USE $FFFF
.,A6BF 05 15    ORA $15         ORA     LINNUM+1
gleich null ?
OR temporary integer high byte

.,A6C1 D0 06    BNE $A6C9         BNE     LIST4           ;IT WAS TYPED.
Nein: $A6C9
branch if start set
THERE WAS A SECOND NUMBER
.,A6C3 A9 FF    LDA #$FF         LDAI    255
Wert laden und
set for -1
MAX END RANGE
.,A6C5 85 14    STA $14         STA     LINNUM
zweite Zeilennummer Maximal-
set temporary integer low byte

.,A6C7 85 15    STA $15         STA     LINNUM+1        ;MAKE IT HUGE.
wert $FFFF (65535)
set temporary integer high byte

.,A6C9 A0 01    LDY #$01 LIST4:  LDYI    1
IFE     REALIO-3,<
Zeiger setzen
set index for line

.,A6CB 84 0F    STY $0F         STY     DORES>
und Quote Modus abschalten
clear open quote flag

.,A6CD B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;IS LINK ZERO?
Linkadresse HIGH holen
get next line pointer high byte
HIGH BYTE OF LINK
.,A6CF F0 43    BEQ $A714         BEQ     GRODY           ;YES, GO TO READY.
IFN     REALIO,<
Ja: dann fertig
if null all done so exit
END OF PROGRAM
.,A6D1 20 2C A8 JSR $A82C         JSR     ISCNTC> ;LISTEN FOR CONT-C.
prüft auf Stop-Taste
do CRTL-C check vector
CHECK IF CONTROL-C HAS BEEN TYPED
.,A6D4 20 D7 AA JSR $AAD7         JSR     CRDO            ;PRINT CRLF TO START WITH.
"CR" ausgeben, neue Zeile
print CR/LF
NO, PRINT <RETURN>
.,A6D7 C8       INY         INY
Zeiger erhöhen
increment index for line

.,A6D8 B1 5F    LDA ($5F),Y         LDADY   LOWTR
Zeilenadresse holen (LOW)
get line number low byte
GET LINE #, COMPARE WITH END RANGE
.,A6DA AA       TAX         TAX
und in das X-Reg. schieben
copy to X

.,A6DB C8       INY         INY
Zeiger erhöhen
increment index

.,A6DC B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;GET LINE NUMBER.
Zeilenadresse holen (HIGH)
get line number high byte

.,A6DE C5 15    CMP $15         CMP     LINNUM+1        ;SEE IF BEYOND LAST.
mit Endnummer vergleichen
compare with temporary integer high byte

.,A6E0 D0 04    BNE $A6E6         BNE     TSTDUN          ;GO DETERMINE RELATION.
Gleich? Nein: $A6E6
branch if no high byte match

.,A6E2 E4 14    CPX $14         CPX     LINNUM          ;WAS EQUAL SO TEST LOW ORDER.
LOW-Nummer vergleichen
compare with temporary integer low byte

.,A6E4 F0 02    BEQ $A6E8         BEQ     TYPLIN          ;EQUAL, SO LIST IT.
Gleich? Ja: $A6E8
branch if = last line to do, < will pass next branch
else
ON LAST LINE OF RANGE
.,A6E6 B0 2C    BCS $A714 TSTDUN: BCS     GRODY           ;IF LINE IS GR THAN LAST, THEN DUNE.
Größer: dann fertig
if greater all done so exit
FINISHED THE RANGE

LIST ONE LINE
.,A6E8 84 49    STY $49 TYPLIN: STY     LSTPNT
Y-Reg. Zwischenspeichern
save index for line

.,A6EA 20 CD BD JSR $BDCD         JSR     LINPRT          ;PRINT AS INT WITHOUT LEADING SPACE.
Zeilennnummer ausgeben
print XA as unsigned integer
PRINT LINE # FROM X,A
.,A6ED A9 20    LDA #$20         LDAI    " "             ;ALWAYS PRINT SPACE AFTER NUMBER.
' ' Leerzeichen
space is the next character
PRINT SPACE AFTER LINE #
.,A6EF A4 49    LDY $49 PRIT4:  LDY     LSTPNT          ;GET POINTER TO LINE BACK.
Y-Reg. wiederholen
get index for line

.,A6F1 29 7F    AND #$7F         ANDI    127
Bit 7 löschen
mask top out bit of character

.,A6F3 20 47 AB JSR $AB47 PLOOP:  JSR     OUTDO           ;PRINT CHAR.
IFE     REALIO-3,<
Zeichen ausgeben
go print the character

.,A6F6 C9 22    CMP #$22         CMPI    34
'"' Hochkomma ?
was it " character

.,A6F8 D0 06    BNE $A700         BNE     PLOOP1
Nein: $A700
if not skip the quote handle
we are either entering or leaving a pair of quotes

.,A6FA A5 0F    LDA $0F         COM     DORES> ;IF QUOTE, COMPLEMENT FLAG.
Hochkomma-Flag laden,
get open quote flag

.,A6FC 49 FF    EOR #$FF
umdrehen (NOT)
toggle it

.,A6FE 85 0F    STA $0F
und wieder abspeichern
save it back

.,A700 C8       INY PLOOP1: INY
Zeilenende nach 255 Zeichen ?
increment index

.,A701 F0 11    BEQ $A714         BEQ     GRODY           ;IF WE HAVE PRINTED 256 CHARACTERS
                                ;THE PROGRAM MUST BE MISFORMATED IN
                                ;MEMORY DUE TO A BAD LOAD OR BAD
                                ;HARDWARE. LET THE GUY RECOVER
Nein: dann aufhören
line too long so just bail out and do a warm start

.,A703 B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;GET NEXT CHAR. IS IT ZERO?
Zeichen holen
get next byte

.,A705 D0 10    BNE $A717         BNE     QPLOP           ;YES. END OF LINE.
kein Zeilenende, dann listen
if not [EOL] (go print character)
was [EOL]
NOT END OF LINE YET
.,A707 A8       TAY         TAY
Akku als Zeiger nach Y
else clear index
END OF LINE
.,A708 B1 5F    LDA ($5F),Y         LDADY   LOWTR
Startadresse der nächsten
get next line pointer low byte
GET LINK TO NEXT LINE
.,A70A AA       TAX         TAX
Zeile holen (LOW) und nach X
copy to X

.,A70B C8       INY         INY
Zeiger erhöhen
increment index

.,A70C B1 5F    LDA ($5F),Y         LDADY   LOWTR
Adresse der Zeile (HIGH)
get next line pointer high byte

.,A70E 86 5F    STX $5F         STX     LOWTR
als Zeiger merken
set pointer to line low byte
POINT TO NEXT LINE
.,A710 85 60    STA $60         STA     LOWTR+1
(speichern nach $5F/60) und
set pointer to line high byte

.,A712 D0 B5    BNE $A6C9         BNE     LIST4           ;BRANCH IF SOMETHING TO LIST.
weitermachen
go do next line if not [EOT]
else ...
BRANCH IF NOT END OF PROGRAM
.,A714 4C 86 E3 JMP $E386 GRODY:  JMP     READY
zum BASIC-Warmstart

BASIC Code in Klartext

umwandlen

do warm start
TO NEXT STATEMENT

.,A717 6C 06 03 JMP ($0306)                                 ;IS IT A TOKEN?
JMP $A71A
do uncrunch BASIC tokens

uncrunch BASIC tokens, the uncrunch BASIC tokens vector is initialised to point here


.,A71A 10 D7    BPL $A6F3 QPLOP:  BPL     PLOOP           ;NO, HEAD FOR PRINTER.
IFE     REALIO-3,<
kein Interpretercode:ausgeben
just go print it if not token byte
else was token byte so uncrunch it
BRANCH IF NOT A TOKEN
.,A71C C9 FF    CMP #$FF         CMPI    PI
Code für Pi?
compare with the token for PI. in this case the token
is the same as the PI character so it just needs printing

.,A71E F0 D3    BEQ $A6F3         BEQ     PLOOP
Ja: so ausgeben
just print it if so

.,A720 24 0F    BIT $0F         BIT     DORES           ;INSIDE QUOTE MARKS?
Hochkommamodus ?
test the open quote flag

.,A722 30 CF    BMI $A6F3         BMI     PLOOP> ;YES, JUST TYPE THE CHARACTER.
dann Zeichen so ausgeben
just go print character if open quote set

.,A724 38       SEC         SEC
Carry setzen (Subtraktion)
else set carry for subtract

.,A725 E9 7F    SBC #$7F         SBCI    127             ;GET RID OF SIGN BIT AND ADD 1.
Offset abziehen
reduce token range to 1 to whatever
CONVERT TOKEN TO INDEX
.,A727 AA       TAX         TAX                     ;MAKE IT A COUNTER.
Code nach X
copy token # to X

.,A728 84 49    STY $49         STY     LSTPNT          ;SAVE POINTER TO LINE.
Zeichenzeiger merken
save index for line
SAVE LINE POINTER
.,A72A A0 FF    LDY #$FF         LDYI    255             ;LOOK AT RES'D WORD LIST.
Zeiger auf Befehlstabelle
start from -1, adjust for pre increment

.,A72C CA       DEX RESRCH: DEX                     ;IS THIS THE RES'D WORD?
erstes Befehlswort?
decrement token #
SKIP KEYWORDS UNTIL REACH THIS ONE
.,A72D F0 08    BEQ $A737         BEQ     PRIT3           ;YES, GO TOSS IT UP..
Ja: ausgeben
if now found go do printing

.,A72F C8       INY RESCR1: INY
Zeiger erhöhen
else increment index

.,A730 B9 9E A0 LDA $A09E,Y         LDA     RESLST,Y,       ;END OF ENTRY?
Offset für X-tes Befehlswort
get byte from keyword table

.,A733 10 FA    BPL $A72F         BPL     RESCR1          ;NO, CONTINUE PASSING.
alle Zeichen bis zum letzen
loop until keyword end marker
NOT AT END OF KEYWORD YET
.,A735 30 F5    BMI $A72C         BMI     RESRCH
überlesen (Bit 7 gesetzt)
go test if this is required keyword, branch always
found keyword, it's the next one
END OF KEYWORD, ALWAYS BRANCHES
.,A737 C8       INY PRIT3:  INY
Zeiger erhöhen
increment keyword table index

.,A738 B9 9E A0 LDA $A09E,Y         LDA     RESLST,Y
Befehlswort aus Tabelle holen
get byte from table

.,A73B 30 B2    BMI $A6EF         BMI     PRIT4           ;END OF RESERVED WORD.
letzter Buchstabe: fertig
go restore index, mask byte and print if
byte was end marker
LAST CHAR OF KEYWORD
.,A73D 20 47 AB JSR $AB47         JSR     OUTDO           ;PRINT IT.
Zeichen ausgeben
else go print the character

.,A740 D0 F5    BNE $A737         BNE     PRIT3           ;END OF ENTRY? NO, TYPE REST.
PAGE

THE "FOR" STATEMENT.

;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
; TOKEN (FORTK) 1 BYTE
; A POINTER TO THE LOOP VARIABLE 2 BYTES
; THE STEP 4+ADDPRC BYTES
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
; THE UPPER VALUE 4+ADDPRC BYTES
; THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;

nächsten Buchstaben ausgeben

BASIC-Befehl FOR

go get next character, branch always

perform FOR

...ALWAYS

"FOR" STATEMENT

FOR PUSHES 18 BYTES ON THE STACK:
2 -- TXTPTR
2 -- LINE NUMBER
5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
1 -- STEP SIGN
5 -- STEP VALUE
2 -- ADDRESS OF FOR VARIABLE IN VARTAB
1 -- FOR TOKEN ($81)
.,A742 A9 80    LDA #$80 FOR:    LDAI    128             ;DON'T RECOGNIZE
Wert laden und
set FNX

.,A744 85 10    STA $10         STA     SUBFLG          ;SUBSCRIPTED VARIABLES.
Integer sperren
set subscript/FNX flag
SUBSCRIPTS NOT ALLOWED
.,A746 20 A5 A9 JSR $A9A5         JSR     LET             ;READ THE VARIABLE AND ASSIGN IT
                                ;THE CORRECT INITIAL VALUE AND STORE
                                ;A POINTER TO THE VARIABLE IN VARPNT.
LET, setzt FOR-Variable
perform LET
DO <VAR> = <EXP>, STORE ADDR IN FORPNT
.,A749 20 8A A3 JSR $A38A         JSR     FNDFOR          ;PNTR IS IN VARPNT, AND FORPNT.
sucht offene FOR-NEXT-Schlei.
search the stack for FOR or GOSUB activity
IS THIS FOR VARIABLE ACTIVE?
.,A74C D0 05    BNE $A753         BNE     NOTOL           ;IF NO MATCH, DON'T ELIMINATE ANYTHING.
nicht gefunden: $A753
branch if FOR, this variable, not found
FOR, this variable, was found so first we dump the old one
NO
.,A74E 8A       TXA         TXA                     ;MAKE IT ARITHMETICAL.
X-Reg. nach Akku
copy index
YES, CANCEL IT AND ENCLOSED LOOPS
.,A74F 69 0F    ADC #$0F         ADCI    FORSIZ-3        ;ELIMINATE ALMOST ALL.
Stapelzejger erhöhen
add FOR structure size-2
CARRY=1, THIS ADDS 16
.,A751 AA       TAX         TAX                     ;NOTE C=1, THEN PLA, PLA.
Akku zurück nach X-Reg. und
copy to index
X WAS ALREADY S+2
.,A752 9A       TXS         TXS                     ;MANIFEST.
in den Stapelzeiger
set stack (dump FOR structure (-2 bytes))

.,A753 68       PLA NOTOL:  PLA                     ;GET RID OF NEWSTT RETURN ADDRESS
Rücksprungadresse vom Stapel
pull return address
POP RETURN ADDRESS TOO
.,A754 68       PLA         PLA                     ;IN CASE THIS IS A TOTALLY NEW ENTRY.
holen (LOW und HIGH)
pull return address

.,A755 A9 09    LDA #$09         LDAI    8+ADDPRC
Wert für Prüfung laden
we need 18d bytes !
BE CERTAIN ENOUGH ROOM IN STACK
.,A757 20 FB A3 JSR $A3FB         JSR     GETSTK          ;MAKE SURE 16 BYTES ARE AVAILABLE.
prüft auf Platz im Stapel
check room on stack for 2*A bytes

.,A75A 20 06 A9 JSR $A906         JSR     DATAN           ;GET A COUNT IN [Y] OF THE NUMBER OF
                                ;CHACRACTERS LEFT IN THE "FOR" STATEMENT
                                ;[TXTPTR] IS UNAFFECTED.
sucht nächstes BAS.-Statement
scan for next BASIC statement ([:] or [EOL])
SCAN AHEAD TO NEXT STATEMENT
.,A75D 18       CLC         CLC                     ;PREP TO ADD.
Carry löschen (Addition)
clear carry for add
PUSH STATEMENT ADDRESS ON STACK
.,A75E 98       TYA         TYA                     ;SAVE IT FOR PUSHING.
CHRGET-Zeiger und Offset
copy index to A

.,A75F 65 7A    ADC $7A         ADC     TXTPTR
= Startadresse der Schleife
add BASIC execute pointer low byte

.,A761 48       PHA         PHA
auf Stapel speichern
push onto stack

.,A762 A5 7B    LDA $7B         LDA     TXTPTR+1
HIGH-Byte holen und
get BASIC execute pointer high byte

.,A764 69 00    ADC #$00         ADCI    0
Übertrag addieren und
add carry

.,A766 48       PHA         PHA
auf den Stapel legen
push onto stack

.,A767 A5 3A    LDA $3A         PSHWD   CURLIN          ;PUT LINE NUMBER ON STACK.
Aktuelle
get current line number high byte
PUSH LINE NUMBER ON STACK
.,A769 48       PHA
Zeilennummer laden und auf
push onto stack

.,A76A A5 39    LDA $39
den Stapel schieben
get current line number low byte

.,A76C 48       PHA
(LOW und HIGH-Byte)
push onto stack

.,A76D A9 A4    LDA #$A4         SYNCHK  TOTK            ;"TO" IS NECESSARY.
'TO' - Code
set "TO" token

.,A76F 20 FF AE JSR $AEFF
prüft auf Code
scan for CHR$(A), else do syntax error then warm start
REQUIRE "TO"
.,A772 20 8D AD JSR $AD8D         JSR     CHKNUM          ;VALUE MUST BE A NUMBER.
prüft ob numerische Variable
check if source is numeric, else do type mismatch
<VAR> = <EXP> MUST BE NUMERIC
.,A775 20 8A AD JSR $AD8A         JSR     FRMNUM          ;GET UPPER VALUE INTO FAC.
numerischer Ausdruck nach FAC
evaluate expression and check is numeric, else do
type mismatch
GET FINAL VALUE, MUST BE NUMERIC
.,A778 A5 66    LDA $66         LDA     FACSGN          ;PACK FAC.
Vorzeichenbyte von FAC holen
get FAC1 sign (b7)
PUT SIGN INTO VALUE IN FAC
.,A77A 09 7F    ORA #$7F         ORAI    127
Bit 0 bis 6 setzen
set all non sign bits

.,A77C 25 62    AND $62         AND     FACHO
mit $62 angleichen
and FAC1 mantissa 1

.,A77E 85 62    STA $62         STA     FACHO           ;SET PACKED SIGN BIT.
und abspeichern
save FAC1 mantissa 1

.,A780 A9 8B    LDA #$8B         LDWDI   LDFONE
Rücksprungadresse laden
set return address low byte
SET UP FOR RETURN
.,A782 A0 A7    LDY #$A7
(LOW und HIGH)
set return address high byte
TO STEP
.,A784 85 22    STA $22         STWD    INDEX1
und Zwischenspeichern
save return address low byte

.,A786 84 23    STY $23
(LOW und HIGH)
save return address high byte

.,A788 4C 43 AE JMP $AE43         JMP     FORPSH          ;PUT FAC ONTO STACK, PACKED.
Schleifenendwert auf Stapel
round FAC1 and put on stack, returns to next instruction
RETURNS BY "JMP (INDEX)"

"STEP" PHRASE OF "FOR" STATEMENT

.,A78B A9 BC    LDA #$BC LDFONE: LDWDI   FONE            ;PUT 1.0 INTO FAC.
Zeiger auf Konstante 1 setzen
set 1 pointer low address, default step size
STEP DEFAULT=1
.,A78D A0 B9    LDY #$B9
(Ersatzwert für STEP)
set 1 pointer high address

.,A78F 20 A2 BB JSR $BBA2         JSR     MOVFM
als Default-STEP-Wert in FAC
unpack memory (AY) into FAC1

.,A792 20 79 00 JSR $0079         JSR     CHRGOT
CHRGOT: letztes Zeichen holen
scan memory

.,A795 C9 A9    CMP #$A9         CMPI    STEPTK          ;A STEP IS GIVEN?
'STEP' - Code?
compare with STEP token

.,A797 D0 06    BNE $A79F         BNE     ONEON           ;NO. ASSUME 1.0.
kein STEP-Wert: $A79F
if not "STEP" continue
was step so ....
USE DEFAULT VALUE OF 1.0
.,A799 20 73 00 JSR $0073         JSR     CHRGET          ;YES. ADVANCE POINTER.
CHRGET nächstes Zeichen holen
increment and scan memory
STEP SPECIFIED, GET IT
.,A79C 20 8A AD JSR $AD8A         JSR     FRMNUM          ;READ THE STEP.
numerischer Ausdruck nach FAC
evaluate expression and check is numeric, else do
type mismatch

.,A79F 20 2B BC JSR $BC2B ONEON:  JSR     SIGN            ;GET SIGN IN ACCA.
holt Vorzeichenbyte
get FAC1 sign, return A = $FF -ve, A = $01 +ve

.,A7A2 20 38 AE JSR $AE38         JSR     PUSHF           ;PUSH FAC ONTO STACK (THRU A).
Vorz. und STEP-Wert auf Stack
push sign, round FAC1 and put on stack

.,A7A5 A5 4A    LDA $4A         PSHWD   FORPNT          ;PUT PNTR TO VARIABLE ON STACK.
Zeiger auf Variablenwert
get FOR/NEXT variable pointer high byte

.,A7A7 48       PHA
(LOW) auf den Stapel
push on stack

.,A7A8 A5 49    LDA $49
Zeiger (HIGH)
get FOR/NEXT variable pointer low byte

.,A7AA 48       PHA
auf den Stapel
push on stack

.,A7AB A9 81    LDA #$81 NXTCON: LDAI    FORTK           ;PUT A FORTK ONTO STACK.
und FOR-Code
get FOR token

.,A7AD 48       PHA         PHA
; BNEA NEWSTT ;SIMULATE BNE TO NEWSTT. JUST FALL IN.
PAGE

NEW STATEMENT FETCHER.

;
; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY TXTPTR
; IS ":" OR END-OF-LINE. THE ADDRESS OF THIS LOC IS LEFT
; ON THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
; IT CAN MERELY DO A RTS WHEN IT IS DONE.
;
NEWSTT: IFN     REALIO,<
auf den Stapel legen

Interpreterschleife

push on stack

interpreter inner loop



PERFORM NEXT STATEMENT

.,A7AE 20 2C A8 JSR $A82C         JSR     ISCNTC> ;LISTEN FOR CONTROL-C.
prüft auf Stop-Taste
do CRTL-C check vector
SEE IF CONTROL-C HAS BEEN TYPED
.,A7B1 A5 7A    LDA $7A         LDWD    TXTPTR          ;LOOK AT CURRENT CHARACTER.
CHRGET Zeiger (LOW und HIGH)
get the BASIC execute pointer low byte
NO, KEEP EXECUTING
.,A7B3 A4 7B    LDY $7B
IFN     BUFPAG,<
laden
get the BASIC execute pointer high byte

.,A7B5 C0 02    CPY #$02         CPYI    BUFPAG> ;SEE IF IT WAS DIRECT BY CHECK FOR BUF'S PAGE NUMBER
Direkt-Modus?
compare the high byte with $02xx

.,A7B7 EA       NOP
No OPeration
unused byte

.,A7B8 F0 04    BEQ $A7BE         BEQ     DIRCON
ja: $A7BE
if immediate mode skip the continue pointer save
IN DIRECT MODE
.,A7BA 85 3D    STA $3D         STWD    OLDTXT          ;SAVE IN CASE OF RESTART BY INPUT.
als Zeiger für CONT
save the continue pointer low byte
IN RUNNING MODE
.,A7BC 84 3E    STY $3E
IFN     BUFPAG,<DIRCON:>
merken
save the continue pointer high byte

.,A7BE A0 00    LDY #$00         LDYI    0
IFE     BUFPAG,<DIRCON:>
Zeiger setzen
clear the index

.,A7C0 B1 7A    LDA ($7A),Y         LDADY   TXTPTR
laufendes Zeichen holen
get a BASIC byte
END OF LINE YET?
.,A7C2 D0 43    BNE $A807         BNE     MORSTS          ;NOT NULL -- CHECK WHAT IT IS
nicht Zeilenende?
if not [EOL] go test for ":"
NO
.,A7C4 A0 02    LDY #$02         LDYI    2               ;LOOK AT LINK.
Zeiger neu setzen
else set the index
YES, SEE IF END OF PROGRAM
.,A7C6 B1 7A    LDA ($7A),Y         LDADY   TXTPTR          ;IS LINK 0?
Programmende?
get next line pointer high byte

.,A7C8 18       CLC         CLC             ;CLEAR CARRY FOR ENDCON AND MATH THAT FOLLOWS
Flag für END setzen
clear carry for no "BREAK" message

.,A7C9 D0 03    BNE $A7CE         JEQ     ENDCON          ;YES - RAN OFF THE END.
Kein Programmende: $A7CE
branch if not end of program

.,A7CB 4C 4B A8 JMP $A84B
ja: dann END ausführen
else go to immediate mode,was immediate or [EOT] marker
YES, END OF PROGRAM
.,A7CE C8       INY         INY                     ;PUT LINE NUMBER IN CURLIN.
Zeiger erhöhen
increment index

.,A7CF B1 7A    LDA ($7A),Y         LDADY   TXTPTR
laufende Zeilennummer
get line number low byte
GET LINE # OF NEXT LINE
.,A7D1 85 39    STA $39         STA     CURLIN
(LOW) nach $39
save current line number low byte

.,A7D3 C8       INY         INY
Zeiger auf nächstes Byte
increment index

.,A7D4 B1 7A    LDA ($7A),Y         LDADY   TXTPTR
laufende Zeilennummer
get line # high byte

.,A7D6 85 3A    STA $3A         STA     CURLIN+1
(HIGH) nach $3A
save current line number high byte

.,A7D8 98       TYA         TYA
Zeiger nach Akku
A now = 4
ADJUST TXTPTR TO START
.,A7D9 65 7A    ADC $7A         ADC     TXTPTR
Programmzeiger auf
add BASIC execute pointer low byte, now points to code
OF NEW LINE
.,A7DB 85 7A    STA $7A         STA     TXTPTR
Programmzeile setzen
save BASIC execute pointer low byte

.,A7DD 90 02    BCC $A7E1         BCC     GONE
C=0: Erhöhung umgehen
branch if no overflow

.,A7DF E6 7B    INC $7B         INC     TXTPTR+1
Programmzeiger (HIGH) erhöhen
else increment BASIC execute pointer high byte


.,A7E1 6C 08 03 JMP ($0308)
Statement ausführen
do start new BASIC code

start new BASIC code, the start new BASIC code vector is initialised to point here


.,A7E4 20 73 00 JSR $0073 GONE:   JSR     CHRGET          ;GET THE STATEMENT TYPE.
CHRGET nächstes Zeichen holen
increment and scan memory
GET FIRST CHR OF STATEMENT
.,A7E7 20 ED A7 JSR $A7ED         JSR     GONE3
Statement ausführen
go interpret BASIC code from BASIC execute pointer
AND START PROCESSING
.,A7EA 4C AE A7 JMP $A7AE         JMP     NEWSTT
zurück zur Interpreterschlei.

BASIC-Statement ausführen

loop

go interpret BASIC code from BASIC execute pointer

BACK FOR MORE

EXECUTE A STATEMENT

(A) IS FIRST CHAR OF STATEMENT
CARRY IS SET
.,A7ED F0 3C    BEQ $A82B GONE3:  BEQ     ISCRTS          ;IF TERMINATOR, TRY AGAIN.
                                ;NO NEED TO SET UP CARRY SINCE IT WILL
                                ;BE ON IF NON-NUMERIC AND NUMERICS
                                ;WILL CAUSE A SYNTAX ERROR LIKE THEY SHOULD
Zeilenende, dann fertig
if the first byte is null just exit
END OF LINE, NULL STATEMENT
.,A7EF E9 80    SBC #$80 GONE2:  SBCI    ENDTK           ;" ON ... GOTO AND GOSUB" COME HERE.
Token?
normalise the token
FIRST CHAR A TOKEN?
.,A7F1 90 11    BCC $A804         BCC     GLET
nein: dann zum LET-Befehl
if wasn't token go do LET
NOT TOKEN, MUST BE "LET"
.,A7F3 C9 23    CMP #$23         CMPI    SCRATK-ENDTK+1
NEW?
compare with token for TAB(-$80
STATEMENT-TYPE TOKEN?
.,A7F5 B0 17    BCS $A80E         BCS     SNERRX          ;SOME RES'D WORD BUT NOT
                                ;A STATEMENT RES'D WORD.
Funktions-Token oder GO TO
branch if >= TAB(
NO, SYNTAX ERROR
.,A7F7 0A       ASL         ASL     A,              ;MULTIPLY BY TWO.
BASIC-Befehl, Code mal 2
*2 bytes per vector
DOUBLE TO GET INDEX
.,A7F8 A8       TAY         TAY                     ;MAKE AN INDEX.
als Zeiger ins Y-Reg.
copy to index
INTO ADDRESS TABLE
.,A7F9 B9 0D A0 LDA $A00D,Y         LDA     STMDSP+1,Y
Befehlsadresse (LOW und
get vector high byte

.,A7FC 48       PHA         PHA
HIGH) aus Tabelle
push on stack
PUT ADDRESS ON STACK
.,A7FD B9 0C A0 LDA $A00C,Y         LDA     STMDSP,Y
holen und als
get vector low byte

.,A800 48       PHA         PHA                     ;PUT DISP ADDR ONTO STACK.
Rücksprungadresse auf Stapel
push on stack

.,A801 4C 73 00 JMP $0073         JMP     CHRGET
Zeichen und Befehl ausführen
increment and scan memory and return. the return in
this case calls the command code, the return from
that will eventually return to the interpreter inner
loop above
GET NEXT CHR &amp; RTS TO ROUTINE

.,A804 4C A5 A9 JMP $A9A5 GLET:   JMP     LET             ;MUST BE A LET
zum LET-Befehl
perform LET
was not [EOL]
MUST BE <VAR> = <EXP>

.,A807 C9 3A    CMP #$3A MORSTS: CMPI    ":"
':' ist es Doppelpunkt?
comapre with ":"

.,A809 F0 D6    BEQ $A7E1         BEQ     GONE            ;IF A ":" CONTINUE STATEMENT
ja: $A7E1
if ":" go execute new code
else ...

.,A80B 4C 08 AF JMP $AF08 SNERR1: JMP     SNERR           ;NEITHER 0 OR ":" SO SYNTAX ERROR
sonst 'SYNTAX ERROR'

prüft auf 'GO' 'TO' Code

do syntax error then warm start
token was >= TAB(


.,A80E C9 4B    CMP #$4B SNERRX: CMPI    GOTK-ENDTK
'GO' (minus $80)
compare with the token for GO

.,A810 D0 F9    BNE $A80B         BNE     SNERR1
nein: 'SYNTAX ERROR'
if not "GO" do syntax error then warm start
else was "GO"

.,A812 20 73 00 JSR $0073         JSR     CHRGET          ;READ IN THE CHARACTER AFTER "GO "
nächstes Zeichen holen
increment and scan memory

.,A815 A9 A4    LDA #$A4         SYNCHK  TOTK
'TO'
set "TO" token

.,A817 20 FF AE JSR $AEFF
prüft auf Code
scan for CHR$(A), else do syntax error then warm start

.,A81A 4C A0 A8 JMP $A8A0         JMP     GOTO
PAGE

RESTORE,STOP,END,CONTINUE,NULL,CLEAR.


zum GOTO-Befehl

BASIC-Befehl RESTORE

perform GOTO

perform RESTORE



"RESTORE" STATEMENT

.,A81D 38       SEC RESTOR: SEC
Carry setzen (Subtraktion)
set carry for subtract
SET DATPTR TO BEGINNING OF PROGRAM
.,A81E A5 2B    LDA $2B         LDA     TXTTAB
Programmstartzeiger (LOW)
get start of memory low byte

.,A820 E9 01    SBC #$01         SBCI    1
laden und davon 1 abziehen
-1

.,A822 A4 2C    LDY $2C         LDY     TXTTAB+1
und HIGH-Byte holen
get start of memory high byte

.,A824 B0 01    BCS $A827         BCS     RESFIN

if no rollunder

.,A826 88       DEY         DEY
LOW-Byte -1
else decrement high byte


SET DATPTR TO Y,A
.,A827 85 41    STA $41 RESFIN: STWD    DATPTR          ;READ FINISHES COME TO "RESFIN".
als DATA-Zeiger
set DATA pointer low byte

.,A829 84 42    STY $42
abspeichern
set DATA pointer high byte

.,A82B 60       RTS ISCRTS: RTS

IFE     REALIO-1,<
ISCNTC: LDAI    1
        BIT     ^O13500
        BMI     ISCRTS
        LDXI    8
        LDAI    3
        CMPI    3>
IFE     REALIO-2,<
ISCNTC: LDA     ^O176000
        REPEAT  4,<NOP>
        LSR     A,
        BCC     ISCRTS
        JSR     INCHR           ;EAT CHAR THAT WAS TYPED
        CMPI    3> ;WAS IT A CONTROL-C??

IFE     REALIO-4,<
ISCNTC: LDA     ^O140000        ;CHECK THE CHARACTER
        CMPI    ^O203
        BEQ     ISCCAP
        RTS
ISCCAP: JSR     INCHR
Rücksprung

prüft auf Stop-Taste



do CRTL-C check vector



SEE IF CONTROL-C TYPED

.,A82C 20 E1 FF JSR $FFE1         CMPI    ^O203>
Stop-Taste abfragen

BASIC-Befehl STOP

scan stop key

perform STOP



"STOP" STATEMENT

.,A82F B0 01    BCS $A832 STOP:   BCS     STOPC           ;MAKE [C] NONZERO AS A FLAG.
C=1: Flag für STOP

BASIC-Befehl END

if carry set do BREAK instead of just END

perform END

CARRY=1 TO FORCE PRINTING "BREAK AT.."

"END" STATEMENT

.,A831 18       CLC END:    CLC
C=0 Flag für END
clear carry
CARRY=0 TO AVOID PRINTING MESSAGE
.,A832 D0 3C    BNE $A870 STOPC:  BNE     CONTRT          ;RETURN IF NOT CONT-C OR
                                ;IF NO TERMINATOR FOR STOP OR END.
                                ;[C]=0 SO WILL NOT PRINT "BREAK".
RUN/STOP nicht gedrückt: RTS
return if wasn't CTRL-C
IF NOT END OF STATEMENT, DO NOTHING
.,A834 A5 7A    LDA $7A         LDWD    TXTPTR
Programmzeiger laden
get BASIC execute pointer low byte

.,A836 A4 7B    LDY $7B IFN     BUFPAG,<
(LOW und HIGH-Byte)
get BASIC execute pointer high byte

.,A838 A6 3A    LDX $3A         LDX     CURLIN+1
Direkt-Modus?
get current line number high byte

.,A83A E8       INX         INX>
(Zeilennummer -1)
increment it
RUNNING?
.,A83B F0 0C    BEQ $A849         BEQ     DIRIS
ja: $A849
branch if was immediate mode
NO, DIRECT MODE
.,A83D 85 3D    STA $3D         STWD    OLDTXT
als Zeiger für CONT setzen
save continue pointer low byte

.,A83F 84 3E    STY $3E
(LOW und HIGH)
save continue pointer high byte

.,A841 A5 39    LDA $39 STPEND: LDWD    CURLIN
Nummer der laufenden Zeile
get current line number low byte

.,A843 A4 3A    LDY $3A
holen (LOW und HIGH)
get current line number high byte

.,A845 85 3B    STA $3B         STWD    OLDLIN
und als Zeilennummer für
save break line number low byte

.,A847 84 3C    STY $3C
CONT merken
save break line number high byte

.,A849 68       PLA DIRIS:  PLA                     ;POP OFF NEWSTT ADDR.
Rücksprungadresse
dump return address low byte

.,A84A 68       PLA         PLA
vom Stapel entfernen
dump return address high byte

.,A84B A9 81    LDA #$81 ENDCON: LDWDI   BRKTXT
Zeiger auf Startadresse
set [CR][LF]"BREAK" pointer low byte
" BREAK" AND BELL
.,A84D A0 A3    LDY #$A3 IFN     REALIO,<
        LDXI    0
        STX     CNTWFL>
BREAK setzen
set [CR][LF]"BREAK" pointer high byte

.,A84F 90 03    BCC $A854         BCC     GORDY           ;CARRY CLEAR SO DON'T PRINT "BREAK".
END Flag?
if was program end skip the print string

.,A851 4C 69 A4 JMP $A469         JMP     ERRFIN
nein: 'BREAK IN XXX' ausgeben
print string and do warm start

.,A854 4C 86 E3 JMP $E386 GORDY:  JMP     READY           ;TYPE "READY".

IFE     REALIO,<
DDT:    PLA                     ;GET RID OF NEWSTT RETURN.
        PLA
        HRRZ    14,.JBDDT##
        JRST    0(14)>
zum BASIC-Warmstart

BASIC-Befehl CONT

do warm start

perform CONT



"CONT" COMMAND

.,A857 D0 17    BNE $A870 CONT:   BNE     CONTRT          ;MAKE SURE THERE IS A TERMINATOR.
Kein Trennzeichen: SYNTAX ERR
exit if following byte to allow syntax error
IF NOT END OF STATEMENT, DO NOTHING
.,A859 A2 1A    LDX #$1A         LDXI    ERRCN           ;CONTINUE ERROR.
Fehlernr. für 'CAN'T CONTINUE
error code $1A, can't continue error

.,A85B A4 3E    LDY $3E         LDY     OLDTXT+1        ;A STORED TXTPTR OF ZERO IS SETUP
                                ;BY STKINI AND INDICATES THERE IS
                                ;NOTHING TO CONTINUE.
CONT gesperrt?
get continue pointer high byte
MEANINGFUL RE-ENTRY?
.,A85D D0 03    BNE $A862         JEQ     ERROR           ;"STOP", "END", TYPING CRLF TO
nein: $A862
go do continue if we can
YES
.,A85F 4C 37 A4 JMP $A437                                 ;"INPUT" AND ^C SETUP OLDTXT.
Fehlermeldung ausgeben
else do error #X then warm start
we can continue so ...
NO
.,A862 A5 3D    LDA $3D         LDA     OLDTXT
CONT-Zeiger (LOW) laden
get continue pointer low byte
RESTORE TXTPTR
.,A864 85 7A    STA $7A         STWD    TXTPTR
und CONT-Zeiger als Programm-
save BASIC execute pointer low byte

.,A866 84 7B    STY $7B
zeiger abspeichern
save BASIC execute pointer high byte

.,A868 A5 3B    LDA $3B         LDWD    OLDLIN
und
get break line low byte
RESTORE LINE NUMBER
.,A86A A4 3C    LDY $3C
Zeilennummer wieder
get break line high byte

.,A86C 85 39    STA $39         STWD    CURLIN
setzen
set current line number low byte

.,A86E 84 3A    STY $3A
(LOW- und HIGH-Byte)
set current line number high byte

.,A870 60       RTS CONTRT: RTS                     ;RETURN TO CALLER.

IFN     NULCMD,<
NULL:   JSR     GETBYT
        BNE     CONTRT          ;MAKE SURE THERE IS TERMINATOR.
        INX
        CPXI    240             ;IS THE NUMBER REASONABLE?
        BCS     FCERR1          ;"FUNCTION CALL" ERROR.
        DEX                     ;BACK -1
        STX     NULCNT
        RTS
FCERR1: JMP     FCERR>
PAGE

LOAD AND SAVE SUBROUTINES.


IFE     REALIO-1,< ;KIM CASSETTE I/O
SAVE:   TSX                     ;SAVE STACK POINTER
        STX     INPFLG
        LDAI    STKEND-256-200
        STA     ^O362           ;SETUP DUMMY STACK FOR KIM MONITOR
        LDAI    254             ;MAKE ID BYTE EQUAL TO FF HEX
        STA     ^O13771         ;STORE INTO KIM ID
        LDWD    TXTTAB          ;START DUMPING FROM TXTTAB
        STWD    ^O13765         ;SETUP SAL,SAH
        LDWD    VARTAB          ;STOP AT VARTAB
        STWD    ^O13767         ;SETUP EAL,EAH
        JMP     ^O14000
RETSAV: LDX     INPFLG          ;RESORE THE REAL STACK POINTER
        TXS
        LDWDI   TAPMES          ;SAY IT WAS DONE
        JMP     STROUT
GLOAD:  DT"LOADED"
        0
TAPMES: DT"SAVED"
        ACRLF
        0
PATSAV: BLOCK 20
LOAD:   LDWD    TXTTAB          ;START DUMPING IN AT TXTTAB
        STWD    ^O13765         ;SETUP SAL,SAH
        LDAI    255
        STA     ^O13771
        LDWDI   RTLOAD
        STWD    ^O1             ;SET UP RETURN ADDRESS FOR LOAD
        JMP     ^O14163         ;GO READ THE DATA IN
RTLOAD: LDXI    STKEND-256              ;RESET THE STACK
        TXS
        LDWDI   READY
        STWD    ^O1
        LDWDI   GLOAD           ;TELL HIM IT WORKED
        JSR     STROUT
        LDXY    ^O13755         ;GET LAST LOCATION
        TXA                     ;ITS ONE TOO BIG
        BNE     DECVRT          ;DECREMENT [X,Y]
        NOP
DECVRT: NOP
        STXY    VARTAB          ;SETUP NEW VARIABLE LOCATION
        JMP     FINI> ;RELINK THE PROGRAM
IFE     REALIO-4,<
SAVE:   SEC                     ;CALCLUATE PROGRAM SIZE IN POKER
        LDA     VARTAB
        SBC     TXTTAB
        STA     POKER
        LDA     VARTAB+1
        SBC     TXTTAB+1
        STA     POKER+1
        JSR     VARTIO
        JSR     CQCOUT          ;WRITE PROGRAM SIZE [POKER]
        JSR     PROGIO
        JMP     CQCOUT          ;WRITE PROGRAM.

LOAD:   JSR     VARTIO
        JSR     CQCSIN          ;READ SIZE OF PROGRAM INTO POKER
        CLC
        LDA     TXTTAB          ;CALCULATE VARTAB FROM SIZE AND
        ADC     POKER           ;TXTTAB
        STA     VARTAB
        LDA     TXTTAB+1
        ADC     POKER+1
        STA     VARTAB+1
        JSR     PROGIO
        JSR     CQCSIN          ;READ PROGRAM.
        LDWDI   TPDONE
        JSR     STROUT
        JMP     FINI

TPDONE: DT"LOADED"
        0

VARTIO: LDWDI   POKER
        STWD    ^O74
        LDAI    POKER+2
        STWD    ^O76
        RTS
PROGIO: LDWD    TXTTAB
        STWD    ^O74
        LDWD    VARTAB
        STWD    ^O76
        RTS>

PAGE

RUN,GOTO,GOSUB,RETURN.

Rücksprung

BASIC-Befehl RUN



perform RUN



"RUN" COMMAND

.,A871 08       PHP
Statusregister retten
save status
SAVE STATUS WHILE SUBTRACTING
.,A872 A9 00    LDA #$00
Wert laden und
no control or kernal messages

.,A874 20 90 FF JSR $FF90
Flag für Programmodus setzen
control kernal messages

.,A877 28       PLP
Statusregister zurückholen
restore status
GET STATUS AGAIN (FROM CHRGET)
.,A878 D0 03    BNE $A87D RUN:    JEQ     RUNC            ;IF NO LINE # ARGUMENT.
weitere Zeichen (Zeilennr.)?
branch if RUN n
PROBABLY A LINE NUMBER
.,A87A 4C 59 A6 JMP $A659
Programmzeiger setzen, CLR
reset execution to start, clear variables, flush stack
and return
START AT BEGINNING OF PROGRAM
.,A87D 20 60 A6 JSR $A660         JSR     CLEARC          ;CLEAN UP -- RESET THE STACK.
CLR-Befehl
go do "CLEAR"
CLEAR VARIABLES
.,A880 4C 97 A8 JMP $A897         JMP     RUNC2           ;MUST REPLACE RTS ADDR.
;
; A GOSUB ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS:
; THE GOSUTK ONE BYTE
; THE LINE NUMBER OF THE GOSUB STATEMENT TWO BYTES
; A POINTER INTO THE TEXT OF THE GOSUB TWO BYTES
;
; HIGH ADDRESS.
;
; TOTAL FIVE BYTES.
;
GOTO-Befehl

BASIC-Befehl GOSUB

get n and do GOTO n

perform GOSUB

JOIN GOSUB STATEMENT

"GOSUB" STATEMENT

LEAVES 7 BYTES ON STACK:
2 -- RETURN ADDRESS (NEWSTT)
2 -- TXTPTR
2 -- LINE #
1 -- GOSUB TOKEN ($B0)
.,A883 A9 03    LDA #$03 GOSUB:  LDAI    3
Wert für Prüfung
need 6 bytes for GOSUB
BE SURE ENOUGH ROOM ON STACK
.,A885 20 FB A3 JSR $A3FB         JSR     GETSTK          ;MAKE SURE THERE IS ROOM.
prüft auf Platz im Stapel
check room on stack for 2*A bytes

.,A888 A5 7B    LDA $7B         PSHWD   TXTPTR          ;PUSH ON THE TEXT POINTER.
Programmzeiger (LOW-
get BASIC execute pointer high byte

.,A88A 48       PHA
und HIGH-Byte) laden
save it

.,A88B A5 7A    LDA $7A
und auf den
get BASIC execute pointer low byte

.,A88D 48       PHA
Stapel retten
save it

.,A88E A5 3A    LDA $3A         PSHWD   CURLIN          ;PUSH ON THE CURRENT LINE NUMBER.
Zeilennummer laden (HIGH)
get current line number high byte

.,A890 48       PHA
und auf den Stapel legen
save it

.,A891 A5 39    LDA $39
Zeilennummer LOW laden
get current line number low byte

.,A893 48       PHA
und auf den Stapel legen
save it

.,A894 A9 8D    LDA #$8D         LDAI    GOSUTK
'GOSUB'-Code laden
token for GOSUB

.,A896 48       PHA         PHA                     ;PUSH ON A GOSUB TOKEN.
und auf den Stapel legen
save it

.,A897 20 79 00 JSR $0079 RUNC2:  JSR     CHRGOT          ;GET CHARACTER AND SET CODES FOR LINGET.
CHRGOT: letztes Zeichen holen
scan memory

.,A89A 20 A0 A8 JSR $A8A0         JSR     GOTO            ;USE RTS SCHEME TO "NEWSTT".
GOTO-Befehl
perform GOTO

.,A89D 4C AE A7 JMP $A7AE         JMP     NEWSTT

zur Interpreterschleife

BASIC-Befehl GOTO

go do interpreter inner loop

perform GOTO



"GOTO" STATEMENT

ALSO USED BY "RUN" AND "GOSUB"
.,A8A0 20 6B A9 JSR $A96B GOTO:   JSR     LINGET          ;PICK UP THE LINE NUMBER IN "LINNUM".
Zeilennummer nach $14/$15
get fixed-point number into temporary integer
GET GOTO LINE
.,A8A3 20 09 A9 JSR $A909         JSR     REMN            ;SKIP TO END OF LINE.
nächsten Zeilenanfang suchen
scan for next BASIC line
POINT Y TO EOL
.,A8A6 38       SEC
Carry löschen (Subtraktion)
set carry for subtract

.,A8A7 A5 39    LDA $39
aktuelle Zeilennummer (LOW)
get current line number low byte

.,A8A9 E5 14    SBC $14
kleiner als laufende Zeile?
subtract temporary integer low byte

.,A8AB A5 3A    LDA $3A         LDA     CURLIN+1
aktuelle Zeilennummer (HIGH)
get current line number high byte
IS CURRENT PAGE < GOTO PAGE?
.,A8AD E5 15    SBC $15         CMP     LINNUM+1
kleiner als laufende Zeile?
subtract temporary integer high byte

.,A8AF B0 0B    BCS $A8BC         BCS     LUK4IT
nein: $A8BC
if current line number >= temporary integer, go search
from the start of memory
SEARCH FROM PROG START IF NOT
.,A8B1 98       TYA         TYA
Differenz in Akku
else copy line index to A
OTHERWISE SEARCH FROM NEXT LINE
.,A8B2 38       SEC         SEC
Carry setzen (Addition)
set carry (+1)

.,A8B3 65 7A    ADC $7A         ADC     TXTPTR
Programmzeiger addieren
add BASIC execute pointer low byte

.,A8B5 A6 7B    LDX $7B         LDX     TXTPTR+1
sucht ab laufender Zeile
get BASIC execute pointer high byte

.,A8B7 90 07    BCC $A8C0         BCC     LUKALL
unbedingter
branch if no overflow to high byte

.,A8B9 E8       INX         INX
Sprung
increment high byte

.,A8BA B0 04    BCS $A8C0         BCSA    LUKALL          ;ALWAYS GOES.
zu $A8C0
branch always (can never be carry)

search for line number in temporary integer from start of memory pointer


.,A8BC A5 2B    LDA $2B LUK4IT: LDWX    TXTTAB
sucht ab Programmstart
get start of memory low byte
GET PROGRAM BEGINNING
.,A8BE A6 2C    LDX $2C

of memory high byte

search for line # in temporary integer from (AX)


.,A8C0 20 17 A6 JSR $A617 LUKALL: JSR     FNDLNC          ;[X,A] ARE ALL SET UP.
sucht Programmzeile
search Basic for temp integer line number from AX
SEARCH FOR GOTO LINE
.,A8C3 90 1E    BCC $A8E3 QFOUND: BCC     USERR           ;GOTO LINE IS NONEXISTANT.
nicht gefunden: 'undef'd st.'
if carry clear go do unsdefined statement error
carry all ready set for subtract
ERROR IF NOT THERE
.,A8C5 A5 5F    LDA $5F         LDA     LOWTR
von der Startadresse (Zeile)
get pointer low byte
TXTPTR = START OF THE DESTINATION LINE
.,A8C7 E9 01    SBC #$01         SBCI    1
eins subtrahieren und als
-1

.,A8C9 85 7A    STA $7A         STA     TXTPTR
Programmzeiger (LOW)
save BASIC execute pointer low byte

.,A8CB A5 60    LDA $60         LDA     LOWTR+1
HIGH-Byte der Zeile laden
get pointer high byte

.,A8CD E9 00    SBC #$00         SBCI    0
Übertrag berücksichtigen
subtract carry

.,A8CF 85 7B    STA $7B         STA     TXTPTR+1
und als Programmzeiger
save BASIC execute pointer high byte

.,A8D1 60       RTS GORTS:  RTS                     ;PROCESS THE STATEMENT.
;
; "RETURN" RESTORES THE LINE NUMBER AND TEXT PNTR FROM THE STACK
; AND ELIMINATES ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB" ENTRY.
;
Rücksprung

BASIC-Befehl RETURN



perform RETURN

RETURN TO NEWSTT OR GOSUB

"POP" AND "RETURN" STATEMENTS

.,A8D2 D0 FD    BNE $A8D1 RETURN: BNE     GORTS           ;NO TERMINATOR=BLOW HIM UP.
Kein Trennzeichen: SYNTAX ERR
exit if following token to allow syntax error

.,A8D4 A9 FF    LDA #$FF         LDAI    255
Wert laden und
set byte so no match possible

.,A8D6 85 4A    STA $4A         STA     FORPNT+1        ;MAKE SURE THE VARIABLE'S PNTR
                                ;NEVER GETS MATCHED.
FOR-NEXT-ZEIGER neu setzen
save FOR/NEXT variable pointer high byte

.,A8D8 20 8A A3 JSR $A38A         JSR     FNDFOR          ;GO PAST ALL THE "FOR" ENTRIES.
GOSUB-Datensatz suchen
search the stack for FOR or GOSUB activity,
get token off stack
TO CANCEL FOR/NEXT IN SUB
.,A8DB 9A       TXS         TXS

tack

.,A8DC C9 8D    CMP #$8D         CMPI    GOSUTK          ;RETURN WITHOUT GOSUB?
'GOSUB'-Code?
compare with GOSUB token
LAST GOSUB FOUND?
.,A8DE F0 0B    BEQ $A8EB         BEQ     RETU1
ja: $A8E8
if matching GOSUB go continue RETURN

.,A8E0 A2 0C    LDX #$0C         LDXI    ERRRG
Nr für 'return without gosub’
else error code $04, return without gosub error

.:A8E2 2C       .BYTE $2C         SKIP2

makes next line BIT $11A2
FAKE
.,A8E3 A2 11    LDX #$02 USERR:  LDXI    ERRUS           ;NO MATCH SO "US" ERROR.
Nr für 'undef'd statement'
error code $11, undefined statement error

.,A8E5 4C 37 A4 JMP $A437         JMP     ERROR           ;YES.
Fehlermeldung ausgeben
do error #X then warm start


.,A8E8 4C 08 AF JMP $AF08 SNERR2: JMP     SNERR
'syntax error' ausgeben
do syntax error then warm start
was matching GOSUB token


.,A8EB 68       PLA RETU1:  PLA                     ;REMOVE GOSUTK.
GOSUB-Code vom Stapel holen
dump token byte
DISCARD GOSUB TOKEN
.,A8EC 68       PLA         PULWD   CURLIN          ;GET LINE NUMBER "GOSUB" WAS FROM.
Zeilennummer (LOW) wieder-
pull return line low byte

.,A8ED 85 39    STA $39
holen und abspeichern
save current line number low byte
PULL LINE #
.,A8EF 68       PLA
Zeilennummer (HIGH) holen
pull return line high byte

.,A8F0 85 3A    STA $3A
und abspeichern
save current line number high byte

.,A8F2 68       PLA         PULWD   TXTPTR          ;GET TEXT PNTR FROM "GOSUB".
Programmzeiger (LOW) wieder-
pull return address low byte

.,A8F3 85 7A    STA $7A
holen und abspeichern
save BASIC execute pointer low byte
PULL TXTPTR
.,A8F5 68       PLA
Programmzeiger (HIGH) holen
pull return address high byte

.,A8F6 85 7B    STA $7B
abspeichern

BASIC-Befehl DATA

save BASIC execute pointer high byte

perform DATA



"DATA" STATEMENT

EXECUTED BY SKIPPING TO NEXT COLON OR EOL
.,A8F8 20 06 A9 JSR $A906 DATA:   JSR     DATAN           ;SKIP TO END OF STATEMENT,
                                ;SINCE WHEN "GOSUB" STUCK THE TEXT PNTR
                                ;ONTO THE STACK, THE LINE NUMBER ARG
                                ;HADN'T BEEN READ YET.
nächstes Statement suchen
scan for next BASIC statement ([:] or [EOL])

add Y to the BASIC execute pointer

MOVE TO NEXT STATEMENT

ADD (Y) TO TXTPTR

.,A8FB 98       TYA ADDON:  TYA
Offset
copy index to A

.,A8FC 18       CLC         CLC
Carry löschen (Addition)
clear carry for add

.,A8FD 65 7A    ADC $7A         ADC     TXTPTR
Programmzeiger addieren
add BASIC execute pointer low byte

.,A8FF 85 7A    STA $7A         STA     TXTPTR
und wieder abspeichern
save BASIC execute pointer low byte

.,A901 90 02    BCC $A905         BCC     REMRTS
Verminderung übergehen
skip increment if no carry

.,A903 E6 7B    INC $7B         INC     TXTPTR+1
Programmzeiger vermindern
else increment BASIC execute pointer high byte

.,A905 60       RTS REMRTS: RTS                     ;"NEWSTT" RTS ADDR IS STILL THERE.

Rücksprung

Offset des nächsten

Trennzeichens finden



scan for next BASIC statement ([:] or [EOL])

returns Y as index to [:] or [EOL]


SCAN AHEAD TO NEXT ":" OR EOL

.,A906 A2 3A    LDX #$3A DATAN:  LDXI    ":"             ;"DATA" TERMINATES ON ":" AND NULL.
':' Doppelpunkt
set look for character = ":"
GET OFFSET IN Y TO EOL OR ":"
.:A908 2C       .BYTE $2C         SKIP2

makes next line BIT $00A2

scan for next BASIC line

returns Y as index to [EOL]
FAKE

.,A909 A2 00    LDX #$00 REMN:   LDXI    0               ;THE ONLY TERMINATOR IS NULL.
$0 Zeilenende
set alternate search character = [EOL]
TO EOL ONLY
.,A90B 86 07    STX $07         STX     CHARAC          ;PRESERVE IT.
als Suchzeichen
store alternate search character

.,A90D A0 00    LDY #$00         LDYI    0               ;THIS MAKES CHARAC=0 AFTER SWAP.
Zähler
set search character = [EOL]

.,A90F 84 08    STY $08         STY     ENDCHR
initialisieren
save the search character

.,A911 A5 08    LDA $08 EXCHQT: LDA     ENDCHR
Speicherzelle $7
get search character
TRICK TO COUNT QUOTE PARITY
.,A913 A6 07    LDX $07         LDX     CHARAC
gesuchtes Zeichen
get alternate search character

.,A915 85 07    STA $07         STA     CHARAC
mit $8
make search character = alternate search character

.,A917 86 08    STX $08         STX     ENDCHR
vertauschen
make alternate search character = search character

.,A919 B1 7A    LDA ($7A),Y REMER:  LDADY   TXTPTR
Zeichen holen
get BASIC byte

.,A91B F0 E8    BEQ $A905         BEQ     REMRTS          ;NULL ALWAYS TERMINATES.
Zeilenende, dann fertig
exit if null [EOL]
END OF LINE
.,A91D C5 08    CMP $08         CMP     ENDCHR          ;IS IT THE OTHER TERMINATOR?
= Suchzeichen?
compare with search character

.,A91F F0 E4    BEQ $A905         BEQ     REMRTS          ;YES, IT'S FINISHED.
ja: $A905
exit if found
COLON IF LOOKING FOR COLONS
.,A921 C8       INY         INY                     ;PROGRESS TO NEXT CHARACTER.
Zeiger erhöhen
else increment index

.,A922 C9 22    CMP #$22         CMPI    34              ;IS IT A QUOTE?
"" Hochkomma?
compare current character with open quote

.,A924 D0 F3    BNE $A919         BNE     REMER           ;NO, JUST CONTINUE.
nein: $A919
if found go swap search character for alternate search
character

.,A926 F0 E9    BEQ $A911         BEQA    EXCHQT          ;YES, TIME TO TRADE.
PAGE

"IF ... THEN" CODE.

sonst $7 und $8 vertauschen

BASIC-Befehl IF

loop for next character, branch always

perform IF

...ALWAYS

"IF" STATEMENT

.,A928 20 9E AD JSR $AD9E IF:     JSR     FRMEVL          ;EVALUATE A FORMULA.
FRMEVL Ausdruck berechnen
evaluate expression

.,A92B 20 79 00 JSR $0079         JSR     CHRGOT          ;GET CURRENT CHARACTER.
CHRGOT letztes Zeichen
scan memory

.,A92E C9 89    CMP #$89         CMPI    GOTOTK          ;IS TERMINATING CHARACTER A GOTOTK?
'GOTO'-Code?
compare with "GOTO" token

.,A930 F0 05    BEQ $A937         BEQ     OKGOTO          ;YES.
ja: $A937
if it was the token for GOTO go do IF ... GOTO
wasn't IF ... GOTO so must be IF ... THEN

.,A932 A9 A7    LDA #$A7         SYNCHK  THENTK          ;NO, IT MUST BE "THEN".
'THEN'-Code
set "THEN" token

.,A934 20 FF AE JSR $AEFF
prüft auf Code
scan for CHR$(A), else do syntax error then warm start

.,A937 A5 61    LDA $61 OKGOTO: LDA     FACEXP          ;0=FALSE. ALL OTHERS TRUE.
Ergebnis des IF-Ausdrucks
get FAC1 exponent
CONDITION TRUE OR FALSE?
.,A939 D0 05    BNE $A940         BNE     DOCOND          ;TRUE !
Ausdruck wahr?

BASIC-Befehl REM

if result was non zero continue execution
else REM rest of line

perform REM

BRANCH IF TRUE

"REM" STATEMENT, OR FALSE "IF" STATEMENT

.,A93B 20 09 A9 JSR $A909 REM:    JSR     REMN            ;SKIP REST OF STATEMENT.
nein, Zeilenanfang suchen
scan for next BASIC line
SKIP REST OF LINE
.,A93E F0 BB    BEQ $A8FB         BEQA    ADDON           ;WILL ALWAYS BRANCH.
Programmz. auf nächste Zeile
add Y to the BASIC execute pointer and return, branch
always
result was non zero so do rest of line
...ALWAYS

.,A940 20 79 00 JSR $0079 DOCOND: JSR     CHRGOT          ;TEST CURRENT CHARACTER.
CHRGOT: letztes Zeichen holen
scan memory
COMMAND OR NUMBER?
.,A943 B0 03    BCS $A948         BCS     DOCO            ;IF A NUMBER, GOTO IT.
keine Ziffer?
branch if not numeric character, is variable or keyword
COMMAND
.,A945 4C A0 A8 JMP $A8A0         JMP     GOTO
zum GOTO-Befehl
else perform GOTO n
is variable or keyword
NUMBER
.,A948 4C ED A7 JMP $A7ED DOCO:   JMP     GONE3           ;INTERPRET NEW STATEMENT.
PAGE

"ON ... GO TO ..." CODE.

Befehl dekodieren, ausführen

BASIC-Befehl ON

interpret BASIC code from BASIC execute pointer

perform ON



"ON" STATEMENT

ON <EXP> GOTO <LIST>
ON <EXP> GOSUB <LIST>
.,A94B 20 9E B7 JSR $B79E ONGOTO: JSR     GETBYT          ;GET VALUE IN FACLO.
Byte-Wert (0 bis 255) holen
get byte parameter
EVALUATE <EXP>, AS BYTE IN FAC+4
.,A94E 48       PHA         PHA                     ;SAVE FOR LATER.
Code merken
push next character
SAVE NEXT CHAR ON STACK
.,A94F C9 8D    CMP #$8D         CMPI    GOSUTK          ;AN "ON ... GOSUB" PERHAPS?
'GOSUB'-Code?
compare with GOSUB token

.,A951 F0 04    BEQ $A957         BEQ     ONGLOP          ;YES.
ja: $A957
if GOSUB go see if it should be executed

.,A953 C9 89    CMP #$89 SNERR3: CMPI    GOTOTK          ;MUST BE "GOTOTK".
'GOTO'-Code?
compare with GOTO token

.,A955 D0 91    BNE $A8E8         BNE     SNERR2
nein: dann 'SYNTAX ERROR'
if not GOTO do syntax error then warm start
next character was GOTO or GOSUB, see if it should be executed

.,A957 C6 65    DEC $65 ONGLOP: DEC     FACLO
Zähler vermindern
decrement the byte value
COUNTED TO RIGHT ONE YET?
.,A959 D0 04    BNE $A95F         BNE     ONGLP1          ;SKIP ANOTHER LINE NUMBER.
noch nicht null?
if not zero go see if another line number exists
NO, KEEP LOOKING
.,A95B 68       PLA         PLA                     ;GET DISPATCH CHARACTER.
ja: Code zurückholen
pull keyword token
YES, RETRIEVE CMD
.,A95C 4C EF A7 JMP $A7EF         JMP     GONE2
und Befehl ausführen
go execute it
AND GO.
.,A95F 20 73 00 JSR $0073 ONGLP1: JSR     CHRGET          ;ADVANCE AND SET CODES.
CHRGET nächstes Zeichen holen
increment and scan memory
PRIME CONVERT SUBROUTINE
.,A962 20 6B A9 JSR $A96B         JSR     LINGET
Zeilennummer holen
get fixed-point number into temporary integer
skip this n
CONVERT LINE #
.,A965 C9 2C    CMP #$2C         CMPI    44              ;IS IT A COMMA?
',' Komma?
compare next character with ","
TERMINATE WITH COMMA?
.,A967 F0 EE    BEQ $A957         BEQ     ONGLOP
ja: dann weiter
loop if ","
YES
.,A969 68       PLA         PLA                     ;REMOVE STACK ENTRY (TOKEN).
kein Sprung: Code zurückholen
else pull keyword token, ran out of options
NO, END OF LIST, SO IGNORE
.,A96A 60       RTS ONGRTS: RTS                     ;EITHER END-OF-LINE OR SYNTAX ERROR.
PAGE

LINGET -- READ A LINE NUMBER INTO LINNUM

;
; "LINGET" READS A LINE NUMBER FROM THE CURRENT TEXT POSITION.
;
; LINE NUMBERS RANGE FROM 0 TO 64000-1.
;
; THE ANSWER IS RETURNED IN "LINNUM".
; "TXTPTR" IS UPDATED TO POINT TO THE TERMINATING CHARCTER
; AND [A] = THE TERMINATING CHARACTER WITH CONDITION
; CODES SET UP TO REFLECT ITS VALUE.
;
Rücksprung

Zeilennummer nach $14/$15



get fixed-point number into temporary integer



CONVERT LINE NUMBER

.,A96B A2 00    LDX #$00 LINGET: LDXI    0
Wert Laden und
clear X
ASC # TO HEX ADDRESS
.,A96D 86 14    STX $14         STX     LINNUM          ;INITIALIZE LINE NUMBER TO ZERO.
Vorsetzen
clear temporary integer low byte
IN LINNUM.
.,A96F 86 15    STX $15         STX     LINNUM+1
(für Zeilennummer gleich 0)
clear temporary integer high byte

.,A971 B0 F7    BCS $A96A MORLIN: BCS     ONGRTS          ;IT IS NOT A DIGIT.
keine Ziffer, dann fertig
return if carry set, end of scan, character was not 0-9
NOT A DIGIT
.,A973 E9 2F    SBC #$2F         SBCI    "0"-1           ;-1 SINCE C=0.
'0'-1 abziehen, gibt Hexwert
subtract $30, $2F+carry, from byte
CONVERT DIGIT TO BINARY
.,A975 85 07    STA $07         STA     CHARAC          ;SAVE CHARACTER.
merken
store #
SAVE THE DIGIT
.,A977 A5 15    LDA $15         LDA     LINNUM+1
HIGH-Byte holen
get temporary integer high byte
CHECK RANGE
.,A979 85 22    STA $22         STA     INDEX
Zwischenspeichern
save it for now

.,A97B C9 19    CMP #$19         CMPI    25              ;LINE NUMBER WILL BE .LT. 64000?
Zahl bereits größer 6400?
compare with $19
LINE # TOO LARGE?
.,A97D B0 D4    BCS $A953         BCS     SNERR3
dann 'SYNTAX ERROR'
branch if >= this makes the maximum line number 63999
because the next bit does $1900 * $0A = $FA00 = 64000
decimal. the branch target is really the SYNTAX error
at $A8E8 but that is too far so an intermediate
compare and branch to that location is used. the problem
with this is that line number that gives a partial result
from $8900 to $89FF, 35072x to 35327x, will pass the new
target compare and will try to execute the remainder of
the ON n GOTO/GOSUB. a solution to this is to copy the
byte in A before the branch to X and then branch to
$A955 skipping the second compare
YES, > 63999, GO INDIRECTLY TO
"SYNTAX ERROR".
<<<<<DANGEROUS CODE>>>>>
NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
FOR OTHER CALLS TO LINGET.

YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
THEN TYPE "GO TO 437761".

ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
THE PROBLEM. ($AB00 - $ABFF)
<<<<<DANGEROUS CODE>>>>>
.,A97F A5 14    LDA $14         LDA     LINNUM
Zahl * 10 (= *2*2+Zahl*2)
get temporary integer low byte
MULTIPLY BY TEN
.,A981 0A       ASL         ASL     A,              ;MULTIPLY BY 10.
Wert und Zwischenwert je
*2 low byte

.,A982 26 22    ROL $22         ROL     INDEX
2 mal um 1 Bit nach
*2 high byte

.,A984 0A       ASL         ASL     A
links rollen
*2 low byte

.,A985 26 22    ROL $22         ROL     INDEX
(entspricht 2 * 2)
*2 high byte (*4)

.,A987 65 14    ADC $14         ADC     LINNUM
plus ursprünglicher Wert
+ low byte (*5)

.,A989 85 14    STA $14         STA     LINNUM
und abspeichern
save it

.,A98B A5 22    LDA $22         LDA     INDEX
Zwischenwert zu
get high byte temp

.,A98D 65 15    ADC $15         ADC     LINNUM+1
zweitem Wert addieren
+ high byte (*5)

.,A98F 85 15    STA $15         STA     LINNUM+1
und wieder abspeichern
save it

.,A991 06 14    ASL $14         ASL     LINNUM
Speicherzelle $14 und
*2 low byte (*10d)

.,A993 26 15    ROL $15         ROL     LINNUM+1
$15 verdoppeln
*2 high byte (*10d)

.,A995 A5 14    LDA $14         LDA     LINNUM
Wert wieder laden
get low byte

.,A997 65 07    ADC $07         ADC     CHARAC          ;ADD IN DIGIT.
und Einerziffer addieren
add #
ADD DIGIT
.,A999 85 14    STA $14         STA     LINNUM
wieder speichern
save low byte

.,A99B 90 02    BCC $A99F         BCC     NXTLGC
Carry gesetzt? (Übertrag)
branch if no overflow to high byte

.,A99D E6 15    INC $15         INC     LINNUM+1
Übertrag addieren
else increment high byte

.,A99F 20 73 00 JSR $0073 NXTLGC: JSR     CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
GET NEXT CHAR
.,A9A2 4C 71 A9 JMP $A971         JMP     MORLIN

PAGE

"LET" CODE.

und weiter machen

BASIC-Befehl LET

loop for next character

perform LET

MORE CONVERTING

"LET" STATEMENT

LET <VAR> = <EXP>
<VAR> = <EXP>
.,A9A5 20 8B B0 JSR $B08B LET:    JSR     PTRGET          ;GET PNTR TO VARIABLE INTO "VARPNT".
sucht Variable hinter LET
get variable address
GET <VAR>
.,A9A8 85 49    STA $49         STWD    FORPNT          ;PRESERVE POINTER.
und Variablenadresse
save variable address low byte

.,A9AA 84 4A    STY $4A
merken (LOW- und HIGH-Byte)
save variable address high byte

.,A9AC A9 B2    LDA #$B2         SYNCHK  EQULTK          ;"=" IS NECESSARY.
'=' - Code
$B2 is "=" token

.,A9AE 20 FF AE JSR $AEFF IFN     INTPRC,<
prüft auf Code
scan for CHR$(A), else do syntax error then warm start

.,A9B1 A5 0E    LDA $0E         LDA     INTFLG          ;SAVE FOR LATER.
Integer-Flag
get data type flag, $80 = integer, $00 = float
SAVE VARIABLE TYPE
.,A9B3 48       PHA         PHA>
auf Stapel retten
push data type flag

.,A9B4 A5 0D    LDA $0D         LDA     VALTYP          ;RETAIN THE VARIABLE'S VALUE TYPE.
und Typ-Flag
get data type flag, $FF = string, $00 = numeric

.,A9B6 48       PHA         PHA
(String/numerisch) retten
push data type flag

.,A9B7 20 9E AD JSR $AD9E         JSR     FRMEVL          ;GET VALUE OF FORMULA INTO "FAC".
FRMEVL: Ausdruck holen
evaluate expression
EVALUATE <EXP>
.,A9BA 68       PLA         PLA
Typ-Flag wiederholen
pop data type flag

.,A9BB 2A       ROL         ROL     A,              ;CARRY SET FOR STRING, OFF FOR
                                ;NUMERIC.
und Bit 7 ins Carry schieben
string bit into carry

.,A9BC 20 90 AD JSR $AD90         JSR     CHKVAL          ;MAKE SURE "VALTYP" MATCHES CARRY.
                                ;AND SET ZERO FLAG FOR NUMERIC.
auf richtigen Typ prüfen
do type match check

.,A9BF D0 18    BNE $A9D9         BNE     COPSTR          ;IF NUMERIC, COPY IT.
COPNUM:
IFN     INTPRC,<
String? ja: $A9D9
branch if string

.,A9C1 68       PLA         PLA                     ;GET NUMBER TYPE.
Integer-Flag zurückholen
pop integer/float data type flag
assign value to numeric variable


.,A9C2 10 12    BPL $A9D6 QINTGR: BPL     COPFLT          ;STORE A FLTING NUMBER.
INTEGER? ja: $A9D6

Wertzuweisung INTEGER

branch if float
expression is numeric integer
REAL VARIABLE
.,A9C4 20 1B BC JSR $BC1B         JSR     ROUND           ;ROUND INTEGER.
FAC runden
round FAC1
INTEGER VAR: ROUND TO 32 BITS
.,A9C7 20 BF B1 JSR $B1BF         JSR     AYINT           ;MAKE 2-BYTE NUMBER.
und nach INTEGER wandlen
evaluate integer expression, no sign check
TRUNCATE TO 16-BITS
.,A9CA A0 00    LDY #$00         LDYI    0
Zeiger setzen
clear index

.,A9CC A5 64    LDA $64         LDA     FACMO           ;GET HIGH.
HIGH-Byte holen und
get FAC1 mantissa 3

.,A9CE 91 49    STA ($49),Y         STADY   FORPNT          ;STORE IT.
Wert in Variable bringen
save as integer variable low byte

.,A9D0 C8       INY         INY
Zeiger erhöhen
increment index

.,A9D1 A5 65    LDA $65         LDA     FACLO           ;GET LOW.
LOW-Byte holen und
get FAC1 mantissa 4

.,A9D3 91 49    STA ($49),Y         STADY   FORPNT
Wert in Variable bringen
save as integer variable high byte

.,A9D5 60       RTS         RTS>
Rücksprung

Wertzuweisung REAL




REAL VARIABLE = EXPRESSION

.,A9D6 4C D0 BB JMP $BBD0 COPFLT: JMP     MOVVF           ;PUT NUMBER @FORPNT.

COPSTR:
FAC nach Variable bringen

Wertzuweisung String

pack FAC1 into variable pointer and return
assign value to numeric variable


.,A9D9 68       PLA IFN     INTPRC,<PLA> ;IF STRING, NO INTFLG.
INPCOM:
IFN     TIME,<
Akku vom Stapel holen
dump integer/float data type flag


INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4

.,A9DA A4 4A    LDY $4A         LDY     FORPNT+1        ;TI$?
Variablenadresse (HIGH) holen
get variable pointer high byte
STRING DATA ALREADY IN STRING AREA?
.,A9DC C0 BF    CPY #$BF         CPYI    ZERO/256        ;ONLY TI$ CAN BE THIS ON ASSIG.
ist Variable TI$?
was it TI$ pointer

.,A9DE D0 4C    BNE $AA2C         BNE     GETSPT          ; WAS NOT TI$.
nein: $AA2C
branch if not
else it's TI$ = <expr$>

.,A9E0 20 A6 B6 JSR $B6A6         JSR     FREFAC          ;WE WONT NEEDIT.
FRESTR
pop string off descriptor stack, or from top of string
space returns with A = length, X = pointer low byte,
Y = pointer high byte

.,A9E3 C9 06    CMP #$06         CMPI    6               ;LENGTH CORRECT?
Stringlänge gleich 6
compare length with 6

.,A9E5 D0 3D    BNE $AA24         BNE     FCERR2
nein: 'illegal quantity'
if length not 6 do illegal quantity error then warm start

.,A9E7 A0 00    LDY #$00         LDYI    0               ;YES. DO SETUP.
Wert holen
clear index

.,A9E9 84 61    STY $61         STY     FACEXP          ;ZERO FAC TO START WITH.
und damit FAC
clear FAC1 exponent

.,A9EB 84 66    STY $66         STY     FACSGN
initialisieren
clear FAC1 sign (b7)

.,A9ED 84 71    STY $71 TIMELP: STY     FBUFPT          ;SAVE POSOTION.
(Akku, Vorzeichen und Zeiger)
save index

.,A9EF 20 1D AA JSR $AA1D         JSR     TIMNUM          ;GET A DIGIT.
prüft nächstes Z. auf Ziffer
check and evaluate numeric digit

.,A9F2 20 E2 BA JSR $BAE2         JSR     MUL10           ;WHOLE QTY BY 10.
FAC = FAC * 10
multiply FAC1 by 10

.,A9F5 E6 71    INC $71         INC     FBUFPT
Stellenzähler erhöhen
increment index

.,A9F7 A4 71    LDY $71         LDY     FBUFPT
und ins Y-Reg. bringen
restore index

.,A9F9 20 1D AA JSR $AA1D         JSR     TIMNUM
prüft nächstes Z. auf Ziffer
check and evaluate numeric digit

.,A9FC 20 0C BC JSR $BC0C         JSR     MOVAF
FAC nach ARG kopieren
round and copy FAC1 to FAC2

.,A9FF AA       TAX         TAX                     ;IF NUM=0 THEN NO MULT.
FAC gleich 0?
copy FAC1 exponent

.,AA00 F0 05    BEQ $AA07         BEQ     NOML6           ;IF =0, GO TIT.
ja: $AA07
branch if FAC1 zero

.,AA02 E8       INX         INX                     ;MULT BY TWO.
Exponent von FAC erhöhen
increment index, * 2

.,AA03 8A       TXA         TXA
(FAC *2) und in den Akku
copy back to A

.,AA04 20 ED BA JSR $BAED         JSR     FINML6          ;ADD IN AND MULT BY 2 GIVES *6.
FAC = FAC + ARG
FAC1 = (FAC1 + (FAC2 * 2)) * 2 = FAC1 * 6

.,AA07 A4 71    LDY $71 NOML6:  LDY     FBUFPT
Stellenzähler
get index

.,AA09 C8       INY         INY
erhöhen
increment index

.,AA0A C0 06    CPY #$06         CPYI    6               ;DONE ALL SIX?
schon 6 Stellen?
compare index with 6

.,AA0C D0 DF    BNE $A9ED         BNE     TIMELP
nein: nächstes Zeichen
loop if not 6

.,AA0E 20 E2 BA JSR $BAE2         JSR     MUL10           ;ONE LAST TIME.
FAC = FAC * 10
multiply FAC1 by 10

.,AA11 20 9B BC JSR $BC9B         JSR     QINT            ;SHIFT IT OVER TO THE RIGHT.
FAC rechtsbündig machen
convert FAC1 floating to fixed

.,AA14 A6 64    LDX $64         LDXI    2
Werte für
get FAC1 mantissa 3

.,AA16 A4 63    LDY $63         SEI                     ;DISALLOW INTERRUPTS.
eingegebene Uhrzeit
get FAC1 mantissa 2

.,AA18 A5 65    LDA $65 TIMEST: LDA     FACMOH,X
holen und
get FAC1 mantissa 4

.,AA1A 4C DB FF JMP $FFDB         STA     CQTIMR,X
        DEX
        BPL     TIMEST          ;LOOP 3 TIMES.
        CLI                     ;TURN ON INTS AGAIN.
        RTS
Time setzen

Zeichen auf Ziffer prüfen

set real time clock and return

check and evaluate numeric digit


.,AA1D B1 22    LDA ($22),Y TIMNUM: LDADY   INDEX           ;INDEX SET UP BY FREFAC.
Zeichen holen (aus String)
get byte from string

.,AA1F 20 80 00 JSR $0080         JSR     QNUM
auf Ziffer prüfen
clear Cb if numeric. this call should be to $84
as the code from $80 first comapres the byte with
[SPACE] and does a BASIC increment and get if it is

.,AA22 90 03    BCC $AA27         BCC     GOTNUM
Ziffer: $AA27
branch if numeric

.,AA24 4C 48 B2 JMP $B248 FCERR2: JMP     FCERR           ;MUST BE NUMERIC STRING.
sonst: 'illegal quantity'
do illegal quantity error then warm start

.,AA27 E9 2F    SBC #$2F GOTNUM: SBCI    "0"-1           ;C IS OFF.
von ASCII nach HEX umwandeln
subtract $2F + carry to convert ASCII to binary

.,AA29 4C 7E BD JMP $BD7E         JMP     FINLOG> ;ADD IN DIGIT TO FAC.

in FAC und ARG übertragen

Wertzuweisung an normalen

String

evaluate new ASCII digit and return

assign value to numeric variable, but not TI$


.,AA2C A0 02    LDY #$02 GETSPT: LDYI    2               ;GET PNTR TO DESCRIPTOR.
Zeiger setzen
index to string pointer high byte

.,AA2E B1 64    LDA ($64),Y         LDADY   FACMO
Stringadresse HIGH mit
get string pointer high byte
(STRING AREA IS BTWN FRETOP
.,AA30 C5 34    CMP $34         CMP     FRETOP+1        ;SEE IF IT POINTS INTO STRING SPACE.
Stringanfangsadr. vergleichen
compare with bottom of string space high byte
HIMEM)
.,AA32 90 17    BCC $AA4B         BCC     DNTCPY          ;IF [FRETOP],GT.[2&3,FACMO], DON'T COPY.
kleiner: String im Programm
branch if string pointer high byte is less than bottom
of string space high byte
YES, DATA ALREADY UP THERE
.,AA34 D0 07    BNE $AA3D         BNE     QVARIA          ;IT IS LESS.
größer: $AA3D
branch if string pointer high byte is greater than
bottom of string space high byte
else high bytes were equal
NO
.,AA36 88       DEY         DEY
Zeiger vermindern
decrement index to string pointer low byte
MAYBE, TEST LOW BYTE OF POINTER
.,AA37 B1 64    LDA ($64),Y         LDADY   FACMO
Stringadresse (LOW) holen
get string pointer low byte

.,AA39 C5 33    CMP $33         CMP     FRETOP          ;COMPARE LOW ORDERS.
und vergleichen
compare with bottom of string space low byte

.,AA3B 90 0E    BCC $AA4B         BCC     DNTCPY
kleiner: String im Programm
branch if string pointer low byte is less than bottom
of string space low byte
YES, ALREADY THERE
.,AA3D A4 65    LDY $65 QVARIA: LDY     FACLO
Zeiger auf Stringdescriptor
get descriptor pointer high byte
NO. DESCRIPTOR ALREADY AMONG VARIABLES?
.,AA3F C4 2E    CPY $2E         CPY     VARTAB+1        ;IF [VARTAB].GT.[FACMO], DON'T COPY.
mit Variablenstart vergl.
compare with start of variables high byte

.,AA41 90 08    BCC $AA4B         BCC     DNTCPY
kleiner: $AA4B
branch if less, is on string stack
NO
.,AA43 D0 0D    BNE $AA52         BNE     COPY            ;IT IS LESS.
größer: $AA52
if greater make space and copy string
else high bytes were equal
YES
.,AA45 A5 64    LDA $64         LDA     FACMO
Stringdiscriptorzeiger (LOW)
get descriptor pointer low byte
MAYBE, COMPARE LO-BYTE
.,AA47 C5 2D    CMP $2D         CMP     VARTAB          ;COMPARE LOW ORDERS.
mit Variablenstart vergl.
compare with start of variables low byte

.,AA49 B0 07    BCS $AA52         BCS     COPY
größer: $AA52
if greater or equal make space and copy string
YES, DESCRIPTOR IS AMONG VARIABLES
.,AA4B A5 64    LDA $64 DNTCPY: LDWD    FACMO
Zeiger in Akku und Y-Reg.
get descriptor pointer low byte
EITHER STRING ALREADY ON TOP, OR
.,AA4D A4 65    LDY $65
auf Stringdescriptor setzen
get descriptor pointer high byte
DESCRIPTOR IS NOT A VARIABLE
.,AA4F 4C 68 AA JMP $AA68         JMP     COPYZC
bis $AA68 überspringen
go copy descriptor to variable
SO JUST STORE THE DESCRIPTOR

STRING NOT YET IN STRING AREA,

AND DESCRIPTOR IS A VARIABLE

.,AA52 A0 00    LDY #$00 COPY:   LDYI    0
Zeiger setzen
clear index
POINT AT LENGTH IN DESCRIPTOR
.,AA54 B1 64    LDA ($64),Y         LDADY   FACMO
Länge des Strings holen
get string length
GET LENGTH
.,AA56 20 75 B4 JSR $B475         JSR     STRINI          ;GET ROOM TO COPY STRING INTO.
prüft Platz, setzt Stringz.
copy descriptor pointer and make string space A bytes long
MAKE A STRING THAT LONG UP ABOVE
.,AA59 A5 50    LDA $50         LDWD    DSCPNT          ;GET POINTER TO OLD DESCRIPTOR, SO
Zeiger auf Stringdescriptor
copy old descriptor pointer low byte
SET UP SOURCE PNTR FOR MONINS
.,AA5B A4 51    LDY $51
holen (LOW- und HIGH-Byte)
copy old descriptor pointer high byte

.,AA5D 85 6F    STA $6F         STWD    STRNG1          ;MOVINS CAN FIND STRING.
und
save old descriptor pointer low byte

.,AA5F 84 70    STY $70
speichern
save old descriptor pointer high byte

.,AA61 20 7A B6 JSR $B67A         JSR     MOVINS          ;COPY IT.
String in Bereich übertragen
copy string from descriptor to utility pointer
MOVE STRING DATA TO NEW AREA
.,AA64 A9 61    LDA #$61         LDWDI   DSCTMP          ;GET POINTER TO OLD DESCRIPTOR.
Werte laden
get descriptor pointer low byte
ADDRESS OF DESCRIPTOR IS IN FAC
.,AA66 A0 00    LDY #$00
und damit
get descriptor pointer high byte

.,AA68 85 50    STA $50 COPYZC: STWD    DSCPNT          ;REMEMBER POINTER TO DESCRIPTOR.
Stringdiscriptor
save descriptor pointer low byte

.,AA6A 84 51    STY $51
neu setzen
save descriptor pointer high byte

.,AA6C 20 DB B6 JSR $B6DB         JSR     FRETMS          ;FREE UP THE TEMPORARY WITHOUT
                                ;FREEING UP ANY STRING SPACE.
Descriptor löschen
clean descriptor stack, YA = pointer
DISCARD DESCRIPTOR IF 'TWAS TEMPORARY
.,AA6F A0 00    LDY #$00         LDYI    0
Zeiger setzen
clear index
COPY STRING DESCRIPTOR
.,AA71 B1 50    LDA ($50),Y         LDADY   DSCPNT
Länge des Descriptors holen
get string length from new descriptor

.,AA73 91 49    STA ($49),Y         STADY   FORPNT
und abspeichern
copy string length to variable

.,AA75 C8       INY         INY                     ;POINT TO STRING PNTR.
Zeiger erhöhen
increment index

.,AA76 B1 50    LDA ($50),Y         LDADY   DSCPNT
Adresse (LOW) holen
get string pointer low byte from new descriptor

.,AA78 91 49    STA ($49),Y         STADY   FORPNT
und speichern
copy string pointer low byte to variable

.,AA7A C8       INY         INY
Zeiger erhöhen
increment index

.,AA7B B1 50    LDA ($50),Y         LDADY   DSCPNT
und Adresse (HIGH)
get string pointer high byte from new descriptor

.,AA7D 91 49    STA ($49),Y         STADY   FORPNT
in Variable bringen
copy string pointer high byte to variable

.,AA7F 60       RTS         RTS
PAGE

PRINT CODE.

IFN     EXTIO,<
Rücksprung

BASIC-Befehl PRINT#



perform PRINT#



.,AA80 20 86 AA JSR $AA86 PRINTN: JSR     CMD             ;DOCMD
CMD-Befehl
perform CMD

.,AA83 4C B5 AB JMP $ABB5         JMP     IODONE          ;RELEASE CHANNEL.
und CLRCH

BASIC-Befehl CMD

close input and output channels and return

perform CMD


.,AA86 20 9E B7 JSR $B79E CMD:    JSR     GETBYT
holt Byte-Ausdruck
get byte parameter

.,AA89 F0 05    BEQ $AA90         BEQ     SAVEIT
Trennzeichen: $AA90
branch if following byte is ":" or [EOT]

.,AA8B A9 2C    LDA #$2C         SYNCHK  44              ;COMMA?
',', Wert laden
set ","

.,AA8D 20 FF AE JSR $AEFF
prüft auf Komma
scan for CHR$(A), else do syntax error then warm start

.,AA90 08       PHP SAVEIT: PHP
Statusregister merken
save status

.,AA91 86 13    STX $13         JSR     CQOOUT          ;CHECK AND OPEN OUTPUT CHANNL.
Nr. des Ausgabegeräts merken
set current I/O channel

.,AA93 20 18 E1 JSR $E118         STX     CHANNL          ;CHANNL TO OUTPUT ON.
CKOUT, Ausgabegerät setzen
open channel for output with error check

.,AA96 28       PLP         PLP                     ;GET STATUS BACK.
Statusregister wiederholen
restore status

.,AA97 4C A0 AA JMP $AAA0         JMP     PRINT>
zum PRINT-Befehl
perform PRINT

.,AA9A 20 21 AB JSR $AB21 STRDON: JSR     STRPRT
String drucken
print string from utility pointer

.,AA9D 20 79 00 JSR $0079 NEWCHR: JSR     CHRGOT          ;REGET LAST CHARACTER.
CHRGOT letztes Zeichen

BASIC-Befehl PRINT

scan memory

perform PRINT



"PRINT" STATEMENT

.,AAA0 F0 35    BEQ $AAD7 PRINT:  BEQ     CRDO            ;TERMINATOR SO TYPE CRLF.
Trennzeichen: $AAD7
if nothing following just print CR/LF
NO MORE LIST, PRINT <RETURN>

.,AAA2 F0 43    BEQ $AAE7 PRINTC: BEQ     PRTRTS          ;HERE AFTER SEEING TAB(X) OR , OR ;
                                ;IN WHICH CASE A TERMINATOR DOES NOT
                                ;MEAN TYPE A CRLF BUT JUST RTS.
Trennz. (TAB, SPC): RTS
exit if nothing following, end of PRINT branch
NO MORE LIST, DON'T PRINT <RETURN>
.,AAA4 C9 A3    CMP #$A3         CMPI    TABTK           ;TAB FUNCTION?
'TAB('-Code?
compare with token for TAB(

.,AAA6 F0 50    BEQ $AAF8         BEQ     TABER           ;YES.
ja: $AAF8
if TAB( go handle it
C=1 FOR TAB(
.,AAA8 C9 A6    CMP #$A6         CMPI    SPCTK           ;SPACE FUNCTION?
'SPC('-Code?
compare with token for SPC(

.,AAAA 18       CLC         CLC
Flag für SPC setzen
flag SPC(

.,AAAB F0 4B    BEQ $AAF8         BEQ     TABER
SPC-Code: $AAF8
if SPC( go handle it
C=0 FOR SPC(
.,AAAD C9 2C    CMP #$2C         CMPI    44              ;A COMMA?
','-Code? (Komma)
compare with ","

.,AAAF F0 37    BEQ $AAE8         BEQ     COMPRT          ;YES.
ja: $AAE8
if "," go skip to the next TAB position

.,AAB1 C9 3B    CMP #$3B         CMPI    59              ;A SEMICOLON?
';'-Code? (Semikolon)
compare with ";"

.,AAB3 F0 5E    BEQ $AB13         BEQ     NOTABR          ;YES.
ja: nächstes Zeichen, weiter
if ";" go continue the print loop

.,AAB5 20 9E AD JSR $AD9E         JSR     FRMEVL          ;EVALUATE THE FORMULA.
FRMEVL: Term holen
evaluate expression
EVALUATE EXPRESSION
.,AAB8 24 0D    BIT $0D         BIT     VALTYP          ;A STRING?
Typflag
test data type flag, $FF = string, $00 = numeric
STRING OR FP VALUE?
.,AABA 30 DE    BMI $AA9A         BMI     STRDON          ;YES.
String?
if string go print string, scan memory and continue PRINT
STRING
.,AABC 20 DD BD JSR $BDDD         JSR     FOUT
FAC in ASCII-String wandeln
convert FAC1 to ASCII string result in (AY)
FP: CONVERT INTO BUFFER
.,AABF 20 87 B4 JSR $B487         JSR     STRLIT          ;BUILD DESCRIPTOR.
IFN     REALIO-3,<
        LDYI    0               ;GET THE POINTER.
        LDADY   FACMO
        CLC
        ADC     TRMPOS          ;MAKE SURE LEN+POS.LT.WIDTH.
        CMP     LINWID          ;GREATER THAN LINE LENGTH?
                                ;REMEMBER SPACE PRINTED AFTER NUMBER.
        BCC     LINCHK          ;GO TYPE.
        JSR     CRDO> ;YES, TYPE CRLF FIRST.
Stringparameter holen
print " terminated string to utility pointer
MAKE BUFFER INTO STRING
.,AAC2 20 21 AB JSR $AB21 LINCHK: JSR     STRPRT          ;PRINT THE NUMBER.
String drucken
print string from utility pointer

.,AAC5 20 3B AB JSR $AB3B         JSR     OUTSPC          ;PRINT A SPACE
Cursor right bzw. Leerzeichen
print [SPACE] or [CURSOR RIGHT]

.,AAC8 D0 D3    BNE $AA9D         BNEA    NEWCHR          ;ALWAYS GOES.
IFN     REALIO-4,<
IFN     BUFPAG,<
weiter machen
go scan memory and continue PRINT, branch always

set XY to $0200 - 1 and print [CR]

PRINT THE STRING
.,AACA A9 00    LDA #$00 FININL: LDAI    0
Eingabepuffer
clear A

.,AACC 9D 00 02 STA $0200,X         STA     BUF,X
mit $0 abschließen
clear first byte of input buffer

.,AACF A2 FF    LDX #$FF         LDXYI   BUF-1>
Zeiger auf
$0200 - 1 low byte

.,AAD1 A0 01    LDY #$01 IFE     BUFPAG,<
FININL: LDYI    0               ;PUT A ZERO AT END OF BUF.
        STY     BUF,X
        LDXI    BUF-1> ;SETUP POINTER.
IFN     EXTIO,<
Eingabepuffer ab $0200 setzen
$0200 - 1 high byte

.,AAD3 A5 13    LDA $13         LDA     CHANNL          ;NO CRDO IF NOT TERMINAL.
Nummer des Ausgabegeräts
get current I/O channel

.,AAD5 D0 10    BNE $AAE7         BNE     PRTRTS>>
CRDO:
IFE     EXTIO,<
        LDAI    13              ;MAKE TRMPOS LESS THAN LINE LENGTH.
        STA     TRMPOS>
IFN     EXTIO,<
IFN     REALIO-3,<
        LDA     CHANNL
        BNE     GOCR
        STA     TRMPOS>
Tastatur? nein: RTS
exit if not default channel

print CR/LF



.,AAD7 A9 0D    LDA #$0D GOCR:   LDAI    13> ;X AND Y MUST BE PRESERVED.
'CR' carriage return
set [CR]
PRINT <RETURN>
.,AAD9 20 47 AB JSR $AB47         JSR     OUTDO
ausgeben
print the character

.,AADC 24 13    BIT $13         LDAI    10
logische Filenummer
test current I/O channel

.,AADE 10 05    BPL $AAE5         JSR     OUTDO
kleiner 128?
if ?? toggle A, EOR #$FF and return

.,AAE0 A9 0A    LDA #$0A CRFIN:
'LF' line feed
set [LF]

.,AAE2 20 47 AB JSR $AB47 IFN     EXTIO,<
ausgeben
print the character
toggle A

.,AAE5 49 FF    EOR #$FF IFN     REALIO-3,<
NOT
invert A
<<< WHY??? >>>
.,AAE7 60       RTS         LDA     CHANNL
        BNE     PRTRTS>>
IFE     NULCMD,<
IFN     REALIO-3,<
        LDAI    0
        STA     TRMPOS>
        EORI    255>
IFN     NULCMD,<
        TXA                     ;PRESERVE [ACCX]. SOME NEED IT.
        PHA
        LDX     NULCNT          ;GET NUMBER OF NULLS.
        BEQ     CLRPOS
        LDAI    0
PRTNUL: JSR     OUTDO
        DEX                     ;DONE WITH NULLS?
        BNE     PRTNUL
CLRPOS: STX     TRMPOS
        PLA
        TAX>
PRTRTS: RTS

COMPRT: LDA     TRMPOS
NCMPOS==<<<LINLEN/CLMWID>-1>*CLMWID> ;CLMWID BEYOND WHICH THERE ARE
IFN     REALIO-3,<
                                ;NO MORE COMMA FIELDS.
        CMP     NCMWID          ;SO ALL COMMA DOES IS "CRDO".

Rücksprung

was ","


.,AAE8 38       SEC         BCC     MORCOM
Zehner-Tabulator mit Komma
set Cb for read cursor position

.,AAE9 20 F0 FF JSR $FFF0         JSR     CRDO            ;TYPE CRLF.
Cursorposition holen
read/set X,Y cursor position

.,AAEC 98       TYA         JMP     NOTABR> ;AND QUIT IF BEYOND LAST FIELD.
Spalte ins Y-Reg.
copy cursor Y

.,AAED 38       SEC MORCOM: SEC
Carry setzen (Subtr.)
set carry for subtract

.,AAEE E9 0A    SBC #$0A MORCO1: SBCI    CLMWID          ;GET [A] MODULUS CLMWID.
10 abziehen
subtract one TAB length

.,AAF0 B0 FC    BCS $AAEE         BCS     MORCO1
nicht negativ?
loop if result was +ve

.,AAF2 49 FF    EOR #$FF         EORI    255             ;FILL PRINT POS OUT TO EVEN CLMWID SO
invertieren
complement it

.,AAF4 69 01    ADC #$01         ADCI    1
+1 (Zweierkomplement)
+1, twos complement

.,AAF6 D0 16    BNE $AB0E         BNE     ASPAC           ;PRINT [A] SPACES.

unbedingter Sprung

TAB( (C=1) und SPC( (C=0)

always print A spaces, result is never $00

.,AAF8 08       PHP TABER:  PHP                     ;REMEMBER IF SPC OR TAB FUNCTION.
Flags merken
save TAB( or SPC( status
C=0 FOR SPC(, C=1 FOR TAB(
.,AAF9 38       SEC         JSR     GTBYTC          ;GET VALUE INTO ACCX.
Carry setzen
set Cb for read cursor position

.,AAFA 20 F0 FF JSR $FFF0
Cursorposition holen
read/set X,Y cursor position

.,AAFD 84 09    STY $09
und Spalte merken
save current cursor position

.,AAFF 20 9B B7 JSR $B79B
Byte-Wert holen
scan and get byte parameter
GET VALUE
.,AB02 C9 29    CMP #$29         CMPI    41
')' Klammer zu?
compare with ")"
TRAILING PARENTHESIS
.,AB04 D0 59    BNE $AB5F         BNE     SNERR4
nein: 'SYNTAX ERROR'
if not ")" do syntax error
NO, SYNTAX ERROR
.,AB06 28       PLP         PLP
Flags wiederherstellen
restore TAB( or SPC( status
TAB( OR SPC(
.,AB07 90 06    BCC $AB0F         BCC     XSPAC           ;PRINT [X] SPACES.
zu SPC(
branch if was SPC(
else was TAB(
SPC(
.,AB09 8A       TXA         TXA
TAB-Wert in Akku
copy TAB() byte to A
CALCULATE SPACES NEEDED FOR TAB(
.,AB0A E5 09    SBC $09         SBC     TRMPOS
mit Cursorspalte vergleichen
subtract current cursor position

.,AB0C 90 05    BCC $AB13         BCC     NOTABR          ;NEGATIVE, DON'T PRINT ANY.
kleiner Cursor-Position: RTS
go loop for next if already past requited position
ALREADY PAST THAT COLUMN
.,AB0E AA       TAX ASPAC:  TAX
Schritte bis zum Tabulator
copy [SPACE] count to X
NOW DO A SPC( TO THE SPECIFIED COLUMN
.,AB0F E8       INX XSPAC:  INX
aus Zähler initialisieren
increment count

.,AB10 CA       DEX XSPAC2: DEX                     ;DECREMENT THE COUNT.
um 1 vermindern
decrement count

.,AB11 D0 06    BNE $AB19         BNE     XSPAC1
=0? nein: Cursor right
branch if count was not zero
was ";" or [SPACES] printed
MORE SPACES TO PRINT

.,AB13 20 73 00 JSR $0073 NOTABR: JSR     CHRGET          ;REGET LAST CHARACTER.
nächstes Zeichen holen
increment and scan memory

.,AB16 4C A2 AA JMP $AAA2         JMP     PRINTC          ;DON'T CALL CRDO.
und weitermachen
continue print loop
CONTINUE PARSING PRINT LIST

.,AB19 20 3B AB JSR $AB3B XSPAC1: JSR     OUTSPC
Cursor right bzw. Leerzeichen
print [SPACE] or [CURSOR RIGHT]

.,AB1C D0 F2    BNE $AB10         BNEA    XSPAC2
;
; PRINT THE STRING POINTED TO BY [Y,A] WHICH ENDS WITH A ZERO.
; IF THE STRING IS BELOW DSCTMP IT WILL BE COPIED INTO STRING SPACE.
;
zum Schleifenanfang

String ausgeben

loop, branch always

print null terminated string

...ALWAYS

PRINT STRING AT (Y,A)

.,AB1E 20 87 B4 JSR $B487 STROUT: JSR     STRLIT          ;GET A STRING LITERAL.
;
; PRINT THE STRING WHOSE DESCRIPTOR IS POINTED TO BY FACMO.
;
Stringparameter holen
print " terminated string to utility pointer

print string from utility pointer

MAKE (Y,A) PRINTABLE

PRINT STRING AT (FACMO,FACLO)

.,AB21 20 A6 B6 JSR $B6A6 STRPRT: JSR     FREFAC          ;RETURN TEMP POINTER.
FRESTR
pop string off descriptor stack, or from top of string
space returns with A = length, X = pointer low byte,
Y = pointer high byte
GET ADDRESS INTO INDEX, (A)=LENGTH
.,AB24 AA       TAX         TAX                     ;PUT COUNT INTO COUNTER.
Stringlänge
copy length
USE X-REG FOR COUNTER
.,AB25 A0 00    LDY #$00         LDYI    0
Zeiger für Stringausgabe
clear index
USE Y-REG FOR SCANNER
.,AB27 E8       INX         INX                     ;MOVE ONE AHEAD.
erhöhen
increment length, for pre decrement loop

.,AB28 CA       DEX STRPR2: DEX
vermindern
decrement length

.,AB29 F0 BC    BEQ $AAE7         BEQ     PRTRTS          ;ALL DONE.
String zu Ende?
exit if done
FINISHED
.,AB2B B1 22    LDA ($22),Y         LDADY   INDEX           ;PNTR TO ACT STRNG SET BY FREFAC.
Zeichen des Strings
get byte from string
NEXT CHAR FROM STRING
.,AB2D 20 47 AB JSR $AB47         JSR     OUTDO
ausgeben
print the character
PRINT THE CHAR
.,AB30 C8       INY         INY
Zeiger erhöhen
increment index

<<< NEXT THREE LINES ARE USELESS >>>
.,AB31 C9 0D    CMP #$0D         CMPI    13
'CR' carriage return?
compare byte with [CR]
WAS IT <RETURN>?
.,AB33 D0 F3    BNE $AB28         BNE     STRPR2
nein: weiter
loop if not [CR]
NO
.,AB35 20 E5 AA JSR $AAE5         JSR     CRFIN           ;TYPE REST OF CARRIAGE RETURN.
Fehler ! Test auf LF-Ausgabe
toggle A, EOR #$FF. what is the point of this ??
EOR #$FF WOULD DO IT, BUT WHY?
<<< ABOVE THREE LINES ARE USELESS >>>
.,AB38 4C 28 AB JMP $AB28         JMP     STRPR2          ;AND ON AND ON.
;
; OUTDO OUTPUTS THE CHARACTER IN ACCA, USING CNTWFL
; (SUPPRESS OR NOT), TRMPOS (PRINT HEAD POSITION),
; TIMING, ETCQ. NO REGISTERS ARE CHANGED.
;
OUTSPC:
IFN     REALIO-3,<
        LDAI    " ">
IFE     REALIO-3,<
und weitermachen

Ausgabe eines Leerzeichens

bzw. Cursor right

loop

print [SPACE] or [CURSOR RIGHT]



.,AB3B A5 13    LDA $13         LDA     CHANNL
Ausgabe in File?
get current I/O channel

.,AB3D F0 03    BEQ $AB42         BEQ     CRTSKP
Bildschirm: dann Cursor right
if default channel go output [CURSOR RIGHT]

.,AB3F A9 20    LDA #$20         LDAI    " "
' ' Leerzeichencode laden
else output [SPACE]
PRINT A SPACE
.:AB41 2C       .BYTE $2C         SKIP2

makes next line BIT $1DA9
SKIP OVER NEXT LINE
.,AB42 A9 1D    LDA #$1D CRTSKP: LDAI    29> ;COMMODORE'S SKIP CHARACTER.
Cursor right Code laden
set [CURSOR RIGHT]

.:AB44 2C       .BYTE $2C         SKIP2

makes next line BIT $3FA9

print "?"

SKIP OVER NEXT LINE
.,AB45 A9 3F    LDA #$3F OUTQST: LDAI    "?"
OUTDO:  IFN     REALIO,<
        BIT     CNTWFL          ;SHOULDN'T AFFECT CHANNEL I/O!
        BMI     OUTRTS>
IFN     REALIO-3,<
        PHA
        CMPI    32              ;IS THIS A PRINTING CHAR?
        BCC     TRYOUT          ;NO, DON'T INCLUDE IT IN TRMPOS.
        LDA     TRMPOS
        CMP     LINWID          ;LENGTH = TERMINAL WIDTH?
        BNE     OUTDO1
        JSR     CRDO            ;YES, TYPE CRLF
OUTDO1:
IFN EXTIO,<
        LDA     CHANNL
        BNE     TRYOUT>
INCTRM: INC     TRMPOS          ;INCREMENT COUNT.
TRYOUT: PLA> ;RESTORE THE A REGISTER

IFE     REALIO-1,<
        STY     KIMY> ;PRESERVE Y.
IFE     REALIO-4,<ORAI ^O200> ;TURN ON B7 FOR APPLE.
IFN     REALIO,<
'?' Fragezeichencode laden
set "?"

print character

PRINT QUESTION MARK
.,AB47 20 0C E1 JSR $E10C OUTLOC: JSR     OUTCH> ;OUTPUT THE CHARACTER.
IFE     REALIO-1,<
        LDY     KIMY> ;GET Y BACK.
IFE     REALIO-2,<REPEAT 4,<NOP>>
IFE     REALIO-4,<ANDI ^O177> ;GET [A] BACK FROM APPLE.

IFE     REALIO,<
        TJSR    OUTSIM##> ;CALL SIMULATOR OUTPUT ROUTINE
Code ausgeben
output character to channel with error check

.,AB4A 29 FF    AND #$FF OUTRTS: ANDI    255             ;SET Z=0.
Flags setzen
set the flags on A


PRINT CHAR FROM (A)

NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT
OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED
BY NORMAL, INVERSE, OR FLASH OR POKE 243,0.
.,AB4C 60       RTS GETRTS: RTS

PAGE

INPUT AND READ CODE.

;
; HERE WHEN THE DATA THAT WAS TYPED IN OR IN "DATA" STATEMENTS
; IS IMPROPERLY FORMATTED. FOR "INPUT" WE START AGAIN.
; FOR "READ" WE GIVE A SYNTAX ERROR AT THE DATA LINE.
;
Rücksprung

Fehlerbehandlung bei Eingabe



bad input routine



INPUT CONVERSION ERROR

ILLEGAL CHARACTER IN NUMERIC FIELD.
MUST DISTINGUISH BETWEEN INPUT, READ, AND GET
.,AB4D A5 11    LDA $11 TRMNOK: LDA     INPFLG
Flag für INPUT / GET / READ
get INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ

.,AB4F F0 11    BEQ $AB62         BEQ     TRMNO1          ;IF INPUT TRY AGAIN.
IFN     GETCMD,<
INPUT: $AB62
branch if INPUT
TAKEN IF INPUT
.,AB51 30 04    BMI $AB57         BMI     GETDTL
READ: $AB57
branch if READ
else was GET
TAKEN IF READ
.,AB53 A0 FF    LDY #$FF         LDYI    255             ;MAKE IT LOOK DIRECT.
GET:
set current line high byte to -1, indicate immediate mode
FROM A GET
.,AB55 D0 04    BNE $AB5B         BNEA    STCURL          ;ALWAYS GOES.
GETDTL:>
unbedingter Sprung

Fehler bei READ

branch always
...ALWAYS

.,AB57 A5 3F    LDA $3F         LDWD    DATLIN          ;GET DATA LINE NUMBER.
DATA-Zeilennummer
get current DATA line number low byte
TELL WHERE THE "DATA" IS, RATHER
.,AB59 A4 40    LDY $40
holen (LOW- und HIGH-Byte)

Fehler bei GET

get current DATA line number high byte
THAN THE "READ"
.,AB5B 85 39    STA $39 STCURL: STWD    CURLIN          ;MAKE IT CURRENT LINE.
gleiche Zeilennummer
set current line number low byte

.,AB5D 84 3A    STY $3A
des Fehlers
set current line number high byte

.,AB5F 4C 08 AF JMP $AF08 SNERR4: JMP     SNERR
TRMNO1:
IFN     EXTIO,<
'SYNTAX ERROR'

Fehler bei INPUT

do syntax error then warm start
was INPUT

.,AB62 A5 13    LDA $13         LDA     CHANNL          ;IF NOT TERMINAL, GIVE BAD DATA.
Nummer des Eingabegeräts
get current I/O channel

.,AB64 F0 05    BEQ $AB6B         BEQ     DOAGIN
Tastatur: 'REDO FROM START'
branch if default channel


.,AB66 A2 18    LDX #$18         LDXI    ERRBD
Nummer für 'FILE DATA'
else error $18, file data error
ERROR CODE = 254
.,AB68 4C 37 A4 JMP $A437         JMP     ERROR>
Fehlermeldung ausgeben
do error #X then warm start

.,AB6B A9 0C    LDA #$0C DOAGIN: LDWDI   TRYAGN
Zeiger in Akku und Y-Reg.
set "?REDO FROM START" pointer low byte
"?REENTER"
.,AB6D A0 AD    LDY #$AD
auf '?REDO FROM START'
set "?REDO FROM START" pointer high byte

.,AB6F 20 1E AB JSR $AB1E         JSR     STROUT          ;PRINT "?REDO FROM START".
String ausgeben
print null terminated string

.,AB72 A5 3D    LDA $3D         LDWD    OLDTXT          ;POINT AT START
Werte holen und
get continue pointer low byte
RE-EXECUTE THE WHOLE INPUT STATEMENT
.,AB74 A4 3E    LDY $3E
Programmzeiger
get continue pointer high byte

.,AB76 85 7A    STA $7A         STWD    TXTPTR          ;OF THIS CURRENT LINE.
zurücksetzen
save BASIC execute pointer low byte

.,AB78 84 7B    STY $7B
auf INPUT-Befehl
save BASIC execute pointer high byte

.,AB7A 60       RTS         RTS                     ;GO TO "NEWSTT".
IFN     GETCMD,<
Rücksprung

BASIC-Befehl GET



perform GET



"GET" STATEMENT

.,AB7B 20 A6 B3 JSR $B3A6 GET:    JSR     ERRDIR          ;DIRECT IS NOT OK.
IFN     EXTIO,<
Testet auf Direkt-Modus
check not Direct, back here if ok
ILLEGAL IF IN DIRECT MODE
.,AB7E C9 23    CMP #$23         CMPI    "#"             ;SEE IF "GET#".
folgt '#’?
compare with "#"

.,AB80 D0 10    BNE $AB92         BNE     GETTTY          ;NO, JUST GET TTY INPUT.
nein: $AB92
branch if not GET#

.,AB82 20 73 00 JSR $0073         JSR     CHRGET          ;MOVE UP TO NEXT BYTE.
CHRGET nächstes Zeichen holen
increment and scan memory

.,AB85 20 9E B7 JSR $B79E         JSR     GETBYT          ;GET CHANNEL INTO X
Byte-Wert holen
get byte parameter

.,AB88 A9 2C    LDA #$2C         SYNCHK  44              ;COMMA?
',' Komma
set ","

.,AB8A 20 FF AE JSR $AEFF
prüft auf Code
scan for CHR$(A), else do syntax error then warm start

.,AB8D 86 13    STX $13         JSR     CQOIN           ;GET CHANNEL OPEN FOR INPUT.
Filenummer
set current I/O channel

.,AB8F 20 1E E1 JSR $E11E         STX     CHANNL>
CHKIN, Eingabe vorbereiten
open channel for input with error check

.,AB92 A2 01    LDX #$01 GETTTY: LDXYI   BUF+1           ;POINT TO 0.
Zeiger auf
set pointer low byte
SIMULATE INPUT
.,AB94 A0 02    LDY #$02 IFN     BUFPAG,<
Pufferende = $201 ein Zeichen
set pointer high byte

.,AB96 A9 00    LDA #$00         LDAI    0               ;TO STUFF AND TO POINT.
Wert laden und
clear A

.,AB98 8D 01 02 STA $0201         STA     BUF+1>
IFE     BUFPAG,<
        STY     BUF+1> ;ZERO IT.
Puffer mit $0 abschließen
ensure null terminator

.,AB9B A9 40    LDA #$40         LDAI    64              ;TURN ON V-BIT.
GET-Flag
input mode = GET
SET UP INPUTFLG
.,AB9D 20 0F AC JSR $AC0F         JSR     INPCO1          ;DO THE GET.
IFN     EXTIO,<
Wertzuweisung an Variable
perform the GET part of READ

.,ABA0 A6 13    LDX $13         LDX     CHANNL
Eingabegerät
get current I/O channel

.,ABA2 D0 13    BNE $ABB7         BNE     IORELE> ;RELEASE.
nicht Tastatur, dann CLRCH
if not default channel go do channel close and return

.,ABA4 60       RTS         RTS>

IFN     EXTIO,<
Rücksprung

BASIC-Befehl INPUT#



perform INPUT#



.,ABA5 20 9E B7 JSR $B79E INPUTN: JSR     GETBYT          ;GET CHANNEL NUMBER.
holt Byte-Wert
get byte parameter

.,ABA8 A9 2C    LDA #$2C         SYNCHK  44              ;A COMMA?
',' Code für Komma
set ","

.,ABAA 20 FF AE JSR $AEFF
prüft auf Komma
scan for CHR$(A), else do syntax error then warm start

.,ABAD 86 13    STX $13         JSR     CQOIN           ;GO WHERE COMMODORE CHECKS IN OPEN.
Eingabegerät
set current I/O channel

.,ABAF 20 1E E1 JSR $E11E         STX     CHANNL
CHKIN, Eingabe vorbereiten
open channel for input with error check

.,ABB2 20 CE AB JSR $ABCE         JSR     NOTQTI          ;DO INPUT TO VARIABLES.
INPUT ohne Dialogstring
perform INPUT with no prompt string

close input and output channels


.,ABB5 A5 13    LDA $13 IODONE: LDA     CHANNL          ;RELEASE CHANNEL.
Eingabegerät im Akku
get current I/O channel

.,ABB7 20 CC FF JSR $FFCC IORELE: JSR     CQCCHN
setzt Eingabegerät zurück
close input and output channels

.,ABBA A2 00    LDX #$00         LDXI    0               ;RESET CHANNEL TO TERMINAL.
Wert laden und
clear X

.,ABBC 86 13    STX $13         STX     CHANNL
Eingabegerät wieder Tastatur
clear current I/O channel, flag default

.,ABBE 60       RTS         RTS>
INPUT:  IFN     REALIO,<
        LSR     CNTWFL> ;BE TALKATIVE.
Rücksprung

BASIC-Befehl INPUT



perform INPUT




"INPUT" STATEMENT

.,ABBF C9 22    CMP #$22         CMPI    34              ;A QUOTE?
'"' Hochkomma?
compare next byte with open quote
CHECK FOR OPTIONAL PROMPT STRING
.,ABC1 D0 0B    BNE $ABCE         BNE     NOTQTI          ;NO MESSAGE.
nein: $ABDE
if no prompt string just do INPUT
NO, PRINT "?" PROMPT
.,ABC3 20 BD AE JSR $AEBD         JSR     STRTXT          ;LITERALIZE THE STRING IN TEXT
Dialogstring holen
print "..." string
MAKE A PRINTABLE STRING OUT OF IT
.,ABC6 A9 3B    LDA #$3B         SYNCHK  59              ;MUST END WITH SEMICOLON.
';' Semikolon
load A with ";"
MUST HAVE ; NOW
.,ABC8 20 FF AE JSR $AEFF
prüft auf Code
scan for CHR$(A), else do syntax error then warm start

.,ABCB 20 21 AB JSR $AB21         JSR     STRPRT          ;PRINT IT OUT.
String ausgeben
print string from utility pointer
done with prompt, now get data
PRINT THE STRING
.,ABCE 20 A6 B3 JSR $B3A6 NOTQTI: JSR     ERRDIR          ;USE COMMON ROUTINE SINCE DEF DIRECT
prüft auf Direkt-Modus
check not Direct, back here if ok
ILLEGAL IF IN DIRECT MODE
.,ABD1 A9 2C    LDA #$2C         LDAI    44              ;GET COMMA.
',' Komma
set ","
PRIME THE BUFFER
.,ABD3 8D FF 01 STA $01FF         STA     BUF-1
                                ;IS ALSO ILLEGAL.
an Pufferstart
save to start of buffer - 1

.,ABD6 20 F9 AB JSR $ABF9 GETAGN: JSR     QINLIN          ;TYPE "?" AND INPUT A LINE OF TEXT.
IFN     EXTIO,<
Fragezeichen ausgeben
print "? " and get BASIC input
NO STRING, PRINT "?"
.,ABD9 A5 13    LDA $13         LDA     CHANNL
Nummer des Eingabegeräts
get current I/O channel

.,ABDB F0 0D    BEQ $ABEA         BEQ     BUFFUL
Tastatur? ja: $ABEA
branch if default I/O channel

.,ABDD 20 B7 FF JSR $FFB7         LDA     CQSTAT          ;GET STATUS BYTE.
Status holen
read I/O status word

.,ABE0 29 02    AND #$02         ANDI    2
Bit 1 isolieren (Tineout R.)
mask no DSR/timeout

.,ABE2 F0 06    BEQ $ABEA         BEQ     BUFFUL          ;A-OK.
Time-out?
branch if not error

.,ABE4 20 B5 AB JSR $ABB5         JSR     IODONE          ;BAD. CLOSE CHANNEL.
ja: CLRCH,Tastatur aktivieren
close input and output channels

.,ABE7 4C F8 A8 JMP $A8F8         JMP     DATA            ;SKIP REST OF INPUT.
BUFFUL:>
nächstes Statement ausführen
perform DATA

.,ABEA AD 00 02 LDA $0200         LDA     BUF             ;ANYTHING INPUT?
erstes Zeichen holen
get first byte in input buffer

.,ABED D0 1E    BNE $AC0D         BNE     INPCON          ;YES, CONTINUE.
IFN     EXTIO,<
Ende?
branch if not null
else ..

.,ABEF A5 13    LDA $13         LDA     CHANNL          ;BLANK LINE MEANS GET ANOTHER.
ja: Eingabegerät
get current I/O channel

.,ABF1 D0 E3    BNE $ABD6         BNE     GETAGN> ;IF NOT TERMINAL.
nicht Tastatur: $ABD6
if not default channel go get BASIC input

.,ABF3 20 06 A9 JSR $A906         CLC                     ;MAKE SURE DONT PRINT BREAK
Offset (Statement) suchen
scan for next BASIC statement ([:] or [EOL])

.,ABF6 4C FB A8 JMP $A8FB         JMP     STPEND          ;NO, STOP.
QINLIN:
IFN     EXTIO,<
Programmzeiger auf Statement
add Y to the BASIC execute pointer and return

print "? " and get BASIC input


.,ABF9 A5 13    LDA $13         LDA     CHANNL
Eingabegerät holen
get current I/O channel

.,ABFB D0 06    BNE $AC03         BNE     GINLIN>
nicht Tastatur: $AC03
skip "?" prompt if not default channel

.,ABFD 20 45 AB JSR $AB45         JSR     OUTQST
'?' ausgeben
print "?"

.,AC00 20 3B AB JSR $AB3B         JSR     OUTSPC
' ' Leerzeichen ausgeben
print [SPACE] or [CURSOR RIGHT]

.,AC03 4C 60 A5 JMP $A560 GINLIN: JMP     INLIN
Eingabezeile holen

BASIC-Befehl READ

call for BASIC input and return

perform READ



"READ" STATEMENT

.,AC06 A6 41    LDX $41 READ:   LDXY    DATPTR          ;GET LAST DATA LOCATION.
DATA-Zeiger nach
get DATA pointer low byte
Y,X POINTS AT NEXT DATA STATEMENT
.,AC08 A4 42    LDY $42
$41/42 holen
get DATA pointer high byte

.,AC0A A9 98    LDA #$98         XWD     ^O1000,^O251    ;LDAI TYA TO MAKE IT NONZERO.
IFE     BUFPAG,<
INPCON: >
        TYA
IFN     BUFPAG,<
READ-Flag
set input mode = READ
SET INPUTFLG = $98
.:AC0C 2C       .BYTE $2C         SKIP2

makes next line BIT $00A9


.,AC0D A9 00    LDA #$00 INPCON: LDAI    0> ;SET FLAG THAT THIS IS INPUT
Flagwert laden
set input mode = INPUT

perform GET

SET INPUTFLG = $00

PROCESS INPUT LIST

(Y,X) IS ADDRESS OF INPUT DATA STRING
(A) = VALUE FOR INPUTFLG: $00 FOR INPUT
$40 FOR GET
$98 FOR READ
.,AC0F 85 11    STA $11 INPCO1: STA     INPFLG          ;STORE THE FLAG.
;
; IN THE PROCESSING OF DATA AND READ STATEMENTS:
; ONE POINTER POINTS TO THE DATA (IE, THE NUMBERS BEING FETCHED)
; AND ANOTHER POINTS TO THE LIST OF VARIABLES.
;
; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A
; TERMINATOR -- A , : OR END-OF-LINE.
;
; AT THIS POINT TXTPTR POINTS TO LIST OF VARIABLES AND
; [Y,X] POINTS TO DATA OR INPUT LINE.
;
und INPUT-Zeiger setzen
set input mode flag, $00 = INPUT, $40 = GET, $98 = READ

.,AC11 86 43    STX $43         STXY    INPPTR
INPUT-Zeiger auf
save READ pointer low byte
ADDRESS OF INPUT STRING
.,AC13 84 44    STY $44
Eingabequelle setzen
save READ pointer high byte
READ, GET or INPUT next variable from list


.,AC15 20 8B B0 JSR $B08B INLOOP: JSR     PTRGET          ;READ VARIABLE LIST.
sucht Variable
get variable address
GET ADDRESS OF VARIABLE
.,AC18 85 49    STA $49         STWD    FORPNT          ;SAVE POINTER FOR "LET" STRING STUFFING.
Vari ablenadresse
save address low byte

.,AC1A 84 4A    STY $4A                                 ;RETURNS PNTR TOP VAR IN VARPNT.
speichern
save address high byte

.,AC1C A5 7A    LDA $7A         LDWD    TXTPTR          ;SAVE TEXT PNTR.
LOW- und HIGH-Byte des
get BASIC execute pointer low byte
SAVE CURRENT TXTPTR,
.,AC1E A4 7B    LDY $7B
Programmzeigers
get BASIC execute pointer high byte
WHICH POINTS INTO PROGRAM
.,AC20 85 4B    STA $4B         STWD    VARTXT
in $4B/$4C
save BASIC execute pointer low byte

.,AC22 84 4C    STY $4C
Zwischenspeichern
save BASIC execute pointer high byte

.,AC24 A6 43    LDX $43         LDXY    INPPTR
INPUT-Zeiger
get READ pointer low byte
SET TXTPTR TO POINT AT INPUT BUFFER
.,AC26 A4 44    LDY $44
(LOW und HIGH)
get READ pointer high byte
OR "DATA" LINE
.,AC28 86 7A    STX $7A         STXY    TXTPTR
als Programmzeiger
save as BASIC execute pointer low byte

.,AC2A 84 7B    STY $7B
abspeichern
save as BASIC execute pointer high byte

.,AC2C 20 79 00 JSR $0079         JSR     CHRGOT          ;GET IT AND SET Z IF TERM.
CHRGOT letztes Zeichen holen
scan memory
GET CHAR AT PNTR
.,AC2F D0 20    BNE $AC51         BNE     DATBK1
Endzeichen? nein: $AC51
branch if not null
pointer was to null entry
NOT END OF LINE OR COLON
.,AC31 24 11    BIT $11         BIT     INPFLG
IFN     GETCMD,<
Eingabeflag
test input mode flag, $00 = INPUT, $40 = GET, $98 = READ
DOING A "GET"?
.,AC33 50 0C    BVC $AC41         BVC     QDATA
kein GET: $AC41
branch if not GET
else was GET
NO
.,AC35 20 24 E1 JSR $E124         JSR     CZGETL          ;DON'T WANT INCHR. JUST ONE.
IFE     REALIO-4,<
        ANDI    127>
GETIN
get character from input device with error check
YES, GET CHAR
.,AC38 8D 00 02 STA $0200         STA     BUF             ;MAKE IT FIRST CHARACTER.
Zeichen in Puffer schreiben
save to buffer

.,AC3B A2 FF    LDX #$FF         LDXYI   <BUF-1> ;POINT JUST BEFORE IT.
Zeiger auf
set pointer low byte

.,AC3D A0 01    LDY #$01 IFE     BUFPAG,<
Puffer setzen
set pointer high byte

.,AC3F D0 0C    BNE $AC4D         BEQA    DATBK>
unbedingter Sprung
go interpret single character
...ALWAYS

.,AC41 30 75    BMI $ACB8
IFN     BUFPAG,<
        BNEA    DATBK>> ;GO PROCESS.
QDATA:  BMI     DATLOP          ;SEARCH FOR ANOTHER DATA STATEMENT.
IFN     EXTIO,<
READ: $ACB8
branch if READ
else was INPUT
DOING A "READ"
.,AC43 A5 13    LDA $13         LDA     CHANNL
Eingabegerät holen
get current I/O channel

.,AC45 D0 03    BNE $AC4A         BNE     GETNTH>
nicht Tastatur: $AC4A
skip "?" prompt if not default channel

.,AC47 20 45 AB JSR $AB45         JSR     OUTQST
Fragezeichen ausgeben
print "?"
DOING AN "INPUT", PRINT "?"
.,AC4A 20 F9 AB JSR $ABF9 GETNTH: JSR     QINLIN          ;GET ANOTHER LINE.
zweites Fragezeichen ausgeben
print "? " and get BASIC input
PRINT ANOTHER "?", AND INPUT A LINE
.,AC4D 86 7A    STX $7A DATBK:  STXY    TXTPTR          ;SET FOR "CHRGET".
Programmzeiger setzen
save BASIC execute pointer low byte

.,AC4F 84 7B    STY $7B
(LOW und HIGH)
save BASIC execute pointer high byte


.,AC51 20 73 00 JSR $0073 DATBK1: JSR     CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory, execute pointer now points to
start of next data or null terminator
GET NEXT INPUT CHAR
.,AC54 24 0D    BIT $0D         BIT     VALTYP          ;GET VALUE TYPE.
Typ-Flag
test data type flag, $FF = string, $00 = numeric
STRING OR NUMERIC?
.,AC56 10 31    BPL $AC89         BPL     NUMINS          ;INPUT A NUMBER IF NUMERIC.
IFN     GETCMD,<
kein String: $AC89
branch if numeric
type is string
NUMERIC
.,AC58 24 11    BIT $11         BIT     INPFLG          ;GET?
Eingabeflag
test INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
STRING -- NOW WHAT INPUT TYPE?
.,AC5A 50 09    BVC $AC65         BVC     SETQUT          ;NO, GO SET QUOTE.
kein GET: $AC65
branch if not GET
else do string GET
NOT A "GET"
.,AC5C E8       INX         INX
Programmzeiger erhöhen
clear X ??
"GET"
.,AC5D 86 7A    STX $7A         STX     TXTPTR
und neu setzen ($0200)
save BASIC execute pointer low byte

.,AC5F A9 00    LDA #$00         LDAI    0               ;ZERO TERMINATORS.
Wert laden und
clear A

.,AC61 85 07    STA $07         STA     CHARAC
Trennzeichen setzen
clear search character
NO OTHER TERMINATORS THAN $00
.,AC63 F0 0C    BEQ $AC71         BEQA    RESETC>
unbedingter Sprung
branch always
is string INPUT or string READ
...ALWAYS

.,AC65 85 07    STA $07 SETQUT: STA     CHARAC          ;ASSUME QUOTED STRING.
nächstes Zeichen
save search character

.,AC67 C9 22    CMP #$22         CMPI    34              ;TERMINATORS OK?
'"' Hochkomma?
compare with "
TERMINATE ON $00 OR QUOTE
.,AC69 F0 07    BEQ $AC72         BEQ     NOWGET          ;YES.
ja: $AC72
branch if quote
string is not in quotes so ":", "," or $00 are the
termination characters

.,AC6B A9 3A    LDA #$3A         LDAI    ":"             ;SET TERMINATORS TO ":" AND
':' Doppelpunktcode laden
set ":"
TERMINATE ON $00, COLON, OR COMMA
.,AC6D 85 07    STA $07         STA     CHARAC
und abspeichern
set search character

.,AC6F A9 2C    LDA #$2C         LDAI    44              ;COMMA.
',' Kommacode (Endzeichen
set ","

.,AC71 18       CLC RESETC: CLC
für Stringübertragung)
clear carry for add

.,AC72 85 08    STA $08 NOWGET: STA     ENDCHR
abspeichern
set scan quotes flag

.,AC74 A5 7A    LDA $7A         LDWD    TXTPTR
Programmzeiger laden
get BASIC execute pointer low byte

.,AC76 A4 7B    LDY $7B
(LOW und HIGH)
get BASIC execute pointer high byte

.,AC78 69 00    ADC #$00         ADCI    0               ;C IS SET PROPERLY ABOVE.
und Übertrag addieren
add to pointer low byte. this add increments the pointer
if the mode is INPUT or READ and the data is a "..."
string
SKIP OVER QUOTATION MARK, IF
.,AC7A 90 01    BCC $AC7D         BCC     NOWGE1
C = 0: $AC7D
branch if no rollover
THERE WAS ONE
.,AC7C C8       INY         INY
bei "'" um 1 erhöhen
else increment pointer high byte

.,AC7D 20 8D B4 JSR $B48D NOWGE1: JSR     STRLT2          ;MAKE A STRING DESCRIPTOR FOR THE VALUE
                                ;AND COPY IF NECESSARY.
String übernehmen
print string to utility pointer
BUILD STRING STARTING AT (Y,A)
TERMINATED BY $00, (CHARAC), OR (ENDCHR)
.,AC80 20 E2 B7 JSR $B7E2         JSR     ST2TXT          ;SET TEXT POINTER.
Programmzeiger hinter String
restore BASIC execute pointer from temp
SET TXTPTR TO POINT AT STRING
.,AC83 20 DA A9 JSR $A9DA         JSR     INPCOM          ;DO ASSIGNMENT.
String an Variable zuweisen
perform string LET
STORE STRING IN VARIABLE
.,AC86 4C 91 AC JMP $AC91         JMP     STRDN2
weiter machen
continue processing command
GET, INPUT or READ is numeric


.,AC89 20 F3 BC JSR $BCF3 NUMINS: JSR     FIN
IFE     INTPRC,<
        JSR     MOVVF>
IFN     INTPRC,<
Ziffernstring in FAC holen
get FAC1 from string
GET FP NUMBER AT TXTPTR
.,AC8C A5 0E    LDA $0E         LDA     INTFLG          ;SET CODES ON FLAG.
INTEGER/REAL-Flag
get data type flag, $80 = integer, $00 = float

.,AC8E 20 C2 A9 JSR $A9C2         JSR     QINTGR> ;GO DECIDE ON FLOAT.
FAC an numerische Variable
assign value to numeric variable
STORE RESULT IN VARIABLE

.,AC91 20 79 00 JSR $0079 STRDN2: JSR     CHRGOT          ;READ LAST CHARACTER.
CHRGOT: letztes Zeichen holen
scan memory

.,AC94 F0 07    BEQ $AC9D         BEQ     TRMOK           ;":" OR EOL IS OK.
Ende?
branch if ":" or [EOL]
END OF LINE OR COLON
.,AC96 C9 2C    CMP #$2C         CMPI    44              ;A COMMA?
',' Code?
comparte with ","
COMMA IN INPUT?
.,AC98 F0 03    BEQ $AC9D         JNE     TRMNOK
ja: $AC9D
branch if ","
YES
.,AC9A 4C 4D AB JMP $AB4D
zur Fehlerbehandlung
else go do bad input routine
string terminated with ":", "," or $00
NOTHING ELSE WILL DO
.,AC9D A5 7A    LDA $7A TRMOK:  LDWD    TXTPTR
Programmzeiger
get BASIC execute pointer low byte
SAVE POSITION IN INPUT BUFFER
.,AC9F A4 7B    LDY $7B
holen und
get BASIC execute pointer high byte

.,ACA1 85 43    STA $43         STWD    INPPTR          ;SAVE FOR MORE READS.
in DATA-Zeiger
save READ pointer low byte

.,ACA3 84 44    STY $44
abspeichern
save READ pointer high byte

.,ACA5 A5 4B    LDA $4B         LDWD    VARTXT
ursprüngliche
get saved BASIC execute pointer low byte
RESTORE PROGRAM POINTER
.,ACA7 A4 4C    LDY $4C
Programmzeiger
get saved BASIC execute pointer high byte

.,ACA9 85 7A    STA $7A         STWD    TXTPTR          ;POINT TO VARIABLE LIST.
wieder zurückholen
restore BASIC execute pointer low byte

.,ACAB 84 7B    STY $7B
und speichern
restore BASIC execute pointer high byte

.,ACAD 20 79 00 JSR $0079         JSR     CHRGOT          ;LOOK AT LAST VARIABLE LIST CHARACTER.
CHRGOT: letztes Zeichen holen
scan memory
NEXT CHAR FROM PROGRAM
.,ACB0 F0 2D    BEQ $ACDF         BEQ     VAREND          ;THAT'S THE END OF THE LIST.
Trennzeichen: $ACDF
branch if ":" or [EOL]
END OF STATEMENT
.,ACB2 20 FD AE JSR $AEFD         JSR     CHKCOM          ;NOT END. CHECK FOR COMMA.
CKCOM: prüft auf Komma
scan for ",", else do syntax error then warm start
BETTER BE A COMMA THEN
.,ACB5 4C 15 AC JMP $AC15         JMP     INLOOP
;
; SUBROUTINE TO FIND DATA
; THE SEARCH IS MADE BY USING THE EXECUTION CODE FOR DATA TO
; SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT
; IS COMPARED WITH "DATATK". EACH NEW LINE NUMBER
; IS STORED IN "DATLIN" SO THAT IF AN ERROR OCCURS
; WHILE READING DATA THE ERROR MESSAGE CAN GIVE THE LINE
; NUMBER OF THE ILL-FORMATTED DATA.
;
weiter
go READ or INPUT next variable from list
was READ


.,ACB8 20 06 A9 JSR $A906 DATLOP: JSR     DATAN           ;SKIP SOME TEXT.
nächstes Statement suchen
scan for next BASIC statement ([:] or [EOL])
GET OFFSET TO NEXT COLON OR EOL
.,ACBB C8       INY         INY
Offset erhöhen
increment index to next byte
TO FIRST CHAR OF NEXT LINE
.,ACBC AA       TAX         TAX                     ;END OF LINE?
Zeilenende?
copy byte to X
WHICH: EOL OR COLON?
.,ACBD D0 12    BNE $ACD1         BNE     NOWLIN          ;SHO AIN'T.
nein: $ACD1
branch if ":"
COLON
.,ACBF A2 0D    LDX #$0D         LDXI    ERROD           ;YES = "NO DATA" ERROR.
'OUT OF DATA' Code
else set error $0D, out of data error
EOL: MIGHT BE OUT OF DATA
.,ACC1 C8       INY         INY
Zeiger erhöhen
increment index to next line pointer high byte
CHECK HI-BYTE OF FORWARD PNTR
.,ACC2 B1 7A    LDA ($7A),Y         LDADY   TXTPTR
Programmende?
get next line pointer high byte
END OF PROGRAM?
.,ACC4 F0 6C    BEQ $AD32         BEQ     ERRGO5
ja: 'OUT OF DATA', X = 0
branch if program end, eventually does error X
YES, WE ARE OUT OF DATA
.,ACC6 C8       INY         INY
Zeiger erhöhen
increment index
PICK UP THE LINE #
.,ACC7 B1 7A    LDA ($7A),Y         LDADY   TXTPTR          ;GET HIGH BYTE OF LINE NUMBER.
Zeilennummer (LOW) holen
get next line # low byte

.,ACC9 85 3F    STA $3F         STA     DATLIN
und abspeichern
save current DATA line low byte

.,ACCB C8       INY         INY
Zeiger erhöhen
increment index

.,ACCC B1 7A    LDA ($7A),Y         LDADY   TXTPTR          ;GET LOW BYTE.
Zeilenummer (HIGH)
get next line # high byte

.,ACCE C8       INY         INY
Zeiger erhöhen
increment index
POINT AT FIRST TEXT CHAR IN LINE
.,ACCF 85 40    STA $40         STA     DATLIN+1
Zeilennummer speichern
save current DATA line high byte

.,ACD1 20 FB A8 JSR $A8FB NOWLIN: LDADY   TXTPTR          ;HOW IS IT?
Programmz. auf Statement
add Y to the BASIC execute pointer
GET 1ST TOKEN OF STATEMENT
.,ACD4 20 79 00 JSR $0079         TAX
CHRGOT letztes Zeichen holen
scan memory

.,ACD7 AA       TAX         JSR     ADDON           ;ADD [Y] TO [TXTPTR].
und ins X-Reg.
copy the byte
SAVE TOKEN IN X-REG
.,ACD8 E0 83    CPX #$83         CPXI    DATATK          ;IS IT A "DATA" STATEMENT.
'DATA' Code?
compare it with token for DATA
DID WE FIND A "DATA" STATEMENT?
.,ACDA D0 DC    BNE $ACB8         BNE     DATLOP          ;NOT QUITE RIGHT. KEEP LOOKING.
nein: weitersuchen
loop if not DATA
NOT YET
.,ACDC 4C 51 AC JMP $AC51         JMP     DATBK1          ;THIS IS THE ONE !
Daten lesen
continue evaluating READ
YES, READ IT

NO MORE INPUT REQUESTED
.,ACDF A5 43    LDA $43 VAREND: LDWD    INPPTR          ;PUT AWAY A NEW DATA PNTR MAYBE.
LOW- und HIGH-Byte des
get READ pointer low byte
GET POINTER IN CASE IT WAS "READ"
.,ACE1 A4 44    LDY $44
Input-Zeigers
get READ pointer high byte

.,ACE3 A6 11    LDX $11         LDX     INPFLG
Eingabe-Flag
get INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
"READ" OR "INPUT"?
.,ACE5 10 03    BPL $ACEA         BPL     VARY0
kein DATA: $ACEA
branch if INPUT or GET
"INPUT"
.,ACE7 4C 27 A8 JMP $A827         JMP     RESFIN
DATA-Zeiger setzen
else set data pointer and exit
"DATA", SO STORE (Y,X) AT DATPTR
.,ACEA A0 00    LDY #$00 VARY0:  LDYI    0
Zeiger setzen
clear index
"INPUT": ANY MORE CHARS ON LINE?
.,ACEC B1 43    LDA ($43),Y         LDADY   INPPTR          ;LAST DATA CHR COULD HAVE BEEN
                                ;COMMA OR COLON BUT SHOULD BE NULL.
nächstes Zeichen holen
get READ byte

.,ACEE F0 0B    BEQ $ACFB         BEQ     INPRTS          ;IT IS NULL.
IFN     EXTIO,<
Endzeichen: $ACFB
exit if [EOL]
NO, ALL IS WELL
.,ACF0 A5 13    LDA $13         LDA     CHANNL          ;IF NOT TERMINAL, NO TYPE.
Eingabe über Tastatur?
get current I/O channel
YES, ERROR
.,ACF2 D0 07    BNE $ACFB         BNE     INPRTS>
nein: $ACFB
exit if not default channel

.,ACF4 A9 FC    LDA #$FC         LDWDI   EXIGNT
Zeiger auf
set "?EXTRA IGNORED" pointer low byte

.,ACF6 A0 AC    LDY #$AC
'?extra ignored' setzen
set "?EXTRA IGNORED" pointer high byte
"EXTRA IGNORED"
.,ACF8 4C 1E AB JMP $AB1E         JMP     STROUT          ;TYPE "?EXTRA IGNORED"
String ausgeben
print null terminated string

.,ACFB 60       RTS INPRTS: RTS                     ;DO NEXT STATEMENT.
Rücksprung



input error messages



.:ACFC 3F 45 58 54 52 41 20 49 EXIGNT: DT"?EXTRA IGNORED"
'?extra ignored'
'?extra ignored'
'?extra ignored'
.:AD04 47 4E 4F 52 45 44 0D 00         ACRLF



.:AD0C 3F 52 45 44 4F 20 46 52         0
'?redo from start'
'?redo from start'
'?redo from start'
.:AD14 4F 4D 20 53 54 41 52 54 TRYAGN: DT"?REDO FROM START"



.:AD1C 0D 00         ACRLF
        0
PAGE

THE NEXT CODE IS THE "NEXT CODE"

;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
; TOKEN (FORTK) 1 BYTE
; A POINTER TO THE LOOP VARIABLE 2 BYTES
; THE STEP 4+ADDPRC BYTES
; A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
; THE UPPER VALUE (PACKED) 4+ADDPRC BYTES
; THE LINE NUMBER OF THE "FOR" STATEMENT 2 BYTES
; A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16+2*ADDPRC BYTES.
;


BASIC-Befehl NEXT



perform NEXT



"NEXT" STATEMENT

.,AD1E D0 04    BNE $AD24 NEXT:   BNE     GETFOR
folgt Variablenname? ja:$AD24
branch if NEXT variable
VARIABLE AFTER "NEXT"
.,AD20 A0 00    LDY #$00         LDYI    0               ;WITHOUT ARG CALL "FNDFOR" WITH
Variablenzeiger = 0
else clear Y
FLAG BY SETTING FORPNT+1 = 0
.,AD22 F0 03    BEQ $AD27         BEQA    STXFOR          ;[FORPNT]=0.
unbedingter Sprung
branch always
NEXT variable
...ALWAYS

.,AD24 20 8B B0 JSR $B08B GETFOR: JSR     PTRGET          ;GET A POINTER TO LOOP VARIABLE
sucht Variable
get variable address
GET PNTR TO VARIABLE IN (Y,A)
.,AD27 85 49    STA $49 STXFOR: STWD    FORPNT          ;INTO "FORPNT".
Adresse der
save FOR/NEXT variable pointer low byte

.,AD29 84 4A    STY $4A
Variablen speichern
save FOR/NEXT variable pointer high byte
(high byte cleared if no variable defined)

.,AD2B 20 8A A3 JSR $A38A         JSR     FNDFOR          ;FIND THE MATCHING ENTRY IF ANY.
sucht FOR-NEXT-Schleife
search the stack for FOR or GOSUB activity
FIND FOR-FRAME FOR THIS VARIABLE
.,AD2E F0 05    BEQ $AD35         BEQ     HAVFOR
gefunden: $AD35
branch if FOR, this variable, found
FOUND IT
.,AD30 A2 0A    LDX #$0A         LDXI    ERRNF           ;"NEXT WITHOUT FOR".
Nummer für 'next without for'
else set error $0A, next without for error
NOT THERE, ABORT
.,AD32 4C 37 A4 JMP $A437 ERRGO5: BEQ     ERRGO4
Fehlermeldung ausgeben
do error #X then warm start
found this FOR variable
...ALWAYS
.,AD35 9A       TXS HAVFOR: TXS                     ;SETUP STACK. CHOP FIRST.
X-Reg. retten
update stack pointer
SET STACK PTR TO POINT TO THIS FRAME,
.,AD36 8A       TXA         TXA
X-Register nach Akku
copy stack pointer

.,AD37 18       CLC         CLC
Carry löschen (Addition)
clear carry for add

.,AD38 69 04    ADC #$04         ADCI    4               ;POINT TO INCREMENT
Zeiger auf Exponenten des
point to STEP value

.,AD3A 48       PHA         PHA                     ;SAVE THIS POINTER TO RESTORE TO [A]
STEP-Wert + 4 und retten
save it

.,AD3B 69 06    ADC #$06         ADCI    5+ADDPRC        ;POINT TO UPPER LIMIT
Zeiger auf Exponent des TO-
point to TO value

.,AD3D 85 24    STA $24         STA     INDEX2          ;SAVE AS INDEX
Wert und retten
save pointer to TO variable for compare

.,AD3F 68       PLA         PLA                     ;RESTORE POINTER TO INCREMENT
Akku wieder vom Stapel holen
restore pointer to STEP value

.,AD40 A0 01    LDY #$01         LDYI    1               ;SET HI ADDR OF THING TO MOVE.
Zeiger für Konstante setzen
point to stack page
(Y,A) IS ADDRESS OF STEP VALUE
.,AD42 20 A2 BB JSR $BBA2         JSR     MOVFM           ;GET QUANTITY INTO THE FAC.
Variable vom Stapel nach FAC
unpack memory (AY) into FAC1
STEP TO FAC
.,AD45 BA       TSX         TSX
Stapelzeiger als Zeiger h.
get stack pointer back

.,AD46 BD 09 01 LDA $0109,X         LDA     257+7+ADDPRC,X, ;SET SIGN CORRECTLY.
Vorzeichenbyte holen und
get step sign

.,AD49 85 66    STA $66         STA     FACSGN
für FAC speichern
save FAC1 sign (b7)

.,AD4B A5 49    LDA $49         LDWD    FORPNT
Variablenadresse für
get FOR/NEXT variable pointer low byte

.,AD4D A4 4A    LDY $4A
FOR-NEXT holen
get FOR/NEXT variable pointer high byte

.,AD4F 20 67 B8 JSR $B867         JSR     FADD            ;ADD INC TO LOOP VARIABLE.
addiert STEP-Wert zu FAC
add FOR variable to FAC1
ADD TO FOR VALUE
.,AD52 20 D0 BB JSR $BBD0         JSR     MOVVF           ;PACK THE FAC INTO MEMORY.
FAC nach Variable bringen
pack FAC1 into FOR variable
PUT NEW VALUE BACK
.,AD55 A0 01    LDY #$01         LDYI    1
Zeiger auf Konstante setzen
point to stack page
(Y,A) IS ADDRESS OF END VALUE
.,AD57 20 5D BC JSR $BC5D         JSR     FCOMPN          ;COMPARE FAC WITH UPPER VALUE.
FAC mit Schleifenendwert vergleichen
compare FAC1 with TO value
COMPARE TO END VALUE
.,AD5A BA       TSX         TSX
Stapelzeiger als Zeiger h.
get stack pointer back

.,AD5B 38       SEC         SEC
Carry setzen (Subtraktion)
set carry for subtract

.,AD5C FD 09 01 SBC $0109,X         SBC     257+7+ADDPRC,X, ;SUBTRACT SIGN OF INC FROM SIGN OF
                                ;OF (CURRENT VALUE-FINAL VALUE).
Stapelwert größer?
subtract step sign
SIGN OF STEP
.,AD5F F0 17    BEQ $AD78         BEQ     LOOPDN          ;IF SIGN (FINAL-CURRENT)-SIGN STEP=0
                                ;THEN LOOP IS DONE.
ja: Schleife verlassen
branch if =, loop complete
loop back and do it all again
BRANCH IF FOR COMPLETE
.,AD61 BD 0F 01 LDA $010F,X         LDA     2*ADDPRC+12+257,X
Zeilennummer des Schleifen-
get FOR line low byte
OTHERWISE SET UP
.,AD64 85 39    STA $39         STA     CURLIN          ;STORE LINE NUMBER OF "FOR" STATEMENT.
anfangs holen (LOW- und
save current line number low byte
FOR LINE #
.,AD66 BD 10 01 LDA $0110,X         LDA     257+13+<2*ADDPRC>,X
HIGH-Byte) und als aktuelle
get FOR line high byte

.,AD69 85 3A    STA $3A         STA     CURLIN+1
BASIC-Zeilennummer speichern
save current line number high byte

.,AD6B BD 12 01 LDA $0112,X         LDA     2*ADDPRC+15+257,X
Schleifenanfang holen (LOW-
get BASIC execute pointer low byte
AND SET TXTPTR TO JUST
.,AD6E 85 7A    STA $7A         STA     TXTPTR          ;STORE TEXT PNTR INTO "FOR" STATEMENT.
und HIGH-Byte) und
save BASIC execute pointer low byte
AFTER FOR STATEMENT
.,AD70 BD 11 01 LDA $0111,X         LDA     2*ADDPRC+14+257,X
als neuen Programmzeiger
get BASIC execute pointer high byte

.,AD73 85 7B    STA $7B         STA     TXTPTR+1
abspeichern
save BASIC execute pointer high byte

.,AD75 4C AE A7 JMP $A7AE NEWSGO: JMP     NEWSTT          ;PROCESS NEXT STATEMENT.
zur Interpreterschleife
go do interpreter inner loop
NEXT loop comlete

.,AD78 8A       TXA LOOPDN: TXA
Zeiger in Akku holen
stack copy to A
POP OFF FOR-FRAME, LOOP IS DONE
.,AD79 69 11    ADC #$11         ADCI    2*ADDPRC+15             ;ADDS 16 WITH CARRY.
(Werte der Schleife aus
add $12, $11 + carry, to dump FOR structure
CARRY IS SET, SO ADDS 18
.,AD7B AA       TAX         TAX
Stapel entfernen)
copy back to index

.,AD7C 9A       TXS         TXS                     ;NEW STACK PNTR.
neuen Stapelzeiger setzen
copy to stack pointer

.,AD7D 20 79 00 JSR $0079         JSR     CHRGOT
CHRGOT letztes Zeichen holen
scan memory
CHAR AFTER VARIABLE
.,AD80 C9 2C    CMP #$2C         CMPI    44              ;COMMA AT END?
',' Komma?
compare with ","
ANOTHER VARIABLE IN NEXT?
.,AD82 D0 F1    BNE $AD75         BNE     NEWSGO
nein: dann fertig
if not "," go do interpreter inner loop
was "," so another NEXT variable to do
NO, GO TO NEXT STATEMENT
.,AD84 20 73 00 JSR $0073         JSR     CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
YES, PRIME FOR NEXT VARIABLE
.,AD87 20 24 AD JSR $AD24         JSR     GETFOR          ;DO NEXT BUT DON'T ALLOW BLANK VARIABLE
                                ;PNTR. [VARPNT] IS THE STK PNTR WHICH
                                ;NEVER MATCHES ANY POINTER.
                                ;JSR TO PUT ON DUMMY NEWSTT ADDR.

FORMULA EVALUATION CODE.

;
; THESE ROUTINES CHECK FOR CERTAIN "VALTYP".
; [C] IS NOT PRESERVED.
;
nächste NEXT-Variable

FRMNUM Ausdruck holen und

auf numerisch prüfen

do NEXT variable

evaluate expression and check type mismatch

(DOES NOT RETURN)

EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC

.,AD8A 20 9E AD JSR $AD9E FRMNUM: JSR     FRMEVL
FRMEVL Term holen

prüft auf numerisch

evaluate expression
check if source and destination are numeric


MAKE SURE (FAC) IS NUMERIC

.,AD8D 18       CLC CHKNUM: CLC
Flag für Test auf numerisch


.:AD8E 24       .BYTE $24         SKIP1


prüft auf String

makes next line BIT $38
check if source and destination are string
DUMMY FOR SKIP

MAKE SURE (FAC) IS STRING

.,AD8F 38       SEC CHKSTR: SEC                     ;SET CARRY.
Flag für Test auf String
destination is string
type match check, set C for string, clear C for numeric


MAKE SURE (FAC) IS CORRECT TYPE

IF C=0, TYPE MUST BE NUMERIC
IF C=1, TYPE MUST BE STRING
.,AD90 24 0D    BIT $0D CHKVAL: BIT     VALTYP          ;WILL NOT F UP "VALTYP".
Typflag testen
test data type flag, $FF = string, $00 = numeric
$00 IF NUMERIC, $FF IF STRING
.,AD92 30 03    BMI $AD97         BMI     DOCSTR
gesetzt: $AD97
branch if string
TYPE IS STRING
.,AD94 B0 03    BCS $AD99         BCS     CHKERR
C=1: 'TYPE MISMATCH'
if destiantion is numeric do type missmatch error
NOT STRING, BUT WE NEED STRING
.,AD96 60       RTS CHKOK:  RTS
Rücksprung

TYPE IS CORRECT
.,AD97 B0 FD    BCS $AD96 DOCSTR: BCS     CHKOK
C=1: RTS
exit if destination is string
do type missmatch error
IS STRING AND WE WANTED STRING
.,AD99 A2 16    LDX #$16 CHKERR: LDXI    ERRTM
Nummer für 'TYPE MISMATCH'
error code $16, type missmatch error
TYPE MISMATCH
.,AD9B 4C 37 A4 JMP $A437 ERRGO4: JMP     ERROR
;
; THE FORMULA EVALUATOR STARTS WITH
; [TXTPTR] POINTING TO THE FIRST CHARACTER OF THE FORMULA.
; AT THE END [TXTPTR] POINTS TO THE TERMINATOR.
; THE RESULT IS LEFT IN THE FAC.
; ON RETURN [A] DOES NOT REFLECT THE TERMINATOR.
;
; THE FORMULA EVALUATOR USES THE OPERATOR LIST (OPTAB)
; TO DETERMINE PRECEDENCE AND DISPATCH ADDRESSES FOR
; EACH OPERATOR.
; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT.
; THE ADDRESS OF THE OPERATOR ROUTINE.
; THE FLOATING POINT TEMPORARY RESULT.
; THE PRECEDENCE OF THE OPERATOR.
;
Fehlermeldung ausgeben

FRMEVL auswerten eines

beliebigen Ausdrucks

do error #X then warm start

evaluate expression



EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE

RESULT IN FAC.

WORKS FOR BOTH STRING AND NUMERIC EXPRESSIONS.
.,AD9E A6 7A    LDX $7A FRMEVL: LDX     TXTPTR
Programmzeiger (LOW) = 0?
get BASIC execute pointer low byte
DECREMENT TXTPTR
.,ADA0 D0 02    BNE $ADA4         BNE     FRMEV1
ja: HIGH-B. nicht vermindern
skip next if not zero

.,ADA2 C6 7B    DEC $7B         DEC     TXTPTR+1
HIGH-Byte vermindern
else decrement BASIC execute pointer high byte

.,ADA4 C6 7A    DEC $7A FRMEV1: DEC     TXTPTR
LOW-Byte vermindern
decrement BASIC execute pointer low byte

.,ADA6 A2 00    LDX #$00         LDXI    0               ;INITIAL DUMMY PRECEDENCE IS 0.
Prioritätswert laden
set null precedence, flag done
START WITH PRECEDENCE = 0
.:ADA8 24       .BYTE $24         SKIP1

makes next line BIT $48
TRICK TO SKIP FOLLOWING "PHA"

.,ADA9 48       PHA LPOPER: PHA                     ;SAVE LOW PRECEDENCE. (MASK.)
Operatormaske retten
push compare evaluation byte if branch to here
PUSH RELOPS FLAGS
.,ADAA 8A       TXA         TXA
Prioritätswert in Akku
copy precedence byte

.,ADAB 48       PHA         PHA                     ;SAVE HIGH PRECEDENCE.
schieben und retten
push precedence byte
SAVE LAST PRECEDENCE
.,ADAC A9 01    LDA #$01         LDAI    1
2 Bytes
2 bytes

.,ADAE 20 FB A3 JSR $A3FB         JSR     GETSTK          ;MAKE SURE THERE IS ROOM FOR
                                ;RECURSIVE CALLS.
prüft auf Platz im Stapel
check room on stack for A*2 bytes
CHECK IF ENOUGH ROOM ON STACK
.,ADB1 20 83 AE JSR $AE83         JSR     EVAL            ;EVALUATE SOMETHING.
Nächstes Element holen
get value from line
GET AN ELEMENT
.,ADB4 A9 00    LDA #$00         CLR     OPMASK          ;PREPARE TO BUILD MASK MAYBE.
Wert laden und
clear A

.,ADB6 85 4D    STA $4D
Maske für Vergleichsoperator
clear comparrison evaluation flag
CLEAR COMPARISON OPERATOR FLAGS

.,ADB8 20 79 00 JSR $0079 TSTOP:  JSR     CHRGOT          ;REGET LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
CHECK FOR RELATIONAL OPERATORS
.,ADBB 38       SEC LOPREL: SEC                     ;PREP TO SUBTRACT.
Carry setzen (Subtraktion)
set carry for subtract
> IS $CF, = IS $D0, < IS $D1
.,ADBC E9 B1    SBC #$B1         SBCI    GREATK          ;IS CURRENT CHARACTER A RELATION?
$B1 von Operatorcode subtr.
subtract the token for ">"
> IS 0, = IS 1, < IS 2
.,ADBE 90 17    BCC $ADD7         BCC     ENDREL          ;NO. RELATIONS ALL THROUGH.
C=0: $ADD7
branch if < ">"
NOT RELATIONAL OPERATOR
.,ADC0 C9 03    CMP #$03         CMPI    LESSTK-GREATK+1 ;REALLY RELATIONAL?
mit $3 vergleichen
compare with ">" to +3

.,ADC2 B0 13    BCS $ADD7         BCS     ENDREL          ;NO -- JUST BIG.
=3: $ADD7
branch if >= 3
was token for ">" "=" or "<"
NOT RELATIONAL OPERATOR
.,ADC4 C9 01    CMP #$01         CMPI    1               ;RESET CARRY FOR ZERO ONLY.

with token for =
SET CARRY IF "=" OR "<"
.,ADC6 2A       ROL         ROL     A,              ;0 TO 1, 1 TO 2, 2 TO 4.
Maske für kleiner
*2, b0 = carry (=1 if token was = or <)
NOW > IS 0, = IS 3, < IS 5
.,ADC7 49 01    EOR #$01         EORI    1
gleich und größer
toggle b0
NOW > IS 1, = IS 2, < IS 4
.,ADC9 45 4D    EOR $4D         EOR     OPMASK          ;BRING IN THE OLD BITS.
für Bits 0,1 und 2
EOR with comparrison evaluation flag
SET BITS OF CPRTYP: 00000<=>
.,ADCB C5 4D    CMP $4D         CMP     OPMASK          ;MAKE SURE THE NEW MASK IS BIGGER.
in $40 erstellen
compare with comparrison evaluation flag
CHECK FOR ILLEGAL COMBINATIONS
.,ADCD 90 61    BCC $AE30         BCC     SNERR5          ;SYNTAX ERROR. BECAUSE TWO OF THE SAME.
(Wenn Codes von 177
if < saved flag do syntax error then warm start
IF LESS THAN, A RELOP WAS REPEATED
.,ADCF 85 4D    STA $4D         STA     OPMASK          ;SAVE MASK.
bis 179 folgen)
save new comparrison evaluation flag

.,ADD1 20 73 00 JSR $0073         JSR     CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory
ANOTHER OPERATOR?
.,ADD4 4C BB AD JMP $ADBB         JMP     LOPREL          ;GET THE NEXT CANDIDATE.
nächstes Zeichen auswerten
go do next character
CHECK FOR <,=,> AGAIN

.,ADD7 A6 4D    LDX $4D ENDREL: LDX     OPMASK          ;WERE THERE ANY?
Operatormaske holen
get comparrison evaluation flag
DID WE FIND A RELATIONAL OPERATOR?
.,ADD9 D0 2C    BNE $AE07         BNE     FINREL          ;YES, HANDLE AS SPECIAL OP.
gleich 0? nein: $AE07
branch if compare function
YES
.,ADDB B0 7B    BCS $AE58         BCS     QOP             ;NOT AN OPERATOR.
Code größer oder gleich 180?
go do functions
else was < TK_GT so is operator or lower
NO, AND NEXT TOKEN IS > $D1
.,ADDD 69 07    ADC #$07         ADCI    GREATK-PLUSTK
Code kleiner 170?
add # of operators (+, -, *, /, ^, AND or OR)
NO, AND NEXT TOKEN < $CF
.,ADDF 90 77    BCC $AE58         BCC     QOP             ;NOT AN OPERATOR.
ja: $AE58
branch if < + operator
carry was set so token was +, -, *, /, ^, AND or OR
IF NEXT TOKEN < "+"
.,ADE1 65 0D    ADC $0D         ADC     VALTYP          ;[C]=1.
Stringaddition?
add data type flag, $FF = string, $00 = numeric
+ AND LAST RESULT A STRING?
.,ADE3 D0 03    BNE $ADE8         JEQ     CAT             ;ONLY IF [A]=0 AND [VALTYP]=-1 (A STR).
nein: Verkettung umgehen
branch if not string or not + token
will only be $00 if type is string and token was +
BRANCH IF NOT
.,ADE5 4C 3D B6 JMP $B63D
Stringverkettung
add strings, string 1 is in the descriptor, string 2
is in line, and return
CONCATENATE IF SO.

.,ADE8 69 FF    ADC #$FF         ADCI    ^O377           ;GET BACK ORIGINAL [A].
Code-$AA (wiederherstellen)
-1 (corrects for carry add)
+-*/ IS 0123
.,ADEA 85 22    STA $22         STA     INDEX1
und speichern
save it

.,ADEC 0A       ASL         ASL     A,              ;MULTIPLY BY 2.
verdoppeln
*2
MULTIPLY BY 3
.,ADED 65 22    ADC $22         ADC     INDEX1          ;BY THREE.
+ Wert (also mal 3)
*3
+-*/ IS 0,3,6,9
.,ADEF A8       TAY         TAY                     ;SET UP FOR LATER.
als Zeiger ins Y-Register
copy to index


.,ADF0 68       PLA QPREC:  PLA                     ;GET PREVIOUS PRECEDENCE.
bisheriger Prioritätswert
pull previous precedence
GET LAST PRECEDENCE
.,ADF1 D9 80 A0 CMP $A080,Y         CMP     OPTAB,Y         ;IS OLD PRECEDENCE GREATER OR EQUAL?
mit Prioritätsw. vergleichen
compare with precedence byte

.,ADF4 B0 67    BCS $AE5D         BCS     QCHNUM          ;YES, GO OPERATE.
größer: $AE5D
branch if A >=
DO NOW IF HIGHER PRECEDENCE
.,ADF6 20 8D AD JSR $AD8D         JSR     CHKNUM          ;CAN'T BE STRING HERE.
prüft auf numerisch
check if source is numeric, else do type mismatch
WAS LAST RESULT A #?
.,ADF9 48       PHA DOPREC: PHA                     ;SAVE OLD PRECEDENCE.
Prioritätswert retten
save precedence
YES, SAVE PRECEDENCE ON STACK
.,ADFA 20 20 AE JSR $AE20 NEGPRC: JSR     DOPRE1          ;SET A RETURN ADDRESS FOR OP.
Operatoradr. und Operanden r.
get vector, execute function then continue evaluation
SAVE REST, CALL FRMEVL RECURSIVELY
.,ADFD 68       PLA         PLA                     ;PULL OFF PREVIOUS PRECEDENCE.

dence

.,ADFE A4 4B    LDY $4B         LDY     OPPTR           ;GET POINTER TO OP.
Operator?
get precedence stacked flag

.,AE00 10 17    BPL $AE19         BPL     QPREC1          ;THAT'S A REAL OPERATOR.
ja: $AE19
branch if stacked values

.,AE02 AA       TAX         TAX                     ;DONE ?
weitere Operation?
copy precedence, set flags

.,AE03 F0 56    BEQ $AE5B         BEQ     QOPGO           ;DONE !
nein: RTS
exit if done
EXIT IF NO MATH IN EXPRESSION
.,AE05 D0 5F    BNE $AE66         BNE     PULSTK
ARG vom Stapel holen
else pop FAC2 and return, branch always
...ALWAYS

FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
.,AE07 46 0D    LSR $0D FINREL: LSR     VALTYP          ;GET VALUE TYPE INTO "C".
Stringflag löschen
clear data type flag, $FF = string, $00 = numeric
(VALTYP) = 0 (NUMERIC), = $FF (STRING)
.,AE09 8A       TXA         TXA
Operatormaske nach
copy compare function flag
SET CPRTYP TO 0000<=>C
.,AE0A 2A       ROL         ROL     A,              ;PUT VALTYP INTO LOW ORDER BIT OF MASK.
links schieben
<<1, shift data type flag into b0, 1 = string, 0 = num
WHERE C=0 IF #, C=1 IF STRING
.,AE0B A6 7A    LDX $7A         LDX     TXTPTR          ;DECREMENT TEXT POINTER.
Programmzeiger holen (LOW)
get BASIC execute pointer low byte
BACK UP TXTPTR
.,AE0D D0 02    BNE $AE11         BNE     FINRE2
=0: HIGH-Byte vermindern
branch if no underflow

.,AE0F C6 7B    DEC $7B         DEC     TXTPTR+1
HIGH-Byte vermindern
else decrement BASIC execute pointer high byte

.,AE11 C6 7A    DEC $7A FINRE2: DEC     TXTPTR
LOW-Byte vermindern
decrement BASIC execute pointer low byte

.,AE13 A0 1B    LDY #$1B         LDYI    PTDORL-OPTAB    ;MAKE [YREG] POINT AT OPERATOR ENTRY.
Offset des Hierarchieflags

set offset to = operator precedence entry
POINT AT RELOPS ENTRY
.,AE15 85 4D    STA $4D         STA     OPMASK          ;SAVE THE OPERATION MASK.
Flag setzen
save new comparrison evaluation flag

.,AE17 D0 D7    BNE $ADF0         BNE     QPREC           ;SAVE IT ALL. BR ALWAYS.
                                ;NOTE B7(VALTYP)=0 SO CHKNUM CALL IS OK.
unbedingter Sprung
branch always
...ALWAYS

.,AE19 D9 80 A0 CMP $A080,Y QPREC1: CMP     OPTAB,Y         ;LAST PRECEDENCE IS GREATER?
mit Hierarchieflag vergl.
compare with stacked function precedence

.,AE1C B0 48    BCS $AE66         BCS     PULSTK          ;YES, GO OPERATE.
größer: $AE66
if A >=, pop FAC2 and return
DO NOW IF HIGHER PRECEDENCE
.,AE1E 90 D9    BCC $ADF9         BCC     DOPREC          ;NO SAVE ARGUMENT AND GET OTHER OPERAND.
sonst weiter
else go stack this one and continue, branch always

get vector, execute function then continue evaluation

...ALWAYS

STACK THIS OPERATION AND CALL FRMEVL FOR
ANOTHER ONE
.,AE20 B9 82 A0 LDA $A082,Y DOPRE1: LDA     OPTAB+2,Y
Operationsadresse (HIGH)
get function vector high byte

.,AE23 48       PHA         PHA                     ;DISP ADDR GOES ONTO STACK.
auf Stapel retten
onto stack
PUSH ADDRESS OF OPERATION PERFORMER
.,AE24 B9 81 A0 LDA $A081,Y         LDA     OPTAB+1,Y
Operationsadresse (LOW)
get function vector low byte

.,AE27 48       PHA         PHA
auf Stapel retten
onto stack
now push sign, round FAC1 and put on stack

.,AE28 20 33 AE JSR $AE33         JSR     PUSHF1          ;SAVE FAC ON STACK UNPACKED.
Operanden auf Stapel retten
function will return here, then the next RTS will call
the function
STACK FAC.SIGN AND FAC
.,AE2B A5 4D    LDA $4D         LDA     OPMASK          ;[ACCA] MAY BE MASK FOR REL.
Operatormaske laden
get comparrison evaluation flag
A=RELOP FLAGS, X=PRECEDENCE BYTE
.,AE2D 4C A9 AD JMP $ADA9         JMP     LPOPER
zum Schleifenanfang
continue evaluating expression
RECURSIVELY CALL FRMEVL

.,AE30 4C 08 AF JMP $AF08 SNERR5: JMP     SNERR           ;GO TO AN ERROR.
gibt 'SYNTAX ERROR'
do syntax error then warm start


STACK (FAC)

THREE ENTRY POINTS:
.1, FROM FRMEVL
.2, FROM "STEP"
.3, FROM "FOR"
.,AE33 A5 66    LDA $66 PUSHF1: LDA     FACSGN
Vorzeichen von FAC
get FAC1 sign (b7)
GET FAC.SIGN TO PUSH IT
.,AE35 BE 80 A0 LDX $A080,Y         LDX     OPTAB,Y,        ;GET HIGH PRECEDENCE.
Hierarchieflag
get precedence byte

push sign, round FAC1 and put on stack

PRECEDENCE BYTE FROM MATHTBL

ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
.,AE38 A8       TAY PUSHF:  TAY                     ;GET POINTER INTO STACK.
Vorzeichen ins Y-Reg.
copy sign
FAC.SIGN OR SGN(STEP VALUE)
.,AE39 68       PLA         PLA
Rücksprungadresse holen
get return address low byte
PULL RETURN ADDRESS AND ADD 1
.,AE3A 85 22    STA $22         STA     INDEX1
und merken
save it
<<< ASSUMES NOT ON PAGE BOUNDARY! >>>
.,AE3C E6 22    INC $22         INC     INDEX1
Rücksprungadresse erhöhen
increment it as return-1 is pushed
note, no check is made on the high byte so if the calling
routine ever assembles to a page edge then this all goes
horribly wrong!
PLACE BUMPED RETURN ADDRESS IN
.,AE3E 68       PLA         PLA
nächstes Adressbyte holen
get return address high byte
INDEX,INDEX+1
.,AE3F 85 23    STA $23         STA     INDEX1+1
und speichern
save it

.,AE41 98       TYA         TYA
                                ;STORE FAC ON STACK UNPACKED.
Vorzeichen wieder in Akku
restore sign
FAC.SIGN OR SGN(STEP VALUE)
.,AE42 48       PHA         PHA                     ;START WITH SIGN SET UP.
und auf Stapel legen
push sign

round FAC1 and put on stack

PUSH FAC.SIGN OR SGN(STEP VALUE)

ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
TO PUSH INITIAL VALUE OF "FOR" VARIABLE
.,AE43 20 1B BC JSR $BC1B FORPSH: JSR     ROUND           ;PUT ROUNDED FAC ON STACK.
FAC runden
round FAC1
ROUND TO 32 BITS
.,AE46 A5 65    LDA $65         LDA     FACLO           ;ENTRY POINT TO SKIP STORING SIGN.
FAC auf Stapel legen
get FAC1 mantissa 4
PUSH (FAC)
.,AE48 48       PHA         PHA
1. Byte retten
save it

.,AE49 A5 64    LDA $64         LDA     FACMO
2. Byte holen
get FAC1 mantissa 3

.,AE4B 48       PHA         PHA
IFN     ADDPRC,<
und retten
save it

.,AE4C A5 63    LDA $63         LDA     FACMOH
3. Byte holen
get FAC1 mantissa 2

.,AE4E 48       PHA         PHA>
und retten
save it

.,AE4F A5 62    LDA $62         LDA     FACHO
4. Byte holen
get FAC1 mantissa 1

.,AE51 48       PHA         PHA
und retten
save it

.,AE52 A5 61    LDA $61         LDA     FACEXP
5. Byte holen
get FAC1 exponent

.,AE54 48       PHA         PHA
und retten
save it

.,AE55 6C 22 00 JMP ($0022)         JMPD    INDEX1          ;RETURN.
Sprung auf Operation
return, sort of

do functions

DO RTS FUNNY WAY

.,AE58 A0 FF    LDY #$FF QOP:    LDYI    255
Flagwert für Operator
flag function
SET UP TO EXIT ROUTINE
.,AE5A 68       PLA         PLA                     ;GET HIGH PRECEDENCE OF LAST OP.
Prioritätsflag retten
pull precedence byte

.,AE5B F0 23    BEQ $AE80 QOPGO:  BEQ     QOPRTS          ;DONE !
=0? ja: $AE80
exit if done
EXIT IF NO MATH TO DO

PERFORM STACKED OPERATION

(A) = PRECEDENCE BYTE
STACK: 1 -- CPRMASK
5 -- (ARG)
2 -- ADDR OF PERFORMER
.,AE5D C9 64    CMP #$64 QCHNUM: CMPI    100             ;RELATIONAL OPERATOR?
=$64?
compare previous precedence with $64
WAS IT RELATIONAL OPERATOR?
.,AE5F F0 03    BEQ $AE64         BEQ     UNPSTK          ;YES, DON'T CHECK OPERAND.
ja: $AE64
branch if was $64 (< function)
YES, ALLOW STRING COMPARE
.,AE61 20 8D AD JSR $AD8D         JSR     CHKNUM          ;MUST BE NUMBER.
prüft auf numerisch
check if source is numeric, else do type mismatch
MUST BE NUMERIC VALUE
.,AE64 84 4B    STY $4B UNPSTK: STY     OPPTR           ;SAVE OPERATOR'S POINTER FOR NEXT TIME.
flag fur Operator
save precedence stacked flag
pop FAC2 and return


.,AE66 68       PLA PULSTK: PLA                     ;GET MASK FOR REL OP IF IT IS ONE.
Akku vom Stapel holen
pop byte
GET 0000<=>C FROM STACK
.,AE67 4A       LSR         LSR     A,              ;SETUP [C] FOR DOREL'S "CHKVAL".
halbieren
shift out comparison evaluation lowest bit
SHIFT TO 00000<=> FORM
.,AE68 85 12    STA $12         STA     DOMASK          ;SAVE FOR "DOCMP".
und abspeichern
save the comparison evaluation flag
00000<=>
.,AE6A 68       PLA         PLA                     ;UNPACK STACK INTO ARG.
ARG von Stapel holen
pop exponent

.,AE6B 85 69    STA $69         STA     ARGEXP
1. Byte speichern
save FAC2 exponent
GET FLOATING POINT VALUE OFF STACK,
.,AE6D 68       PLA         PLA
2. Byte holen
pop mantissa 1
AND PUT IT IN ARG
.,AE6E 85 6A    STA $6A         STA     ARGHO
IFN     ADDPRC,<
und speichern
save FAC2 mantissa 1

.,AE70 68       PLA         PLA
3. Byte holen
pop mantissa 2

.,AE71 85 6B    STA $6B         STA     ARGMOH>
und speichern
save FAC2 mantissa 2

.,AE73 68       PLA         PLA
4. Byte holen
pop mantissa 3

.,AE74 85 6C    STA $6C         STA     ARGMO
und speichern
save FAC2 mantissa 3

.,AE76 68       PLA         PLA
5. Byte holen
pop mantissa 4

.,AE77 85 6D    STA $6D         STA     ARGLO
und speichern
save FAC2 mantissa 4

.,AE79 68       PLA         PLA
6. Byte (Vorzeichen holen
pop sign

.,AE7A 85 6E    STA $6E         STA     ARGSGN
und speichern
save FAC2 sign (b7)

.,AE7C 45 66    EOR $66         EOR     FACSGN          ;GET PROBABLE RESULT SIGN.
Vorzeichen von ARG und FAC
EOR FAC1 sign (b7)
SAVE EOR OF SIGNS OF THE OPERANDS,
.,AE7E 85 6F    STA $6F         STA     ARISGN          ;ARITHMETIC SIGN. USED BY
                                ;ADD, SUB, MULT, DIV.
verknüpfen und speichern
save sign compare (FAC1 EOR FAC2)
IN CASE OF MULTIPLY OR DIVIDE
.,AE80 A5 61    LDA $61 QOPRTS: LDA     FACEXP          ;GET IT AND SET CODES.
Exponentbyte von FAC laden
get FAC1 exponent
FAC EXPONENT IN A-REG
.,AE82 60       RTS UNPRTS: RTS                     ;RETURN.
Rücksprung

Nächstes Element eines

Ausdrucks holen



get value from line

STATUS .EQ. IF (FAC)=0
RTS GOES TO PERFORM OPERATION

GET ELEMENT IN EXPRESSION

GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
.,AE83 6C 0A 03 JMP ($030A)
JMP $AE86
get arithmetic element

get arithmetic element, the get arithmetic element vector is initialised to point here


.,AE86 A9 00    LDA #$00 EVAL:   CLR     VALTYP          ;ASSUME VALUE WILL BE NUMERIC.
Wert laden und damit
clear byte
ASSUME NUMERIC
.,AE88 85 0D    STA $0D
Typflag auf numerisch setzen
clear data type flag, $FF = string, $00 = numeric

.,AE8A 20 73 00 JSR $0073 EVAL0:  JSR     CHRGET          ;GET A CHARACTER.
CHRGET nächstes Zeichen holen
increment and scan memory

.,AE8D B0 03    BCS $AE92         BCS     EVAL2
Ziffer? nein: $AE92
branch if not numeric character
else numeric string found (e.g. 123)
NOT A DIGIT
.,AE8F 4C F3 BC JMP $BCF3 EVAL1:  JMP     FIN             ;IT IS A NUMBER.
Variable nach FAC holen
get FAC1 from string and return
get value from line .. continued
wasn't a number so ...
NUMERIC CONSTANT
.,AE92 20 13 B1 JSR $B113 EVAL2:  JSR     ISLETC          ;VARIABLE NAME?
Buchstabe?
check byte, return Cb = 0 if<"A" or >"Z"
VARIABLE NAME?
.,AE95 90 03    BCC $AE9A         BCS     ISVAR           ;YES.
nein: JMP umgehen
branch if not variable name

.,AE97 4C 28 AF JMP $AF28 IFE     REALIO-3,<
Variable holen
variable name set-up and return
YES
.,AE9A C9 FF    CMP #$FF         CMPI    PI
BASIC-Code für Pi?
compare with token for PI

.,AE9C D0 0F    BNE $AEAD         BNE     QDOT
nein: $AEAD
branch if not PI

.,AE9E A9 A8    LDA #$A8         LDWDI   PIVAL
Zeiger auf Konstante Pi
get PI pointer low byte

.,AEA0 A0 AE    LDY #$AE
(LOW und HIGH-Byte)
get PI pointer high byte

.,AEA2 20 A2 BB JSR $BBA2         JSR     MOVFM           ;PUT VALUE IN FOR PI.
Konstante in FAC holen
unpack memory (AY) into FAC1

.,AEA5 4C 73 00 JMP $0073         JMP     CHRGET
CHRGET nächstes Zeichen holen

increment and scan memory and return

PI as floating number



.:AEA8 82 49 0F DA A1 PIVAL:  ^O202
        ^O111
        ^O017
        ^O332
        ^O241>
Konstante Pi 3.14159265

3.141592653

get value from line .. continued

wasn't variable name so ...


.,AEAD C9 2E    CMP #$2E QDOT:   CMPI    "."             ;LEADING CHARACTER OF CONSTANT?
'.' Dezimalpunkt?
compare with "."
DECIMAL POINT
.,AEAF F0 DE    BEQ $AE8F         BEQ     EVAL1
ja: $AE8F
if so get FAC1 from string and return, e.g. was .123
wasn't .123 so ...
YES, NUMERIC CONSTANT
.,AEB1 C9 AB    CMP #$AB         CMPI    MINUTK          ;NEGATION?
'-'?
compare with token for -
UNARY MINUS?
.,AEB3 F0 58    BEQ $AF0D         BEQ     DOMIN           ;SHO IS.
zum Vorzeichenwechsel
branch if - token, do set-up for functions
wasn't -123 so ...
YES
.,AEB5 C9 AA    CMP #$AA         CMPI    PLUSTK
'+'?
compare with token for +
UNARY PLUS
.,AEB7 F0 D1    BEQ $AE8A         BEQ     EVAL0
ja: $Ae8A
branch if + token, +1 = 1 so ignore leading +
it wasn't any sort of number so ...
YES
.,AEB9 C9 22    CMP #$22         CMPI    34              ;A QUOTE? A STRING?
'"'?
compare with "
STRING CONSTANT?
.,AEBB D0 0F    BNE $AECC         BNE     EVAL3
nein: $AECC
branch if not open quote
was open quote so get the enclosed string

print "..." string to string utility area

NO

STRING CONSTANT ELEMENT

SET Y,A = (TXTPTR)+CARRY
.,AEBD A5 7A    LDA $7A STRTXT: LDWD    TXTPTR
LOW- und HIGH-Byte des
get BASIC execute pointer low byte
ADD (CARRY) TO GET ADDRESS OF 1ST CHAR
.,AEBF A4 7B    LDY $7B
Programmzeigers holen
get BASIC execute pointer high byte
OF STRING IN Y,A
.,AEC1 69 00    ADC #$00         ADCI    0               ;TO INC, ADD C=1.
und Übertrag addieren
add carry to low byte

.,AEC3 90 01    BCC $AEC6         BCC     STRTX2
C=0: $AEC6
branch if no overflow

.,AEC5 C8       INY         INY
HIGH-Byte erhöhen
increment high byte

.,AEC6 20 87 B4 JSR $B487 STRTX2: JSR     STRLIT          ;YES. GO PROCESS IT.
String übertragen
print " terminated string to utility pointer
BUILD DESCRIPTOR TO STRING
GET ADDRESS OF DESCRIPTOR IN FAC
.,AEC9 4C E2 B7 JMP $B7E2         JMP     ST2TXT
Programmz. auf Stringende +1
restore BASIC execute pointer from temp and return
get value from line .. continued
wasn't a string so ...
POINT TXTPTR AFTER TRAILING QUOTE

.,AECC C9 A8    CMP #$A8 EVAL3:  CMPI    NOTTK           ;CHECK FOR "NOT" OPERATOR.
'NOT'-Code?
compare with token for NOT

.,AECE D0 13    BNE $AEE3         BNE     EVAL4
nein: $AEE3
branch if not token for NOT
was NOT token
NOT "NOT", TRY "FN"
.,AED0 A0 18    LDY #$18         LDYI    NOTTAB-OPTAB            ;"NOT" HAS PRECEDENCE 90.
Offset des H.Flags in Tabelle
offset to NOT function
POINT AT = COMPARISON
.,AED2 D0 3B    BNE $AF0F         BNE     GONPRC          ;GO DO ITS EVALUATION.
unbedingter Sprung

BASIC-Befehl NOT

do set-up for function then execute, branch always
do = compare
...ALWAYS

"NOT" FUNCTION

IF FAC=0, RETURN FAC=1
IF FAC<>0, RETURN FAC=0
.,AED4 20 BF B1 JSR $B1BF NOTOP:  JSR     AYINT           ;INTEGERIZE.
FAC nach INTEGER wandeln
evaluate integer expression, no sign check

.,AED7 A5 65    LDA $65         LDA     FACLO           ;GET THE ARGUMENT.
HIGH-Byte holen
get FAC1 mantissa 4

.,AED9 49 FF    EOR #$FF         EORI    255
alle Bits umdrehen
invert it

.,AEDB A8       TAY         TAY
und ins Y-Reg.
copy it

.,AEDC A5 64    LDA $64         LDA     FACMO
LOW-Byte holen
get FAC1 mantissa 3

.,AEDE 49 FF    EOR #$FF         EORI    255
alle Bits invertieren
invert it

.,AEE0 4C 91 B3 JMP $B391         JMP     GIVAYF          ;FLOAT [Y,A] AS RESULT IN FAC.
                                ;AND RETURN.
nach Fließkomma wandeln
convert fixed integer AY to float FAC1 and return
get value from line .. continued
wasn't a string or NOT so ...


COMPARISON FOR EQUALITY (= OPERATOR)

ALSO USED TO EVALUATE "NOT" FUNCTION
.,AEE3 C9 A5    CMP #$A5 EVAL4:  CMPI    FNTK            ;USER-DEFINED FUNCTION?
'FN'-Code?
compare with token for FN

.,AEE5 D0 03    BNE $AEEA         JEQ     FNDOER
nein: $AEEA
branch if not token for FN

.,AEE7 4C F4 B3 JMP $B3F4
FN ausführen
else go evaluate FNx
get value from line .. continued
wasn't a string, NOT or FN so ...


.,AEEA C9 B4    CMP #$B4         CMPI    ONEFUN          ;A FUNCTION NAME?
'SGN'-Code
compare with token for SGN

.,AEEC 90 03    BCC $AEF1         BCC     PARCHK          ;FUNCTIONS ARE THE HIGHEST NUMBERED
kleiner (keine Stringfunkt.)?
if less than SGN token evaluate expression in parentheses
else was a function token

.,AEEE 4C A7 AF JMP $AFA7         JMP     ISFUN           ;CHARACTERS SO NO NEED TO CHECK
                                ;AN UPPER-BOUND.
holt String ,ersten Parameter

holt Term in Klammern

go set up function references, branch always
get value from line .. continued
if here it can only be something in brackets so ....
evaluate expression within parentheses


EVALUATE "(EXPRESSION)"

.,AEF1 20 FA AE JSR $AEFA PARCHK: JSR     CHKOPN          ;ONLY POSSIBILITY LEFT IS
prüft auf Klammer auf
scan for "(", else do syntax error then warm start
IS THERE A '(' AT TXTPTR?
.,AEF4 20 9E AD JSR $AD9E         JSR     FRMEVL          ;A FORMULA IN PARENTHESIS.
                                ;RECURSIVELY EVALUATE THE FORMULA.
FRMEVL holt Term

prüft auf Zeichen im B.-Text

evaluate expression
all the 'scan for' routines return the character after the sought character
scan for ")", else do syntax error then warm start
YES, EVALUATE EXPRESSION

.,AEF7 A9 29    LDA #$29 CHKCLS: LDAI    41              ;CHECK FOR A RIGHT PARENTHESE
')' Klammer zu
load A with ")"
CHECK FOR ')'
.:AEF9 2C       .BYTE $2C         SKIP2

makes next line BIT $28A9
scan for "(", else do syntax error then warm start
TRICK

.,AEFA A9 28    LDA #$28 CHKOPN: LDAI    40
'(' Klammer auf
load A with "("

.:AEFC 2C       .BYTE $2C         SKIP2

makes next line BIT $2CA9
scan for ",", else do syntax error then warm start
TRICK

.,AEFD A9 2C    LDA #$2C CHKCOM: LDAI    44
;
; "SYNCHK" LOOKS AT THE CURRENT CHARACTER TO MAKE SURE IT
; IS THE SPECIFIC THING LOADED INTO ACCA JUST BEFORE THE CALL TO
; "SYNCHK". IF NOT, IT CALLS THE "SYNTAX ERROR" ROUTINE.
; OTHERWISE IT GOBBLES THE NEXT CHAR AND RETURNS,
;
; [A]=NEW CHAR AND TXTPTR IS ADVANCED BY "CHRGET".
;
',' Komma
load A with ","
scan for CHR$(A), else do syntax error then warm start
COMMA AT TXTPTR?

UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR

.,AEFF A0 00    LDY #$00 SYNCHR: LDYI    0
Zeiger setzen
clear index

.,AF01 D1 7A    CMP ($7A),Y         CMPDY   TXTPTR          ;CHARACTERS EQUAL?
mit laufendem Zeichen vergl.
compare with BASIC byte

.,AF03 D0 03    BNE $AF08         BNE     SNERR
keine Übereinstimmung?
if not expected byte do syntax error then warm start

.,AF05 4C 73 00 JMP $0073 CHRGO5: JMP     CHRGET
CHRGET nächstes Zeichen holen
else increment and scan memory and return
syntax error then warm start
MATCH, GET NEXT CHAR &amp; RETURN

.,AF08 A2 0B    LDX #$0B SNERR:  LDXI    ERRSN           ;"SYNTAX ERROR"
Nummer für 'SYNTAX ERROR'
error code $0B, syntax error

.,AF0A 4C 37 A4 JMP $A437         JMP     ERROR
Fehlermeldung ausgeben
do error #X then warm start


.,AF0D A0 15    LDY #$15 DOMIN:  LDYI    NEGTAB-OPTAB    ;A PRECEDENCE BELOW "^".
Offset Hierachie-Code für VZW
set offset from base to > operator
POINT AT UNARY MINUS
.,AF0F 68       PLA GONPRC: PLA                     ;GET RID OF RTS ADDR.
nächsten 2 Bytes vom
dump return address low byte

.,AF10 68       PLA         PLA
Stapel entfernen
dump return address high byte

.,AF11 4C FA AD JMP $ADFA         JMP     NEGPRC          ;EVALUTE FOR NEGATION.
zur Auswertung

prüft auf Variable

execute function then continue evaluation

check address range, return Cb = 1 if address in BASIC ROM



.,AF14 38       SEC
innerhalb des BASICs
set carry for subtract

.,AF15 A5 64    LDA $64
Carry setzen (Subtr.)
get variable address low byte

.,AF17 E9 00    SBC #$00
Descriptor holen
subtract $A000 low byte

.,AF19 A5 65    LDA $65
liegt Descriptor ($64/$65)
get variable address high byte

.,AF1B E9 A0    SBC #$A0
zwischen $A000 und $E32A?
subtract $A000 high byte

.,AF1D 90 08    BCC $AF27
ja: dann C=1, sonst RTS
exit if address < $A000

.,AF1F A9 A2    LDA #$A2
1. Wert laden
get end of BASIC marker low byte

.,AF21 E5 64    SBC $64
1. Descriptorbyte abziehen
subtract variable address low byte

.,AF23 A9 E3    LDA #$E3
2. Wert laden
get end of BASIC marker high byte

.,AF25 E5 65    SBC $65
und Descriptorwert abziehen
subtract variable address high byte

.,AF27 60       RTS
Rücksprung

Variable holen



variable name set-up



.,AF28 20 8B B0 JSR $B08B ISVAR:  JSR     PTRGET          ;GET A PNTR TO VARIABLE.
Variable suchen
get variable address

.,AF2B 85 64    STA $64 ISVRET: STWD    FACMO
Zeiger auf Variable
save variable pointer low byte
ADDRESS OF VARIABLE
.,AF2D 84 65    STY $65 IFN     TIME!EXTIO,<
bzw. Stringdescriptor
save variable pointer high byte

.,AF2F A6 45    LDX $45         LDWD    VARNAM> ;CHECK TIME,TIME$,STATUS.
als
get current variable name first character
NUMERIC OR STRING?
.,AF31 A4 46    LDY $46         LDX     VALTYP
Variablenname speichern
get current variable name second character

.,AF33 A5 0D    LDA $0D
Typflag holen
get data type flag, $FF = string, $00 = numeric

.,AF35 F0 26    BEQ $AF5D         BEQ     GOOO            ;THE STRING IS SET UP.
numerisch?
branch if numeric
variable is string
NUMERIC
.,AF37 A9 00    LDA #$00         LDXI    0
Wert laden und
else clear A

.,AF39 85 70    STA $70         STX     FACOV
IFN     TIME,<
in Rundungsbyte fur FAC
clear FAC1 rounding byte

.,AF3B 20 14 AF JSR $AF14         BIT     FACLO           ;AN ARRAY?
Descriptor im Interpreter?
check address range

.,AF3E 90 1C    BCC $AF5C         BPL     STRRTS          ;YES.
nein
exit if not in BASIC ROM

.,AF40 E0 54    CPX #$54         CMPI    "T"             ;TI$?
'T'? (von TI$)
compare variable name first character with "T"

.,AF42 D0 18    BNE $AF5C         BNE     STRRTS
nein: $AF5C
exit if not "T"

.,AF44 C0 C9    CPY #$C9         CPYI    "I"+128
'I$'? (von TI$)
compare variable name second character with "I$"

.,AF46 D0 14    BNE $AF5C         BNE     STRRTS
nein: $AF5C
exit if not "I$"
variable name was "TI$"

.,AF48 20 84 AF JSR $AF84         JSR     GETTIM          ;YES. PUT TIME IN FACMOH-LO.
Zeit nach FAC holen
read real time clock into FAC1 mantissa, 0HML

.,AF4B 84 5E    STY $5E         STY     TENEXP          ;Y=0.
Flag für Exponentialdarst. =0
clear exponent count adjust

.,AF4D 88       DEY         DEY
vermindern (=$FF)
Y = $FF

.,AF4E 84 71    STY $71         STY     FBUFPT
Zeiger für Stringstartadresse
set output string index, -1 to allow for pre increment

.,AF50 A0 06    LDY #$06         LDYI    6               ;SIX DIGITS TO PRINT.
Länge 6 für TI$
HH:MM:SS is six digits

.,AF52 84 5D    STY $5D         STY     DECCNT
speichern
set number of characters before the decimal point

.,AF54 A0 24    LDY #$24         LDYI    FDCEND-FOUTBL
Zeiger auf Stellenwert

index to jiffy conversion table

.,AF56 20 68 BE JSR $BE68         JSR     FOUTIM          ;CONVERT TO ASCII.
erzeugt String TI$
convert jiffy count to string

.,AF59 4C 6F B4 JMP $B46F         JMP     TIMSTR>
bringt String in Str.bereich
exit via STR$() code tail

.,AF5C 60       RTS STRRTS: RTS
GOOO:
IFN     INTPRC,<
Rücksprung

variable name set-up, variable is numeric

.,AF5D 24 0E    BIT $0E         LDX     INTFLG
INTEGER/ REAL Flag
test data type flag, $80 = integer, $00 = float

.,AF5F 10 0D    BPL $AF6E         BPL     GOOOOO
REAL? ja: $AF6E

Integervariable holen

branch if float
FLOATING POINT
.,AF61 A0 00    LDY #$00         LDYI    0
Zeiger setzen
clear index
INTEGER
.,AF63 B1 64    LDA ($64),Y         LDADY   FACMO           ;FETCH HIGH.
Intgerzahl holen (1. Byte)
get integer variable low byte

.,AF65 AA       TAX         TAX
ins X-Reg.
copy to X
GET VALUE IN A,Y
.,AF66 C8       INY         INY
Zeiger erhöhen
increment index

.,AF67 B1 64    LDA ($64),Y         LDADY   FACMO
2. Byte holen
get integer variable high byte

.,AF69 A8       TAY         TAY                     ;PUT LOW IN Y.
ins Y-Register
copy to Y

.,AF6A 8A       TXA         TXA                     ;GET HIGH IN A.
1. Byte in Akku holen
copy loa byte to A

.,AF6B 4C 91 B3 JMP $B391         JMP     GIVAYF> ;FLOAT AND RETURN.
GOOOOO:
IFN     TIME,<
und nach Fließkomma wandeln

REAL-Variable holen

convert fixed integer AY to float FAC1 and return
variable name set-up, variable is float
CONVERT A,Y TO FLOATING POINT
.,AF6E 20 14 AF JSR $AF14         BIT     FACLO           ;AN ARRAY?
Descriptor im Interpreter?
check address range

.,AF71 90 2D    BCC $AFA0         BPL     GOMOVF          ;YES.
nein
if not in BASIC ROM get pointer and unpack into FAC1

.,AF73 E0 54    CPX #$54         CMPI    "T"
'T'? (von TI)
compare variable name first character with "T"

.,AF75 D0 1B    BNE $AF92         BNE     QSTATV
nein: $AF92
branch if not "T"

.,AF77 C0 49    CPY #$49         CPYI    "I"
'I'? (von TI)
compare variable name second character with "I"

.,AF79 D0 25    BNE $AFA0         BNE     GOMOVF
nein: $AFA0
branch if not "I"
variable name was "TI"

.,AF7B 20 84 AF JSR $AF84         JSR     GETTIM
TIME in FAC holen
read real time clock into FAC1 mantissa, 0HML

.,AF7E 98       TYA         TYA                     ;FOR FLOATB.
Akku =0 setzen
clear A

.,AF7F A2 A0    LDX #$A0         LDXI    160             ;SET EXPONNENT.
Exponentbyte für FAC
set exponent to 32 bit value

.,AF81 4C 4F BC JMP $BC4F         JMP     FLOATB
FAC linksbündig machen

Zeit holen

set exponent = X and normalise FAC1

read real time clock into FAC1 mantissa, 0HML


.,AF84 20 DE FF JSR $FFDE GETTIM: LDWDI   <CQTIMR-2>
TIME holen
read real time clock

.,AF87 86 64    STX $64         SEI                     ;TURN OF INT SYS.
1. Byte nach FAC
save jiffy clock mid byte as FAC1 mantissa 3

.,AF89 84 63    STY $63         JSR     MOVFM
2. Byte nach FAC
save jiffy clock high byte as FAC1 mantissa 2

.,AF8B 85 65    STA $65         CLI                     ;BACK ON.
3. Byte nach FAC
save jiffy clock low byte as FAC1 mantissa 4

.,AF8D A0 00    LDY #$00
Wert laden (0) und
clear Y

.,AF8F 84 62    STY $62         STY     FACHO           ;ZERO HIGHEST.
als 4. Byte nach FAC
clear FAC1 mantissa 1

.,AF91 60       RTS         RTS>
QSTATV:
IFN     EXTIO,<
Rücksprung

variable name set-up, variable is float and not "Tx"

.,AF92 E0 53    CPX #$53         CMPI    "S"
'S'?
compare variable name first character with "S"

.,AF94 D0 0A    BNE $AFA0         BNE     GOMOVF
nein: $AFA0
if not "S" go do normal floating variable

.,AF96 C0 54    CPY #$54         CPYI    "T"
'T'?
compare variable name second character with "

.,AF98 D0 06    BNE $AFA0         BNE     GOMOVF
nein: $AFA0
if not "T" go do normal floating variable
variable name was "ST"

.,AF9A 20 B7 FF JSR $FFB7         LDA     CQSTAT
Status holen
read I/O status word

.,AF9D 4C 3C BC JMP $BC3C         JMP     FLOAT
GOMOVF:>
IFN     TIME!EXTIO,<
Byte in Fließkommaformat

REAL-Variable holen

save A as integer byte and return
variable is float

.,AFA0 A5 64    LDA $64         LDWD    FACMO>
LOW- und HIGH-Byte der
get variable pointer low byte

.,AFA2 A4 65    LDY $65
Variablenadresse
get variable pointer high byte

.,AFA4 4C A2 BB JMP $BBA2         JMP     MOVFM           ;MOVE ACTUAL VALUE IN.
                                ;AND RETURN.

Variable in FAC holen

Funktionsberechnung

unpack memory (AY) into FAC1

get value from line continued

only functions left so ..
set up function references


PROCESS UNARY OPERATORS (FUNCTIONS)

.,AFA7 0A       ASL ISFUN:  ASL     A,              ;MULTIPLY BY TWO.
Funktionscode mal 2
*2 (2 bytes per function address)
DOUBLE TOKEN TO GET INDEX
.,AFA8 48       PHA         PHA
auf den Stapel retten
save function offset

.,AFA9 AA       TAX         TAX
und ins X-Register
copy function offset

.,AFAA 20 73 00 JSR $0073         JSR     CHRGET          ;SET UP FOR SYNCHK.
CHRGET nächstes Zeichen
increment and scan memory

.,AFAD E0 8F    CPX #$8F         CPXI    2*LASNUM-256+1  ;IS IT PAST "LASNUM"?
numerische Funktion?
compare function offset to CHR$ token offset+1
LEFT$, RIGHT$, AND MID$
.,AFAF 90 20    BCC $AFD1         BCC     OKNORM          ;NO, MUST BE NORMAL FUNCTION.
;
; MOST FUNCTIONS TAKE A SINGLE ARGUMENT.
; THE RETURN ADDRESS OF THESE FUNCTIONS IS "CHKNUM"
; WHICH ASCERTAINS THAT [VALTYP]=0 (NUMERIC).
; NORMAL FUNCTIONS THAT RETURN STRING RESULTS
; (E.G., CHR$) MUST POP OFF THAT RETURN ADDR AND
; RETURN DIRECTLY TO "FRMEVL".
;
; THE SO-CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT,
; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH
; MUST BE A NUMBER BETWEEN 0 AND 255.
; THE CLOSED PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY
; TO "FRMEVL" WITH THE TEXT PNTR POINTING BEYOND THE ")".
; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT
; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE
; INTEGER ARGUMENT.
;
ja: $AFD1

Stringfunktion, String und

ersten Parameter

branch if < LEFT$ (can not be =)
get value from line .. continued
was LEFT$, RIGHT$ or MID$ so..
NOT ONE OF THE STRING FUNCTIONS
.,AFB1 20 FA AE JSR $AEFA         JSR     CHKOPN          ;CHECK FOR AN OPEN PARENTHESE
prüft auf Klammer auf
scan for "(", else do syntax error then warm start
STRING FUNCTION, NEED "("
.,AFB4 20 9E AD JSR $AD9E         JSR     FRMEVL          ;EAT OPEN PAREN AND FIRST ARG.
FRMEVL holen beliebigen Term
evaluate, should be string, expression
EVALUATE EXPRESSION FOR STRING
.,AFB7 20 FD AE JSR $AEFD         JSR     CHKCOM          ;TWO ARGS SO COMMA MUST DELIMIT.
prüft auf Komma
scan for ",", else do syntax error then warm start
REQUIRE A COMMA
.,AFBA 20 8F AD JSR $AD8F         JSR     CHKSTR          ;MAKE SURE FIRST WAS STRING.
prüft auf String
check if source is string, else do type mismatch
MAKE SURE EXPRESSION IS A STRING
.,AFBD 68       PLA         PLA                     ;GET FUNCTION NUMBER.
Funktionstoken left$, r$, m$
restore function offset

.,AFBE AA       TAX         TAX
Akku nach X holen
copy it
RETRIEVE ROUTINE POINTER
.,AFBF A5 65    LDA $65         PSHWD   FACMO           ;SAVE POINTER AT STRING DESCRIPTOR
Adresse des
get descriptor pointer high byte
STACK ADDRESS OF STRING
.,AFC1 48       PHA
Stringdescriptors
push string pointer high byte

.,AFC2 A5 64    LDA $64
holen und auf den Stapel
get descriptor pointer low byte

.,AFC4 48       PHA
retten (LOW und HIGH)
push string pointer low byte

.,AFC5 8A       TXA         TXA
Akku wiederholen
restore function offset

.,AFC6 48       PHA         PHA                     ;RESAVE FUNCTION NUMBER.
                                ;THIS MUST BE ON STACK SINCE RECURSIVE.
Token auf den Stapel retten
save function offset
STACK DOUBLED TOKEN
.,AFC7 20 9E B7 JSR $B79E         JSR     GETBYT          ;[X]=VALUE OF FORMULA.
holt Byte-Wert (2. Parameter)
get byte parameter
CONVERT NEXT EXPRESSION TO BYTE IN X-REG
.,AFCA 68       PLA         PLA                     ;GET FUNCTION NUMBER.
Token zurückholen
restore function offset
GET DOUBLED TOKEN OFF STACK
.,AFCB A8       TAY         TAY
und ins Y-Reg.
copy function offset
USE AS INDEX TO BRANCH
.,AFCC 8A       TXA         TXA
2. Bytewert in den Akku laden
copy byte parameter to A
VALUE OF SECOND PARAMETER
.,AFCD 48       PHA         PHA
und auf den Stapel retten
push byte parameter
PUSH 2ND PARAM
.,AFCE 4C D6 AF JMP $AFD6         JMP     FINGO           ;DISPATCH TO FUNCTION.
Routine ausführen

numerische Funktion auswerten

go call function
get value from line .. continued
was SGN() to CHR$() so..
JOIN UNARY FUNCTIONS
.,AFD1 20 F1 AE JSR $AEF1 OKNORM: JSR     PARCHK          ;READ A FORMULA SURROUNDED BY PARENS.
holt Term in Klammern
evaluate expression within parentheses
REQUIRE "(EXPRESSION)"
.,AFD4 68       PLA         PLA                     ;GET DISPATCH FUNCTION.
BASIC-Code für Funktion holen
restore function offset

.,AFD5 A8       TAY         TAY
und als Zeiger ins Y-Reg.
copy to index
INDEX INTO FUNCTION ADDRESS TABLE
.,AFD6 B9 EA 9F LDA $9FEA,Y FINGO:  LDA     FUNDSP-2*ONEFUN+256,Y,  ;MODIFY DISPATCH ADDRESS.
Vektor für Funktionsbe-
get function jump vector low byte

.,AFD9 85 55    STA $55         STA     JMPER+1
rechnung holen und speichern
save functions jump vector low byte
PREPARE TO JSR TO ADDRESS
.,AFDB B9 EB 9F LDA $9FEB,Y         LDA     FUNDSP-2*ONEFUN+257,Y
2.Byte holen
get function jump vector high byte

.,AFDE 85 56    STA $56         STA     JMPER+2
und speichern
save functions jump vector high byte

.,AFE0 20 54 00 JSR $0054         JSR     JMPER           ;DISPATCH!
                                ;STRING FUNCTIONS REMOVE THIS RET ADDR.
Funktion ausführen
do function call
DOES NOT RETURN FOR
CHR$, LEFT$, RIGHT$, OR MID$
.,AFE3 4C 8D AD JMP $AD8D         JMP     CHKNUM          ;CHECK IT FOR NUMERICNESS AND RETURN.

prüft auf numerisch

BASIC-Befehl OR

check if source is numeric and RTS, else do type mismatch
string functions avoid this by dumping the return address

perform OR

this works because NOT(NOT(x) AND NOT(y)) = x OR y
REQUIRE NUMERIC RESULT

.,AFE6 A0 FF    LDY #$FF OROP:   LDYI    255             ;MUST ALWAYS COMPLEMENT..
Flag für OR
set Y for OR

.:AFE8 2C       .BYTE $2C         SKIP2


BASIC-Befehl AND

makes next line BIT $00A0

perform AND


.,AFE9 A0 00    LDY #$00 ANDOP:  LDYI    0
Flag fur AND
clear Y for AND

.,AFEB 84 0B    STY $0B         STY     COUNT           ;OPERATOR.
Flag setzen
set AND/OR invert value

.,AFED 20 BF B1 JSR $B1BF         JSR     AYINT           ;[FACMO&LO]=INT VALUE AND CHECK SIZE.
FAC nach INTEGER wandeln
evaluate integer expression, no sign check

.,AFF0 A5 64    LDA $64         LDA     FACMO           ;USE DEMORGAN'S LAW ON HIGH
ersten Wert holen
get FAC1 mantissa 3

.,AFF2 45 0B    EOR $0B         EOR     COUNT
mit Flag verknüpfen
EOR low byte

.,AFF4 85 07    STA $07         STA     INTEGR
und speichern
save it

.,AFF6 A5 65    LDA $65         LDA     FACLO           ;AND LOW.
zweiten Wert holen
get FAC1 mantissa 4

.,AFF8 45 0B    EOR $0B         EOR     COUNT
mit Flag verknüpfen
EOR high byte

.,AFFA 85 08    STA $08         STA     INTEGR+1
und speichern
save it

.,AFFC 20 FC BB JSR $BBFC         JSR     MOVFA
ARG nach FAC
copy FAC2 to FAC1, get 2nd value in expression

.,AFFF 20 BF B1 JSR $B1BF         JSR     AYINT           ;[FACMO&LO]=INT OF ARG.
FAC nach Integer
evaluate integer expression, no sign check

.,B002 A5 65    LDA $65         LDA     FACLO
zweites Byte holen
get FAC1 mantissa 4

.,B004 45 0B    EOR $0B         EOR     COUNT
mit Flag verknüpfen
EOR high byte

.,B006 25 08    AND $08         AND     INTEGR+1
logische AND-Verknüpfung
AND with expression 1 high byte

.,B008 45 0B    EOR $0B         EOR     COUNT           ;FINISH OUT DEMORGAN.
mit Flag verknüpfen
EOR result high byte

.,B00A A8       TAY         TAY                     ;SAVE HIGH.
ins Y-Reg. retten
save in Y

.,B00B A5 64    LDA $64         LDA     FACMO
erstes Byte holen
get FAC1 mantissa 3

.,B00D 45 0B    EOR $0B         EOR     COUNT
mit Flag verknüpfen
EOR low byte

.,B00F 25 07    AND $07         AND     INTEGR
logische AND-Verknüpfung
AND with expression 1 low byte

.,B011 45 0B    EOR $0B         EOR     COUNT
mit Flag verknüpfen
EOR result low byte

.,B013 4C 91 B3 JMP $B391         JMP     GIVAYF          ;FLOAT [A.Y] AND RET TO USER.

;
; TIME TO PERFORM A RELATIONAL OPERATOR.
; [DOMASK] CONTAINS THE BITS AS TO WHICH RELATIONAL
; OPERATOR IT WAS. CARRY BIT ON=STRING COMPARE.
;
wieder in Fließkomma wandeln

Vergleich

convert fixed integer AY to float FAC1 and return

perform comparisons

do < compare


PERFORM RELATIONAL OPERATIONS

.,B016 20 90 AD JSR $AD90 DOREL:  JSR     CHKVAL          ;CHECK FOR MATCH.
prüft auf identischen Typ
type match check, set C for string
MAKE SURE FAC IS CORRECT TYPE
.,B019 B0 13    BCS $B02E         BCS     STRCMP          ;IT IS A STRING.
String: dann weiter
branch if string
do numeric < compare
TYPE MATCHES, BRANCH IF STRINGS
.,B01B A5 6E    LDA $6E         LDA     ARGSGN          ;PACK ARG FOR FCOMP.
Wert holen
get FAC2 sign (b7)
NUMERIC COMPARISON
.,B01D 09 7F    ORA #$7F         ORAI    127
ARG in Speicherformat
set all non sign bits
RE-PACK VALUE IN ARG FOR FCOMP
.,B01F 25 6A    AND $6A         AND     ARGHO
wandeln und
and FAC2 mantissa 1 (AND in sign bit)

.,B021 85 6A    STA $6A         STA     ARGHO
wieder abspeichern
save FAC2 mantissa 1

.,B023 A9 69    LDA #$69         LDWDI   ARGEXP
Adresse von ARG
set pointer low byte to FAC2

.,B025 A0 00    LDY #$00
(LOW- und HIGH-Byte)
set pointer high byte to FAC2

.,B027 20 5B BC JSR $BC5B         JSR     FCOMP
Vergleich ARG mit FAC
compare FAC1 with (AY)
RETURN A-REG = -1,0,1
.,B02A AA       TAX         TAX

lt
AS ARG <,=,> FAC
.,B02B 4C 61 B0 JMP $B061         JMP     QCOMP
Ergebnis in FAC holen

Stringvergleich

go evaluate result
do string < compare


STRING COMPARISON

.,B02E A9 00    LDA #$00 STRCMP: CLR     VALTYP          ;RESULT WILL BE NUMERIC.
Wert laden und damit
clear byte
SET RESULT TYPE TO NUMERIC
.,B030 85 0D    STA $0D
Stringflag löschen
clear data type flag, $FF = string, $00 = numeric

.,B032 C6 4D    DEC $4D         DEC     OPMASK          ;TURN OFF VALTYP WHICH WAS STRING.
Operatormaske - 1
clear < bit in comparrison evaluation flag
MAKE CPRTYP 0000<=>0
.,B034 20 A6 B6 JSR $B6A6         JSR     FREFAC          ;FREE THE FACLO STRING.
FRLSTR
pop string off descriptor stack, or from top of string
space returns with A = length, X = pointer low byte,
Y = pointer high byte

.,B037 85 61    STA $61         STA     DSCTMP          ;SAVE FOR LATER.
Stringlänge holen
save length
STRING LENGTH
.,B039 86 62    STX $62         STXY    DSCTMP+1
LOW- und HIGH-Byte der
save string pointer low byte

.,B03B 84 63    STY $63
Stringadresse speichern
save string pointer high byte

.,B03D A5 6C    LDA $6C         LDWD    ARGMO           ;GET POINTER TO OTHER STRING.
LOW- und HIGH-Byte des
get descriptor pointer low byte

.,B03F A4 6D    LDY $6D
Zeigers auf zweiten String
get descriptor pointer high byte

.,B041 20 AA B6 JSR $B6AA         JSR     FRETMP          ;FREES FIRST DESC POINTER.
FRESTR
pop (YA) descriptor off stack or from top of string space
returns with A = length, X = pointer low byte,
Y = pointer high byte

.,B044 86 6C    STX $6C         STXY    ARGMO
Adresse des
save string pointer low byte

.,B046 84 6D    STY $6D
2. Strings
save string pointer high byte

.,B048 AA       TAX         TAX                     ;COPY COUNT INTO X.
Länge des 2.Strings merken
copy length
LEN (ARG) STRING
.,B049 38       SEC         SEC
Carry setzen (Subtraktion)
set carry for subtract

.,B04A E5 61    SBC $61         SBC     DSCTMP          ;WHICH IS GREATER. IF 0, ALL SET UP.
Längen vergleichen
subtract string 1 length
SET X TO SMALLER LEN
.,B04C F0 08    BEQ $B056         BEQ     STASGN          ;JUST PUT SIGN OF DIFFERENCE AWAY.
gleich: $B056
branch if str 1 length = string 2 length

.,B04E A9 01    LDA #$01         LDAI    1
Wert für: 1.String länger
set str 1 length > string 2 length

.,B050 90 04    BCC $B056         BCC     STASGN          ;SIGN IS POSITIVE.
2.String kürzer
branch if so

.,B052 A6 61    LDX $61         LDX     DSCTMP          ;LENGTH OF FAC IS SHORTER.
Länge des 1.Strings
get string 1 length

.,B054 A9 FF    LDA #$FF         LDAI    ^O377           ;GET A MINUS 1 FOR NEGATIVES.
Wert für: 1.String kürzer
set str 1 length < string 2 length

.,B056 85 66    STA $66 STASGN: STA     FACSGN          ;KEEP FOR LATER.
Flag für gleichen String,
save length compare
FLAG WHICH SHORTER
.,B058 A0 FF    LDY #$FF         LDYI    255             ;SET POINTER TO FIRST STRING. (ARG.)
wenn beide Strings identisch aber
set index

.,B05A E8       INX         INX                     ;TO LOOP PROPERLY.
ungleich lang sind
adjust for loop

.,B05B C8       INY NXTCMP: INY
Zeiger erhöhen
increment index

.,B05C CA       DEX         DEX                     ;ANY CHARACTERS LEFT TO COMPARE?
Stringende?
decrement count

.,B05D D0 07    BNE $B066         BNE     GETCMP          ;NOT DONE YET.
nein: weiter
branch if still bytes to do
MORE CHARS IN BOTH STRINGS
.,B05F A6 66    LDX $66         LDX     FACSGN          ;USE SIGN OF LENGTH DIFFERENCE
                                ;SINCE ALL CHARACTERS ARE THE SAME.
Vorzeichenbyte holen
get length compare back
IF = SO FAR, DECIDE BY LENGTH

.,B061 30 0F    BMI $B072 QCOMP:  BMI     DOCMP           ;C IS ALWAYS SET THEN.
negativ: $B072
branch if str 1 < str 2

.,B063 18       CLC         CLC
Carry löschen
flag str 1 <= str 2

.,B064 90 0C    BCC $B072         BCC     DOCMP           ;ALWAYS BRANCH.
unbedingter Sprung
go evaluate result
...ALWAYS

.,B066 B1 6C    LDA ($6C),Y GETCMP: LDADY   ARGMO           ;GET NEXT CHAR TO COMPARE.
Vergleich der Strings
get string 2 byte

.,B068 D1 62    CMP ($62),Y         CMPDY   DSCTMP+1        ;SAME?
zeichenweise
compare with string 1 byte

.,B06A F0 EF    BEQ $B05B         BEQ     NXTCMP          ;YEP. TRY FURTHER.
gleiche Zeichen: weiter
loop if bytes =
SAME, KEEP COMPARING
.,B06C A2 FF    LDX #$FF         LDXI    ^O377           ;SET A POSITIVE DIFFERENCE.
Wert laden
set str 1 < string 2
IN CASE ARG GREATER
.,B06E B0 02    BCS $B072         BCS     DOCMP           ;PUT STACK BACK TOGETHER.
und Vergleich beenden
branch if so
IT IS
.,B070 A2 01    LDX #$01         LDXI    1               ;SET A NEGATIVE DIFFERENCE.
Wert laden
set str 1 > string 2
FAC GREATER

.,B072 E8       INX DOCMP:  INX                     ;-1 TO 1, 0 TO 2, 1 TO 4.
und um 1 erhöhen
x = 0, 1 or 2
CONVERT FF,0,1 TO 0,1,2
.,B073 8A       TXA         TXA
Wert in den Akku
copy to A

.,B074 2A       ROL         ROL     A
linksverschieben, Bit 1, 2=$1
* 2 (1, 2 or 4)
AND TO 0,2,4 IF C=0, ELSE 1,2,5
.,B075 25 12    AND $12         AND     DOMASK
mit Vorzeichen verknüpfen
AND with the comparison evaluation flag
00000<=>
.,B077 F0 02    BEQ $B07B         BEQ     GOFLOT
=0: $B07B
branch if 0 (compare is false)
IF NO MATCH: FALSE
.,B079 A9 FF    LDA #$FF         LDAI    ^O377           ;MAP 0 TO 0. ALL OTHERS TO -1.

result true
AT LEAST ONE MATCH: TRUE
.,B07B 4C 3C BC JMP $BC3C GOFLOT: JMP     FLOAT           ;FLOAT THE ONE-BYTE RESULT INTO FAC.

PAGE

DIMENSION AND VARIABLE SEARCHING.

;
; THE "DIM" CODE SETS [DIMFLG] AND THEN FALLS INTO THE VARIABLE SEARCH
; ROUTINE, WHICH LOOKS AT DIMFLG AT THREE DIFFERENT POINTS.
; 1) IF AN ENTRY IS FOUND, "DIMFLG" BEING ON INDICATES
; A "DOUBLY" DIMENSIONED VARIABLE.
; 2) WHEN A NEW ENTRY IS BEING BUILT "DIMFLG" BEING ON
; INDICTAES THE INDICES SHOULD BE USED FOR THE
; SIZE OF EACH INDEX. OTHERWISE THE DEFAULT OF TEN
; IS USED.
; 3) WHEN THE BUILD ENTRY CODE FINISHES, ONLY IF "DIMFLG" IS OFF
; WILL INDEXING BE DONE.
;
Ergebnis nach FAC holen
save A as integer byte and return


"DIM" STATEMENT

.,B07E 20 FD AE JSR $AEFD DIM3:   JSR     CHKCOM          ;MUST BE A COMMA
CHKCOM prüft auf Komma

BASIC-Befehl DIM

scan for ",", else do syntax error then warm start

perform DIM

SEPARATED BY COMMAS
.,B081 AA       TAX DIM:    TAX                     ;SET [ACCX] NONZERO.
                                ;[ACCA] MUST BE NONZERO TO WORK RIGHT.
nächstes Zeichen
copy "DIM" flag to X
NON-ZERO, FLAGS PTRGET DIM CALLED
.,B082 20 90 B0 JSR $B090 DIM1:   JSR     PTRGT1
Variable dimensionieren
search for variable
ALLOCATE THE ARRAY
.,B085 20 79 00 JSR $0079 DIMCON: JSR     CHRGOT          ;GET LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
NEXT CHAR
.,B088 D0 F4    BNE $B07E         BNE     DIM3
nicht Ende: zur nächsten Var.
scan for "," and loop if not null
NOT END OF STATEMENT
.,B08A 60       RTS         RTS
;
; ROUTINE TO READ THE VARIABLE NAME AT THE CURRENT TEXT POSITION
; AND PUT A POINTER TO ITS VALUE IN VARPNT. [TXTPTR]
; POINTS TO THE TERMINATING CHARCTER.. NOT THAT EVALUATING SUBSCRIPTS
; IN A VARIABLE NAME CAN CAUSE RECURSIVE CALLS TO "PTRGET" SO AT
; THAT POINT ALL VALUES MUST BE STORED ON THE STACK.
;
Rücksprung

Variable holen



search for variable



PTRGET -- GENERAL VARIABLE SCAN

SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
VARTAB AND ARYTAB FOR THE NAME.
IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
RETURN WITH ADDRESS IN VARPNT AND Y,A

ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
DIMFLG -- NONZERO IF CALLED FROM "DIM"
ELSE = 0

SUBFLG -- = $00
= $40 IF CALLED FROM "GETARYPT"
= $80 IF CALLED FROM "DEF FN"
= $C1-DA IF CALLED FROM "FN"
.,B08B A2 00    LDX #$00 PTRGET: LDXI    0               ;MAKE [ACCX]=0.
Flag für nicht dimensionieren
set DIM flag = $00

.,B08D 20 79 00 JSR $0079         JSR     CHRGOT          ;RETRIEVE LAST CHARACTER.
CHRGOT letztes Zeichen holen
scan memory, 1st character
GET FIRST CHAR OF VARIABLE NAME

.,B090 86 0C    STX $0C PTRGT1: STX     DIMFLG          ;STORE FLAG AWAY.
DIM-Flag setzen
save DIM flag
X IS NONZERO IF FROM DIM

.,B092 85 45    STA $45 PTRGT2: STA     VARNAM
Variablenname
save 1st character

.,B094 20 79 00 JSR $0079         JSR     CHRGOT          ;GET CURRENT CHARACTER
                                ;MAYBE WITH FUNCTION BIT OFF.
CHRGOT letztes Zeichen holen
scan memory

.,B097 20 13 B1 JSR $B113         JSR     ISLETC          ;CHECK FOR LETTER.
prüft auf Buchstabe
check byte, return Cb = 0 if<"A" or >"Z"
IS IT A LETTER?
.,B09A B0 03    BCS $B09F         BCS     PTRGT3          ;MUST HAVE A LETTER.
ja: $B09F
branch if ok
YES, OKAY SO FAR
.,B09C 4C 08 AF JMP $AF08 INTERR: JMP     SNERR
'SYNTAX ERROR'
else syntax error then warm start
was variable name so ...
NO, SYNTAX ERROR
.,B09F A2 00    LDX #$00 PTRGT3: LDXI    0               ;ASSUME NO SECOND CHARACTER.
Wert laden und damit
clear 2nd character temp

.,B0A1 86 0D    STX $0D         STX     VALTYP          ;DEFAULT IS NUMERIC.
IFN     INTPRC,<
Stringflag löschen
clear data type flag, $FF = string, $00 = numeric

.,B0A3 86 0E    STX $0E         STX     INTFLG> ;ASSUME FLOATING.
Integerflag löschen
clear data type flag, $80 = integer, $00 = float

.,B0A5 20 73 00 JSR $0073         JSR     CHRGET          ;GET FOLLOWING CHARACTER.
CHRGET nächstes Zeichen holen
increment and scan memory, 2nd character
SECOND CHAR OF VARIABLE NAME
.,B0A8 90 05    BCC $B0AF         BCC     ISSEC           ;CARRY RESET BY CHRGET IF NUMERIC.
Ziffer?
if character = "0"-"9" (ok) go save 2nd character
2nd character wasn't "0" to "9" so ...
NUMERIC
.,B0AA 20 13 B1 JSR $B113         JSR     ISLETC          ;SET CARRY IF NOT ALPHABETIC.
prüft auf Buchstabe
check byte, return Cb = 0 if<"A" or >"Z"
LETTER?
.,B0AD 90 0B    BCC $B0BA         BCC     NOSEC           ;ALLOW ALPHABETICS.
nein: $B0BA
branch if <"A" or >"Z" (go check if string)
NO, END OF NAME
.,B0AF AA       TAX ISSEC:  TAX                     ;IT IS A NUMBER -- SAVE IN ACCX.
zweiter Buchstabe des Names
copy 2nd character
ignore further (valid) characters in the variable name
SAVE SECOND CHAR OF NAME IN X
.,B0B0 20 73 00 JSR $0073 EATEM:  JSR     CHRGET          ;LOOK AT NEXT CHARACTER.
CHRGET nächstes Zeichen holen
increment and scan memory, 3rd character
SCAN TO END OF VARIABLE NAME
.,B0B3 90 FB    BCC $B0B0         BCC     EATEM           ;SKIP NUMERICS.
Ziffer?
loop if character = "0"-"9" (ignore)
NUMERIC
.,B0B5 20 13 B1 JSR $B113         JSR     ISLETC
prüft auf Buchstabe
check byte, return Cb = 0 if<"A" or >"Z"

.,B0B8 B0 F6    BCS $B0B0         BCS     EATEM           ;SKIP ALPHABETICS.
ja: weitere Zeichen überlesen
loop if character = "A"-"Z" (ignore)
check if string variable
ALPHA
.,B0BA C9 24    CMP #$24 NOSEC:  CMPI    "$"             ;IS IT A STRING?
'$' Code?
compare with "$"
STRING?
.,B0BC D0 06    BNE $B0C4         BNE     NOTSTR          ;IF NOT, [VALTYP]=0.
nein: $B0C4
branch if not string
type is string
NO
.,B0BE A9 FF    LDA #$FF         LDAI    ^O377           ;SET [VALTYP]=255 (STRING !).
Wert laden und
set data type = string

.,B0C0 85 0D    STA $0D         STA     VALTYP
IFN     INTPRC,<
Stringflag setzen
set data type flag, $FF = string, $00 = numeric

.,B0C2 D0 10    BNE $B0D4         BNEA    TURNON          ;ALWAYS GOES.
Sprung
branch always
...ALWAYS
.,B0C4 C9 25    CMP #$25 NOTSTR: CMPI    "%"             ;INTEGER VARIABLE?
'%' Code?
compare with "%"
INTEGER?
.,B0C6 D0 13    BNE $B0DB         BNE     STRNAM          ;NO.
nein: $B0DB
branch if not integer
NO
.,B0C8 A5 10    LDA $10         LDA     SUBFLG
Integer erlaubt?
get subscript/FNX flag
YES; INTEGER VARIABLE ALLOWED?
.,B0CA D0 D0    BNE $B09C         BNE     INTERR
nein: 'SYNTAX ERROR'
if ?? do syntax error then warm start
NO, SYNTAX ERROR
.,B0CC A9 80    LDA #$80         LDAI    128
Wert für Integer laden
set integer type
YES
.,B0CE 85 0E    STA $0E         STA     INTFLG          ;SET FLAG.
und Integerflag setzen
set data type = integer
FLAG INTEGER MODE
.,B0D0 05 45    ORA $45         ORA     VARNAM          ;TURN ON BOTH HIGH BITS.
Bit 7 im 1.Zeichen setzen und
OR current variable name first byte

.,B0D2 85 45    STA $45         STA     VARNAM>
speichern (Bit7=1: Integer)
save current variable name first byte
SET SIGN BIT ON VARNAME
.,B0D4 8A       TXA TURNON: TXA
X nach Akku speichern
get 2nd character back
SECOND CHAR OF NAME
.,B0D5 09 80    ORA #$80         ORAI    128             ;TURN ON MSB OF SECOND CHARACTER.
Bit 7 im 2.Buchstaben setzen
set top bit, indicate string or integer variable
SET SIGN
.,B0D7 AA       TAX         TAX
X-Reg. zurückholen
copy back to 2nd character temp

.,B0D8 20 73 00 JSR $0073         JSR     CHRGET          ;GET CHARACTER AFTER $.
IFE     INTPRC,<
NOTSTR:>
CHRGET nächstes Zeichen holen
increment and scan memory
GET TERMINATING CHAR
.,B0DB 86 46    STX $46 STRNAM: STX     VARNAM+1        ;STORE AWAY SECOND CHARACTER.
zweiten Buchstaben speichern
save 2nd character
STORE SECOND CHAR OF NAME
.,B0DD 38       SEC         SEC
Feldvariablen erlaubt?
set carry for subtract

.,B0DE 05 10    ORA $10         ORA     SUBFLG          ;ADD FLAG WHETHER TO ALLOW ARRAYS.
wenn nicht, Bit7 setzen
or with subscript/FNX flag - or FN name
$00 OR $40 IF SUBSCRIPTS OK, ELSE $80
.,B0E0 E9 28    SBC #$28         SBCI    40              ;(CHECK FOR "(") WON'T MATCH IF SUBFLG SET.
'('-Wert abziehen
subtract "("
IF SUBFLG=$00 AND CHAR="("...
.,B0E2 D0 03    BNE $B0E7         JEQ     ISARY           ;IT IS!
nicht Klammer auf?
branch if not "("
NOPE
.,B0E4 4C D1 B1 JMP $B1D1
dimensionierte Variable holen
go find, or make, array
either find or create variable
variable name wasn't xx(.... so look for plain variable
YES
.,B0E7 A0 00    LDY #$00         CLR     SUBFLG          ;ALLOW SUBSCRIPTS AGAIN.
Wert laden und
clear A

.,B0E9 84 10    STY $10
FN-Flag = 0 setzen
clear subscript/FNX flag

.,B0EB A5 2D    LDA $2D         LDA     VARTAB          ;PLACE TO START SEARCH.
Zeiger auf Variablenanfang
get start of variables low byte
START LOWTR AT SIMPLE VARIABLE TABLE
.,B0ED A6 2E    LDX $2E         LDX     VARTAB+1
        LDYI    0
holen (LOW und HIGH)
get start of variables high byte

.,B0EF 86 60    STX $60 STXFND: STX     LOWTR+1
und zum
save search address high byte

.,B0F1 85 5F    STA $5F LOPFND: STA     LOWTR
Suchen merken
save search address low byte

.,B0F3 E4 30    CPX $30         CPX     ARYTAB+1        ;AT END OF TABLE YET?
Suchzeiger = Variablenanfang
compare with end of variables high byte
END OF SIMPLE VARIABLES?
.,B0F5 D0 04    BNE $B0FB         BNE     LOPFN
nein: $B0FB
skip next compare if <>
high addresses were = so compare low addresses
NO, GO ON
.,B0F7 C5 2F    CMP $2F         CMP     ARYTAB
Ende der Variablen erreicht?
compare low address with end of variables low byte
YES; END OF ARRAYS?
.,B0F9 F0 22    BEQ $B11D         BEQ     NOTFNS          ;YES. WE COULDN'T FIND IT.
ja: nicht gefunden, anlegen
if not found go make new variable
YES, MAKE ONE
.,B0FB A5 45    LDA $45 LOPFN:  LDA     VARNAM
ersten Buchstaben des Namens
get 1st character of variable to find
SAME FIRST LETTER?
.,B0FD D1 5F    CMP ($5F),Y         CMPDY   LOWTR           ;COMPARE HIGH ORDERS.
mit Tabelle vergleichen
compare with variable name 1st character

.,B0FF D0 08    BNE $B109         BNE     NOTIT           ;NO COMPARISON.
nein: weitersuchen
branch if no match
1st characters match so compare 2nd character
NOT SAME FIRST LETTER
.,B101 A5 46    LDA $46         LDA     VARNAM+1
zweiten Buchstaben
get 2nd character of variable to find
SAME SECOND LETTER?
.,B103 C8       INY         INY
Zeiger erhöhen
index to point to variable name 2nd character

.,B104 D1 5F    CMP ($5F),Y         CMPDY   LOWTR           ;AND THE LOW PART?
vergleichen
compare with variable name 2nd character

.,B106 F0 7D    BEQ $B185         BEQ     FINPTR          ;THAT'S IT ! THAT'S IT !
gleich: gefunden
branch if match (found variable)
YES, SAME VARIABLE NAME
.,B108 88       DEY         DEY
Zeiger vermindern
else decrement index (now = $00)
NO, BUMP TO NEXT NAME
.,B109 18       CLC NOTIT:  CLC
Carry setzen (Addition)
clear carry for add

.,B10A A5 5F    LDA $5F         LDA     LOWTR
Zeiger um 7
get search address low byte

.,B10C 69 07    ADC #$07         ADCI    6+ADDPRC        ;MAKES NO DIF AMONG TYPES.
erhöhen (2+5 Byte REAL Var.)
+7, offset to next variable name

.,B10E 90 E1    BCC $B0F1         BCC     LOPFND
(Länge eines V.-Eintrags)
loop if no overflow to high byte

.,B110 E8       INX         INX
Übertrag addieren
else increment high byte

.,B111 D0 DC    BNE $B0EF         BNEA    STXFND          ;ALWAYS BRANCHES.

;
; TEST FOR A LETTER. / CARRY OFF= NOT A LETTER.
; CARRY ON= A LETTER.
;
weiter suchen

prüft auf Buchstabe

loop always, RAM doesn't extend to $FFFF
check byte, return Cb = 0 if<"A" or >"Z"
...ALWAYS

CHECK IF (A) IS ASCII LETTER A-Z

RETURN CARRY = 1 IF A-Z
= 0 IF NOT

<<<NOTE FASTER AND SHORTER CODE: >>>
<<< CMP #'Z'+1 COMPARE HI END
<<< BCS .1 ABOVE A-Z
<<< CMP #'A' COMPARE LO END
<<< RTS C=0 IF LO, C=1 IF A-Z
<<<.1 CLC C=0 IF HI
<<< RTS
.,B113 C9 41    CMP #$41 ISLETC: CMPI    "A"
'A'-Code? (Buchstabencode)
compare with "A"
COMPARE LO END
.,B115 90 05    BCC $B11C         BCC     ISLRTS          ;IF LESS THAN "A", RET.
nein: $B11C sonst C = 0
exit if less
carry is set
C=0 IF LOW
.,B117 E9 5B    SBC #$5B         SBCI    "Z"+1
'Z' + 1
subtract "Z"+1
PREPARE HI END TEST
.,B119 38       SEC         SEC
ja: dann C = 1
set carry
TEST HI END, RESTORING (A)
.,B11A E9 A5    SBC #$A5         SBCI    256-"Z"-1       ;RESET CARRY IF [A] .GT. "Z".
nein: dann C = 0
subtract $A5 (restore byte)
carry clear if byte > $5A
C=0 IF LO, C=1 IF A-Z
.,B11C 60       RTS ISLRTS: RTS                     ;RETURN TO CALLER.

Rücksprung

Variable anlegen


reached end of variable memory without match
... so create new variable


VARIABLE NOT FOUND, SO MAKE ONE

.,B11D 68       PLA NOTFNS: PLA                     ;CHECK WHO'S CALLING.

dress low byte
LOOK AT RETURN ADDRESS ON STACK TO
.,B11E 48       PHA         PHA                     ;RESTORE IT.
Aufrufadresse prüfen
push return address low byte
SEE IF CALLED FROM FRM.VARIABLE
.,B11F C9 2A    CMP #$2A         CMPI    ISVRET-1-<ISVRET-1>/256*256 ;IS EVAL CALLING?
Aufruf von FRMEVL?
compare with expected calling routine return low byte

.,B121 D0 05    BNE $B128         BNE     NOTEVL          ;NO, CARRY ON.
IFN     REALIO-3,<
        TSX
        LDA     258,X
        CMPI    <<ISVRET-1>/256>
        BNE     NOTEVL>
nein: dann neu anlegen
if not get variable go create new variable
this will only drop through if the call was from $AF28 and is only called
from there if it is searching for a variable from the right hand side of a LET a=b
statement, it prevents the creation of variables not assigned a value.
value returned by this is either numeric zero, exponent byte is $00, or null string,
descriptor length byte is $00. in fact a pointer to any $00 byte would have done.
else return dummy null value
NO
.,B123 A9 13    LDA #$13 LDZR:   LDWDI   ZERO            ;SET UP PNTR TO SIMULATED ZERO.
Zeiger auf Konstante 0
set result pointer low byte
YES, CALLED FROM FRM.VARIABLE
.,B125 A0 BF    LDY #$BF
(LOW und HIGH)
set result pointer high byte
POINT TO A CONSTANT ZERO
.,B127 60       RTS         RTS                     ;FOR STRINGS OR NUMERIC.
                                ;AND FOR INTEGERS TOO.
NOTEVL:
IFN     TIME!EXTIO,<
Rücksprung

create new numeric variable
NEW VARIABLE USED IN EXPRESSION = 0

MAKE A NEW SIMPLE VARIABLE

MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
ENTER 7-BYTE VARIABLE DATA IN THE HOLE
.,B128 A5 45    LDA $45         LDWD    VARNAM>
LOW- und HIGH-Byte
get variable name first character

.,B12A A4 46    LDY $46 IFN     TIME,<
des Variablennames
get variable name second character

.,B12C C9 54    CMP #$54         CMPI    "T"
'T'-Code?
compare first character with "T"

.,B12E D0 0B    BNE $B13B         BNE     QSTAVR
nein: $B13B
branch if not "T"

.,B130 C0 C9    CPY #$C9         CPYI    "I"+128
'I$'-Code?
compare second character with "I$"

.,B132 F0 EF    BEQ $B123         BEQ     LDZR
ja: TI$
if "I$" return null value

.,B134 C0 49    CPY #$49         CPYI    "I"
'I'-Code?
compare second character with "I"

.,B136 D0 03    BNE $B13B         BNE     QSTAVR>
IFN     EXTIO!TIME,<
nein: $B13B
branch if not "I"
if name is "TI" do syntax error

.,B138 4C 08 AF JMP $AF08 GOBADV: JMP     SNERR>
QSTAVR:
IFN     EXTIO,<
'SYNTAX ERROR'
do syntax error then warm start

.,B13B C9 53    CMP #$53         CMPI    "S"
'S'-Code?
compare first character with "S"

.,B13D D0 04    BNE $B143         BNE     VAROK
nein: $B143
branch if not "S"

.,B13F C0 54    CPY #$54         CPYI    "T"
'T'-Code?
compare second character with "T"

.,B141 F0 F5    BEQ $B138         BEQ     GOBADV>
ST, dann 'SYNTAX ERROR'
if name is "ST" do syntax error

.,B143 A5 2F    LDA $2F VAROK:  LDWD    ARYTAB
LOW- und HIGH-Byte des
get end of variables low byte
SET UP CALL TO BLTU TO
.,B145 A4 30    LDY $30
Zeigers auf Arraytabelle
get end of variables high byte
TO MOVE FROM ARYTAB THRU STREND-1
.,B147 85 5F    STA $5F         STWD    LOWTR           ;LOWEST THING TO MOVE.
laden und
save old block start low byte
7 BYTES HIGHER
.,B149 84 60    STY $60
merken
save old block start high byte

.,B14B A5 31    LDA $31         LDWD    STREND          ;GET HIGHEST ADDR TO MOVE.
LOW- und HIGH-Byte des
get end of arrays low byte

.,B14D A4 32    LDY $32
Zeigers auf Ende der
get end of arrays high byte

.,B14F 85 5A    STA $5A         STWD    HIGHTR
Arraytabelle
save old block end low byte

.,B151 84 5B    STY $5B
merken
save old block end high byte

.,B153 18       CLC         CLC
Carry für Addition setzen
clear carry for add

.,B154 69 07    ADC #$07         ADCI    6+ADDPRC
um 7 verschieben für Anlage
+7, space for one variable

.,B156 90 01    BCC $B159         BCC     NOTEVE
einer neuen Variablen
branch if no overflow to high byte

.,B158 C8       INY         INY
Übertrag addieren
else increment high byte

.,B159 85 58    STA $58 NOTEVE: STWD    HIGHDS          ;PLACE TO STUFF IT.
LOW- und HIGH-Byte des
set new block end low byte

.,B15B 84 59    STY $59
neuen Blockendes speichern
set new block end high byte

.,B15D 20 B8 A3 JSR $A3B8         JSR     BLTU            ;MOVE IT ALL.
                                ;NOTE [Y,A] HAS [HIGHDS] FOR REASON.
Block verschieben
open up space in memory
MOVE ARRAY BLOCK UP
.,B160 A5 58    LDA $58         LDWD    HIGHDS          ;AND SET UP
Werte
get new start low byte
STORE NEW START OF ARRAYS
.,B162 A4 59    LDY $59
wiederholen
get new start high byte (-$100)

.,B164 C8       INY         INY
und damit
correct high byte

.,B165 85 2F    STA $2F         STWD    ARYTAB          ;NEW START OF ARRAY TABLE.
Zeiger auf Arraytabelle
set end of variables low byte

.,B167 84 30    STY $30
neu setzen
set end of variables high byte

.,B169 A0 00    LDY #$00         LDYI    0               ;GET ADDR OF VARIABLE ENTRY.
Zeiger setzen
clear index

.,B16B A5 45    LDA $45         LDA     VARNAM
erster Buchstabe des Namens
get variable name 1st character
FIRST CHAR OF NAME
.,B16D 91 5F    STA ($5F),Y         STADY   LOWTR
und speichern
save variable name 1st character

.,B16F C8       INY         INY
Zeiger erhöhen,
increment index

.,B170 A5 46    LDA $46         LDA     VARNAM+1
zweiten Buchstaben holen
get variable name 2nd character
SECOND CHAR OF NAME
.,B172 91 5F    STA ($5F),Y         STADY   LOWTR           ;STORE NAME OF VARIABLE.
und abspeichern
save variable name 2nd character

.,B174 A9 00    LDA #$00         LDAI    0
Nullwert laden
clear A
SET FIVE-BYTE VALUE TO 0
.,B176 C8       INY         INY
Zeiger erhöhen
increment index

.,B177 91 5F    STA ($5F),Y         STADY   LOWTR
nächsten 5 Werte
initialise variable byte

.,B179 C8       INY         INY
der Variable auf 0 setzen
increment index

.,B17A 91 5F    STA ($5F),Y         STADY   LOWTR
2. Byte speichern
initialise variable byte

.,B17C C8       INY         INY
Zeiger erhöhen
increment index

.,B17D 91 5F    STA ($5F),Y         STADY   LOWTR
3. Byte speichern
initialise variable byte

.,B17F C8       INY         INY
Zeiger erhöhen
increment index

.,B180 91 5F    STA ($5F),Y         STADY   LOWTR           ;FOURTH ZERO FOR DEF FUNC.
IFN     ADDPRC,<
4. Byte speichern
initialise variable byte

.,B182 C8       INY         INY
Zeiger erhöhen
increment index

.,B183 91 5F    STA ($5F),Y         STADY   LOWTR>
5. Byte speichern
initialise variable byte
found a match for variable


PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A

.,B185 A5 5F    LDA $5F FINPTR: LDA     LOWTR
Zeiger auf Variablenwert
get variable address low byte
LOWTR POINTS AT NAME OF VARIABLE,
.,B187 18       CLC         CLC
Carry löschen (Addition)
clear carry for add
SO ADD 2 TO GET TO VALUE
.,B188 69 02    ADC #$02         ADCI    2
zwei für Namen addieren
+2, offset past variable name bytes

.,B18A A4 60    LDY $60         LDY     LOWTR+1
in Zeiger auf Variable
get variable address high byte

.,B18C 90 01    BCC $B18F         BCC     FINNOW
Zeiger auf erstes Byte
branch if no overflow from add

.,B18E C8       INY         INY

t high byte

.,B18F 85 47    STA $47 FINNOW: STWD    VARPNT          ;THIS IS IT.
als Variablenzeiger
save current variable pointer low byte
ADDRESS IN VARPNT AND Y,A
.,B191 84 48    STY $48
nach $47/48 speichern
save current variable pointer high byte

.,B193 60       RTS         RTS
PAGE

MULTIPLE DIMENSION CODE.

Rücksprung

berechnet Zeiger auf erstes

Arrayelement


set-up array pointer to first element in array


COMPUTE ADDRESS OF FIRST VALUE IN ARRAY

ARYPNT = (LOWTR) + #DIMS*2 + 5
.,B194 A5 0B    LDA $0B FMAPTR: LDA     COUNT
Anzahl der Dimensionen
get # of dimensions (1, 2 or 3)
GET # OF DIMENSIONS

.,B196 0A       ASL         ASL     A,
mal 2
*2 (also clears the carry !)
#DIMS*2 (SIZE OF EACH DIM IN 2 BYTES)
.,B197 69 05    ADC #$05         ADCI    5               ;POINT TO ENTRIES. C CLR'D BY ASL.
plus 5
+5 (result is 7, 9 or 11 here)
+ 5 (2 FOR NAME, 2 FOR OFFSET TO NEXT
ARRAY, AND 1 FOR #DIMS
.,B199 65 5F    ADC $5F         ADC     LOWTR
zu $5F und
add array start pointer low byte
ADDRESS OF TH IS ARRAY IN ARYTAB
.,B19B A4 60    LDY $60         LDY     LOWTR+1
$60 addieren
get array pointer high byte

.,B19D 90 01    BCC $B1A0         BCC     JSRGM
Erhöhung umgehen
branch if no overflow

.,B19F C8       INY         INY
Übertrag addieren
else increment high byte

.,B1A0 85 58    STA $58 JSRGM:  STWD    ARYPNT
Ergebnis-Zeiger nach
save array data pointer low byte
ADDRESS OF FIRST VALUE IN ARRAY
.,B1A2 84 59    STY $59
$58/59 speichern
save array data pointer high byte

.,B1A4 60       RTS         RTS

Rücksprung



-32768 as floating value



.:B1A5 90 80 00 00 00 N32768: EXP     144,128,0,0     ;-32768.

Konstante -32768

Umwandlung FAC nach Integer

-32768

convert float to fixed

-32768 IN FLOATING POINT

.,B1AA 20 BF B1 JSR $B1BF
FAC nach Integer wandeln
evaluate integer expression, no sign check

.,B1AD A5 64    LDA $64
LOW-Byte
get result low byte

.,B1AF A4 65    LDY $65
HIGH-Byte
get result high byte

.,B1B1 60       RTS

;
; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND
; TURNS IT INTO A POSITIVE INTEGER
; LEAVING THE RESULT IN FACMO&LO. NEGATIVE ARGUMENTS
; ARE NOT ALLOWED.
;
Rücksprung

Ausdruck holen und

nach Integer



evaluate integer expression



EVALUATE NUMERIC FORMULA AT TXTPTR

CONVERTING RESULT TO INTEGER 0 <= X <= 32767
IN FAC+3,4
.,B1B2 20 73 00 JSR $0073 INTIDX: JSR     CHRGET
CHRGET nächstes Zeichen holen
increment and scan memory

.,B1B5 20 9E AD JSR $AD9E         JSR     FRMEVL          ;GET A NUMBER
FRMEVL, Ausdruck auswerten
evaluate expression
evaluate integer expression, sign check

.,B1B8 20 8D AD JSR $AD8D POSINT: JSR     CHKNUM
prüft auf numerisch
check if source is numeric, else do type mismatch


CONVERT FAC TO INTEGER

MUST BE POSITIVE AND LESS THAN 32768
.,B1BB A5 66    LDA $66         LDA     FACSGN
Vorzeichen?
get FAC1 sign (b7)
ERROR IF -
.,B1BD 30 0D    BMI $B1CC         BMI     NONONO          ;IF NEGATIVE, BLOW HIM OUT.
negativ: dann 'ILLEGAL QUANT'
do illegal quantity error if -ve
evaluate integer expression, no sign check


CONVERT FAC TO INTEGER

MUST BE -32767 <= FAC <= 32767
.,B1BF A5 61    LDA $61 AYINT:  LDA     FACEXP
Exponent
get FAC1 exponent
EXPONENT OF VALUE IN FAC
.,B1C1 C9 90    CMP #$90         CMPI    144             ;FAC .GT. 32767?
Betrag größer 32768?
compare with exponent = 2^16 (n>2^15)
ABS(VALUE) < 32768?
.,B1C3 90 09    BCC $B1CE         BCC     QINTGO
nein: $B1CE
if n<2^16 go convert FAC1 floating to fixed and return
YES, OK FOR INTEGER
.,B1C5 A9 A5    LDA #$A5         LDWDI   N32768          ;GET ADDR OF -32768.
Zeiger auf
set pointer low byte to -32768
NO; NEXT FEW LINES ARE SUPPOSED TO
.,B1C7 A0 B1    LDY #$B1
Konstante -32768 setzen
set pointer high byte to -32768
ALLOW -32768 ($8000)
.,B1C9 20 5B BC JSR $BC5B         JSR     FCOMP           ;SEE IF FAC=[[Y,A]].
Vergleich FAC mit Konstante
compare FAC1 with (AY)

.,B1CC D0 7A    BNE $B248 NONONO: BNE     FCERR           ;NO, FAC IS TOO BIG.
ungleich: 'ILLEGAL QUANT'
if <> do illegal quantity error then warm start
ILLEGAL QUANTITY
.,B1CE 4C 9B BC JMP $BC9B QINTGO: JMP     QINT            ;GO TO QINT AND SHOVE IT.
;
; FORMAT OF ARRAYS IN CORE.
;
; DESCRIPTOR:
; LOWBYTE = FIRST CHARACTER.
; HIGHBYTE = SECOND CHARACTER (200 BIT IS STRING FLAG).
; LENGTH OF ARRAY IN CORE IN BYTES (INCLUDES EVERYTHING).
; NUMBER OF DIMENSIONS.
; FOR EACH DIMENSION STARTING WITH THE FIRST A LIST
; (2 BYTES EACH) OF THE MAX INDICE+1
; THE VALUES
;
wandelt Fließkomma in Integer

dimensionierte Variable holen

convert FAC1 floating to fixed and return

find or make array

an array is stored as follows

array name two bytes with the following patterns for different types
1st char 2nd char
b7 b7 type element size
-------- -------- ----- ------------
0 0 floating point 5
0 1 string 3
1 1 integer 2
offset to next array word
dimension count byte
1st dimension size word, this is the number of elements including 0
2nd dimension size word, only here if the array has a second dimension
2nd dimension size word, only here if the array has a third dimension
note: the dimension size word is in high byte low byte
format, not like most 6502 words
then for each element the required number of bytes given as the element size above
CONVERT TO INTEGER

LOCATE ARRAY ELEMENT OR CREATE AN ARRAY


PARSE THE SUBSCRIPT LIST

.,B1D1 A5 0C    LDA $0C ISARY:  LDA     DIMFLG
IFN     INTPRC,<
DIM Flag
get DIM flag
YES
.,B1D3 05 0E    ORA $0E         ORA     INTFLG>
Integer Flag
OR with data type flag
SET HIGH BIT IF %
.,B1D5 48       PHA         PHA                     ;SAVE [DIMFLG] FOR RECURSION.
auf Stapel retten
push it
SAVE VALTYP AND DIMFLG ON STACK
.,B1D6 A5 0D    LDA $0D         LDA     VALTYP
String Flag
get data type flag, $FF = string, $00 = numeric

.,B1D8 48       PHA         PHA                     ;SAVE [VALTYP] FOR RECURSION.
auf Stapel retten
push it

.,B1D9 A0 00    LDY #$00         LDYI    0               ;SET NUMBER OF DIMENSIONS TO ZERO.
Anzahl der Indizes
clear dimensions count
now get the array dimension(s) and stack it (them) before the data type and DIM flag
COUNT # DIMENSIONS IN Y-REG
.,B1DB 98       TYA INDLOP: TYA                     ;SAVE NUMBER OF DIMS.
in Akku und
copy dimensions count
SAVE #DIMS ON STACK
.,B1DC 48       PHA         PHA
auf Stapel retten
save it

.,B1DD A5 46    LDA $46         PSHWD   VARNAM          ;SAVE LOOKS.
2. Buchstabe des Variablenn.
get array name 2nd byte
SAVE VARIABLE NAME ON STACK
.,B1DF 48       PHA
und retten
save it

.,B1E0 A5 45    LDA $45
1. Buchstabe der Variablenn.
get array name 1st byte

.,B1E2 48       PHA
retten
save it

.,B1E3 20 B2 B1 JSR $B1B2         JSR     INTIDX          ;EVALUATE INDICE INTO FACMO&LO.
Index holen und nach Integer
evaluate integer expression
EVALUATE SUBSCRIPT AS INTEGER
.,B1E6 68       PLA         PULWD   VARNAM          ;GET BACK ALL... WE'RE HOME.
die zwei
pull array name 1st byte
RESTORE VARIABLE NAME
.,B1E7 85 45    STA $45
Bytes des
restore array name 1st byte

.,B1E9 68       PLA
Variablennamens zurückholen
pull array name 2nd byte

.,B1EA 85 46    STA $46
und wieder abspeichern
restore array name 2nd byte

.,B1EC 68       PLA         PLA                     ;(# OF DIMS).
Anzahl der Indizes
pull dimensions count
RESTORE # DIMS TO Y-REG
.,B1ED A8       TAY         TAY
holen und ins Y-Reg.
restore it

.,B1EE BA       TSX         TSX
Stapelzeiger als Zeiger setzen
copy stack pointer
COPY VALTYP AND DIMFLG ON STACK
.,B1EF BD 02 01 LDA $0102,X         LDA     258,X
Variablenflags
get DIM flag
TO LEAVE ROOM FOR THE SUBSCRIPT
.,B1F2 48       PHA         PHA                     ;PUSH DIMFLG AND VALTYP FURTHER.
aus dem Stapel kopieren
push it

.,B1F3 BD 01 01 LDA $0101,X         LDA     257,X
und oben auf den
get data type flag

.,B1F6 48       PHA         PHA
Stapel legen
push it

.,B1F7 A5 64    LDA $64         LDA     INDICE          ;PUT INDICE ONTO STACK.
anstelle der
get this dimension size high byte
GET SUBSCRIPT VALUE AND PLACE IN THE
.,B1F9 9D 02 01 STA $0102,X         STA     258,X,          ;UNDER DIMFLG AND VALTYP.
Variablenflags
stack before flag bytes
STACK WHERE VALTYP &amp; DIMFLG WERE
.,B1FC A5 65    LDA $65         LDA     INDICE+1
Index LOW und HIGH in
get this dimension size low byte

.,B1FE 9D 01 01 STA $0101,X         STA     257,X
den Stapel kopieren
stack before flag bytes

.,B201 C8       INY         INY                     ;INCREMENT # OF DIMS.
Anzahl der Indizes erhöhen
increment dimensions count
COUNT THE SUBSCRIPT
.,B202 20 79 00 JSR $0079         JSR     CHRGOT          ;GET TERMINATING CHARACTER.
CHRGOT letztes Zeichen holen
scan memory
NEXT CHAR
.,B205 C9 2C    CMP #$2C         CMPI    44              ;A COMMA?
',' Komma?
compare with ","

.,B207 F0 D2    BEQ $B1DB         BEQ     INDLOP          ;YES.
ja: dann nächsten Index
if found go do next dimension
COMMA, PARSE ANOTHER SUBSCRIPT
.,B209 84 0B    STY $0B         STY     COUNT           ;SAVE COUNT OF DIMS.
Anzahl der Indizes speichern
store dimensions count
NO MORE SUBSCRIPTS, SAVE #
.,B20B 20 F7 AE JSR $AEF7         JSR     CHKCLS          ;MUST BE CLOSED PAREN.
prüft auf Klammer zu
scan for ")", else do syntax error then warm start
NOW NEED ")"
.,B20E 68       PLA         PLA
Flags vom
pull data type flag
RESTORE VALTYPE AND DIMFLG
.,B20F 85 0D    STA $0D         STA     VALTYP          ;GET VALTYP AND
Stapel
restore data type flag, $FF = string, $00 = numeric

.,B211 68       PLA         PLA
IFN     INTPRC,<
zurückholen
pull data type flag

.,B212 85 0E    STA $0E         STA     INTFLG
und abspeichern
restore data type flag, $80 = integer, $00 = float

.,B214 29 7F    AND #$7F         ANDI    127>
Integerflag herstellen
mask dim flag
ISOLATE DIMFLG
.,B216 85 0C    STA $0C         STA     DIMFLG          ;DIMFLG OFF STACK.
und abspeichern
restore DIM flag


SEARCH ARRAY TABLE FOR THIS ARRAY NAME

.,B218 A6 2F    LDX $2F         LDX     ARYTAB          ;PLACE TO START SEARCH.
LOW- und HIGH-Byte des
set end of variables low byte
(array memory start low byte)
(A,X) = START OF ARRAY TABLE
.,B21A A5 30    LDA $30         LDA     ARYTAB+1
Zeigers auf Arraytabelle
set end of variables high byte
(array memory start high byte)
now check to see if we are at the end of array memory, we would be if there were
no arrays.

.,B21C 86 5F    STX $5F LOPFDA: STX     LOWTR
holen und
save as array start pointer low byte
USE LOWTR FOR RUNNING POINTER
.,B21E 85 60    STA $60         STA     LOWTR+1
Zeiger merken
save as array start pointer high byte

.,B220 C5 32    CMP $32         CMP     STREND+1        ;END OF ARRAYS?
Ende erreicht?
compare with end of arrays high byte
DID WE REACH THE END OF ARRAYS YET?
.,B222 D0 04    BNE $B228         BNE     LOPFDV
nein: weiter
branch if not reached array memory end
NO, KEEP SEARCHING
.,B224 E4 31    CPX $31         CPX     STREND
mit Tabellenende vergleichen
else compare with end of arrays low byte

.,B226 F0 39    BEQ $B261         BEQ     NOTFDD          ;A FINE THING! NO ARRAY!.
ja: nicht gefunden, anlegen
go build array if not found
search for array
YES, THIS IS A NEW ARRAY NAME
.,B228 A0 00    LDY #$00 LOPFDV: LDYI    0
Zeiger setzen
clear index
POINT AT 1ST CHAR OF ARRAY NAME
.,B22A B1 5F    LDA ($5F),Y         LDADY   LOWTR
Namen aus Tabelle holen
get array name first byte
GET 1ST CHAR OF NAME
.,B22C C8       INY         INY
Zeiger erhöhen
increment index to second name byte
POINT AT 2ND CHAR
.,B22D C5 45    CMP $45         CMP     VARNAM          ;COMPARE HIGH ORDERS.
mit ges. Namen vergleichen
compare with this array name first byte
1ST CHAR SAME?
.,B22F D0 06    BNE $B237         BNE     NMARY1          ;NO WAY IS IT THIS. GET OUT OF HERE.
ungleich: $B237
branch if no match
NO, MOVE TO NEXT ARRAY
.,B231 A5 46    LDA $46         LDA     VARNAM+1
Vergleich mit
else get this array name second byte
YES, TRY 2ND CHAR
.,B233 D1 5F    CMP ($5F),Y         CMPDY   LOWTR           ;LOW ORDERS?
zweitem Buchstaben
compare with array name second byte
SAME?
.,B235 F0 16    BEQ $B24D         BEQ     GOTARY          ;WELL, HERE IT IS !!
gefunden: $B24D
array found so branch
no match
YES, ARRAY FOUND
.,B237 C8       INY NMARY1: INY
Zeiger erhöhen
increment index
POINT AT OFFSET TO NEXT ARRAY
.,B238 B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;GET LENGTH.
Suchzeiger zur
get array size low byte
ADD OFFSET TO RUNNING POINTER
.,B23A 18       CLC         CLC
Feldlänge
clear carry for add

.,B23B 65 5F    ADC $5F         ADC     LOWTR
Addieren
add array start pointer low byte

.,B23D AA       TAX         TAX
ergibt Zeiger auf
copy low byte to X

.,B23E C8       INY         INY
nächstes Array
increment index

.,B23F B1 5F    LDA ($5F),Y         LDADY   LOWTR
gleiches System
get array size high byte

.,B241 65 60    ADC $60         ADC     LOWTR+1
mit zweitem Byte
add array memory pointer high byte

.,B243 90 D7    BCC $B21C         BCC     LOPFDA          ;ALWAYS BRANCHES.
und weiter suchen
if no overflow go check next array

do bad subscript error

...ALWAYS

ERROR: BAD SUBSCRIPTS

.,B245 A2 12    LDX #$12 BSERR:  LDXI    ERRBS           ;GET BAD SUB ERROR NUMBER.
Nummer für 'bad subscript'
error $12, bad subscript error

.:B247 2C       .BYTE $2C         SKIP2

makes next line BIT $0EA2

do illegal quantity error

TRICK TO SKIP NEXT LINE

ERROR: ILLEGAL QUANTITY

.,B248 A2 0E    LDX #$0E FCERR:  LDXI    ERRFC           ;TOO BIG. "FUNCTION CALL" ERROR.
Nummer für 'illegal quanti.'
error $0E, illegal quantity error

.,B24A 4C 37 A4 JMP $A437 ERRGO3: JMP     ERROR
Fehlermeldung ausgeben
do error #X then warm start

found the array



FOUND THE ARRAY

.,B24D A2 13    LDX #$13 GOTARY: LDXI    ERRDD           ;PERHAPS A "RE-DIMENSION" ERROR
Nummer für 'redim'd array'
set error $13, double dimension error
SET UP FOR REDIM'D ARRAY ERROR
.,B24F A5 0C    LDA $0C         LDA     DIMFLG          ;TEST THE DIMFLG
DIM-Flag null?
get DIM flag
CALLED FROM "DIM" STATEMENT?
.,B251 D0 F7    BNE $B24A         BNE     ERRGO3
nein: dann Fehlermeldung
if we are trying to dimension it do error #X then warm
start
found the array and we're not dimensioning it so we must find an element in it
YES, ERROR
.,B253 20 94 B1 JSR $B194         JSR     FMAPTR
Zeiger auf 1.Arrayelement
set-up array pointer to first element in array
SET (ARYPNT) = ADDR OF FIRST ELEMENT
.,B256 A5 0B    LDA $0B         LDA     COUNT           ;GET NUMBER OF DIMS INPUT.
Zahl der gefundenen Dimensio.
get dimensions count
COMPARE NUMBER OF DIMENSIONS
.,B258 A0 04    LDY #$04         LDYI    4
Zeiger setzen
set index to array's # of dimensions

.,B25A D1 5F    CMP ($5F),Y         CMPDY   LOWTR           ;# OF DIMS THE SAME?
mit Dimensionen des Arrays
vergleichen
compare with no of dimensions

.,B25C D0 E7    BNE $B245         BNE     BSERR           ;SAME SO GO GET DEFINITION.
ungleich: 'bad subscript'
if wrong do bad subscript error
NOT SAME, SUBSCRIPT ERROR
.,B25E 4C EA B2 JMP $B2EA         JMP     GETDEF

;
; HERE WHEN VARIABLE IS NOT FOUND IN THE ARRAY TABLE.
;
; BUILDING AN ENTRY.
;
; PUT DOWN THE DESCRIPTOR.
; SETUP NUMBER OF DIMENSIONS.
; MAKE SURE THERE IS ROOM FOR THE NEW ENTRY.
; REMEMBER "VARPNT".
; TALLY=4.
; SKIP 2 LOCS FOR LATER FILL IN OF SIZE.
; LOOP: GET AN INDICE
; PUT DOWN NUMBER+1 AND INCREMENT VARPTR.
; TALLY=TALLY*NUMBER+1.
; DECREMENT NUMBER-DIMS.
; BNE LOOP
; CALL "REASON" WITH [Y,A] REFLECTING LAST LOC OF VARIABLE.
; UPDATE STREND.
; ZERO ALL.
; MAKE TALLY INCLUDE MAXDIMS AND DESCRIPTOR.
; PUT DOWN TALLY.
; IF CALLED BY DIMENSION, RETURN.
; OTHERWISE INDEX INTO THE VARIABLE AS IF IT
; WERE FOUND ON THE INITIAL SEARCH.
;
sucht gewünschtes Element

Arrayvariable anlegen

found array so go get element
array not found, so build it


CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT

.,B261 20 94 B1 JSR $B194 NOTFDD: JSR     FMAPTR          ;FORM ARYPNT.
Länge des Arraykopfs
set-up array pointer to first element in array
PUT ADDR OF 1ST ELEMENT IN ARYPNT
.,B264 20 08 A4 JSR $A408         JSR     REASON
prüft auf genügend Platz
check available memory, do out of memory error if no room
MAKE SURE ENOUGH MEMORY LEFT
.,B267 A0 00    LDY #$00         LDAI    0
        TAY
Zeiger für Polynom-
clear Y
POINT Y-REG AT VARIABLE NAME SLOT
.,B269 84 72    STY $72         STA     CURTOL+1
IFE     ADDPRC,<
        LDXI    4>
IFN     ADDPRC,<
auswertung neu setzen
clear array data size high byte
START SIZE COMPUTATION
.,B26B A2 05    LDX #$05         LDXI    5>
Wert für Variablenlänge(REAL)
set default element size
ASSUME 5-BYTES PER ELEMENT
.,B26D A5 45    LDA $45         LDA     VARNAM          ;THIS CODE ONLY WORKS FOR INTPRC=1
erster Buchstabe des Namens
get variable name 1st byte
STUFF VARIABLE NAME IN ARRAY
.,B26F 91 5F    STA ($5F),Y         STADY   LOWTR           ;IF ADDPRC=1.
IFN     ADDPRC,<
in Arraytabelle
save array name 1st byte

.,B271 10 01    BPL $B274         BPL     NOTFLT
kein Integer?
branch if not string or floating point array
NOT INTEGER ARRAY
.,B273 CA       DEX         DEX>
bei Integerzahl
decrement element size, $04
INTEGER ARRAY, DECR. SIZE TO 4-BYTES
.,B274 C8       INY NOTFLT: INY
Bytes vermindern
increment index
POINT Y-REG AT NEXT CHAR OF NAME
.,B275 A5 46    LDA $46         LDA     VARNAM+1
zweiter Buchstabe
get variable name 2nd byte
REST OF ARRAY NAME
.,B277 91 5F    STA ($5F),Y         STADY   LOWTR
in Tabelle schreiben
save array name 2nd byte

.,B279 10 02    BPL $B27D         BPL     STOMLT
kein String oder Integer?
branch if not integer or string
REAL ARRAY, STICK WITH SIZE = 5 BYTES
.,B27B CA       DEX         DEX
IFN     ADDPRC,<
entgültige
decrement element size, $03
INTEGER OR STRING ARRAY, ADJUST SIZE
.,B27C CA       DEX         DEX>
Variablenlänge herstellen
decrement element size, $02
TO INTEGER=3, STRING=2 BYTES
.,B27D 86 71    STX $71 STOMLT: STX     CURTOL
und speichern (2, 3 oder 5)
save element size
STORE LOW-BYTE OF ARRAY ELEMENT SIZE
.,B27F A5 0B    LDA $0B         LDA     COUNT
Anzahl der Dimensionen holen
get dimensions count
STORE NUMBER OF DIMENSIONS
.,B281 C8       INY         REPEAT  3,<INY>
Zeiger
increment index ..
IN 5TH BYTE OF ARRAY
.,B282 C8       INY
um 3
.. to array ..

.,B283 C8       INY
erhöhen
.. dimension count

.,B284 91 5F    STA ($5F),Y         STADY   LOWTR           ;SAVE NUMBER OF DIMENSIONS.
im Arrayheader speichern
save array dimension count

.,B286 A2 0B    LDX #$0B LOPPTA: LDXI    11              ;DEFAULT SIZE.
11, Defaultwert für
set default dimension size low byte
DEFAULT DIMENSION = 11 ELEMENTS
.,B288 A9 00    LDA #$00         LDAI    0
Dimensionierung
set default dimension size high byte
FOR HI-BYTE OF DIMENSION IF DEFAULT
.,B28A 24 0C    BIT $0C         BIT     DIMFLG
Aufruf durch DIM-Befehl?
test DIM flag
DIMENSIONED ARRAY?
.,B28C 50 08    BVC $B296         BVC     NOTDIM          ;NOT IN A DIM STATEMENT.
nein: $B296
branch if default to be used
NO, USE DEFAULT VALUE
.,B28E 68       PLA         PLA                     ;GET LOW ORDER OF INDICE.
Dimension vom Stapel holen
pull dimension size low byte
GET SPECIFIED DIM IN A,X
.,B28F 18       CLC         CLC
Carry löschen (Addition)
clear carry for add
# ELEMENTS IS 1 LARGER THAN
.,B290 69 01    ADC #$01         ADCI    1
eins addieren
add 1, allow for zeroeth element
DIMENSION VALUE
.,B292 AA       TAX         TAX
und ins X-Reg.
copy low byte to X

.,B293 68       PLA         PLA                     ;GET HIGH PART OF INDICE.
2.Wert holen
pull dimension size high byte

.,B294 69 00    ADC #$00         ADCI    0
Übertrag addieren
add carry to high byte

.,B296 C8       INY NOTDIM: INY
Zeiger erhöhen
incement index to dimension size high byte
ADD THIS DIMENSION TO ARRAY DESCRIPTOR
.,B297 91 5F    STA ($5F),Y         STADY   LOWTR           ;STORE HIGH PART OF INDICE.
und speichern
save dimension size high byte

.,B299 C8       INY         INY
Zeiger erhöhen
incement index to dimension size low byte

.,B29A 8A       TXA         TXA
1.Wert wieder in den Akku
copy dimension size low byte

.,B29B 91 5F    STA ($5F),Y         STADY   LOWTR           ;STORE LOW ORDER OF INDICE.
und ebenfalls speichern
save dimension size low byte

.,B29D 20 4C B3 JSR $B34C         JSR     UMULT           ;[X,A]=[CURTOL]*[LOWTR,Y]
Platz für Dimensionen berech.
compute array size
MULTIPLY THIS
DIMENSION BY RUNNING SIZE
((LOWTR)) * (STRNG2) --> A,X
.,B2A0 86 71    STX $71         STX     CURTOL          ;SAVE NEW TALLY.
LOW- und HIGH-Byte des
save result low byte
STORE RUNNING SIZE IN STRNG2
.,B2A2 85 72    STA $72         STA     CURTOL+1
Variablenende-Zeigers merken
save result high byte

.,B2A4 A4 22    LDY $22         LDY     INDEX
Zeiger auf Arrayheader
restore index
RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT
.,B2A6 C6 0B    DEC $0B         DEC     COUNT           ;ANY MORE INDICES LEFT?
weitere Dimensionen?
decrement dimensions count
COUNT DOWN # DIMS
.,B2A8 D0 DC    BNE $B286         BNE     LOPPTA          ;YES.
ja: $B286 (Schleifenbeginn)
loop if not all done
LOOP TILL DONE

NOW A,X HAS TOTAL # BYTES OF ARRAY ELEMENTS
.,B2AA 65 59    ADC $59         ADC     ARYPNT+1
Feldlänge plus Startadresse
add array data pointer high byte
COMPUTE ADDRESS OF END OF THIS ARRAY
.,B2AC B0 5D    BCS $B30B         BCS     OMERR1          ;OVERFLOW.
Überlauf: 'OUT OF MEMORY'
if overflow do out of memory error then warm start
...TOO LARGE, ERROR
.,B2AE 85 59    STA $59         STA     ARYPNT+1        ;COMPUTE WHERE TO ZERO.
Wert wieder speichern
save array data pointer high byte

.,B2B0 A8       TAY         TAY
und ins Y-Reg. bringen
copy array data pointer high byte

.,B2B1 8A       TXA         TXA
Variablenendzeiger in Akku
copy array size low byte

.,B2B2 65 58    ADC $58         ADC     ARYPNT
2.Zeichen addieren
add array data pointer low byte

.,B2B4 90 03    BCC $B2B9         BCC     GREASE
Überlauf: Platz prüfen
branch if no rollover

.,B2B6 C8       INY         INY
Endadresse erhöhen
else increment next array pointer high byte

.,B2B7 F0 52    BEQ $B30B         BEQ     OMERR1
Überlauf: 'OUT OF MEMORY'
if rolled over do out of memory error then warm start
...TOO LARGE, ERROR
.,B2B9 20 08 A4 JSR $A408 GREASE: JSR     REASON          ;GET ROOM.
prüft auf Speicherplatz
check available memory, do out of memory error if no room
MAKE SURE THERE IS ROOM UP TO Y,A
.,B2BC 85 31    STA $31         STWD    STREND          ;NEW END OF STORAGE.
Zeiger auf Ende
set end of arrays low byte
THERE IS ROOM SO SAVE NEW END OF TABLE
.,B2BE 84 32    STY $32
der Arraytabelle setzen
set end of arrays high byte
now the aray is created we need to zero all the elements in it
AND ZERO THE ARRAY
.,B2C0 A9 00    LDA #$00         LDAI    0               ;STORING [ACCA] IS FASTER THAN CLEAR.
Array mit Nullen füllen
clear A for array clear

.,B2C2 E6 72    INC $72         INC     CURTOL+1

array size high byte, now block count
PREPARE FOR FAST ZEROING LOOP
.,B2C4 A4 71    LDY $71         LDY     CURTOL
1.Schleifenende?
get array size low byte, now index to block
# BYTES MOD 256
.,B2C6 F0 05    BEQ $B2CD         BEQ     DECCUR
ja: $B2CD
branch if $00
FULL PAGE
.,B2C8 88       DEY ZERITA: DEY
Zeiger vermindern
decrement index, do 0 to n-1
CLEAR PAGE FULL
.,B2C9 91 58    STA ($58),Y         STADY   ARYPNT
Nullwert setzen
clear array element byte

.,B2CB D0 FB    BNE $B2C8         BNE     ZERITA          ;NO. CONTINUE.
fertig: $B2C8
loop until this block done

.,B2CD C6 59    DEC $59 DECCUR: DEC     ARYPNT+1

array pointer high byte
POINT TO NEXT PAGE
.,B2CF C6 72    DEC $72         DEC     CURTOL+1

block count high byte
COUNT THE PAGES
.,B2D1 D0 F5    BNE $B2C8         BNE     ZERITA          ;DO ANOTHER BLOCK.

til all blocks done
STILL MORE TO CLEAR
.,B2D3 E6 59    INC $59         INC     ARYPNT+1        ;BUMP BACK UP. WILL USE LATER.

or last loop
RECOVER LAST DEC, POINT AT 1ST ELEMENT
.,B2D5 38       SEC         SEC
Carry setzen (Subtr.)
set carry for subtract

.,B2D6 A5 31    LDA $31         LDA     STREND          ;RESTORE [ACCA].
Zeiger auf Feldende
get end of arrays low byte
COMPUTE OFFSET TO END OF ARRAYS
.,B2D8 E5 5F    SBC $5F         SBC     LOWTR           ;DETERMINE LENGTH.
- Zeiger auf Arrayheader
subtract array start low byte
AND STORE IN ARRAY DESCRIPTOR
.,B2DA A0 02    LDY #$02         LDYI    2
Zeiger setzen
index to array size low byte

.,B2DC 91 5F    STA ($5F),Y         STADY   LOWTR           ;LOW.
Arraylänge LOW
save array size low byte

.,B2DE A5 32    LDA $32         LDA     STREND+1
Zeiger auf Feldende
get end of arrays high byte

.,B2E0 C8       INY         INY
Zeiger erhöhen
index to array size high byte

.,B2E1 E5 60    SBC $60         SBC     LOWTR+1
- Zeiger auf Arrayheader
subtract array start high byte

.,B2E3 91 5F    STA ($5F),Y         STADY   LOWTR           ;HIGH.
Arraylänge HIGH
save array size high byte

.,B2E5 A5 0C    LDA $0C         LDA     DIMFLG
Aufruf vom DIM-Befehl?
get default DIM flag
WAS THIS CALLED FROM "DIM" STATEMENT?
.,B2E7 D0 62    BNE $B34B         BNE     DIMRTS          ;BYE.
ja: RTS

Arrayelement suchen

exit if this was a DIM command
else, find element
YES, WE ARE FINISHED
.,B2E9 C8       INY         INY
;
; AT THIS POINT [LOWTR,Y] POINTS BEYOND THE SIZE TO THE NUMBER OF
; DIMENSIONS. STRATEGY:
; NUMDIM=NUMBER OF DIMENSIONS.
; CURTOL=0.
; INLPNM:GET A NEW INDICE.
; MAKE SURE INDICE IS NOT TOO BIG.
; MULTIPLY CURTOL BY CURMAX.
; ADD INDICE TO CURTOL.
; NUMDIM=NUMDIM-1.
; BNE INLPNM.
; USE [CURTOL]*4 AS OFFSET.
;
Zeiger erhöhen
set index to # of dimensions, the dimension indeces
are on the stack and will be removed as the position
of the array element is calculated
NO, NOW NEED TO FIND THE ELEMENT

FIND SPECIFIED ARRAY ELEMENT

(LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR
THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS
.,B2EA B1 5F    LDA ($5F),Y GETDEF: LDADY   LOWTR
Zahl der Dimensionen
get array's dimension count
GET # OF DIMENSIONS
.,B2EC 85 0B    STA $0B         STA     COUNT           ;SAVE A COUNTER.
speichern
save it

.,B2EE A9 00    LDA #$00         LDAI    0               ;ZERO [CURTOL].
Nullwert laden und
clear byte
ZERO SUBSCRIPT ACCUMULATOR
.,B2F0 85 71    STA $71         STA     CURTOL
Zeiger auf Polynom-
clear array data pointer low byte

.,B2F2 85 72    STA $72 INLPNM: STA     CURTOL+1
auswertung löschen
save array data pointer high byte

.,B2F4 C8       INY         INY
Zeiger erhöhen
increment index, point to array bound high byte

.,B2F5 68       PLA         PLA                     ;GET LOW INDICE.
1. Indexwert vom Stapel
pull array index low byte
PULL NEXT SUBSCRIPT FROM STACK
.,B2F6 AA       TAX         TAX
holen und ins X-Reg. bringen
copy to X
SAVE IN FAC+3,4
.,B2F7 85 64    STA $64         STA     INDICE
Wert speichern
save index low byte to FAC1 mantissa 3
AND COMPARE WITH DIMENSIONED SIZE
.,B2F9 68       PLA         PLA                     ;AND THE HIGH PART
2. Indexwert holen
pull array index high byte

.,B2FA 85 65    STA $65         STA     INDICE+1
und speichern
save index high byte to FAC1 mantissa 4

.,B2FC D1 5F    CMP ($5F),Y         CMPDY   LOWTR           ;COMPARE WITH MAX INDICE.
mit Wert im Array vergleichen
compare with array bound high byte

.,B2FE 90 0E    BCC $B30E         BCC     INLPN2
kleiner?
branch if within bounds
SUBSCRIPT NOT TOO LARGE
.,B300 D0 06    BNE $B308         BNE     BSERR7          ;IF GREATER, "BAD SUBSCRIPT" ERROR.
größer: 'bad subscript'
if outside bounds do bad subscript error
else high byte was = so test low bytes
SUBSCRIPT IS TOO LARGE
.,B302 C8       INY         INY
Zeiger erhöhen
index to array bound low byte
CHECK LOW-BYTE OF SUBSCRIPT
.,B303 8A       TXA         TXA
1.Wert zurückholen
get array index low byte

.,B304 D1 5F    CMP ($5F),Y         CMPDY   LOWTR
LOW-Byte vergleichen
compare with array bound low byte

.,B306 90 07    BCC $B30F         BCC     INLPN1
kleiner: dann weiter
branch if within bounds
NOT TOO LARGE

.,B308 4C 45 B2 JMP $B245 BSERR7: JMP     BSERR
'bad subscript'
do bad subscript error
BAD SUBSCRIPTS ERROR
.,B30B 4C 35 A4 JMP $A435 OMERR1: JMP     OMERR
'out of memory'

Berechnung der Adresse

eines Arrayelements

do out of memory error then warm start
MEM FULL ERROR

.,B30E C8       INY INLPN2: INY
Zeiger erhöhen
index to array bound low byte
BUMP POINTER INTO DESCRIPTOR
.,B30F A5 72    LDA $72 INLPN1: LDA     CURTOL+1        ;DON'T MULTIPLY IF CURTOL=0.
Zeiger auf Polynomausw.(HIGH)
get array data pointer high byte
BYPASS MULTIPLICATION IF VALUE SO
.,B311 05 71    ORA $71         ORA     CURTOL
Zeiger auf Polynomausw.(LOW)
OR with array data pointer low byte
FAR = 0
.,B313 18       CLC         CLC                     ;PREPARE TO GET INDICE BACK.
Carry löschen
clear carry for either add, carry always clear here ??

.,B314 F0 0A    BEQ $B320         BEQ     ADDIND          ;GET HIGH PART OF INDICE BACK.
Multiplikation umgehen
branch if array data pointer = null, skip multiply
IT IS ZERO SO FAR
.,B316 20 4C B3 JSR $B34C         JSR     UMULT           ;MULTIPLY [CURTOL] BY [LOWTR,Y,Y+1].
Multiplikation
compute array size
NOT ZERO, SO MULTIPLY
.,B319 8A       TXA         TXA
(X/Y)=($71/72)*(($5F/60),Y)
get result low byte
ADD CURRENT SUBSCRIPT
.,B31A 65 64    ADC $64         ADC     INDICE          ;ADD IN [INDICE].

low byte from FAC1 mantissa 3

.,B31C AA       TAX         TAX
Akku zurück ins X-Reg.
save result low byte

.,B31D 98       TYA         TYA

gh byte

.,B31E A4 22    LDY $22         LDY     INDEX1
Zeiger in Arrayheader
restore index
RETRIEVE Y SAVED BY MULTIPLY.SUBSCRIPT
.,B320 65 65    ADC $65 ADDIND: ADC     INDICE+1

high byte from FAC1 mantissa 4
FINISH ADDING CURRENT SUBSCRIPT
.,B322 86 71    STX $71         STX     CURTOL

y data pointer low byte
STORE ACCUMULATED OFFSET
.,B324 C6 0B    DEC $0B         DEC     COUNT           ;ANY MORE?
Anzahl der Dimensionen
decrement dimensions count
LAST SUBSCRIPT YET?
.,B326 D0 CA    BNE $B2F2         BNE     INLPNM          ;YES.
mit nächstem Index weiter
loop if dimensions still to do
NO, LOOP TILL DONE
.,B328 85 72    STA $72         STA     CURTOL+1        ;FIX ARRAY BUG ****
IFE     ADDPRC,<
        LDXI    4>
IFN     ADDPRC,<

y data pointer high byte
YES, NOW MULTIPLY BE ELEMENT SIZE
.,B32A A2 05    LDX #$05         LDXI    5               ;THIS CODE ONLY WORKS FOR INTPRC=1
Variablenlänge (5, REAL)
set default element size
START WITH SIZE = 5
.,B32C A5 45    LDA $45         LDA     VARNAM          ;IF ADDPRC=1.
erster Buchstabe des Namens
get variable name 1st byte
DETERMINE VARIABLE TYPE
.,B32E 10 01    BPL $B331         BPL     NOTFL1
Integer? nein: $B331
branch if not string or floating point array
NOT INTEGER
.,B330 CA       DEX         DEX>
Länge vermindern
decrement element size, $04
INTEGER, BACK DOWN SIZE TO 4 BYTES
.,B331 A5 46    LDA $46 NOTFL1: LDA     VARNAM+1
zweiter Buchstabe des Namens
get variable name 2nd byte
DISCRIMINATE BETWEEN REAL AND STR
.,B333 10 02    BPL $B337         BPL     STOML1
FLP? ja: $B337
branch if not integer or string
IT IS REAL
.,B335 CA       DEX         DEX
IFN     ADDPRC,<
Länge 2 mal
decrement element size, $03
SIZE = 3 IF STRING, =2 IF INTEGER
.,B336 CA       DEX         DEX>
vermindern
decrement element size, $02

.,B337 86 28    STX $28 STOML1: STX     ADDEND
Länge der Variablen 2,3 oder5
save dimension size low byte
SET UP MULTIPLIER
.,B339 A9 00    LDA #$00         LDAI    0
Wert laden und damit
clear dimension size high byte
HI-BYTE OF MULTIPLIER
.,B33B 20 55 B3 JSR $B355         JSR     UMULTD          ;ON RTS, A&Y=HI . X=LO.
Offset im Array berechnen
compute array size
(STRNG2) BY ELEMENT SIZE
.,B33E 8A       TXA         TXA
zur Adresse des ersten
copy array size low byte
ADD ACCUMULATED OFFSET
.,B33F 65 58    ADC $58         ADC     ARYPNT
Elements addieren
add array data start pointer low byte
TO ADDRESS OF 1ST ELEMENT
.,B341 85 47    STA $47         STA     VARPNT
ergibt Variablenadresse
save as current variable pointer low byte
TO GET ADDRESS OF SPECIFIED ELEMENT
.,B343 98       TYA         TYA
2.Byte in Akku holen
copy array size high byte

.,B344 65 59    ADC $59         ADC     ARYPNT+1
addieren, ergibt
add array data start pointer high byte

.,B346 85 48    STA $48         STA     VARPNT+1
HIGH-Byte der Adresse
save as current variable pointer high byte

.,B348 A8       TAY         TAY
ins Y-Reg. bringen und
copy high byte to Y
RETURN WITH ADDR IN VARPNT
.,B349 A5 47    LDA $47         LDA     VARPNT
1.Byte wieder in Akku holen
get current variable pointer low byte
pointer to element is now in AY
AND IN Y,A
.,B34B 60       RTS DIMRTS: RTS                     ;RETURN TO CALLER.

INTEGER ARITHMETIC ROUTINES.

;TWO BYTE UNSIGNED INTEGER MULTIPLY.
;THIS IS FOR MULTIPLY DIMENSIONED ARRAYS.
; [X,Y]=[X,A]=[CURTOL]*[LOWTR,Y,Y+1].
Rücksprung

Hilfsroutine für

Arrayberechnung


compute array size, result in XY


MULTIPLY (STRNG2) BY ((LOWTR),Y)

LEAVING PRODUCT IN A,X.

(HI-BYTE ALSO IN Y.)
USED ONLY BY ARRAY SUBSCRIPT ROUTINES
.,B34C 84 22    STY $22 UMULT:  STY     INDEX
Register merken
save index
SAVE Y-REG
.,B34E B1 5F    LDA ($5F),Y         LDADY   LOWTR
1. Wert holen
get dimension size low byte
GET MULTIPLIER
.,B350 85 28    STA $28         STA     ADDEND          ;LOW, THEN HIGH.
und abspeichern
save dimension size low byte
SAVE IN RESULT+2,3
.,B352 88       DEY         DEY
Zeiger vermindern
decrement index

.,B353 B1 5F    LDA ($5F),Y         LDADY   LOWTR           ;PUT [LOWTR,Y,Y+1] IN FASTER MEMORY.
2. Wert holen
get dimension size high byte


.,B355 85 29    STA $29 UMULTD: STA     ADDEND+1
und abspeichern
save dimension size high byte
LOW BYTE OF MULTIPLIER
.,B357 A9 10    LDA #$10         LDAI    16
Wert laden und damit
count = $10 (16 bit multiply)
MULTIPLY 16 BITS
.,B359 85 5D    STA $5D         STA     DECCNT
Verschiebezähler setzen
save bit count

.,B35B A2 00    LDX #$00         LDXI    0               ;CLR THE ACCS.
LOW- und HIGH-Byte des Er-
clear result low byte
PRODUCT = 0 INITIALLY
.,B35D A0 00    LDY #$00         LDYI    0               ;RESULT INITIALLY ZERO.
gebnisregisters auf 0 setzen
clear result high byte

.,B35F 8A       TXA UMULTC: TXA
LOW-Byte in Akku holen und
get result low byte
DOUBLE PRODUCT
.,B360 0A       ASL         ASL     A,              ;MULTIPLY BY TWO.
um 1 Bit nach links schieben
*2
LOW BYTE
.,B361 AA       TAX         TAX
Byte zurück ins X-Reg.
save result low byte

.,B362 98       TYA         TYA
HIGH-Byte in den Akku holen,
get result high byte
HIGH BYTE
.,B363 2A       ROL         ROL     A,
um 1 Bit nach links schieben
*2
IF TOO LARGE, SET CARRY
.,B364 A8       TAY         TAY
und zurückbringen
save result high byte

.,B365 B0 A4    BCS $B30B         BCS     OMERR1          ;TWO MUCH !
Überlauf: 'out of memory'
if overflow go do "Out of memory" error
TOO LARGE, "MEM FULL ERROR"
.,B367 06 71    ASL $71         ASL     CURTOL
nächstes Bit aus
shift element size low byte
NEXT BIT OF MUTLPLICAND
.,B369 26 72    ROL $72         ROL     CURTOL+1
$71/72 herausholen
shift element size high byte
INTO CARRY
.,B36B 90 0B    BCC $B378         BCC     UMLCNT          ;NOTHING IN THIS POSITION TO MULTIPLY.
=0? ja: Addition umgehen
skip add if no carry
BIT=0, DON'T NEED TO ADD
.,B36D 18       CLC         CLC
Carry setzen (Addition)
else clear carry for add
BIT=1, ADD INTO PARTIAL PRODUCT
.,B36E 8A       TXA         TXA
LOW-Byte holen
get result low byte

.,B36F 65 28    ADC $28         ADC     ADDEND
1. Wert addieren
add dimension size low byte

.,B371 AA       TAX         TAX
LOW-Byte zurückbringen
save result low byte

.,B372 98       TYA         TYA
HIGH-Byte holen
get result high byte

.,B373 65 29    ADC $29         ADC     ADDEND+1
2. Wert addieren
add dimension size high byte

.,B375 A8       TAY         TAY
HIGH-Byte zurückholen
save result high byte

.,B376 B0 93    BCS $B30B         BCS     OMERR1          ;MAN, JUST TOO MUCH !
Überlauf: 'out of memory'
if overflow go do "Out of memory" error
TOO LARGE, "MEM FULL ERROR"
.,B378 C6 5D    DEC $5D UMLCNT: DEC     DECCNT          ;DONE?
nächstes Bit holen
decrement bit count
16-BITS YET?
.,B37A D0 E3    BNE $B35F         BNE     UMULTC          ;KEEP IT UP.
alle 16 Bits? nein: weiter
loop until all done
NO, KEEP SHUFFLING
.,B37C 60       RTS UMLRTS: RTS                     ;YES, ALL DONE.
PAGE

FRE FUNCTION AND INTEGER TO FLOATING ROUTINES.

Rücksprung

BASIC-Funktion FRE


perform FRE()
YES, PRODUCT IN Y,X AND A,X

"FRE" FUNCTION

COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
.,B37D A5 0D    LDA $0D FRE:    LDA     VALTYP
Typflag
get data type flag, $FF = string, $00 = numeric
LOOK AT VALUE OF ARGUMENT
.,B37F F0 03    BEQ $B384         BEQ     NOFREF
kein String
branch if numeric
=0 MEANS REAL, =$FF MEANS STRING
.,B381 20 A6 B6 JSR $B6A6         JSR     FREFAC
FRESTR
pop string off descriptor stack, or from top of string
space returns with A = length, X=$71=pointer low byte,
Y=$72=pointer high byte
FRE(n) was numeric so do this
STRING, SO SET IT FREE IS TEMP
.,B384 20 26 B5 JSR $B526 NOFREF: JSR     GARBA2
Garbage Collection
go do garbage collection
COLLECT ALL THE GARBAGE IN SIGHT
.,B387 38       SEC         SEC
Carry setzen (Subtr.)
set carry for subtract
COMPUTE SPACE BETWEEN ARRAYS AND
.,B388 A5 33    LDA $33         LDA     FRETOP          ;WE WANT
Stringanfang (LOW)
get bottom of string space low byte
STRING TEMP AREA
.,B38A E5 31    SBC $31         SBC     STREND          ;[FRETOP]-[STREND].
- Variablenende (LOW)
subtract end of arrays low byte

.,B38C A8       TAY         TAY
ergibt freien Speicher
copy result to Y

.,B38D A5 34    LDA $34         LDA     FRETOP+1
Stringanfang (HIGH)
get bottom of string space high byte

.,B38F E5 32    SBC $32         SBC     STREND+1

- Variablenende (HIGH)
subtract end of arrays high byte

convert fixed integer AY to float FAC1

FREE SPACE IN Y,A
FALL INTO GIVAYF TO FLOAT THE VALUE
NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE

FLOAT THE SIGNED INTEGER IN A,Y

.,B391 A2 00    LDX #$00 GIVAYF: LDXI    0
Wert laden und
set type = numeric
MARK FAC VALUE TYPE REAL
.,B393 86 0D    STX $0D         STX     VALTYP
Flag auf numerisch setzen
clear data type flag, $FF = string, $00 = numeric

.,B395 85 62    STA $62         STWD    FACHO
LOW- und HIGH-Byte des
save FAC1 mantissa 1
SAVE VALUE FROM A,Y IN MANTISSA
.,B397 84 63    STY $63
Ergebnisses merken
save FAC1 mantissa 2

.,B399 A2 90    LDX #$90         LDXI    144             ;SET EXPONENT TO 2^16.
und nach
set exponent=2^16 (integer)
SET EXPONENT TO 2^16
.,B39B 4C 44 BC JMP $BC44         JMP     FLOATS          ;TURN IT TO A FLOATING PNT #.

Fließkomma wandlen

BASIC-Funktion POS

set exp = X, clear FAC1 3 and 4, normalise and return

perform POS()

CONVERT TO SIGNED FP

"POS" FUNCTION

RETURNS CURRENT LINE POSITION FROM MON.CH
.,B39E 38       SEC POS:    LDY     TRMPOS          ;GET POSITION.
C=1 Cursorposition holen
set Cb for read cursor position

.,B39F 20 F0 FF JSR $FFF0
Cursorposition holen
read/set X,Y cursor position


FLOAT (Y) INTO FAC, GIVING VALUE 0-255

.,B3A2 A9 00    LDA #$00 SNGFLT: LDAI    0
Z=1
clear high byte
MSB = 0
.,B3A4 F0 EB    BEQ $B391         BEQA    GIVAYF          ;FLOAT IT.
PAGE

SIMPLE-USER-DEFINED-FUNCTION CODE.

;
; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS
; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM:
; DEF FNA(X)=X^2+X-2
; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS.
;
; IDEA: CREATE A SIMPLE VARIABLE ENTRY
; WHOSE FIRST CHARACTER HAS THE 200 BIT SET.
; THE VALUE WILL BE:
;
; A TEXT PNTR TO THE FORMULA.
; A PNTR TO THE ARGUMENT VARIABLE.
;
; FUNCTION NAMES CAN BE LIKE "FNA4".
;
;
; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE.
; AND COMPLAIN IF SO.
;
unbedingter Sprung

Test auf Direkt-Modus

convert fixed integer AY to float FAC1, branch always
check not Direct, used by DEF and INPUT
...ALWAYS

CHECK FOR DIRECT OR RUNNING MODE

GIVING ERROR IF DIRECT MODE

.,B3A6 A6 3A    LDX $3A ERRDIR: LDX     CURLIN+1        ;DIR MODE HAS [CURLIN]=0,255
Flag laden (Direktm. = $FF)
get current line number high byte
=$FF IF DIRECT MODE
.,B3A8 E8       INX         INX                     ;SO NOW, IS RESULT ZERO?
testen
increment it
MAKES $FF INTO ZERO
.,B3A9 D0 A0    BNE $B34B         BNE     DIMRTS          ;YES.
nein: dann RTS
return if not direct mode
else do illegal direct error
RETURN IF RUNNING MODE
.,B3AB A2 15    LDX #$15         LDXI    ERRID           ;INPUT DIRECT ERROR CODE.
Nummer für 'illegal direct'
error $15, illegal direct error
DIRECT MODE, GIVE ERROR
.:B3AD 2C       .BYTE $2C         SKIP2

makes next line BIT $1BA2
TRICK TO SKIP NEXT 2 BYTES

.,B3AE A2 1B    LDX #$1B ERRGUF: LDXI    ERRUF           ;USER DEFINED FUNCTION NEVER DEFINED
Nummer für 'undef'd function'
error $1B, undefined function error
UNDEFINDED FUNCTION ERROR
.,B3B0 4C 37 A4 JMP $A437 ERRGO1: JMP     ERROR

Fehlermeldung ausgeben

BASIC-Befehl DEF FN

do error #X then warm start

perform DEF



"DEF" STATEMENT

.,B3B3 20 E1 B3 JSR $B3E1 DEF:    JSR     GETFNM          ;GET A PNTR TO THE FUNCTION.
prüft FN-Syntax
check FNx syntax
PARSE "FN", FUNCTION NAME
.,B3B6 20 A6 B3 JSR $B3A6         JSR     ERRDIR
testet auf Direkt-Modus
check not direct, back here if ok
ERROR IF IN DIRECT MODE
.,B3B9 20 FA AE JSR $AEFA         JSR     CHKOPN          ;MUST HAVE "(".
prüft auf 'Klammer auf
scan for "(", else do syntax error then warm start
NEED "("
.,B3BC A9 80    LDA #$80         LDAI    128
Wert laden
set flag for FNx
FLAG PTRGET THAT CALLED FROM "DEF FN"
.,B3BE 85 10    STA $10         STA     SUBFLG          ;PROHIBIT SUBSCRIPTED VARIABLES.
sperrt INTEGER-Variable
save subscript/FNx flag
ALLOW ONLY SIMPLE FP VARIABLE FOR ARG
.,B3C0 20 8B B0 JSR $B08B         JSR     PTRGET          ;GET PNTR TO ARGUMENT.
sucht Variable
get variable address
GET PNTR TO ARGUMENT
.,B3C3 20 8D AD JSR $AD8D         JSR     CHKNUM          ;IS IT A NUMBER?
prüft auf numerisch
check if source is numeric, else do type mismatch
MUST BE NUMERIC
.,B3C6 20 F7 AE JSR $AEF7         JSR     CHKCLS          ;MUST HAVE ")"
prüft auf 'Klammer zu'
scan for ")", else do syntax error then warm start
MUST HAVE ")" NOW
.,B3C9 A9 B2    LDA #$B2         SYNCHK  EQULTK          ;MUST HAVE "=".
'=' BASIC-Code
get = token
NOW NEED "="
.,B3CB 20 FF AE JSR $AEFF
prüft auf '='
scan for CHR$(A), else do syntax error then warm start
OR ELSE SYNTAX ERROR
.,B3CE 48       PHA IFN     ADDPRC,<PHA> ;PUT CRAZY BYTE ON.
erstes Zeichen auf Stapel
push next character
SAVE CHAR AFTER "="
.,B3CF A5 48    LDA $48         PSHWD   VARPNT
LOW- und HIGH-Byte der
get current variable pointer high byte
SAVE PNTR TO ARGUMENT
.,B3D1 48       PHA
FN-Variablen-Adresse
push it

.,B3D2 A5 47    LDA $47
auf den Stapel
get current variable pointer low byte

.,B3D4 48       PHA
legen
push it

.,B3D5 A5 7B    LDA $7B         PSHWD   TXTPTR
LOW- und HIGH-Byte
get BASIC execute pointer high byte
SAVE TXTPTR
.,B3D7 48       PHA
des Programmzeigers
push it

.,B3D8 A5 7A    LDA $7A
auf den Stapel
get BASIC execute pointer low byte

.,B3DA 48       PHA
legen
push it

.,B3DB 20 F8 A8 JSR $A8F8         JSR     DATA
Programmzeiger auf Statement
perform DATA
SCAN TO NEXT STATEMENT
.,B3DE 4C 4F B4 JMP $B44F         JMP     DEFFIN
;
; SUBROUTINE TO GET A PNTR TO A FUNCTION NAME.
;
FN-Variable vom Stapel holen

prüft FN-Syntax

put execute pointer and variable pointer into function
and return

check FNx syntax

STORE ABOVE 5 BYTES IN "VALUE"

COMMON ROUTINE FOR "DEFFN" AND "FN", TO

PARSE "FN" AND THE FUNCTION NAME

.,B3E1 A9 A5    LDA #$A5 GETFNM: SYNCHK  FNTK            ;MUST START WITH FN.
FN-Code
set FN token
MUST NOW SEE "FN" TOKEN
.,B3E3 20 FF AE JSR $AEFF
prüft auf FN-Code
scan for CHR$(A), else do syntax error then warm start
OR ELSE SYNTAX ERROR
.,B3E6 09 80    ORA #$80         ORAI    128             ;PUT FUNCTION BIT ON.
Wert laden
set FN flag bit
SET SIGN BIT ON 1ST CHAR OF NAME,
.,B3E8 85 10    STA $10         STA     SUBFLG
sperrt INTEGER-Variable
save FN name
MAKING $C0 < SUBFLG < $DB
.,B3EA 20 92 B0 JSR $B092         JSR     PTRGT2          ;GET POINTER TO FUNCTION OR CREATE ANEW.
sucht Variable
search for FN variable
WHICH TELLS PTRGET WHO CALLED
.,B3ED 85 4E    STA $4E         STWD    DEFPNT
LOW- und HIGH-Byte
save function pointer low byte
FOUND VALID FUNCTION NAME, SO
.,B3EF 84 4F    STY $4F
FN-Variablenzeiger setzen
save function pointer high byte
SAVE ADDRESS
.,B3F1 4C 8D AD JMP $AD8D         JMP     CHKNUM          ;MAKE SURE IT'S NOT A STRING AND RETURN.

prüft auf numerisch

BASIC-Funktion FN

check if source is numeric and return, else do type
mismatch

Evaluate FNx

MUST BE NUMERIC

"FN" FUNCTION CALL

.,B3F4 20 E1 B3 JSR $B3E1 FNDOER: JSR     GETFNM          ;GET THE FUNCTION'S NAME.
prüft FN-Syntax
check FNx syntax
PARSE "FN", FUNCTION NAME
.,B3F7 A5 4F    LDA $4F         PSHWD   DEFPNT
LOW- und HiGH-Byte des
get function pointer high byte
STACK FUNCTION ADDRESS
.,B3F9 48       PHA
FN-Variablenzeigers
push it
IN CASE OF A NESTED FN CALL
.,B3FA A5 4E    LDA $4E
auf den Stapel
get function pointer low byte

.,B3FC 48       PHA
legen
push it

.,B3FD 20 F1 AE JSR $AEF1         JSR     PARCHK          ;EVALUATE PARAMETER.
holt Term in Klammern
evaluate expression within parentheses
MUST NOW HAVE "(EXPRESSION)"
.,B400 20 8D AD JSR $AD8D         JSR     CHKNUM
prüft auf numerisch
check if source is numeric, else do type mismatch
MUST BE NUMERIC EXPRESSION
.,B403 68       PLA         PULWD   DEFPNT
LOW- und HIGH-Byte
pop function pointer low byte
GET FUNCTION ADDRESS BACK
.,B404 85 4E    STA $4E
des
restore it

.,B406 68       PLA
FN-Variablenzeigers wieder-
pop function pointer high byte

.,B407 85 4F    STA $4F
holen und speichern
restore it

.,B409 A0 02    LDY #$02         LDYI    2
Zeiger setzen
index to variable pointer high byte
POINT AT ADD OF ARGUMENT VARIABLE
.,B40B B1 4E    LDA ($4E),Y         LDADY   DEFPNT          ;GET POINTER TO VARIABLE.
Zeiger (LOW) auf FN-Variable
get variable address low byte

.,B40D 85 47    STA $47         STA     VARPNT          ;SAVE VARIABLE POINTER.
in Variablenadresszeiger
save current variable pointer low byte

.,B40F AA       TAX         TAX
und ins X-Reg.
copy address low byte

.,B410 C8       INY         INY
Zeiger erhöhen
index to variable address high byte

.,B411 B1 4E    LDA ($4E),Y         LDADY   DEFPNT
Zeiger (HIGH) laden
get variable pointer high byte

.,B413 F0 99    BEQ $B3AE         BEQ     ERRGUF
gibt 'undef'd function'
branch if high byte zero
UNDEFINED FUNCTION
.,B415 85 48    STA $48         STA     VARPNT+1
in Variablenadresse
save current variable pointer high byte

.,B417 C8       INY IFN     ADDPRC,<INY> ;SINCE DEF USES ONLY 4.
Zeiger erhöhen
index to mantissa 3
now stack the function variable value before use
Y=4 NOW
.,B418 B1 47    LDA ($47),Y DEFSTF: LDADY   VARPNT
FN-Variablenwert holen
get byte from variable
SAVE OLD VALUE OF ARGUMENT VARIABLE
.,B41A 48       PHA         PHA                     ;PUSH IT ALL ON STACK.
und auf Stapel retten
stack it
ON STACK, IN CASE ALSO USED AS
.,B41B 88       DEY         DEY                     ;SINCE WE ARE RECURSING MAYBE.
Zeiger vermindern
decrement index
A NORMAL VARIABLE!
.,B41C 10 FA    BPL $B418         BPL     DEFSTF
fertig? nein: nächster Wert
loop until variable stacked

.,B41E A4 48    LDY $48         LDY     VARPNT+1

nt variable pointer high byte
(Y,X)= ADDRESS, STORE FAC IN VARIABLE
.,B420 20 D4 BB JSR $BBD4         JSR     MOVMF           ;PUT CURRENT FAC INTO OUR ARG VARIABLE.
FAC in FN-Variable übertragen
pack FAC1 into (XY)

.,B423 A5 7B    LDA $7B         PSHWD   TXTPTR          ;SAVE TEXT POINTER.
Programmzeiger (LOW)
get BASIC execute pointer high byte
REMEMBER TXTPTR AFTER FN CALL
.,B425 48       PHA
auf Stapel
push it

.,B426 A5 7A    LDA $7A
Programmzeiger (HIGH)
get BASIC execute pointer low byte

.,B428 48       PHA
auf Stapel
push it

.,B429 B1 4E    LDA ($4E),Y         LDADY   DEFPNT          ;PNTR TO FUNCTION.
LOW und HIGH-Byte
get function execute pointer low byte
Y=0 FROM MOVMF
.,B42B 85 7A    STA $7A         STA     TXTPTR
des
save BASIC execute pointer low byte
POINT TO FUNCTION DEF'N
.,B42D C8       INY         INY
Programmzeigers auf
index to high byte

.,B42E B1 4E    LDA ($4E),Y         LDADY   DEFPNT
FN-Ausdruck
get function execute pointer high byte

.,B430 85 7B    STA $7B         STA     TXTPTR+1
speichern
save BASIC execute pointer high byte

.,B432 A5 48    LDA $48         PSHWD   VARPNT          ;SAVE VARIABLE POINTER.
Zeiger auf FN-Variable
get current variable pointer high byte
SAVE ADDRESS OF ARGUMENT VARIABLE
.,B434 48       PHA
holen und
push it

.,B435 A5 47    LDA $47
auf den Stapel
get current variable pointer low byte

.,B437 48       PHA
retten
push it

.,B438 20 8A AD JSR $AD8A         JSR     FRMNUM          ;EVALUATE FORMULA AND CHECK NUMERIC.
numerischen Ausdruck holen
evaluate expression and check is numeric, else do
type mismatch
EVALUATE THE FUNCTION EXPRESSION
.,B43B 68       PLA         PULWD   DEFPNT
LOW- und HIGH-Byte
pull variable address low byte
GET ADDRESS OF ARGUMENT VARIABLE
.,B43C 85 4E    STA $4E
des Zeigers auf FN-
save variable address low byte
AND SAVE IT
.,B43E 68       PLA
Variable vom Stapel holen
pull variable address high byte

.,B43F 85 4F    STA $4F
und in FN-Zeiger speichern
save variable address high byte

.,B441 20 79 00 JSR $0079         JSR     CHRGOT
CHRGOT letztes Zeichen holen
scan memory
MUST BE AT ":" OR EOL
.,B444 F0 03    BEQ $B449         JNE     SNERR           ;IT DIDN'T TERMINATE. HUH?
keine weiteren Zeichen?
branch if null (should be [EOL] marker)
WE ARE
.,B446 4C 08 AF JMP $AF08
gibt 'SYNTAX ERROR'
else syntax error then warm start

restore BASIC execute pointer and function variable from stack

WE ARE NOT, SLYNTAX ERROR
.,B449 68       PLA         PULWD   TXTPTR          ;RESTORE TEXT PNTR.
LOW- und HIGH-Byte
pull BASIC execute pointer low byte
RETRIEVE TXTPTR AFTER "FN" CALL
.,B44A 85 7A    STA $7A
des
save BASIC execute pointer low byte

.,B44C 68       PLA
Programmzeigers
pull BASIC execute pointer high byte

.,B44D 85 7B    STA $7B
zurückholen
save BASIC execute pointer high byte
put execute pointer and variable pointer into fu