PAG
*****************************
*                           *
*    Applesoft - Part A     *
*                           *
* Copywrite Apple Computer, *
* Inc. and Microsoft, Inc.; *
* not for publication or    *
* distribution.             *
*                           *
*****************************
*                           *
*   Input parsing,          *
*   Routine addressing,     *
*   For-next loops, etc.    *
*                           *
*      $D000 - $DD66        *
*                           *
*****************************

* Equates for all parts:

* Applesoft tokens:

for = $81
data = $83
pop = $A1
goto = $AB
gosub = $B0
rem = $B2
print = $BA
tab = $C0
to = $C1
fn = $C2
spc = $C3
then = $C4
at = $C5
not = $C6
step = $C7
plus = $C8
minus = $C9
equal = $D0
sgn = $D2
scrn = $D7
leftstr = $E8

* Zero page locations:

GOWARM = 0 ;Set up by cold start
GOSTROUT = 3 ; but not used anywhere.
USR = $A
CHARAC = $D
ENDCHR = $E
PNTR = $F
NUMDIM = $F ;Used in array rtns
DIMFLG = $10
VALTYP = $11 ;$FF for string, 0 if numeric
INTFLG = $12 ;- for int var
DATAFLG = $13 ;Used in PARSE
GARFLG = DATAFLG ;Used in GARBAG
SUBFLG = $14
INPUTFLG = $15 ;Has $40 for GET, $98 for READ
CPRMASK = $16 ;Receives CPRTYP in FRMEVL
SIGNFLG = $16 ;Flags sign in TAN
SHAPEL = $1A
SHAPEH = $1B
HCOLOR1 = $1C
COUNTH = $1D
WNDWDTH = $21
CH = $24
GBASL = $26
GBASH = $27
H2 = $2C
V2 = $2D
MASK = $2E ;Used by //c only
HMASK = $30
INVFLG = $32
PROMPT = $33
A1L = $3C
A1H = $3D
A2L = $3E
A2H = $3F
LINNUM = $50
TEMPPT = $52
LASTPT = $53
TEMPST = $55
INDEX = $5E
DEST = $60
RESULT = $62
TXTTAB = $67
VARTAB = $69
ARYTAB = $6B
STREND = $6D
FRETOP = $6F
FRESPC = $71
MEMSIZ = $73
CURLIN = $75
OLDLIN = $77
OLDTEXT = $79
DATLIN = $7B
DATPTR = $7D
INPTR = $7F
VARNAM = $81 ;$:+-, %:--, real:++, fnc:-+
VARPNT = $83
FORPNT = $85
TXPSV = $87 ;Used in INPUT
LASTOP = $87 ;Scratch flag used in FRMEVL
CPRTYP = $89 ;>,=,< flag in FRMEVL
FNCNAM = $8A
DSCPTR = $8C
DSCLEN = $8F ;Used in GARBAG
JMPADRS = $90
LENGTH = $91 ;Used in GARBAG
ARYPNT = $94 ;Used in GARBAG
HIGHDS = $94
HIGHTR = $96
INDX = $99 ;Used by array rtns
LOWTR = $9B
DSCTMP = $9D
VPNT = $A0 ;Temp var ptr
EXTRASV = $92 ;FP extra precision
TEMP1 = $93 ;Save areas for FAC
TEMP2 = $98
TEMP3 = $8A
TMPEXP = $99 ;Used in FIN (EVAL)
EXPON = $9A ; "
DPFLG = $9B ;Flags dec pnt in FIN
EXPSGN = $9C ; "  sign of exp in FIN
FAC = $9D ;Primary floating pnt acc
SERLEN = $A3 ;Holds length of series-1
FPGEN = $A4
ARG = $A5 ;Secondary fp acc
FACSGN = FAC+5 ;Holds unpacked sign
ARGSGN = ARG+5
SGNCPR = $AB ;Flags opp sign in FP rout.
EXTRAFAC = $AC ;FP precision
SERPNT = $AD ;Pntr to series data in FP
STRNG1 = $AB
STRNG2 = $AD
PRGEND = $AF
CHRGET = $B1
CHRGOT = $B7
TXTPTR = $B8
RNDSEED = $C9
DXL = $D0
DXH = $D1
DY = $D2
QDRNT = $D3
EL = $D4
EH = $D5
LOCK = $D6 ;Prevents user access if -
ERRFLG = $D8
ERRLIN = $DA
ERRPOS = $DC
ERRNUM = $DE
ERRSTK = $DF
X0L = $E0
X0H = $E1
Y0 = $E2
HCOLORZ = $E4
HNDX = $E5
HPAG = $E6
SCALEZ = $E7
SHAPEPNT = $E8
COLCOUNT = $EA
FIRST = $F0
SPEEDZ = $F1 ;Output speed
TRCFLG = $F2
ORMASK = $F3 ;Has $40 for flash
TXTPSV = $F4
CURLSV = $F6
REMSTK = $F8
ROTZ = $F9
* $FF is also used by the string out rtns.

* Apple stuff:

STACK = $100
IN = $200
AMPER = $3F5
OURCH = $57B ;New roms & //c
KEY = $C000
SLOTROM = $C006 ;Used only by new
INTROM = $C007 ; //e roms
RD80ST = $C018
RD80COL = $C01F
TXTCLR = $C050
MIXCLR = $C052
MIXSET = $C053
LOWSCR = $C054
HISCR = $C055
LORES = $C056
HIRES = $C057
RDDOUBHG = $C079
MONPLOT = $F800
PLOT1 = $F80E ;//c roms only
HLINE = $F819
PREAD = $FB1E
VLINE = $F828
GBASCALC = $F847 ; "
SETCOL = $F864
SCRN = $F871
SETTXT = $FB39
SETGR = $FB40
SETWND = $FB4B ; "
TABV = $FB5B
HOME = $FC58
MONWAIT = $FCA8
RD2BIT = $FCFA
RDKEY = $FD0C
GETLN = $FD6A
COUT = $FDED
INPORT = $FE8B
OUTPORT = $FE95
WRITE = $FECD
MONREAD = $FEFD
MONREAD2 = $FF02

 DO APPLEC
SHLOAD = AMPER
RECALL = AMPER
STORE = AMPER
LOAD = AMPER
SAVE = AMPER
 FIN

