mirror of
https://github.com/trudnai/Steve2.git
synced 2024-12-12 16:30:10 +00:00
6915 lines
282 KiB
ArmAsm
6915 lines
282 KiB
ArmAsm
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 FORPNT+1
|
|
JSR GTFORP |