APPLESOFT.................COMMENTS BY BOB SANDER-CEDERLOF
1010 .OR $D000
1020 .TF B.FP,D2
1030 .IN S.DEFINITIONS,D1
SAVE S.DEFINITIONS
1010 *--------------------------------
1020 * ZERO PAGE LOCATIONS:
1030 *--------------------------------
00- 1040 GOWARM .EQ $00,01,02 GETS "JMP RESTART"
03- 1050 GOSTROUT .EQ $03,04,05 GETS "JMP STROUT"
0A- 1060 USR .EQ $0A,0B,0C GETS "JMP <USER ADDR>"
1070 * (INITIALLY $E199)
0D- 1080 CHARAC .EQ $0D ALTERNATE STRING TERMINATOR
0E- 1090 ENDCHR .EQ $0E STRING TERMINATOR
0F- 1100 TKN.CNTR .EQ $0F USED IN PARSE
0F- 1110 EOL.PNTR .EQ $0F USED IN NXLIN
0F- 1120 NUMDIM .EQ $0F USED IN ARRAY ROUTINES
10- 1130 DIMFLG .EQ $10
11- 1140 VALTYP .EQ $11,12 $:VALTYP=$FF; %:VALTYP+1=$80
13- 1150 DATAFLG .EQ $13 USED IN PARSE
13- 1160 GARFLG .EQ $13 USED IN GARBAG
14- 1170 SUBFLG .EQ $14
15- 1180 INPUTFLG .EQ $15 = $40 FOR GET, $98 FOR READ
16- 1190 CPRMASK .EQ $16 RECEIVES CPRTYP IN FRMEVL
16- 1200 SIGNFLG .EQ $16 FLAGS SIGN IN TAN
1A- 1210 HGR.SHAPE .EQ $1A,1B
1C- 1220 HGR.BITS .EQ $1C
1D- 1230 HGR.COUNT .EQ $1D
24- 1240 MON.CH .EQ $24
26- 1250 MON.GBASL .EQ $26
27- 1260 MON.GBASH .EQ $27
2C- 1270 MON.H2 .EQ $2C
2D- 1280 MON.V2 .EQ $2D
30- 1290 MON.HMASK .EQ $30
32- 1300 MON.INVFLG .EQ $32
33- 1310 MON.PROMPT .EQ $33
3C- 1320 MON.A1L .EQ $3C USED BY TAPE I/O ROUTINES
3D- 1330 MON.A1H .EQ $3D "
3E- 1340 MON.A2L .EQ $3E "
3F- 1350 MON.A2H .EQ $3F "
50- 1360 LINNUM .EQ $50,51 CONVERTED LINE #
52- 1370 TEMPPT .EQ $52 LAST USED TEMP STRING DESC
53- 1380 LASTPT .EQ $53,54 LAST USED TEMP STRING PNTR
55- 1390 TEMPST .EQ $55 - 5D HOLDS UP TO 3 DESCRIPTORS
5E- 1400 INDEX .EQ $5E,5F
60- 1410 DEST .EQ $60,61
62- 1420 RESULT .EQ $62 - 66 RESULT OF LAST * OR /
67- 1430 TXTTAB .EQ $67,68 START OF PROGRAM TEXT
69- 1440 VARTAB .EQ $69,6A START OF VARIABLE STORAGE
6B- 1450 ARYTAB .EQ $6B,6C START OF ARRAY STORAGE
6D- 1460 STREND .EQ $6D,6E END OF ARRAY STORAGE
6F- 1470 FRETOP .EQ $6F,70 START OF STRING STORAGE
71- 1480 FRESPC .EQ $71,72 TEMP PNTR, STRING ROUTINES
73- 1490 MEMSIZ .EQ $73,74 END OF STRING SPACE (HIMEM)
75- 1500 CURLIN .EQ $75,76 CURRENT LINE NUMBER
1510 * ( = $FFXX IF IN DIRECT MODE)
77- 1520 OLDLIN .EQ $77,78 ADDR. OF LAST LINE EXECUTED
79- 1530 OLDTEXT .EQ $79,7A
7B- 1540 DATLIN .EQ $7B,7C LINE # OF CURRENT DATA STT.
7D- 1550 DATPTR .EQ $7D,7E ADDR OF CURRENT DATA STT.
7F- 1560 INPTR .EQ $7F,80
81- 1570 VARNAM .EQ $81,82 NAME OF VARIABLE
83- 1580 VARPNT .EQ $83,84 ADDR OF VARIABLE
85- 1590 FORPNT .EQ $85,86
87- 1600 TXPSV .EQ $87,88 USED IN INPUT
87- 1610 LASTOP .EQ $87 SCRATCH FLAG USED IN FRMEVL
89- 1620 CPRTYP .EQ $89 >,=,< FLAG IN FRMEVL
8A- 1630 TEMP3 .EQ $8A - 8E
8A- 1640 FNCNAM .EQ $8A
8C- 1650 DSCPTR .EQ $8C
8F- 1660 DSCLEN .EQ $8F USED IN GARBAG
90- 1670 JMPADRS .EQ $90,91,92 GETS "JMP ...."
91- 1680 LENGTH .EQ $91 USED IN GARBAG
92- 1690 ARG.EXTENSION .EQ $92 FP EXTRA PRECISION
93- 1700 TEMP1 .EQ $93 - 97 SAVE AREAS FOR FAC
94- 1710 ARYPNT .EQ $94 USED IN GARBAG
94- 1720 HIGHDS .EQ $94,95 PNTR FOR BLTU
96- 1730 HIGHTR .EQ $96,97 PNTR FOR BLTU
98- 1740 TEMP2 .EQ $98 - 9C
99- 1750 TMPEXP .EQ $99 USED IN FIN (EVAL)
99- 1760 INDX .EQ $99 USED BY ARRAY RTNS
9A- 1770 EXPON .EQ $9A "
9B- 1780 DPFLG .EQ $9B FLAGS DEC PNT IN FIN
9B- 1790 LOWTR .EQ $9B,9C
9C- 1800 EXPSGN .EQ $9C
9D- 1810 FAC .EQ $9D - A1 MAIN FLT PT ACCUMULATOR
9D- 1820 DSCTMP .EQ $9D,9E,9F
A0- 1830 VPNT .EQ $A0,A1 TEMP VAR PTR
A2- 1840 FAC.SIGN .EQ $A2 HOLDS UNPACKED SIGN
A3- 1850 SERLEN .EQ $A3 HOLDS LENGTH OF SERIES-1
A4- 1860 SHIFT.SIGN.EXT .EQ $A4 SIGN EXTENSION, RIGHT SHIFTS
A5- 1870 ARG .EQ $A5 - A9 SECONDARY FP ACC
AA- 1880 ARG.SIGN .EQ $AA
AB- 1890 SGNCPR .EQ $AB FLAGS OPP SIGN IN FP ROUT.
AC- 1900 FAC.EXTENSION .EQ $AC FAC EXTENSION BYTE
AD- 1910 SERPNT .EQ $AD PNTR TO SERIES DATA IN FP
AB- 1920 STRNG1 .EQ $AB,AC
AD- 1930 STRNG2 .EQ $AD,AE
AF- 1940 PRGEND .EQ $AF,B0
B1- 1950 CHRGET .EQ $B1 - C8
B7- 1960 CHRGOT .EQ $B7
B8- 1970 TXTPTR .EQ $B8,B9
C9- 1980 RNDSEED .EQ $C9 - CD
D0- 1990 HGR.DX .EQ $D0,D1
D2- 2000 HGR.DY .EQ $D2
D3- 2010 HGR.QUADRANT .EQ $D3
D4- 2020 HGR.E .EQ $D4,D5
D6- 2030 LOCK .EQ $D6 NO USER ACCESS IF > 127
D8- 2040 ERRFLG .EQ $D8 $80 IF ON ERR ACTIVE
DA- 2050 ERRLIN .EQ $DA,DB LINE # WHERE ERROR OCCURRED
DC- 2060 ERRPOS .EQ $DC,DD TXTPTR SAVE FOR HANDLERR
DE- 2070 ERRNUM .EQ $DE WHICH ERROR OCCURRED
DF- 2080 ERRSTK .EQ $DF STACK PNTR BEFORE ERROR
E0- 2090 HGR.X .EQ $E0,E1
E2- 2100 HGR.Y .EQ $E2
E4- 2110 HGR.COLOR .EQ $E4
E5- 2120 HGR.HORIZ .EQ $E5 BYTE INDEX FROM GBASH,L
E6- 2130 HGR.PAGE .EQ $E6 HGR=$20, HGR2=$40
E7- 2140 HGR.SCALE .EQ $E7
E8- 2150 HGR.SHAPE.PNTR .EQ $E8,E9
EA- 2160 HGR.COLLISIONS .EQ $EA
F0- 2170 FIRST .EQ $F0
F1- 2180 SPEEDZ .EQ $F1 OUTPUT SPEED
F2- 2190 TRCFLG .EQ $F2
F3- 2200 FLASH.BIT .EQ $F3 = $40 FOR FLASH, ELSE =$00
F4- 2210 TXTPSV .EQ $F4,F5
F6- 2220 CURLSV .EQ $F6,F7
F8- 2230 REMSTK .EQ $F8 STACK PNTR BEFORE EACH STT.
F9- 2240 HGR.ROTATION .EQ $F9
2250 * $FF IS ALSO USED BY THE STRING OUT ROUTINES
2260 *--------------------------------
0100- 2270 STACK .EQ $100
0200- 2280 INPUT.BUFFER .EQ $200
03F5- 2290 AMPERSAND.VECTOR .EQ $3F5 - 3F7 GETS "JMP ...."
2300 *--------------------------------
2310 * I/O & SOFT SWITCHES
2320 *--------------------------------
C000- 2330 KEYBOARD .EQ $C000
C050- 2340 SW.TXTCLR .EQ $C050
C052- 2350 SW.MIXCLR .EQ $C052
C053- 2360 SW.MIXSET .EQ $C053
C054- 2370 SW.LOWSCR .EQ $C054
C055- 2380 SW.HISCR .EQ $C055
C056- 2390 SW.LORES .EQ $C056
C057- 2400 SW.HIRES .EQ $C057
2410 *--------------------------------
2420 * MONITOR SUBROUTINES
2430 *--------------------------------
F800- 2440 MON.PLOT .EQ $F800
F819- 2450 MON.HLINE .EQ $F819
F828- 2460 MON.VLINE .EQ $F828
F864- 2470 MON.SETCOL .EQ $F864
F871- 2480 MON.SCRN .EQ $F871
FB1E- 2490 MON.PREAD .EQ $FB1E
FB39- 2500 MON.SETTXT .EQ $FB39
FB40- 2510 MON.SETGR .EQ $FB40
FB5B- 2520 MON.TABV .EQ $FB5B
FC58- 2530 MON.HOME .EQ $FC58
FCA8- 2540 MON.WAIT .EQ $FCA8
FCFA- 2550 MON.RD2BIT .EQ $FCFA
FD0C- 2560 MON.RDKEY .EQ $FD0C
FD6A- 2570 MON.GETLN .EQ $FD6A
FDED- 2580 MON.COUT .EQ $FDED
FE8B- 2590 MON.INPORT .EQ $FE8B
FE95- 2600 MON.OUTPORT .EQ $FE95
FECD- 2610 MON.WRITE .EQ $FECD
FEFD- 2620 MON.READ .EQ $FEFD
FF02- 2630 MON.READ2 .EQ $FF02
2640 *--------------------------------
1050 .IN S.D000,D1
SAVE S.TOKENS
1010 *--------------------------------
1020 * APPLESOFT TOKENS
1030 *--------------------------------
81- 1040 TOKEN.FOR .EQ $81
83- 1050 TOKEN.DATA .EQ $83
A1- 1060 TOKEN.POP .EQ $A1
AB- 1070 TOKEN.GOTO .EQ $AB
B0- 1080 TOKEN.GOSUB .EQ $B0
B2- 1090 TOKEN.REM .EQ $B2
BA- 1100 TOKEN.PRINT .EQ $BA
C0- 1110 TOKEN.TAB .EQ $C0
C1- 1120 TOKEN.TO .EQ $C1
C2- 1130 TOKEN.FN .EQ $C2
C3- 1140 TOKEN.SPC .EQ $C3
C4- 1150 TOKEN.THEN .EQ $C4
C5- 1160 TOKEN.AT .EQ $C5
C6- 1170 TOKEN.NOT .EQ $C6
C7- 1180 TOKEN.STEP .EQ $C7
C8- 1190 TOKEN.PLUS .EQ $C8
C9- 1200 TOKEN.MINUS .EQ $C9
CF- 1210 TOKEN.GREATER .EQ $CF
D0- 1220 TOKEN.EQUAL .EQ $D0
D2- 1230 TOKEN.SGN .EQ $D2
D7- 1240 TOKEN.SCRN .EQ $D7
E8- 1250 TOKEN.LEFTSTR .EQ $E8
1260 *--------------------------------
1270 * BRANCH TABLE FOR TOKENS
1280 *--------------------------------
1290 TOKEN.ADDRESS.TABLE
D000- 6F D8 1300 .DA END-1 $80...128...END
D002- 65 D7 1310 .DA FOR-1 $81...129...FOR
D004- F8 DC 1320 .DA NEXT-1 $82...130...NEXT
D006- 94 D9 1330 .DA DATA-1 $83...131...DATA
D008- B1 DB 1340 .DA INPUT-1 $84...132...INPUT
D00A- 30 F3 1350 .DA DEL-1 $85...133...DEL
D00C- D8 DF 1360 .DA DIM-1 $86...134...DIM
D00E- E1 DB 1370 .DA READ-1 $87...135...READ
D010- 8F F3 1380 .DA GR-1 $88...136...GR
D012- 98 F3 1390 .DA TEXT-1 $89...137...TEXT
D014- E4 F1 1400 .DA PR.NUMBER-1 $8A...138...PR#
D016- DD F1 1410 .DA IN.NUMBER-1 $8B...139...IN#
D018- D4 F1 1420 .DA CALL-1 $8C...140...CALL
D01A- 24 F2 1430 .DA PLOT-1 $8D...141...PLOT
D01C- 31 F2 1440 .DA HLIN-1 $8E...142...HLIN
D01E- 40 F2 1450 .DA VLIN-1 $8F...143...VLIN
D020- D7 F3 1460 .DA HGR2-1 $90...144...HGR2
D022- E1 F3 1470 .DA HGR-1 $91...145...HGR
D024- E8 F6 1480 .DA HCOLOR-1 $92...146...HCOLOR=
D026- FD F6 1490 .DA HPLOT-1 $93...147...HPLOT
D028- 68 F7 1500 .DA DRAW-1 $94...148...DRAW
D02A- 6E F7 1510 .DA XDRAW-1 $95...149...XDRAW
D02C- E6 F7 1520 .DA HTAB-1 $96...150...HTAB
D02E- 57 FC 1530 .DA MON.HOME-1 $97...151...HOME
D030- 20 F7 1540 .DA ROT-1 $98...152...ROT=
D032- 26 F7 1550 .DA SCALE-1 $99...153...SCALE=
D034- 74 F7 1560 .DA SHLOAD-1 $9A...154...SHLOAD
D036- 6C F2 1570 .DA TRACE-1 $9B...155...TRACE
D038- 6E F2 1580 .DA NOTRACE-1 $9C...156...NOTRACE
D03A- 72 F2 1590 .DA NORMAL-1 $9D...157...NORMAL
D03C- 76 F2 1600 .DA INVERSE-1 $9E...158...INVERSE
D03E- 7F F2 1610 .DA FLASH-1 $9F...159...FLASH
D040- 4E F2 1620 .DA COLOR-1 $A0...160...COLOR=
D042- 6A D9 1630 .DA POP-1 $A1...161...POP
D044- 55 F2 1640 .DA VTAB-1 $A2...162...VTAB
D046- 85 F2 1650 .DA HIMEM-1 $A3...163...HIMEM:
D048- A5 F2 1660 .DA LOMEM-1 $A4...164...LOMEM:
D04A- CA F2 1670 .DA ONERR-1 $A5...165...ONERR
D04C- 17 F3 1680 .DA RESUME-1 $A6...166...RESUME
D04E- BB F3 1690 .DA RECALL-1 $A7...167...RECALL
D050- 9E F3 1700 .DA STORE-1 $A8...168...STORE
D052- 61 F2 1710 .DA SPEED-1 $A9...169...SPEED=
D054- 45 DA 1720 .DA LET-1 $AA...170...LET
D056- 3D D9 1730 .DA GOTO-1 $AB...171...GOTO
D058- 11 D9 1740 .DA RUN-1 $AC...172...RUN
D05A- C8 D9 1750 .DA IF-1 $AD...173...IF
D05C- 48 D8 1760 .DA RESTORE-1 $AE...174...RESTORE
D05E- F4 03 1770 .DA AMPERSAND.VECTOR-1 $AF...175...&
D060- 20 D9 1780 .DA GOSUB-1 $B0...176...GOSUB
D062- 6A D9 1790 .DA POP-1 $B1...177...RETURN
D064- DB D9 1800 .DA REM-1 $B2...178...REM
D066- 6D D8 1810 .DA STOP-1 $B3...179...STOP
D068- EB D9 1820 .DA ONGOTO-1 $B4...180...ON
D06A- 83 E7 1830 .DA WAIT-1 $B5...181...WAIT
D06C- C8 D8 1840 .DA LOAD-1 $B6...182...LOAD
D06E- AF D8 1850 .DA SAVE-1 $B7...183...SAVE
D070- 12 E3 1860 .DA DEF-1 $B8...184...DEF
D072- 7A E7 1870 .DA POKE-1 $B9...185...POKE
D074- D4 DA 1880 .DA PRINT-1 $BA...186...PRINT
D076- 95 D8 1890 .DA CONT-1 $BB...187...CONT
D078- A4 D6 1900 .DA LIST-1 $BC...188...LIST
D07A- 69 D6 1910 .DA CLEAR-1 $BD...189...CLEAR
D07C- 9F DB 1920 .DA GET-1 $BE...190...GET
D07E- 48 D6 1930 .DA NEW-1 $BF...191...NEW
1940 *--------------------------------
1950 UNFNC
D080- 90 EB 1960 .DA SGN $D2...210...SGN
D082- 23 EC 1970 .DA INT $D3...211...INT
D084- AF EB 1980 .DA ABS $D4...212...ABS
D086- 0A 00 1990 .DA USR $D5...213...USR
D088- DE E2 2000 .DA FRE $D6...214...FRE
D08A- 12 D4 2010 .DA ERROR $D7...215...SCRN(
D08C- CD DF 2020 .DA PDL $D8...216...PDL
D08E- FF E2 2030 .DA POS $D9...217...POS
D090- 8D EE 2040 .DA SQR $DA...218...SQR
D092- AE EF 2050 .DA RND $DB...219...RND
D094- 41 E9 2060 .DA LOG $DC...220...LOG
D096- 09 EF 2070 .DA EXP $DD...221...EXP
D098- EA EF 2080 .DA COS $DE...222...COS
D09A- F1 EF 2090 .DA SIN $DF...223...SIN
D09C- 3A F0 2100 .DA TAN $E0...224...TAN
D09E- 9E F0 2110 .DA ATN $E1...225...ATN
D0A0- 64 E7 2120 .DA PEEK $E2...226...PEEK
D0A2- D6 E6 2130 .DA LEN $E3...227...LEN
D0A4- C5 E3 2140 .DA STR $E4...228...STR$
D0A6- 07 E7 2150 .DA VAL $E5...229...VAL
D0A8- E5 E6 2160 .DA ASC $E6...230...ASC
D0AA- 46 E6 2170 .DA CHRSTR $E7...231...CHR$
D0AC- 5A E6 2180 .DA LEFTSTR $E8...232...LEFT$
D0AE- 86 E6 2190 .DA RIGHTSTR $E9...233...RIGHT$
D0B0- 91 E6 2200 .DA MIDSTR $EA...234...MID$
2210 *--------------------------------
2220 * MATH OPERATOR BRANCH TABLE
2230 *
2240 * ONE-BYTE PRECEDENCE CODE
2250 * TWO-BYTE ADDRESS
2260 *--------------------------------
46- 2270 P.OR .EQ $46 "OR" IS LOWEST PRECEDENCE
50- 2280 P.AND .EQ $50
64- 2290 P.REL .EQ $64 RELATIONAL OPERATORS
79- 2300 P.ADD .EQ $79 BINARY + AND -
7B- 2310 P.MUL .EQ $7B * AND /
7D- 2320 P.PWR .EQ $7D EXPONENTIATION
7F- 2330 P.NEQ .EQ $7F UNARY - AND COMPARISON =
2340 *--------------------------------
2350 MATHTBL
D0B2- 79 C0 E7 2360 .DA #P.ADD,FADDT-1 $C8...200...+
D0B5- 79 A9 E7 2370 .DA #P.ADD,FSUBT-1 $C9...201...-
D0B8- 7B 81 E9 2380 .DA #P.MUL,FMULTT-1 $CA...202...*
D0BB- 7B 68 EA 2390 .DA #P.MUL,FDIVT-1 $CB...203.../
D0BE- 7D 96 EE 2400 .DA #P.PWR,FPWRT-1 $CC...204...^
D0C1- 50 54 DF 2410 .DA #P.AND,AND-1 $CD...205...AND
D0C4- 46 4E DF 2420 .DA #P.OR,OR-1 $CE...206...OR
D0C7- 7F CF EE 2430 M.NEG .DA #P.NEQ,NEGOP-1 $CF...207...>
D0CA- 7F 97 DE 2440 M.EQU .DA #P.NEQ,EQUOP-1 $D0...208...=
D0CD- 64 64 DF 2450 M.REL .DA #P.REL,RELOPS-1 $D1...209...<
2460 *--------------------------------
2470 * TOKEN NAME TABLE
2480 *--------------------------------
2490 TOKEN.NAME.TABLE
D0D0- 45 4E C4 2500 .AT "END" $80...128
D0D3- 46 4F D2 2510 .AT "FOR" $81...129
D0D6- 4E 45 58
D0D9- D4 2520 .AT "NEXT" $82...130
D0DA- 44 41 54
D0DD- C1 2530 .AT "DATA" $83...131
D0DE- 49 4E 50
D0E1- 55 D4 2540 .AT "INPUT" $84...132
D0E3- 44 45 CC 2550 .AT "DEL" $85...133
D0E6- 44 49 CD 2560 .AT "DIM" $86...134
D0E9- 52 45 41
D0EC- C4 2570 .AT "READ" $87...135
D0ED- 47 D2 2580 .AT "GR" $88...136
D0EF- 54 45 58
D0F2- D4 2590 .AT "TEXT" $89...137
D0F3- 50 52 A3 2600 .AT "PR#" $8A...138
D0F6- 49 4E A3 2610 .AT "IN#" $8B...139
D0F9- 43 41 4C
D0FC- CC 2620 .AT "CALL" $8C...140
D0FD- 50 4C 4F
D100- D4 2630 .AT "PLOT" $8D...141
D101- 48 4C 49
D104- CE 2640 .AT "HLIN" $8E...142
D105- 56 4C 49
D108- CE 2650 .AT "VLIN" $8F...143
D109- 48 47 52
D10C- B2 2660 .AT "HGR2" $90...144
D10D- 48 47 D2 2670 .AT "HGR" $91...145
D110- 48 43 4F
D113- 4C 4F 52
D116- BD 2680 .AT "HCOLOR=" $92...146
D117- 48 50 4C
D11A- 4F D4 2690 .AT "HPLOT" $93...147
D11C- 44 52 41
D11F- D7 2700 .AT "DRAW" $94...148
D120- 58 44 52
D123- 41 D7 2710 .AT "XDRAW" $95...149
D125- 48 54 41
D128- C2 2720 .AT "HTAB" $96...150
D129- 48 4F 4D
D12C- C5 2730 .AT "HOME" $97...151
D12D- 52 4F 54
D130- BD 2740 .AT "ROT=" $98...152
D131- 53 43 41
D134- 4C 45 BD 2750 .AT "SCALE=" $99...153
D137- 53 48 4C
D13A- 4F 41 C4 2760 .AT "SHLOAD" $9A...154
D13D- 54 52 41
D140- 43 C5 2770 .AT "TRACE" $9B...155
D142- 4E 4F 54
D145- 52 41 43
D148- C5 2780 .AT "NOTRACE" $9C...156
D149- 4E 4F 52
D14C- 4D 41 CC 2790 .AT "NORMAL" $9D...157
D14F- 49 4E 56
D152- 45 52 53
D155- C5 2800 .AT "INVERSE" $9E...158
D156- 46 4C 41
D159- 53 C8 2810 .AT "FLASH" $9F...159
D15B- 43 4F 4C
D15E- 4F 52 BD 2820 .AT "COLOR=" $A0...160
D161- 50 4F D0 2830 .AT "POP" $A1...161
D164- 56 54 41
D167- C2 2840 .AT "VTAB" $A2...162
D168- 48 49 4D
D16B- 45 4D BA 2850 .AT "HIMEM:" $A3...163
D16E- 4C 4F 4D
D171- 45 4D BA 2860 .AT "LOMEM:" $A4...164
D174- 4F 4E 45
D177- 52 D2 2870 .AT "ONERR" $A5...165
D179- 52 45 53
D17C- 55 4D C5 2880 .AT "RESUME" $A6...166
D17F- 52 45 43
D182- 41 4C CC 2890 .AT "RECALL" $A7...167
D185- 53 54 4F
D188- 52 C5 2900 .AT "STORE" $A8...168
D18A- 53 50 45
D18D- 45 44 BD 2910 .AT "SPEED=" $A9...169
D190- 4C 45 D4 2920 .AT "LET" $AA...170
D193- 47 4F 54
D196- CF 2930 .AT "GOTO" $AB...171
D197- 52 55 CE 2940 .AT "RUN" $AC...172
D19A- 49 C6 2950 .AT "IF" $AD...173
D19C- 52 45 53
D19F- 54 4F 52
D1A2- C5 2960 .AT "RESTORE" $AE...174
D1A3- A6 2970 .AT "&" $AF...175
D1A4- 47 4F 53
D1A7- 55 C2 2980 .AT "GOSUB" $B0...176
D1A9- 52 45 54
D1AC- 55 52 CE 2990 .AT "RETURN" $B1...177
D1AF- 52 45 CD 3000 .AT "REM" $B2...178
D1B2- 53 54 4F
D1B5- D0 3010 .AT "STOP" $B3...179
D1B6- 4F CE 3020 .AT "ON" $B4...180
D1B8- 57 41 49
D1BB- D4 3030 .AT "WAIT" $B5...181
D1BC- 4C 4F 41
D1BF- C4 3040 .AT "LOAD" $B6...182
D1C0- 53 41 56
D1C3- C5 3050 .AT "SAVE" $B7...183
D1C4- 44 45 C6 3060 .AT "DEF" $B8...184
D1C7- 50 4F 4B
D1CA- C5 3070 .AT "POKE" $B9...185
D1CB- 50 52 49
D1CE- 4E D4 3080 .AT "PRINT" $BA...186
D1D0- 43 4F 4E
D1D3- D4 3090 .AT "CONT" $BB...187
D1D4- 4C 49 53
D1D7- D4 3100 .AT "LIST" $BC...188
D1D8- 43 4C 45
D1DB- 41 D2 3110 .AT "CLEAR" $BD...189
D1DD- 47 45 D4 3120 .AT "GET" $BE...190
D1E0- 4E 45 D7 3130 .AT "NEW" $BF...191
D1E3- 54 41 42
D1E6- A8 3140 .AT "TAB(" $C0...192
D1E7- 54 CF 3150 .AT "TO" $C1...193
D1E9- 46 CE 3160 .AT "FN" $C2...194
D1EB- 53 50 43
D1EE- A8 3170 .AT "SPC(" $C3...195
D1EF- 54 48 45
D1F2- CE 3180 .AT "THEN" $C4...196
D1F3- 41 D4 3190 .AT "AT" $C5...197
D1F5- 4E 4F D4 3200 .AT "NOT" $C6...198
D1F8- 53 54 45
D1FB- D0 3210 .AT "STEP" $C7...199
D1FC- AB 3220 .AT "+" $C8...200
D1FD- AD 3230 .AT "-" $C9...201
D1FE- AA 3240 .AT "*" $CA...202
D1FF- AF 3250 .AT "/" $CB...203
D200- DE 3260 .AT "^" $CC...204
D201- 41 4E C4 3270 .AT "AND" $CD...205
D204- 4F D2 3280 .AT "OR" $CE...206
D206- BE 3290 .AT ">" $CF...207
D207- BD 3300 .AT "=" $D0...208
D208- BC 3310 .AT "<" $D1...209
D209- 53 47 CE 3320 .AT "SGN" $D2...210
D20C- 49 4E D4 3330 .AT "INT" $D3...211
D20F- 41 42 D3 3340 .AT "ABS" $D4...212
D212- 55 53 D2 3350 .AT "USR" $D5...213
D215- 46 52 C5 3360 .AT "FRE" $D6...214
D218- 53 43 52
D21B- 4E A8 3370 .AT "SCRN(" $D7...215
D21D- 50 44 CC 3380 .AT "PDL" $D8...216
D220- 50 4F D3 3390 .AT "POS" $D9...217
D223- 53 51 D2 3400 .AT "SQR" $DA...218
D226- 52 4E C4 3410 .AT "RND" $DB...219
D229- 4C 4F C7 3420 .AT "LOG" $DC...220
D22C- 45 58 D0 3430 .AT "EXP" $DD...221
D22F- 43 4F D3 3440 .AT "COS" $DE...222
D232- 53 49 CE 3450 .AT "SIN" $DF...223
D235- 54 41 CE 3460 .AT "TAN" $E0...224
D238- 41 54 CE 3470 .AT "ATN" $E1...225
D23B- 50 45 45
D23E- CB 3480 .AT "PEEK" $E2...226
D23F- 4C 45 CE 3490 .AT "LEN" $E3...227
D242- 53 54 52
D245- A4 3500 .AT "STR$" $E4...228
D246- 56 41 CC 3510 .AT "VAL" $E5...229
D249- 41 53 C3 3520 .AT "ASC" $E6...230
D24C- 43 48 52
D24F- A4 3530 .AT "CHR$" $E7...231
D250- 4C 45 46
D253- 54 A4 3540 .AT "LEFT$" $E8...232
D255- 52 49 47
D258- 48 54 A4 3550 .AT "RIGHT$" $E9...233
D25B- 4D 49 44
D25E- A4 3560 .AT "MID$" $EA...234
D25F- 00 3570 .HS 00 END OF TOKEN NAME TABLE
3580 *--------------------------------
1070 .IN S.D260,D1
SAVE S.D260
1010 *--------------------------------
1020 * ERROR MESSAGES
1030 *--------------------------------
1040 ERROR.MESSAGES
00- 1050 ERR.NOFOR .EQ *-ERROR.MESSAGES
D260- 4E 45 58
D263- 54 20 57
D266- 49 54 48
D269- 4F 55 54
D26C- 20 46 4F
D26F- D2 1060 .AT /NEXT WITHOUT FOR/
10- 1070 ERR.SYNTAX .EQ *-ERROR.MESSAGES
D270- 53 59 4E
D273- 54 41 D8 1080 .AT /SYNTAX/
16- 1090 ERR.NOGOSUB .EQ *-ERROR.MESSAGES
D276- 52 45 54
D279- 55 52 4E
D27C- 20 57 49
D27F- 54 48 4F
D282- 55 54 20
D285- 47 4F 53
D288- 55 C2 1100 .AT /RETURN WITHOUT GOSUB/
2A- 1110 ERR.NODATA .EQ *-ERROR.MESSAGES
D28A- 4F 55 54
D28D- 20 4F 46
D290- 20 44 41
D293- 54 C1 1120 .AT /OUT OF DATA/
35- 1130 ERR.ILLQTY .EQ *-ERROR.MESSAGES
D295- 49 4C 4C
D298- 45 47 41
D29B- 4C 20 51
D29E- 55 41 4E
D2A1- 54 49 54
D2A4- D9 1140 .AT /ILLEGAL QUANTITY/
45- 1150 ERR.OVERFLOW .EQ *-ERROR.MESSAGES
D2A5- 4F 56 45
D2A8- 52 46 4C
D2AB- 4F D7 1160 .AT /OVERFLOW/
4D- 1170 ERR.MEMFULL .EQ *-ERROR.MESSAGES
D2AD- 4F 55 54
D2B0- 20 4F 46
D2B3- 20 4D 45
D2B6- 4D 4F 52
D2B9- D9 1180 .AT /OUT OF MEMORY/
5A- 1190 ERR.UNDEFSTAT .EQ *-ERROR.MESSAGES
D2BA- 55 4E 44
D2BD- 45 46 27
D2C0- 44 20 53
D2C3- 54 41 54
D2C6- 45 4D 45
D2C9- 4E D4 1200 .AT /UNDEF'D STATEMENT/
6B- 1210 ERR.BADSUBS .EQ *-ERROR.MESSAGES
D2CB- 42 41 44
D2CE- 20 53 55
D2D1- 42 53 43
D2D4- 52 49 50
D2D7- D4 1220 .AT /BAD SUBSCRIPT/
78- 1230 ERR.REDIMD .EQ *-ERROR.MESSAGES
D2D8- 52 45 44
D2DB- 49 4D 27
D2DE- 44 20 41
D2E1- 52 52 41
D2E4- D9 1240 .AT /REDIM'D ARRAY/
85- 1250 ERR.ZERODIV .EQ *-ERROR.MESSAGES
D2E5- 44 49 56
D2E8- 49 53 49
D2EB- 4F 4E 20
D2EE- 42 59 20
D2F1- 5A 45 52
D2F4- CF 1260 .AT /DIVISION BY ZERO/
95- 1270 ERR.ILLDIR .EQ *-ERROR.MESSAGES
D2F5- 49 4C 4C
D2F8- 45 47 41
D2FB- 4C 20 44
D2FE- 49 52 45
D301- 43 D4 1280 .AT /ILLEGAL DIRECT/
A3- 1290 ERR.BADTYPE .EQ *-ERROR.MESSAGES
D303- 54 59 50
D306- 45 20 4D
D309- 49 53 4D
D30C- 41 54 43
D30F- C8 1300 .AT /TYPE MISMATCH/
B0- 1310 ERR.STRLONG .EQ *-ERROR.MESSAGES
D310- 53 54 52
D313- 49 4E 47
D316- 20 54 4F
D319- 4F 20 4C
D31C- 4F 4E C7 1320 .AT /STRING TOO LONG/
BF- 1330 ERR.FRMCPX .EQ *-ERROR.MESSAGES
D31F- 46 4F 52
D322- 4D 55 4C
D325- 41 20 54
D328- 4F 4F 20
D32B- 43 4F 4D
D32E- 50 4C 45
D331- D8 1340 .AT /FORMULA TOO COMPLEX/
D2- 1350 ERR.CANTCONT .EQ *-ERROR.MESSAGES
D332- 43 41 4E
D335- 27 54 20
D338- 43 4F 4E
D33B- 54 49 4E
D33E- 55 C5 1360 .AT /CAN'T CONTINUE/
E0- 1370 ERR.UNDEFFUNC .EQ *-ERROR.MESSAGES
D340- 55 4E 44
D343- 45 46 27
D346- 44 20 46
D349- 55 4E 43
D34C- 54 49 4F
D34F- CE 1380 .AT /UNDEF'D FUNCTION/
1390 *--------------------------------
D350- 20 45 52
D353- 52 4F 52 1400 QT.ERROR .AS / ERROR/
D356- 07 00 1410 .HS 0700 BELL
D358- 20 49 4E
D35B- 20 1420 QT.IN .AS / IN /
D35C- 00 1430 .HS 00
D35D- 0D 1440 QT.BREAK .HS 0D
D35E- 42 52 45
D361- 41 4B 1450 .AS /BREAK/
D363- 07 00 1460 .HS 0700 BELL
1090 .IN S.D365,D1
SAVE S.D365
1010 *--------------------------------
1020 * CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
1030 * THE STACK FOR A FRAME WITH THE SAME VARIABLE.
1040 *
1050 * (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
1060 * = $XXFF IF CALLED FROM "RETURN"
1070 * <<< BUG: SHOULD BE $FFXX >>>
1080 *
1090 * RETURNS .NE. IF VARIABLE NOT FOUND,
1100 * (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
1110 *
1120 * .EQ. IF FOUND
1130 * (X) = STACK PNTR OF FRAME FOUND
1140 *--------------------------------
1150 GTFORPNT
D365- BA 1160 TSX
D366- E8 1170 INX
D367- E8 1180 INX
D368- E8 1190 INX
D369- E8 1200 INX
D36A- BD 01 01 1210 .1 LDA STACK+1,X "FOR" FRAME HERE?
D36D- C9 81 1220 CMP #TOKEN.FOR
D36F- D0 21 1230 BNE .4 NO
D371- A5 86 1240 LDA FORPNT+1 YES -- "NEXT" WITH NO VARIABLE?
D373- D0 0A 1250 BNE .2 NO, VARIABLE SPECIFIED
D375- BD 02 01 1260 LDA STACK+2,X YES, SO USE THIS FRAME
D378- 85 85 1270 STA FORPNT
D37A- BD 03 01 1280 LDA STACK+3,X
D37D- 85 86 1290 STA FORPNT+1
D37F- DD 03 01 1300 .2 CMP STACK+3,X IS VARIABLE IN THIS FRAME?
D382- D0 07 1310 BNE .3 NO
D384- A5 85 1320 LDA FORPNT LOOK AT 2ND BYTE TOO
D386- DD 02 01 1330 CMP STACK+2,X SAME VARIABLE?
D389- F0 07 1340 BEQ .4 YES
D38B- 8A 1350 .3 TXA NO, SO TRY NEXT FRAME (IF ANY)
D38C- 18 1360 CLC 18 BYTES PER FRAME
D38D- 69 12 1370 ADC #18
D38F- AA 1380 TAX
D390- D0 D8 1390 BNE .1 ...ALWAYS?
D392- 60 1400 .4 RTS
1410 *--------------------------------
1420 * MOVE BLOCK OF MEMORY UP
1430 *
1440 * ON ENTRY:
1450 * (Y,A) = (HIGHDS) = DESTINATION END+1
1460 * (LOWTR) = LOWEST ADDRESS OF SOURCE
1470 * (HIGHTR) = HIGHEST SOURCE ADDRESS+1
1480 *--------------------------------
D393- 20 E3 D3 1490 BLTU JSR REASON BE SURE (Y,A) < FRETOP
D396- 85 6D 1500 STA STREND NEW TOP OF ARRAY STORAGE
D398- 84 6E 1510 STY STREND+1
D39A- 38 1520 BLTU2 SEC
D39B- A5 96 1530 LDA HIGHTR COMPUTE # OF BYTES TO BE MOVED
D39D- E5 9B 1540 SBC LOWTR (FROM LOWTR THRU HIGHTR-1)
D39F- 85 5E 1550 STA INDEX PARTIAL PAGE AMOUNT
D3A1- A8 1560 TAY
D3A2- A5 97 1570 LDA HIGHTR+1
D3A4- E5 9C 1580 SBC LOWTR+1
D3A6- AA 1590 TAX # OF WHOLE PAGES IN X-REG
D3A7- E8 1600 INX
D3A8- 98 1610 TYA # BYTES IN PARTIAL PAGE
D3A9- F0 23 1620 BEQ .4 NO PARTIAL PAGE
D3AB- A5 96 1630 LDA HIGHTR BACK UP HIGHTR # BYTES IN PARTIAL PAGE
D3AD- 38 1640 SEC
D3AE- E5 5E 1650 SBC INDEX
D3B0- 85 96 1660 STA HIGHTR
D3B2- B0 03 1670 BCS .1
D3B4- C6 97 1680 DEC HIGHTR+1
D3B6- 38 1690 SEC
D3B7- A5 94 1700 .1 LDA HIGHDS BACK UP HIGHDS # BYTES IN PARTIAL PAGE
D3B9- E5 5E 1710 SBC INDEX
D3BB- 85 94 1720 STA HIGHDS
D3BD- B0 08 1730 BCS .3
D3BF- C6 95 1740 DEC HIGHDS+1
D3C1- 90 04 1750 BCC .3 ...ALWAYS
D3C3- B1 96 1760 .2 LDA (HIGHTR),Y MOVE THE BYTES
D3C5- 91 94 1770 STA (HIGHDS),Y
D3C7- 88 1780 .3 DEY
D3C8- D0 F9 1790 BNE .2 LOOP TO END OF THIS 256 BYTES
D3CA- B1 96 1800 LDA (HIGHTR),Y MOVE ONE MORE BYTE
D3CC- 91 94 1810 STA (HIGHDS),Y
D3CE- C6 97 1820 .4 DEC HIGHTR+1 DOWN TO NEXT BLOCK OF 256
D3D0- C6 95 1830 DEC HIGHDS+1
D3D2- CA 1840 DEX ANOTHER BLOCK OF 256 TO MOVE?
D3D3- D0 F2 1850 BNE .3 YES
D3D5- 60 1860 RTS NO, FINISHED
1870 *--------------------------------
1880 * CHECK IF ENOUGH ROOM LEFT ON STACK
1890 * FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
1900 *--------------------------------
D3D6- 0A 1910 CHKMEM ASL
D3D7- 69 36 1920 ADC #54
D3D9- B0 35 1930 BCS MEMERR ...MEM FULL ERR
D3DB- 85 5E 1940 STA INDEX
D3DD- BA 1950 TSX
D3DE- E4 5E 1960 CPX INDEX
D3E0- 90 2E 1970 BCC MEMERR ...MEM FULL ERR
D3E2- 60 1980 RTS
1990 *--------------------------------
2000 * CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
2010 * (Y,A) = ADDR ARRAYS NEED TO GROW TO
2020 *--------------------------------
D3E3- C4 70 2030 REASON CPY FRETOP+1 HIGH BYTE
D3E5- 90 28 2040 BCC .4 PLENTY OF ROOM
D3E7- D0 04 2050 BNE .1 NOT ENOUGH, TRY GARBAGE COLLECTION
D3E9- C5 6F 2060 CMP FRETOP LOW BYTE
D3EB- 90 22 2070 BCC .4 ENOUGH ROOM
2080 *--------------------------------
D3ED- 48 2090 .1 PHA SAVE (Y,A), TEMP1, AND TEMP2
D3EE- A2 09 2100 LDX #FAC-TEMP1-1
D3F0- 98 2110 TYA
D3F1- 48 2120 .2 PHA
D3F2- B5 93 2130 LDA TEMP1,X
D3F4- CA 2140 DEX
D3F5- 10 FA 2150 BPL .2
D3F7- 20 84 E4 2160 JSR GARBAG MAKE AS MUCH ROOM AS POSSIBLE
D3FA- A2 F7 2170 LDX #TEMP1-FAC+1 RESTORE TEMP1 AND TEMP2
D3FC- 68 2180 .3 PLA AND (Y,A)
D3FD- 95 9D 2190 STA FAC,X
D3FF- E8 2200 INX
D400- 30 FA 2210 BMI .3
D402- 68 2220 PLA
D403- A8 2230 TAY
D404- 68 2240 PLA DID WE FIND ENOUGH ROOM?
D405- C4 70 2250 CPY FRETOP+1 HIGH BYTE
D407- 90 06 2260 BCC .4 YES, AT LEAST A PAGE
D409- D0 05 2270 BNE MEMERR NO, MEM FULL ERR
D40B- C5 6F 2280 CMP FRETOP LOW BYTE
D40D- B0 01 2290 BCS MEMERR NO, MEM FULL ERR
D40F- 60 2300 .4 RTS YES, RETURN
2310 *--------------------------------
D410- A2 4D 2320 MEMERR LDX #ERR.MEMFULL
2330 *--------------------------------
2340 * HANDLE AN ERROR
2350 *
2360 * (X)=OFFSET IN ERROR MESSAGE TABLE
2370 * (ERRFLG) > 128 IF "ON ERR" TURNED ON
2380 * (CURLIN+1) = $FF IF IN DIRECT MODE
2390 *--------------------------------
D412- 24 D8 2400 ERROR BIT ERRFLG "ON ERR" TURNED ON?
D414- 10 03 2410 BPL .1 NO
D416- 4C E9 F2 2420 JMP HANDLERR YES
D419- 20 FB DA 2430 .1 JSR CRDO PRINT <RETURN>
D41C- 20 5A DB 2440 JSR OUTQUES PRINT "?"
D41F- BD 60 D2 2450 .2 LDA ERROR.MESSAGES,X
D422- 48 2460 PHA PRINT MESSAGE
D423- 20 5C DB 2470 JSR OUTDO
D426- E8 2480 INX
D427- 68 2490 PLA
D428- 10 F5 2500 BPL .2
D42A- 20 83 D6 2510 JSR STKINI FIX STACK, ET AL
D42D- A9 50 2520 LDA #QT.ERROR PRINT " ERROR" AND BELL
D42F- A0 D3 2530 LDY /QT.ERROR
2540 *--------------------------------
2550 * PRINT STRING AT (Y,A)
2560 * PRINT CURRENT LINE # UNLESS IN DIRECT MODE
2570 * FALL INTO WARM RESTART
2580 *--------------------------------
2590 PRINT.ERROR.LINNUM
D431- 20 3A DB 2600 JSR STROUT PRINT STRING AT (Y,A)
D434- A4 76 2610 LDY CURLIN+1 RUNNING, OR DIRECT?
D436- C8 2620 INY
D437- F0 03 2630 BEQ RESTART WAS $FF, SO DIRECT MODE
D439- 20 19 ED 2640 JSR INPRT RUNNING, SO PRINT LINE NUMBER
2650 *--------------------------------
2660 * WARM RESTART ENTRY
2670 *
2680 * COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G
2690 *--------------------------------
2700 RESTART
D43C- 20 FB DA 2710 JSR CRDO PRINT <RETURN>
D43F- A2 DD 2720 LDX #']+$80 PROMPT CHARACTER
D441- 20 2E D5 2730 JSR INLIN2 READ A LINE
D444- 86 B8 2740 STX TXTPTR SET UP CHRGET TO SCAN THE LINE
D446- 84 B9 2750 STY TXTPTR+1
D448- 46 D8 2760 LSR ERRFLG CLEAR FLAG
D44A- 20 B1 00 2770 JSR CHRGET
D44D- AA 2780 TAX
D44E- F0 EC 2790 BEQ RESTART EMPTY LINE
D450- A2 FF 2800 LDX #$FF $FF IN HI-BYTE OF CURLIN MEANS
D452- 86 76 2810 STX CURLIN+1 WE ARE IN DIRECT MODE
D454- 90 06 2820 BCC NUMBERED.LINE CHRGET SAW DIGIT, NUMBERED LINE
D456- 20 59 D5 2830 JSR PARSE.INPUT.LINE NO NUMBER, SO PARSE IT
D459- 4C 05 D8 2840 JMP TRACE. AND TRY EXECUTING IT
2850 *--------------------------------
2860 * HANDLE NUMBERED LINE
2870 *--------------------------------
2880 NUMBERED.LINE
D45C- A6 AF 2890 LDX PRGEND SQUASH VARIABLE TABLE
D45E- 86 69 2900 STX VARTAB
D460- A6 B0 2910 LDX PRGEND+1
D462- 86 6A 2920 STX VARTAB+1
D464- 20 0C DA 2930 JSR LINGET GET LINE #
D467- 20 59 D5 2940 JSR PARSE.INPUT.LINE AND PARSE THE INPUT LINE
D46A- 84 0F 2950 STY EOL.PNTR SAVE INDEX TO INPUT BUFFER
D46C- 20 1A D6 2960 JSR FNDLIN IS THIS LINE # ALREADY IN PROGRAM?
D46F- 90 44 2970 BCC PUT.NEW.LINE NO
D471- A0 01 2980 LDY #1 YES, SO DELETE IT
D473- B1 9B 2990 LDA (LOWTR),Y LOWTR POINTS AT LINE
D475- 85 5F 3000 STA INDEX+1 GET HIGH BYTE OF FORWARD PNTR
D477- A5 69 3010 LDA VARTAB
D479- 85 5E 3020 STA INDEX
D47B- A5 9C 3030 LDA LOWTR+1
D47D- 85 61 3040 STA DEST+1
D47F- A5 9B 3050 LDA LOWTR
D481- 88 3060 DEY
D482- F1 9B 3070 SBC (LOWTR),Y
D484- 18 3080 CLC
D485- 65 69 3090 ADC VARTAB
D487- 85 69 3100 STA VARTAB
D489- 85 60 3110 STA DEST
D48B- A5 6A 3120 LDA VARTAB+1
D48D- 69 FF 3130 ADC #$FF
D48F- 85 6A 3140 STA VARTAB+1
D491- E5 9C 3150 SBC LOWTR+1
D493- AA 3160 TAX
D494- 38 3170 SEC
D495- A5 9B 3180 LDA LOWTR
D497- E5 69 3190 SBC VARTAB
D499- A8 3200 TAY
D49A- B0 03 3210 BCS .1
D49C- E8 3220 INX
D49D- C6 61 3230 DEC DEST+1
D49F- 18 3240 .1 CLC
D4A0- 65 5E 3250 ADC INDEX
D4A2- 90 03 3260 BCC .2
D4A4- C6 5F 3270 DEC INDEX+1
D4A6- 18 3280 CLC
3290 *--------------------------------
D4A7- B1 5E 3300 .2 LDA (INDEX),Y MOVE HIGHER LINES OF PROGRAM
D4A9- 91 60 3310 STA (DEST),Y DOWN OVER THE DELETED LINE.
D4AB- C8 3320 INY
D4AC- D0 F9 3330 BNE .2
D4AE- E6 5F 3340 INC INDEX+1
D4B0- E6 61 3350 INC DEST+1
D4B2- CA 3360 DEX
D4B3- D0 F2 3370 BNE .2
3380 *--------------------------------
3390 PUT.NEW.LINE
D4B5- AD 00 02 3400 LDA INPUT.BUFFER ANY CHARACTERS AFTER LINE #?
D4B8- F0 38 3410 BEQ FIX.LINKS NO, SO NOTHING TO INSERT.
D4BA- A5 73 3420 LDA MEMSIZ YES, SO MAKE ROOM AND INSERT LINE
D4BC- A4 74 3430 LDY MEMSIZ+1 WIPE STRING AREA CLEAN
D4BE- 85 6F 3440 STA FRETOP
D4C0- 84 70 3450 STY FRETOP+1
D4C2- A5 69 3460 LDA VARTAB SET UP BLTU SUBROUTINE
D4C4- 85 96 3470 STA HIGHTR INSERT NEW LINE.
D4C6- 65 0F 3480 ADC EOL.PNTR
D4C8- 85 94 3490 STA HIGHDS
D4CA- A4 6A 3500 LDY VARTAB+1
D4CC- 84 97 3510 STY HIGHTR+1
D4CE- 90 01 3520 BCC .1
D4D0- C8 3530 INY
D4D1- 84 95 3540 .1 STY HIGHDS+1
D4D3- 20 93 D3 3550 JSR BLTU MAKE ROOM FOR THE LINE
D4D6- A5 50 3560 LDA LINNUM PUT LINE NUMBER IN LINE IMAGE
D4D8- A4 51 3570 LDY LINNUM+1
D4DA- 8D FE 01 3580 STA INPUT.BUFFER-2
D4DD- 8C FF 01 3590 STY INPUT.BUFFER-1
D4E0- A5 6D 3600 LDA STREND
D4E2- A4 6E 3610 LDY STREND+1
D4E4- 85 69 3620 STA VARTAB
D4E6- 84 6A 3630 STY VARTAB+1
D4E8- A4 0F 3640 LDY EOL.PNTR
3650 *---COPY LINE INTO PROGRAM-------
D4EA- B9 FB 01 3660 .2 LDA INPUT.BUFFER-5,Y
D4ED- 88 3670 DEY
D4EE- 91 9B 3680 STA (LOWTR),Y
D4F0- D0 F8 3690 BNE .2
3700 *--------------------------------
3710 * CLEAR ALL VARIABLES
3720 * RE-ESTABLISH ALL FORWARD LINKS
3730 *--------------------------------
3740 FIX.LINKS
D4F2- 20 65 D6 3750 JSR SETPTRS CLEAR ALL VARIABLES
D4F5- A5 67 3760 LDA TXTTAB POINT INDEX AT START OF PROGRAM
D4F7- A4 68 3770 LDY TXTTAB+1
D4F9- 85 5E 3780 STA INDEX
D4FB- 84 5F 3790 STY INDEX+1
D4FD- 18 3800 CLC
D4FE- A0 01 3810 .1 LDY #1 HI-BYTE OF NEXT FORWARD PNTR
D500- B1 5E 3820 LDA (INDEX),Y END OF PROGRAM YET?
D502- D0 0B 3830 BNE .2 NO, KEEP GOING
D504- A5 69 3840 LDA VARTAB YES
D506- 85 AF 3850 STA PRGEND
D508- A5 6A 3860 LDA VARTAB+1
D50A- 85 B0 3870 STA PRGEND+1
D50C- 4C 3C D4 3880 JMP RESTART
D50F- A0 04 3890 .2 LDY #4 FIND END OF THIS LINE
D511- C8 3900 .3 INY (NOTE MAXIMUM LENGTH < 256)
D512- B1 5E 3910 LDA (INDEX),Y
D514- D0 FB 3920 BNE .3
D516- C8 3930 INY COMPUTE ADDRESS OF NEXT LINE
D517- 98 3940 TYA
D518- 65 5E 3950 ADC INDEX
D51A- AA 3960 TAX
D51B- A0 00 3970 LDY #0 STORE FORWARD PNTR IN THIS LINE
D51D- 91 5E 3980 STA (INDEX),Y
D51F- A5 5F 3990 LDA INDEX+1
D521- 69 00 4000 ADC #0 (NOTE: THIS CLEARS CARRY)
D523- C8 4010 INY
D524- 91 5E 4020 STA (INDEX),Y
D526- 86 5E 4030 STX INDEX
D528- 85 5F 4040 STA INDEX+1
D52A- 90 D2 4050 BCC .1 ...ALWAYS
4060 *--------------------------------
1110 .IN S.D52C,D1
SAVE S.D52C
1010 *--------------------------------
1020 * READ A LINE, AND STRIP OFF SIGN BITS
1030 *--------------------------------
D52C- A2 80 1040 INLIN LDX #$80 NULL PROMPT
D52E- 86 33 1050 INLIN2 STX MON.PROMPT
D530- 20 6A FD 1060 JSR MON.GETLN
D533- E0 EF 1070 CPX #239 MAXIMUM LINE LENGTH
D535- 90 02 1080 BCC .1
D537- A2 EF 1090 LDX #239 TRUNCATE AT 239 CHARS
D539- A9 00 1100 .1 LDA #0 MARK END OF LINE WITH $00 BYTE
D53B- 9D 00 02 1110 STA INPUT.BUFFER,X
D53E- 8A 1120 TXA
D53F- F0 0B 1130 BEQ .3 NULL INPUT LINE
D541- BD FF 01 1140 .2 LDA INPUT.BUFFER-1,X DROP SIGN BITS
D544- 29 7F 1150 AND #$7F
D546- 9D FF 01 1160 STA INPUT.BUFFER-1,X
D549- CA 1170 DEX
D54A- D0 F5 1180 BNE .2
D54C- A9 00 1190 .3 LDA #0 (Y,X) POINTS AT BUFFER-1
D54E- A2 FF 1200 LDX #INPUT.BUFFER-1
D550- A0 01 1210 LDY /INPUT.BUFFER-1
D552- 60 1220 RTS
1230 *--------------------------------
D553- 20 0C FD 1240 INCHR JSR MON.RDKEY *** OUGHT TO BE "BIT $C010" ***
D556- 29 7F 1250 AND #$7F
D558- 60 1260 RTS
1270 *--------------------------------
1280 * TOKENIZE THE INPUT LINE
1290 *--------------------------------
1300 PARSE.INPUT.LINE
D559- A6 B8 1310 LDX TXTPTR INDEX INTO UNPARSED LINE
D55B- CA 1320 DEX PREPARE FOR INX AT "PARSE"
D55C- A0 04 1330 LDY #4 INDEX TO PARSED OUTPUT LINE
D55E- 84 13 1340 STY DATAFLG CLEAR SIGN-BIT OF DATAFLG
D560- 24 D6 1350 BIT LOCK IS THIS PROGRAM LOCKED?
D562- 10 08 1360 BPL PARSE NO, GO AHEAD AND PARSE THE LINE
D564- 68 1370 PLA YES, IGNORE INPUT AND "RUN"
D565- 68 1380 PLA THE PROGRAM
D566- 20 65 D6 1390 JSR SETPTRS CLEAR ALL VARIABLES
D569- 4C D2 D7 1400 JMP NEWSTT START RUNNING
1410 *--------------------------------
D56C- E8 1420 PARSE INX NEXT INPUT CHARACTER
D56D- BD 00 02 1430 .1 LDA INPUT.BUFFER,X
D570- 24 13 1440 BIT DATAFLG IN A "DATA" STATEMENT?
D572- 70 04 1450 BVS .2 YES (DATAFLG = $49)
D574- C9 20 1460 CMP #' ' IGNORE BLANKS
D576- F0 F4 1470 BEQ PARSE
D578- 85 0E 1480 .2 STA ENDCHR
D57A- C9 22 1490 CMP #'" START OF QUOTATION?
D57C- F0 74 1500 BEQ .13
D57E- 70 4D 1510 BVS .9 BRANCH IF IN "DATA" STATEMENT
D580- C9 3F 1520 CMP #'? SHORTHAND FOR "PRINT"?
D582- D0 04 1530 BNE .3 NO
D584- A9 BA 1540 LDA #TOKEN.PRINT YES, REPLACE WITH "PRINT" TOKEN
D586- D0 45 1550 BNE .9 ...ALWAYS
D588- C9 30 1560 .3 CMP #'0 IS IT A DIGIT, COLON, OR SEMI-COLON?
D58A- 90 04 1570 BCC .4 NO, PUNCTUATION !"#$%&'()*+,-./
D58C- C9 3C 1580 CMP #';'+1
D58E- 90 3D 1590 BCC .9 YES, NOT A TOKEN
1600 *--------------------------------
1610 * SEARCH TOKEN NAME TABLE FOR MATCH STARTING
1620 * WITH CURRENT CHAR FROM INPUT LINE
1630 *--------------------------------
D590- 84 AD 1640 .4 STY STRNG2 SAVE INDEX TO OUTPUT LINE
D592- A9 D0 1650 LDA #TOKEN.NAME.TABLE-$100
D594- 85 9D 1660 STA FAC MAKE PNTR FOR SEARCH
D596- A9 CF 1670 LDA /TOKEN.NAME.TABLE-$100
D598- 85 9E 1680 STA FAC+1
D59A- A0 00 1690 LDY #0 USE Y-REG WITH (FAC) TO ADDRESS TABLE
D59C- 84 0F 1700 STY TKN.CNTR HOLDS CURRENT TOKEN-$80
D59E- 88 1710 DEY PREPARE FOR "INY" A FEW LINES DOWN
D59F- 86 B8 1720 STX TXTPTR SAVE POSITION IN INPUT LINE
D5A1- CA 1730 DEX PREPARE FOR "INX" A FEW LINES DOWN
D5A2- C8 1740 .5 INY ADVANCE POINTER TO TOKEN TABLE
D5A3- D0 02 1750 BNE .6 Y=Y+1 IS ENOUGH
D5A5- E6 9E 1760 INC FAC+1 ALSO NEED TO BUMP THE PAGE
D5A7- E8 1770 .6 INX ADVANCE POINTER TO INPUT LINE
D5A8- BD 00 02 1780 .7 LDA INPUT.BUFFER,X NEXT CHAR FROM INPUT LINE
D5AB- C9 20 1790 CMP #' ' THIS CHAR A BLANK?
D5AD- F0 F8 1800 BEQ .6 YES, IGNORE ALL BLANKS
D5AF- 38 1810 SEC NO, COMPARE TO CHAR IN TABLE
D5B0- F1 9D 1820 SBC (FAC),Y SAME AS NEXT CHAR OF TOKEN NAME?
D5B2- F0 EE 1830 BEQ .5 YES, CONTINUE MATCHING
D5B4- C9 80 1840 CMP #$80 MAYBE; WAS IT SAME EXCEPT FOR BIT 7?
D5B6- D0 41 1850 BNE .14 NO, SKIP TO NEXT TOKEN
D5B8- 05 0F 1860 ORA TKN.CNTR YES, END OF TOKEN; GET TOKEN #
D5BA- C9 C5 1870 CMP #TOKEN.AT DID WE MATCH "AT"?
D5BC- D0 0D 1880 BNE .8 NO, SO NO AMBIGUITY
D5BE- BD 01 02 1890 LDA INPUT.BUFFER+1,X "AT" COULD BE "ATN" OR "A TO"
D5C1- C9 4E 1900 CMP #'N "ATN" HAS PRECEDENCE OVER "AT"
D5C3- F0 34 1910 BEQ .14 IT IS "ATN", FIND IT THE HARD WAY
D5C5- C9 4F 1920 CMP #'O "TO" HAS PRECEDENCE OVER "AT"
D5C7- F0 30 1930 BEQ .14 IT IS "A TO", FIN IT THE HARD WAY
D5C9- A9 C5 1940 LDA #TOKEN.AT NOT "ATN" OR "A TO", SO USE "AT"
1950 *--------------------------------
1960 * STORE CHARACTER OR TOKEN IN OUTPUT LINE
1970 *--------------------------------
D5CB- A4 AD 1980 .8 LDY STRNG2 GET INDEX TO OUTPUT LINE IN Y-REG
D5CD- E8 1990 .9 INX ADVANCE INPUT INDEX
D5CE- C8 2000 INY ADVANCE OUTPUT INDEX
D5CF- 99 FB 01 2010 STA INPUT.BUFFER-5,Y STORE CHAR OR TOKEN
D5D2- B9 FB 01 2020 LDA INPUT.BUFFER-5,Y TEST FOR EOL OR EOS
D5D5- F0 39 2030 BEQ .17 END OF LINE
D5D7- 38 2040 SEC
D5D8- E9 3A 2050 SBC #': END OF STATEMENT?
D5DA- F0 04 2060 BEQ .10 YES, CLEAR DATAFLG
D5DC- C9 49 2070 CMP #TOKEN.DATA-':' "DATA" TOKEN?
D5DE- D0 02 2080 BNE .11 NO, LEAVE DATAFLG ALONE
D5E0- 85 13 2090 .10 STA DATAFLG DATAFLG = 0 OR $83-$3A = $49
D5E2- 38 2100 .11 SEC IS IT A "REM" TOKEN?
D5E3- E9 78 2110 SBC #TOKEN.REM-':'
D5E5- D0 86 2120 BNE .1 NO, CONTINUE PARSING LINE
D5E7- 85 0E 2130 STA ENDCHR YES, CLEAR LITERAL FLAG
2140 *--------------------------------
2150 * HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,
2160 * BY COPYING CHARS UP TO ENDCHR.
2170 *--------------------------------
D5E9- BD 00 02 2180 .12 LDA INPUT.BUFFER,X
D5EC- F0 DF 2190 BEQ .9 END OF LINE
D5EE- C5 0E 2200 CMP ENDCHR
D5F0- F0 DB 2210 BEQ .9 FOUND ENDCHR
D5F2- C8 2220 .13 INY NEXT OUTPUT CHAR
D5F3- 99 FB 01 2230 STA INPUT.BUFFER-5,Y
D5F6- E8 2240 INX NEXT INPUT CHAR
D5F7- D0 F0 2250 BNE .12 ...ALWAYS
2260 *--------------------------------
2270 * ADVANCE POINTER TO NEXT TOKEN NAME
2280 *--------------------------------
D5F9- A6 B8 2290 .14 LDX TXTPTR GET POINTER TO INPUT LINE IN X-REG
D5FB- E6 0F 2300 INC TKN.CNTR BUMP (TOKEN # - $80)
D5FD- B1 9D 2310 .15 LDA (FAC),Y SCAN THROUGH TABLE FOR BIT7 = 1
D5FF- C8 2320 INY NEXT TOKEN ONE BEYOND THAT
D600- D0 02 2330 BNE .16 ...USUALLY ENOUGH TO BUMP Y-REG
D602- E6 9E 2340 INC FAC+1 NEXT SET OF 256 TOKEN CHARS
D604- 0A 2350 .16 ASL SEE IF SIGN BIT SET ON CHAR
D605- 90 F6 2360 BCC .15 NO, MORE IN THIS NAME
D607- B1 9D 2370 LDA (FAC),Y YES, AT NEXT NAME. END OF TABLE?
D609- D0 9D 2380 BNE .7 NO, NOT END OF TABLE
D60B- BD 00 02 2390 LDA INPUT.BUFFER,X YES, SO NOT A KEYWORD
D60E- 10 BB 2400 BPL .8 ...ALWAYS, COPY CHAR AS IS
2410 *---END OF LINE------------------
D610- 99 FD 01 2420 .17 STA INPUT.BUFFER-3,Y STORE ANOTHER 00 ON END
D613- C6 B9 2430 DEC TXTPTR+1 SET TXTPTR = INPUT.BUFFER-1
D615- A9 FF 2440 LDA #INPUT.BUFFER-1
D617- 85 B8 2450 STA TXTPTR
D619- 60 2460 RTS
2470 *--------------------------------
2480 * SEARCH FOR LINE
2490 *
2500 * (LINNUM) = LINE # TO FIND
2510 * IF NOT FOUND: CARRY = 0
2520 * LOWTR POINTS AT NEXT LINE
2530 * IF FOUND: CARRY = 1
2540 * LOWTR POINTS AT LINE
2550 *--------------------------------
D61A- A5 67 2560 FNDLIN LDA TXTTAB SEARCH FROM BEGINNING OF PROGRAM
D61C- A6 68 2570 LDX TXTTAB+1
D61E- A0 01 2580 FL1 LDY #1 SEARCH FROM (X,A)
D620- 85 9B 2590 STA LOWTR
D622- 86 9C 2600 STX LOWTR+1
D624- B1 9B 2610 LDA (LOWTR),Y
D626- F0 1F 2620 BEQ .3 END OF PROGRAM, AND NOT FOUND
D628- C8 2630 INY
D629- C8 2640 INY
D62A- A5 51 2650 LDA LINNUM+1
D62C- D1 9B 2660 CMP (LOWTR),Y
D62E- 90 18 2670 BCC RTS.1 IF NOT FOUND
D630- F0 03 2680 BEQ .1
D632- 88 2690 DEY
D633- D0 09 2700 BNE .2
D635- A5 50 2710 .1 LDA LINNUM
D637- 88 2720 DEY
D638- D1 9B 2730 CMP (LOWTR),Y
D63A- 90 0C 2740 BCC RTS.1 PAST LINE, NOT FOUND
D63C- F0 0A 2750 BEQ RTS.1 IF FOUND
D63E- 88 2760 .2 DEY
D63F- B1 9B 2770 LDA (LOWTR),Y
D641- AA 2780 TAX
D642- 88 2790 DEY
D643- B1 9B 2800 LDA (LOWTR),Y
D645- B0 D7 2810 BCS FL1 ALWAYS
D647- 18 2820 .3 CLC RETURN CARRY = 0
D648- 60 2830 RTS.1 RTS
2840 *--------------------------------
2850 * "NEW" STATEMENT
2860 *--------------------------------
D649- D0 FD 2870 NEW BNE RTS.1 IGNORE IF MORE TO THE STATEMENT
D64B- A9 00 2880 SCRTCH LDA #0
D64D- 85 D6 2890 STA LOCK
D64F- A8 2900 TAY
D650- 91 67 2910 STA (TXTTAB),Y
D652- C8 2920 INY
D653- 91 67 2930 STA (TXTTAB),Y
D655- A5 67 2940 LDA TXTTAB
D657- 69 02 2950 ADC #2 (CARRY WASN'T CLEARED, SO "NEW" USUALLY
D659- 85 69 2960 STA VARTAB ADDS 3, WHEREAS "FP" ADDS 2.)
D65B- 85 AF 2970 STA PRGEND
D65D- A5 68 2980 LDA TXTTAB+1
D65F- 69 00 2990 ADC #0
D661- 85 6A 3000 STA VARTAB+1
D663- 85 B0 3010 STA PRGEND+1
3020 *--------------------------------
3030 SETPTRS
D665- 20 97 D6 3040 JSR STXTPT SET TXTPTR TO TXTTAB - 1
D668- A9 00 3050 LDA #0 (THIS COULD HAVE BEEN ".HS 2C")
3060 *--------------------------------
3070 * "CLEAR" STATEMENT
3080 *--------------------------------
D66A- D0 2A 3090 CLEAR BNE RTS.2 IGNORE IF NOT AT END OF STATEMENT
D66C- A5 73 3100 CLEARC LDA MEMSIZ CLEAR STRING AREA
D66E- A4 74 3110 LDY MEMSIZ+1
D670- 85 6F 3120 STA FRETOP
D672- 84 70 3130 STY FRETOP+1
D674- A5 69 3140 LDA VARTAB CLEAR ARRAY AREA
D676- A4 6A 3150 LDY VARTAB+1
D678- 85 6B 3160 STA ARYTAB
D67A- 84 6C 3170 STY ARYTAB+1
D67C- 85 6D 3180 STA STREND LOW END OF FREE SPACE
D67E- 84 6E 3190 STY STREND+1
D680- 20 49 D8 3200 JSR RESTORE SET "DATA" POINTER TO BEGINNING
3210 *--------------------------------
D683- A2 55 3220 STKINI LDX #TEMPST
D685- 86 52 3230 STX TEMPPT
D687- 68 3240 PLA SAVE RETURN ADDRESS
D688- A8 3250 TAY
D689- 68 3260 PLA
D68A- A2 F8 3270 LDX #$F8 START STACK AT $F8,
D68C- 9A 3280 TXS LEAVING ROOM FOR PARSING LINES
D68D- 48 3290 PHA RESTORE RETURN ADDRESS
D68E- 98 3300 TYA
D68F- 48 3310 PHA
D690- A9 00 3320 LDA #0
D692- 85 7A 3330 STA OLDTEXT+1
D694- 85 14 3340 STA SUBFLG
D696- 60 3350 RTS.2 RTS
3360 *--------------------------------
3370 * SET TXTPTR TO BEGINNING OF PROGRAM
3380 *--------------------------------
D697- 18 3390 STXTPT CLC TXTPTR = TXTTAB - 1
D698- A5 67 3400 LDA TXTTAB
D69A- 69 FF 3410 ADC #$FF
D69C- 85 B8 3420 STA TXTPTR
D69E- A5 68 3430 LDA TXTTAB+1
D6A0- 69 FF 3440 ADC #$FF
D6A2- 85 B9 3450 STA TXTPTR+1
D6A4- 60 3460 RTS
3470 *--------------------------------
3480 * "LIST" STATEMENT
3490 *--------------------------------
D6A5- 90 0A 3500 LIST BCC .1 NO LINE # SPECIFIED
D6A7- F0 08 3510 BEQ .1 ---DITTO---
D6A9- C9 C9 3520 CMP #TOKEN.MINUS IF DASH OR COMMA, START AT LINE 0
D6AB- F0 04 3530 BEQ .1 IS IS A DASH
D6AD- C9 2C 3540 CMP #', COMMA?
D6AF- D0 E5 3550 BNE RTS.2 NO, ERROR
D6B1- 20 0C DA 3560 .1 JSR LINGET CONVERT LINE NUMBER IF ANY
D6B4- 20 1A D6 3570 JSR FNDLIN POINT LOWTR TO 1ST LINE
D6B7- 20 B7 00 3580 JSR CHRGOT RANGE SPECIFIED?
D6BA- F0 10 3590 BEQ .3 NO
D6BC- C9 C9 3600 CMP #TOKEN.MINUS
D6BE- F0 04 3610 BEQ .2
D6C0- C9 2C 3620 CMP #',
D6C2- D0 84 3630 BNE RTS.1
D6C4- 20 B1 00 3640 .2 JSR CHRGET GET NEXT CHAR
D6C7- 20 0C DA 3650 JSR LINGET CONVERT SECOND LINE #
D6CA- D0 CA 3660 BNE RTS.2 BRANCH IF SYNTAX ERR
D6CC- 68 3670 .3 PLA POP RETURN ADRESS
D6CD- 68 3680 PLA (GET BACK BY "JMP NEWSTT")
D6CE- A5 50 3690 LDA LINNUM IF NO SECOND NUMBER, USE $FFFF
D6D0- 05 51 3700 ORA LINNUM+1
D6D2- D0 06 3710 BNE LIST.0 THERE WAS A SECOND NUMBER
D6D4- A9 FF 3720 LDA #$FF MAX END RANGE
D6D6- 85 50 3730 STA LINNUM
D6D8- 85 51 3740 STA LINNUM+1
D6DA- A0 01 3750 LIST.0 LDY #1
D6DC- B1 9B 3760 LDA (LOWTR),Y HIGH BYTE OF LINK
D6DE- F0 44 3770 BEQ LIST.3 END OF PROGRAM
D6E0- 20 58 D8 3780 JSR ISCNTC CHECK IF CONTROL-C HAS BEEN TYPED
D6E3- 20 FB DA 3790 JSR CRDO NO, PRINT <RETURN>
D6E6- C8 3800 INY
D6E7- B1 9B 3810 LDA (LOWTR),Y GET LINE #, COMPARE WITH END RANGE
D6E9- AA 3820 TAX
D6EA- C8 3830 INY
D6EB- B1 9B 3840 LDA (LOWTR),Y
D6ED- C5 51 3850 CMP LINNUM+1
D6EF- D0 04 3860 BNE .5
D6F1- E4 50 3870 CPX LINNUM
D6F3- F0 02 3880 BEQ .6 ON LAST LINE OF RANGE
D6F5- B0 2D 3890 .5 BCS LIST.3 FINISHED THE RANGE
3900 *---LIST ONE LINE----------------
D6F7- 84 85 3910 .6 STY FORPNT
D6F9- 20 24 ED 3920 JSR LINPRT PRINT LINE # FROM X,A
D6FC- A9 20 3930 LDA #' ' PRINT SPACE AFTER LINE #
D6FE- A4 85 3940 LIST.1 LDY FORPNT
D700- 29 7F 3950 AND #$7F
D702- 20 5C DB 3960 LIST.2 JSR OUTDO
D705- A5 24 3970 LDA MON.CH IF PAST COLUMN 33, START A NEW LINE
D707- C9 21 3980 CMP #33
D709- 90 07 3990 BCC .1 < 33
D70B- 20 FB DA 4000 JSR CRDO PRINT <RETURN>
D70E- A9 05 4010 LDA #5 AND TAB OVER 5
D710- 85 24 4020 STA MON.CH
D712- C8 4030 .1 INY
D713- B1 9B 4040 LDA (LOWTR),Y
D715- D0 1D 4050 BNE LIST.4 NOT END OF LINE YET
D717- A8 4060 TAY END OF LINE
D718- B1 9B 4070 LDA (LOWTR),Y GET LINK TO NEXT LINE
D71A- AA 4080 TAX
D71B- C8 4090 INY
D71C- B1 9B 4100 LDA (LOWTR),Y
D71E- 86 9B 4110 STX LOWTR POINT TO NEXT LINE
D720- 85 9C 4120 STA LOWTR+1
D722- D0 B6 4130 BNE LIST.0 BRANCH IF NOT END OF PROGRAM
D724- A9 0D 4140 LIST.3 LDA #$0D PRINT <RETURN>
D726- 20 5C DB 4150 JSR OUTDO
D729- 4C D2 D7 4160 JMP NEWSTT TO NEXT STATEMENT
4170 *--------------------------------
D72C- C8 4180 GETCHR INY PICK UP CHAR FROM TABLE
D72D- D0 02 4190 BNE .1
D72F- E6 9E 4200 INC FAC+1
D731- B1 9D 4210 .1 LDA (FAC),Y
D733- 60 4220 RTS
4230 *--------------------------------
D734- 10 CC 4240 LIST.4 BPL LIST.2 BRANCH IF NOT A TOKEN
D736- 38 4250 SEC
D737- E9 7F 4260 SBC #$7F CONVERT TOKEN TO INDEX
D739- AA 4270 TAX
D73A- 84 85 4280 STY FORPNT SAVE LINE POINTER
D73C- A0 D0 4290 LDY #TOKEN.NAME.TABLE-$100
D73E- 84 9D 4300 STY FAC POINT FAC TO TABLE
D740- A0 CF 4310 LDY /TOKEN.NAME.TABLE-$100
D742- 84 9E 4320 STY FAC+1
D744- A0 FF 4330 LDY #-1
D746- CA 4340 .1 DEX SKIP KEYWORDS UNTIL REACH THIS ONE
D747- F0 07 4350 BEQ .3
D749- 20 2C D7 4360 .2 JSR GETCHR BUMP Y, GET CHAR FROM TABLE
D74C- 10 FB 4370 BPL .2 NOT AT END OF KEYWORD YET
D74E- 30 F6 4380 BMI .1 END OF KEYWORD, ALWAYS BRANCHES
D750- A9 20 4390 .3 LDA #' ' FOUND THE RIGHT KEYWORD
D752- 20 5C DB 4400 JSR OUTDO PRINT LEADING SPACE
D755- 20 2C D7 4410 .4 JSR GETCHR PRINT THE KEYWORD
D758- 30 05 4420 BMI .5 LAST CHAR OF KEYWORD
D75A- 20 5C DB 4430 JSR OUTDO
D75D- D0 F6 4440 BNE .4 ...ALWAYS
D75F- 20 5C DB 4450 .5 JSR OUTDO PRINT LAST CHAR OF KEYWORD
D762- A9 20 4460 LDA #' ' PRINT TRAILING SPACE
D764- D0 98 4470 BNE LIST.1 ...ALWAYS, BACK TO ACTUAL LINE
1130 .IN S.D766,D1
SAVE S.D766
1010 *--------------------------------
1020 * "FOR" STATEMENT
1030 *
1040 * FOR PUSHES 18 BYTES ON THE STACK:
1050 * 2 -- TXTPTR
1060 * 2 -- LINE NUMBER
1070 * 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
1080 * 1 -- STEP SIGN
1090 * 5 -- STEP VALUE
1100 * 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
1110 * 1 -- FOR TOKEN ($81)
1120 *--------------------------------
D766- A9 80 1130 FOR LDA #$80
D768- 85 14 1140 STA SUBFLG SUBSCRIPTS NOT ALLOWED
D76A- 20 46 DA 1150 JSR LET DO <VAR> = <EXP>, STORE ADDR IN FORPNT
D76D- 20 65 D3 1160 JSR GTFORPNT IS THIS FOR VARIABLE ACTIVE?
D770- D0 05 1170 BNE .1 NO
D772- 8A 1180 TXA YES, CANCEL IT AND ENCLOSED LOOPS
D773- 69 0F 1190 ADC #15 CARRY=1, THIS ADDS 16
D775- AA 1200 TAX X WAS ALREADY S+2
D776- 9A 1210 TXS
D777- 68 1220 .1 PLA POP RETURN ADDRESS TOO
D778- 68 1230 PLA
D779- A9 09 1240 LDA #9 BE CERTAIN ENOUGH ROOM IN STACK
D77B- 20 D6 D3 1250 JSR CHKMEM
D77E- 20 A3 D9 1260 JSR DATAN SCAN AHEAD TO NEXT STATEMENT
D781- 18 1270 CLC PUSH STATEMENT ADDRESS ON STACK
D782- 98 1280 TYA
D783- 65 B8 1290 ADC TXTPTR
D785- 48 1300 PHA
D786- A5 B9 1310 LDA TXTPTR+1
D788- 69 00 1320 ADC #0
D78A- 48 1330 PHA
D78B- A5 76 1340 LDA CURLIN+1 PUSH LINE NUMBER ON STACK
D78D- 48 1350 PHA
D78E- A5 75 1360 LDA CURLIN
D790- 48 1370 PHA
D791- A9 C1 1380 LDA #TOKEN.TO
D793- 20 C0 DE 1390 JSR SYNCHR REQUIRE "TO"
D796- 20 6A DD 1400 JSR CHKNUM <VAR> = <EXP> MUST BE NUMERIC
D799- 20 67 DD 1410 JSR FRMNUM GET FINAL VALUE, MUST BE NUMERIC
D79C- A5 A2 1420 LDA FAC.SIGN PUT SIGN INTO VALUE IN FAC
D79E- 09 7F 1430 ORA #$7F
D7A0- 25 9E 1440 AND FAC+1
D7A2- 85 9E 1450 STA FAC+1
D7A4- A9 AF 1460 LDA #STEP SET UP FOR RETURN
D7A6- A0 D7 1470 LDY /STEP TO STEP
D7A8- 85 5E 1480 STA INDEX
D7AA- 84 5F 1490 STY INDEX+1
D7AC- 4C 20 DE 1500 JMP FRM.STACK.3 RETURNS BY "JMP (INDEX)"
1510 *--------------------------------
1520 * "STEP" PHRASE OF "FOR" STATEMENT
1530 *--------------------------------
D7AF- A9 13 1540 STEP LDA #CON.ONE STEP DEFAULT=1
D7B1- A0 E9 1550 LDY /CON.ONE
D7B3- 20 F9 EA 1560 JSR LOAD.FAC.FROM.YA
D7B6- 20 B7 00 1570 JSR CHRGOT
D7B9- C9 C7 1580 CMP #TOKEN.STEP
D7BB- D0 06 1590 BNE .1 USE DEFAULT VALUE OF 1.0
D7BD- 20 B1 00 1600 JSR CHRGET STEP SPECIFIED, GET IT
D7C0- 20 67 DD 1610 JSR FRMNUM
D7C3- 20 82 EB 1620 .1 JSR SIGN
D7C6- 20 15 DE 1630 JSR FRM.STACK.2
D7C9- A5 86 1640 LDA FORPNT+1
D7CB- 48 1650 PHA
D7CC- A5 85 1660 LDA FORPNT
D7CE- 48 1670 PHA
D7CF- A9 81 1680 LDA #TOKEN.FOR
D7D1- 48 1690 PHA
1700 *--------------------------------
1710 * PERFORM NEXT STATEMENT
1720 *--------------------------------
D7D2- BA 1730 NEWSTT TSX REMEMBER THE STACK POSITION
D7D3- 86 F8 1740 STX REMSTK
D7D5- 20 58 D8 1750 JSR ISCNTC SEE IF CONTROL-C HAS BEEN TYPED
D7D8- A5 B8 1760 LDA TXTPTR NO, KEEP EXECUTING
D7DA- A4 B9 1770 LDY TXTPTR+1
D7DC- A6 76 1780 LDX CURLIN+1 =$FF IF IN DIRECT MODE
D7DE- E8 1790 INX $FF TURNS INTO $00
D7DF- F0 04 1800 BEQ .1 IN DIRECT MODE
D7E1- 85 79 1810 STA OLDTEXT IN RUNNING MODE
D7E3- 84 7A 1820 STY OLDTEXT+1
D7E5- A0 00 1830 .1 LDY #0
D7E7- B1 B8 1840 LDA (TXTPTR),Y END OF LINE YET?
D7E9- D0 57 1850 BNE COLON. NO
D7EB- A0 02 1860 LDY #2 YES, SEE IF END OF PROGRAM
D7ED- B1 B8 1870 LDA (TXTPTR),Y
D7EF- 18 1880 CLC
D7F0- F0 34 1890 BEQ GOEND YES, END OF PROGRAM
D7F2- C8 1900 INY
D7F3- B1 B8 1910 LDA (TXTPTR),Y GET LINE # OF NEXT LINE
D7F5- 85 75 1920 STA CURLIN
D7F7- C8 1930 INY
D7F8- B1 B8 1940 LDA (TXTPTR),Y
D7FA- 85 76 1950 STA CURLIN+1
D7FC- 98 1960 TYA ADJUST TXTPTR TO START
D7FD- 65 B8 1970 ADC TXTPTR OF NEW LINE
D7FF- 85 B8 1980 STA TXTPTR
D801- 90 02 1990 BCC .2
D803- E6 B9 2000 INC TXTPTR+1
2010 .2
2020 *--------------------------------
D805- 24 F2 2030 TRACE. BIT TRCFLG IS TRACE ON?
D807- 10 14 2040 BPL .1 NO
D809- A6 76 2050 LDX CURLIN+1 YES, ARE WE RUNNING?
D80B- E8 2060 INX
D80C- F0 0F 2070 BEQ .1 NOT RUNNING, SO DON'T TRACE
D80E- A9 23 2080 LDA #'#' PRINT "#"
D810- 20 5C DB 2090 JSR OUTDO
D813- A6 75 2100 LDX CURLIN
D815- A5 76 2110 LDA CURLIN+1
D817- 20 24 ED 2120 JSR LINPRT PRINT LINE NUMBER
D81A- 20 57 DB 2130 JSR OUTSP PRINT TRAILING SPACE
D81D- 20 B1 00 2140 .1 JSR CHRGET GET FIRST CHR OF STATEMENT
D820- 20 28 D8 2150 JSR EXECUTE.STATEMENT AND START PROCESSING
D823- 4C D2 D7 2160 JMP NEWSTT BACK FOR MORE
2170 *--------------------------------
D826- F0 62 2180 GOEND BEQ END4
2190 *--------------------------------
2200 * EXECUTE A STATEMENT
2210 *
2220 * (A) IS FIRST CHAR OF STATEMENT
2230 * CARRY IS SET
2240 *--------------------------------
2250 EXECUTE.STATEMENT
D828- F0 2D 2260 BEQ RTS.3 END OF LINE, NULL STATEMENT
2270 EXECUTE.STATEMENT.1
D82A- E9 80 2280 SBC #$80 FIRST CHAR A TOKEN?
D82C- 90 11 2290 BCC .1 NOT TOKEN, MUST BE "LET"
D82E- C9 40 2300 CMP #$40 STATEMENT-TYPE TOKEN?
D830- B0 14 2310 BCS SYNERR.1 NO, SYNTAX ERROR
D832- 0A 2320 ASL DOUBLE TO GET INDEX
D833- A8 2330 TAY INTO ADDRESS TABLE
D834- B9 01 D0 2340 LDA TOKEN.ADDRESS.TABLE+1,Y
D837- 48 2350 PHA PUT ADDRESS ON STACK
D838- B9 00 D0 2360 LDA TOKEN.ADDRESS.TABLE,Y
D83B- 48 2370 PHA
D83C- 4C B1 00 2380 JMP CHRGET GET NEXT CHR & RTS TO ROUTINE
2390 *--------------------------------
D83F- 4C 46 DA 2400 .1 JMP LET MUST BE <VAR> = <EXP>
2410 *--------------------------------
D842- C9 3A 2420 COLON. CMP #':'
D844- F0 BF 2430 BEQ TRACE.
D846- 4C C9 DE 2440 SYNERR.1 JMP SYNERR
2450 *--------------------------------
2460 * "RESTORE" STATEMENT
2470 *--------------------------------
2480 RESTORE
D849- 38 2490 SEC SET DATPTR TO BEGINNING OF PROGRAM
D84A- A5 67 2500 LDA TXTTAB
D84C- E9 01 2510 SBC #1
D84E- A4 68 2520 LDY TXTTAB+1
D850- B0 01 2530 BCS SETDA
D852- 88 2540 DEY
2550 *---SET DATPTR TO Y,A------------
D853- 85 7D 2560 SETDA STA DATPTR
D855- 84 7E 2570 STY DATPTR+1
D857- 60 2580 RTS.3 RTS
2590 *--------------------------------
2600 * SEE IF CONTROL-C TYPED
2610 *--------------------------------
D858- AD 00 C0 2620 ISCNTC LDA KEYBOARD
D85B- C9 83 2630 CMP #$83
D85D- F0 01 2640 BEQ .1
D85F- 60 2650 RTS
D860- 20 53 D5 2660 .1 JSR INCHR <<< SHOULD BE "BIT $C010" >>>
2670 CONTROL.C.TYPED
D863- A2 FF 2680 LDX #$FF CONTROL C ATTEMPTED
D865- 24 D8 2690 BIT ERRFLG "ON ERR" ENABLED?
D867- 10 03 2700 BPL .2 NO
D869- 4C E9 F2 2710 JMP HANDLERR YES, RETURN ERR CODE = 255
D86C- C9 03 2720 .2 CMP #3 SINCE IT IS CTRL-C, SET Z AND C BITS
2730 *--------------------------------
2740 * "STOP" STATEMENT
2750 *--------------------------------
D86E- B0 01 2760 STOP BCS END2 CARRY=1 TO FORCE PRINTING "BREAK AT.."
2770 *--------------------------------
2780 * "END" STATEMENT
2790 *--------------------------------
D870- 18 2800 END CLC CARRY=0 TO AVOID PRINTING MESSAGE
D871- D0 3C 2810 END2 BNE RTS.4 IF NOT END OF STATEMENT, DO NOTHING
D873- A5 B8 2820 LDA TXTPTR
D875- A4 B9 2830 LDY TXTPTR+1
D877- A6 76 2840 LDX CURLIN+1
D879- E8 2850 INX RUNNING?
D87A- F0 0C 2860 BEQ .1 NO, DIRECT MODE
D87C- 85 79 2870 STA OLDTEXT
D87E- 84 7A 2880 STY OLDTEXT+1
D880- A5 75 2890 LDA CURLIN
D882- A4 76 2900 LDY CURLIN+1
D884- 85 77 2910 STA OLDLIN
D886- 84 78 2920 STY OLDLIN+1
D888- 68 2930 .1 PLA
D889- 68 2940 PLA
D88A- A9 5D 2950 END4 LDA #QT.BREAK " BREAK" AND BELL
D88C- A0 D3 2960 LDY /QT.BREAK
D88E- 90 03 2970 BCC .1
D890- 4C 31 D4 2980 JMP PRINT.ERROR.LINNUM
D893- 4C 3C D4 2990 .1 JMP RESTART
3000 *--------------------------------
3010 * "CONT" COMMAND
3020 *--------------------------------
D896- D0 17 3030 CONT BNE RTS.4 IF NOT END OF STATEMENT, DO NOTHING
D898- A2 D2 3040 LDX #ERR.CANTCONT
D89A- A4 7A 3050 LDY OLDTEXT+1 MEANINGFUL RE-ENTRY?
D89C- D0 03 3060 BNE .1 YES
D89E- 4C 12 D4 3070 JMP ERROR NO
D8A1- A5 79 3080 .1 LDA OLDTEXT RESTORE TXTPTR
D8A3- 85 B8 3090 STA TXTPTR
D8A5- 84 B9 3100 STY TXTPTR+1
D8A7- A5 77 3110 LDA OLDLIN RESTORE LINE NUMBER
D8A9- A4 78 3120 LDY OLDLIN+1
D8AB- 85 75 3130 STA CURLIN
D8AD- 84 76 3140 STY CURLIN+1
D8AF- 60 3150 RTS.4 RTS
3160 *--------------------------------
3170 * "SAVE" COMMAND
3180 * WRITES PROGRAM ON CASSETTE TAPE
3190 *--------------------------------
D8B0- 38 3200 SAVE SEC
D8B1- A5 AF 3210 LDA PRGEND COMPUTE PROGRAM LENGTH
D8B3- E5 67 3220 SBC TXTTAB
D8B5- 85 50 3230 STA LINNUM
D8B7- A5 B0 3240 LDA PRGEND+1
D8B9- E5 68 3250 SBC TXTTAB+1
D8BB- 85 51 3260 STA LINNUM+1
D8BD- 20 F0 D8 3270 JSR VARTIO SET UP TO WRITE 3 BYTE HEADER
D8C0- 20 CD FE 3280 JSR MON.WRITE WRITE 'EM
D8C3- 20 01 D9 3290 JSR PROGIO SET UP TO WRITE THE PROGRAM
D8C6- 4C CD FE 3300 JMP MON.WRITE WRITE IT
3310 *--------------------------------
3320 * "LOAD" COMMAND
3330 * READS A PROGRAM FROM CASSETTE TAPE
3340 *--------------------------------
D8C9- 20 F0 D8 3350 LOAD JSR VARTIO SET UP TO READ 3 BYTE HEADER
D8CC- 20 FD FE 3360 JSR MON.READ READ LENGTH, LOCK BYTE
D8CF- 18 3370 CLC
D8D0- A5 67 3380 LDA TXTTAB COMPUTE END ADDRESS
D8D2- 65 50 3390 ADC LINNUM
D8D4- 85 69 3400 STA VARTAB
D8D6- A5 68 3410 LDA TXTTAB+1
D8D8- 65 51 3420 ADC LINNUM+1
D8DA- 85 6A 3430 STA VARTAB+1
D8DC- A5 52 3440 LDA TEMPPT LOCK BYTE
D8DE- 85 D6 3450 STA LOCK
D8E0- 20 01 D9 3460 JSR PROGIO SET UP TO READ PROGRAM
D8E3- 20 FD FE 3470 JSR MON.READ READ IT
D8E6- 24 D6 3480 BIT LOCK IF LOCKED, START RUNNING NOW
D8E8- 10 03 3490 BPL .1 NOT LOCKED
D8EA- 4C 65 D6 3500 JMP SETPTRS LOCKED, START RUNNING
D8ED- 4C F2 D4 3510 .1 JMP FIX.LINKS JUST FIX FORWARD POINTERS
3520 *--------------------------------
D8F0- A9 50 3530 VARTIO LDA #LINNUM SET UP TO READ/WRITE 3 BYTE HEADER
D8F2- A0 00 3540 LDY #0
D8F4- 85 3C 3550 STA MON.A1L
D8F6- 84 3D 3560 STY MON.A1H
D8F8- A9 52 3570 LDA #TEMPPT
D8FA- 85 3E 3580 STA MON.A2L
D8FC- 84 3F 3590 STY MON.A2H
D8FE- 84 D6 3600 STY LOCK
D900- 60 3610 RTS
3620 *--------------------------------
D901- A5 67 3630 PROGIO LDA TXTTAB SET UP TO READ/WRITE PROGRAM
D903- A4 68 3640 LDY TXTTAB+1
D905- 85 3C 3650 STA MON.A1L
D907- 84 3D 3660 STY MON.A1H
D909- A5 69 3670 LDA VARTAB
D90B- A4 6A 3680 LDY VARTAB+1
D90D- 85 3E 3690 STA MON.A2L
D90F- 84 3F 3700 STY MON.A2H
D911- 60 3710 RTS
3720 *--------------------------------
1150 .IN S.D912,D1
SAVE S.D912
1010 *--------------------------------
1020 * "RUN" COMMAND
1030 *--------------------------------
D912- 08 1040 RUN PHP SAVE STATUS WHILE SUBTRACTING
D913- C6 76 1050 DEC CURLIN+1 IF WAS $FF (MEANING DIRECT MODE)
1060 * MAKE IT "RUNNING MODE"
D915- 28 1070 PLP GET STATUS AGAIN (FROM CHRGET)
D916- D0 03 1080 BNE .1 PROBABLY A LINE NUMBER
D918- 4C 65 D6 1090 JMP SETPTRS START AT BEGINNING OF PROGRAM
D91B- 20 6C D6 1100 .1 JSR CLEARC CLEAR VARIABLES
D91E- 4C 35 D9 1110 JMP GO.TO.LINE JOIN GOSUB STATEMENT
1120 *--------------------------------
1130 * "GOSUB" STATEMENT
1140 *
1150 * LEAVES 7 BYTES ON STACK:
1160 * 2 -- RETURN ADDRESS (NEWSTT)
1170 * 2 -- TXTPTR
1180 * 2 -- LINE #
1190 * 1 -- GOSUB TOKEN ($B0)
1200 *--------------------------------
D921- A9 03 1210 GOSUB LDA #3 BE SURE ENOUGH ROOM ON STACK
D923- 20 D6 D3 1220 JSR CHKMEM
D926- A5 B9 1230 LDA TXTPTR+1
D928- 48 1240 PHA
D929- A5 B8 1250 LDA TXTPTR
D92B- 48 1260 PHA
D92C- A5 76 1270 LDA CURLIN+1
D92E- 48 1280 PHA
D92F- A5 75 1290 LDA CURLIN
D931- 48 1300 PHA
D932- A9 B0 1310 LDA #TOKEN.GOSUB
D934- 48 1320 PHA
1330 GO.TO.LINE
D935- 20 B7 00 1340 JSR CHRGOT
D938- 20 3E D9 1350 JSR GOTO
D93B- 4C D2 D7 1360 JMP NEWSTT
1370 *--------------------------------
1380 * "GOTO" STATEMENT
1390 * ALSO USED BY "RUN" AND "GOSUB"
1400 *--------------------------------
D93E- 20 0C DA 1410 GOTO JSR LINGET GET GOTO LINE
D941- 20 A6 D9 1420 JSR REMN POINT Y TO EOL
D944- A5 76 1430 LDA CURLIN+1 IS CURRENT PAGE < GOTO PAGE?
D946- C5 51 1440 CMP LINNUM+1
D948- B0 0B 1450 BCS .1 SEARCH FROM PROG START IF NOT
D94A- 98 1460 TYA OTHERWISE SEARCH FROM NEXT LINE
D94B- 38 1470 SEC
D94C- 65 B8 1480 ADC TXTPTR
D94E- A6 B9 1490 LDX TXTPTR+1
D950- 90 07 1500 BCC .2
D952- E8 1510 INX
D953- B0 04 1520 BCS .2
D955- A5 67 1530 .1 LDA TXTTAB GET PROGRAM BEGINNING
D957- A6 68 1540 LDX TXTTAB+1
D959- 20 1E D6 1550 .2 JSR FL1 SEARCH FOR GOTO LINE
D95C- 90 1E 1560 BCC UNDERR ERROR IF NOT THERE
D95E- A5 9B 1570 LDA LOWTR TXTPTR = START OF THE DESTINATION LINE
D960- E9 01 1580 SBC #1
D962- 85 B8 1590 STA TXTPTR
D964- A5 9C 1600 LDA LOWTR+1
D966- E9 00 1610 SBC #0
D968- 85 B9 1620 STA TXTPTR+1
D96A- 60 1630 RTS.5 RTS RETURN TO NEWSTT OR GOSUB
1640 *--------------------------------
1650 * "POP" AND "RETURN" STATEMENTS
1660 *--------------------------------
D96B- D0 FD 1670 POP BNE RTS.5
D96D- A9 FF 1680 LDA #$FF
D96F- 85 85 1690 STA FORPNT <<< BUG: SHOULD BE FORPNT+1 >>>
1700 * <<< SEE "ALL ABOUT APPLESOFT", PAGES 100,101 >>>
D971- 20 65 D3 1710 JSR GTFORPNT TO CANCEL FOR/NEXT IN SUB
D974- 9A 1720 TXS
D975- C9 B0 1730 CMP #TOKEN.GOSUB LAST GOSUB FOUND?
D977- F0 0B 1740 BEQ RETURN
D979- A2 16 1750 LDX #ERR.NOGOSUB
D97B- 2C 1760 .HS 2C FAKE
D97C- A2 5A 1770 UNDERR LDX #ERR.UNDEFSTAT
D97E- 4C 12 D4 1780 JMP ERROR
1790 *--------------------------------
D981- 4C C9 DE 1800 SYNERR.2 JMP SYNERR
1810 *--------------------------------
D984- 68 1820 RETURN PLA DISCARD GOSUB TOKEN
D985- 68 1830 PLA
D986- C0 42 1840 CPY #TOKEN.POP*2
D988- F0 3B 1850 BEQ PULL3 BRANCH IF A POP
D98A- 85 75 1860 STA CURLIN PULL LINE #
D98C- 68 1870 PLA
D98D- 85 76 1880 STA CURLIN+1
D98F- 68 1890 PLA
D990- 85 B8 1900 STA TXTPTR PULL TXTPTR
D992- 68 1910 PLA
D993- 85 B9 1920 STA TXTPTR+1
1930 *--------------------------------
1940 * "DATA" STATEMENT
1950 * EXECUTED BY SKIPPING TO NEXT COLON OR EOL
1960 *--------------------------------
D995- 20 A3 D9 1970 DATA JSR DATAN MOVE TO NEXT STATEMENT
1980 *--------------------------------
1990 * ADD (Y) TO TXTPTR
2000 *--------------------------------
D998- 98 2010 ADDON TYA
D999- 18 2020 CLC
D99A- 65 B8 2030 ADC TXTPTR
D99C- 85 B8 2040 STA TXTPTR
D99E- 90 02 2050 BCC .1
D9A0- E6 B9 2060 INC TXTPTR+1
2070 .1
D9A2- 60 2080 RTS.6 RTS
2090 *--------------------------------
2100 * SCAN AHEAD TO NEXT ":" OR EOL
2110 *--------------------------------
D9A3- A2 3A 2120 DATAN LDX #':' GET OFFSET IN Y TO EOL OR ":"
D9A5- 2C 2130 .HS 2C FAKE
2140 *--------------------------------
D9A6- A2 00 2150 REMN LDX #0 TO EOL ONLY
D9A8- 86 0D 2160 STX CHARAC
D9AA- A0 00 2170 LDY #0
D9AC- 84 0E 2180 STY ENDCHR
D9AE- A5 0E 2190 .1 LDA ENDCHR TRICK TO COUNT QUOTE PARITY
D9B0- A6 0D 2200 LDX CHARAC
D9B2- 85 0D 2210 STA CHARAC
D9B4- 86 0E 2220 STX ENDCHR
D9B6- B1 B8 2230 .2 LDA (TXTPTR),Y
D9B8- F0 E8 2240 BEQ RTS.6 END OF LINE
D9BA- C5 0E 2250 CMP ENDCHR
D9BC- F0 E4 2260 BEQ RTS.6 COLON IF LOOKING FOR COLONS
D9BE- C8 2270 INY
D9BF- C9 22 2280 CMP #'"'
D9C1- D0 F3 2290 BNE .2
D9C3- F0 E9 2300 BEQ .1 ...ALWAYS
2310 *--------------------------------
D9C5- 68 2320 PULL3 PLA
D9C6- 68 2330 PLA
D9C7- 68 2340 PLA
D9C8- 60 2350 RTS
2360 *--------------------------------
2370 * "IF" STATEMENT
2380 *--------------------------------
D9C9- 20 7B DD 2390 IF JSR FRMEVL
D9CC- 20 B7 00 2400 JSR CHRGOT
D9CF- C9 AB 2410 CMP #TOKEN.GOTO
D9D1- F0 05 2420 BEQ .1
D9D3- A9 C4 2430 LDA #TOKEN.THEN
D9D5- 20 C0 DE 2440 JSR SYNCHR
D9D8- A5 9D 2450 .1 LDA FAC CONDITION TRUE OR FALSE?
D9DA- D0 05 2460 BNE IF.TRUE BRANCH IF TRUE
2470 *--------------------------------
2480 * "REM" STATEMENT, OR FALSE "IF" STATEMENT
2490 *--------------------------------
D9DC- 20 A6 D9 2500 REM JSR REMN SKIP REST OF LINE
D9DF- F0 B7 2510 BEQ ADDON ...ALWAYS
2520 *--------------------------------
2530 IF.TRUE
D9E1- 20 B7 00 2540 JSR CHRGOT COMMAND OR NUMBER?
D9E4- B0 03 2550 BCS .1 COMMAND
D9E6- 4C 3E D9 2560 JMP GOTO NUMBER
D9E9- 4C 28 D8 2570 .1 JMP EXECUTE.STATEMENT
2580 *--------------------------------
2590 * "ON" STATEMENT
2600 *
2610 * ON <EXP> GOTO <LIST>
2620 * ON <EXP> GOSUB <LIST>
2630 *--------------------------------
D9EC- 20 F8 E6 2640 ONGOTO JSR GETBYT EVALUATE <EXP>, AS BYTE IN FAC+4
D9EF- 48 2650 PHA SAVE NEXT CHAR ON STACK
D9F0- C9 B0 2660 CMP #TOKEN.GOSUB
D9F2- F0 04 2670 BEQ ON.2
D9F4- C9 AB 2680 ON.1 CMP #TOKEN.GOTO
D9F6- D0 89 2690 BNE SYNERR.2
D9F8- C6 A1 2700 ON.2 DEC FAC+4 COUNTED TO RIGHT ONE YET?
D9FA- D0 04 2710 BNE .3 NO, KEEP LOOKING
D9FC- 68 2720 PLA YES, RETRIEVE CMD
D9FD- 4C 2A D8 2730 JMP EXECUTE.STATEMENT.1 AND GO.
DA00- 20 B1 00 2740 .3 JSR CHRGET PRIME CONVERT SUBROUTINE
DA03- 20 0C DA 2750 JSR LINGET CONVERT LINE #
DA06- C9 2C 2760 CMP #',' TERMINATE WITH COMMA?
DA08- F0 EE 2770 BEQ ON.2 YES
DA0A- 68 2780 PLA NO, END OF LIST, SO IGNORE
DA0B- 60 2790 RTS.7 RTS
2800 *--------------------------------
2810 * CONVERT LINE NUMBER
2820 *--------------------------------
DA0C- A2 00 2830 LINGET LDX #0 ASC # TO HEX ADDRESS
DA0E- 86 50 2840 STX LINNUM IN LINNUM.
DA10- 86 51 2850 STX LINNUM+1
DA12- B0 F7 2860 .1 BCS RTS.7 NOT A DIGIT
DA14- E9 2F 2870 SBC #'0'-1 CONVERT DIGIT TO BINARY
DA16- 85 0D 2880 STA CHARAC SAVE THE DIGIT
DA18- A5 51 2890 LDA LINNUM+1 CHECK RANGE
DA1A- 85 5E 2900 STA INDEX
DA1C- C9 19 2910 CMP /6400 LINE # TOO LARGE?
DA1E- B0 D4 2920 BCS ON.1 YES, > 63999, GO INDIRECTLY TO
2930 * "SYNTAX ERROR".
2940 *<<<<<DANGEROUS CODE>>>>>
2950 * NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
2960 * ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
2970 * JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
2980 * FOR OTHER CALLS TO LINGET.
2990 *
3000 * YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
3010 * THEN TYPE "GO TO 437761".
3020 *
3030 * ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
3040 * THE PROBLEM. ($AB00 - $ABFF)
3050 *<<<<<DANGEROUS CODE>>>>>
DA20- A5 50 3060 LDA LINNUM MULTIPLY BY TEN
DA22- 0A 3070 ASL
DA23- 26 5E 3080 ROL INDEX
DA25- 0A 3090 ASL
DA26- 26 5E 3100 ROL INDEX
DA28- 65 50 3110 ADC LINNUM
DA2A- 85 50 3120 STA LINNUM
DA2C- A5 5E 3130 LDA INDEX
DA2E- 65 51 3140 ADC LINNUM+1
DA30- 85 51 3150 STA LINNUM+1
DA32- 06 50 3160 ASL LINNUM
DA34- 26 51 3170 ROL LINNUM+1
DA36- A5 50 3180 LDA LINNUM
DA38- 65 0D 3190 ADC CHARAC ADD DIGIT
DA3A- 85 50 3200 STA LINNUM
DA3C- 90 02 3210 BCC .2
DA3E- E6 51 3220 INC LINNUM+1
DA40- 20 B1 00 3230 .2 JSR CHRGET GET NEXT CHAR
DA43- 4C 12 DA 3240 JMP .1 MORE CONVERTING
3250 *--------------------------------
3260 * "LET" STATEMENT
3270 *
3280 * LET <VAR> = <EXP>
3290 * <VAR> = <EXP>
3300 *--------------------------------
DA46- 20 E3 DF 3310 LET JSR PTRGET GET <VAR>
DA49- 85 85 3320 STA FORPNT
DA4B- 84 86 3330 STY FORPNT+1
DA4D- A9 D0 3340 LDA #TOKEN.EQUAL
DA4F- 20 C0 DE 3350 JSR SYNCHR
DA52- A5 12 3360 LDA VALTYP+1 SAVE VARIABLE TYPE
DA54- 48 3370 PHA
DA55- A5 11 3380 LDA VALTYP
DA57- 48 3390 PHA
DA58- 20 7B DD 3400 JSR FRMEVL EVALUATE <EXP>
DA5B- 68 3410 PLA
DA5C- 2A 3420 ROL
DA5D- 20 6D DD 3430 JSR CHKVAL
DA60- D0 18 3440 BNE LET.STRING
DA62- 68 3450 PLA
3460 *--------------------------------
DA63- 10 12 3470 LET2 BPL .1 REAL VARIABLE
DA65- 20 72 EB 3480 JSR ROUND.FAC INTEGER VAR: ROUND TO 32 BITS
DA68- 20 0C E1 3490 JSR AYINT TRUNCATE TO 16-BITS
DA6B- A0 00 3500 LDY #0
DA6D- A5 A0 3510 LDA FAC+3
DA6F- 91 85 3520 STA (FORPNT),Y
DA71- C8 3530 INY
DA72- A5 A1 3540 LDA FAC+4
DA74- 91 85 3550 STA (FORPNT),Y
DA76- 60 3560 RTS
3570 *--------------------------------
3580 * REAL VARIABLE = EXPRESSION
3590 *--------------------------------
DA77- 4C 27 EB 3600 .1 JMP SETFOR
3610 *--------------------------------
3620 LET.STRING
DA7A- 68 3630 PLA
3640 *--------------------------------
3650 * INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
3660 *--------------------------------
DA7B- A0 02 3670 PUTSTR LDY #2 STRING DATA ALREADY IN STRING AREA?
DA7D- B1 A0 3680 LDA (FAC+3),Y (STRING AREA IS BTWN FRETOP
DA7F- C5 70 3690 CMP FRETOP+1 HIMEM)
DA81- 90 17 3700 BCC .2 YES, DATA ALREADY UP THERE
DA83- D0 07 3710 BNE .1 NO
DA85- 88 3720 DEY MAYBE, TEST LOW BYTE OF POINTER
DA86- B1 A0 3730 LDA (FAC+3),Y
DA88- C5 6F 3740 CMP FRETOP
DA8A- 90 0E 3750 BCC .2 YES, ALREADY THERE
DA8C- A4 A1 3760 .1 LDY FAC+4 NO. DESCRIPTOR ALREADY AMONG VARIABLES?
DA8E- C4 6A 3770 CPY VARTAB+1
DA90- 90 08 3780 BCC .2 NO
DA92- D0 0D 3790 BNE .3 YES
DA94- A5 A0 3800 LDA FAC+3 MAYBE, COMPARE LO-BYTE
DA96- C5 69 3810 CMP VARTAB
DA98- B0 07 3820 BCS .3 YES, DESCRIPTOR IS AMONG VARIABLES
DA9A- A5 A0 3830 .2 LDA FAC+3 EITHER STRING ALREADY ON TOP, OR
DA9C- A4 A1 3840 LDY FAC+4 DESCRIPTOR IS NOT A VARIABLE
DA9E- 4C B7 DA 3850 JMP .4 SO JUST STORE THE DESCRIPTOR
3860 *--------------------------------
3870 * STRING NOT YET IN STRING AREA,
3880 * AND DESCRIPTOR IS A VARIABLE
3890 *--------------------------------
DAA1- A0 00 3900 .3 LDY #0 POINT AT LENGTH IN DESCRIPTOR
DAA3- B1 A0 3910 LDA (FAC+3),Y GET LENGTH
DAA5- 20 D5 E3 3920 JSR STRINI MAKE A STRING THAT LONG UP ABOVE
DAA8- A5 8C 3930 LDA DSCPTR SET UP SOURCE PNTR FOR MONINS
DAAA- A4 8D 3940 LDY DSCPTR+1
DAAC- 85 AB 3950 STA STRNG1
DAAE- 84 AC 3960 STY STRNG1+1
DAB0- 20 D4 E5 3970 JSR MOVINS MOVE STRING DATA TO NEW AREA
DAB3- A9 9D 3980 LDA #FAC ADDRESS OF DESCRIPTOR IS IN FAC
DAB5- A0 00 3990 LDY /FAC
DAB7- 85 8C 4000 .4 STA DSCPTR
DAB9- 84 8D 4010 STY DSCPTR+1
DABB- 20 35 E6 4020 JSR FRETMS DISCARD DESCRIPTOR IF 'TWAS TEMPORARY
DABE- A0 00 4030 LDY #0 COPY STRING DESCRIPTOR
DAC0- B1 8C 4040 LDA (DSCPTR),Y
DAC2- 91 85 4050 STA (FORPNT),Y
DAC4- C8 4060 INY
DAC5- B1 8C 4070 LDA (DSCPTR),Y
DAC7- 91 85 4080 STA (FORPNT),Y
DAC9- C8 4090 INY
DACA- B1 8C 4100 LDA (DSCPTR),Y
DACC- 91 85 4110 STA (FORPNT),Y
DACE- 60 4120 RTS
1170 .IN S.DACF,D1
SAVE S.DACF
1010 *--------------------------------
1020 PR.STRING
DACF- 20 3D DB 1030 JSR STRPRT
DAD2- 20 B7 00 1040 JSR CHRGOT
1050 *--------------------------------
1060 * "PRINT" STATEMENT
1070 *--------------------------------
DAD5- F0 24 1080 PRINT BEQ CRDO NO MORE LIST, PRINT <RETURN>
1090 *--------------------------------
DAD7- F0 29 1100 PRINT2 BEQ RTS.8 NO MORE LIST, DON'T PRINT <RETURN>
DAD9- C9 C0 1110 CMP #TOKEN.TAB
DADB- F0 39 1120 BEQ PR.TAB.OR.SPC C=1 FOR TAB(
DADD- C9 C3 1130 CMP #TOKEN.SPC
DADF- 18 1140 CLC
DAE0- F0 34 1150 BEQ PR.TAB.OR.SPC C=0 FOR SPC(
DAE2- C9 2C 1160 CMP #','
DAE4- 18 1170 CLC <<< NO PURPOSE TO THIS >>>
DAE5- F0 1C 1180 BEQ PR.COMMA
DAE7- C9 3B 1190 CMP #';'
DAE9- F0 44 1200 BEQ PR.NEXT.CHAR
DAEB- 20 7B DD 1210 JSR FRMEVL EVALUATE EXPRESSION
DAEE- 24 11 1220 BIT VALTYP STRING OR FP VALUE?
DAF0- 30 DD 1230 BMI PR.STRING STRING
DAF2- 20 34 ED 1240 JSR FOUT FP: CONVERT INTO BUFFER
DAF5- 20 E7 E3 1250 JSR STRLIT MAKE BUFFER INTO STRING
DAF8- 4C CF DA 1260 JMP PR.STRING PRINT THE STRING
1270 *--------------------------------
DAFB- A9 0D 1280 CRDO LDA #$0D PRINT <RETURN>
DAFD- 20 5C DB 1290 JSR OUTDO
DB00- 49 FF 1300 NEGATE EOR #$FF <<< WHY??? >>>
DB02- 60 1310 RTS.8 RTS
1320 *--------------------------------
1330 * TAB TO NEXT COMMA COLUMN
1340 * <<< NOTE BUG IF WIDTH OF WINDOW LESS THAN 33 >>>
1350 PR.COMMA
DB03- A5 24 1360 LDA MON.CH
DB05- C9 18 1370 CMP #24 <<< BUG: IT SHOULD BE 32 >>>
DB07- 90 05 1380 BCC .1 NEXT COLUMN, SAME LINE
DB09- 20 FB DA 1390 JSR CRDO FIRST COLUMN, NEXT LINT
DB0C- D0 21 1400 BNE PR.NEXT.CHAR ...ALWAYS
DB0E- 69 10 1410 .1 ADC #16
DB10- 29 F0 1420 AND #$F0 ROUND TO 16 OR 32
DB12- 85 24 1430 STA MON.CH
DB14- 90 19 1440 BCC PR.NEXT.CHAR ...ALWAYS
1450 *--------------------------------
1460 PR.TAB.OR.SPC
DB16- 08 1470 PHP C=0 FOR SPC(, C=1 FOR TAB(
DB17- 20 F5 E6 1480 JSR GTBYTC GET VALUE
DB1A- C9 29 1490 CMP #')' TRAILING PARENTHESIS
DB1C- F0 03 1500 BEQ .1 GOOD
DB1E- 4C C9 DE 1510 JMP SYNERR NO, SYNTAX ERROR
DB21- 28 1520 .1 PLP TAB( OR SPC(
DB22- 90 07 1530 BCC .2 SPC(
DB24- CA 1540 DEX TAB(
DB25- 8A 1550 TXA CALCULATE SPACES NEEDED FOR TAB(
DB26- E5 24 1560 SBC MON.CH
DB28- 90 05 1570 BCC PR.NEXT.CHAR ALREADY PAST THAT COLUMN
DB2A- AA 1580 TAX NOW DO A SPC( TO THE SPECIFIED COLUMN
DB2B- E8 1590 .2 INX
DB2C- CA 1600 NXSPC DEX
DB2D- D0 06 1610 BNE DOSPC MORE SPACES TO PRINT
1620 *--------------------------------
1630 PR.NEXT.CHAR
DB2F- 20 B1 00 1640 JSR CHRGET
DB32- 4C D7 DA 1650 JMP PRINT2 CONTINUE PARSING PRINT LIST
1660 *--------------------------------
DB35- 20 57 DB 1670 DOSPC JSR OUTSP
DB38- D0 F2 1680 BNE NXSPC ...ALWAYS
1690 *--------------------------------
1700 * PRINT STRING AT (Y,A)
DB3A- 20 E7 E3 1710 STROUT JSR STRLIT MAKE (Y,A) PRINTABLE
1720 *--------------------------------
1730 * PRINT STRING AT (FACMO,FACLO)
1740 *--------------------------------
DB3D- 20 00 E6 1750 STRPRT JSR FREFAC GET ADDRESS INTO INDEX, (A)=LENGTH
DB40- AA 1760 TAX USE X-REG FOR COUNTER
DB41- A0 00 1770 LDY #0 USE Y-REG FOR SCANNER
DB43- E8 1780 INX
DB44- CA 1790 .1 DEX
DB45- F0 BB 1800 BEQ RTS.8 FINISHED
DB47- B1 5E 1810 LDA (INDEX),Y NEXT CHAR FROM STRING
DB49- 20 5C DB 1820 JSR OUTDO PRINT THE CHAR
DB4C- C8 1830 INY
1840 * <<< NEXT THREE LINES ARE USELESS >>>
DB4D- C9 0D 1850 CMP #$0D WAS IT <RETURN>?
DB4F- D0 F3 1860 BNE .1 NO
DB51- 20 00 DB 1870 JSR NEGATE EOR #$FF WOULD DO IT, BUT WHY?
1880 * <<< ABOVE THREE LINES ARE USELESS >>>
DB54- 4C 44 DB 1890 JMP .1
1900 *--------------------------------
DB57- A9 20 1910 OUTSP LDA #' ' PRINT A SPACE
DB59- 2C 1920 .HS 2C SKIP OVER NEXT LINE
DB5A- A9 3F 1930 OUTQUES LDA #'?' PRINT QUESTION MARK
1940 *--------------------------------
1950 * PRINT CHAR FROM (A)
1960 *
1970 * NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT
1980 * OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED
1990 * BY NORMAL, INVERSE, OR FLASH OR POKE 243,0.
2000 *--------------------------------
DB5C- 09 80 2010 OUTDO ORA #$80 PRINT (A)
DB5E- C9 A0 2020 CMP #$A0 CONTROL CHR?
DB60- 90 02 2030 BCC .1 SKIP IF SO
DB62- 05 F3 2040 ORA FLASH.BIT =$40 FOR FLASH, ELSE $00
DB64- 20 ED FD 2050 .1 JSR MON.COUT "AND"S WITH $3F (INVERSE), $7F (FLASH)
DB67- 29 7F 2060 AND #$7F
DB69- 48 2070 PHA
DB6A- A5 F1 2080 LDA SPEEDZ COMPLEMENT OF SPEED #
DB6C- 20 A8 FC 2090 JSR MON.WAIT SO SPEED=255 BECOMES (A)=1
DB6F- 68 2100 PLA
DB70- 60 2110 RTS
2120 *--------------------------------
2130 * INPUT CONVERSION ERROR: ILLEGAL CHARACTER
2140 * IN NUMERIC FIELD. MUST DISTINGUISH
2150 * BETWEEN INPUT, READ, AND GET
2160 *--------------------------------
2170 INPUTERR
DB71- A5 15 2180 LDA INPUTFLG
DB73- F0 12 2190 BEQ RESPERR TAKEN IF INPUT
DB75- 30 04 2200 BMI READERR TAKEN IF READ
DB77- A0 FF 2210 LDY #$FF FROM A GET
DB79- D0 04 2220 BNE ERLIN ...ALWAYS
2230 *--------------------------------
2240 READERR
DB7B- A5 7B 2250 LDA DATLIN TELL WHERE THE "DATA" IS, RATHER
DB7D- A4 7C 2260 LDY DATLIN+1 THAN THE "READ"
2270 *--------------------------------
DB7F- 85 75 2280 ERLIN STA CURLIN
DB81- 84 76 2290 STY CURLIN+1
DB83- 4C C9 DE 2300 JMP SYNERR
2310 *--------------------------------
DB86- 68 2320 INPERR PLA
2330 *--------------------------------
2340 RESPERR
DB87- 24 D8 2350 BIT ERRFLG "ON ERR" TURNED ON?
DB89- 10 05 2360 BPL .1 NO, GIVE REENTRY A TRY
DB8B- A2 FE 2370 LDX #254 ERROR CODE = 254
DB8D- 4C E9 F2 2380 JMP HANDLERR
DB90- A9 EF 2390 .1 LDA #ERR.REENTRY "?REENTER"
DB92- A0 DC 2400 LDY /ERR.REENTRY
DB94- 20 3A DB 2410 JSR STROUT
DB97- A5 79 2420 LDA OLDTEXT RE-EXECUTE THE WHOLE INPUT STATEMENT
DB99- A4 7A 2430 LDY OLDTEXT+1
DB9B- 85 B8 2440 STA TXTPTR
DB9D- 84 B9 2450 STY TXTPTR+1
DB9F- 60 2460 RTS
2470 *--------------------------------
2480 * "GET" STATEMENT
2490 *--------------------------------
DBA0- 20 06 E3 2500 GET JSR ERRDIR ILLEGAL IF IN DIRECT MODE
DBA3- A2 01 2510 LDX #INPUT.BUFFER+1 SIMULATE INPUT
DBA5- A0 02 2520 LDY /INPUT.BUFFER+1
DBA7- A9 00 2530 LDA #0
DBA9- 8D 01 02 2540 STA INPUT.BUFFER+1
DBAC- A9 40 2550 LDA #$40 SET UP INPUTFLG
DBAE- 20 EB DB 2560 JSR PROCESS.INPUT.LIST <<< CAN SAVE 1 BYTE HERE>>>
DBB1- 60 2570 RTS <<<BY "JMP PROCESS.INPUT.LIST">>>
2580 *--------------------------------
2590 * "INPUT" STATEMENT
2600 *--------------------------------
DBB2- C9 22 2610 INPUT CMP #'"' CHECK FOR OPTIONAL PROMPT STRING
DBB4- D0 0E 2620 BNE .1 NO, PRINT "?" PROMPT
DBB6- 20 81 DE 2630 JSR STRTXT MAKE A PRINTABLE STRING OUT OF IT
DBB9- A9 3B 2640 LDA #';' MUST HAVE ; NOW
DBBB- 20 C0 DE 2650 JSR SYNCHR
DBBE- 20 3D DB 2660 JSR STRPRT PRINT THE STRING
DBC1- 4C C7 DB 2670 JMP .2
DBC4- 20 5A DB 2680 .1 JSR OUTQUES NO STRING, PRINT "?"
DBC7- 20 06 E3 2690 .2 JSR ERRDIR ILLEGAL IF IN DIRECT MODE
DBCA- A9 2C 2700 LDA #',' PRIME THE BUFFER
DBCC- 8D FF 01 2710 STA INPUT.BUFFER-1
DBCF- 20 2C D5 2720 JSR INLIN
DBD2- AD 00 02 2730 LDA INPUT.BUFFER
DBD5- C9 03 2740 CMP #$03 CONTROL C?
DBD7- D0 10 2750 BNE INPUT.FLAG.ZERO NO
DBD9- 4C 63 D8 2760 JMP CONTROL.C.TYPED
2770 *--------------------------------
DBDC- 20 5A DB 2780 NXIN JSR OUTQUES PRINT "?"
DBDF- 4C 2C D5 2790 JMP INLIN
2800 *--------------------------------
2810 * "READ" STATEMENT
2820 *--------------------------------
DBE2- A6 7D 2830 READ LDX DATPTR Y,X POINTS AT NEXT DATA STATEMENT
DBE4- A4 7E 2840 LDY DATPTR+1
DBE6- A9 98 2850 LDA #$98 SET INPUTFLG = $98
DBE8- 2C 2860 .HS 2C TRICK TO PROCESS.INPUT.LIST
2870 *--------------------------------
2880 INPUT.FLAG.ZERO
DBE9- A9 00 2890 LDA #0 SET INPUTFLG = $00
2900 *--------------------------------
2910 * PROCESS INPUT LIST
2920 *
2930 * (Y,X) IS ADDRESS OF INPUT DATA STRING
2940 * (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
2950 * $40 FOR GET
2960 * $98 FOR READ
2970 *--------------------------------
2980 PROCESS.INPUT.LIST
DBEB- 85 15 2990 STA INPUTFLG
DBED- 86 7F 3000 STX INPTR ADDRESS OF INPUT STRING
DBEF- 84 80 3010 STY INPTR+1
3020 *--------------------------------
3030 PROCESS.INPUT.ITEM
DBF1- 20 E3 DF 3040 JSR PTRGET GET ADDRESS OF VARIABLE
DBF4- 85 85 3050 STA FORPNT
DBF6- 84 86 3060 STY FORPNT+1
DBF8- A5 B8 3070 LDA TXTPTR SAVE CURRENT TXTPTR,
DBFA- A4 B9 3080 LDY TXTPTR+1 WHICH POINTS INTO PROGRAM
DBFC- 85 87 3090 STA TXPSV
DBFE- 84 88 3100 STY TXPSV+1
DC00- A6 7F 3110 LDX INPTR SET TXTPTR TO POINT AT INPUT BUFFER
DC02- A4 80 3120 LDY INPTR+1 OR "DATA" LINE
DC04- 86 B8 3130 STX TXTPTR
DC06- 84 B9 3140 STY TXTPTR+1
DC08- 20 B7 00 3150 JSR CHRGOT GET CHAR AT PNTR
DC0B- D0 1E 3160 BNE INSTART NOT END OF LINE OR COLON
DC0D- 24 15 3170 BIT INPUTFLG DOING A "GET"?
DC0F- 50 0E 3180 BVC .1 NO
DC11- 20 0C FD 3190 JSR MON.RDKEY YES, GET CHAR
DC14- 29 7F 3200 AND #$7F
DC16- 8D 00 02 3210 STA INPUT.BUFFER
DC19- A2 FF 3220 LDX #INPUT.BUFFER-1
DC1B- A0 01 3230 LDY /INPUT.BUFFER-1
DC1D- D0 08 3240 BNE .2 ...ALWAYS
3250 *--------------------------------
DC1F- 30 7F 3260 .1 BMI FINDATA DOING A "READ"
DC21- 20 5A DB 3270 JSR OUTQUES DOING AN "INPUT", PRINT "?"
DC24- 20 DC DB 3280 JSR NXIN PRINT ANOTHER "?", AND INPUT A LINE
DC27- 86 B8 3290 .2 STX TXTPTR
DC29- 84 B9 3300 STY TXTPTR+1
3310 *--------------------------------
3320 INSTART
DC2B- 20 B1 00 3330 JSR CHRGET GET NEXT INPUT CHAR
DC2E- 24 11 3340 BIT VALTYP STRING OR NUMERIC?
DC30- 10 31 3350 BPL .5 NUMERIC
DC32- 24 15 3360 BIT INPUTFLG STRING -- NOW WHAT INPUT TYPE?
DC34- 50 09 3370 BVC .1 NOT A "GET"
DC36- E8 3380 INX "GET"
DC37- 86 B8 3390 STX TXTPTR
DC39- A9 00 3400 LDA #0
DC3B- 85 0D 3410 STA CHARAC NO OTHER TERMINATORS THAN $00
DC3D- F0 0C 3420 BEQ .2 ...ALWAYS
3430 *--------------------------------
DC3F- 85 0D 3440 .1 STA CHARAC
DC41- C9 22 3450 CMP #'"' TERMINATE ON $00 OR QUOTE
DC43- F0 07 3460 BEQ .3
DC45- A9 3A 3470 LDA #':' TERMINATE ON $00, COLON, OR COMMA
DC47- 85 0D 3480 STA CHARAC
DC49- A9 2C 3490 LDA #','
DC4B- 18 3500 .2 CLC
DC4C- 85 0E 3510 .3 STA ENDCHR
DC4E- A5 B8 3520 LDA TXTPTR
DC50- A4 B9 3530 LDY TXTPTR+1
DC52- 69 00 3540 ADC #0 SKIP OVER QUOTATION MARK, IF
DC54- 90 01 3550 BCC .4 THERE WAS ONE
DC56- C8 3560 INY
DC57- 20 ED E3 3570 .4 JSR STRLT2 BUILD STRING STARTING AT (Y,A)
3580 * TERMINATED BY $00, (CHARAC), OR (ENDCHR)
DC5A- 20 3D E7 3590 JSR POINT SET TXTPTR TO POINT AT STRING
DC5D- 20 7B DA 3600 JSR PUTSTR STORE STRING IN VARIABLE
DC60- 4C 72 DC 3610 JMP INPUT.MORE
3620 *--------------------------------
DC63- 48 3630 .5 PHA
DC64- AD 00 02 3640 LDA INPUT.BUFFER ANYTHING IN BUFFER?
DC67- F0 30 3650 BEQ INPFIN NO, SEE IF READ OR INPUT
3660 *--------------------------------
3670 INPUT.DATA
DC69- 68 3680 PLA "READ"
DC6A- 20 4A EC 3690 JSR FIN GET FP NUMBER AT TXTPTR
DC6D- A5 12 3700 LDA VALTYP+1
DC6F- 20 63 DA 3710 JSR LET2 STORE RESULT IN VARIABLE
3720 *--------------------------------
3730 INPUT.MORE
DC72- 20 B7 00 3740 JSR CHRGOT
DC75- F0 07 3750 BEQ .1 END OF LINE OR COLON
DC77- C9 2C 3760 CMP #',' COMMA IN INPUT?
DC79- F0 03 3770 BEQ .1 YES
DC7B- 4C 71 DB 3780 JMP INPUTERR NOTHING ELSE WILL DO
DC7E- A5 B8 3790 .1 LDA TXTPTR SAVE POSITION IN INPUT BUFFER
DC80- A4 B9 3800 LDY TXTPTR+1
DC82- 85 7F 3810 STA INPTR
DC84- 84 80 3820 STY INPTR+1
DC86- A5 87 3830 LDA TXPSV RESTORE PROGRAM POINTER
DC88- A4 88 3840 LDY TXPSV+1
DC8A- 85 B8 3850 STA TXTPTR
DC8C- 84 B9 3860 STY TXTPTR+1
DC8E- 20 B7 00 3870 JSR CHRGOT NEXT CHAR FROM PROGRAM
DC91- F0 33 3880 BEQ INPDONE END OF STATEMENT
DC93- 20 BE DE 3890 JSR CHKCOM BETTER BE A COMMA THEN
DC96- 4C F1 DB 3900 JMP PROCESS.INPUT.ITEM
3910 *--------------------------------
DC99- A5 15 3920 INPFIN LDA INPUTFLG "INPUT" OR "READ"
DC9B- D0 CC 3930 BNE INPUT.DATA "READ"
DC9D- 4C 86 DB 3940 JMP INPERR
3950 *--------------------------------
3960 FINDATA
DCA0- 20 A3 D9 3970 JSR DATAN GET OFFSET TO NEXT COLON OR EOL
DCA3- C8 3980 INY TO FIRST CHAR OF NEXT LINE
DCA4- AA 3990 TAX WHICH: EOL OR COLON?
DCA5- D0 12 4000 BNE .1 COLON
DCA7- A2 2A 4010 LDX #ERR.NODATA EOL: MIGHT BE OUT OF DATA
DCA9- C8 4020 INY CHECK HI-BYTE OF FORWARD PNTR
DCAA- B1 B8 4030 LDA (TXTPTR),Y END OF PROGRAM?
DCAC- F0 5F 4040 BEQ GERR YES, WE ARE OUT OF DATA
DCAE- C8 4050 INY PICK UP THE LINE #
DCAF- B1 B8 4060 LDA (TXTPTR),Y
DCB1- 85 7B 4070 STA DATLIN
DCB3- C8 4080 INY
DCB4- B1 B8 4090 LDA (TXTPTR),Y
DCB6- C8 4100 INY POINT AT FIRST TEXT CHAR IN LINE
DCB7- 85 7C 4110 STA DATLIN+1
DCB9- B1 B8 4120 .1 LDA (TXTPTR),Y GET 1ST TOKEN OF STATEMENT
DCBB- AA 4130 TAX SAVE TOKEN IN X-REG
DCBC- 20 98 D9 4140 JSR ADDON ADD (Y) TO TXTPTR
DCBF- E0 83 4150 CPX #TOKEN.DATA DID WE FIND A "DATA" STATEMENT?
DCC1- D0 DD 4160 BNE FINDATA NOT YET
DCC3- 4C 2B DC 4170 JMP INSTART YES, READ IT
4180 *---NO MORE INPUT REQUESTED------
4190 INPDONE
DCC6- A5 7F 4200 LDA INPTR GET POINTER IN CASE IT WAS "READ"
DCC8- A4 80 4210 LDY INPTR+1
DCCA- A6 15 4220 LDX INPUTFLG "READ" OR "INPUT"?
DCCC- 10 03 4230 BPL .1 "INPUT"
DCCE- 4C 53 D8 4240 JMP SETDA "DATA", SO STORE (Y,X) AT DATPTR
DCD1- A0 00 4250 .1 LDY #0 "INPUT": ANY MORE CHARS ON LINE?
DCD3- B1 7F 4260 LDA (INPTR),Y
DCD5- F0 07 4270 BEQ .2 NO, ALL IS WELL
DCD7- A9 DF 4280 LDA #ERR.EXTRA YES, ERROR
DCD9- A0 DC 4290 LDY /ERR.EXTRA "EXTRA IGNORED"
DCDB- 4C 3A DB 4300 JMP STROUT
DCDE- 60 4310 .2 RTS
4320 *--------------------------------
4330 ERR.EXTRA
DCDF- 3F 45 58
DCE2- 54 52 41
DCE5- 20 49 47
DCE8- 4E 4F 52
DCEB- 45 44 4340 .AS '?EXTRA IGNORED'
DCED- 0D 00 4350 .HS 0D00
4360 ERR.REENTRY
DCEF- 3F 52 45
DCF2- 45 4E 54
DCF5- 45 52 4370 .AS '?REENTER'
DCF7- 0D 00 4380 .HS 0D00
4390 *--------------------------------
1190 .IN S.DCF9,D1
SAVE S.DCF9
1010 *--------------------------------
1020 * "NEXT" STATEMENT
1030 *--------------------------------
DCF9- D0 04 1040 NEXT BNE NEXT.1 VARIABLE AFTER "NEXT"
DCFB- A0 00 1050 LDY #0 FLAG BY SETTING FORPNT+1 = 0
DCFD- F0 03 1060 BEQ NEXT.2 ...ALWAYS
1070 *--------------------------------
DCFF- 20 E3 DF 1080 NEXT.1 JSR PTRGET GET PNTR TO VARIABLE IN (Y,A)
DD02- 85 85 1090 NEXT.2 STA FORPNT
DD04- 84 86 1100 STY FORPNT+1
DD06- 20 65 D3 1110 JSR GTFORPNT FIND FOR-FRAME FOR THIS VARIABLE
DD09- F0 04 1120 BEQ NEXT.3 FOUND IT
DD0B- A2 00 1130 LDX #ERR.NOFOR NOT THERE, ABORT
DD0D- F0 69 1140 GERR BEQ JERROR ...ALWAYS
DD0F- 9A 1150 NEXT.3 TXS SET STACK PTR TO POINT TO THIS FRAME,
DD10- E8 1160 INX WHICH TRIMS OFF ANY INNER LOOPS
DD11- E8 1170 INX
DD12- E8 1180 INX
DD13- E8 1190 INX
DD14- 8A 1200 TXA LOW BYTE OF ADRS OF STEP VALUE
DD15- E8 1210 INX
DD16- E8 1220 INX
DD17- E8 1230 INX
DD18- E8 1240 INX
DD19- E8 1250 INX
DD1A- E8 1260 INX
DD1B- 86 60 1270 STX DEST LOW BYTE ADRS OF FOR VAR VALUE
DD1D- A0 01 1280 LDY /STACK (Y,A) IS ADDRESS OF STEP VALUE
DD1F- 20 F9 EA 1290 JSR LOAD.FAC.FROM.YA STEP TO FAC
DD22- BA 1300 TSX
DD23- BD 09 01 1310 LDA STACK+9,X
DD26- 85 A2 1320 STA FAC.SIGN
DD28- A5 85 1330 LDA FORPNT
DD2A- A4 86 1340 LDY FORPNT+1
DD2C- 20 BE E7 1350 JSR FADD ADD TO FOR VALUE
DD2F- 20 27 EB 1360 JSR SETFOR PUT NEW VALUE BACK
DD32- A0 01 1370 LDY /STACK (Y,A) IS ADDRESS OF END VALUE
DD34- 20 B4 EB 1380 JSR FCOMP2 COMPARE TO END VALUE
DD37- BA 1390 TSX
DD38- 38 1400 SEC
DD39- FD 09 01 1410 SBC STACK+9,X SIGN OF STEP
DD3C- F0 17 1420 BEQ .2 BRANCH IF FOR COMPLETE
DD3E- BD 0F 01 1430 LDA STACK+15,X OTHERWISE SET UP
DD41- 85 75 1440 STA CURLIN FOR LINE #
DD43- BD 10 01 1450 LDA STACK+16,X
DD46- 85 76 1460 STA CURLIN+1
DD48- BD 12 01 1470 LDA STACK+18,X AND SET TXTPTR TO JUST
DD4B- 85 B8 1480 STA TXTPTR AFTER FOR STATEMENT
DD4D- BD 11 01 1490 LDA STACK+17,X
DD50- 85 B9 1500 STA TXTPTR+1
DD52- 4C D2 D7 1510 .1 JMP NEWSTT
DD55- 8A 1520 .2 TXA POP OFF FOR-FRAME, LOOP IS DONE
DD56- 69 11 1530 ADC #17 CARRY IS SET, SO ADDS 18
DD58- AA 1540 TAX
DD59- 9A 1550 TXS
DD5A- 20 B7 00 1560 JSR CHRGOT CHAR AFTER VARIABLE
DD5D- C9 2C 1570 CMP #',' ANOTHER VARIABLE IN NEXT?
DD5F- D0 F1 1580 BNE .1 NO, GO TO NEXT STATEMENT
DD61- 20 B1 00 1590 JSR CHRGET YES, PRIME FOR NEXT VARIABLE
DD64- 20 FF DC 1600 JSR NEXT.1 (DOES NOT RETURN)
1610 *--------------------------------
1620 * EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC
1630 *--------------------------------
DD67- 20 7B DD 1640 FRMNUM JSR FRMEVL
1650 *--------------------------------
1660 * MAKE SURE (FAC) IS NUMERIC
1670 *--------------------------------
DD6A- 18 1680 CHKNUM CLC
DD6B- 24 1690 .HS 24 DUMMY FOR SKIP
1700 *--------------------------------
1710 * MAKE SURE (FAC) IS STRING
1720 *--------------------------------
DD6C- 38 1730 CHKSTR SEC
1740 *--------------------------------
1750 * MAKE SURE (FAC) IS CORRECT TYPE
1760 * IF C=0, TYPE MUST BE NUMERIC
1770 * IF C=1, TYPE MUST BE STRING
1780 *--------------------------------
DD6D- 24 11 1790 CHKVAL BIT VALTYP $00 IF NUMERIC, $FF IF STRING
DD6F- 30 03 1800 BMI .2 TYPE IS STRING
DD71- B0 03 1810 BCS .3 NOT STRING, BUT WE NEED STRING
DD73- 60 1820 .1 RTS TYPE IS CORRECT
DD74- B0 FD 1830 .2 BCS .1 IS STRING AND WE WANTED STRING
DD76- A2 A3 1840 .3 LDX #ERR.BADTYPE TYPE MISMATCH
DD78- 4C 12 D4 1850 JERROR JMP ERROR
1210 .IN S.DD7B,D1
SAVE S.DD7B
1010 *--------------------------------
1020 * EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
1030 * RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
1040 * EXPRESSIONS.
1050 *--------------------------------
DD7B- A6 B8 1060 FRMEVL LDX TXTPTR DECREMENT TXTPTR
DD7D- D0 02 1070 BNE .1
DD7F- C6 B9 1080 DEC TXTPTR+1
DD81- C6 B8 1090 .1 DEC TXTPTR
DD83- A2 00 1100 LDX #0 START WITH PRECEDENCE = 0
DD85- 24 1110 .HS 24 TRICK TO SKIP FOLLOWING "PHA"
1120 *--------------------------------
1130 FRMEVL.1
DD86- 48 1140 PHA PUSH RELOPS FLAGS
DD87- 8A 1150 TXA
DD88- 48 1160 PHA SAVE LAST PRECEDENCE
DD89- A9 01 1170 LDA #1
DD8B- 20 D6 D3 1180 JSR CHKMEM CHECK IF ENOUGH ROOM ON STACK
DD8E- 20 60 DE 1190 JSR FRM.ELEMENT GET AN ELEMENT
DD91- A9 00 1200 LDA #0
DD93- 85 89 1210 STA CPRTYP CLEAR COMPARISON OPERATOR FLAGS
1220 *--------------------------------
1230 FRMEVL.2
DD95- 20 B7 00 1240 JSR CHRGOT CHECK FOR RELATIONAL OPERATORS
DD98- 38 1250 .1 SEC > IS $CF, = IS $D0, < IS $D1
DD99- E9 CF 1260 SBC #TOKEN.GREATER > IS 0, = IS 1, < IS 2
DD9B- 90 17 1270 BCC .2 NOT RELATIONAL OPERATOR
DD9D- C9 03 1280 CMP #3
DD9F- B0 13 1290 BCS .2 NOT RELATIONAL OPERATOR
DDA1- C9 01 1300 CMP #1 SET CARRY IF "=" OR "<"
DDA3- 2A 1310 ROL NOW > IS 0, = IS 3, < IS 5
DDA4- 49 01 1320 EOR #1 NOW > IS 1, = IS 2, < IS 4
DDA6- 45 89 1330 EOR CPRTYP SET BITS OF CPRTYP: 00000<=>
DDA8- C5 89 1340 CMP CPRTYP CHECK FOR ILLEGAL COMBINATIONS
DDAA- 90 61 1350 BCC SNTXERR IF LESS THAN, A RELOP WAS REPEATED
DDAC- 85 89 1360 STA CPRTYP
DDAE- 20 B1 00 1370 JSR CHRGET ANOTHER OPERATOR?
DDB1- 4C 98 DD 1380 JMP .1 CHECK FOR <,=,> AGAIN
1390 *--------------------------------
DDB4- A6 89 1400 .2 LDX CPRTYP DID WE FIND A RELATIONAL OPERATOR?
DDB6- D0 2C 1410 BNE FRM.RELATIONAL YES
DDB8- B0 7B 1420 BCS NOTMATH NO, AND NEXT TOKEN IS > $D1
DDBA- 69 07 1430 ADC #$CF-TOKEN.PLUS NO, AND NEXT TOKEN < $CF
DDBC- 90 77 1440 BCC NOTMATH IF NEXT TOKEN < "+"
DDBE- 65 11 1450 ADC VALTYP + AND LAST RESULT A STRING?
DDC0- D0 03 1460 BNE .3 BRANCH IF NOT
DDC2- 4C 97 E5 1470 JMP CAT CONCATENATE IF SO.
1480 *--------------------------------
DDC5- 69 FF 1490 .3 ADC #$FF +-*/ IS 0123
DDC7- 85 5E 1500 STA INDEX
DDC9- 0A 1510 ASL MULTIPLY BY 3
DDCA- 65 5E 1520 ADC INDEX +-*/ IS 0,3,6,9
DDCC- A8 1530 TAY
1540 *--------------------------------
1550 FRM.PRECEDENCE.TEST
DDCD- 68 1560 PLA GET LAST PRECEDENCE
DDCE- D9 B2 D0 1570 CMP MATHTBL,Y
DDD1- B0 67 1580 BCS FRM.PERFORM.1 DO NOW IF HIGHER PRECEDENCE
DDD3- 20 6A DD 1590 JSR CHKNUM WAS LAST RESULT A #?
DDD6- 48 1600 NXOP PHA YES, SAVE PRECEDENCE ON STACK
DDD7- 20 FD DD 1610 SAVOP JSR FRM.RECURSE SAVE REST, CALL FRMEVL RECURSIVELY
DDDA- 68 1620 PLA
DDDB- A4 87 1630 LDY LASTOP
DDDD- 10 17 1640 BPL PREFNC
DDDF- AA 1650 TAX
DDE0- F0 56 1660 BEQ GOEX EXIT IF NO MATH IN EXPRESSION
DDE2- D0 5F 1670 BNE FRM.PERFORM.2 ...ALWAYS
1680 *--------------------------------
1690 * FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
1700 *--------------------------------
1710 FRM.RELATIONAL
DDE4- 46 11 1720 LSR VALTYP (VALTYP) = 0 (NUMERIC), = $FF (STRING)
DDE6- 8A 1730 TXA SET CPRTYP TO 0000<=>C
DDE7- 2A 1740 ROL WHERE C=0 IF #, C=1 IF STRING
DDE8- A6 B8 1750 LDX TXTPTR BACK UP TXTPTR
DDEA- D0 02 1760 BNE .1
DDEC- C6 B9 1770 DEC TXTPTR+1
DDEE- C6 B8 1780 .1 DEC TXTPTR
DDF0- A0 1B 1790 LDY #M.REL-MATHTBL POINT AT RELOPS ENTRY
DDF2- 85 89 1800 STA CPRTYP
DDF4- D0 D7 1810 BNE FRM.PRECEDENCE.TEST ...ALWAYS
1820 *--------------------------------
DDF6- D9 B2 D0 1830 PREFNC CMP MATHTBL,Y
DDF9- B0 48 1840 BCS FRM.PERFORM.2 DO NOW IF HIGHER PRECEDENCE
DDFB- 90 D9 1850 BCC NXOP ...ALWAYS
1860 *--------------------------------
1870 * STACK THIS OPERATION AND CALL FRMEVL FOR
1880 * ANOTHER ONE
1890 *--------------------------------
1900 FRM.RECURSE
DDFD- B9 B4 D0 1910 LDA MATHTBL+2,Y
DE00- 48 1920 PHA PUSH ADDRESS OF OPERATION PERFORMER
DE01- B9 B3 D0 1930 LDA MATHTBL+1,Y
DE04- 48 1940 PHA
DE05- 20 10 DE 1950 JSR FRM.STACK.1 STACK FAC.SIGN AND FAC
DE08- A5 89 1960 LDA CPRTYP A=RELOP FLAGS, X=PRECEDENCE BYTE
DE0A- 4C 86 DD 1970 JMP FRMEVL.1 RECURSIVELY CALL FRMEVL
1980 *--------------------------------
DE0D- 4C C9 DE 1990 SNTXERR JMP SYNERR
2000 *--------------------------------
2010 * STACK (FAC)
2020 *
2030 * THREE ENTRY POINTS:
2040 * .1, FROM FRMEVL
2050 * .2, FROM "STEP"
2060 * .3, FROM "FOR"
2070 *--------------------------------
2080 FRM.STACK.1
DE10- A5 A2 2090 LDA FAC.SIGN GET FAC.SIGN TO PUSH IT
DE12- BE B2 D0 2100 LDX MATHTBL,Y PRECEDENCE BYTE FROM MATHTBL
2110 *--------------------------------
2120 * ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
2130 *--------------------------------
2140 FRM.STACK.2
DE15- A8 2150 TAY FAC.SIGN OR SGN(STEP VALUE)
DE16- 68 2160 PLA PULL RETURN ADDRESS AND ADD 1
DE17- 85 5E 2170 STA INDEX <<< ASSUMES NOT ON PAGE BOUNDARY! >>>
DE19- E6 5E 2180 INC INDEX PLACE BUMPED RETURN ADDRESS IN
DE1B- 68 2190 PLA INDEX,INDEX+1
DE1C- 85 5F 2200 STA INDEX+1
DE1E- 98 2210 TYA FAC.SIGN OR SGN(STEP VALUE)
DE1F- 48 2220 PHA PUSH FAC.SIGN OR SGN(STEP VALUE)
2230 *--------------------------------
2240 * ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
2250 * TO PUSH INITIAL VALUE OF "FOR" VARIABLE
2260 *--------------------------------
2270 FRM.STACK.3
DE20- 20 72 EB 2280 JSR ROUND.FAC ROUND TO 32 BITS
DE23- A5 A1 2290 LDA FAC+4 PUSH (FAC)
DE25- 48 2300 PHA
DE26- A5 A0 2310 LDA FAC+3
DE28- 48 2320 PHA
DE29- A5 9F 2330 LDA FAC+2
DE2B- 48 2340 PHA
DE2C- A5 9E 2350 LDA FAC+1
DE2E- 48 2360 PHA
DE2F- A5 9D 2370 LDA FAC
DE31- 48 2380 PHA
DE32- 6C 5E 00 2390 JMP (INDEX) DO RTS FUNNY WAY
2400 *--------------------------------
2410 *
2420 *--------------------------------
DE35- A0 FF 2430 NOTMATH LDY #$FF SET UP TO EXIT ROUTINE
DE37- 68 2440 PLA
DE38- F0 23 2450 GOEX BEQ EXIT EXIT IF NO MATH TO DO
2460 *--------------------------------
2470 * PERFORM STACKED OPERATION
2480 *
2490 * (A) = PRECEDENCE BYTE
2500 * STACK: 1 -- CPRMASK
2510 * 5 -- (ARG)
2520 * 2 -- ADDR OF PERFORMER
2530 *--------------------------------
2540 FRM.PERFORM.1
DE3A- C9 64 2550 CMP #P.REL WAS IT RELATIONAL OPERATOR?
DE3C- F0 03 2560 BEQ .1 YES, ALLOW STRING COMPARE
DE3E- 20 6A DD 2570 JSR CHKNUM MUST BE NUMERIC VALUE
DE41- 84 87 2580 .1 STY LASTOP
2590 *--------------------------------
2600 FRM.PERFORM.2
DE43- 68 2610 PLA GET 0000<=>C FROM STACK
DE44- 4A 2620 LSR SHIFT TO 00000<=> FORM
DE45- 85 16 2630 STA CPRMASK 00000<=>
DE47- 68 2640 PLA
DE48- 85 A5 2650 STA ARG GET FLOATING POINT VALUE OFF STACK,
DE4A- 68 2660 PLA AND PUT IT IN ARG
DE4B- 85 A6 2670 STA ARG+1
DE4D- 68 2680 PLA
DE4E- 85 A7 2690 STA ARG+2
DE50- 68 2700 PLA
DE51- 85 A8 2710 STA ARG+3
DE53- 68 2720 PLA
DE54- 85 A9 2730 STA ARG+4
DE56- 68 2740 PLA
DE57- 85 AA 2750 STA ARG+5
DE59- 45 A2 2760 EOR FAC.SIGN SAVE EOR OF SIGNS OF THE OPERANDS,
DE5B- 85 AB 2770 STA SGNCPR IN CASE OF MULTIPLY OR DIVIDE
DE5D- A5 9D 2780 EXIT LDA FAC FAC EXPONENT IN A-REG
DE5F- 60 2790 RTS STATUS .EQ. IF (FAC)=0
2800 * RTS GOES TO PERFORM OPERATION
2810 *--------------------------------
2820 * GET ELEMENT IN EXPRESSION
2830 *
2840 * GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
2850 * TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
2860 *--------------------------------
2870 FRM.ELEMENT
DE60- A9 00 2880 LDA #0 ASSUME NUMERIC
DE62- 85 11 2890 STA VALTYP
DE64- 20 B1 00 2900 .1 JSR CHRGET
DE67- B0 03 2910 BCS .3 NOT A DIGIT
DE69- 4C 4A EC 2920 .2 JMP FIN NUMERIC CONSTANT
DE6C- 20 7D E0 2930 .3 JSR ISLETC VARIABLE NAME?
DE6F- B0 64 2940 BCS FRM.VARIABLE YES
DE71- C9 2E 2950 CMP #'.' DECIMAL POINT
DE73- F0 F4 2960 BEQ .2 YES, NUMERIC CONSTANT
DE75- C9 C9 2970 CMP #TOKEN.MINUS UNARY MINUS?
DE77- F0 55 2980 BEQ MIN YES
DE79- C9 C8 2990 CMP #TOKEN.PLUS UNARY PLUS
DE7B- F0 E7 3000 BEQ .1 YES
DE7D- C9 22 3010 CMP #'"' STRING CONSTANT?
DE7F- D0 0F 3020 BNE NOT. NO
3030 *--------------------------------
3040 * STRING CONSTANT ELEMENT
3050 *
3060 * SET Y,A = (TXTPTR)+CARRY
3070 *--------------------------------
DE81- A5 B8 3080 STRTXT LDA TXTPTR ADD (CARRY) TO GET ADDRESS OF 1ST CHAR
DE83- A4 B9 3090 LDY TXTPTR+1 OF STRING IN Y,A
DE85- 69 00 3100 ADC #0
DE87- 90 01 3110 BCC .1
DE89- C8 3120 INY
DE8A- 20 E7 E3 3130 .1 JSR STRLIT BUILD DESCRIPTOR TO STRING
3140 * GET ADDRESS OF DESCRIPTOR IN FAC
DE8D- 4C 3D E7 3150 JMP POINT POINT TXTPTR AFTER TRAILING QUOTE
3160 *--------------------------------
3170 * "NOT" FUNCTION
3180 * IF FAC=0, RETURN FAC=1
3190 * IF FAC<>0, RETURN FAC=0
3200 *--------------------------------
DE90- C9 C6 3210 NOT. CMP #TOKEN.NOT
DE92- D0 10 3220 BNE FN. NOT "NOT", TRY "FN"
DE94- A0 18 3230 LDY #M.EQU-MATHTBL POINT AT = COMPARISON
DE96- D0 38 3240 BNE EQUL ...ALWAYS
3250 *--------------------------------
3260 * COMPARISON FOR EQUALITY (= OPERATOR)
3270 * ALSO USED TO EVALUATE "NOT" FUNCTION
3280 *--------------------------------
DE98- A5 9D 3290 EQUOP LDA FAC SET "TRUE" IF (FAC) = ZERO
DE9A- D0 03 3300 BNE .1 FALSE
DE9C- A0 01 3310 LDY #1 TRUE
DE9E- 2C 3320 .HS 2C TRICK TO SKIP NEXT 2 BYTES
DE9F- A0 00 3330 .1 LDY #0 FALSE
DEA1- 4C 01 E3 3340 JMP SNGFLT
3350 *--------------------------------
DEA4- C9 C2 3360 FN. CMP #TOKEN.FN
DEA6- D0 03 3370 BNE SGN.
DEA8- 4C 54 E3 3380 JMP FUNCT
3390 *--------------------------------
DEAB- C9 D2 3400 SGN. CMP #TOKEN.SGN
DEAD- 90 03 3410 BCC PARCHK
DEAF- 4C 0C DF 3420 JMP UNARY
3430 *--------------------------------
3440 * EVALUATE "(EXPRESSION)"
3450 *--------------------------------
DEB2- 20 BB DE 3460 PARCHK JSR CHKOPN IS THERE A '(' AT TXTPTR?
DEB5- 20 7B DD 3470 JSR FRMEVL YES, EVALUATE EXPRESSION
3480 *--------------------------------
DEB8- A9 29 3490 CHKCLS LDA #')' CHECK FOR ')'
DEBA- 2C 3500 .HS 2C TRICK
3510 *--------------------------------
DEBB- A9 28 3520 CHKOPN LDA #'('
DEBD- 2C 3530 .HS 2C TRICK
3540 *--------------------------------
DEBE- A9 2C 3550 CHKCOM LDA #',' COMMA AT TXTPTR?
3560 *--------------------------------
3570 * UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
3580 *--------------------------------
DEC0- A0 00 3590 SYNCHR LDY #0
DEC2- D1 B8 3600 CMP (TXTPTR),Y
DEC4- D0 03 3610 BNE SYNERR
DEC6- 4C B1 00 3620 JMP CHRGET MATCH, GET NEXT CHAR & RETURN
3630 *--------------------------------
DEC9- A2 10 3640 SYNERR LDX #ERR.SYNTAX
DECB- 4C 12 D4 3650 JMP ERROR
3660 *--------------------------------
DECE- A0 15 3670 MIN LDY #M.NEG-MATHTBL POINT AT UNARY MINUS
DED0- 68 3680 EQUL PLA
DED1- 68 3690 PLA
DED2- 4C D7 DD 3700 JMP SAVOP
3710 *--------------------------------
3720 FRM.VARIABLE
DED5- 20 E3 DF 3730 JSR PTRGET
DED7- 3740 FRM.VARIABLE.CALL .EQ *-1 SO PTRGET CAN TELL WE CALLED
DED8- 85 A0 3750 STA VPNT ADDRESS OF VARIABLE
DEDA- 84 A1 3760 STY VPNT+1
DEDC- A6 11 3770 LDX VALTYP NUMERIC OR STRING?
DEDE- F0 05 3780 BEQ .1 NUMERIC
DEE0- A2 00 3790 LDX #0 STRING
DEE2- 86 AC 3800 STX STRNG1+1
DEE4- 60 3810 RTS
DEE5- A6 12 3820 .1 LDX VALTYP+1 NUMERIC, WHICH TYPE?
DEE7- 10 0D 3830 BPL .2 FLOATING POINT
DEE9- A0 00 3840 LDY #0 INTEGER
DEEB- B1 A0 3850 LDA (VPNT),Y
DEED- AA 3860 TAX GET VALUE IN A,Y
DEEE- C8 3870 INY
DEEF- B1 A0 3880 LDA (VPNT),Y
DEF1- A8 3890 TAY
DEF2- 8A 3900 TXA
DEF3- 4C F2 E2 3910 JMP GIVAYF CONVERT A,Y TO FLOATING POINT
DEF6- 4C F9 EA 3920 .2 JMP LOAD.FAC.FROM.YA
3930 *--------------------------------
1230 .IN S.DEF9,D1
SAVE S.DEF9
1010 *--------------------------------
1020 * "SCRN(" FUNCTION
1030 *--------------------------------
DEF9- 20 B1 00 1040 SCREEN JSR CHRGET
DEFC- 20 EC F1 1050 JSR PLOTFNS GET COLUMN AND ROW
DEFF- 8A 1060 TXA ROW
DF00- A4 F0 1070 LDY FIRST COLUMN
DF02- 20 71 F8 1080 JSR MON.SCRN GET 4-BIT COLOR THERE
DF05- A8 1090 TAY
DF06- 20 01 E3 1100 JSR SNGFLT CONVERT (Y) TO REAL IN FAC
DF09- 4C B8 DE 1110 JMP CHKCLS REQUIRE ")"
1120 *--------------------------------
1130 * PROCESS UNARY OPERATORS (FUNCTIONS)
1140 *--------------------------------
DF0C- C9 D7 1150 UNARY CMP #TOKEN.SCRN NOT UNARY, DO SPECIAL
DF0E- F0 E9 1160 BEQ SCREEN
DF10- 0A 1170 ASL DOUBLE TOKEN TO GET INDEX
DF11- 48 1180 PHA
DF12- AA 1190 TAX
DF13- 20 B1 00 1200 JSR CHRGET
DF16- E0 CF 1210 CPX #TOKEN.LEFTSTR*2-1 LEFT$, RIGHT$, AND MID$
DF18- 90 20 1220 BCC .1 NOT ONE OF THE STRING FUNCTIONS
DF1A- 20 BB DE 1230 JSR CHKOPN STRING FUNCTION, NEED "("
DF1D- 20 7B DD 1240 JSR FRMEVL EVALUATE EXPRESSION FOR STRING
DF20- 20 BE DE 1250 JSR CHKCOM REQUIRE A COMMA
DF23- 20 6C DD 1260 JSR CHKSTR MAKE SURE EXPRESSION IS A STRING
DF26- 68 1270 PLA
DF27- AA 1280 TAX RETRIEVE ROUTINE POINTER
DF28- A5 A1 1290 LDA VPNT+1 STACK ADDRESS OF STRING
DF2A- 48 1300 PHA
DF2B- A5 A0 1310 LDA VPNT
DF2D- 48 1320 PHA
DF2E- 8A 1330 TXA
DF2F- 48 1340 PHA STACK DOUBLED TOKEN
DF30- 20 F8 E6 1350 JSR GETBYT CONVERT NEXT EXPRESSION TO BYTE IN X-REG
DF33- 68 1360 PLA GET DOUBLED TOKEN OFF STACK
DF34- A8 1370 TAY USE AS INDEX TO BRANCH
DF35- 8A 1380 TXA VALUE OF SECOND PARAMETER
DF36- 48 1390 PHA PUSH 2ND PARAM
DF37- 4C 3F DF 1400 JMP .2 JOIN UNARY FUNCTIONS
DF3A- 20 B2 DE 1410 .1 JSR PARCHK REQUIRE "(EXPRESSION)"
DF3D- 68 1420 PLA
DF3E- A8 1430 TAY INDEX INTO FUNCTION ADDRESS TABLE
DF3F- B9 DC CF 1440 .2 LDA UNFNC-TOKEN.SGN-TOKEN.SGN+$100,Y
DF42- 85 91 1450 STA JMPADRS+1 PREPARE TO JSR TO ADDRESS
DF44- B9 DD CF 1460 LDA UNFNC-TOKEN.SGN-TOKEN.SGN+$101,Y
DF47- 85 92 1470 STA JMPADRS+2
DF49- 20 90 00 1480 JSR JMPADRS DOES NOT RETURN FOR
1490 * CHR$, LEFT$, RIGHT$, OR MID$
DF4C- 4C 6A DD 1500 JMP CHKNUM REQUIRE NUMERIC RESULT
1510 *--------------------------------
DF4F- A5 A5 1520 OR LDA ARG "OR" OPERATOR
DF51- 05 9D 1530 ORA FAC IF RESULT NONZERO, IT IS TRUE
DF53- D0 0B 1540