CMDTABL DA END-1
 DA FOR-1
 DA NEXT-1
 DA DATA-1
 DA INPUT-1
 DA DEL-1
 DA DIM-1
 DA READ-1
 DA GR-1
 DA TEXT-1
 DA PRNU-1
 DA INNU-1
 DA CALL-1
 DA PLOT-1
 DA HLIN-1
 DA VLIN-1
 DA HGR2-1
 DA HGR-1
 DA HCOLOR-1
 DA HPLOT-1
 DA DRAW-1
 DA XDRAW-1
 DA HTAB-1
 DA HOME-1
 DA ROT-1
 DA SCALE-1
 DA SHLOAD-1
 DA TRACE-1
 DA NOTRACE-1
 DA NORMAL-1
 DA INVERSE-1
 DA FLASH-1
 DA COLOR-1
 DA POP-1
 DA VTAB-1
 DA HIMEM-1
 DA LOMEM-1
 DA ONERR-1
 DA RESUME-1
 DA RECALL-1
 DA STORE-1
 DA SPEED-1
 DA LET-1
 DA GOTO-1
 DA RUN-1
 DA IF-1
 DA RESTORE-1
 DA AMPER-1
 DA GOSUB-1
 DA POP-1 ;RETURN
 DA REM-1
 DA STOP-1
 DA ONGOTO-1
 DA WAIT-1
 DA LOAD-1
 DA SAVE-1
 DA DEF-1
 DA POKE-1
 DA PRINT-1
 DA CONT-1
 DA LIST-1
 DA CLEAR-1
 DA GET-1
 DA NEW-1
UNFNC DA SGN
 DA INT
 DA ABS
 DA USR
 DA FRE
 DA ERROR ;SCRN done special
 DA PDL
 DA POS
 DA SQR
 DA RND
 DA LOG
 DA EXP
 DA COS
 DA SIN
 DA TAN
 DA ATN
 DA PEEK
 DA LEN
 DA STR
 DA VAL
 DA ASC
 DA CHRSTR
 DA LEFTSTR
 DA RIGHTSTR
 DA MIDSTR

* The hex #s are for preference testing:

MATHTBL HEX 79
 DA FADDT-1
 HEX 79
 DA FSUBT-1
 HEX 7B
 DA FMULTT-1
 HEX 7B
 DA FDIVT-1
 HEX 7D
 DA FPWRT-1
 HEX 50
 DA AND-1
 HEX 46
 DA OR-1
MINUS HEX 7F
 DA NEGOP-1 ;Unary minus
UNOT HEX 7F
 DA EQUOP-1 ;Unary NOT
PLUS HEX 64
 DA POSOP-1 ;Used by <=>

TOKTABL DCI 'END'
 DCI 'FOR'
 DCI 'NEXT'
 DCI 'DATA'
 DCI 'INPUT'
 DCI 'DEL'
 DCI 'DIM'
 DCI 'READ'
 DCI 'GR'
 DCI 'TEXT'
 DCI 'PR#'
 DCI 'IN#'
 DCI 'CALL'
 DCI 'PLOT'
 DCI 'HLIN'
 DCI 'VLIN'
 DCI 'HGR2'
 DCI 'HGR'
 DCI 'HCOLOR='
 DCI 'HPLOT'
 DCI 'DRAW'
 DCI 'XDRAW'
 DCI 'HTAB'
 DCI 'HOME'
 DCI 'ROT='
 DCI 'SCALE='
 DCI 'SHLOAD'
 DCI 'TRACE'
 DCI 'NOTRACE'
 DCI 'NORMAL'
 DCI 'INVERSE'
 DCI 'FLASH'
 DCI 'COLOR='
 DCI 'POP'
 DCI 'VTAB'
 DCI 'HIMEM:'
 DCI 'LOMEM:'
 DCI 'ONERR'
 DCI 'RESUME'
 DCI 'RECALL'
 DCI 'STORE'
 DCI 'SPEED='
 DCI 'LET'
 DCI 'GOTO'
 DCI 'RUN'
 DCI 'IF'
 DCI 'RESTORE'
 ASC "&"
 DCI 'GOSUB'
 DCI 'RETURN'
 DCI 'REM'
 DCI 'STOP'
 DCI 'ON'
 DCI 'WAIT'
 DCI 'LOAD'
 DCI 'SAVE'
 DCI 'DEF'
 DCI 'POKE'
 DCI 'PRINT'
 DCI 'CONT'
 DCI 'LIST'
 DCI 'CLEAR'
 DCI 'GET'
 DCI 'NEW'
 DCI 'TAB('
 DCI 'TO'
 DCI 'FN'
 DCI 'SPC('
 DCI 'THEN'
 DCI 'AT'
 DCI 'NOT'
 DCI 'STEP'
 ASC "+"
 ASC "-"
 ASC "*"
 ASC "/"
 ASC "^"
 DCI 'AND'
 DCI 'OR'
 ASC ">"
 ASC "="
 ASC "<"
 DCI 'SGN'
 DCI 'INT'
 DCI 'ABS'
 DCI 'USR'
 DCI 'FRE'
 DCI 'SCRN('
 DCI 'PDL'
 DCI 'POS'
 DCI 'SQR'
 DCI 'RND'
 DCI 'LOG'
 DCI 'EXP'
 DCI 'COS'
 DCI 'SIN'
 DCI 'TAN'
 DCI 'ATN'
 DCI 'PEEK'
 DCI 'LEN'
 DCI 'STR$'
 DCI 'VAL'
 DCI 'ASC'
 DCI 'CHR$'
 DCI 'LEFT$'
 DCI 'RIGHT$'
 DCI 'MID$'
 BRK

ERRMSG
NXwoFOR DCI 'NEXT WITHOUT FOR'
SYNTXERR DCI 'SYNTAX'
RTNwoGSB DCI 'RETURN WITHOUT GOSUB'
OofDATA DCI 'OUT OF DATA'
ILLQUAN DCI 'ILLEGAL QUANTITY'
OVFLOW DCI 'OVERFLOW'
OofMEM DCI 'OUT OF MEMORY'
UNDSTAT DCI *UNDEF'D STATEMENT*
BADSUBS DCI 'BAD SUBSCRIPT'
REdimARR DCI *REDIM'D ARRAY*
DIVbyZRO DCI 'DIVISION BY ZERO'
ILLDIR DCI 'ILLEGAL DIRECT'
TYPEMISS DCI 'TYPE MISMATCH'
STRtoLNG DCI 'STRING TOO LONG'
FORMtoCX DCI 'FORMULA TOO COMPLEX'
CANTCON DCI *CAN'T CONTINUE*
UNDFUNC DCI *UNDEF'D FUNCTION*

ERRIN ASC ' ERROR'0700
INMSG ASC ' IN '00
BREAKIN HEX 0D
 ASC 'BREAK'0700

GTFORPNT TSX ;Search through stack
 LUP 4 ; for FOR data
 INX
 --^
