Apple-2-Tools/Steve2
1
0
Fork 0
mirror of https://github.com/trudnai/Steve2.git synced 2024-12-12 01:29:51 +00:00
Code Issues Projects Releases Wiki Activity
8a6f1654ee
Steve2/Apple_II_ROM.s
Tamas Rudnai 8a6f1654ee Refactoring instruction handler in switch 
Fixed some issues
2019-09-11 00:11:45 -07:00

6915 lines
282 KiB
ArmAsm
Raw Blame History

include(`asm.m4h')
; --------------------------------
;
; Applesoft BASIC, V2
;
; Written by Marc McDonald and Randy Wigginton.
;
; Original copyright 1976 by Microsoft,
; 1977 by Apple Computer.
;
; Disassembled by (unknown).
; Fixed by Chris Mosher.
;
; For the cc65.org Assembler (ca65)
;
; Applesoft BASIC was first written by
; Marc McDonald, the first employee of Microsoft,
; in mid-1976. That version was bought by Apple
; and released (on casette) in Nov. 1977.
;
; Version 2 was written by Randy Wigginton and
; others at Apple in spring 1978. This version
; was released in several different forms. The
; one reproduced by this source assembly file is
; the main-board ROM form, which appeared in the
; Apple ][ plus ROM at $D000-$F7FF.
;
; --------------------------------
; --------------------------------
; ZERO PAGE LOCATIONS:
; --------------------------------
GOWARM = $00 ; GETS "JMP RESTART"
GOSTROUT = $03 ; GETS "JMP STROUT"
USR = $0A ; GETS "JMP <USER ADDR>"
; (INITIALLY $E199)
CHARAC = $0D ; ALTERNATE STRING TERMINATOR
ENDCHR = $0E ; STRING TERMINATOR
TKN_CNTR = $0F ; USED IN PARSE
EOL_PNTR = $0F ; USED IN NXLIN
NUMDIM = $0F ; USED IN ARRAY ROUTINES
DIMFLG = $10 ;
VALTYP = $11 ; $:VALTYP=$FF; %:VALTYP+1=$80
DATAFLG = $13 ; USED IN PARSE
GARFLG = $13 ; USED IN GARBAG
SUBFLG = $14 ;
INPUTFLG = $15 ; = $40 FOR GET, $98 FOR READ
CPRMASK = $16 ; RECEIVES CPRTYP IN FRMEVL
SIGNFLG = $16 ; FLAGS SIGN IN TAN
HGR_SHAPE = $1A ;
HGR_BITS = $1C ;
HGR_COUNT = $1D ;
MON_CH = $24 ;
MON_GBASL = $26 ;
MON_GBASH = $27 ;
MON_H2 = $2C ;
MON_V2 = $2D ;
MON_HMASK = $30 ;
MON_INVFLG = $32 ;
MON_PROMPT = $33 ;
MON_A1L = $3C ; USED BY TAPE I/O ROUTINES
MON_A1H = $3D ; "
MON_A2L = $3E ; "
MON_A2H = $3F ; "
LINNUM = $50 ; CONVERTED LINE #
TEMPPT = $52 ; LAST USED TEMP STRING DESC
LASTPT = $53 ; LAST USED TEMP STRING PNTR
TEMPST = $55 ; HOLDS UP TO 3 DESCRIPTORS
INDEX = $5E ;
DEST = $60 ;
RESULT = $62 ; RESULT OF LAST * OR /
TXTTAB = $67 ; START OF PROGRAM TEXT
VARTAB = $69 ; START OF VARIABLE STORAGE
ARYTAB = $6B ; START OF ARRAY STORAGE
STREND = $6D ; END OF ARRAY STORAGE
FRETOP = $6F ; START OF STRING STORAGE
FRESPC = $71 ; TEMP PNTR, STRING ROUTINES
MEMSIZ = $73 ; END OF STRING SPACE (HIMEM)
CURLIN = $75 ; CURRENT LINE NUMBER
; ( = $FFXX IF IN DIRECT MODE)
OLDLIN = $77 ; ADDR. OF LAST LINE EXECUTED
OLDTEXT = $79 ;
DATLIN = $7B ; LINE # OF CURRENT DATA STT.
DATPTR = $7D ; ADDR OF CURRENT DATA STT.
INPTR = $7F ;
VARNAM = $81 ; NAME OF VARIABLE
VARPNT = $83 ; ADDR OF VARIABLE
FORPNT = $85 ;
TXPSV = $87 ; USED IN INPUT
LASTOP = $87 ; SCRATCH FLAG USED IN FRMEVL
CPRTYP = $89 ; >,=,< FLAG IN FRMEVL
TEMP3 = $8A ;
FNCNAM = $8A ;
DSCPTR = $8C ;
DSCLEN = $8F ; USED IN GARBAG
JMPADRS = $90 ; GETS "JMP ...."
LENGTH = $91 ; USED IN GARBAG
ARG_EXTENSION = $92 ; FP EXTRA PRECISION
TEMP1 = $93 ; SAVE AREAS FOR FAC
ARYPNT = $94 ; USED IN GARBAG
HIGHDS = $94 ; PNTR FOR BLTU
HIGHTR = $96 ; PNTR FOR BLTU
TEMP2 = $98 ;
TMPEXP = $99 ; USED IN FIN (EVAL)
INDX = $99 ; USED BY ARRAY RTNS
EXPON = $9A ; "
DPFLG = $9B ; FLAGS DEC PNT IN FIN
LOWTR = $9B ;
EXPSGN = $9C ;
FAC = $9D ; MAIN FLT PT ACCUMULATOR
DSCTMP = $9D ;
VPNT = $A0 ; TEMP VAR PTR
FAC_SIGN = $A2 ; HOLDS UNPACKED SIGN
SERLEN = $A3 ; HOLDS LENGTH OF SERIES-1
SHIFT_SIGN_EXT = $A4 ; SIGN EXTENSION, RIGHT SHIFTS
ARG = $A5 ; SECONDARY FP ACC
ARG_SIGN = $AA ;
SGNCPR = $AB ; FLAGS OPP SIGN IN FP ROUT.
FAC_EXTENSION = $AC ; FAC EXTENSION BYTE
SERPNT = $AD ; PNTR TO SERIES DATA IN FP
STRNG1 = $AB ;
STRNG2 = $AD ;
PRGEND = $AF ;
CHRGET = $B1 ;
CHRGOT = $B7 ;
TXTPTR = $B8 ;
RNDSEED = $C9 ;
HGR_DX = $D0 ;
HGR_DY = $D2 ;
HGR_QUADRANT = $D3 ;
HGR_E = $D4 ;
LOCK = $D6 ; NO USER ACCESS IF > 127
ERRFLG = $D8 ; $80 IF ON ERR ACTIVE
ERRLIN = $DA ; LINE # WHERE ERROR OCCURRED
ERRPOS = $DC ; TXTPTR SAVE FOR HANDLERR
ERRNUM = $DE ; WHICH ERROR OCCURRED
ERRSTK = $DF ; STACK PNTR BEFORE ERROR
HGR_X = $E0 ;
HGR_Y = $E2 ;
HGR_COLOR = $E4 ;
HGR_HORIZ = $E5 ; BYTE INDEX FROM GBASH,L
HGR_PAGE = $E6 ; HGR=$20, HGR2=$40
HGR_SCALE = $E7 ;
HGR_SHAPE_PNTR = $E8 ;
HGR_COLLISIONS = $EA ;
FIRST = $F0 ;
SPEEDZ = $F1 ; OUTPUT SPEED
TRCFLG = $F2 ;
FLASH_BIT = $F3 ; = $40 FOR FLASH, ELSE =$00
TXTPSV = $F4 ;
CURLSV = $F6 ;
REMSTK = $F8 ; STACK PNTR BEFORE EACH STT.
HGR_ROTATION = $F9 ;
; $FF IS ALSO USED BY THE STRING OUT ROUTINES
; --------------------------------
STACK = $0100
INPUT_BUFFER = $0200
AMPERSAND_VECTOR = $03F5 ; - 3F7 GETS "JMP ...."
; --------------------------------
; I/O & SOFT SWITCHES
; --------------------------------
KEYBOARD = $C000
SW_TXTCLR = $C050
SW_MIXCLR = $C052
SW_MIXSET = $C053
SW_LOWSCR = $C054
SW_HISCR = $C055
SW_LORES = $C056
SW_HIRES = $C057
; --------------------------------
; MONITOR SUBROUTINES
; --------------------------------
MON_PLOT = $F800
MON_HLINE = $F819
MON_VLINE = $F828
MON_SETCOL = $F864
MON_SCRN = $F871
MON_PREAD = $FB1E
MON_SETTXT = $FB39
MON_SETGR = $FB40
MON_TABV = $FB5B
MON_HOME = $FC58
MON_WAIT = $FCA8
MON_RD2BIT = $FCFA
MON_RDKEY = $FD0C
MON_GETLN = $FD6A
MON_COUT = $FDED
MON_INPORT = $FE8B
MON_OUTPORT = $FE95
MON_WRITE = $FECD
MON_READ = $FEFD
MON_READ2 = $FF02
; --------------------------------
; --------------------------------
; APPLESOFT TOKENS
; --------------------------------
TOKEN_FOR = $81
TOKENDWTA = $83
TOKEN_POP = $A1
TOKEN_GOTO = $AB
TOKEN_GOSUB = $B0
TOKEN_REM = $B2
TOKEN_PRINT = $BA
TOKEN_TAB = $C0
TOKEN_TO = $C1
TOKEN_FN = $C2
TOKEN_SPC = $C3
TOKEN_THEN = $C4
TOKENDB = $C5
TOKEN_NOT = $C6
TOKEN_STEP = $C7
TOKEN_PLUS = $C8
TOKEN_MINUS = $C9
TOKEN_GREATER = $CF
TOKENEQUUAL = $D0
TOKEN_SGN = $D2
TOKEN_SCRN = $D7
TOKEN_LEFTSTR = $E8
; --------------------------------
; BRANCH TABLE FOR TOKENS
; --------------------------------
TOKEN_ADDRESS_TABLE ASM_ADDR(`ENDX-1') ; $80...128...END
ASM_ADDR(`FOR-1') ; $81...129...FOR
ASM_ADDR(`NEXT-1') ; $82...130...NEXT
ASM_ADDR(`DATA-1') ; $83...131..DWTA
ASM_ADDR(`INPUT-1') ; $84...132...INPUT
ASM_ADDR(`DEL-1') ; $85...133...DEL
ASM_ADDR(`DIM-1') ; $86...134...DIM
ASM_ADDR(`READ-1') ; $87...135...READ
ASM_ADDR(`GR-1') ; $88...136...GR
ASM_ADDR(`TEXT-1') ; $89...137...TEXT
ASM_ADDR(`PR_NUMBER-1') ; $8A...138...PR#
ASM_ADDR(`IN_NUMBER-1') ; $8B...139...IN#
ASM_ADDR(`CALL-1') ; $8C...140...CALL
ASM_ADDR(`PLOT-1') ; $8D...141...PLOT
ASM_ADDR(`HLIN-1') ; $8E...142...HLIN
ASM_ADDR(`VLIN-1') ; $8F...143...VLIN
ASM_ADDR(`HGR2-1') ; $90...144...HGR2
ASM_ADDR(`HGR-1') ; $91...145...HGR
ASM_ADDR(`HCOLOR-1') ; $92...146...HCOLOR=
ASM_ADDR(`HPLOT-1') ; $93...147...HPLOT
ASM_ADDR(`DRAW-1') ; $94...148...DRAW
ASM_ADDR(`XDRAW-1') ; $95...149...XDRAW
ASM_ADDR(`HTAB-1') ; $96...150...HTAB
ASM_ADDR(`MON_HOME-1') ; $97...151...HOME
ASM_ADDR(`ROT-1') ; $98...152...ROT=
ASM_ADDR(`SCALE-1') ; $99...153...SCALE=
ASM_ADDR(`SHLOAD-1') ; $9A...154...SHLOAD
ASM_ADDR(`TRACE-1') ; $9B...155...TRACE
ASM_ADDR(`NOTRACE-1') ; $9C...156...NOTRACE
ASM_ADDR(`NORMAL-1') ; $9D...157...NORMAL
ASM_ADDR(`INVERSE-1') ; $9E...158...INVERSE
ASM_ADDR(`FLASH-1') ; $9F...159...FLASH
ASM_ADDR(`COLOR-1') ; $A0...160...COLOR=
ASM_ADDR(`POP-1') ; $A1...161...POP
ASM_ADDR(`VTAB-1') ; $A2...162...VTAB
ASM_ADDR(`HIMEM-1') ; $A3...163...HIMEM:
ASM_ADDR(`LOMEM-1') ; $A4...164...LOMEM:
ASM_ADDR(`ONERR-1') ; $A5...165...ONERR
ASM_ADDR(`RESUME-1') ; $A6...166...RESUME
ASM_ADDR(`RECALL-1') ; $A7...167...RECALL
ASM_ADDR(`STORE-1') ; $A8...168...STORE
ASM_ADDR(`SPEED-1') ; $A9...169...SPEED=
ASM_ADDR(`LET-1') ; $AA...170...LET
ASM_ADDR(`GOTO-1') ; $AB...171...GOTO
ASM_ADDR(`RUN-1') ; $AC...172...RUN
ASM_ADDR(`IF-1') ; $AD...173...IF
ASM_ADDR(`RESTORE-1') ; $AE...174...RESTORE
ASM_ADDR(`AMPERSAND_VECTOR-1') ; $AF...175...&
ASM_ADDR(`GOSUB-1') ; $B0...176...GOSUB
ASM_ADDR(`POP-1') ; $B1...177...RETURN
ASM_ADDR(`REM-1') ; $B2...178...REM
ASM_ADDR(`STOP-1') ; $B3...179...STOP
ASM_ADDR(`ONGOTO-1') ; $B4...180...ON
ASM_ADDR(`WAIT-1') ; $B5...181...WAIT
ASM_ADDR(`LOAD-1') ; $B6...182...LOAD
ASM_ADDR(`SAVE-1') ; $B7...183...SAVE
ASM_ADDR(`DEF-1') ; $B8...184...DEF
ASM_ADDR(`POKE-1') ; $B9...185...POKE
ASM_ADDR(`PRINT-1') ; $BA...186...PRINT
ASM_ADDR(`CONT-1') ; $BB...187...CONT
ASM_ADDR(`LIST-1') ; $BC...188...LIST
ASM_ADDR(`CLEAR-1') ; $BD...189...CLEAR
ASM_ADDR(`GET-1') ; $BE...190...GET
ASM_ADDR(`NEW-1') ; $BF...191...NEW
; --------------------------------
UNFNC ASM_ADDR(`SGN') ; $D2...210...SGN
ASM_ADDR(`INT') ; $D3...211...INT
ASM_ADDR(`ABS') ; $D4...212...ABS
ASM_ADDR(`USR') ; $D5...213...USR
ASM_ADDR(`FRE') ; $D6...214...FRE
ASM_ADDR(`ERROR') ; $D7...215...SCRN(
ASM_ADDR(`PDL') ; $D8...216...PDL
ASM_ADDR(`POS') ; $D9...217...POS
ASM_ADDR(`SQR') ; $DA...218...SQR
ASM_ADDR(`RND') ; $DB...219...RND
ASM_ADDR(`LOG') ; $DC...220...LOG
ASM_ADDR(`EXP') ; $DD...221...EXP
ASM_ADDR(`COS') ; $DE...222...COS
ASM_ADDR(`SIN') ; $DF...223...SIN
ASM_ADDR(`TAN') ; $E0...224...TAN
ASM_ADDR(`ATN') ; $E1...225...ATN
ASM_ADDR(`PEEK') ; $E2...226...PEEK
ASM_ADDR(`LEN') ; $E3...227...LEN
ASM_ADDR(`STR') ; $E4...228...STR$
ASM_ADDR(`VAL') ; $E5...229...VAL
ASM_ADDR(`ASC') ; $E6...230...ASC
ASM_ADDR(`CHRSTR') ; $E7...231...CHR$
ASM_ADDR(`LEFTSTR') ; $E8...232...LEFT$
ASM_ADDR(`RIGHTSTR') ; $E9...233...RIGHT$
ASM_ADDR(`MIDSTR') ; $EA...234...MID$
; --------------------------------
; MATH OPERATOR BRANCH TABLE
;
; ONE-BYTE PRECEDENCE CODE
; TWO-BYTE ADDRESS
; --------------------------------
P_OR = $46 ; "OR" IS LOWEST PRECEDENCE
P_AND = $50 ;
P_REL = $64 ; RELATIONAL OPERATORS
P_ADD = $79 ; BINARY + AND -
P_MUL = $7B ; * AND /
P_PWR = $7D ; EXPONENTIATION
P_NEQ = $7F ; UNARY - AND COMPARISON =
; --------------------------------
MATHTBL ASM_DATA(`P_ADD')
ASM_ADDR(`FADDT-1') ; $C8...200...+
ASM_DATA(`P_ADD')
ASM_ADDR(`FSUBT-1') ; $C9...201...-
ASM_DATA(`P_MUL')
ASM_ADDR(`FMULTT-1') ; $CA...202...*
ASM_DATA(`P_MUL')
ASM_ADDR(`FDIVT-1') ; $CB...203.../
ASM_DATA(`P_PWR')
ASM_ADDR(`FPWRT-1') ; $CC...204...^
ASM_DATA(`P_AND')
ASM_ADDR(`ANDOP-1') ; $CD...205...AND
ASM_DATA(`P_OR')
ASM_ADDR(`OR-1') ; $CE...206...OR
M_NEG ASM_DATA(`P_NEQ')
ASM_ADDR(`NEGOP-1') ; $CF...207...>
MEQUU ASM_DATA(`P_NEQ')
ASM_ADDR(`EQUOP-1') ; $D0...208...=
M_REL ASM_DATA(`P_REL')
ASM_ADDR(`RELOPS-1') ; $D1...209...<
; --------------------------------
; TOKEN NAME TABLE
; --------------------------------
;
TOKEN_NAME_TABLE LHASCII(`END') ; $80...128
LHASCII(`FOR') ; $81...129
LHASCII(`NEXT') ; $82...130
LHASCII(`DATA') ; $83...131
LHASCII(`INPUT') ; $84...132
LHASCII(`DEL') ; $85...133
LHASCII(`DIM') ; $86...134
LHASCII(`READ') ; $87...135
LHASCII(`GR') ; $88...136
LHASCII(`TEXT') ; $89...137
LHASCII(`PR#') ; $8A...138
LHASCII(`IN#') ; $8B...139
LHASCII(`CALL') ; $8C...140
LHASCII(`PLOT') ; $8D...141
LHASCII(`HLIN') ; $8E...142
LHASCII(`VLIN') ; $8F...143
LHASCII(`HGR2') ; $90...144
LHASCII(`HGR') ; $91...145
LHASCII(`HCOLOR=') ; $92...146
LHASCII(`HPLOT') ; $93...147
LHASCII(`DRAW') ; $94...148
LHASCII(`XDRAW') ; $95...149
LHASCII(`HTAB') ; $96...150
LHASCII(`HOME') ; $97...151
LHASCII(`ROT=') ; $98...152
LHASCII(`SCALE=') ; $99...153
LHASCII(`SHLOAD') ; $9A...154
LHASCII(`TRACE') ; $9B...155
LHASCII(`NOTRACE') ; $9C...156
LHASCII(`NORMAL') ; $9D...157
LHASCII(`INVERSE') ; $9E...158
LHASCII(`FLASH') ; $9F...159
LHASCII(`COLOR=') ; $A0...160
LHASCII(`POP') ; $A1...161
LHASCII(`VTAB') ; $A2...162
LHASCII(`HIMEM:') ; $A3...163
LHASCII(`LOMEM:') ; $A4...164
LHASCII(`ONERR') ; $A5...165
LHASCII(`RESUME') ; $A6...166
LHASCII(`RECALL') ; $A7...167
LHASCII(`STORE') ; $A8...168
LHASCII(`SPEED=') ; $A9...169
LHASCII(`LET') ; $AA...170
LHASCII(`GOTO') ; $AB...171
LHASCII(`RUN') ; $AC...172
LHASCII(`IF') ; $AD...173
LHASCII(`RESTORE') ; $AE...174
LHASCII(`&') ; $AF...175
LHASCII(`GOSUB') ; $B0...176
LHASCII(`RETURN') ; $B1...177
LHASCII(`REM') ; $B2...178
LHASCII(`STOP') ; $B3...179
LHASCII(`ON') ; $B4...180
LHASCII(`WAIT') ; $B5...181
LHASCII(`LOAD') ; $B6...182
LHASCII(`SAVE') ; $B7...183
LHASCII(`DEF') ; $B8...184
LHASCII(`POKE') ; $B9...185
LHASCII(`PRINT') ; $BA...186
LHASCII(`CONT') ; $BB...187
LHASCII(`LIST') ; $BC...188
LHASCII(`CLEAR') ; $BD...189
LHASCII(`GET') ; $BE...190
LHASCII(`NEW') ; $BF...191
LOASCII(`TAB') ; $C0...192
ASM_DATA($A8)
LHASCII(`TO') ; $C1...193
LHASCII(`FN') ; $C2...194
LOASCII(`SPC') ; $C3...195
ASM_DATA($A8)
LHASCII(`THEN') ; $C4...196
LHASCII(`AT') ; $C5...197
LHASCII(`NOT') ; $C6...198
LHASCII(`STEP') ; $C7...199
LHASCII(`+') ; $C8...200
LHASCII(`-') ; $C9...201
LHASCII(`*') ; $CA...202
LHASCII(`/') ; $CB...203
ASM_DATA($DE)
; LHASCII(`^') ; $CC...204
LHASCII(`AND') ; $CD...205
LHASCII(`OR') ; $CE...206
LHASCII(`>') ; $CF...207
LHASCII(`=') ; $D0...208
LHASCII(`<') ; $D1...209
LHASCII(`SGN') ; $D2...210
LHASCII(`INT') ; $D3...211
LHASCII(`ABS') ; $D4...212
LHASCII(`USR') ; $D5...213
LHASCII(`FRE') ; $D6...214
LOASCII(`SCRN') ; $D7...215
ASM_DATA($A8)
LHASCII(`PDL') ; $D8...216
LHASCII(`POS') ; $D9...217
LHASCII(`SQR') ; $DA...218
LHASCII(`RND') ; $DB...219
LHASCII(`LOG') ; $DC...220
LHASCII(`EXP') ; $DD...221
LHASCII(`COS') ; $DE...222
LHASCII(`SIN') ; $DF...223
LHASCII(`TAN') ; $E0...224
LHASCII(`ATN') ; $E1...225
LHASCII(`PEEK') ; $E2...226
LHASCII(`LEN') ; $E3...227
LHASCII(`STR$') ; $E4...228
LHASCII(`VAL') ; $E5...229
LHASCII(`ASC') ; $E6...230
LHASCII(`CHR$') ; $E7...231
LHASCII(`LEFT$') ; $E8...232
LHASCII(`RIGHT$') ; $E9...233
LHASCII(`MID$') ; $EA...234
ASM_DATA(0) ; END OF TOKEN NAME TABLE
; --------------------------------
; --------------------------------
; ERROR MESSAGES
; --------------------------------
ERROR_MESSAGES
ERR_NOFOR = *-ERROR_MESSAGES
LHASCII(`NEXT WITHOUT FOR')
ERR_SYNTAX = *-ERROR_MESSAGES
LHASCII(`SYNTAX')
ERR_NOGOSUB = *-ERROR_MESSAGES
LHASCII(`RETURN WITHOUT GOSUB')
ERR_NODATA = *-ERROR_MESSAGES
LHASCII(`OUT OF DATA')
ERR_ILLQTY = *-ERROR_MESSAGES
LHASCII(`ILLEGAL QUANTITY')
ERR_OVERFLOW = *-ERROR_MESSAGES
LHASCII(`OVERFLOW')
ERR_MEMFULL = *-ERROR_MESSAGES
LHASCII(`OUT OF MEMORY')
ERR_UNDEFSTAT = *-ERROR_MESSAGES
LOASCII(`UNDEF')
ASM_DATA($27)
LHASCII(`D STATEMENT')
ERR_BADSUBS = *-ERROR_MESSAGES
LHASCII(`BAD SUBSCRIPT')
ERR_REDIMD = *-ERROR_MESSAGES
LOASCII(`REDIM')
ASM_DATA($27)
LHASCII(`D ARRAY')
ERR_ZERODIV = *-ERROR_MESSAGES
LHASCII(`DIVISION BY ZERO')
ERR_ILLDIR = *-ERROR_MESSAGES
LHASCII(`ILLEGAL DIRECT')
ERR_BADTYPE = *-ERROR_MESSAGES
LHASCII(`TYPE MISMATCH')
ERR_STRLONG = *-ERROR_MESSAGES
LHASCII(`STRING TOO LONG')
ERR_FRMCPX = *-ERROR_MESSAGES
LHASCII(`FORMULA TOO COMPLEX')
ERR_CANTCONT = *-ERROR_MESSAGES
LOASCII(`CAN')
ASM_DATA($27)
LHASCII(`T CONTINUE')
ERR_UNDEFFUNC = *-ERROR_MESSAGES
LOASCII(`UNDEF')
ASM_DATA($27)
LHASCII(`D FUNCTION')
; --------------------------------
QT_ERROR LOASCII(` ERROR')
ASM_DATA($07,0)
QT_IN LOASCII(` IN ')
ASM_DATA(0)
QT_BREAK ASM_DATA($0D)
LOASCII(`BREAK')
ASM_DATA($07,0)
; --------------------------------
; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
; THE STACK FOR A FRAME WITH THE SAME VARIABLE.
;
; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
; = $XXFF IF CALLED FROM "RETURN"
; <<< BUG: SHOULD BE $FFXX >>>
;
; RETURNS .NE. IF VARIABLE NOT FOUND,
; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
;
; EQU. IF FOUND
; (X) = STACK PNTR OF FRAME FOUND
; --------------------------------
GTFORPNT
TSX
INX
INX
INX
INX
L_GTFORPNT_1 LDA STACK+1,X ; "FOR" FRAME HERE?
CMP #TOKEN_FOR ;
BNE L_GTFORPNT_4 ; NO
LDA FORPNT+1 ; YES -- "NEXT" WITH NO VARIABLE?
BNE L_GTFORPNT_2 ; NO, VARIABLE SPECIFIED
LDA STACK+2,X ; YES, SO USE THIS FRAME
STA FORPNT ;
LDA STACK+3,X ;
STA FORPNT+1 ;
L_GTFORPNT_2 CMP STACK+3,X ; IS VARIABLE IN THIS FRAME?
BNE L_GTFORPNT_3 ; NO
LDA FORPNT ; LOOK AT 2ND BYTE TOO
CMP STACK+2,X ; SAME VARIABLE?
BEQ L_GTFORPNT_4 ; YES
L_GTFORPNT_3 TXA ; NO, SO TRY NEXT FRAME (IF ANY)
CLC ; 18 BYTES PER FRAME
ADC #18 ;
TAX
BNE L_GTFORPNT_1 ; ...ALWAYS?
L_GTFORPNT_4 RTS
; --------------------------------
; MOVE BLOCK OF MEMORY UP
;
; ON ENTRY:
; (Y,A) = (HIGHDS) = DESTINATION END+1
; (LOWTR) = LOWEST ADDRESS OF SOURCE
; (HIGHTR) = HIGHEST SOURCE ADDRESS+1
; --------------------------------
BLTU JSR REASON ; BE SURE (Y,A) < FRETOP
STA STREND ; NEW TOP OF ARRAY STORAGE
STY STREND+1 ;
BLTU2 SEC ;
LDA HIGHTR ; COMPUTE # OF BYTES TO BE MOVED
SBC LOWTR ; (FROM LOWTR THRU HIGHTR-1)
STA INDEX ; PARTIAL PAGE AMOUNT
TAY ;
LDA HIGHTR+1 ;
SBC LOWTR+1 ;
TAX ; # OF WHOLE PAGES IN X-REG
INX ;
TYA ; # BYTES IN PARTIAL PAGE
BEQ L_BLTU2_4 ; NO PARTIAL PAGE
LDA HIGHTR ; BACK UP HIGHTR # BYTES IN PARTIAL PAGE
SEC ;
SBC INDEX ;
STA HIGHTR ;
BCS L_BLTU2_1 ;
DEC HIGHTR+1 ;
SEC ;
L_BLTU2_1 LDA HIGHDS ; BACK UP HIGHDS # BYTES IN PARTIAL PAGE
SBC INDEX ;
STA HIGHDS ;
BCS L_BLTU2_3 ;
DEC HIGHDS+1 ;
BCC L_BLTU2_3 ; ...ALWAYS
L_BLTU2_2 LDA (HIGHTR),Y ; MOVE THE BYTES
STA (HIGHDS),Y
L_BLTU2_3 DEY
BNE L_BLTU2_2 ; LOOP TO END OF THIS 256 BYTES
LDA (HIGHTR),Y ; MOVE ONE MORE BYTE
STA (HIGHDS),Y
L_BLTU2_4 DEC HIGHTR+1 ; DOWN TO NEXT BLOCK OF 256
DEC HIGHDS+1
DEX ; ANOTHER BLOCK OF 256 TO MOVE?
BNE L_BLTU2_3 ; YES
RTS ; NO, FINISHED
; --------------------------------
; CHECK IF ENOUGH ROOM LEFT ON STACK
; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
; --------------------------------
CHKMEM ASL
ADC #54
BCS MEMERR ; ...MEM FULL ERR
STA INDEX
TSX
CPX INDEX
BCC MEMERR ; ...MEM FULL ERR
RTS
; --------------------------------
; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
; (Y,A) = ADDR ARRAYS NEED TO GROW TO
; --------------------------------
REASON CPY FRETOP+1 ; HIGH BYTE
BCC L_REASON_4 ; PLENTY OF ROOM
BNE L_REASON_1 ; NOT ENOUGH, TRY GARBAGE COLLECTION
CMP FRETOP ; LOW BYTE
BCC L_REASON_4 ; ENOUGH ROOM
; --------------------------------
L_REASON_1 PHA ; SAVE (Y,A), TEMP1, AND TEMP2
LDX #FAC-TEMP1-1
TYA
L_REASON_2 PHA
LDA TEMP1,X
DEX
BPL L_REASON_2
JSR GARBAG ; MAKE AS MUCH ROOM AS POSSIBLE
LDX #TEMP1+256-FAC+1 ; RESTORE TEMP1 AND TEMP2
L_REASON_3 PLA ; AND (Y,A)
STA FAC,X
INX
BMI L_REASON_3
PLA
TAY
PLA ; DID WE FIND ENOUGH ROOM?
CPY FRETOP+1 ; HIGH BYTE
BCC L_REASON_4 ; YES, AT LEAST A PAGE
BNE MEMERR ; NO, MEM FULL ERR
CMP FRETOP ; LOW BYTE
BCS MEMERR ; NO, MEM FULL ERR
L_REASON_4 RTS ; YES, RETURN
; --------------------------------
MEMERR LDX #ERR_MEMFULL
; --------------------------------
; HANDLE AN ERROR
;
; (X)=OFFSET IN ERROR MESSAGE TABLE
; (ERRFLG) > 128 IF "ON ERR" TURNED ON
; (CURLIN+1) = $FF IF IN DIRECT MODE
; --------------------------------
ERROR BIT ERRFLG ; "ON ERR" TURNED ON?
BPL L_ERROR_1 ; NO
JMP HANDLERR ; YES
L_ERROR_1 JSR CRDO ; PRINT <RETURN>
JSR OUTQUES ; PRINT "?"
L_ERROR_2 LDA ERROR_MESSAGES,X
PHA ; PRINT MESSAGE
JSR OUTDO
INX
PLA
BPL L_ERROR_2
JSR STKINI ; FIX STACK, ET AL
LDA #<QT_ERROR ; PRINT " ERROR" AND BELL
LDY #>QT_ERROR
; --------------------------------
; PRINT STRING AT (Y,A)
; PRINT CURRENT LINE # UNLESS IN DIRECT MODE
; FALL INTO WARM RESTART
; --------------------------------
PRINT_ERROR_LINNUM
JSR STROUT ; PRINT STRING AT (Y,A)
LDY CURLIN+1 ; RUNNING, OR DIRECT?
INY
BEQ RESTART ; WAS $FF, SO DIRECT MODE
JSR INPRT ; RUNNING, SO PRINT LINE NUMBER
; --------------------------------
; WARM RESTART ENTRY
;
; COME HERE FROM MONITOR BY CTL-C, 0G, 3D0G, OR E003G
; --------------------------------
RESTART
JSR CRDO ; PRINT <RETURN>
LDX #HICHAR(`]') ; PROMPT CHARACTER
JSR INLIN2 ; READ A LINE
STX TXTPTR ; SET UP CHRGET TO SCAN THE LINE
STY TXTPTR+1 ;
LSR ERRFLG ; CLEAR FLAG
JSR CHRGET ;
TAX ;
BEQ RESTART ; EMPTY LINE
LDX #$FF ; $FF IN HI-BYTE OF CURLIN MEANS
STX CURLIN+1 ; WE ARE IN DIRECT MODE
BCC NUMBERED_LINE ; CHRGET SAW DIGIT, NUMBERED LINE
JSR PARSE_INPUT_LINE ; NO NUMBER, SO PARSE IT
JMP TRACE_ ; AND TRY EXECUTING IT
; --------------------------------
; HANDLE NUMBERED LINE
; --------------------------------
NUMBERED_LINE
LDX PRGEND ; SQUASH VARIABLE TABLE
STX VARTAB
LDX PRGEND+1
STX VARTAB+1
JSR LINGET ; GET LINE #
JSR PARSE_INPUT_LINE ; AND PARSE THE INPUT LINE
STY EOL_PNTR ; SAVE INDEX TO INPUT BUFFER
JSR FNDLIN ; IS THIS LINE # ALREADY IN PROGRAM?
BCC PUT_NEW_LINE ; NO
LDY #1 ; YES, SO DELETE IT
LDA (LOWTR),Y ; LOWTR POINTS AT LINE
STA INDEX+1 ; GET HIGH BYTE OF FORWARD PNTR
LDA VARTAB
STA INDEX
LDA LOWTR+1
STA DEST+1
LDA LOWTR
DEY
SBC (LOWTR),Y
CLC
ADC VARTAB
STA VARTAB
STA DEST
LDA VARTAB+1
ADC #$FF
STA VARTAB+1
SBC LOWTR+1
TAX
SEC
LDA LOWTR
SBC VARTAB
TAY
BCS L_NUMBERED_LINE_1
INX
DEC DEST+1
L_NUMBERED_LINE_1 CLC
ADC INDEX
BCC L_NUMBERED_LINE_2
DEC INDEX+1
CLC
; --------------------------------
L_NUMBERED_LINE_2 LDA (INDEX),Y ; MOVE HIGHER LINES OF PROGRAM
STA (DEST),Y ; DOWN OVER THE DELETED LINE.
INY
BNE L_NUMBERED_LINE_2
INC INDEX+1
INC DEST+1
DEX
BNE L_NUMBERED_LINE_2
; --------------------------------
PUT_NEW_LINE
LDA INPUT_BUFFER ; ANY CHARACTERS AFTER LINE #?
BEQ FIX_LINKS ; NO, SO NOTHING TO INSERT.
LDA MEMSIZ ; YES, SO MAKE ROOM AND INSERT LINE
LDY MEMSIZ+1 ; WIPE STRING AREA CLEAN
STA FRETOP ;
STY FRETOP+1 ;
LDA VARTAB ; SET UP BLTU SUBROUTINE
STA HIGHTR ; INSERT NEW LINE.
ADC EOL_PNTR
STA HIGHDS
LDY VARTAB+1
STY HIGHTR+1
BCC L_PUT_NEW_LINE_1
INY
L_PUT_NEW_LINE_1 STY HIGHDS+1
JSR BLTU ; MAKE ROOM FOR THE LINE
LDA LINNUM ; PUT LINE NUMBER IN LINE IMAGE
LDY LINNUM+1
STA INPUT_BUFFER-2
STY INPUT_BUFFER-1
LDA STREND
LDY STREND+1
STA VARTAB
STY VARTAB+1
LDY EOL_PNTR
; ---COPY LINE INTO PROGRAM-------
L_PUT_NEW_LINE_2 LDA INPUT_BUFFER-5,Y
DEY
STA (LOWTR),Y
BNE L_PUT_NEW_LINE_2
; --------------------------------
; CLEAR ALL VARIABLES
; RE-ESTABLISH ALL FORWARD LINKS
; --------------------------------
FIX_LINKS
JSR SETPTRS ; CLEAR ALL VARIABLES
LDA TXTTAB ; POINT INDEX AT START OF PROGRAM
LDY TXTTAB+1
STA INDEX
STY INDEX+1
CLC
L_FIX_LINKS_1 LDY #1 ; HI-BYTE OF NEXT FORWARD PNTR
LDA (INDEX),Y ; END OF PROGRAM YET?
BNE L_FIX_LINKS_2 ; NO, KEEP GOING
LDA VARTAB ; YES
STA PRGEND
LDA VARTAB+1
STA PRGEND+1
JMP RESTART
L_FIX_LINKS_2 LDY #4 ; FIND END OF THIS LINE
L_FIX_LINKS_3 INY ; (NOTE MAXIMUM LENGTH < 256)
LDA (INDEX),Y ;
BNE L_FIX_LINKS_3 ;
INY ; COMPUTE ADDRESS OF NEXT LINE
TYA ;
ADC INDEX ;
TAX ;
LDY #0 ; STORE FORWARD PNTR IN THIS LINE
STA (INDEX),Y ;
LDA INDEX+1 ;
ADC #0 ; (NOTE: THIS CLEARS CARRY)
INY ;
STA (INDEX),Y ;
STX INDEX ;
STA INDEX+1 ;
BCC L_FIX_LINKS_1 ; ...ALWAYS
; --------------------------------
; --------------------------------
; READ A LINE, AND STRIP OFF SIGN BITS
; --------------------------------
INLIN LDX #$80 ; NULL PROMPT
INLIN2 STX MON_PROMPT
JSR MON_GETLN
CPX #239 ; MAXIMUM LINE LENGTH
BCC L_INLIN2_1
LDX #239 ; TRUNCATE AT 239 CHARS
L_INLIN2_1 LDA #0 ; MARK END OF LINE WITH $00 BYTE
STA INPUT_BUFFER,X
TXA
BEQ L_INLIN2_3 ; NULL INPUT LINE
L_INLIN2_2 LDA INPUT_BUFFER-1,X ; DROP SIGN BITS
AND #$7F
STA INPUT_BUFFER-1,X
DEX
BNE L_INLIN2_2
L_INLIN2_3 LDA #0 ; (Y,X) POINTS AT BUFFER-1
LDX #<(INPUT_BUFFER-1)
LDY #>(INPUT_BUFFER-1)
RTS
; --------------------------------
INCHR JSR MON_RDKEY ; *** OUGHT TO BE "BIT $C010" ***
AND #$7F
RTS
; --------------------------------
; TOKENIZE THE INPUT LINE
; --------------------------------
PARSE_INPUT_LINE
LDX TXTPTR ; INDEX INTO UNPARSED LINE
DEX ; PREPARE FOR INX AT "PARSE"
LDY #4 ; INDEX TO PARSED OUTPUT LINE
STY DATAFLG ; CLEAR SIGN-BIT OF DATAFLG
BIT LOCK ; IS THIS PROGRAM LOCKED?
BPL PARSE ; NO, GO AHEAD AND PARSE THE LINE
PLA ; YES, IGNORE INPUT AND "RUN"
PLA ; THE PROGRAM
JSR SETPTRS ; CLEAR ALL VARIABLES
JMP NEWSTT ; START RUNNING
; --------------------------------
PARSE INX ; NEXT INPUT CHARACTER
L_PARSE_1 LDA INPUT_BUFFER,X
BIT DATAFLG ; IN A "DATA" STATEMENT?
BVS L_PARSE_2 ; YES (DATAFLG = $49)
CMP #LOCHAR(` ') ; IGNORE BLANKS
BEQ PARSE ;
L_PARSE_2 STA ENDCHR ;
CMP #$22 ; START OF QUOTATION?
BEQ L_PARSE_13 ;
BVS L_PARSE_9 ; BRANCH IF IN "DATA" STATEMENT
CMP #LOCHAR(`?') ; SHORTHAND FOR "PRINT"?
BNE L_PARSE_3 ; NO
LDA #TOKEN_PRINT ; YES, REPLACE WITH "PRINT" TOKEN
BNE L_PARSE_9 ; ...ALWAYS
L_PARSE_3 CMP #LOCHAR(`0') ; IS IT A DIGIT, COLON, OR SEMI-COLON?
BCC L_PARSE_4 ; NO, PUNCTUATION !"#$%&'()*+,-./
CMP #LOCHAR(`;')+1
BCC L_PARSE_9 ; YES, NOT A TOKEN
; --------------------------------
; SEARCH TOKEN NAME TABLE FOR MATCH STARTING
; WITH CURRENT CHAR FROM INPUT LINE
; --------------------------------
L_PARSE_4 STY STRNG2 ; SAVE INDEX TO OUTPUT LINE
LDA #<(TOKEN_NAME_TABLE-$100)
STA FAC ; MAKE PNTR FOR SEARCH
LDA #>(TOKEN_NAME_TABLE-$100)
STA FAC+1
LDY #0 ; USE Y-REG WITH (FAC) TO ADDRESS TABLE
STY TKN_CNTR ; HOLDS CURRENT TOKEN-$80
DEY ; PREPARE FOR "INY" A FEW LINES DOWN
STX TXTPTR ; SAVE POSITION IN INPUT LINE
DEX ; PREPARE FOR "INX" A FEW LINES DOWN
L_PARSE_5 INY ; ADVANCE POINTER TO TOKEN TABLE
BNE L_PARSE_6 ; Y=Y+1 IS ENOUGH
INC FAC+1 ; ALSO NEED TO BUMP THE PAGE
L_PARSE_6 INX ; ADVANCE POINTER TO INPUT LINE
L_PARSE_7 LDA INPUT_BUFFER,X ; NEXT CHAR FROM INPUT LINE
CMP #LOCHAR(` ') ; THIS CHAR A BLANK?
BEQ L_PARSE_6 ; YES, IGNORE ALL BLANKS
SEC ; NO, COMPARE TO CHAR IN TABLE
SBC (FAC),Y ; SAME AS NEXT CHAR OF TOKEN NAME?
BEQ L_PARSE_5 ; YES, CONTINUE MATCHING
CMP #$80 ; MAYBE; WAS IT SAME EXCEPT FOR BIT 7?
BNE L_PARSE_14 ; NO, SKIP TO NEXT TOKEN
ORA TKN_CNTR ; YES, END OF TOKEN; GET TOKEN #
CMP #TOKENDB ; DID WE MATCH "AT"?
BNE L_PARSE_8 ; NO, SO NO AMBIGUITY
LDA INPUT_BUFFER+1,X ; "AT" COULD BE "ATN" OR "A TO"
CMP #LOCHAR(`N') ; "ATN" HAS PRECEDENCE OVER "AT"
BEQ L_PARSE_14 ; IT IS "ATN", FIND IT THE HARD WAY
CMP #LOCHAR(`O') ; "TO" HAS PRECEDENCE OVER "AT"
BEQ L_PARSE_14 ; IT IS "A TO", FIN IT THE HARD WAY
LDA #TOKENDB ; NOT "ATN" OR "A TO", SO USE "AT"
; --------------------------------
; STORE CHARACTER OR TOKEN IN OUTPUT LINE
; --------------------------------
L_PARSE_8 LDY STRNG2 ; GET INDEX TO OUTPUT LINE IN Y-REG
L_PARSE_9 INX ; ADVANCE INPUT INDEX
INY ; ADVANCE OUTPUT INDEX
STA INPUT_BUFFER-5,Y ; STORE CHAR OR TOKEN
LDA INPUT_BUFFER-5,Y ; TEST FOR EOL OR EOS
BEQ L_PARSE_17 ; END OF LINE
SEC ;
SBC #LOCHAR(`:') ; END OF STATEMENT?
BEQ L_PARSE_10 ; YES, CLEAR DATAFLG
CMP #TOKENDWTA+128-$BA ; "DATA" TOKEN?
BNE L_PARSE_11 ; NO, LEAVE DATAFLG ALONE
L_PARSE_10 STA DATAFLG ; DATAFLG = 0 OR $83-$3A = $49
L_PARSE_11 SEC ; IS IT A "REM" TOKEN?
SBC #TOKEN_REM+128-$BA
BNE L_PARSE_1 ; NO, CONTINUE PARSING LINE
STA ENDCHR ; YES, CLEAR LITERAL FLAG
; --------------------------------
; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,
; BY COPYING CHARS UP TO ENDCHR.
; --------------------------------
L_PARSE_12 LDA INPUT_BUFFER,X
BEQ L_PARSE_9 ; END OF LINE
CMP ENDCHR
BEQ L_PARSE_9 ; FOUND ENDCHR
L_PARSE_13 INY ; NEXT OUTPUT CHAR
STA INPUT_BUFFER-5,Y
INX ; NEXT INPUT CHAR
BNE L_PARSE_12 ; ...ALWAYS
; --------------------------------
; ADVANCE POINTER TO NEXT TOKEN NAME
; --------------------------------
L_PARSE_14 LDX TXTPTR ; GET POINTER TO INPUT LINE IN X-REG
INC TKN_CNTR ; BUMP (TOKEN # - $80)
L_PARSE_15 LDA (FAC),Y ; SCAN THROUGH TABLE FOR BIT7 = 1
INY ; NEXT TOKEN ONE BEYOND THAT
BNE L_PARSE_16 ; ...USUALLY ENOUGH TO BUMP Y-REG
INC FAC+1 ; NEXT SET OF 256 TOKEN CHARS
L_PARSE_16 ASL ; SEE IF SIGN BIT SET ON CHAR
BCC L_PARSE_15 ; NO, MORE IN THIS NAME
LDA (FAC),Y ; YES, AT NEXT NAME. END OF TABLE?
BNE L_PARSE_7 ; NO, NOT END OF TABLE
LDA INPUT_BUFFER,X ; YES, SO NOT A KEYWORD
BPL L_PARSE_8 ; ...ALWAYS, COPY CHAR AS IS
; ---END OF LINE------------------
L_PARSE_17 STA INPUT_BUFFER-3,Y ; STORE ANOTHER 00 ON END
DEC TXTPTR+1 ; SET TXTPTR = INPUT.BUFFER-1
LDA #<(INPUT_BUFFER-1)
STA TXTPTR
RTS
; --------------------------------
; SEARCH FOR LINE
;
; (LINNUM) = LINE # TO FIND
; IF NOT FOUND: CARRY = 0
; LOWTR POINTS AT NEXT LINE
; IF FOUND: CARRY = 1
; LOWTR POINTS AT LINE
; --------------------------------
FNDLIN LDA TXTTAB ; SEARCH FROM BEGINNING OF PROGRAM
LDX TXTTAB+1 ;
FL1 LDY #1 ; SEARCH FROM (X,A)
STA LOWTR ;
STX LOWTR+1 ;
LDA (LOWTR),Y ;
BEQ L_FL1_3 ; END OF PROGRAM, AND NOT FOUND
INY ;
INY ;
LDA LINNUM+1 ;
CMP (LOWTR),Y ;
BCC RTS_1 ; IF NOT FOUND
BEQ L_FL1_1 ;
DEY ;
BNE L_FL1_2 ;
L_FL1_1 LDA LINNUM ;
DEY ;
CMP (LOWTR),Y ;
BCC RTS_1 ; PAST LINE, NOT FOUND
BEQ RTS_1 ; IF FOUND
L_FL1_2 DEY ;
LDA (LOWTR),Y ;
TAX ;
DEY ;
LDA (LOWTR),Y ;
BCS FL1 ; ALWAYS
L_FL1_3 CLC ; RETURN CARRY = 0
RTS_1 RTS
; --------------------------------
; "NEW" STATEMENT
; --------------------------------
NEW BNE RTS_1 ; IGNORE IF MORE TO THE STATEMENT
SCRTCH LDA #0
STA LOCK
TAY
STA (TXTTAB),Y
INY
STA (TXTTAB),Y
LDA TXTTAB
ADC #2 ; (CARRY WASN'T CLEARED, SO "NEW" USUALLY
STA VARTAB ; ADDS 3, WHEREAS "FP" ADDS 2.)
STA PRGEND
LDA TXTTAB+1
ADC #0
STA VARTAB+1
STA PRGEND+1
; --------------------------------
SETPTRS
JSR STXTPT ; SET TXTPTR TO TXTTAB - 1
LDA #0 ; (THIS COULD HAVE BEEN ".HS 2C")
; --------------------------------
; "CLEAR" STATEMENT
; --------------------------------
CLEAR BNE RTS_2 ; IGNORE IF NOT AT END OF STATEMENT
CLEARC LDA MEMSIZ ; CLEAR STRING AREA
LDY MEMSIZ+1 ;
STA FRETOP ;
STY FRETOP+1 ;
LDA VARTAB ; CLEAR ARRAY AREA
LDY VARTAB+1 ;
STA ARYTAB ;
STY ARYTAB+1 ;
STA STREND ; LOW END OF FREE SPACE
STY STREND+1 ;
JSR RESTORE ; SET "DATA" POINTER TO BEGINNING
; --------------------------------
STKINI LDX #TEMPST
STX TEMPPT
PLA ; SAVE RETURN ADDRESS
TAY ;
PLA ;
LDX #$F8 ; START STACK AT $F8,
TXS ; LEAVING ROOM FOR PARSING LINES
PHA ; RESTORE RETURN ADDRESS
TYA
PHA
LDA #0
STA OLDTEXT+1
STA SUBFLG
RTS_2 RTS
; --------------------------------
; SET TXTPTR TO BEGINNING OF PROGRAM
; --------------------------------
STXTPT CLC ; TXTPTR = TXTTAB - 1
LDA TXTTAB
ADC #$FF
STA TXTPTR
LDA TXTTAB+1
ADC #$FF
STA TXTPTR+1
RTS
; --------------------------------
; "LIST" STATEMENT
; --------------------------------
LIST BCC L_LIST_1 ; NO LINE # SPECIFIED
BEQ L_LIST_1 ; ---DITTO---
CMP #TOKEN_MINUS ; IF DASH OR COMMA, START AT LINE 0
BEQ L_LIST_1 ; IS IS A DASH
CMP #LOCHAR(`,') ; COMMA?
BNE RTS_2 ; NO, ERROR
L_LIST_1 JSR LINGET ; CONVERT LINE NUMBER IF ANY
JSR FNDLIN ; POINT LOWTR TO 1ST LINE
JSR CHRGOT ; RANGE SPECIFIED?
BEQ L_LIST_3 ; NO
CMP #TOKEN_MINUS
BEQ L_LIST_2
CMP #LOCHAR(`,')
BNE RTS_1
L_LIST_2 JSR CHRGET ; GET NEXT CHAR
JSR LINGET ; CONVERT SECOND LINE #
BNE RTS_2 ; BRANCH IF SYNTAX ERR
L_LIST_3 PLA ; POP RETURN ADRESS
PLA ; (GET BACK BY "JMP NEWSTT")
LDA LINNUM ; IF NO SECOND NUMBER, USE $FFFF
ORA LINNUM+1 ;
BNE LIST_0 ; THERE WAS A SECOND NUMBER
LDA #$FF ; MAX END RANGE
STA LINNUM ;
STA LINNUM+1 ;
LIST_0 LDY #1 ;
LDA (LOWTR),Y ; HIGH BYTE OF LINK
BEQ LIST_3 ; END OF PROGRAM
JSR ISCNTC ; CHECK IF CONTROL-C HAS BEEN TYPED
JSR CRDO ; NO, PRINT <RETURN>
INY ;
LDA (LOWTR),Y ; GET LINE #, COMPARE WITH END RANGE
TAX ;
INY ;
LDA (LOWTR),Y ;
CMP LINNUM+1 ;
BNE L_LIST_0_5 ;
CPX LINNUM ;
BEQ L_LIST_0_6 ; ON LAST LINE OF RANGE
L_LIST_0_5 BCS LIST_3 ; FINISHED THE RANGE
; ---LIST ONE LINE----------------
L_LIST_0_6 STY FORPNT ;
JSR LINPRT ; PRINT LINE # FROM X,A
LDA #LOCHAR(` ') ; PRINT SPACE AFTER LINE #
LIST_1 LDY FORPNT ;
AND #$7F ;
LIST_2 JSR OUTDO ;
LDA MON_CH ; IF PAST COLUMN 33, START A NEW LINE
CMP #33 ;
BCC L_LIST_2_1 ; < 33
JSR CRDO ; PRINT <RETURN>
LDA #5 ; AND TAB OVER 5
STA MON_CH ;
L_LIST_2_1 INY ;
LDA (LOWTR),Y ;
BNE LIST_4 ; NOT END OF LINE YET
TAY ; END OF LINE
LDA (LOWTR),Y ; GET LINK TO NEXT LINE
TAX ;
INY ;
LDA (LOWTR),Y ;
STX LOWTR ; POINT TO NEXT LINE
STA LOWTR+1 ;
BNE LIST_0 ; BRANCH IF NOT END OF PROGRAM
LIST_3 LDA #$0D ; PRINT <RETURN>
JSR OUTDO ;
JMP NEWSTT ; TO NEXT STATEMENT
; --------------------------------
GETCHR INY ; PICK UP CHAR FROM TABLE
BNE L_GETCHR_1 ;
INC FAC+1 ;
L_GETCHR_1 LDA (FAC),Y ;
RTS ;
; --------------------------------
LIST_4 BPL LIST_2 ; BRANCH IF NOT A TOKEN
SEC ;
SBC #$7F ; CONVERT TOKEN TO INDEX
TAX ;
STY FORPNT ; SAVE LINE POINTER
LDY #<(TOKEN_NAME_TABLE-$100)
STY FAC ; POINT FAC TO TABLE
LDY #>(TOKEN_NAME_TABLE-$100)
STY FAC+1
LDY #$FF
L_LIST_4_1 DEX ; SKIP KEYWORDS UNTIL REACH THIS ONE
BEQ L_LIST_4_3 ;
L_LIST_4_2 JSR GETCHR ; BUMP Y, GET CHAR FROM TABLE
BPL L_LIST_4_2 ; NOT AT END OF KEYWORD YET
BMI L_LIST_4_1 ; END OF KEYWORD, ALWAYS BRANCHES
L_LIST_4_3 LDA #LOCHAR(` ') ; FOUND THE RIGHT KEYWORD
JSR OUTDO ; PRINT LEADING SPACE
L_LIST_4_4 JSR GETCHR ; PRINT THE KEYWORD
BMI L_LIST_4_5 ; LAST CHAR OF KEYWORD
JSR OUTDO ;
BNE L_LIST_4_4 ; ...ALWAYS
L_LIST_4_5 JSR OUTDO ; PRINT LAST CHAR OF KEYWORD
LDA #LOCHAR(` ') ; PRINT TRAILING SPACE
BNE LIST_1 ; ...ALWAYS, BACK TO ACTUAL LINE
; --------------------------------
; "FOR" STATEMENT
;
; FOR PUSHES 18 BYTES ON THE STACK:
; 2 -- TXTPTR
; 2 -- LINE NUMBER
; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
; 1 -- STEP SIGN
; 5 -- STEP VALUE
; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
; 1 -- FOR TOKEN ($81)
; --------------------------------
FOR LDA #$80 ;
STA SUBFLG ; SUBSCRIPTS NOT ALLOWED
JSR LET ; DO <VAR> = <EXP>, STORE ADDR IN FORPNT
JSR GTFORPNT ; IS THIS FOR VARIABLE ACTIVE?
BNE L_FOR_1 ; NO
TXA ; YES, CANCEL IT AND ENCLOSED LOOPS
ADC #15 ; CARRY=1, THIS ADDS 16
TAX ; X WAS ALREADY S+2
TXS ;
L_FOR_1 PLA ; POP RETURN ADDRESS TOO
PLA ;
LDA #9 ; BE CERTAIN ENOUGH ROOM IN STACK
JSR CHKMEM ;
JSR DATAN ; SCAN AHEAD TO NEXT STATEMENT
CLC ; PUSH STATEMENT ADDRESS ON STACK
TYA ;
ADC TXTPTR ;
PHA ;
LDA TXTPTR+1 ;
ADC #0 ;
PHA ;
LDA CURLIN+1 ; PUSH LINE NUMBER ON STACK
PHA ;
LDA CURLIN ;
PHA ;
LDA #TOKEN_TO ;
JSR SYNCHR ; REQUIRE "TO"
JSR CHKNUM ; <VAR> = <EXP> MUST BE NUMERIC
JSR FRMNUM ; GET FINAL VALUE, MUST BE NUMERIC
LDA FAC_SIGN ; PUT SIGN INTO VALUE IN FAC
ORA #$7F ;
AND FAC+1 ;
STA FAC+1 ;
LDA #<STEP ; SET UP FOR RETURN
LDY #>STEP ; TO STEP
STA INDEX
STY INDEX+1
JMP FRM_STACK_3 ; RETURNS BY "JMP (INDEX)"
; --------------------------------
; "STEP" PHRASE OF "FOR" STATEMENT
; --------------------------------
STEP LDA #<CON_ONE ; STEP DEFAULT=1
LDY #>CON_ONE
JSR LOAD_FAC_FROM_YA
JSR CHRGOT
CMP #TOKEN_STEP
BNE L_STEP_1 ; USE DEFAULT VALUE OF 1.0
JSR CHRGET ; STEP SPECIFIED, GET IT
JSR FRMNUM
L_STEP_1 JSR SIGN
JSR FRM_STACK_2
LDA FORPNT+1
PHA
LDA FORPNT
PHA
LDA #TOKEN_FOR
PHA
; --------------------------------
; PERFORM NEXT STATEMENT
; --------------------------------
NEWSTT TSX ; REMEMBER THE STACK POSITION
STX REMSTK ;
JSR ISCNTC ; SEE IF CONTROL-C HAS BEEN TYPED
LDA TXTPTR ; NO, KEEP EXECUTING
LDY TXTPTR+1 ;
LDX CURLIN+1 ; =$FF IF IN DIRECT MODE
INX ; $FF TURNS INTO $00
BEQ L_NEWSTT_1 ; IN DIRECT MODE
STA OLDTEXT ; IN RUNNING MODE
STY OLDTEXT+1 ;
L_NEWSTT_1 LDY #0 ;
LDA (TXTPTR),Y ; END OF LINE YET?
BNE COLON_ ; NO
LDY #2 ; YES, SEE IF END OF PROGRAM
LDA (TXTPTR),Y ;
CLC ;
BEQ GOEND ; YES, END OF PROGRAM
INY ;
LDA (TXTPTR),Y ; GET LINE # OF NEXT LINE
STA CURLIN ;
INY ;
LDA (TXTPTR),Y ;
STA CURLIN+1 ;
TYA ; ADJUST TXTPTR TO START
ADC TXTPTR ; OF NEW LINE
STA TXTPTR
BCC L_NEWSTT_2
INC TXTPTR+1
L_NEWSTT_2
; --------------------------------
TRACE_ BIT TRCFLG ; IS TRACE ON?
BPL L_TRACE__1 ; NO
LDX CURLIN+1 ; YES, ARE WE RUNNING?
INX ;
BEQ L_TRACE__1 ; NOT RUNNING, SO DON'T TRACE
LDA #LOCHAR(`#') ; PRINT "#"
JSR OUTDO ;
LDX CURLIN ;
LDA CURLIN+1 ;
JSR LINPRT ; PRINT LINE NUMBER
JSR OUTSP ; PRINT TRAILING SPACE
L_TRACE__1 JSR CHRGET ; GET FIRST CHR OF STATEMENT
JSR EXECUTE_STATEMENT ; AND START PROCESSING
JMP NEWSTT ; BACK FOR MORE
; --------------------------------
GOEND BEQ END4
; --------------------------------
; EXECUTE A STATEMENT
;
; (A) IS FIRST CHAR OF STATEMENT
; CARRY IS SET
; --------------------------------
EXECUTE_STATEMENT
BEQ RTS_3 ; END OF LINE, NULL STATEMENT
EXECUTE_STATEMENT_1 ;
SBC #$80 ; FIRST CHAR A TOKEN?
BCC L_EXECUTE_STATEMENT_1_1 ; NOT TOKEN, MUST BE "LET"
CMP #$40 ; STATEMENT-TYPE TOKEN?
BCS SYNERR_1 ; NO, SYNTAX ERROR
ASL ; DOUBLE TO GET INDEX
TAY ; INTO ADDRESS TABLE
LDA TOKEN_ADDRESS_TABLE+1,Y
PHA ; PUT ADDRESS ON STACK
LDA TOKEN_ADDRESS_TABLE,Y
PHA
JMP CHRGET ; GET NEXT CHR & RTS TO ROUTINE
; --------------------------------
L_EXECUTE_STATEMENT_1_1 JMP LET ; MUST BE <VAR> = <EXP>
; --------------------------------
COLON_ CMP #LOCHAR(`:')
BEQ TRACE_
SYNERR_1 JMP SYNERR
; --------------------------------
; "RESTORE" STATEMENT
; --------------------------------
RESTORE
SEC ; SET DATPTR TO BEGINNING OF PROGRAM
LDA TXTTAB
SBC #1
LDY TXTTAB+1
BCS SETDA
DEY
; ---SET DATPTR TO Y,A------------
SETDA STA DATPTR
STY DATPTR+1
RTS_3 RTS
; --------------------------------
; SEE IF CONTROL-C TYPED
; --------------------------------
ISCNTC LDA KEYBOARD
CMP #$83
BEQ L_ISCNTC_1
RTS
L_ISCNTC_1 JSR INCHR ; <<< SHOULD BE "BIT $C010" >>>
CONTROL_C_TYPED
LDX #$FF ; CONTROL C ATTEMPTED
BIT ERRFLG ; "ON ERR" ENABLED?
BPL L_CONTROL_C_TYPED_2 ; NO
JMP HANDLERR ; YES, RETURN ERR CODE = 255
L_CONTROL_C_TYPED_2 CMP #3 ; SINCE IT IS CTRL-C, SET Z AND C BITS
; --------------------------------
; "STOP" STATEMENT
; --------------------------------
STOP BCS END2 ; CARRY=1 TO FORCE PRINTING "BREAK AT.."
; --------------------------------
; "END" STATEMENT
; --------------------------------
ENDX CLC ; CARRY=0 TO AVOID PRINTING MESSAGE
END2 BNE RTS_4 ; IF NOT END OF STATEMENT, DO NOTHING
LDA TXTPTR
LDY TXTPTR+1
LDX CURLIN+1
INX ; RUNNING?
BEQ L_END2_1 ; NO, DIRECT MODE
STA OLDTEXT
STY OLDTEXT+1
LDA CURLIN
LDY CURLIN+1
STA OLDLIN
STY OLDLIN+1
L_END2_1 PLA
PLA
END4 LDA #<QT_BREAK ; " BREAK" AND BELL
LDY #>QT_BREAK
BCC L_END4_1
JMP PRINT_ERROR_LINNUM
L_END4_1 JMP RESTART
; --------------------------------
; "CONT" COMMAND
; --------------------------------
CONT BNE RTS_4 ; IF NOT END OF STATEMENT, DO NOTHING
LDX #ERR_CANTCONT
LDY OLDTEXT+1 ; MEANINGFUL RE-ENTRY?
BNE L_CONT_1 ; YES
JMP ERROR ; NO
L_CONT_1 LDA OLDTEXT ; RESTORE TXTPTR
STA TXTPTR ;
STY TXTPTR+1 ;
LDA OLDLIN ; RESTORE LINE NUMBER
LDY OLDLIN+1
STA CURLIN
STY CURLIN+1
RTS_4 RTS
; --------------------------------
; "SAVE" COMMAND
; WRITES PROGRAM ON CASSETTE TAPE
; --------------------------------
SAVE SEC
LDA PRGEND ; COMPUTE PROGRAM LENGTH
SBC TXTTAB
STA LINNUM
LDA PRGEND+1
SBC TXTTAB+1
STA LINNUM+1
JSR VARTIO ; SET UP TO WRITE 3 BYTE HEADER
JSR MON_WRITE ; WRITE 'EM
JSR PROGIO ; SET UP TO WRITE THE PROGRAM
JMP MON_WRITE ; WRITE IT
; --------------------------------
; "LOAD" COMMAND
; READS A PROGRAM FROM CASSETTE TAPE
; --------------------------------
LOAD JSR VARTIO ; SET UP TO READ 3 BYTE HEADER
JSR MON_READ ; READ LENGTH, LOCK BYTE
CLC ;
LDA TXTTAB ; COMPUTE END ADDRESS
ADC LINNUM ;
STA VARTAB ;
LDA TXTTAB+1 ;
ADC LINNUM+1 ;
STA VARTAB+1 ;
LDA TEMPPT ; LOCK BYTE
STA LOCK ;
JSR PROGIO ; SET UP TO READ PROGRAM
JSR MON_READ ; READ IT
BIT LOCK ; IF LOCKED, START RUNNING NOW
BPL L_LOAD_1 ; NOT LOCKED
JMP SETPTRS ; LOCKED, START RUNNING
L_LOAD_1 JMP FIX_LINKS ; JUST FIX FORWARD POINTERS
; --------------------------------
VARTIO LDA #LINNUM ; SET UP TO READ/WRITE 3 BYTE HEADER
LDY #0
STA MON_A1L
STY MON_A1H
LDA #TEMPPT
STA MON_A2L
STY MON_A2H
STY LOCK
RTS
; --------------------------------
PROGIO LDA TXTTAB ; SET UP TO READ/WRITE PROGRAM
LDY TXTTAB+1
STA MON_A1L
STY MON_A1H
LDA VARTAB
LDY VARTAB+1
STA MON_A2L
STY MON_A2H
RTS
; --------------------------------
; --------------------------------
; "RUN" COMMAND
; --------------------------------
RUN PHP ; SAVE STATUS WHILE SUBTRACTING
DEC CURLIN+1 ; IF WAS $FF (MEANING DIRECT MODE)
; MAKE IT "RUNNING MODE"
PLP ; GET STATUS AGAIN (FROM CHRGET)
BNE L_RUN_1 ; PROBABLY A LINE NUMBER
JMP SETPTRS ; START AT BEGINNING OF PROGRAM
L_RUN_1 JSR CLEARC ; CLEAR VARIABLES
JMP GO_TO_LINE ; JOIN GOSUB STATEMENT
; --------------------------------
; "GOSUB" STATEMENT
;
; LEAVES 7 BYTES ON STACK:
; 2 -- RETURN ADDRESS (NEWSTT)
; 2 -- TXTPTR
; 2 -- LINE #
; 1 -- GOSUB TOKEN ($B0)
; --------------------------------
GOSUB LDA #3 ; BE SURE ENOUGH ROOM ON STACK
JSR CHKMEM
LDA TXTPTR+1
PHA
LDA TXTPTR
PHA
LDA CURLIN+1
PHA
LDA CURLIN
PHA
LDA #TOKEN_GOSUB
PHA
GO_TO_LINE
JSR CHRGOT
JSR GOTO
JMP NEWSTT
; --------------------------------
; "GOTO" STATEMENT
; ALSO USED BY "RUN" AND "GOSUB"
; --------------------------------
GOTO JSR LINGET ; GET GOTO LINE
JSR REMN ; POINT Y TO EOL
LDA CURLIN+1 ; IS CURRENT PAGE < GOTO PAGE?
CMP LINNUM+1 ;
BCS L_GOTO_1 ; SEARCH FROM PROG START IF NOT
TYA ; OTHERWISE SEARCH FROM NEXT LINE
SEC ;
ADC TXTPTR ;
LDX TXTPTR+1 ;
BCC L_GOTO_2 ;
INX ;
BCS L_GOTO_2 ;
L_GOTO_1 LDA TXTTAB ; GET PROGRAM BEGINNING
LDX TXTTAB+1 ;
L_GOTO_2 JSR FL1 ; SEARCH FOR GOTO LINE
BCC UNDERR ; ERROR IF NOT THERE
LDA LOWTR ; TXTPTR = START OF THE DESTINATION LINE
SBC #1 ;
STA TXTPTR ;
LDA LOWTR+1 ;
SBC #0 ;
STA TXTPTR+1 ;
RTS_5 RTS ; RETURN TO NEWSTT OR GOSUB
; --------------------------------
; "POP" AND "RETURN" STATEMENTS
; --------------------------------
POP BNE RTS_5
LDA #$FF
STA FORPNT ; <<< BUG: SHOULD BE FORPNT+1 >>>
; <<< SEE "ALL ABOUT APPLESOFT", PAGES 100,101 >>>
JSR GTFORPNT ; TO CANCEL FOR/NEXT IN SUB
TXS
CMP #TOKEN_GOSUB ; LAST GOSUB FOUND?
BEQ RETURN
LDX #ERR_NOGOSUB
ASM_DATA($2C) ; FAKE
UNDERR LDX #ERR_UNDEFSTAT
JMP ERROR
; --------------------------------
SYNERR_2 JMP SYNERR
; --------------------------------
RETURN PLA ; DISCARD GOSUB TOKEN
PLA
CPY #<(TOKEN_POP*2)
BEQ PULL3 ; BRANCH IF A POP
STA CURLIN ; PULL LINE #
PLA
STA CURLIN+1
PLA
STA TXTPTR ; PULL TXTPTR
PLA
STA TXTPTR+1
; --------------------------------
; "DATA" STATEMENT
; EXECUTED BY SKIPPING TO NEXT COLON OR EOL
; --------------------------------
DATA JSR DATAN ; MOVE TO NEXT STATEMENT
; --------------------------------
; ADD (Y) TO TXTPTR
; --------------------------------
ADDON TYA
CLC
ADC TXTPTR
STA TXTPTR
BCC L_ADDON_1
INC TXTPTR+1
L_ADDON_1
RTS_6 RTS
; --------------------------------
; SCAN AHEAD TO NEXT ":" OR EOL
; --------------------------------
DATAN LDX #LOCHAR(`:') ; GET OFFSET IN Y TO EOL OR ":"
ASM_DATA($2C) ; FAKE
; --------------------------------
REMN LDX #0 ; TO EOL ONLY
STX CHARAC
LDY #0
STY ENDCHR
L_REMN_1 LDA ENDCHR ; TRICK TO COUNT QUOTE PARITY
LDX CHARAC
STA CHARAC
STX ENDCHR
L_REMN_2 LDA (TXTPTR),Y
BEQ RTS_6 ; END OF LINE
CMP ENDCHR
BEQ RTS_6 ; COLON IF LOOKING FOR COLONS
INY
CMP #$22
BNE L_REMN_2
BEQ L_REMN_1 ; ...ALWAYS
; --------------------------------
PULL3 PLA
PLA
PLA
RTS
; --------------------------------
; "IF" STATEMENT
; --------------------------------
IF JSR FRMEVL
JSR CHRGOT
CMP #TOKEN_GOTO
BEQ L_IF_1
LDA #TOKEN_THEN
JSR SYNCHR
L_IF_1 LDA FAC ; CONDITION TRUE OR FALSE?
BNE IF_TRUE ; BRANCH IF TRUE
; --------------------------------
; "REM" STATEMENT, OR FALSE "IF" STATEMENT
; --------------------------------
REM JSR REMN ; SKIP REST OF LINE
BEQ ADDON ; ...ALWAYS
; --------------------------------
IF_TRUE
JSR CHRGOT ; COMMAND OR NUMBER?
BCS L_IF_TRUE_1 ; COMMAND
JMP GOTO ; NUMBER
L_IF_TRUE_1 JMP EXECUTE_STATEMENT
; --------------------------------
; "ON" STATEMENT
;
; ON <EXP> GOTO <LIST>
; ON <EXP> GOSUB <LIST>
; --------------------------------
ONGOTO JSR GETBYT ; EVALUATE <EXP>, AS BYTE IN FAC+4
PHA ; SAVE NEXT CHAR ON STACK
CMP #TOKEN_GOSUB
BEQ ON_2
ON_1 CMP #TOKEN_GOTO
BNE SYNERR_2
ON_2 DEC FAC+4 ; COUNTED TO RIGHT ONE YET?
BNE L_ON_2_3 ; NO, KEEP LOOKING
PLA ; YES, RETRIEVE CMD
JMP EXECUTE_STATEMENT_1 ; AND GO.
L_ON_2_3 JSR CHRGET ; PRIME CONVERT SUBROUTINE
JSR LINGET ; CONVERT LINE #
CMP #LOCHAR(`,') ; TERMINATE WITH COMMA?
BEQ ON_2 ; YES
PLA ; NO, END OF LIST, SO IGNORE
RTS_7 RTS
; --------------------------------
; CONVERT LINE NUMBER
; --------------------------------
LINGET LDX #0 ; ASC # TO HEX ADDRESS
STX LINNUM ; IN LINNUM.
STX LINNUM+1 ;
L_LINGET_1 BCS RTS_7 ; NOT A DIGIT
SBC #LOCHAR(`0')-1 ; CONVERT DIGIT TO BINARY
STA CHARAC ; SAVE THE DIGIT
LDA LINNUM+1 ; CHECK RANGE
STA INDEX ;
CMP #>6400 ; LINE # TOO LARGE?
BCS ON_1 ; YES, > 63999, GO INDIRECTLY TO
; "SYNTAX ERROR".
; <<<<<DANGEROUS CODE>>>>>
; NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
; ON_1 WILL COMPARE = AND CAUSE A CATASTROPHIC
; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
; FOR OTHER CALLS TO LINGET.
;
; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
; THEN TYPE "GO TO 437761".
;
; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
; THE PROBLEM. ($AB00 - $ABFF)
; <<<<<DANGEROUS CODE>>>>>
LDA LINNUM ; MULTIPLY BY TEN
ASL
ROL INDEX
ASL
ROL INDEX
ADC LINNUM
STA LINNUM
LDA INDEX
ADC LINNUM+1
STA LINNUM+1
ASL LINNUM
ROL LINNUM+1
LDA LINNUM
ADC CHARAC ; ADD DIGIT
STA LINNUM
BCC L_LINGET_2
INC LINNUM+1
L_LINGET_2 JSR CHRGET ; GET NEXT CHAR
JMP L_LINGET_1 ; MORE CONVERTING
; --------------------------------
; "LET" STATEMENT
;
; LET <VAR> = <EXP>
; <VAR> = <EXP>
; --------------------------------
LET JSR PTRGET ; GET <VAR>
STA FORPNT
STY FORPNT+1
LDA #TOKENEQUUAL
JSR SYNCHR
LDA VALTYP+1 ; SAVE VARIABLE TYPE
PHA
LDA VALTYP
PHA
JSR FRMEVL ; EVALUATE <EXP>
PLA
ROL
JSR CHKVAL
BNE LET_STRING
PLA
; --------------------------------
LET2 BPL L_LET2_1 ; REAL VARIABLE
JSR ROUND_FAC ; INTEGER VAR: ROUND TO 32 BITS
JSR AYINT ; TRUNCATE TO 16-BITS
LDY #0
LDA FAC+3
STA (FORPNT),Y
INY
LDA FAC+4
STA (FORPNT),Y
RTS
; --------------------------------
; REAL VARIABLE = EXPRESSION
; --------------------------------
L_LET2_1 JMP SETFOR
; --------------------------------
LET_STRING
PLA
; --------------------------------
; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
; --------------------------------
PUTSTR LDY #2 ; STRING DATA ALREADY IN STRING AREA?
LDA (FAC+3),Y ; (STRING AREA IS BTWN FRETOP
CMP FRETOP+1 ; HIMEM)
BCC L_PUTSTR_2 ; YES, DATA ALREADY UP THERE
BNE L_PUTSTR_1 ; NO
DEY ; MAYBE, TEST LOW BYTE OF POINTER
LDA (FAC+3),Y ;
CMP FRETOP ;
BCC L_PUTSTR_2 ; YES, ALREADY THERE
L_PUTSTR_1 LDY FAC+4 ; NO. DESCRIPTOR ALREADY AMONG VARIABLES?
CPY VARTAB+1 ;
BCC L_PUTSTR_2 ; NO
BNE L_PUTSTR_3 ; YES
LDA FAC+3 ; MAYBE, COMPARE LO-BYTE
CMP VARTAB ;
BCS L_PUTSTR_3 ; YES, DESCRIPTOR IS AMONG VARIABLES
L_PUTSTR_2 LDA FAC+3 ; EITHER STRING ALREADY ON TOP, OR
LDY FAC+4 ; DESCRIPTOR IS NOT A VARIABLE
JMP L_PUTSTR_4 ; SO JUST STORE THE DESCRIPTOR
; --------------------------------
; STRING NOT YET IN STRING AREA,
; AND DESCRIPTOR IS A VARIABLE
; --------------------------------
L_PUTSTR_3 LDY #0 ; POINT AT LENGTH IN DESCRIPTOR
LDA (FAC+3),Y ; GET LENGTH
JSR STRINI ; MAKE A STRING THAT LONG UP ABOVE
LDA DSCPTR ; SET UP SOURCE PNTR FOR MONINS
LDY DSCPTR+1 ;
STA STRNG1 ;
STY STRNG1+1 ;
JSR MOVINS ; MOVE STRING DATA TO NEW AREA
LDA #<FAC ; ADDRESS OF DESCRIPTOR IS IN FAC
LDY #>FAC ;
L_PUTSTR_4 STA DSCPTR ;
STY DSCPTR+1 ;
JSR FRETMS ; DISCARD DESCRIPTOR IF 'TWAS TEMPORARY
LDY #0 ; COPY STRING DESCRIPTOR
LDA (DSCPTR),Y
STA (FORPNT),Y
INY
LDA (DSCPTR),Y
STA (FORPNT),Y
INY
LDA (DSCPTR),Y
STA (FORPNT),Y
RTS
; --------------------------------
PR_STRING
JSR STRPRT
JSR CHRGOT
; --------------------------------
; "PRINT" STATEMENT
; --------------------------------
PRINT BEQ CRDO ; NO MORE LIST, PRINT <RETURN>
; --------------------------------
PRINT2 BEQ RTS_8 ; NO MORE LIST, DON'T PRINT <RETURN>
CMP #TOKEN_TAB
BEQ PR_TAB_OR_SPC ; C=1 FOR TAB(
CMP #TOKEN_SPC
CLC
BEQ PR_TAB_OR_SPC ; C=0 FOR SPC(
CMP #LOCHAR(`,')
CLC ; <<< NO PURPOSE TO THIS >>>
BEQ PR_COMMA ;
CMP #LOCHAR(`;')
BEQ PR_NEXT_CHAR ;
JSR FRMEVL ; EVALUATE EXPRESSION
BIT VALTYP ; STRING OR FP VALUE?
BMI PR_STRING ; STRING
JSR FOUT ; FP: CONVERT INTO BUFFER
JSR STRLIT ; MAKE BUFFER INTO STRING
JMP PR_STRING ; PRINT THE STRING
; --------------------------------
CRDO LDA #$0D ; PRINT <RETURN>
JSR OUTDO
NEGATE EOR #$FF ; <<< WHY??? >>>
RTS_8 RTS
; --------------------------------
; TAB TO NEXT COMMA COLUMN
; <<< NOTE BUG IF WIDTH OF WINDOW LESS THAN 33 >>>
PR_COMMA
LDA MON_CH
CMP #24 ; <<< BUG: IT SHOULD BE 32 >>>
BCC L_PR_COMMA_1 ; NEXT COLUMN, SAME LINE
JSR CRDO ; FIRST COLUMN, NEXT LINT
BNE PR_NEXT_CHAR ; ...ALWAYS
L_PR_COMMA_1 ADC #16
AND #$F0 ; ROUND TO 16 OR 32
STA MON_CH
BCC PR_NEXT_CHAR ; ...ALWAYS
; --------------------------------
PR_TAB_OR_SPC
PHP ; C=0 FOR SPC(, C=1 FOR TAB(
JSR GTBYTC ; GET VALUE
CMP #LOCHAR(`)') ; TRAILING PARENTHESIS
BEQ L_PR_TAB_OR_SPC_1 ; GOOD
JMP SYNERR ; NO, SYNTAX ERROR
L_PR_TAB_OR_SPC_1 PLP ; TAB( OR SPC(
BCC L_PR_TAB_OR_SPC_2 ; SPC(
DEX ; TAB(
TXA ; CALCULATE SPACES NEEDED FOR TAB(
SBC MON_CH
BCC PR_NEXT_CHAR ; ALREADY PAST THAT COLUMN
TAX ; NOW DO A SPC( TO THE SPECIFIED COLUMN
L_PR_TAB_OR_SPC_2 INX
NXSPC DEX
BNE DOSPC ; MORE SPACES TO PRINT
; --------------------------------
PR_NEXT_CHAR
JSR CHRGET
JMP PRINT2 ; CONTINUE PARSING PRINT LIST
; --------------------------------
DOSPC JSR OUTSP
BNE NXSPC ; ...ALWAYS
; --------------------------------
; PRINT STRING AT (Y,A)
STROUT JSR STRLIT ; MAKE (Y,A) PRINTABLE
; --------------------------------
; PRINT STRING AT (FACMO,FACLO)
; --------------------------------
STRPRT JSR FREFAC ; GET ADDRESS INTO INDEX, (A)=LENGTH
TAX ; USE X-REG FOR COUNTER
LDY #0 ; USE Y-REG FOR SCANNER
INX ;
L_STRPRT_1 DEX ;
BEQ RTS_8 ; FINISHED
LDA (INDEX),Y ; NEXT CHAR FROM STRING
JSR OUTDO ; PRINT THE CHAR
INY ;
; <<< NEXT THREE LINES ARE USELESS >>>
CMP #$0D ; WAS IT <RETURN>?
BNE L_STRPRT_1 ; NO
JSR NEGATE ; EOR #$FF WOULD DO IT, BUT WHY?
; <<< ABOVE THREE LINES ARE USELESS >>>
JMP L_STRPRT_1
; --------------------------------
OUTSP LDA #LOCHAR(` ') ; PRINT A SPACE
ASM_DATA($2C) ; SKIP OVER NEXT LINE
OUTQUES LDA #LOCHAR(`?') ; PRINT QUESTION MARK
; --------------------------------
; PRINT CHAR FROM (A)
;
; NOTE: POKE 243,32 ($20 IN $F3) WILL CONVERT
; OUTPUT TO LOWER CASE. THIS CAN BE CANCELLED
; BY NORMAL, INVERSE, OR FLASH OR POKE 243,0.
; --------------------------------
OUTDO ORA #$80 ; PRINT (A)
CMP #$A0 ; CONTROL CHR?
BCC L_OUTDO_1 ; SKIP IF SO
ORA FLASH_BIT ; =$40 FOR FLASH, ELSE $00
L_OUTDO_1 JSR MON_COUT ; "AND"S WITH $3F (INVERSE), $7F (FLASH)
AND #$7F ;
PHA ;
LDA SPEEDZ ; COMPLEMENT OF SPEED #
JSR MON_WAIT ; SO SPEED=255 BECOMES (A)=1
PLA
RTS
; --------------------------------
; INPUT CONVERSION ERROR: ILLEGAL CHARACTER
; IN NUMERIC FIELD. MUST DISTINGUISH
; BETWEEN INPUT, READ, AND GET
; --------------------------------
INPUTERR
LDA INPUTFLG
BEQ RESPERR ; TAKEN IF INPUT
BMI READERR ; TAKEN IF READ
LDY #$FF ; FROM A GET
BNE ERLIN ; ...ALWAYS
; --------------------------------
READERR
LDA DATLIN ; TELL WHERE THE "DATA" IS, RATHER
LDY DATLIN+1 ; THAN THE "READ"
; --------------------------------
ERLIN STA CURLIN
STY CURLIN+1
JMP SYNERR
; --------------------------------
INPERR PLA
; --------------------------------
RESPERR
BIT ERRFLG ; "ON ERR" TURNED ON?
BPL L_RESPERR_1 ; NO, GIVE REENTRY A TRY
LDX #254 ; ERROR CODE = 254
JMP HANDLERR
L_RESPERR_1 LDA #<ERR_REENTRY ; "?REENTER"
LDY #>ERR_REENTRY
JSR STROUT
LDA OLDTEXT ; RE-EXECUTE THE WHOLE INPUT STATEMENT
LDY OLDTEXT+1
STA TXTPTR
STY TXTPTR+1
RTS
; --------------------------------
; "GET" STATEMENT
; --------------------------------
GET JSR ERRDIR ; ILLEGAL IF IN DIRECT MODE
LDX #<(INPUT_BUFFER+1) ; SIMULATE INPUT
LDY #>(INPUT_BUFFER+1)
LDA #0
STA INPUT_BUFFER+1
LDA #$40 ; SET UP INPUTFLG
JSR PROCESS_INPUT_LIST ; <<< CAN SAVE 1 BYTE HERE>>>
RTS ; <<<BY "JMP PROCESS.INPUT.LIST">>>
; --------------------------------
; "INPUT" STATEMENT
; --------------------------------
INPUT CMP #$22 ; CHECK FOR OPTIONAL PROMPT STRING
BNE L_INPUT_1 ; NO, PRINT "?" PROMPT
JSR STRTXT ; MAKE A PRINTABLE STRING OUT OF IT
LDA #LOCHAR(`;') ; MUST HAVE ; NOW
JSR SYNCHR ;
JSR STRPRT ; PRINT THE STRING
JMP L_INPUT_2 ;
L_INPUT_1 JSR OUTQUES ; NO STRING, PRINT "?"
L_INPUT_2 JSR ERRDIR ; ILLEGAL IF IN DIRECT MODE
LDA #LOCHAR(`,') ; PRIME THE BUFFER
STA INPUT_BUFFER-1
JSR INLIN
LDA INPUT_BUFFER
CMP #$03 ; CONTROL C?
BNE INPUT_FLAG_ZERO ; NO
JMP CONTROL_C_TYPED
; --------------------------------
NXIN JSR OUTQUES ; PRINT "?"
JMP INLIN
; --------------------------------
; "READ" STATEMENT
; --------------------------------
READ LDX DATPTR ; Y,X POINTS AT NEXT DATA STATEMENT
LDY DATPTR+1 ;
LDA #$98 ; SET INPUTFLG = $98
ASM_DATA($2C) ; TRICK TO PROCESS.INPUT.LIST
; --------------------------------
INPUT_FLAG_ZERO LDA #0 ; SET INPUTFLG = $00
; --------------------------------
; PROCESS INPUT LIST
;
; (Y,X) IS ADDRESS OF INPUT DATA STRING
; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
; $40 FOR GET
; $98 FOR READ
; --------------------------------
PROCESS_INPUT_LIST STA INPUTFLG
STX INPTR ; ADDRESS OF INPUT STRING
STY INPTR+1
; --------------------------------
PROCESS_INPUT_ITEM JSR PTRGET ; GET ADDRESS OF VARIABLE
STA FORPNT ;
STY FORPNT+1 ;
LDA TXTPTR ; SAVE CURRENT TXTPTR,
LDY TXTPTR+1 ; WHICH POINTS INTO PROGRAM
STA TXPSV ;
STY TXPSV+1 ;
LDX INPTR ; SET TXTPTR TO POINT AT INPUT BUFFER
LDY INPTR+1 ; OR "DATA" LINE
STX TXTPTR ;
STY TXTPTR+1 ;
JSR CHRGOT ; GET CHAR AT PNTR
BNE INSTART ; NOT END OF LINE OR COLON
BIT INPUTFLG ; DOING A "GET"?
BVC L_PROCESS_INPUT_ITEM_1 ; NO
JSR MON_RDKEY ; YES, GET CHAR
AND #$7F
STA INPUT_BUFFER
LDX #<(INPUT_BUFFER-1)
LDY #>(INPUT_BUFFER-1)
BNE L_PROCESS_INPUT_ITEM_2 ; ...ALWAYS
; --------------------------------
L_PROCESS_INPUT_ITEM_1 BMI FINDATA ; DOING A "READ"
JSR OUTQUES ; DOING AN "INPUT", PRINT "?"
JSR NXIN ; PRINT ANOTHER "?", AND INPUT A LINE
L_PROCESS_INPUT_ITEM_2 STX TXTPTR
STY TXTPTR+1
; --------------------------------
INSTART
JSR CHRGET ; GET NEXT INPUT CHAR
BIT VALTYP ; STRING OR NUMERIC?
BPL L_INSTART_5 ; NUMERIC
BIT INPUTFLG ; STRING -- NOW WHAT INPUT TYPE?
BVC L_INSTART_1 ; NOT A "GET"
INX ; "GET"
STX TXTPTR
LDA #0
STA CHARAC ; NO OTHER TERMINATORS THAN $00
BEQ L_INSTART_2 ; ...ALWAYS
; --------------------------------
L_INSTART_1 STA CHARAC
CMP #$22 ; TERMINATE ON $00 OR QUOTE
BEQ L_INSTART_3
LDA #LOCHAR(`:') ; TERMINATE ON $00, COLON, OR COMMA
STA CHARAC
LDA #LOCHAR(`,')
L_INSTART_2 CLC
L_INSTART_3 STA ENDCHR
LDA TXTPTR
LDY TXTPTR+1
ADC #0 ; SKIP OVER QUOTATION MARK, IF
BCC L_INSTART_4 ; THERE WAS ONE
INY
L_INSTART_4 JSR STRLT2 ; BUILD STRING STARTING AT (Y,A)
; TERMINATED BY $00, (CHARAC), OR (ENDCHR)
JSR POINT ; SET TXTPTR TO POINT AT STRING
JSR PUTSTR ; STORE STRING IN VARIABLE
JMP INPUT_MORE
; --------------------------------
L_INSTART_5 PHA
LDA INPUT_BUFFER ; ANYTHING IN BUFFER?
BEQ INPFIN ; NO, SEE IF READ OR INPUT
; --------------------------------
INPUTDWTA
PLA ; "READ"
JSR FIN ; GET FP NUMBER AT TXTPTR
LDA VALTYP+1 ;
JSR LET2 ; STORE RESULT IN VARIABLE
; --------------------------------
INPUT_MORE
JSR CHRGOT
BEQ L_INPUT_MORE_1 ; END OF LINE OR COLON
CMP #LOCHAR(`,') ; COMMA IN INPUT?
BEQ L_INPUT_MORE_1 ; YES
JMP INPUTERR ; NOTHING ELSE WILL DO
L_INPUT_MORE_1 LDA TXTPTR ; SAVE POSITION IN INPUT BUFFER
LDY TXTPTR+1 ;
STA INPTR ;
STY INPTR+1 ;
LDA TXPSV ; RESTORE PROGRAM POINTER
LDY TXPSV+1 ;
STA TXTPTR ;
STY TXTPTR+1 ;
JSR CHRGOT ; NEXT CHAR FROM PROGRAM
BEQ INPDONE ; END OF STATEMENT
JSR CHKCOM ; BETTER BE A COMMA THEN
JMP PROCESS_INPUT_ITEM
; --------------------------------
INPFIN LDA INPUTFLG ; "INPUT" OR "READ"
BNE INPUTDWTA ; "READ"
JMP INPERR
; --------------------------------
FINDATA
JSR DATAN ; GET OFFSET TO NEXT COLON OR EOL
INY ; TO FIRST CHAR OF NEXT LINE
TAX ; WHICH: EOL OR COLON?
BNE L_FINDATA_1 ; COLON
LDX #ERR_NODATA ; EOL: MIGHT BE OUT OF DATA
INY ; CHECK HI-BYTE OF FORWARD PNTR
LDA (TXTPTR),Y ; END OF PROGRAM?
BEQ GERR ; YES, WE ARE OUT OF DATA
INY ; PICK UP THE LINE #
LDA (TXTPTR),Y
STA DATLIN
INY
LDA (TXTPTR),Y
INY ; POINT AT FIRST TEXT CHAR IN LINE
STA DATLIN+1
L_FINDATA_1 LDA (TXTPTR),Y ; GET 1ST TOKEN OF STATEMENT
TAX ; SAVE TOKEN IN X-REG
JSR ADDON ; ADD (Y) TO TXTPTR
CPX #TOKENDWTA ; DID WE FIND A "DATA" STATEMENT?
BNE FINDATA ; NOT YET
JMP INSTART ; YES, READ IT
; ---NO MORE INPUT REQUESTED------
INPDONE
LDA INPTR ; GET POINTER IN CASE IT WAS "READ"
LDY INPTR+1
LDX INPUTFLG ; "READ" OR "INPUT"?
BPL L_INPDONE_1 ; "INPUT"
JMP SETDA ; "DATA", SO STORE (Y,X) AT DATPTR
L_INPDONE_1 LDY #0 ; "INPUT": ANY MORE CHARS ON LINE?
LDA (INPTR),Y
BEQ L_INPDONE_2 ; NO, ALL IS WELL
LDA #<ERR_EXTRA ; YES, ERROR
LDY #>ERR_EXTRA ; "EXTRA IGNORED"
JMP STROUT
L_INPDONE_2 RTS
; --------------------------------
ERR_EXTRA LOASCII(`?EXTRA IGNORED')
ASM_DATA($0D,0)
ERR_REENTRY LOASCII(`?REENTER')
ASM_DATA($0D,0)
; --------------------------------
; --------------------------------
; "NEXT" STATEMENT
; --------------------------------
NEXT BNE NEXT_1 ; VARIABLE AFTER "NEXT"
LDY #0 ; FLAG BY SETTING FORPNT+1 = 0
BEQ NEXT_2 ; ...ALWAYS
; --------------------------------
NEXT_1 JSR PTRGET ; GET PNTR TO VARIABLE IN (Y,A)
NEXT_2 STA FORPNT
STY FORP