:L LDA STACK+1,X
 CMP #for
 BNE RET1
 LDA FORPNT+1
 BNE :SAME ;Taken if var specified
 LDA STACK+2,X ;Get FOR var pointer
 STA FORPNT
 LDA STACK+3,X
 STA FORPNT+1
:SAME CMP STACK+3,X ;Compare FOR var adrs
 BNE :NX ;Branch if not same
 LDA FORPNT
 CMP STACK+2,X
 BEQ RET1
:NX TXA ;Not correct FOR,
 CLC ; set up to look at next.
 ADC #$12
 TAX
 BNE :L
RET1 RTS

BLTU JSR REASON ;Is there room?
 STA STREND ;Set top of array storage to A,Y
 STY STREND+1

* Set up to move upwards LOWTR through HIGHTR-1
* to just below HIGHDS:

BLTU2 SEC
 SB HIGHTR;LOWTR;INDEX
 TAY
 LDA HIGHTR+1
 SBC LOWTR+1
 TAX
 INX
 TYA
 BEQ :NXP ;Taken if no partial page
 LDA HIGHTR ;Prepare to move partial page
 SEC ; first to maximize speed
 SBC INDEX
 STA HIGHTR
 BCS :OV
 DEC HIGHTR+1
 SEC
:OV SB HIGHDS;INDEX;HIGHDS
 BCS :NXB
 DEC HIGHDS+1
 BCC :NXB
:BL LDA (HIGHTR),Y ;Now do the move
 STA (HIGHDS),Y
:NXB DEY
 BNE :BL
 LDA (HIGHTR),Y
 STA (HIGHDS),Y
:NXP DEC HIGHTR+1
 DEC HIGHDS+1
 DEX ;Another page to move?
 BNE :NXB
 RTS

* Stack memory check used by FOR, GOSUB, FRMEVL:

CHKMEM ASL ;Entered with A=1, 3, or 9
 ADC #$36
 BCS MEMERR ;Never taken
 STA INDEX
 TSX
 CPX INDEX
 BCC MEMERR
 RTS

REASON CPY FRETOP+1 ;Check that A,Y < FRETOP
 BCC :RET ;Return if so.
 BNE :R1 ;Clean shop if not.
 CMP FRETOP
 BCC :RET
:R1 PHA ;Save A,Y and TEMP1 & TEMP2
 LDX #FAC-TEMP1-1
 TYA
:R2 PHA
 LDA TEMP1,X
 DEX
 BPL :R2
 JSR GARBAG ;Collection time
 LDX #TEMP1-FAC+1
:R3 PLA ;Restore TEMP1 & 2 and A,Y.
 STA FAC,X
 INX
 BMI :R3
 PLA
 TAY
 PLA ;Is there room now?
 CPY FRETOP+1
 BCC :RET ;Return if so
 BNE MEMERR ;Memory error if not.
 CMP FRETOP
 BCS MEMERR
:RET RTS

MEMERR LDX #OofMEM-ERRMSG
ERROR BIT ERRFLG ;ONERR active?
 BPL DOERRMSG ;Branch if not
 JMP HANDLERR

DOERRMSG JSR CRDO
 JSR OUTQUES
:EL LDA ERRMSG,X
 PHA
 JSR OUTDO
 INX
 PLA
 BPL :EL
 JSR STKINI
 LDA #ERRIN
 LDY #>ERRIN
PRNTIN? JSR STROUT
 LDY CURLIN+1 ;Direct mode?
 INY
 BEQ RESTART ;Branch if so
 JSR INPRT

RESTART JSR CRDO
 LDX #"]"
 JSR INLIN2 ;Get direct input
 STX TXTPTR ;Point to input buff
 STY TXTPTR+1
 LSR ERRFLG ;Defeat ONERR
 JSR CHRGET
 TAX
 BEQ RESTART ;If no input
 LDX #$FF ;Set direct mode flag
 STX CURLIN+1 ; = high byte of CURLIN.
 BCC NXLIN ;Branch if line # given
 JSR GETIN ;Otherwise parse
 JMP TRACE? ;and act on command.
NXLIN TRX PRGEND;VARTAB
 JSR LINGET ;Get line #
 JSR GETIN ;and parse input
 STY PNTR ;Save index to input buffer
 JSR FNDLIN ;Is line there now?
 BCC :NEWLN ;Branch if not
 LDY #1 ;If line is there, delete it.
 LDA (LOWTR),Y ;Get link high
 STA INDEX+1
 MOV VARTAB;INDEX
 MOV LOWTR+1;DEST+1
 LDA LOWTR
 DEY
 SBC (LOWTR),Y ;Line-link
 CLC
 ADC VARTAB
 STA VARTAB ;New prog end
 STA DEST
 LDA VARTAB+1
 ADC #$FF
 STA VARTAB+1
 SBC LOWTR+1
 TAX
 SEC
 LDA LOWTR
 SBC VARTAB
 TAY ;Index to move partial page
 BCS :OV
 INX
 DEC DEST+1
:OV CLC
 ADC INDEX
 BCC :MD
 DEC INDEX+1
 CLC
:MD LDA (INDEX),Y ;Move rest of program
 STA (DEST),Y ;to deleted line's place.
 INY
 BNE :MD
 INC INDEX+1
 INC DEST+1
 DEX ;Another page to move?
 BNE :MD
:NEWLN LDA IN ;Line # alone?
 BEQ LINKSET ;Skip to LINKSET if so.
 TRAY MEMSIZ;FRETOP
 LDA VARTAB ;Set up memory move to
 STA HIGHTR ;insert new line.
 ADC PNTR
 STA HIGHDS
 LDY VARTAB+1
 STY HIGHTR+1
 BCC :MVPROG
 INY
:MVPROG STY HIGHDS+1
 JSR BLTU ;Do the move
 TRAY LINNUM;IN-2
 TRAY STREND;VARTAB
 LDY PNTR
:INSRT LDA IN-5,Y ;Insert new line
 DEY
 STA (LOWTR),Y
 BNE :INSRT
;Note LINKSET can be called
LINKSET JSR SETPTRS ;by typing 0[RTN]
 TRAY TXTTAB;INDEX
 CLC
:NXLNK LDY #1
 LDA (INDEX),Y
 BNE :PUTLNK
 MOVD VARTAB;PRGEND
 JMP RESTART
:PUTLNK LDY #4 ;Set up links
:FNDEOL INY
 LDA (INDEX),Y
 BNE :FNDEOL
 INY
 TYA
 ADC INDEX
 TAX
 LDY #0
 STA (INDEX),Y
 LDA INDEX+1
 ADC #0
 INY
 STA (INDEX),Y
 STX INDEX
 STA INDEX+1
 BCC :NXLNK

INLIN LDX #$80
INLIN2 STX PROMPT
 JSR GETLN
 CPX #$EF
 BCC GDBUFS
 LDX #$EF ;Terminate line at $EF chrs
GDBUFS LDA #0 ;Set up eol marker
 STA IN,X
 TXA
 BEQ :NI
:STRIP LDA IN-1,X ;Convert to + ascii
 AND #$7F
 STA IN-1,X
 DEX
 BNE :STRIP
:NI LDA #0
 LDX #IN-1
 LDY #>IN-1
 RTS

INCHR JSR RDKEY
 AND #$7F
 RTS

GETIN LDX TXTPTR
 DEX
 LDY #4
 STY DATAFLG
 BIT LOCK ;Program protected?
 BPL PARSE
 PLA ;If so, ignore input
 PLA ;and run program again.
 JSR SETPTRS
 JMP NEWSTT

PARSE INX
NXCHR
 DO NEWROMS
 JSR GETUPC
 ELSE
 LDA IN,X
 FIN
 BIT DATAFLG
 BVS :SE ;Branch if DATA stmnt
 CMP #' '
 BEQ PARSE
:SE STA ENDCHR
 CMP #'"'
 BEQ :SIN
 BVS :PUTIN ;Branch if DATA stmnt
 CMP #'?'
 BNE :TOK
 LDA #print
 BNE :PUTIN ;Always
:TOK CMP #'0'
 BLT :ISTOK
 CMP #'<'
 BLT :PUTIN
:ISTOK STY STRNG2
 LDA #TOKTABL-$100
 STA FAC
 LDA #>TOKTABL-$100
 STA FAC+1
 LDY #0
 STY PNTR ;Holds current token-$80
 DEY
 STX TXTPTR
 DEX
:NY INY
 BNE :NX
 INC FAC+1
:NX INX
:LIN
 DO NEWROMS
 JSR GETUPC
 ELSE
 LDA IN,X
 FIN
 CMP #' ' ;Skip spaces
 BEQ :NX
 SEC
 SBC (FAC),Y ;Does it match keyword?
 BEQ :NY ;Next chr if so
 CMP #$80 ;Match last keyword chr?
 BNE :SKIPTOK ;Skip to next token if not
 ORA PNTR ;Get token
 CMP #at
 BNE :PUTTOK
 DO NEWROMS
 JSR GETUPC0
 ELSE
 LDA IN+1,X
 FIN
 CMP #'N' ;Preferance to ATN
 BEQ :SKIPTOK
 CMP #'O' ;Preferance to TO
 BEQ :SKIPTOK
 LDA #at
:PUTTOK LDY STRNG2
:PUTIN INX
 INY
 STA IN-5,Y
 LDA IN-5,Y
 BEQ :DONE
 SEC
 SBC #':'
 BEQ :SD ;Reset DATAFLG at stmnt end
 CMP #data-':'
 BNE :REM?
:SD STA DATAFLG
:REM? SEC
 SBC #rem-':'
 BNE NXCHR
 STA ENDCHR ;Clear literal flag
:SFTIN
 DO NEWROMS
 JSR GETUPC
 ELSE
 LDA IN,X
 FIN
 BEQ :PUTIN
 CMP ENDCHR
 BEQ :PUTIN
:SIN INY
 STA IN-5,Y
 INX
 BNE :SFTIN ;Loop till literal done
:SKIPTOK LDX TXTPTR
 INC PNTR ;Next token
:SK LDA (FAC),Y ;Skip over current keyword
 INY
 BNE :OV
 INC FAC+1
:OV ASL
 BCC :SK ;Loop till keyword skipped
 LDA (FAC),Y
 BNE :LIN ;Loop till keyword table done
 DO NEWROMS
 JSR INUPC
 ELSE
 LDA IN,X ;Not keyword
 FIN
 BPL :PUTTOK ;Always
:DONE STA IN-3,Y ;EOL in case in direct mode
 DEC TXTPTR+1 ;Point TXTPTR to IN-1
 LDA #$FF
 STA TXTPTR
 RTS

* Search program for line whose # is now in LINNUM.
* On exit: carry is set if found, clear if not,
* LOWTR points to line if found, to next one if not.

FNDLIN LDA TXTTAB ;Start search at prog start
 LDX TXTTAB+1
FL1 LDY #1 ;Start search at A,X
 STA LOWTR
 STX LOWTR+1
 LDA (LOWTR),Y ;Get link high
 BEQ :EOP ;Branch if end of program
 INY
 INY
 LDA LINNUM+1
 CMP (LOWTR),Y ;Compare line # high
 BCC RET3 ;If not found
 BEQ :OV
 DEY
 BNE :GETLNK ;Always - get next line
:OV LDA LINNUM
 DEY
 CMP (LOWTR),Y ;Line # low
 BCC RET3 ;Past line, not found
 BEQ RET3 ;If found
:GETLNK DEY
 LDA (LOWTR),Y ;Get next link high
 TAX
 DEY
 LDA (LOWTR),Y ; and low
 BCS FL1 ;Always
:EOP CLC
RET3 RTS

NEW BNE RET3 ;Branch if syntax error
SCRTCH LDA #0
 STA LOCK ;Enable user commands
 TAY
 STA (TXTTAB),Y
 INY
 STA (TXTTAB),Y
 LDA TXTTAB
 ADC #2 ;Carry is indeterminate
 STA VARTAB
 STA PRGEND
 LDA TXTTAB+1
 ADC #0
 STA VARTAB+1
 STA PRGEND+1
SETPTRS JSR STXTPT
 LDA #0
CLEAR BNE RET4
CLEARC TRAY MEMSIZ;FRETOP
 TRAY VARTAB;ARYTAB
 STA STREND
 STY STREND+1
 JSR RESTORE
STKINI LDX #TEMPST
 STX TEMPPT
 PLA
 TAY
 PLA
 LDX #$F8 ;Keep top of stack for
 TXS ; link and line #
 PHA ; (Could have used $FB here)
 TYA
 PHA
 LDA #0
 STA OLDTEXT+1 ;Defeat CONT
 STA SUBFLG
RET4 RTS

STXTPT CLC
 AD TXTTAB;#$FF;TXTPTR
 AD TXTTAB+1;#$FF;TXTPTR+1
 RTS

LIST BCC STRTRNG ;Line # specified?
 BEQ STRTRNG ;No
 CMP #minus ;Start range at 0 if so
 BEQ STRTRNG
 CMP #','
 BNE RET4
STRTRNG JSR LINGET ;Set LINNUM to start of rng
 JSR FNDLIN ;Point LOWTR to 1st line
 JSR CHRGOT ;Range specified?
 BEQ MAINLST ;Branch if not
 CMP #minus
 BEQ ENDRNG
 CMP #','
 BNE RET3
ENDRNG JSR CHRGET ;Update TXTPTR
 JSR LINGET ;Set LINNUM to end rng
 BNE RET4 ;Branch if syntax err
MAINLST PLA ;Pop rtn adrs
 PLA
 LDA LINNUM
 ORA LINNUM+1
 BNE :NXL
 LDA #$FF ;Max end range
 STA LINNUM
 STA LINNUM+1
:NXL LDY #1
 LDA (LOWTR),Y ;High byte of link
 BEQ :LISTED
 JSR ISCNTC ;Check for control C
 JSR CRDO
 INY
 LDA (LOWTR),Y ;Get line number
 TAX
 INY
 LDA (LOWTR),Y
 CMP LINNUM+1
 BNE :LSTD
 CPX LINNUM
 BEQ :LST1
:LSTD BCS :LISTED
:LST1 STY FORPNT
 DO NEWROMS
 JSR SPCLIN
 ELSE
 JSR LINPRT ;Print X,A
 FIN
 LDA #' '
:LL LDY FORPNT
 AND #$7F
:SNDCHR JSR OUTDO
 DO NEWROMS
 JSR GETCH
 NOP
 ELSE
 LDA CH
 CMP #33 ;If over 33, do CR
 FIN
 BCC :NCR
 JSR CRDO
 LDA #5 ; and tab over 5
 STA CH
:NCR INY
 LDA (LOWTR),Y
 BNE :TOKEN?
 TAY ;At end of line, get link
 LDA (LOWTR),Y
 TAX
 INY
 LDA (LOWTR),Y
 STX LOWTR ;Point to next line
 STA LOWTR+1
 BNE :NXL
:LISTED LDA #$D ;CR and out
 JSR OUTDO
 JMP NEWSTT

:GETCHR INY ;Pick up chr from table
 BNE :GC
 INC FAC+1
:GC LDA (FAC),Y
 RTS

:TOKEN? BPL :SNDCHR ;Branch if not token
 SEC
 SBC #$7F ;Make index to table
 TAX
 STY FORPNT ;Save line pointer
 LDY #TOKTABL-$100
 STY FAC ;Point FAC to table
 LDY #>TOKTABL-$100
 STY FAC+1
 LDY #$FF
:SKPTK DEX ;Count tokens versa X
 BEQ :PT
:TOKL JSR :GETCHR
 BPL :TOKL
 BMI :SKPTK
:PT LDA #' ' ;Token found, send space
 JSR OUTDO
:TOKLP JSR :GETCHR ; then token
 BMI :TOKDON
 JSR OUTDO
 BNE :TOKLP
:TOKDON JSR OUTDO ;Send last chr of token
 LDA #' ' ;Send end space
 BNE :LL ;Back to actual line

* FOR places following 18 bytes on stack:
*  TXTPTR
*  Line number
*  TO value (5 byte FP #)
*  STEP sign
*  STEP value (5 byte)
*  FORPNT (pointer to varl)
*  FOR token

FOR LDA #$80
 STA SUBFLG ;Subscripts not allowed
 JSR LET
 JSR GTFORPNT ;Is this FOR varl active?
 BNE FOR2 ;Branch if not
 TXA ;If so, cancel it and
 ADC #$F ; all subsequent ones.
 TAX
 TXS
FOR2 PLA
 PLA
 LDA #9
 JSR CHKMEM ;Check stack ptr >= $48
 JSR DATAN ;Point to next statement
 CLC ; and push this address.
 TYA
 ADC TXTPTR
 PHA
 LDA TXTPTR+1
 ADC #0
 PHA
 PUSH CURLIN
 LDA #to
 JSR SYNCHR
 JSR CHKNUM
 JSR FRMNUM
 LDA FACSGN
 ORA #$7F
 AND FAC+1
 STA FAC+1 ;Pack FAC
 LDA #STEP ;Set up for return
 LDY #>STEP ; to STEP
 STA INDEX
 STY INDEX+1
 JMP PUSHFAC ;Returns to STEP

* BUG: Note that this TO value has been packed
* BEFORE it is rounded (by PUSHFAC).  This can
* result in a positive number being converted into
* a negative one.  For example: FOR I=0 TO 2^35-1
* executes only once!

STEP LDA #ONE ;STEP default=1
 LDY #>ONE
 JSR MOVFM
 JSR CHRGOT
 CMP #step
 BNE ONESTEP
 JSR CHRGET ;Step specified, get it
 JSR FRMNUM
ONESTEP JSR SIGN
 JSR PSHFACX
 PUSH FORPNT
 LDA #for
 PHA
NEWSTT TSX ;Execute new statement
 STX REMSTK
 JSR ISCNTC
 LDA TXTPTR
 LDY TXTPTR+1
 LDX CURLIN+1 ;Direct mode
 INX
 BEQ :DIR ;Branch if so
 STA OLDTEXT ;Save TXTPTR if in program
 STY OLDTEXT+1 ; for possible CONT
:DIR LDY #0
 LDA (TXTPTR),Y ;At eol?
 BNE COLON? ;If not, is it a colon?
 LDY #2 ;If so, is link 0?
 LDA (TXTPTR),Y
 CLC
 BEQ GOEND ;Done if link 0
 INY
 LDA (TXTPTR),Y
 STA CURLIN ;If not done, save line #
 INY
 LDA (TXTPTR),Y
 STA CURLIN+1
 TYA
 BUMP TXTPTR ;And set up txtptr
TRACE? BIT TRCFLG ;Trace requested?
 BPL EXECUTE ;Branch if not
 LDX CURLIN+1
 INX
 BEQ EXECUTE ;Skip if direct command
 LDA #'#' ;Print "#"
 JSR OUTDO
 LDX CURLIN
 LDA CURLIN+1
 JSR LINPRT ;and the number
 JSR OUTSP
EXECUTE JSR CHRGET ;Get first chr of statement
 JSR GOCMD ;and start processing
 JMP NEWSTT ;Back for more

GOEND BEQ END4
GOCMD BEQ RET5
GOCMD2 SBC #$80 ;A token?
 BCC :NOTOK ;Branch if not
 CMP #$40 ;"Routine" type token?
 BCS JSY ;Syntax error if not
 ASL ;If a routine token,
 TAY ;then place routine address
 LDA CMDTABL+1,Y
 PHA ;on stack,
 LDA CMDTABL,Y
 PHA
 JMP CHRGET ;Get next chr & RTS to routine.
:NOTOK JMP LET ;Must be a variable assignment
COLON? CMP #':'
 BEQ TRACE?
JSY JMP SYNERR

RESTORE SEC
 LDA TXTTAB
 SBC #1
 LDY TXTTAB+1
 BCS SETDA
 DEY
SETDA STA DATPTR
 STY DATPTR+1
RET5 RTS

ISCNTC LDA KEY
 CMP #$83
 BEQ :GK
 RTS
:GK JSR INCHR
ERFLG? LDX #$FF ;Control C attempted
 BIT ERRFLG
 BPL :CTRC
 JMP HANDLERR
:CTRC CMP #3

STOP BCS END2

END CLC
END2 BNE RET6
 LDA TXTPTR
 LDY TXTPTR+1
 LDX CURLIN+1 ;Direct mode?
 INX
 BEQ END3 ;Branch if so
 STA OLDTEXT
 STY OLDTEXT+1
 TRAY CURLIN;OLDLIN
END3 PLA
 PLA
END4 LDA #BREAKIN
 LDY #>BREAKIN
 BCC GOSTART
 JMP PRNTIN?
GOSTART JMP RESTART

CONT BNE RET6
 LDX #CANTCON-ERRMSG
 LDY OLDTEXT+1
 BNE :C
 JMP ERROR
:C LDA OLDTEXT
 STA TXTPTR
 STY TXTPTR+1
 TRAY OLDLIN;CURLIN
RET6 RTS

 DO APPLEC

GETUPC0 LDA IN+1,X
 BPL CNVUPC ;Always
GETUPC LDA ENDCHR
 BEQ NOCNV ;Don't convert if REM
 CMP #'"'
 BEQ NOCNV ; or literal
 LDA DATAFLG
 CMP #data-':'
 BEQ NOCNV ; or DATA
INUPC LDA IN,X
CNVUPC PHP
 CMP #'a'
 BLT :PP
 AND #%01011111 ;Convert to upper case
:PP PLP
 RTS
NOCNV LDA IN,X
 RTS

SPCLIN PHA
 LDA #' '
 JSR OUTDO ;Precede line # with space
 PLA ; to ease editing
 JMP LINPRT

GETCH LDA CH
 CMP #40-7
 BIT RD80COL ;80 col mode?
 BPL :X ;Exit if not
 LDA OURCH
 CMP #80-7
:X RTS

GRPATCH LDA TXTCLR
 JSR GRCLEAR
 LDA #20
 JMP SETWND ;Set mixed mode

GRCLEAR LDY #39
 STY V2
 JSR IS80 ;Double gr enabled?
 LDA #39
 BCC :N80 ;Branch if 40 col
 ROL ;Times 2
:N80 TAY
:CLR LDA #0 ;Clear lores screen
 STA HMASK
 JSR NEWVLIN1
 DEY
 BPL :CLR
 RTS
 ERR \$D912
 DS $D912-* ;Fill with 0's

 ELSE

SAVE SUB PRGEND;TXTTAB;LINNUM
 JSR VARTIO
 JSR WRITE
 JSR PROGIO
 JMP WRITE
LOAD JSR VARTIO
 JSR MONREAD
 ADD TXTTAB;LINNUM;VARTAB
 MOV TEMPPT;LOCK
 JSR PROGIO
 JSR MONREAD
 BIT LOCK ;If neg byte read from tape
 BPL :LNK
 JMP SETPTRS ; then do auto run
:LNK JMP LINKSET

VARTIO LDA #LINNUM
 LDY #0
 STA A1L
 STY A1H
 LDA #TEMPPT
 STA A2L
 STY A2H
 STY LOCK
 RTS

PROGIO TRAY TXTTAB;A1L
 TRAY VARTAB;A2L
 RTS

 FIN

RUN PHP
 DEC CURLIN+1
 PLP
 BNE :RUNLIN ;Branch if line given
 JMP SETPTRS ;"Specify" program start
:RUNLIN JSR CLEARC ;Clear varls
 JMP GOLINE ;Go to line specified

* GOSUB leaves following on stack:
*  Return address (NEWSTT)
*  TXTPTR
*  line number
*  GOSUB token

GOSUB LDA #3
 JSR CHKMEM ;Check stack ptr >= $3C
 PUSH TXTPTR
 PUSH CURLIN
 LDA #gosub
 PHA
GOLINE JSR CHRGOT
 JSR GOTO
 JMP NEWSTT

GOTO JSR LINGET ;Get GOTO line
 JSR REMN ;Point Y to eol
 LDA CURLIN+1 ;Is current page < GOTO page?
 CMP LINNUM+1
 BCS :G1 ;Search from prog start if not
 TYA ;Otherwise search from next line
 SEC
 ADC TXTPTR
 LDX TXTPTR+1
 BCC :G2
 INX
 BCS :G2
:G1 LDA TXTTAB ;Get program beginning
 LDX TXTTAB+1
:G2 JSR FL1 ;Search for GOTO line
 BCC UNDERR ;Error if not there
;Point TXTPTR to GOTO line
 SB LOWTR;#1;TXTPTR
 SB LOWTR+1;#0;TXTPTR+1
RET7 RTS ;Return to NEWSTT or GOSUB

POP BNE RET7
 LDA #$FF
 STA FORPNT ;Bug: should be FORPNT+1
 JSR GTFORPNT ;To cancel FOR/NEXT in sub
 TXS
 CMP #gosub ;Last GOSUB found?
 BEQ RETURN
 LDX #RTNwoGSB-ERRMSG
 HEX 2C ;Trick to skip next line
UNDERR LDX #UNDSTAT-ERRMSG
 JMP ERROR

GSYNER JMP SYNERR

RETURN PLA
 PLA
 CPY #pop*2
 BEQ PULL3 ;Branch if a POP
 STA CURLIN ;Retrieve line #
 PLA
 STA CURLIN+1
 PULL TXTPTR ;and TXTPTR
DATA JSR DATAN ;Move to next statement
ADDON TYA
 CLC
 BUMP TXTPTR
RET8 RTS

DATAN LDX #':' ;Get offset in Y to eol or ":"
 HEX 2C ;Trick to skip next line
REMN LDX #0 ; " to eol only.
 STX CHARAC
 LDY #0
 STY ENDCHR
:R1 LDA ENDCHR ;Trick to count quote parity
 LDX CHARAC
 STA CHARAC
 STX ENDCHR
:R2 LDA (TXTPTR),Y
 BEQ RET8 ;If eol or
 CMP ENDCHR ; specified endchr
 BEQ RET8 ; then exit with Y=offset
 INY
 CMP #'"'
 BNE :R2 ;If not quote then continue
 BEQ :R1 ;Switch parity & continue

PULL3 PLA
 PLA
 PLA
 RTS

IF JSR FRMEVL
 JSR CHRGOT
 CMP #goto
 BEQ TRUE?
 LDA #then
 JSR SYNCHR
TRUE? LDA FAC ;Condition true or false?
 BNE IFTRUE ;Branch if true
REM JSR REMN ;Skip rest of line
 BEQ ADDON ;Always taken

IFTRUE JSR CHRGOT ;Command or number?
 BCS JGOCMD ;Branch if command
 JMP GOTO ;Go if #
JGOCMD JMP GOCMD ;Act on command

ONGOTO JSR GETBYT ;Get specified # in FAC+4
 PHA
 CMP #gosub
 BEQ ONCNT
GOTO? CMP #goto
 BNE GSYNER
ONCNT DEC FAC+4 ;Counted to right one yet?
 BNE :NXN ;No, keep looking
 PLA ;Yes, retrieve cmd
 JMP GOCMD2 ;and go.
:NXN JSR CHRGET
 JSR LINGET
 CMP #','
 BEQ ONCNT
 PLA ;Not found, so ignore
RET9 RTS

LINGET LDX #0 ;ASC # to HEX address
 STX LINNUM ;in LINNUM.
 STX LINNUM+1
ASCHEX BCS RET9 ;Exit routine on 1st non #
 SBC #'0'-1
 STA CHARAC
 LDA LINNUM+1
 STA INDEX
 CMP #$FA/10 ;Line # too large?
 BCS GOTO? ;Get error if so.
;(Note that GOTO xxxxxy
; where xxxxx is between
; 43776 and 44031 causes
; a jump to $22DA.  GOSUBs etc
; jump to other locations.)
 LDA LINNUM
 LUP 2
 ASL
 ROL INDEX
 --^
 ADC LINNUM
 STA LINNUM
 AD INDEX;LINNUM+1;LINNUM+1
 ASL LINNUM ;Previous # times 10
 ROL LINNUM+1
 AD LINNUM;CHARAC;LINNUM
 BCC NXDIG
 INC LINNUM+1 ; plus new digit
NXDIG JSR CHRGET
 JMP ASCHEX

LET JSR PTRGET
 STA FORPNT
 STY FORPNT+1
 LDA #equal
 JSR SYNCHR
 PUSH VALTYP
 JSR FRMEVL
 PLA
 ROL ;Rot VALTYP sign to carry
 JSR CHKVAL
 BNE LETSTR ;If a string
 PLA
LET2 BPL LETREAL
 JSR RNDB ;Integer var
 JSR AYINT
 LDY #0
 LDA VPNT
 STA (FORPNT),Y
 INY
 LDA VPNT+1
 STA (FORPNT),Y
 RTS
LETREAL JMP SETFOR
LETSTR PLA
PUTSTR LDY #2
 LDA (VPNT),Y
 CMP FRETOP+1
 BCC :COPS ;Branch if not in str space
 BNE :DSC
 DEY
 LDA (VPNT),Y
 CMP FRETOP
 BCC :COPS
:DSC LDY VPNT+1 ;Descriptor exist?
 CPY VARTAB+1
 BCC :COPS ;Copy if so
 BNE :NEWDSC
 LDA VPNT
 CMP VARTAB
 BCS :NEWDSC
:COPS LDA VPNT ;Just copy descriptor
 LDY VPNT+1
 JMP COPY
:NEWDSC LDY #0 ;Make new descriptor
 LDA (VPNT),Y
 JSR STRINI
 TRAY DSCPTR;STRNG1
 JSR MOVINS
 LDA #FAC
 LDY #0
COPY STA DSCPTR
 STY DSCPTR+1
 JSR FRETMS
 LDY #0
 LUP 2
 LDA (DSCPTR),Y
 STA (FORPNT),Y
 INY
 --^
 LDA (DSCPTR),Y
 STA (FORPNT),Y
 RTS

PRSTRING JSR STRPRT
 JSR CHRGOT
PRINT BEQ CRDO ;Branch if end of statement
PRINT2 BEQ RET10
 CMP #tab
 BEQ TABWHERE
 CMP #spc
 CLC
 BEQ TABWHERE
 CMP #','
 CLC ;No purpose to this
 BEQ TAB
 CMP #';'
 BEQ NEXTCHR
 JSR FRMEVL ;Evalute formula
 BIT VALTYP
 BMI PRSTRING ;Branch if string
 JSR FOUT ;Convert # in FAC to string
 JSR STRLIT ;Create temp descriptor
 JMP PRSTRING ;Print it

CRDO LDA #$D
 JSR OUTDO
NEGATE EOR #$FF
RET10 RTS

TAB
 DO NEWROMS
 JSR GETCH
 BMI :NXC ;Branch if 80 col &
; not near edge
 ELSE
 LDA CH
 FIN
 CMP #$18 ;This should be $20 (bug)
 BCC :NXC
 JSR CRDO
 BNE NEXTCHR ;Always
:NXC ADC #$10
 AND #$F0 ;Tabs 16, 32
 DO NEWROMS
 TAX
 SEC
 BCS SBCH
 ELSE
 STA CH
 BCC NEXTCHR ;Always
 FIN

TABWHERE PHP ;Remember SPC or TAB
 JSR GTBYTC
 CMP #')'
 DO NEWROMS
 BNE JSYNER
 ELSE
 BEQ :SPC?
 JMP SYNERR
 FIN ;Addresses now normal
:SPC? PLP
 BCC TABIT ;Branch if SPC
 DEX
 DO NEWROMS
SBCH JSR SUBCH
 ELSE
 TXA
 SBC CH ;Compute # of spcs to send
 FIN
 BCC NEXTCHR ;Branch if negative
 TAX
TABIT INX
NXSPC DEX
 BNE DOSPC
NEXTCHR JSR CHRGET ;Check for end of statement
 JMP PRINT2
DOSPC JSR OUTSP
 BNE NXSPC ;Always

STROUT JSR STRLIT ;Print string at (A,Y)
STRPRT JSR FREFAC ;Get pointer to string
 TAX ;Length
 LDY #0
 INX
NXCHAR DEX
 BEQ RET10 ;Exit if string done
 LDA (INDEX),Y
 JSR OUTDO
 INY
 CMP #$D
 BNE NXCHAR
 JSR NEGATE ;Why?
 JMP NXCHAR

* 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.

OUTSP LDA #' '
 HEX 2C ;Trick to skip next line
OUTQUES LDA #'?'
OUTDO ORA #$80
 CMP #" " ;Control chr?
 BLT :OV ;Skip if so
 ORA ORMASK ;Convert to flash or no change
:OV JSR COUT
 AND #$7F
 PHA
 LDA SPEEDZ
 JSR MONWAIT
 PLA
 RTS

INPUTERR LDA INPUTFLG
 BEQ RESPERR ;Taken if INPUT
 BMI READERR ;Taken if READ
 LDY #$FF ;From a GET
 BNE ERLIN
READERR LDA DATLIN
 LDY DATLIN+1
ERLIN STA CURLIN
 STY CURLIN+1
JSYNER JMP SYNERR
INPERR PLA
RESPERR BIT ERRFLG
 BPL DOREENT
 LDX #$FE ;Bad responce
 JMP HANDLERR
DOREENT LDA #REENT
 LDY #>REENT
 JSR STROUT
 TRAY OLDTEXT;TXTPTR
 RTS

GET JSR ERRDIR
 LDX #IN+1 ;Simulate input
 LDY #>IN+1
 LDA #0
 STA IN+1
 LDA #$40 ;Set up INPUTFLG
 JSR MAININP
 RTS

INPUT CMP #'"' ;Check for optional
 BNE QOUT ;input string.
 JSR STRTXT
 LDA #';'
 JSR SYNCHR
 JSR STRPRT
 JMP DIR?
QOUT JSR OUTQUES ;No string, print "?"
DIR? JSR ERRDIR
 LDA #','
 STA IN-1
 JSR INLIN
 LDA IN
 CMP #3 ;Control C?
 BNE ZF
 JMP ERFLG?

NXIN JSR OUTQUES
 JMP INLIN
READ LDX DATPTR
 LDY DATPTR+1
 LDA #$98
 HEX 2C ;Trick to branch to MAININP
ZF LDA #0
MAININP STA INPUTFLG
 STX INPTR
 STY INPTR+1
NXINP JSR PTRGET
 STA FORPNT
 STY FORPNT+1
 TRAY TXTPTR;TXPSV
 TRXY INPTR;TXTPTR
 JSR CHRGOT
 BNE INSTART
 BIT INPUTFLG
 BVC SNDQ? ;Branch if not GET
 JSR RDKEY ;GET it
 AND #$7F
 STA IN
 LDX #IN-1
 LDY #>IN-1
 BNE STXP

SNDQ? BMI FINDATA
 JSR OUTQUES
 JSR NXIN
STXP STX TXTPTR
 STY TXTPTR+1
INSTART JSR CHRGET
 BIT VALTYP
 BPL NUMIN
 BIT INPUTFLG
 BVC PUTCHR ;Branch if not GET
 INX
 STX TXTPTR
 LDA #0
 STA CHARAC
 BEQ PENCHR
PUTCHR STA CHARAC
 CMP #'"'
 BEQ PECHR
 LDA #':'
 STA CHARAC
 LDA #','
PENCHR CLC
PECHR STA ENDCHR
 LDA TXTPTR
 LDY TXTPTR+1
 ADC #0 ;Skip quote, if there
 BCC :OV
 INY
:OV JSR STRLT2
 JSR POINT
 JSR PUTSTR
 JMP WNX
NUMIN PHA
 LDA IN ;From DATA?
 BEQ INPFIN ;Branch if so
DATIN PLA
 JSR FIN ;Get FP number at TXTPNT
 LDA INTFLG
 JSR LET2 ;Put in varl
WNX JSR CHRGOT
 BEQ SWPNT ;Branch if input done?
 CMP #',' ;Comma in input?
 BEQ SWPNT
 JMP INPUTERR ;Nothing else will do
SWPNT TRAY TXTPTR;INPTR
 TRAY TXPSV;TXTPTR
 JSR CHRGOT
 BEQ INPDONE ;If statement not done
 JSR CHKCOM ; program must have comma.
 JMP NXINP ;Get next input
INPFIN LDA INPUTFLG
 BNE DATIN
 JMP INPERR

FINDATA JSR DATAN ;Get offset to next statement
 INY
 TAX ;End of line?
 BNE NXS ;Branch if ":"
 LDX #OofDATA-ERRMSG
 INY
 LDA (TXTPTR),Y ;End of program?
 BEQ GERR ;Error if so
 INY
 LDA (TXTPTR),Y ;Get next line #
 STA DATLIN
 INY
 LDA (TXTPTR),Y
 INY
 STA DATLIN+1
NXS LDA (TXTPTR),Y ;Get 1st token of statement
 TAX
 JSR ADDON ;Update TXTPTR
 CPX #data
 BNE FINDATA ;Loop till DATA found
 JMP INSTART ;Found DATA token
INPDONE LDA INPTR ;No more input requested
 LDY INPTR+1
 LDX INPUTFLG
 BPL :OV
 JMP SETDA ;If from DATA
:OV LDY #0
 LDA (INPTR),Y ;Extra input?
 BEQ RET11
 LDA #EXIG ;Error if so
 LDY #>EXIG
 JMP STROUT
RET11 RTS

EXIG ASC '?EXTRA IGNORED'0D00

REENT ASC '?REENTER'0D00

NEXT BNE VARNXT ;Branch if var specified
 LDY #0
 BEQ SKPV
VARNXT JSR PTRGET ;Find var pointer
SKPV STA FORPNT
 STY FORPNT+1
 JSR GTFORPNT ;Find FOR data on stack
 BEQ GOTFOR
 LDX #NXwoFOR-ERRMSG
GERR BEQ JERROR ;Always
GOTFOR TXS ;Set stack ptr to point
; at FOR data.
 LUP 4
 INX
 --^
 TXA ;Low byte of adrs of STEP value
 LUP 6
 INX
 --^
 STX DEST ;Low byte adrs of TO value
 LDY #1
 JSR MOVFM ;STEP to FAC
 TSX
 LDA STACK+9,X
 STA FACSGN ;-1,0,1 as STEP -,0,+
 LDA FORPNT
 LDY FORPNT+1
 JSR FADD ;Add to FOR value
 JSR SETFOR ;Put new value back
 LDY #1
 JSR FCOMP2 ;Compare to end value
 TSX
 SEC ;A=1,0,-1 as TO <=> current
 SBC STACK+9,X ; FOR variable
 BEQ ENDFOR ;Branch if FOR complete
 LDA STACK+$F,X ;Otherwise set up
 STA CURLIN ; FOR line #
 LDA STACK+$10,X
 STA CURLIN+1
 LDA STACK+$12,X ; and set TXTPTR to just
 STA TXTPTR ; after FOR statement
 LDA STACK+$11,X
 STA TXTPTR+1
GONEWST JMP NEWSTT
ENDFOR TXA
 ADC #$11 ;Carry is set
 TAX ;Cancel FOR by bumping
 TXS ; stack pointer by $12.
 JSR CHRGOT
 CMP #',' ;Another var in NEXT?
 BNE GONEWST
 JSR CHRGET
 JSR VARNXT ;Does not return