back to project page

Applesoft Disassembly

                   * Disassembly of Applesoft II BASIC, as found in the Apple ][+.                *
                   *                                                                              *
                   * This project is a conversion of Bob Sander-Cederlof's "S-C DocuMentor:       *
                   * Applesoft", with minor edits.  See *
                   * for the original disassembly listing.                                        *
                   *                                                                              *
                   * Changes from the original include conversion of comments to mixed-case,      *
                   * correction of typographical errors, and general reformatting to fit          *
                   * SourceGen's constraints.  Some text has been changed to fit personal         *
                   * preference (e.g. PTR vs. PNTR for "pointer").  In cases where an operand     *
                   * expression is too complex, the original can be found in the comment field    *
                   * (look for occurrences of "should be").  It is likely some errors have been   *
                   * introduced; please consult the original material when in doubt.              *
                   *                                                                              *
                   * Applesoft is copyright by Microsoft and Apple Computer.                      *
                   * Apple ][+ ROM image obtained from AppleWin (Apple2_Plus.rom).                *
                   * Project created by Andy McFadden, using 6502bench SourceGen v1.4.            *
                   * Last updated 2019/10/27                                                      *
                   ERR_NOFOR   .eq     $00    {const}
                   TKN_CNTR    .eq     $0f    {const}
                   ERR_SYNTAX  .eq     $10    {const}
                   ERR_NOGOSUB .eq     $16    {const}
                   ERR_NODATA  .eq     $2a    {const}
                   ERR_ILLQTY  .eq     $35    {const}
                   ERR_OVERFLOW .eq    $45    {const}
                   P_OR        .eq     $46    {const}
                   ERR_MEMFULL .eq     $4d    {const}
                   P_AND       .eq     $50    {const}
                   ERR_UNDEFSTAT .eq   $5a    {const}
                   P_REL       .eq     $64    {const}
                   ERR_BADSUBS .eq     $6b    {const}
                   ERR_REDIMD  .eq     $78    {const}
                   P_ADD       .eq     $79    {const}
                   P_MUL       .eq     $7b    {const}
                   P_PWR       .eq     $7d    {const}
                   P_NEQ       .eq     $7f    {const}
                   TOK_FOR     .eq     $81    {const}
                   TOK_DATA    .eq     $83    {const}
                   ERR_ZERODIV .eq     $85    {const}
                   ERR_ILLDIR  .eq     $95    {const}
                   ERR_BADTYPE .eq     $a3    {const}
                   TOK_GOTO    .eq     $ab    {const}
                   ERR_STRLONG .eq     $b0    {const}
                   TOK_GOSUB   .eq     $b0    {const}
                   TOK_REM     .eq     $b2    {const}
                   TOK_PRINT   .eq     $ba    {const}
                   ERR_FRMCPX  .eq     $bf    {const}
                   TOK_TAB     .eq     $c0    {const}
                   TOK_TO      .eq     $c1    {const}
                   TOK_FN      .eq     $c2    {const}
                   TOK_SPC     .eq     $c3    {const}
                   TOK_THEN    .eq     $c4    {const}
                   TOK_AT      .eq     $c5    {const}
                   TOK_NOT     .eq     $c6    {const}
                   TOK_STEP    .eq     $c7    {const}
                   TOK_PLUS    .eq     $c8    {const}
                   TOK_MINUS   .eq     $c9    {const}
                   TOK_GREATER .eq     $cf    {const}
                   TOK_EQUAL   .eq     $d0    {const}
                   ERR_CANTCONT .eq    $d2    {const}
                   TOK_SGN     .eq     $d2    {const}
                   TOK_SCRN    .eq     $d7    {const}
                   ERR_UNDEFFUNC .eq   $e0    {const}
                   GOWARM      .eq     $00    {addr/3} ;gets "JMP RESTART" (3b)
                   GOSTROUT    .eq     $03    {addr/3} ;gets "JMP STROUT" (3b)
                   USRVEC      .eq     $0a    {addr/3} ;USR() command vector (initially $E199) (3b)
                   CHARAC      .eq     $0d             ;used by string utility
                   ENDCHR      .eq     $0e             ;used by string utility
                   EOL_PNTR    .eq     $0f
                   DIMFLG      .eq     $10
                   VALTYP      .eq     $11    {addr/2} ;flag for last FAC operation ($00=num, $FF=str) (2b)
                   DATAFLG     .eq     $13
                   SUBFLG      .eq     $14
                   INPUTFLG    .eq     $15
                   CPRMASK     .eq     $16
                   HGR_SHAPE   .eq     $1a    {addr/2} ;(2b)
                   HGR_BITS    .eq     $1c             ;hi-res color mask
                   HGR_COUNT   .eq     $1d             ;hi-res high-order byte of step for line
                   MON_CH      .eq     $24             ;cursor horizontal displacement
                   HBASL       .eq     $26             ;base address for hi-res drawing (low)
                   HBASH       .eq     $27             ;base address for hi-res drawing (high)
                   MON_H2      .eq     $2c             ;right end of horizontal line drawn by HLINE
                   MON_V2      .eq     $2d             ;bottom of vertical line drawn by VLINE
                   HMASK       .eq     $30             ;hi-res graphics on-the-fly bit mask
                   MON_INVFLAG .eq     $32             ;text mask (255=normal, 127=flash, 63=inv)
                   MON_PROMPT  .eq     $33             ;prompt character
                   MON_KSWL    .eq     $38             ;character input hook (lo)
                   MON_A1L     .eq     $3c             ;general purpose
                   MON_A1H     .eq     $3d             ;general purpose
                   MON_A2L     .eq     $3e             ;general purpose
                   MON_A2H     .eq     $3f             ;general purpose
                   LINNUM      .eq     $50    {addr/2} ;line number (2b)
                   TEMPPT      .eq     $52    {addr/2} ;temporary point (2b)
                   TEMPST      .eq     $55
                   INDEX       .eq     $5e    {addr/2} ;temp (stack) pointer for moving strings (2b)
                   DEST        .eq     $60    {addr/2} ;pointer (2b)
                   RESULT      .eq     $62    {addr/5} ;(5b)
                   TEXTTAB     .eq     $67    {addr/2} ;pointer to start of Applesoft program (2b)
                   VARTAB      .eq     $69    {addr/2} ;pointer to start of Applesoft variables (2b)
                   ARYTAB      .eq     $6b    {addr/2} ;pointer to start of Applesoft array space (2b)
                   STREND      .eq     $6d    {addr/2} ;pointer to end of numeric storage (2b)
                   FRETOP      .eq     $6f    {addr/2} ;pointer to end of string storage (2b)
                   FRESPC      .eq     $71    {addr/2} ;temporary pointer for string-storage routines (2b)
                   MEMSIZE     .eq     $73    {addr/2} ;HIMEM (2b)
                   CURLIN      .eq     $75    {addr/2} ;current line number (2b)
                   OLDIN       .eq     $77    {addr/2} ;last line executed (2b)
                   OLDTEXT     .eq     $79    {addr/2} ;old text pointer (2b)
                   DATLIN      .eq     $7b    {addr/2} ;current lin # from which data is being read (2b)
                   DATPTR      .eq     $7d    {addr/2} ;points to mem from which data is being read (2b)
                   INPTR       .eq     $7f    {addr/2} ;(2b)
                   VARNAM      .eq     $81    {addr/2} ;holds last-used variable's name (2b)
                   VARPNT      .eq     $83    {addr/2} ;pointer to last-used variable's value (2b)
                   FORPNT      .eq     $85    {addr/2} ;general pointer (2b)
                   TXPSV       .eq     $87    {addr/2} ;pointer (2b)
                   CPRTYP      .eq     $89
                   FNCNAM      .eq     $8a    {addr/2}
                   TEMP3       .eq     $8a             ;fp math register (5b)
                   DSCPTR      .eq     $8c    {addr/2} ;pointer (2b)
                   DSCLEN      .eq     $8f
                   JMPADRS     .eq     $90    {addr/3} ;jump address; $90 is set to $4C (3b)
                   LENGTH      .eq     $91
                   TEMP1       .eq     $93             ;fp math register
                   HIGHDS      .eq     $94    {addr/2} ;block copy pointer (2b)
                   HIGHTR      .eq     $96    {addr/2} ;block copy pointer (2b)
                   TEMP2       .eq     $98             ;fp math register
                   TMPEXP      .eq     $99
                   EXPON       .eq     $9a
                   LOWTR       .eq     $9b    {addr/2} ;general pointer (2b)
                   FAC         .eq     $9d    {addr/6} ;floating point accumulator (6b)
                   FAC_SIGN    .eq     $a2             ;single byte sign of FAC
                   SERLEN      .eq     $a3
                   SHIFT_SIGN_EXT .eq  $a4
                   ARG         .eq     $a5    {addr/6} ;secondary floating point accumulator (6b)
                   ARG_SIGN    .eq     $aa
                   STRNG1      .eq     $ab    {addr/2} ;pointer to a string (2b)
                   STRNG2      .eq     $ad    {addr/2} ;pointer to a string (2b)
                   PRGEND      .eq     $af    {addr/2} ;pointer to end of program (2b)
                   CHRGET      .eq     $b1             ;get next character or Applesoft token
                   CHRGOT      .eq     $b7             ;get next, but don't advance TXTPTR
                   TXTPTR      .eq     $b8    {addr/2} ;points at next char or token (2b)
                   RNDSEED     .eq     $c9    {addr/5} ;floating point random number (5b)
                   HGR_DX      .eq     $d0    {addr/2} ;(2b)
                   HGR_DY      .eq     $d2
                   HGR_QUAD    .eq     $d3
                   HGR_E       .eq     $d4    {addr/2} ;(2b)
                   LOCK        .eq     $d6             ;set to $80 to auto-run
                   ERRFLG      .eq     $d8             ;$80 if onerr active
                   ERRLIN      .eq     $da    {addr/2} ;(2b)
                   ERRPOS      .eq     $dc    {addr/2} ;(2b)
                   ERRNUM      .eq     $de
                   ERRSTK      .eq     $df
                   HGR_X       .eq     $e0    {addr/2} ;(2b)
                   HGR_Y       .eq     $e2
                   HGR_COLOR   .eq     $e4
                   HGR_HORIZ   .eq     $e5             ;byte index from GBASH,L
                   HGR_PAGE    .eq     $e6             ;hi-res page to draw on ($20 or $40)
                   HGR_SCALE   .eq     $e7             ;hi-res graphics scale factor
                   HGR_SHAPE_PTR .eq   $e8    {addr/2} ;hi-res shape table pointer (2b)
                   HGR_COLLISIONS .eq  $ea             ;collision counter
                   FIRST       .eq     $f0
                   SPEEDZ      .eq     $f1             ;controls text output speed
                   TRCFLG      .eq     $f2
                   FLASH_BIT   .eq     $f3             ;=$40 for flash, else =$00
                   TXTPSV      .eq     $f4    {addr/2} ;(2b)
                   CURLSV      .eq     $f6    {addr/2} ;(2b)
                   REMSTK      .eq     $f8             ;stack ptr before each STT
                   HGR_ROTATION .eq    $f9
                   STACK       .eq     $0100  {addr/256}
                   INPUT_BUFFER .eq    $0200  {addr/256}
                   AMPERV      .eq     $03f5  {addr/3} ;JMP to function that handles Applesoft '&' cmds (3b)
                   KBD         .eq     $c000           ;R last key pressed + 128
                   TXTCLR      .eq     $c050           ;RW display graphics
                   MIXCLR      .eq     $c052           ;RW display full screen
                   MIXSET      .eq     $c053           ;RW display split screen
                   TXTPAGE1    .eq     $c054           ;RW display page 1
                   TXTPAGE2    .eq     $c055           ;RW display page 2 (or read/write aux mem)
                   LORES       .eq     $c056           ;RW display lo-res graphics
                   HIRES       .eq     $c057           ;RW display hi-res graphics
                   MON_PLOT    .eq     $f800           ;lo-res plot at X=Y-reg, Y=Acc
                   MON_HLINE   .eq     $f819           ;lo-res horiz line at Y=Acc with X from $2c
                   MON_VLINE   .eq     $f828           ;lo-res vert line at X=Y-reg and Y from Acc to $2b
                   MON_SETCOL  .eq     $f864           ;set lo-res color to Acc
                   MON_SCRN    .eq     $f871           ;load Acc with lo-res value at Y=Acc, X=X-reg
                   MON_PREAD   .eq     $fb1e           ;read paddle specifed by X-reg, return in Y-reg
                   MON_SETTXT  .eq     $fb39           ;set screen to text mode
                   MON_SETGR   .eq     $fb40           ;set screen to graphics mode
                   MON_TABV    .eq     $fb5b           ;place cursor at line (A-reg) and column (ch)
                   MON_HOME    .eq     $fc58           ;clear screen and reset text output to top-left
                   MON_WAIT    .eq     $fca8           ;delay for (26 + 27*Acc + 5*(Acc*Acc))/2 cycles
                   MON_RD2BIT  .eq     $fcfa           ;cassette read
                   MON_RDKEY   .eq     $fd0c           ;read key
                   MON_GETLN   .eq     $fd6a           ;get a line of input
                   MON_COUT    .eq     $fded           ;print Acc to output device
                   MON_INPORT  .eq     $fe8b
                   MON_OUTPORT .eq     $fe95
                   MON_WRITE   .eq     $fecd           ;write data to cassette
                   MON_READ    .eq     $fefd           ;read data from cassette
                   MON_READ2   .eq     $ff02           ;read data from cassette

                               .org    $d000
                   ; Branch table for tokens.  Entries are (address-1).
d000: 6f d8                    .dd2    END-1           ;token $80
d002: 65 d7                    .dd2    FOR-1
d004: f8 dc                    .dd2    NEXT-1
d006: 94 d9                    .dd2    DATA-1
d008: b1 db                    .dd2    INPUT-1
d00a: 30 f3                    .dd2    DEL-1
d00c: d8 df                    .dd2    DIM-1
d00e: e1 db                    .dd2    READ-1
d010: 8f f3                    .dd2    GR-1
d012: 98 f3                    .dd2    TEXT-1
d014: e4 f1                    .dd2    PR_NUMBER-1
d016: dd f1                    .dd2    IN_NUMBER-1
d018: d4 f1                    .dd2    CALL-1
d01a: 24 f2                    .dd2    PLOT-1
d01c: 31 f2                    .dd2    HLIN-1
d01e: 40 f2                    .dd2    VLIN-1
d020: d7 f3                    .dd2    HGR2-1          ;$90
d022: e1 f3                    .dd2    HGR-1
d024: e8 f6                    .dd2    HCOLOR-1
d026: fd f6                    .dd2    HPLOT-1
d028: 68 f7                    .dd2    DRAW-1
d02a: 6e f7                    .dd2    XDRAW-1
d02c: e6 f7                    .dd2    HTAB-1
d02e: 57 fc                    .dd2    MON_HOME-1      ;HOME command goes directly to monitor routine
d030: 20 f7                    .dd2    ROT-1
d032: 26 f7                    .dd2    SCALE-1
d034: 74 f7                    .dd2    SHLOAD-1
d036: 6c f2                    .dd2    TRACE-1
d038: 6e f2                    .dd2    NOTRACE-1
d03a: 72 f2                    .dd2    NORMAL-1
d03c: 76 f2                    .dd2    INVERSE-1
d03e: 7f f2                    .dd2    FLASH-1
d040: 4e f2                    .dd2    COLOR-1         ;$a0
d042: 6a d9                    .dd2    POP-1
d044: 55 f2                    .dd2    VTAB-1
d046: 85 f2                    .dd2    HIMEM-1
d048: a5 f2                    .dd2    LOMEM-1
d04a: ca f2                    .dd2    ONERR-1
d04c: 17 f3                    .dd2    RESUME-1
d04e: bb f3                    .dd2    RECALL-1
d050: 9e f3                    .dd2    STORE-1
d052: 61 f2                    .dd2    SPEED-1
d054: 45 da                    .dd2    LET-1
d056: 3d d9                    .dd2    GOTO-1
d058: 11 d9                    .dd2    RUN-1
d05a: c8 d9                    .dd2    IF-1
d05c: 48 d8                    .dd2    RESTORE-1
d05e: f4 03                    .dd2    AMPERV-1        ;jumps directly to the page 3 vector
d060: 20 d9                    .dd2    GOSUB-1         ;$b0
d062: 6a d9                    .dd2    POP-1           ;RETURN and POP go to same handler
d064: db d9                    .dd2    REM-1
d066: 6d d8                    .dd2    STOP-1
d068: eb d9                    .dd2    ONGOTO-1
d06a: 83 e7                    .dd2    WAIT-1
d06c: c8 d8                    .dd2    LOAD-1
d06e: af d8                    .dd2    SAVE-1
d070: 12 e3                    .dd2    DEF-1
d072: 7a e7                    .dd2    POKE-1
d074: d4 da                    .dd2    PRINT-1
d076: 95 d8                    .dd2    CONT-1
d078: a4 d6                    .dd2    LIST-1
d07a: 69 d6                    .dd2    CLEAR-1
d07c: 9f db                    .dd2    GET-1
d07e: 48 d6                    .dd2    NEW-1           ;$bf
                   ; No direct pointer for $C0-C7: TAB(, TO, FN, SPC(, THEN, AT, NOT, STEP.  Math
                   ; operation addresses are below, in MATHTBL.
                   ; Additional functions follow. Addresses are the actual entry points,
                   ; unadjusted.
d080: 90 eb                    .dd2    SGN             ;$d2
d082: 23 ec                    .dd2    INT
d084: af eb                    .dd2    ABS
d086: 0a 00                    .dd2    USRVEC          ;jumps directly to zero-page vector
d088: de e2                    .dd2    FRE
d08a: 12 d4                    .dd2    ERROR           ;SCRN(
d08c: cd df                    .dd2    PDL
d08e: ff e2                    .dd2    POS
d090: 8d ee                    .dd2    SQR
d092: ae ef                    .dd2    RND
d094: 41 e9                    .dd2    LOG
d096: 09 ef                    .dd2    EXP
d098: ea ef                    .dd2    COS
d09a: f1 ef                    .dd2    SIN
d09c: 3a f0                    .dd2    TAN             ;$e0
d09e: 9e f0                    .dd2    ATN
d0a0: 64 e7                    .dd2    PEEK
d0a2: d6 e6                    .dd2    LEN
d0a4: c5 e3                    .dd2    STR
d0a6: 07 e7                    .dd2    VAL
d0a8: e5 e6                    .dd2    ASC
d0aa: 46 e6                    .dd2    CHRSTR
d0ac: 5a e6                    .dd2    LEFTSTR
d0ae: 86 e6                    .dd2    RIGHTSTR
d0b0: 91 e6                    .dd2    MIDSTR          ;$ea
                   ; Math operator branch table
                   ; One-byte precedence code, followed by two-byte address - 1
                   ; 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 =
d0b2: 79           MATHTBL     .dd1    P_ADD
d0b3: c0 e7                    .dd2    FADDT-1         ;$C8 +
d0b5: 79                       .dd1    P_ADD
d0b6: a9 e7                    .dd2    FSUBT-1         ;$C9 -
d0b8: 7b                       .dd1    P_MUL
d0b9: 81 e9                    .dd2    FMULTT-1        ;$CA *
d0bb: 7b                       .dd1    P_MUL
d0bc: 68 ea                    .dd2    FDIVT-1         ;$CB /
d0be: 7d                       .dd1    P_PWR
d0bf: 96 ee                    .dd2    FPWRT-1         ;$CC ^
d0c1: 50                       .dd1    P_AND
d0c2: 54 df                    .dd2    AND-1           ;$CD AND
d0c4: 46                       .dd1    P_OR
d0c5: 4e df                    .dd2    OR-1            ;$CE OR
d0c7: 7f           M_NEG       .dd1    P_NEQ
d0c8: cf ee                    .dd2    NEGOP-1         ;$CF >
d0ca: 7f           M_EQU       .dd1    P_NEQ
d0cb: 97 de                    .dd2    EQUOP-1         ;$D0 =
d0cd: 64           M_REL       .dd1    P_REL
d0ce: 64 df                    .dd2    RELOPS-1        ;$D1 <
                   * Token name table                                                             *
d0d0: 45 4e c4                 .dstr   ‘END’           ;$80
d0d3: 46 4f d2                 .dstr   ‘FOR’           ;$81
d0d6: 4e 45 58 d4              .dstr   ‘NEXT’          ;$82
d0da: 44 41 54 c1              .dstr   ‘DATA’          ;$83
d0de: 49 4e 50 55+             .dstr   ‘INPUT’         ;$84
d0e3: 44 45 cc                 .dstr   ‘DEL’           ;$85
d0e6: 44 49 cd                 .dstr   ‘DIM’           ;$86
d0e9: 52 45 41 c4              .dstr   ‘READ’          ;$87
d0ed: 47 d2                    .dstr   ‘GR’            ;$88
d0ef: 54 45 58 d4              .dstr   ‘TEXT’          ;$89
d0f3: 50 52 a3                 .dstr   ‘PR#’           ;$8a
d0f6: 49 4e a3                 .dstr   ‘IN#’           ;$8b
d0f9: 43 41 4c cc              .dstr   ‘CALL’          ;$8c
d0fd: 50 4c 4f d4              .dstr   ‘PLOT’          ;$8d
d101: 48 4c 49 ce              .dstr   ‘HLIN’          ;$8e
d105: 56 4c 49 ce              .dstr   ‘VLIN’          ;$8f
d109: 48 47 52 b2              .dstr   ‘HGR2’          ;$90
d10d: 48 47 d2                 .dstr   ‘HGR’           ;$91
d110: 48 43 4f 4c+             .dstr   ‘HCOLOR=’       ;$92
d117: 48 50 4c 4f+             .dstr   ‘HPLOT’         ;$93
d11c: 44 52 41 d7              .dstr   ‘DRAW’          ;$94
d120: 58 44 52 41+             .dstr   ‘XDRAW’         ;$95
d125: 48 54 41 c2              .dstr   ‘HTAB’          ;$96
d129: 48 4f 4d c5              .dstr   ‘HOME’          ;$97
d12d: 52 4f 54 bd              .dstr   ‘ROT=’          ;$98
d131: 53 43 41 4c+             .dstr   ‘SCALE=’        ;$99
d137: 53 48 4c 4f+             .dstr   ‘SHLOAD’        ;$9a
d13d: 54 52 41 43+             .dstr   ‘TRACE’         ;$9b
d142: 4e 4f 54 52+             .dstr   ‘NOTRACE’       ;$9c
d149: 4e 4f 52 4d+             .dstr   ‘NORMAL’        ;$9d
d14f: 49 4e 56 45+             .dstr   ‘INVERSE’       ;$9e
d156: 46 4c 41 53+             .dstr   ‘FLASH’         ;$9f
d15b: 43 4f 4c 4f+             .dstr   ‘COLOR=’        ;$a0
d161: 50 4f d0                 .dstr   ‘POP’           ;$a1
d164: 56 54 41 c2              .dstr   ‘VTAB’          ;$a2
d168: 48 49 4d 45+             .dstr   ‘HIMEM:’        ;$a3
d16e: 4c 4f 4d 45+             .dstr   ‘LOMEM:’        ;$a4
d174: 4f 4e 45 52+             .dstr   ‘ONERR’         ;$a5
d179: 52 45 53 55+             .dstr   ‘RESUME’        ;$a6
d17f: 52 45 43 41+             .dstr   ‘RECALL’        ;$a7
d185: 53 54 4f 52+             .dstr   ‘STORE’         ;$a8
d18a: 53 50 45 45+             .dstr   ‘SPEED=’        ;$a9
d190: 4c 45 d4                 .dstr   ‘LET’           ;$aa
d193: 47 4f 54 cf              .dstr   ‘GOTO’          ;$ab
d197: 52 55 ce                 .dstr   ‘RUN’           ;$ac
d19a: 49 c6                    .dstr   ‘IF’            ;$ad
d19c: 52 45 53 54+             .dstr   ‘RESTORE’       ;$ae
d1a3: a6                       .dd1    “&”             ;$af
d1a4: 47 4f 53 55+             .dstr   ‘GOSUB’         ;$b0
d1a9: 52 45 54 55+             .dstr   ‘RETURN’        ;$b1
d1af: 52 45 cd                 .dstr   ‘REM’           ;$b2
d1b2: 53 54 4f d0              .dstr   ‘STOP’          ;$b3
d1b6: 4f ce                    .dstr   ‘ON’            ;$b4
d1b8: 57 41 49 d4              .dstr   ‘WAIT’          ;$b5
d1bc: 4c 4f 41 c4              .dstr   ‘LOAD’          ;$b6
d1c0: 53 41 56 c5              .dstr   ‘SAVE’          ;$b7
d1c4: 44 45 c6                 .dstr   ‘DEF’           ;$b8
d1c7: 50 4f 4b c5              .dstr   ‘POKE’          ;$b9
d1cb: 50 52 49 4e+             .dstr   ‘PRINT’         ;$ba
d1d0: 43 4f 4e d4              .dstr   ‘CONT’          ;$bb
d1d4: 4c 49 53 d4              .dstr   ‘LIST’          ;$bc
d1d8: 43 4c 45 41+             .dstr   ‘CLEAR’         ;$bd
d1dd: 47 45 d4                 .dstr   ‘GET’           ;$be
d1e0: 4e 45 d7                 .dstr   ‘NEW’           ;$bf
d1e3: 54 41 42 a8              .dstr   ‘TAB(’          ;$c0
d1e7: 54 cf                    .dstr   ‘TO’            ;$c1
d1e9: 46 ce                    .dstr   ‘FN’            ;$c2
d1eb: 53 50 43 a8              .dstr   ‘SPC(’          ;$c3
d1ef: 54 48 45 ce              .dstr   ‘THEN’          ;$c4
d1f3: 41 d4                    .dstr   ‘AT’            ;$c5
d1f5: 4e 4f d4                 .dstr   ‘NOT’           ;$c6
d1f8: 53 54 45 d0              .dstr   ‘STEP’          ;$c7
d1fc: ab                       .dd1    “+”             ;$c8
d1fd: ad                       .dd1    “-”             ;$c9
d1fe: aa                       .dd1    “*”             ;$ca
d1ff: af                       .dd1    “/”             ;$cb
d200: de                       .dd1    “^”             ;$cc
d201: 41 4e c4                 .dstr   ‘AND’           ;$cd
d204: 4f d2                    .dstr   ‘OR’            ;$ce
d206: be                       .dd1    “>”             ;$cf
d207: bd                       .dd1    “=”             ;$d0
d208: bc                       .dd1    “<”             ;$d1
d209: 53 47 ce                 .dstr   ‘SGN’           ;$d2
d20c: 49 4e d4                 .dstr   ‘INT’           ;$d3
d20f: 41 42 d3                 .dstr   ‘ABS’           ;$d4
d212: 55 53 d2                 .dstr   ‘USR’           ;$d5
d215: 46 52 c5                 .dstr   ‘FRE’           ;$d6
d218: 53 43 52 4e+             .dstr   ‘SCRN(’         ;$d7
d21d: 50 44 cc                 .dstr   ‘PDL’           ;$d8
d220: 50 4f d3                 .dstr   ‘POS’           ;$d9
d223: 53 51 d2                 .dstr   ‘SQR’           ;$da
d226: 52 4e c4                 .dstr   ‘RND’           ;$db
d229: 4c 4f c7                 .dstr   ‘LOG’           ;$dc
d22c: 45 58 d0                 .dstr   ‘EXP’           ;$dd
d22f: 43 4f d3                 .dstr   ‘COS’           ;$de
d232: 53 49 ce                 .dstr   ‘SIN’           ;$df
d235: 54 41 ce                 .dstr   ‘TAN’           ;$e0
d238: 41 54 ce                 .dstr   ‘ATN’           ;$e1
d23b: 50 45 45 cb              .dstr   ‘PEEK’          ;$e2
d23f: 4c 45 ce                 .dstr   ‘LEN’           ;$e3
d242: 53 54 52 a4              .dstr   ‘STR$’          ;$e4
d246: 56 41 cc                 .dstr   ‘VAL’           ;$e5
d249: 41 53 c3                 .dstr   ‘ASC’           ;$e6
d24c: 43 48 52 a4              .dstr   ‘CHR$’          ;$e7
d250: 4c 45 46 54+             .dstr   ‘LEFT$’         ;$e8
d255: 52 49 47 48+             .dstr   ‘RIGHT$’        ;$e9
d25b: 4d 49 44 a4              .dstr   ‘MID$’          ;$ea
d25f: 00                       .dd1    $00             ;end of token name table
                   * Error messages                                                               *
                   *                                                                              *
                   * (The code uses error message constants that are defined by subtracting the   *
                   * start of the table from the address of the error.  Currently no way to do    *
                   * that in SourceGen, so the constants are project symbols instead.)            *
d260: 4e 45 58 54+ ERROR_MSGS  .dstr   ‘NEXT WITHOUT FOR’
d270: 53 59 4e 54+             .dstr   ‘SYNTAX’
d276: 52 45 54 55+             .dstr   ‘RETURN WITHOUT GOSUB’
d28a: 4f 55 54 20+             .dstr   ‘OUT OF DATA’
d295: 49 4c 4c 45+             .dstr   ‘ILLEGAL QUANTITY’
d2a5: 4f 56 45 52+             .dstr   ‘OVERFLOW’
d2ad: 4f 55 54 20+             .dstr   ‘OUT OF MEMORY’
d2ba: 55 4e 44 45+             .dstr   ‘UNDEF'D STATEMENT’
d2cb: 42 41 44 20+             .dstr   ‘BAD SUBSCRIPT’
d2d8: 52 45 44 49+             .dstr   ‘REDIM'D ARRAY’
d2e5: 44 49 56 49+             .dstr   ‘DIVISION BY ZERO’
d2f5: 49 4c 4c 45+             .dstr   ‘ILLEGAL DIRECT’
d303: 54 59 50 45+             .dstr   ‘TYPE MISMATCH’
d310: 53 54 52 49+             .dstr   ‘STRING TOO LONG’
d31f: 46 4f 52 4d+             .dstr   ‘FORMULA TOO COMPLEX’
d332: 43 41 4e 27+             .dstr   ‘CAN'T CONTINUE’
d340: 55 4e 44 45+             .dstr   ‘UNDEF'D FUNCTION’
d350: 20 45 52 52+ QT_ERROR    .zstr   ‘ ERROR’,$07
d358: 20 49 4e 20+ QT_IN       .zstr   ‘ IN ’
d35d: 0d 42 52 45+ QT_BREAK    .zstr   $0d,‘BREAK’,$07

                   ; 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 ptr after skipping all frames
                   ;           .EQ. if variable found
                   ;           X = stack ptr of frame found
d365: ba           GTFORPNT    tsx
d366: e8                       inx
d367: e8                       inx
d368: e8                       inx
d369: e8                       inx
d36a: bd 01 01     LD36A       lda     STACK+1,x       ;FOR frame here?
d36d: c9 81                    cmp     #TOK_FOR
d36f: d0 21                    bne     LD392           ;no
d371: a5 86                    lda     FORPNT+1        ;yes; NEXT with no variable?
d373: d0 0a                    bne     LD37F           ;no, variable specified
d375: bd 02 01                 lda     STACK+2,x       ;yes, so use this frame
d378: 85 85                    sta     FORPNT
d37a: bd 03 01                 lda     STACK+3,x
d37d: 85 86                    sta     FORPNT+1
d37f: dd 03 01     LD37F       cmp     STACK+3,x       ;is variable in this frame?
d382: d0 07                    bne     LD38B           ;no
d384: a5 85                    lda     FORPNT          ;look at 2nd byte too
d386: dd 02 01                 cmp     STACK+2,x       ;same variable?
d389: f0 07                    beq     LD392           ;yes
d38b: 8a           LD38B       txa                     ;no, so try next frame (if any)
d38c: 18                       clc                     ;18 bytes per frame
d38d: 69 12                    adc     #18
d38f: aa                       tax
d390: d0 d8                    bne     LD36A           ;...always?
d392: 60           LD392       rts

                   ; Move block of memory up
                   ;   On entry:
                   ;     (Y,A) = HIGHDS = destination end + 1
                   ;     LOWTR = lowest address of source
                   ;     HIGHTR = highest source address + 1
d393: 20 e3 d3     BLTU        jsr     REASON          ;be sure (Y,A) < FRETOP
d396: 85 6d                    sta     STREND          ;new top of array storage
d398: 84 6e                    sty     STREND+1
d39a: 38           BLTU2       sec
d39b: a5 96                    lda     HIGHTR          ;compute # of bytes to be moved
d39d: e5 9b                    sbc     LOWTR           ;  (from LOWTR through HIGHTR-1)
d39f: 85 5e                    sta     INDEX           ;partial page amount
d3a1: a8                       tay
d3a2: a5 97                    lda     HIGHTR+1
d3a4: e5 9c                    sbc     LOWTR+1
d3a6: aa                       tax                     ;# of whole pages in X-reg
d3a7: e8                       inx
d3a8: 98                       tya                     ;# bytes in partial page
d3a9: f0 23                    beq     LD3CE           ;no partial page
d3ab: a5 96                    lda     HIGHTR          ;back up HIGHTR # bytes in partial page
d3ad: 38                       sec
d3ae: e5 5e                    sbc     INDEX
d3b0: 85 96                    sta     HIGHTR
d3b2: b0 03                    bcs     LD3B7
d3b4: c6 97                    dec     HIGHTR+1
d3b6: 38                       sec
d3b7: a5 94        LD3B7       lda     HIGHDS          ;back up highds # bytes in partial page
d3b9: e5 5e                    sbc     INDEX
d3bb: 85 94                    sta     HIGHDS
d3bd: b0 08                    bcs     LD3C7
d3bf: c6 95                    dec     HIGHDS+1
d3c1: 90 04                    bcc     LD3C7           ;...always

d3c3: b1 96        LD3C3       lda     (HIGHTR),y      ;move the bytes
d3c5: 91 94                    sta     (HIGHDS),y
d3c7: 88           LD3C7       dey
d3c8: d0 f9                    bne     LD3C3           ;loop to end of this 256 bytes
d3ca: b1 96                    lda     (HIGHTR),y      ;move one more byte
d3cc: 91 94                    sta     (HIGHDS),y
d3ce: c6 97        LD3CE       dec     HIGHTR+1        ;down to next block of 256
d3d0: c6 95                    dec     HIGHDS+1
d3d2: ca                       dex                     ;another block of 256 to move?
d3d3: d0 f2                    bne     LD3C7           ;yes
d3d5: 60                       rts                     ;no, finished

                   ; Check if enough room left on stack for FOR, GOSUB, or expression evaluation.
d3d6: 0a           CHKMEM      asl     A
d3d7: 69 36                    adc     #54
d3d9: b0 35                    bcs     MEMERR          ;...mem full err
d3db: 85 5e                    sta     INDEX
d3dd: ba                       tsx
d3de: e4 5e                    cpx     INDEX
d3e0: 90 2e                    bcc     MEMERR          ;...mem full err
d3e2: 60                       rts

                   ; Check if enough room between arrays and strings.
                   ;   (Y,A) = addr arrays need to grow to
d3e3: c4 70        REASON      cpy     FRETOP+1        ;high byte
d3e5: 90 28                    bcc     LD40F           ;plenty of room
d3e7: d0 04                    bne     LD3ED           ;not enough, try garbage collection
d3e9: c5 6f                    cmp     FRETOP          ;low byte
d3eb: 90 22                    bcc     LD40F           ;enough room
d3ed: 48           LD3ED       pha                     ;save (Y,A), TEMP1, and TEMP2
d3ee: a2 09                    ldx     #9              ;(should be #FAC-TEMP1-1)
d3f0: 98                       tya
d3f1: 48           LD3F1       pha
d3f2: b5 93                    lda     TEMP1,x
d3f4: ca                       dex
d3f5: 10 fa                    bpl     LD3F1
d3f7: 20 84 e4                 jsr     GARBAG          ;make as much room as possible
d3fa: a2 f7                    ldx     #$f7            ;(should be #TEMP1-FAC+1) restore TEMP1 and TEMP2
d3fc: 68           LD3FC       pla                     ;  and (Y,A)
d3fd: 95 9d                    sta     FAC,x
d3ff: e8                       inx
d400: 30 fa                    bmi     LD3FC
d402: 68                       pla
d403: a8                       tay
d404: 68                       pla                     ;did we find enough room?
d405: c4 70                    cpy     FRETOP+1        ;high byte
d407: 90 06                    bcc     LD40F           ;yes, at least a page
d409: d0 05                    bne     MEMERR          ;no, mem full err
d40b: c5 6f                    cmp     FRETOP          ;low byte
d40d: b0 01                    bcs     MEMERR          ;no, mem full err
d40f: 60           LD40F       rts                     ;yes, return

d410: a2 4d        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                                           *
                   *                                                                              *
                   * Entry for SCRN( statement in func table points here.                         *
d412: 24 d8        ERROR       bit     ERRFLG          ;ON ERR turned on?
d414: 10 03                    bpl     LD419           ;no
d416: 4c e9 f2                 jmp     HANDLERR        ;yes

d419: 20 fb da     LD419       jsr     CRDO            ;print <return>
d41c: 20 5a db                 jsr     OUTQUES         ;print "?"
d41f: bd 60 d2     LD41F       lda     ERROR_MSGS,x
d422: 48                       pha                     ;print message
d423: 20 5c db                 jsr     OUTDO
d426: e8                       inx
d427: 68                       pla
d428: 10 f5                    bpl     LD41F
d42a: 20 83 d6                 jsr     STKINI          ;fix stack, et. al.
d42d: a9 50                    lda     #<QT_ERROR      ;print " ERROR" and bell
d42f: a0 d3                    ldy     #>QT_ERROR
                   ; Print string at (Y,A)
                   ; Print current line # unless in direct mode
                   ; Fall into warm restart
d431: 20 3a db                 jsr     STROUT          ;print string at (Y,A)
d434: a4 76                    ldy     CURLIN+1        ;running, or direct?
d436: c8                       iny
d437: f0 03                    beq     RESTART         ;was $ff, so direct mode
d439: 20 19 ed                 jsr     INPRT           ;running, so print line number
                   * Warm restart entry                                                           *
                   *                                                                              *
                   * Come here from monitor by Ctrl+C, 0G, 3D0G, or E003G.                        *
d43c: 20 fb da     RESTART     jsr     CRDO            ;print <return>
d43f: a2 dd                    ldx     #“]”            ;prompt character
d441: 20 2e d5                 jsr     INLIN2          ;read a line
d444: 86 b8                    stx     TXTPTR          ;set up CHRGET to scan the line
d446: 84 b9                    sty     TXTPTR+1
d448: 46 d8                    lsr     ERRFLG          ;clear flag
d44a: 20 b1 00                 jsr     CHRGET
d44d: aa                       tax
d44e: f0 ec                    beq     RESTART         ;empty line
d450: a2 ff                    ldx     #$ff            ;$ff in hi-byte of CURLIN means
d452: 86 76                    stx     CURLIN+1        ;  we are in direct mode
d454: 90 06                    bcc     NUMBERED_LINE   ;CHRGET saw digit, numbered line
d456: 20 59 d5                 jsr     PARSE_INPUT_LINE ;no number, so parse it
d459: 4c 05 d8                 jmp     TRACE_          ;and try executing it

                   ; Handle numbered line.
d45c: a6 af                    ldx     PRGEND          ;squash variable table
d45e: 86 69                    stx     VARTAB
d460: a6 b0                    ldx     PRGEND+1
d462: 86 6a                    stx     VARTAB+1
d464: 20 0c da                 jsr     LINGET          ;get line #
d467: 20 59 d5                 jsr     PARSE_INPUT_LINE ;and parse the input line
d46a: 84 0f                    sty     EOL_PNTR        ;save index to input buffer
d46c: 20 1a d6                 jsr     FNDLIN          ;is this line # already in program?
d46f: 90 44                    bcc     PUT_NEW_LINE    ;no
d471: a0 01                    ldy     #$01            ;yes, so delete it
d473: b1 9b                    lda     (LOWTR),y       ;LOWPTR points at line
d475: 85 5f                    sta     INDEX+1         ;get high byte of forward ptr
d477: a5 69                    lda     VARTAB
d479: 85 5e                    sta     INDEX
d47b: a5 9c                    lda     LOWTR+1
d47d: 85 61                    sta     DEST+1
d47f: a5 9b                    lda     LOWTR
d481: 88                       dey
d482: f1 9b                    sbc     (LOWTR),y
d484: 18                       clc
d485: 65 69                    adc     VARTAB
d487: 85 69                    sta     VARTAB
d489: 85 60                    sta     DEST
d48b: a5 6a                    lda     VARTAB+1
d48d: 69 ff                    adc     #$ff
d48f: 85 6a                    sta     VARTAB+1
d491: e5 9c                    sbc     LOWTR+1
d493: aa                       tax
d494: 38                       sec
d495: a5 9b                    lda     LOWTR
d497: e5 69                    sbc     VARTAB
d499: a8                       tay
d49a: b0 03                    bcs     LD49F
d49c: e8                       inx
d49d: c6 61                    dec     DEST+1
d49f: 18           LD49F       clc
d4a0: 65 5e                    adc     INDEX
d4a2: 90 03                    bcc     LD4A7
d4a4: c6 5f                    dec     INDEX+1
d4a6: 18                       clc
d4a7: b1 5e        LD4A7       lda     (INDEX),y       ;move higher lines of program
d4a9: 91 60                    sta     (DEST),y        ;down over the deleted line
d4ab: c8                       iny
d4ac: d0 f9                    bne     LD4A7
d4ae: e6 5f                    inc     INDEX+1
d4b0: e6 61                    inc     DEST+1
d4b2: ca                       dex
d4b3: d0 f2                    bne     LD4A7
d4b5: ad 00 02                 lda     INPUT_BUFFER    ;any characters after line #?
d4b8: f0 38                    beq     FIX_LINKS       ;no, so nothing to insert
d4ba: a5 73                    lda     MEMSIZE         ;yes, so make room and insert line
d4bc: a4 74                    ldy     MEMSIZE+1       ;wipe string area clean
d4be: 85 6f                    sta     FRETOP
d4c0: 84 70                    sty     FRETOP+1
d4c2: a5 69                    lda     VARTAB          ;set up BLTU subroutine
d4c4: 85 96                    sta     HIGHTR          ;insert new line
d4c6: 65 0f                    adc     EOL_PNTR
d4c8: 85 94                    sta     HIGHDS
d4ca: a4 6a                    ldy     VARTAB+1
d4cc: 84 97                    sty     HIGHTR+1
d4ce: 90 01                    bcc     LD4D1
d4d0: c8                       iny
d4d1: 84 95        LD4D1       sty     HIGHDS+1
d4d3: 20 93 d3                 jsr     BLTU            ;make room for the line
d4d6: a5 50                    lda     LINNUM          ;put line number in line image
d4d8: a4 51                    ldy     LINNUM+1
d4da: 8d fe 01                 sta     INPUT_BUFFER-2
d4dd: 8c ff 01                 sty     INPUT_BUFFER-1
d4e0: a5 6d                    lda     STREND
d4e2: a4 6e                    ldy     STREND+1
d4e4: 85 69                    sta     VARTAB
d4e6: 84 6a                    sty     VARTAB+1
d4e8: a4 0f                    ldy     EOL_PNTR
                   ; Copy line into program.
d4ea: b9 fb 01     LD4EA       lda     INPUT_BUFFER-5,y
d4ed: 88                       dey
d4ee: 91 9b                    sta     (LOWTR),y
d4f0: d0 f8                    bne     LD4EA
                   ; Clear all variables.  Re-establish all forward links.
d4f2: 20 65 d6     FIX_LINKS   jsr     SETPTRS         ;clear all variables
d4f5: a5 67                    lda     TEXTTAB         ;point index at start of program
d4f7: a4 68                    ldy     TEXTTAB+1
d4f9: 85 5e                    sta     INDEX
d4fb: 84 5f                    sty     INDEX+1
d4fd: 18                       clc
d4fe: a0 01        LD4FE       ldy     #$01            ;hi-byte of next forward ptr
d500: b1 5e                    lda     (INDEX),y       ;end of program yet?
d502: d0 0b                    bne     LD50F           ;no, keep going
d504: a5 69                    lda     VARTAB          ;yes
d506: 85 af                    sta     PRGEND
d508: a5 6a                    lda     VARTAB+1
d50a: 85 b0                    sta     PRGEND+1
d50c: 4c 3c d4                 jmp     RESTART

d50f: a0 04        LD50F       ldy     #$04            ;find end of this line
d511: c8           LD511       iny                     ;(note maximum length < 256)
d512: b1 5e                    lda     (INDEX),y
d514: d0 fb                    bne     LD511
d516: c8                       iny                     ;compute address of next line
d517: 98                       tya
d518: 65 5e                    adc     INDEX
d51a: aa                       tax
d51b: a0 00                    ldy     #$00            ;store forward ptr in this line
d51d: 91 5e                    sta     (INDEX),y
d51f: a5 5f                    lda     INDEX+1
d521: 69 00                    adc     #$00            ;A-reg != $ff, so this always clears carry
d523: c8                       iny
d524: 91 5e                    sta     (INDEX),y
d526: 86 5e                    stx     INDEX
d528: 85 5f                    sta     INDEX+1
d52a: 90 d2                    bcc     LD4FE           ;...always

                   ; Read a line, and strip off sign bits.
d52c: a2 80        INLIN       ldx     #$80            ;null prompt
d52e: 86 33        INLIN2      stx     MON_PROMPT
d530: 20 6a fd                 jsr     MON_GETLN
d533: e0 ef                    cpx     #239            ;maximum line length
d535: 90 02                    bcc     LD539
d537: a2 ef                    ldx     #239            ;truncate at 239 chars
d539: a9 00        LD539       lda     #$00            ;mark end of line with $00 byte
d53b: 9d 00 02                 sta     INPUT_BUFFER,x
d53e: 8a                       txa
d53f: f0 0b                    beq     LD54C           ;null input line
d541: bd ff 01     LD541       lda     INPUT_BUFFER-1,x ;drop sign bits
d544: 29 7f                    and     #$7f
d546: 9d ff 01                 sta     INPUT_BUFFER-1,x
d549: ca                       dex
d54a: d0 f5                    bne     LD541
d54c: a9 00        LD54C       lda     #$00            ;(Y,X) points at buffer - 1
d54e: a2 ff                    ldx     #<INPUT_BUFFER+255
d550: a0 01                    ldy     #(>INPUT_BUFFER)-1
d552: 60                       rts

d553: 20 0c fd     INCHR       jsr     MON_RDKEY       ;*** ought to be BIT $C010 ***
d556: 29 7f                    and     #$7f
d558: 60                       rts

                   ; Tokenize the input line.
d559: a6 b8                    ldx     TXTPTR          ;index into unparsed line
d55b: ca                       dex                     ;prepare for INX at PARSE
d55c: a0 04                    ldy     #$04            ;index to parsed output line
d55e: 84 13                    sty     DATAFLG         ;clear sign-bit of DATAFLG
d560: 24 d6                    bit     LOCK            ;is this program locked?
d562: 10 08                    bpl     PARSE           ;no, go ahead and parse the line
d564: 68                       pla                     ;yes, ignore input and RUN
d565: 68                       pla                     ;  the program
d566: 20 65 d6                 jsr     SETPTRS         ;clear all variables
d569: 4c d2 d7                 jmp     NEWSTT          ;start running

d56c: e8           PARSE       inx                     ;next input character
d56d: bd 00 02     LD56D       lda     INPUT_BUFFER,x
d570: 24 13                    bit     DATAFLG         ;in a DATA statement?
d572: 70 04                    bvs     LD578           ;yes (DATAFLG = $49)
d574: c9 20                    cmp     #‘ ’            ;ignore blanks
d576: f0 f4                    beq     PARSE
d578: 85 0e        LD578       sta     ENDCHR
d57a: c9 22                    cmp     #‘"’            ;start of quotation?
d57c: f0 74                    beq     LD5F2
d57e: 70 4d                    bvs     LD5CD           ;branch if in DATA statement
d580: c9 3f                    cmp     #‘?’            ;shorthand for PRINT?
d582: d0 04                    bne     LD588           ;no
d584: a9 ba                    lda     #TOK_PRINT      ;yes, replace with PRINT token
d586: d0 45                    bne     LD5CD           ;...always

d588: c9 30        LD588       cmp     #‘0’            ;is it a digit, colon, or semi-colon?
d58a: 90 04                    bcc     LD590           ;no, punctuation !"#$%&'()*+,-./
d58c: c9 3c                    cmp     #‘<’            ;(should be  #';'+1 )
d58e: 90 3d                    bcc     LD5CD           ;yes, not a token
                   ; Search token name table for match, starting with current char from input line.
d590: 84 ad        LD590       sty     STRNG2          ;save index to output line
d592: a9 d0                    lda     #<TOKEN_NAME_TABLE
d594: 85 9d                    sta     FAC             ;make ptr for search
d596: a9 cf                    lda     #(>TOKEN_NAME_TABLE)-1
d598: 85 9e                    sta     FAC+1
d59a: a0 00                    ldy     #$00            ;use Y-reg with FAC to address table
d59c: 84 0f                    sty     TKN_CNTR        ;holds current token - $80
d59e: 88                       dey                     ;prepare for INY a few lines down
d59f: 86 b8                    stx     TXTPTR          ;save position in input line
d5a1: ca                       dex                     ;prepare for INX a few lines down
d5a2: c8           LD5A2       iny                     ;advance pointer to token table
d5a3: d0 02                    bne     LD5A7           ;Y=Y+1 is enough
d5a5: e6 9e                    inc     FAC+1           ;also need to bump the page
d5a7: e8           LD5A7       inx                     ;advance pointer to input line
d5a8: bd 00 02     LD5A8       lda     INPUT_BUFFER,x  ;next char from input line
d5ab: c9 20                    cmp     #‘ ’            ;this char a blank?
d5ad: f0 f8                    beq     LD5A7           ;yes, ignore all blanks
d5af: 38                       sec                     ;no, compare to char in table
d5b0: f1 9d                    sbc     (FAC),y         ;same as next char of token name?
d5b2: f0 ee                    beq     LD5A2           ;yes, continue matching
d5b4: c9 80                    cmp     #$80            ;maybe; was it same except for bit 7?
d5b6: d0 41                    bne     LD5F9           ;no, skip to next token
d5b8: 05 0f                    ora     TKN_CNTR        ;yes, end of token; get token #
d5ba: c9 c5                    cmp     #TOK_AT         ;did we match AT?
d5bc: d0 0d                    bne     LD5CB           ;no, so no ambiguity
d5be: bd 01 02                 lda     INPUT_BUFFER+1,x ;AT could be ATN or "A TO"
d5c1: c9 4e                    cmp     #‘N’            ;ATN has precedence over AT
d5c3: f0 34                    beq     LD5F9           ;it is ATN, find it the hard way
d5c5: c9 4f                    cmp     #‘O’            ;TO has precedence over AT
d5c7: f0 30                    beq     LD5F9           ;it is "A TO", find it the hard way
d5c9: a9 c5                    lda     #TOK_AT         ;not ATN or "A TO", so use AT
                   ; Store character or token in output line.
d5cb: a4 ad        LD5CB       ldy     STRNG2          ;get index to output line in Y-reg
d5cd: e8           LD5CD       inx                     ;advance input index
d5ce: c8                       iny                     ;advance output index
d5cf: 99 fb 01                 sta     INPUT_BUFFER-5,y ;store char or token
d5d2: b9 fb 01                 lda     INPUT_BUFFER-5,y ;test for EOL or EOS
d5d5: f0 39                    beq     LD610           ;end of line
d5d7: 38                       sec
d5d8: e9 3a                    sbc     #‘:’            ;end of statement?
d5da: f0 04                    beq     LD5E0           ;yes, clear DATAFLG
d5dc: c9 49                    cmp     #TOK_DATA-58    ;(TOK_DATA - ':')  DATA token?
d5de: d0 02                    bne     LD5E2           ;no, leave DATAFLG alone
d5e0: 85 13        LD5E0       sta     DATAFLG         ;DATAFLG = 0 or $83-$3a = $49
d5e2: 38           LD5E2       sec                     ;is it a REM token?
d5e3: e9 78                    sbc     #TOK_REM-58     ;(TOK_REM - ':')
d5e5: d0 86                    bne     LD56D           ;no, continue parsing line
d5e7: 85 0e                    sta     ENDCHR          ;yes, clear literal flag
                   ; Handle literal (between quotes) or remark, by copying chars up to ENDCHR.
d5e9: bd 00 02     LD5E9       lda     INPUT_BUFFER,x
d5ec: f0 df                    beq     LD5CD           ;end of line
d5ee: c5 0e                    cmp     ENDCHR
d5f0: f0 db                    beq     LD5CD           ;found ENDCHR
d5f2: c8           LD5F2       iny                     ;next output char
d5f3: 99 fb 01                 sta     INPUT_BUFFER-5,y
d5f6: e8                       inx                     ;next input char
d5f7: d0 f0                    bne     LD5E9           ;...always
                   ; Advance pointer to next token name.
d5f9: a6 b8        LD5F9       ldx     TXTPTR          ;get pointer to input line in X-reg
d5fb: e6 0f                    inc     TKN_CNTR        ;bump (token # - $80)
d5fd: b1 9d        LD5FD       lda     (FAC),y         ;scan through table for BIT7 = 1
d5ff: c8                       iny                     ;next token one beyond that
d600: d0 02                    bne     LD604           ;...usually enough to bump Y-reg
d602: e6 9e                    inc     FAC+1           ;next set of 256 token chars
d604: 0a           LD604       asl     A               ;see if sign bit set on char
d605: 90 f6                    bcc     LD5FD           ;no, more in this name
d607: b1 9d                    lda     (FAC),y         ;yes, at next name; end of table?
d609: d0 9d                    bne     LD5A8           ;no, not end of table
d60b: bd 00 02                 lda     INPUT_BUFFER,x  ;yes, so not a keyword
d60e: 10 bb                    bpl     LD5CB           ;...always, copy char as is
                   ; end of line
d610: 99 fd 01     LD610       sta     INPUT_BUFFER-3,y ;store another 00 on end
d613: c6 b9                    dec     TXTPTR+1        ;set TXTPTR = INPUT_BUFFER - 1
d615: a9 ff                    lda     #<INPUT_BUFFER+255
d617: 85 b8                    sta     TXTPTR
d619: 60                       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
d61a: a5 67        FNDLIN      lda     TEXTTAB         ;search from beginning of program
d61c: a6 68                    ldx     TEXTTAB+1
d61e: a0 01        FL1         ldy     #$01            ;search from (X,A)
d620: 85 9b                    sta     LOWTR
d622: 86 9c                    stx     LOWTR+1
d624: b1 9b                    lda     (LOWTR),y
d626: f0 1f                    beq     LD647           ;end of program, and not found
d628: c8                       iny
d629: c8                       iny
d62a: a5 51                    lda     LINNUM+1
d62c: d1 9b                    cmp     (LOWTR),y
d62e: 90 18                    bcc     RTS_1           ;if not found
d630: f0 03                    beq     LD635
d632: 88                       dey
d633: d0 09                    bne     LD63E
d635: a5 50        LD635       lda     LINNUM
d637: 88                       dey
d638: d1 9b                    cmp     (LOWTR),y
d63a: 90 0c                    bcc     RTS_1           ;past line, not found
d63c: f0 0a                    beq     RTS_1           ;if found
d63e: 88           LD63E       dey
d63f: b1 9b                    lda     (LOWTR),y
d641: aa                       tax
d642: 88                       dey
d643: b1 9b                    lda     (LOWTR),y
d645: b0 d7                    bcs     FL1             ;always

d647: 18           LD647       clc                     ;return carry=0
d648: 60           RTS_1       rts

                   * NEW statement                                                                *
d649: d0 fd        NEW         bne     RTS_1           ;ignore if more to the statement
d64b: a9 00        SCRTCH      lda     #$00
d64d: 85 d6                    sta     LOCK
d64f: a8                       tay
d650: 91 67                    sta     (TEXTTAB),y
d652: c8                       iny
d653: 91 67                    sta     (TEXTTAB),y
d655: a5 67                    lda     TEXTTAB
d657: 69 02                    adc     #$02            ;carry wasn't cleared, so NEW usually
d659: 85 69                    sta     VARTAB          ;  adds 3, whereas FP adds 2
d65b: 85 af                    sta     PRGEND
d65d: a5 68                    lda     TEXTTAB+1
d65f: 69 00                    adc     #$00
d661: 85 6a                    sta     VARTAB+1
d663: 85 b0                    sta     PRGEND+1
d665: 20 97 d6     SETPTRS     jsr     STXTPT          ;set TXTPTR to TXTTAB - 1
d668: a9 00                    lda     #$00            ;(this could have been .dd1 $2C)
                   * CLEAR statement                                                              *
d66a: d0 2a        CLEAR       bne     RTS_2           ;ignore if not at end of statement
d66c: a5 73        CLEARC      lda     MEMSIZE         ;clear string area
d66e: a4 74                    ldy     MEMSIZE+1
d670: 85 6f                    sta     FRETOP
d672: 84 70                    sty     FRETOP+1
d674: a5 69                    lda     VARTAB          ;clear array area
d676: a4 6a                    ldy     VARTAB+1
d678: 85 6b                    sta     ARYTAB
d67a: 84 6c                    sty     ARYTAB+1
d67c: 85 6d                    sta     STREND          ;low end of free space
d67e: 84 6e                    sty     STREND+1
d680: 20 49 d8                 jsr     RESTORE         ;set DATA pointer to beginning
d683: a2 55        STKINI      ldx     #TEMPST
d685: 86 52                    stx     TEMPPT
d687: 68                       pla                     ;save return address
d688: a8                       tay
d689: 68                       pla
d68a: a2 f8                    ldx     #$f8            ;start stack at $f8
d68c: 9a                       txs                     ;  leaving room for parsing lines
d68d: 48                       pha                     ;restore return address
d68e: 98                       tya
d68f: 48                       pha
d690: a9 00                    lda     #$00
d692: 85 7a                    sta     OLDTEXT+1
d694: 85 14                    sta     SUBFLG
d696: 60           RTS_2       rts

                   ; Set TXTPTR to beginning of program.
d697: 18           STXTPT      clc                     ;TXTPTR = TXTTAB - 1
d698: a5 67                    lda     TEXTTAB
d69a: 69 ff                    adc     #$ff
d69c: 85 b8                    sta     TXTPTR
d69e: a5 68                    lda     TEXTTAB+1
d6a0: 69 ff                    adc     #$ff
d6a2: 85 b9                    sta     TXTPTR+1
d6a4: 60                       rts

                   * LIST statement                                                               *
d6a5: 90 0a        LIST        bcc     LD6B1           ;no line # specified
d6a7: f0 08                    beq     LD6B1           ;---ditto---
d6a9: c9 c9                    cmp     #TOK_MINUS      ;if dash or comma, start at line 0
d6ab: f0 04                    beq     LD6B1           ;it is a dash
d6ad: c9 2c                    cmp     #‘,’            ;comma?
d6af: d0 e5                    bne     RTS_2           ;no, error
d6b1: 20 0c da     LD6B1       jsr     LINGET          ;convert line number if any
d6b4: 20 1a d6                 jsr     FNDLIN          ;point LOWTR to 1st line
d6b7: 20 b7 00                 jsr     CHRGOT          ;range specified?
d6ba: f0 10                    beq     LD6CC           ;no
d6bc: c9 c9                    cmp     #TOK_MINUS
d6be: f0 04                    beq     LD6C4
d6c0: c9 2c                    cmp     #‘,’
d6c2: d0 84                    bne     RTS_1
d6c4: 20 b1 00     LD6C4       jsr     CHRGET          ;get next char
d6c7: 20 0c da                 jsr     LINGET          ;convert second line #
d6ca: d0 ca                    bne     RTS_2           ;branch if syntax err
d6cc: 68           LD6CC       pla                     ;pop return address
d6cd: 68                       pla                     ;(get back by JMP NEWSTT
d6ce: a5 50                    lda     LINNUM          ;if no second number, use $FFFF
d6d0: 05 51                    ora     LINNUM+1
d6d2: d0 06                    bne     LIST_0          ;there was a second number
d6d4: a9 ff                    lda     #$ff            ;max end range
d6d6: 85 50                    sta     LINNUM
d6d8: 85 51                    sta     LINNUM+1
d6da: a0 01        LIST_0      ldy     #$01
d6dc: b1 9b                    lda     (LOWTR),y       ;high byte of link
d6de: f0 44                    beq     LIST_3          ;end of program
d6e0: 20 58 d8                 jsr     ISCNTC          ;check if Ctrl+C has been typed
d6e3: 20 fb da                 jsr     CRDO            ;no, print <return>
d6e6: c8                       iny
d6e7: b1 9b                    lda     (LOWTR),y       ;get line #, compare with end range
d6e9: aa                       tax
d6ea: c8                       iny
d6eb: b1 9b                    lda     (LOWTR),y
d6ed: c5 51                    cmp     LINNUM+1
d6ef: d0 04                    bne     LD6F5
d6f1: e4 50                    cpx     LINNUM
d6f3: f0 02                    beq     LD6F7           ;on last line of range
d6f5: b0 2d        LD6F5       bcs     LIST_3          ;fnished the range
d6f7: 84 85        LD6F7       sty     FORPNT
d6f9: 20 24 ed                 jsr     LINPRT          ;print line # from (X,A)
d6fc: a9 20                    lda     #‘ ’            ;print space after line #
d6fe: a4 85        LIST_1      ldy     FORPNT
d700: 29 7f                    and     #$7f
d702: 20 5c db     LIST_2      jsr     OUTDO
d705: a5 24                    lda     MON_CH          ;if past column 33, start a new line
d707: c9 21                    cmp     #33
d709: 90 07                    bcc     LD712           ;< 33
d70b: 20 fb da                 jsr     CRDO            ;print <return>
d70e: a9 05                    lda     #5              ;and tab over 5
d710: 85 24                    sta     MON_CH
d712: c8           LD712       iny
d713: b1 9b                    lda     (LOWTR),y
d715: d0 1d                    bne     LIST_4          ;not end of line yet
d717: a8                       tay                     ;end of line
d718: b1 9b                    lda     (LOWTR),y       ;get link to next line
d71a: aa                       tax
d71b: c8                       iny
d71c: b1 9b                    lda     (LOWTR),y
d71e: 86 9b                    stx     LOWTR           ;point to next line
d720: 85 9c                    sta     LOWTR+1
d722: d0 b6                    bne     LIST_0          ;branch if not end of program
d724: a9 0d        LIST_3      lda     #$0d            ;print <return>
d726: 20 5c db                 jsr     OUTDO
d729: 4c d2 d7                 jmp     NEWSTT          ;to next statement

d72c: c8           GETCHR      iny                     ;pick up char from table
d72d: d0 02                    bne     LD731
d72f: e6 9e                    inc     FAC+1
d731: b1 9d        LD731       lda     (FAC),y
d733: 60                       rts

d734: 10 cc        LIST_4      bpl     LIST_2          ;branch if not a token
d736: 38                       sec
d737: e9 7f                    sbc     #$7f            ;convert token to index
d739: aa                       tax
d73a: 84 85                    sty     FORPNT          ;save line pointer
d73c: a0 d0                    ldy     #<TOKEN_NAME_TABLE
d73e: 84 9d                    sty     FAC             ;point FAC to table
d740: a0 cf                    ldy     #(>TOKEN_NAME_TABLE)-1
d742: 84 9e                    sty     FAC+1
d744: a0 ff                    ldy     #$ff
d746: ca           LD746       dex                     ;skip keywords until reach this one
d747: f0 07                    beq     LD750
d749: 20 2c d7     LD749       jsr     GETCHR          ;bump Y, get char from table
d74c: 10 fb                    bpl     LD749           ;not at end of keyword yet
d74e: 30 f6                    bmi     LD746           ;end of keyword, always branches

d750: a9 20        LD750       lda     #‘ ’            ;found the right keyword
d752: 20 5c db                 jsr     OUTDO           ;print leading space
d755: 20 2c d7     LD755       jsr     GETCHR          ;print the keyword
d758: 30 05                    bmi     LD75F           ;last char of keyword
d75a: 20 5c db                 jsr     OUTDO
d75d: d0 f6                    bne     LD755           ;...always

d75f: 20 5c db     LD75F       jsr     OUTDO           ;print last char of keyword
d762: a9 20                    lda     #‘ ’            ;print trailing space
d764: d0 98                    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)                                                        *
d766: a9 80        FOR         lda     #$80
d768: 85 14                    sta     SUBFLG          ;subscripts not allowed
d76a: 20 46 da                 jsr     LET             ;do <var> = <exp>, store addr in FORPNT
d76d: 20 65 d3                 jsr     GTFORPNT        ;is this FOR variable active?
d770: d0 05                    bne     LD777           ;no
d772: 8a                       txa                     ;yes, cancel it and enclosed loops
d773: 69 0f                    adc     #$0f            ;carry=1, this adds 16
d775: aa                       tax                     ;X was already S+2
d776: 9a                       txs
d777: 68           LD777       pla                     ;pop return address too
d778: 68                       pla
d779: a9 09                    lda     #$09            ;be certain enough room in stack
d77b: 20 d6 d3                 jsr     CHKMEM
d77e: 20 a3 d9                 jsr     DATAN           ;scan ahead to next statement
d781: 18                       clc                     ;push statement address on stack
d782: 98                       tya
d783: 65 b8                    adc     TXTPTR
d785: 48                       pha
d786: a5 b9                    lda     TXTPTR+1
d788: 69 00                    adc     #$00
d78a: 48                       pha
d78b: a5 76                    lda     CURLIN+1        ;push line number on stack
d78d: 48                       pha
d78e: a5 75                    lda     CURLIN
d790: 48                       pha
d791: a9 c1                    lda     #TOK_TO
d793: 20 c0 de                 jsr     SYNCHR          ;require TO
d796: 20 6a dd                 jsr     CHKNUM          ;<var> = <exp> must be numeric
d799: 20 67 dd                 jsr     FRMNUM          ;get final value, must be numeric
d79c: a5 a2                    lda     FAC_SIGN        ;put sign into value in FAC
d79e: 09 7f                    ora     #$7f
d7a0: 25 9e                    and     FAC+1
d7a2: 85 9e                    sta     FAC+1
d7a4: a9 af                    lda     #<STEP          ;set up for return
d7a6: a0 d7                    ldy     #>STEP          ;  to step
d7a8: 85 5e                    sta     INDEX
d7aa: 84 5f                    sty     INDEX+1
d7ac: 4c 20 de                 jmp     FRM_STACK_3     ;returns by "JMP (INDEX)"

                   ; STEP phrase of FOR statement.
d7af: a9 13        STEP        lda     #<CON_ONE       ;STEP default=1
d7b1: a0 e9                    ldy     #>CON_ONE
d7b3: 20 f9 ea                 jsr     LOAD_FAC_FROM_YA
d7b6: 20 b7 00                 jsr     CHRGOT
d7b9: c9 c7                    cmp     #TOK_STEP
d7bb: d0 06                    bne     LD7C3           ;use default value of 1.0
d7bd: 20 b1 00                 jsr     CHRGET          ;step specified, get it
d7c0: 20 67 dd                 jsr     FRMNUM
d7c3: 20 82 eb     LD7C3       jsr     SIGN
d7c6: 20 15 de                 jsr     FRM_STACK_2
d7c9: a5 86                    lda     FORPNT+1
d7cb: 48                       pha
d7cc: a5 85                    lda     FORPNT
d7ce: 48                       pha
d7cf: a9 81                    lda     #TOK_FOR
d7d1: 48                       pha
                   ; Perform NEXT statement.
d7d2: ba           NEWSTT      tsx                     ;remember the stack position
d7d3: 86 f8                    stx     REMSTK
d7d5: 20 58 d8                 jsr     ISCNTC          ;see if Ctrl+C has been typed
d7d8: a5 b8                    lda     TXTPTR          ;no, keep executing
d7da: a4 b9                    ldy     TXTPTR+1
d7dc: a6 76                    ldx     CURLIN+1        ;=$FF if in direct mode
d7de: e8                       inx                     ; $FF turns into $00
d7df: f0 04                    beq     LD7E5           ; in direct mode
d7e1: 85 79                    sta     OLDTEXT         ;in running mode
d7e3: 84 7a                    sty     OLDTEXT+1
d7e5: a0 00        LD7E5       ldy     #$00
d7e7: b1 b8                    lda     (TXTPTR),y      ;end of line yet?
d7e9: d0 57                    bne     COLON           ;no
d7eb: a0 02                    ldy     #$02            ;yes, see if end of program
d7ed: b1 b8                    lda     (TXTPTR),y
d7ef: 18                       clc
d7f0: f0 34                    beq     GOEND           ;yes, end of program
d7f2: c8                       iny
d7f3: b1 b8                    lda     (TXTPTR),y      ;get line # of next line
d7f5: 85 75                    sta     CURLIN
d7f7: c8                       iny
d7f8: b1 b8                    lda     (TXTPTR),y
d7fa: 85 76                    sta     CURLIN+1
d7fc: 98                       tya                     ;adjust TXTPTR to start
d7fd: 65 b8                    adc     TXTPTR          ;of new line
d7ff: 85 b8                    sta     TXTPTR
d801: 90 02                    bcc     TRACE_
d803: e6 b9                    inc     TXTPTR+1
d805: 24 f2        TRACE_      bit     TRCFLG          ;is trace on?
d807: 10 14                    bpl     LD81D           ;no
d809: a6 76                    ldx     CURLIN+1        ;yes, are we running?
d80b: e8                       inx
d80c: f0 0f                    beq     LD81D           ;not running, so don't trace
d80e: a9 23                    lda     #‘#’            ;print '#'
d810: 20 5c db                 jsr     OUTDO
d813: a6 75                    ldx     CURLIN
d815: a5 76                    lda     CURLIN+1
d817: 20 24 ed                 jsr     LINPRT          ;print line number
d81a: 20 57 db                 jsr     OUTSP           ;print trailing space
d81d: 20 b1 00     LD81D       jsr     CHRGET          ;get first chr of statement
d820: 20 28 d8                 jsr     EXECUTE_STATEMENT ;and start processing
d823: 4c d2 d7                 jmp     NEWSTT          ;back for more

d826: f0 62        GOEND       beq     END4

                   ; Execute a statement
                   ;   A-reg is first char of statement
                   ;   Carry is set
d828: f0 2d                    beq     RTS_3           ;end of line, null statement
d82a: e9 80                    sbc     #$80            ;first char a token?
d82c: 90 11                    bcc     LD83F           ;not token, must be LET
d82e: c9 40                    cmp     #$40            ;statement-type token?
d830: b0 14                    bcs     SYNERR_1        ;no, syntax error
d832: 0a                       asl     A               ;double to get index
d833: a8                       tay                     ;into address table
d834: b9 01 d0                 lda     TOKEN_ADDR_TABLE+1,y
d837: 48                       pha                     ;put address on stack
d838: b9 00 d0                 lda     TOKEN_ADDR_TABLE,y
d83b: 48                       pha
d83c: 4c b1 00                 jmp     CHRGET          ;get next chr & rts to routine

d83f: 4c 46 da     LD83F       jmp     LET             ;must be <var> = <exp>

d842: c9 3a        COLON       cmp     #‘:’
d844: f0 bf                    beq     TRACE_
d846: 4c c9 de     SYNERR_1    jmp     SYNERR

                   * RESTORE statement                                                            *
d849: 38           RESTORE     sec                     ;set DATPTR to beginning of program
d84a: a5 67                    lda     TEXTTAB
d84c: e9 01                    sbc     #$01
d84e: a4 68                    ldy     TEXTTAB+1
d850: b0 01                    bcs     SETDA
d852: 88                       dey
                   ; Set DATPTR to (Y,A)
d853: 85 7d        SETDA       sta     DATPTR
d855: 84 7e                    sty     DATPTR+1
d857: 60           RTS_3       rts

                   ; See if Ctrl+C typed
d858: ad 00 c0     ISCNTC      lda     KBD
d85b: c9 83                    cmp     #$83
d85d: f0 01                    beq     LD860
d85f: 60                       rts

d860: 20 53 d5     LD860       jsr     INCHR           ;<<< should be BIT $C010 >>>
d863: a2 ff                    ldx     #$ff            ;Ctrl+C attempted
d865: 24 d8                    bit     ERRFLG          ;ON ERR enabled?
d867: 10 03                    bpl     LD86C           ;no
d869: 4c e9 f2                 jmp     HANDLERR        ;yes, return err code = 255

d86c: c9 03        LD86C       cmp     #$03            ;since it is Ctrl+C, set Z and C bits
                   * STOP statement                                                               *
d86e: b0 01        STOP        bcs     END2            ;carry=1 to force printing "BREAK AT.."
                   * END statement                                                                *
d870: 18           END         clc                     ;carry=0 to avoid printing message
d871: d0 3c        END2        bne     RTS_4           ;if not end of statement, do nothing
d873: a5 b8                    lda     TXTPTR
d875: a4 b9                    ldy     TXTPTR+1
d877: a6 76                    ldx     CURLIN+1
d879: e8                       inx                     ;running?
d87a: f0 0c                    beq     LD888           ;no, direct mode
d87c: 85 79                    sta     OLDTEXT
d87e: 84 7a                    sty     OLDTEXT+1
d880: a5 75                    lda     CURLIN
d882: a4 76                    ldy     CURLIN+1
d884: 85 77                    sta     OLDIN
d886: 84 78                    sty     OLDIN+1
d888: 68           LD888       pla
d889: 68                       pla
d88a: a9 5d        END4        lda     #<QT_BREAK      ;" BREAK" and bell
d88c: a0 d3                    ldy     #>QT_BREAK
d88e: 90 03                    bcc     LD893
d890: 4c 31 d4                 jmp     PRINT_ERROR_LINNUM

d893: 4c 3c d4     LD893       jmp     RESTART

                   * CONT statement                                                               *
d896: d0 17        CONT        bne     RTS_4           ;if not end of statement, do nothing
d898: a2 d2                    ldx     #ERR_CANTCONT
d89a: a4 7a                    ldy     OLDTEXT+1       ;meaningful re-entry?
d89c: d0 03                    bne     LD8A1           ;yes
d89e: 4c 12 d4                 jmp     ERROR           ;no

d8a1: a5 79        LD8A1       lda     OLDTEXT         ;restore TXTPTR
d8a3: 85 b8                    sta     TXTPTR
d8a5: 84 b9                    sty     TXTPTR+1
d8a7: a5 77                    lda     OLDIN           ;restore line number
d8a9: a4 78                    ldy     OLDIN+1
d8ab: 85 75                    sta     CURLIN
d8ad: 84 76                    sty     CURLIN+1
d8af: 60           RTS_4       rts

                   * SAVE statement                                                               *
                   *                                                                              *
                   * Writes program on cassette tape.                                             *
d8b0: 38           SAVE        sec
d8b1: a5 af                    lda     PRGEND          ;compute program length
d8b3: e5 67                    sbc     TEXTTAB
d8b5: 85 50                    sta     LINNUM
d8b7: a5 b0                    lda     PRGEND+1
d8b9: e5 68                    sbc     TEXTTAB+1
d8bb: 85 51                    sta     LINNUM+1
d8bd: 20 f0 d8                 jsr     VARTIO          ;set up to write 3-byte header
d8c0: 20 cd fe                 jsr     MON_WRITE       ;write 'em
d8c3: 20 01 d9                 jsr     PROGIO          ;set up to write the program
d8c6: 4c cd fe                 jmp     MON_WRITE       ;write it

                   * LOAD statement                                                               *
                   *                                                                              *
                   * Reads a program from cassette tape.                                          *
d8c9: 20 f0 d8     LOAD        jsr     VARTIO          ;set up to read 3-byte header
d8cc: 20 fd fe                 jsr     MON_READ        ;read length, lock byte
d8cf: 18                       clc
d8d0: a5 67                    lda     TEXTTAB         ;compute end address
d8d2: 65 50                    adc     LINNUM
d8d4: 85 69                    sta     VARTAB
d8d6: a5 68                    lda     TEXTTAB+1
d8d8: 65 51                    adc     LINNUM+1
d8da: 85 6a                    sta     VARTAB+1
d8dc: a5 52                    lda     TEMPPT          ;lock byte
d8de: 85 d6                    sta     LOCK
d8e0: 20 01 d9                 jsr     PROGIO          ;set up to read program
d8e3: 20 fd fe                 jsr     MON_READ        ;read it
d8e6: 24 d6                    bit     LOCK            ;if locked, start running now
d8e8: 10 03                    bpl     LD8ED           ;not locked
d8ea: 4c 65 d6                 jmp     SETPTRS         ;locked, start running

d8ed: 4c f2 d4     LD8ED       jmp     FIX_LINKS       ;just fix forward pointers

d8f0: a9 50        VARTIO      lda     #LINNUM         ;set up to read/write 3-byte header
d8f2: a0 00                    ldy     #$00
d8f4: 85 3c                    sta     MON_A1L
d8f6: 84 3d                    sty     MON_A1H
d8f8: a9 52                    lda     #TEMPPT
d8fa: 85 3e                    sta     MON_A2L
d8fc: 84 3f                    sty     MON_A2H
d8fe: 84 d6                    sty     LOCK
d900: 60                       rts

d901: a5 67        PROGIO      lda     TEXTTAB         ;set up to read/write program
d903: a4 68                    ldy     TEXTTAB+1
d905: 85 3c                    sta     MON_A1L
d907: 84 3d                    sty     MON_A1H
d909: a5 69                    lda     VARTAB
d90b: a4 6a                    ldy     VARTAB+1
d90d: 85 3e                    sta     MON_A2L
d90f: 84 3f                    sty     MON_A2H
d911: 60                       rts

                   * RUN statement                                                                *
d912: 08           RUN         php                     ;save status while subtracting
d913: c6 76                    dec     CURLIN+1        ;if was $FF (meaning direct mode), make it run mode
d915: 28                       plp                     ;get status again (from CHRGET)
d916: d0 03                    bne     LD91B           ;probably a line number
d918: 4c 65 d6                 jmp     SETPTRS         ;start at beginning of program

d91b: 20 6c d6     LD91B       jsr     CLEARC          ;clear variables
d91e: 4c 35 d9                 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)                                                      *
d921: a9 03        GOSUB       lda     #$03            ;be sure enough room on stack
d923: 20 d6 d3                 jsr     CHKMEM
d926: a5 b9                    lda     TXTPTR+1
d928: 48                       pha
d929: a5 b8                    lda     TXTPTR
d92b: 48                       pha
d92c: a5 76                    lda     CURLIN+1
d92e: 48                       pha
d92f: a5 75                    lda     CURLIN
d931: 48                       pha
d932: a9 b0                    lda     #TOK_GOSUB
d934: 48                       pha
d935: 20 b7 00     GO_TO_LINE  jsr     CHRGOT
d938: 20 3e d9                 jsr     GOTO
d93b: 4c d2 d7                 jmp     NEWSTT

                   * GOTO statement                                                               *
                   *                                                                              *
                   * Also used by RUN and GOSUB                                                   *
d93e: 20 0c da     GOTO        jsr     LINGET          ;get GOTO line
d941: 20 a6 d9                 jsr     REMN            ;point Y to EOL
d944: a5 76                    lda     CURLIN+1        ;is current page < GOTO page?
d946: c5 51                    cmp     LINNUM+1
d948: b0 0b                    bcs     LD955           ;search from prog start if not
d94a: 98                       tya                     ;otherwise search from next line
d94b: 38                       sec
d94c: 65 b8                    adc     TXTPTR
d94e: a6 b9                    ldx     TXTPTR+1
d950: 90 07                    bcc     LD959
d952: e8                       inx
d953: b0 04                    bcs     LD959

d955: a5 67        LD955       lda     TEXTTAB         ;get program beginning
d957: a6 68                    ldx     TEXTTAB+1
d959: 20 1e d6     LD959       jsr     FL1             ;search for GOTO line
d95c: 90 1e                    bcc     UNDERR          ;error if not there
d95e: a5 9b                    lda     LOWTR           ;TXTPTR = start of the destination line
d960: e9 01                    sbc     #$01
d962: 85 b8                    sta     TXTPTR
d964: a5 9c                    lda     LOWTR+1
d966: e9 00                    sbc     #$00
d968: 85 b9                    sta     TXTPTR+1
d96a: 60           RTS_5       rts                     ;return to NEWSTT or GOSUB

                   * POP and RETURN statements                                                    *
d96b: d0 fd        POP         bne     RTS_5
d96d: a9 ff                    lda     #$ff
d96f: 85 85                    sta     FORPNT          ;<<< BUG: should be FORPNT+1 >>>
                   ; <<< see "All About Applesoft", pages 100,101 >>>
d971: 20 65 d3                 jsr     GTFORPNT        ;to cancel FOR/NEXT in sub
d974: 9a                       txs
d975: c9 b0                    cmp     #TOK_GOSUB      ;last GOSUB found?
d977: f0 0b                    beq     RETURN
d979: a2 16                    ldx     #ERR_NOGOSUB
d97b: 2c                       bit ▼   $5aa2           ;fake: BIT xxxx skips ahead to JMP ERROR
d97c: a2 5a        UNDERR      ldx     #ERR_UNDEFSTAT
d97e: 4c 12 d4                 jmp     ERROR

d981: 4c c9 de     SYNERR_2    jmp     SYNERR

d984: 68           RETURN      pla                     ;discard GOSUB token
d985: 68                       pla
d986: c0 42                    cpy     #$42            ;(should be #TOK_POP*2 = $142)
d988: f0 3b                    beq     PULL3           ;branch if a POP
d98a: 85 75                    sta     CURLIN          ;pull line #
d98c: 68                       pla
d98d: 85 76                    sta     CURLIN+1
d98f: 68                       pla
d990: 85 b8                    sta     TXTPTR          ;pull TXTPTR
d992: 68                       pla
d993: 85 b9                    sta     TXTPTR+1
                   * DATA statement                                                               *
                   *                                                                              *
                   * Executed by skipping to next colon or EOL                                    *
d995: 20 a3 d9     DATA        jsr     DATAN           ;move to next statement
                   ; add Y-reg to TXTPTR
d998: 98           ADDON       tya
d999: 18                       clc
d99a: 65 b8                    adc     TXTPTR
d99c: 85 b8                    sta     TXTPTR
d99e: 90 02                    bcc     RTS_6
d9a0: e6 b9                    inc     TXTPTR+1
d9a2: 60           RTS_6       rts

                   ; Scan ahead to next ':' or EOL
d9a3: a2 3a        DATAN       ldx     #‘:’            ;get offset in Y to EOL or ':'
d9a5: 2c                       bit ▼   a:FAC_SIGN      ;fake
d9a6: a2 00        REMN        ldx     #$00            ;to EOL only
d9a8: 86 0d                    stx     CHARAC
d9aa: a0 00                    ldy     #$00
d9ac: 84 0e                    sty     ENDCHR
d9ae: a5 0e        LD9AE       lda     ENDCHR          ;trick to count quote parity
d9b0: a6 0d                    ldx     CHARAC
d9b2: 85 0d                    sta     CHARAC
d9b4: 86 0e                    stx     ENDCHR
d9b6: b1 b8        LD9B6       lda     (TXTPTR),y
d9b8: f0 e8                    beq     RTS_6           ;end of line
d9ba: c5 0e                    cmp     ENDCHR
d9bc: f0 e4                    beq     RTS_6           ;colon if looking for colons
d9be: c8                       iny
d9bf: c9 22                    cmp     #‘"’
d9c1: d0 f3                    bne     LD9B6
d9c3: f0 e9                    beq     LD9AE           ;...always

d9c5: 68           PULL3       pla
d9c6: 68                       pla
d9c7: 68                       pla
d9c8: 60                       rts

                   * IF statement                                                                 *
d9c9: 20 7b dd     IF          jsr     FRMEVL
d9cc: 20 b7 00                 jsr     CHRGOT
d9cf: c9 ab                    cmp     #TOK_GOTO
d9d1: f0 05                    beq     LD9D8
d9d3: a9 c4                    lda     #TOK_THEN
d9d5: 20 c0 de                 jsr     SYNCHR
d9d8: a5 9d        LD9D8       lda     FAC             ;condition true or false?
d9da: d0 05                    bne     IF_TRUE         ;branch if true
                   * REM statement                                                                *
                   *                                                                              *
                   * Or false IF statement                                                        *
d9dc: 20 a6 d9     REM         jsr     REMN            ;skip read of line
d9df: f0 b7                    beq     ADDON           ;...always

d9e1: 20 b7 00     IF_TRUE     jsr     CHRGOT          ;command or number?
d9e4: b0 03                    bcs     LD9E9           ;command
d9e6: 4c 3e d9                 jmp     GOTO            ;number

d9e9: 4c 28 d8     LD9E9       jmp     EXECUTE_STATEMENT

                   * ON statement                                                                 *
                   *                                                                              *
                   *   ON <exp> GOTO <list>                                                       *
                   *   ON <exp> GOSUB <list>                                                      *
d9ec: 20 f8 e6     ONGOTO      jsr     GETBYT          ;evaluate <exp>, as byte in FAC+4
d9ef: 48                       pha                     ;save next char on stack
d9f0: c9 b0                    cmp     #TOK_GOSUB
d9f2: f0 04                    beq     ON_2
d9f4: c9 ab        ON_1        cmp     #TOK_GOTO
d9f6: d0 89                    bne     SYNERR_2
d9f8: c6 a1        ON_2        dec     FAC+4           ;counted to right one yet?
d9fa: d0 04                    bne     LDA00           ;no, keep looking
d9fc: 68                       pla                     ;yes, retrieve cmd
d9fd: 4c 2a d8                 jmp     EXECUTE_STATEMENT_1 ;and go

da00: 20 b1 00     LDA00       jsr     CHRGET          ;prime convert subroutine
da03: 20 0c da                 jsr     LINGET          ;convert line #
da06: c9 2c                    cmp     #‘,’            ;terminate with comma?
da08: f0 ee                    beq     ON_2            ;yes
da0a: 68                       pla                     ;no, end of list, so ignore
da0b: 60           RTS_7       rts

                   ; Convert line number
da0c: a2 00        LINGET      ldx     #$00            ;asc # to hex address
da0e: 86 50                    stx     LINNUM          ;in LINNUM
da10: 86 51                    stx     LINNUM+1
da12: b0 f7        LDA12       bcs     RTS_7           ;not a digit
da14: e9 2f                    sbc     #‘/’            ;(should be #'0'-1) convert digit to binary
da16: 85 0d                    sta     CHARAC          ;save the digit
da18: a5 51                    lda     LINNUM+1        ;check range
da1a: 85 5e                    sta     INDEX
da1c: c9 19                    cmp     #$19            ;(should be #>6400) line # too large?
da1e: b0 d4                    bcs     ON_1            ;yes, > 63999, go indirectly to "SYNTAX ERROR"
                   ; <<< DANGEROUS CODE >>>
                   ; Note that if A-reg = $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 if 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 >>>
da20: a5 50                    lda     LINNUM          ;multiply by ten
da22: 0a                       asl     A
da23: 26 5e                    rol     INDEX
da25: 0a                       asl     A
da26: 26 5e                    rol     INDEX
da28: 65 50                    adc     LINNUM
da2a: 85 50                    sta     LINNUM
da2c: a5 5e                    lda     INDEX
da2e: 65 51                    adc     LINNUM+1
da30: 85 51                    sta     LINNUM+1
da32: 06 50                    asl     LINNUM
da34: 26 51                    rol     LINNUM+1
da36: a5 50                    lda     LINNUM
da38: 65 0d                    adc     CHARAC          ;add digit
da3a: 85 50                    sta     LINNUM
da3c: 90 02                    bcc     LDA40
da3e: e6 51                    inc     LINNUM+1
da40: 20 b1 00     LDA40       jsr     CHRGET          ;get next char
da43: 4c 12 da                 jmp     LDA12           ;more converting

                   * LET statement                                                                *
                   *                                                                              *
                   * LET <var> = <exp>                                                            *
                   * <var> = <exp>                                                                *
da46: 20 e3 df     LET         jsr     PTRGET          ;get <var>
da49: 85 85                    sta     FORPNT
da4b: 84 86                    sty     FORPNT+1
da4d: a9 d0                    lda     #TOK_EQUAL
da4f: 20 c0 de                 jsr     SYNCHR
da52: a5 12                    lda     VALTYP+1        ;save variable type
da54: 48                       pha
da55: a5 11                    lda     VALTYP
da57: 48                       pha
da58: 20 7b dd                 jsr     FRMEVL          ;evalute <exp>
da5b: 68                       pla
da5c: 2a                       rol     A
da5d: 20 6d dd                 jsr     CHKVAL
da60: d0 18                    bne     LET_STRING
da62: 68                       pla
da63: 10 12        LET2        bpl     LDA77           ;real variable
da65: 20 72 eb                 jsr     ROUND_FAC       ;integer var: round to 32 bits
da68: 20 0c e1                 jsr     AYINT           ;truncate to 16 bits
da6b: a0 00                    ldy     #$00
da6d: a5 a0                    lda     FAC+3
da6f: 91 85                    sta     (FORPNT),y
da71: c8                       iny
da72: a5 a1                    lda     FAC+4
da74: 91 85                    sta     (FORPNT),y
da76: 60                       rts

                   ; Real variable = expression
da77: 4c 27 eb     LDA77       jmp     SETFOR

da7a: 68           LET_STRING  pla
                   ; Install string, descriptor address is at FAC+3,4
da7b: a0 02        PUTSTR      ldy     #$02            ;string data already in string area?
da7d: b1 a0                    lda     (FAC+3),y       ;(string area is between FRETOP HIMEM)
da7f: c5 70                    cmp     FRETOP+1
da81: 90 17                    bcc     LDA9A           ;yes, data already up there
da83: d0 07                    bne     LDA8C           ;no
da85: 88                       dey                     ;maybe, test low byte of pointer
da86: b1 a0                    lda     (FAC+3),y
da88: c5 6f                    cmp     FRETOP
da8a: 90 0e                    bcc     LDA9A           ;yes, already there
da8c: a4 a1        LDA8C       ldy     FAC+4           ;no; descriptor already among variables?
da8e: c4 6a                    cpy     VARTAB+1
da90: 90 08                    bcc     LDA9A           ;no
da92: d0 0d                    bne     LDAA1           ;yes
da94: a5 a0                    lda     FAC+3           ;maybe, compare low byte
da96: c5 69                    cmp     VARTAB
da98: b0 07                    bcs     LDAA1           ;yes, descriptor is among variables
da9a: a5 a0        LDA9A       lda     FAC+3           ;either string already on top, or
da9c: a4 a1                    ldy     FAC+4           ;descriptor is not a variable
da9e: 4c b7 da                 jmp     LDAB7           ;so just store the descriptor

                   ; string not yet in string area, and descriptor is a variable
daa1: a0 00        LDAA1       ldy     #$00            ;point at length in descriptor
daa3: b1 a0                    lda     (FAC+3),y       ;get length
daa5: 20 d5 e3                 jsr     STRINI          ;make a string that long up above
daa8: a5 8c                    lda     DSCPTR          ;set up source ptr for MOVINS
daaa: a4 8d                    ldy     DSCPTR+1
daac: 85 ab                    sta     STRNG1
daae: 84 ac                    sty     STRNG1+1
dab0: 20 d4 e5                 jsr     MOVINS          ;move string data to new area
dab3: a9 9d                    lda     #FAC            ;address of descriptor is in FAC
dab5: a0 00                    ldy     #>FAC
dab7: 85 8c        LDAB7       sta     DSCPTR
dab9: 84 8d                    sty     DSCPTR+1
dabb: 20 35 e6                 jsr     FRETMS          ;discard descriptor if 'twas temporary
dabe: a0 00                    ldy     #$00            ;copy string descriptor
dac0: b1 8c                    lda     (DSCPTR),y
dac2: 91 85                    sta     (FORPNT),y
dac4: c8                       iny
dac5: b1 8c                    lda     (DSCPTR),y
dac7: 91 85                    sta     (FORPNT),y
dac9: c8                       iny
daca: b1 8c                    lda     (DSCPTR),y
dacc: 91 85                    sta     (FORPNT),y
dace: 60                       rts

dacf: 20 3d db     PR_STRING   jsr     STRPRT
dad2: 20 b7 00                 jsr     CHRGOT
                   * PRINT statement                                                              *
dad5: f0 24        PRINT       beq     CRDO            ;no more list, print <return>
dad7: f0 29        PRINT2      beq     RTS_8           ;no more list, don't print <return>
dad9: c9 c0                    cmp     #TOK_TAB
dadb: f0 39                    beq     PR_TAB_OR_SPC   ;C=1 for TAB(
dadd: c9 c3                    cmp     #TOK_SPC
dadf: 18                       clc
dae0: f0 34                    beq     PR_TAB_OR_SPC   ;C=0 for SPC(
dae2: c9 2c                    cmp     #‘,’
dae4: 18                       clc                     ;<<< no purpose to this >>>
dae5: f0 1c                    beq     PR_COMMA
dae7: c9 3b                    cmp     #‘;’
dae9: f0 44                    beq     PR_NEXT_CHAR
daeb: 20 7b dd                 jsr     FRMEVL          ;evaluate expression
daee: 24 11                    bit     VALTYP          ;string or FP value?
daf0: 30 dd                    bmi     PR_STRING       ;string
daf2: 20 34 ed                 jsr     FOUT            ;FP: convert into buffer
daf5: 20 e7 e3                 jsr     STRLIT          ;make buffer into string
daf8: 4c cf da                 jmp     PR_STRING       ;print the string

dafb: a9 0d        CRDO        lda     #$0d            ;print <return>
dafd: 20 5c db                 jsr     OUTDO
db00: 49 ff        NEGATE      eor     #$ff            ;<<< why??? >>>
db02: 60           RTS_8       rts

                   ; Tab to next comma column
                   ; <<< note bug if width of window less than 33 >>>
db03: a5 24        PR_COMMA    lda     MON_CH
db05: c9 18                    cmp     #24             ;<<< bug: it should be 32 >>>
db07: 90 05                    bcc     LDB0E           ;next column, same line
db09: 20 fb da                 jsr     CRDO            ;first column, next line
db0c: d0 21                    bne     PR_NEXT_CHAR    ;...always

db0e: 69 10        LDB0E       adc     #16
db10: 29 f0                    and     #$f0            ;round to 16 or 32
db12: 85 24                    sta     MON_CH
db14: 90 19                    bcc     PR_NEXT_CHAR    ;...always
db16: 08                       php                     ;C=0 for SPC(, C=1 for TAB(
db17: 20 f5 e6                 jsr     GTBYTC          ;get value
db1a: c9 29                    cmp     #‘)’            ;trailing parenthesis
db1c: f0 03                    beq     LDB21           ;good
db1e: 4c c9 de                 jmp     SYNERR          ;no, syntax error

db21: 28           LDB21       plp                     ;TAB( or SPC(
db22: 90 07                    bcc     LDB2B           ;SPC(
db24: ca                       dex                     ;TAB(
db25: 8a                       txa                     ;calculate spaces needed for TAB(
db26: e5 24                    sbc     MON_CH
db28: 90 05                    bcc     PR_NEXT_CHAR    ;already past that column
db2a: aa                       tax                     ;now do a SPC( to the specified column
db2b: e8           LDB2B       inx
db2c: ca           NXSPC       dex
db2d: d0 06                    bne     DOSPC           ;more spaces to print
db2f: 20 b1 00                 jsr     CHRGET
db32: 4c d7 da                 jmp     PRINT2          ;continue parsing print list

db35: 20 57 db     DOSPC       jsr     OUTSP
db38: d0 f2                    bne     NXSPC           ;...always

                   ; Print string at (Y,A)
db3a: 20 e7 e3     STROUT      jsr     STRLIT          ;make (Y,A) printable
                   ; Print string at (FACMO,FACLO)
db3d: 20 00 e6     STRPRT      jsr     FREFAC          ;get address into INDEX, A-reg = length
db40: aa                       tax                     ;use X-reg for counter
db41: a0 00                    ldy     #$00            ;use Y-reg for scanner
db43: e8                       inx
db44: ca           LDB44       dex
db45: f0 bb                    beq     RTS_8           ;finished
db47: b1 5e                    lda     (INDEX),y       ;next char from string
db49: 20 5c db                 jsr     OUTDO           ;print the char
db4c: c8                       iny
                   ; <<< next three lines are useless >>>
db4d: c9 0d                    cmp     #$0d            ;was it <return>?
db4f: d0 f3                    bne     LDB44           ;no
db51: 20 00 db                 jsr     NEGATE          ;EOR #$FF would do it, but why?
db54: 4c 44 db                 jmp     LDB44

db57: a9 20        OUTSP       lda     #‘ ’            ;print a space
db59: 2c                       bit ▼   $3fa9           ;skip over next line
db5a: a9 3f        OUTQUES     lda     #‘?’            ;print question mark
                   ; Print char from A-reg
                   ; 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.
db5c: 09 80        OUTDO       ora     #$80            ;print A-reg
db5e: c9 a0                    cmp     #$a0            ;control chr?
db60: 90 02                    bcc     LDB64           ;skip if so
db62: 05 f3                    ora     FLASH_BIT       ;=$40 for FLASH, else $00
db64: 20 ed fd     LDB64       jsr     MON_COUT        ;ANDs with $3F (INVERSE), $7F (FLASH)
db67: 29 7f                    and     #$7f
db69: 48                       pha
db6a: a5 f1                    lda     SPEEDZ          ;complement of speed #
db6c: 20 a8 fc                 jsr     MON_WAIT        ;so SPEED=255 becomes A=1
db6f: 68                       pla
db70: 60                       rts

                   ; Input conversion error: illegal character in numeric field.  Must distinguish
                   ; between INPUT, READ, and GET
db71: a5 15        INPUTERR    lda     INPUTFLG
db73: f0 12                    beq     RESPERR         ;taken if INPUT
db75: 30 04                    bmi     READERR         ;taken if READ
db77: a0 ff                    ldy     #$ff            ;from a GET
db79: d0 04                    bne     ERLIN           ;...always

db7b: a5 7b        READERR     lda     DATLIN          ;tell where the DATA is, rather
db7d: a4 7c                    ldy     DATLIN+1        ; than the READ
db7f: 85 75        ERLIN       sta     CURLIN
db81: 84 76                    sty     CURLIN+1
db83: 4c c9 de                 jmp     SYNERR

db86: 68           INPERR      pla
db87: 24 d8        RESPERR     bit     ERRFLG          ;ON ERR turned on?
db89: 10 05                    bpl     LDB90           ;no, give reentry a try
db8b: a2 fe                    ldx     #254            ;error code = 254
db8d: 4c e9 f2                 jmp     HANDLERR

db90: a9 ef        LDB90       lda     #<ERR_REENTRY   ;"?REENTER"
db92: a0 dc                    ldy     #>ERR_REENTRY
db94: 20 3a db                 jsr     STROUT
db97: a5 79                    lda     OLDTEXT         ;re-execute the whole INPUT statement
db99: a4 7a                    ldy     OLDTEXT+1
db9b: 85 b8                    sta     TXTPTR
db9d: 84 b9                    sty     TXTPTR+1
db9f: 60                       rts

                   * GET statement                                                                *
dba0: 20 06 e3     GET         jsr     ERRDIR          ;illegal if in direct mode
dba3: a2 01                    ldx     #<INPUT_BUFFER+1 ;simulate input
dba5: a0 02                    ldy     #>INPUT_BUFFER
dba7: a9 00                    lda     #$00
dba9: 8d 01 02                 sta     INPUT_BUFFER+1
dbac: a9 40                    lda     #$40            ;set up inputflg
dbae: 20 eb db                 jsr     PROCESS_INPUT_LIST ;<<< can save 1 byte here >>>
dbb1: 60                       rts                     ;<<< by JMP PROCESS_INPUT_LIST >>>

                   * INPUT statement                                                              *
dbb2: c9 22        INPUT       cmp     #‘"’            ;check for optional prompt string
dbb4: d0 0e                    bne     LDBC4           ;no, print "?" prompt
dbb6: 20 81 de                 jsr     STRTXT          ;make a printable string out of it
dbb9: a9 3b                    lda     #‘;’            ;must have ';' now
dbbb: 20 c0 de                 jsr     SYNCHR
dbbe: 20 3d db                 jsr     STRPRT          ;print the string
dbc1: 4c c7 db                 jmp     LDBC7

dbc4: 20 5a db     LDBC4       jsr     OUTQUES         ;no string, print "?"
dbc7: 20 06 e3     LDBC7       jsr     ERRDIR          ;illegal if in direct mode
dbca: a9 2c                    lda     #‘,’            ;prime the buffer
dbcc: 8d ff 01                 sta     INPUT_BUFFER-1
dbcf: 20 2c d5                 jsr     INLIN
dbd2: ad 00 02                 lda     INPUT_BUFFER
dbd5: c9 03                    cmp     #$03            ;Ctrl+C?
dbd7: d0 10                    bne     INPUT_FLAG_ZERO ;no
dbd9: 4c 63 d8                 jmp     CTRL_C_TYPED

dbdc: 20 5a db     NXIN        jsr     OUTQUES         ;print "?"
dbdf: 4c 2c d5                 jmp     INLIN

                   * READ statement                                                               *
dbe2: a6 7d        READ        ldx     DATPTR          ;(Y,X) points at next DATA statement
dbe4: a4 7e                    ldy     DATPTR+1
dbe6: a9 98                    lda     #$98            ;set INPUTFLG=$98
dbe8: 2c                       bit ▼   a:$00a9         ;trick to PROCESS_INPUT_LIST
dbe9: a9 00                    lda     #$00            ;set INPUTFLG = $00
                   ; Process input list
                   ;   (Y,X) is address of input data string
                   ;   A-reg = value for INPUTFLG: $00 for INPUT
                   ;                               $40 for GET
                   ;                               $98 for READ
dbeb: 85 15                    sta     INPUTFLG
dbed: 86 7f                    stx     INPTR           ;address of input string
dbef: 84 80                    sty     INPTR+1
dbf1: 20 e3 df                 jsr     PTRGET          ;get address of variable
dbf4: 85 85                    sta     FORPNT
dbf6: 84 86                    sty     FORPNT+1
dbf8: a5 b8                    lda     TXTPTR
dbfa: a4 b9                    ldy     TXTPTR+1        ;save current TXTPTR
dbfc: 85 87                    sta     TXPSV           ;which points into program
dbfe: 84 88                    sty     TXPSV+1
dc00: a6 7f                    ldx     INPTR           ;set TXTPTR to point at input buffer
dc02: a4 80                    ldy     INPTR+1         ;or DATA line
dc04: 86 b8                    stx     TXTPTR
dc06: 84 b9                    sty     TXTPTR+1
dc08: 20 b7 00                 jsr     CHRGOT          ;get char at ptr
dc0b: d0 1e                    bne     INSTART         ;not end of line or colon
dc0d: 24 15                    bit     INPUTFLG        ;doing a GET?
dc0f: 50 0e                    bvc     LDC1F           ;no
dc11: 20 0c fd                 jsr     MON_RDKEY       ;yes, get char
dc14: 29 7f                    and     #$7f
dc16: 8d 00 02                 sta     INPUT_BUFFER
dc19: a2 ff                    ldx     #<INPUT_BUFFER+255
dc1b: a0 01                    ldy     #(>INPUT_BUFFER)-1
dc1d: d0 08                    bne     LDC27           ;...always

dc1f: 30 7f        LDC1F       bmi     FINDATA         ;doing a READ
dc21: 20 5a db                 jsr     OUTQUES         ;doing an INPUT, print "?"
dc24: 20 dc db                 jsr     NXIN            ;print another "?", and input a line
dc27: 86 b8        LDC27       stx     TXTPTR
dc29: 84 b9                    sty     TXTPTR+1
dc2b: 20 b1 00     INSTART     jsr     CHRGET          ;get next input char
dc2e: 24 11                    bit     VALTYP          ;string or numeric?
dc30: 10 31                    bpl     LDC63           ;numeric
dc32: 24 15                    bit     INPUTFLG        ;string -- now what input type?
dc34: 50 09                    bvc     LDC3F           ;not a GET
dc36: e8                       inx                     ;GET
dc37: 86 b8                    stx     TXTPTR
dc39: a9 00                    lda     #$00
dc3b: 85 0d                    sta     CHARAC          ;no other terminators than $00
dc3d: f0 0c                    beq     LDC4B           ;...always

dc3f: 85 0d        LDC3F       sta     CHARAC
dc41: c9 22                    cmp     #‘"’            ;terminate on $00 or quote
dc43: f0 07                    beq     LDC4C
dc45: a9 3a                    lda     #‘:’            ;terminate on $00, colon, or comma
dc47: 85 0d                    sta     CHARAC
dc49: a9 2c                    lda     #‘,’
dc4b: 18           LDC4B       clc
dc4c: 85 0e        LDC4C       sta     ENDCHR
dc4e: a5 b8                    lda     TXTPTR
dc50: a4 b9                    ldy     TXTPTR+1
dc52: 69 00                    adc     #$00            ;skip over quotation mark, if
dc54: 90 01                    bcc     LDC57           ;there was one
dc56: c8                       iny
dc57: 20 ed e3     LDC57       jsr     STRLT2          ;build string starting at (Y,A), term by $00, CHARAC, or ENDCHR
dc5a: 20 3d e7                 jsr     POINT           ;set TXTPTR to point at string
dc5d: 20 7b da                 jsr     PUTSTR          ;store string in variable
dc60: 4c 72 dc                 jmp     INPUT_MORE

dc63: 48           LDC63       pha
dc64: ad 00 02                 lda     INPUT_BUFFER    ;anything in buffer?
dc67: f0 30                    beq     INPFIN          ;no, see if READ or INPUT
dc69: 68           INPUT_DATA  pla                     ;READ
dc6a: 20 4a ec                 jsr     FIN             ;get fp number at TXTPTR
dc6d: a5 12                    lda     VALTYP+1
dc6f: 20 63 da                 jsr     LET2            ;store result in variable
dc72: 20 b7 00     INPUT_MORE  jsr     CHRGOT
dc75: f0 07                    beq     LDC7E           ;end of line or colon
dc77: c9 2c                    cmp     #‘,’            ;comma in input?
dc79: f0 03                    beq     LDC7E           ;yes
dc7b: 4c 71 db                 jmp     INPUTERR        ;nothing else will do

dc7e: a5 b8        LDC7E       lda     TXTPTR          ;save position in input buffer
dc80: a4 b9                    ldy     TXTPTR+1
dc82: 85 7f                    sta     INPTR
dc84: 84 80                    sty     INPTR+1
dc86: a5 87                    lda     TXPSV           ;restore program pointer
dc88: a4 88                    ldy     TXPSV+1
dc8a: 85 b8                    sta     TXTPTR
dc8c: 84 b9                    sty     TXTPTR+1
dc8e: 20 b7 00                 jsr     CHRGOT          ;next char from program
dc91: f0 33                    beq     INPDONE         ;end of statement
dc93: 20 be de                 jsr     CHKCOM          ;better be a comma then
dc96: 4c f1 db                 jmp     PROCESS_INPUT_ITEM

dc99: a5 15        INPFIN      lda     INPUTFLG        ;INPUT or READ
dc9b: d0 cc                    bne     INPUT_DATA      ;READ
dc9d: 4c 86 db                 jmp     INPERR

dca0: 20 a3 d9     FINDATA     jsr     DATAN           ;get offset to next colon or EOL
dca3: c8                       iny                     ;to first char of next line
dca4: aa                       tax                     ;which: EOL or colon?
dca5: d0 12                    bne     LDCB9           ;colon
dca7: a2 2a                    ldx     #ERR_NODATA     ;EOL: might be out of data
dca9: c8                       iny                     ;check hi-byte of forward ptr
dcaa: b1 b8                    lda     (TXTPTR),y      ;end of program?
dcac: f0 5f                    beq     GERR            ;yes, we are out of data
dcae: c8                       iny                     ;pick up the line #
dcaf: b1 b8                    lda     (TXTPTR),y
dcb1: 85 7b                    sta     DATLIN
dcb3: c8                       iny
dcb4: b1 b8                    lda     (TXTPTR),y
dcb6: c8                       iny                     ;point at first text char in line
dcb7: 85 7c                    sta     DATLIN+1
dcb9: b1 b8        LDCB9       lda     (TXTPTR),y      ;get 1st token of statement
dcbb: aa                       tax                     ;save token in X-reg
dcbc: 20 98 d9                 jsr     ADDON           ;add Y-reg to TXTPTR
dcbf: e0 83                    cpx     #TOK_DATA       ;did we find a DATA statement?
dcc1: d0 dd                    bne     FINDATA         ;not yet
dcc3: 4c 2b dc                 jmp     INSTART         ;yes, read it

dcc6: a5 7f        INPDONE     lda     INPTR           ;get pointer in case it was READ
dcc8: a4 80                    ldy     INPTR+1
dcca: a6 15                    ldx     INPUTFLG        ;READ or INPUT?
dccc: 10 03                    bpl     LDCD1           ;INPUT
dcce: 4c 53 d8                 jmp     SETDA           ;DATA, so store (Y,X) at DATPTR

dcd1: a0 00        LDCD1       ldy     #$00            ;INPUT: any more chars on line?
dcd3: b1 7f                    lda     (INPTR),y
dcd5: f0 07                    beq     LDCDE           ;no, all is well
dcd7: a9 df                    lda     #<ERR_EXTRA     ;yes, error
dcd9: a0 dc                    ldy     #>ERR_EXTRA     ;"EXTRA IGNORED"
dcdb: 4c 3a db                 jmp     STROUT

dcde: 60           LDCDE       rts

dcdf: 3f 45 58 54+ ERR_EXTRA   .zstr   ‘?EXTRA IGNORED’,$0d
dcef: 3f 52 45 45+ ERR_REENTRY .zstr   ‘?REENTER’,$0d

                   * NEXT statement                                                               *
dcf9: d0 04        NEXT        bne     NEXT_1          ;variable after NEXT
dcfb: a0 00                    ldy     #$00            ;flag by setting FORPNT+1 = 0
dcfd: f0 03                    beq     NEXT_2          ;...always

dcff: 20 e3 df     NEXT_1      jsr     PTRGET          ;get ptr to variable in (Y,A)
dd02: 85 85        NEXT_2      sta     FORPNT
dd04: 84 86                    sty     FORPNT+1
dd06: 20 65 d3                 jsr     GTFORPNT        ;find FOR-frame for this variable
dd09: f0 04                    beq     NEXT_3          ;found it
dd0b: a2 00                    ldx     #ERR_NOFOR      ;not there, abort
dd0d: f0 69        GERR        beq     JERROR          ;...always

dd0f: 9a           NEXT_3      txs
dd10: e8                       inx                     ;set stack ptr to point to this frame,
dd11: e8                       inx                     ; which trims off any inner loops
dd12: e8                       inx
dd13: e8                       inx
dd14: 8a                       txa                     ;low byte of adrs of step value
dd15: e8                       inx
dd16: e8                       inx
dd17: e8                       inx
dd18: e8                       inx
dd19: e8                       inx
dd1a: e8                       inx
dd1b: 86 60                    stx     DEST            ;low byte adrs of FOR var value
dd1d: a0 01                    ldy     #>STACK         ;(Y,A) is address of step value
dd1f: 20 f9 ea                 jsr     LOAD_FAC_FROM_YA ;step to FAC
dd22: ba                       tsx
dd23: bd 09 01                 lda     STACK+9,x
dd26: 85 a2                    sta     FAC_SIGN
dd28: a5 85                    lda     FORPNT
dd2a: a4 86                    ldy     FORPNT+1
dd2c: 20 be e7                 jsr     FADD            ;add to FOR value
dd2f: 20 27 eb                 jsr     SETFOR          ;put new value back
dd32: a0 01                    ldy     #>STACK         ;(Y,A) is address of end value
dd34: 20 b4 eb                 jsr     FCOMP2          ;compare to end value
dd37: ba                       tsx
dd38: 38                       sec
dd39: fd 09 01                 sbc     STACK+9,x       ;sign of step
dd3c: f0 17                    beq     LDD55           ;branch if FOR complete
dd3e: bd 0f 01                 lda     STACK+15,x      ;otherwise set up
dd41: 85 75                    sta     CURLIN          ;FOR line #
dd43: bd 10 01                 lda     STACK+16,x
dd46: 85 76                    sta     CURLIN+1
dd48: bd 12 01                 lda     STACK+18,x      ;and set TXTPTR to just
dd4b: 85 b8                    sta     TXTPTR          ; after FOR statement
dd4d: bd 11 01                 lda     STACK+17,x
dd50: 85 b9                    sta     TXTPTR+1
dd52: 4c d2 d7     LDD52       jmp     NEWSTT

dd55: 8a           LDD55       txa                     ;pop off FOR-frame, loop is done
dd56: 69 11                    adc     #17             ;carry is set, so adds 18
dd58: aa                       tax
dd59: 9a                       txs
dd5a: 20 b7 00                 jsr     CHRGOT          ;char after variable
dd5d: c9 2c                    cmp     #‘,’            ;another variable in NEXT?
dd5f: d0 f1                    bne     LDD52           ;no, go to next statement
dd61: 20 b1 00                 jsr     CHRGET          ;yes, prime for next variable
dd64: 20 ff dc                 jsr     NEXT_1          ;(does not return)
                   ; Evaluate expression, make sure it is numeric
dd67: 20 7b dd     FRMNUM      jsr     FRMEVL
                   ; Make sure FAC is numeric
dd6a: 18           CHKNUM      clc
dd6b: 24                       bit ▼   MON_KSWL        ;dummy for skip
                   ; Make sure FAC is string
dd6c: 38           CHKSTR      sec
                   ; Make sure FAC is correct type.
                   ;   if C=0, type must be numeric
                   ;   if C=1, type must be string
dd6d: 24 11        CHKVAL      bit     VALTYP          ;$00 if numeric, $FF if string
dd6f: 30 03                    bmi     LDD74           ;type is string
dd71: b0 03                    bcs     LDD76           ;not string, but we need string
dd73: 60           LDD73       rts                     ;type is correct

dd74: b0 fd        LDD74       bcs     LDD73           ;is string and we wanted string
dd76: a2 a3        LDD76       ldx     #ERR_BADTYPE    ;type mismatch
dd78: 4c 12 d4     JERROR      jmp     ERROR

                   ; Evaluate the expression at TXTPTR, leaving the result in FAC.  Works for both
                   ; string and numeric expressions.
dd7b: a6 b8        FRMEVL      ldx     TXTPTR          ;decrement TXTPTR
dd7d: d0 02                    bne     LDD81
dd7f: c6 b9                    dec     TXTPTR+1
dd81: c6 b8        LDD81       dec     TXTPTR
dd83: a2 00                    ldx     #$00            ;start with precedence = 0
dd85: 24                       bit ▼   $48             ;track to skip following PHA
dd86: 48           FRMEVL_1    pha                     ;push relops flags
dd87: 8a                       txa
dd88: 48                       pha                     ;save last precedence
dd89: a9 01                    lda     #$01
dd8b: 20 d6 d3                 jsr     CHKMEM          ;check if enough room on stack
dd8e: 20 60 de                 jsr     FRM_ELEMENT     ;get an element
dd91: a9 00                    lda     #$00
dd93: 85 89                    sta     CPRTYP          ;clear comparison operator flags
dd95: 20 b7 00     FRMEVL_2    jsr     CHRGOT          ;check for relational operators
dd98: 38           LDD98       sec                     ;> is $CF, = is $D0, < is $D1
dd99: e9 cf                    sbc     #TOK_GREATER    ;> is 0, = is 1, < is 2
dd9b: 90 17                    bcc     LDDB4           ;not relational operator
dd9d: c9 03                    cmp     #3
dd9f: b0 13                    bcs     LDDB4           ;not relational operator
dda1: c9 01                    cmp     #1              ;set carry if "=" or "<"
dda3: 2a                       rol     A               ;now > is 0, = is 3, < is 5
dda4: 49 01                    eor     #$01            ;now > is 1, = is 2, < is 4
dda6: 45 89                    eor     CPRTYP          ;set bits of CPRTYP:  00000<=>
dda8: c5 89                    cmp     CPRTYP          ;check for illegal combinations
ddaa: 90 61                    bcc     SNTXERR         ;if less than, a relop was repeated
ddac: 85 89                    sta     CPRTYP
ddae: 20 b1 00                 jsr     CHRGET          ;another operator?
ddb1: 4c 98 dd                 jmp     LDD98           ;check for <,=,> again

ddb4: a6 89        LDDB4       ldx     CPRTYP          ;did we find a relational operator?
ddb6: d0 2c                    bne     FRM_RELATIONAL  ;yes
ddb8: b0 7b                    bcs     NOTMATH         ;no, and next token is > $D1
ddba: 69 07                    adc     #TOK_PLUS-193   ;(should be #$CF-TOK_PLUS) no, and next token < $CF
ddbc: 90 77                    bcc     NOTMATH         ;if next token < "+"
ddbe: 65 11                    adc     VALTYP          ;+ and last result a string?
ddc0: d0 03                    bne     LDDC5           ;branch if not
ddc2: 4c 97 e5                 jmp     CAT             ;concatenate if so

ddc5: 69 ff        LDDC5       adc     #$ff            ;+-*/ is 0123
ddc7: 85 5e                    sta     INDEX
ddc9: 0a                       asl     A               ;multiply by 3
ddca: 65 5e                    adc     INDEX           ;+-*/ is 0,3,6,9
ddcc: a8                       tay
                   • Clear variables
                   LASTOP      .var    $87    {addr/1} ;Overlaps with TXPSV
                   SGNCPR      .var    $ab    {addr/1} ;Overlaps with STRNG1

ddcd: 68                       pla                     ;get last precedence
ddce: d9 b2 d0                 cmp     MATHTBL,y
ddd1: b0 67                    bcs     FRM_PERFORM_1   ;do now if higher precedence
ddd3: 20 6a dd                 jsr     CHKNUM          ;was last result a #?
ddd6: 48           NXOP        pha                     ;yes, save precedence on stack
ddd7: 20 fd dd     SAVOP       jsr     FRM_RECURSE     ;save rest, call FRMEVL recursively
ddda: 68                       pla
dddb: a4 87                    ldy     LASTOP
dddd: 10 17                    bpl     PREFNC
dddf: aa                       tax
dde0: f0 56                    beq     GOEX            ;exit if no math in expression
dde2: d0 5f                    bne     FRM_PERFORM_2   ;...always

                   ; Found one or more relational operators <,=,>
dde4: 46 11                    lsr     VALTYP          ;VALTYP = 0 (numeric), = $FF (string)
dde6: 8a                       txa                     ;set CPRTYP to 0000<=>C
dde7: 2a                       rol     A               ;where C=0 if #, C=1 if string
dde8: a6 b8                    ldx     TXTPTR          ;back up TXTPTR
ddea: d0 02                    bne     LDDEE
ddec: c6 b9                    dec     TXTPTR+1
ddee: c6 b8        LDDEE       dec     TXTPTR
ddf0: a0 1b                    ldy     #<M_REL-178     ;(should be M_REL - MATHTBL)  point at relops entry
ddf2: 85 89                    sta     CPRTYP
ddf4: d0 d7                    bne     FRM_PRECEDENCE_TEST ;...always

ddf6: d9 b2 d0     PREFNC      cmp     MATHTBL,y
ddf9: b0 48                    bcs     FRM_PERFORM_2   ;do now if higher precedence
ddfb: 90 d9                    bcc     NXOP            ;...always

                   ; Stack this operation and call FRMEVL for another one
ddfd: b9 b4 d0     FRM_RECURSE lda     MATHTBL+2,y
de00: 48                       pha                     ;push address of operation performer
de01: b9 b3 d0                 lda     MATHTBL+1,y
de04: 48                       pha
de05: 20 10 de                 jsr     FRM_STACK_1     ;stack FAC_SIGN and FAC
de08: a5 89                    lda     CPRTYP          ;A=relop flags, X=precedence byte
de0a: 4c 86 dd                 jmp     FRMEVL_1        ;recursively call FRMEVL

de0d: 4c c9 de     SNTXERR     jmp     SYNERR

                   ; Stack (FAC)
                   ; Three entry points:
                   ;   _1, from FRMEVL
                   ;   _2, from STEP
                   ;   _3, from FOR
de10: a5 a2        FRM_STACK_1 lda     FAC_SIGN        ;get FAC_SIGN and push it
de12: be b2 d0                 ldx     MATHTBL,y       ;precedence byte from MATHTBL
                   ; Enter here from STEP, to push step sign and value
de15: a8           FRM_STACK_2 tay                     ;FAC_SIGN or SGN(step value)
de16: 68                       pla                     ;pull return address and add 1
de17: 85 5e                    sta     INDEX           ;<<< assumes not on page boundary! >>>
de19: e6 5e                    inc     INDEX           ;place bumped return address in
de1b: 68                       pla                     ; INDEX,INDEX+1
de1c: 85 5f                    sta     INDEX+1
de1e: 98                       tya                     ;FAC_SIGN or SGN(step value)
de1f: 48                       pha                     ;push FAC_SIGN or SGN(step value)
                   ; Enter here from FOR, with INDEX = step, to push initial value of FOR variable
de20: 20 72 eb     FRM_STACK_3 jsr     ROUND_FAC       ;round to 32 bits
de23: a5 a1                    lda     FAC+4           ;push FAC
de25: 48                       pha
de26: a5 a0                    lda     FAC+3
de28: 48                       pha
de29: a5 9f                    lda     FAC+2
de2b: 48                       pha
de2c: a5 9e                    lda     FAC+1
de2e: 48                       pha
de2f: a5 9d                    lda     FAC
de31: 48                       pha
de32: 6c 5e 00                 jmp     (INDEX)         ;do RTS funny way

de35: a0 ff        NOTMATH     ldy     #$ff            ;set up to exit routine
de37: 68                       pla
de38: f0 23        GOEX        beq     EXIT            ;exit if no math to do
                   ; Perform stacked operation.
                   ;   A-reg = precedence byte
                   ;   Stack: 1 - CPRMASK
                   ;          5 - ARG
                   ;          2 - addr of performer
de3a: c9 64                    cmp     #P_REL          ;was it relational operator?
de3c: f0 03                    beq     LDE41           ;yes, allow string compare
de3e: 20 6a dd                 jsr     CHKNUM          ;must be numeric value
de41: 84 87        LDE41       sty     LASTOP
de43: 68                       pla                     ;get 0000<=>C from stack
de44: 4a                       lsr     A               ;shift to 00000<=> form
de45: 85 16                    sta     CPRMASK         ;00000<=>
de47: 68                       pla
de48: 85 a5                    sta     ARG             ;get floating point value off stack,
de4a: 68                       pla                     ; and put it in ARG
de4b: 85 a6                    sta     ARG+1
de4d: 68                       pla
de4e: 85 a7                    sta     ARG+2
de50: 68                       pla
de51: 85 a8                    sta     ARG+3
de53: 68                       pla
de54: 85 a9                    sta     ARG+4
de56: 68                       pla
de57: 85 aa                    sta     ARG+5
de59: 45 a2                    eor     FAC_SIGN        ;save EOR of signs of the operands,
de5b: 85 ab                    sta     SGNCPR          ; in case of multiply or divide
de5d: a5 9d        EXIT        lda     FAC             ;FAC exponent in A-reg
de5f: 60                       rts                     ;status .EQ. if FAC=0; RTS goes to perform operation

                   ; Get element in expression
                   ; Get value of variable or number at TXTPNT, or point to string descriptor if a
                   ; string, and put in FAC.
de60: a9 00        FRM_ELEMENT lda     #$00            ;assume numeric
de62: 85 11                    sta     VALTYP
de64: 20 b1 00     LDE64       jsr     CHRGET
de67: b0 03                    bcs     LDE6C           ;not a digit
de69: 4c 4a ec     LDE69       jmp     FIN             ;numeric constant

de6c: 20 7d e0     LDE6C       jsr     ISLETC          ;variable name?
de6f: b0 64                    bcs     FRM_VARIABLE    ;yes
de71: c9 2e                    cmp     #‘.’            ;decimal point
de73: f0 f4                    beq     LDE69           ;yes, numeric constant
de75: c9 c9                    cmp     #TOK_MINUS      ;unary minus?
de77: f0 55                    beq     MIN             ;yes
de79: c9 c8                    cmp     #TOK_PLUS       ;unary plus
de7b: f0 e7                    beq     LDE64           ;yes
de7d: c9 22                    cmp     #‘"’            ;string constant?
de7f: d0 0f                    bne     NOT_            ;no
                   ; String constant element
                   ;   Set (Y,A) = TXTPTR + carry
de81: a5 b8        STRTXT      lda     TXTPTR          ;add carry to get address of 1st char
de83: a4 b9                    ldy     TXTPTR+1
de85: 69 00                    adc     #$00
de87: 90 01                    bcc     LDE8A
de89: c8                       iny
de8a: 20 e7 e3     LDE8A       jsr     STRLIT          ;build descriptor to string; get address of descriptor in FAC
de8d: 4c 3d e7                 jmp     POINT           ;point TXTPTR after trailing quote

                   ; NOT function
                   ;   if FAC=0, return FAC=1
                   ;   if FAC<>0, return FAC=0
de90: c9 c6        NOT_        cmp     #TOK_NOT
de92: d0 10                    bne     FN_             ;not NOT, try FN
de94: a0 18                    ldy     #<M_EQU-178     ;(should be M_EQU - MATHTBL)  point at = comparison
de96: d0 38                    bne     EQUL            ;...always

                   ; Comparison for equality (= operator).  Also used to evaluate NOT function.
de98: a5 9d        EQUOP       lda     FAC             ;set TRUE if FAC = zero
de9a: d0 03                    bne     LDE9F           ;false
de9c: a0 01                    ldy     #$01            ;true
de9e: 2c                       bit ▼   a:$00a0         ;trick to skip next 2 bytes
de9f: a0 00        LDE9F       ldy     #$00            ;false
dea1: 4c 01 e3                 jmp     SNGFLT

dea4: c9 c2        FN_         cmp     #TOK_FN
dea6: d0 03                    bne     SGN_
dea8: 4c 54 e3                 jmp     FUNCT

deab: c9 d2        SGN_        cmp     #TOK_SGN
dead: 90 03                    bcc     PARCHK
deaf: 4c 0c df                 jmp     UNARY

                   ; Evaluate "(expression)"
deb2: 20 bb de     PARCHK      jsr     CHKOPN          ;is there a '(' at TXTPTR?
deb5: 20 7b dd                 jsr     FRMEVL          ;yes, evaluate expression
deb8: a9 29        CHKCLS      lda     #‘)’            ;check for ')'
deba: 2c                       bit ▼   $28a9           ;trick
debb: a9 28        CHKOPN      lda     #‘(’
debd: 2c                       bit ▼   $2ca9           ;trick
debe: a9 2c        CHKCOM      lda     #‘,’            ;comma at TXTPTR?
                   ; Unless char at TXTPTR = A-reg, syntax error
dec0: a0 00        SYNCHR      ldy     #$00
dec2: d1 b8                    cmp     (TXTPTR),y
dec4: d0 03                    bne     SYNERR
dec6: 4c b1 00                 jmp     CHRGET          ;match, get next char & return

dec9: a2 10        SYNERR      ldx     #ERR_SYNTAX
decb: 4c 12 d4                 jmp     ERROR

dece: a0 15        MIN         ldy     #<M_NEG-178     ;(should be M_NEG - MATHTBL)  point at unary minus
ded0: 68           EQUL        pla
ded1: 68                       pla
ded2: 4c d7 dd                 jmp     SAVOP

                   VPNT        .var    $a0    {addr/2} ;Overlaps with FAC+3

ded5: 20 e3 df                 jsr     PTRGET          ;so PTRGET can tell we called
ded8: 85 a0                    sta     VPNT            ;address of variable
deda: 84 a1                    sty     VPNT+1
dedc: a6 11                    ldx     VALTYP          ;numeric or string?
dede: f0 05                    beq     LDEE5           ;numeric
dee0: a2 00                    ldx     #$00            ;string
dee2: 86 ac                    stx     STRNG1+1
dee4: 60                       rts

dee5: a6 12        LDEE5       ldx     VALTYP+1        ;numeric, which type?
dee7: 10 0d                    bpl     LDEF6           ;floating point
dee9: a0 00                    ldy     #$00            ;integer
deeb: b1 a0                    lda     (VPNT),y
deed: aa                       tax                     ;get value in (A,Y)
deee: c8                       iny
deef: b1 a0                    lda     (VPNT),y
def1: a8                       tay
def2: 8a                       txa
def3: 4c f2 e2                 jmp     GIVAYF          ;convert (A,Y) to floating point

def6: 4c f9 ea     LDEF6       jmp     LOAD_FAC_FROM_YA

def9: 20 b1 00     SCREEN      jsr     CHRGET
defc: 20 ec f1                 jsr     PLOTFNS         ;get column and row
deff: 8a                       txa                     ;row
df00: a4 f0                    ldy     FIRST           ;column
df02: 20 71 f8                 jsr     MON_SCRN        ;get 4-bit color there
df05: a8                       tay
df06: 20 01 e3                 jsr     SNGFLT          ;convert Y-reg to real in FAC
df09: 4c b8 de                 jmp     CHKCLS          ;require ")"

df0c: c9 d7        UNARY       cmp     #TOK_SCRN       ;not unary, do special
df0e: f0 e9                    beq     SCREEN
df10: 0a                       asl     A               ;double token to get index
df11: 48                       pha
df12: aa                       tax
df13: 20 b1 00                 jsr     CHRGET
df16: e0 cf                    cpx     #$cf            ;(should be TOK_LEFT*2-1)  LEFT$, RIGHT$, and MID$
df18: 90 20                    bcc     LDF3A           ;not one of the string functions
df1a: 20 bb de                 jsr     CHKOPN          ;string function, need "("
df1d: 20 7b dd                 jsr     FRMEVL          ;evaluate expression for string
df20: 20 be de                 jsr     CHKCOM          ;require a comma
df23: 20 6c dd                 jsr     CHKSTR          ;make sure expression is a string
df26: 68                       pla
df27: aa                       tax                     ;retrieve routine pointer
df28: a5 a1                    lda     VPNT+1          ;stack address of string
df2a: 48                       pha
df2b: a5 a0                    lda     VPNT
df2d: 48                       pha
df2e: 8a                       txa
df2f: 48                       pha                     ;stack doubled token
df30: 20 f8 e6                 jsr     GETBYT          ;convert next expression to byte in X-reg
df33: 68                       pla                     ;get doubled token off stack
df34: a8                       tay                     ;use as index to branch
df35: 8a                       txa                     ;value of second parameter
df36: 48                       pha                     ;push 2nd param
df37: 4c 3f df                 jmp     LDF3F           ;join unary functions

df3a: 20 b2 de     LDF3A       jsr     PARCHK          ;require "(expression)"
df3d: 68                       pla
df3e: a8                       tay                     ;index into function address table
df3f: b9 dc cf     LDF3F       lda     $cfdc,y         ;(should be UNFNC - TOK_SGN - TOK_SGN + $100)
df42: 85 91                    sta     JMPADRS+1
df44: b9 dd cf                 lda     $cfdd,y         ;(should be UNFNC - TOK_SGN - TOK_SGN + $101)
df47: 85 92                    sta     JMPADRS+2
df49: 20 90 00                 jsr     JMPADRS         ;does not return for CHR$, LEFT$, RIGHT$, or MID$
df4c: 4c 6a dd                 jmp     CHKNUM          ;require numeric result

df4f: a5 a5        OR          lda     ARG             ;OR operator
df51: 05 9d                    ora     FAC             ;if result nonzero, it is true
df53: d0 0b                    bne     TRUE
df55: a5 a5        AND         lda     ARG             ;AND operator
df57: f0 04                    beq     FALSE           ;if either is zero, result is false
df59: a5 9d                    lda     FAC
df5b: d0 03                    bne     TRUE
df5d: a0 00        FALSE       ldy     #$00            ;return FAC=0
df5f: 2c                       bit ▼   $01a0           ;trick
df60: a0 01        TRUE        ldy     #$01            ;return FAC=1
df62: 4c 01 e3                 jmp     SNGFLT

                   ; Perform relational operations
df65: 20 6d dd     RELOPS      jsr     CHKVAL          ;make sure FAC is correct type
df68: b0 13                    bcs     STRCMP          ;type matches, branch if strings
df6a: a5 aa                    lda     ARG_SIGN        ;numeric comparison
df6c: 09 7f                    ora     #$7f            ;re-pack value in ARG for FCOMP
df6e: 25 a6                    and     ARG+1
df70: 85 a6                    sta     ARG+1
df72: a9 a5                    lda     #ARG
df74: a0 00                    ldy     #>ARG
df76: 20 b2 eb                 jsr     FCOMP           ;return A-reg = -1,0,1
df79: aa                       tax                     ; as ARG <,=,> FAC
df7a: 4c b0 df                 jmp     NUMCMP

                   ; String comparison
df7d: a9 00        STRCMP      lda     #$00            ;set result type to numeric
df7f: 85 11                    sta     VALTYP
df81: c6 89                    dec     CPRTYP          ;make CPRTYP 0000<=>0
df83: 20 00 e6                 jsr     FREFAC
df86: 85 9d                    sta     FAC             ;string length
df88: 86 9e                    stx     FAC+1
df8a: 84 9f                    sty     FAC+2
df8c: a5 a8                    lda     ARG+3
df8e: a4 a9                    ldy     ARG+4
df90: 20 04 e6                 jsr     FRETMP
df93: 86 a8                    stx     ARG+3
df95: 84 a9                    sty     ARG+4
df97: aa                       tax                     ;len ARG string
df98: 38                       sec
df99: e5 9d                    sbc     FAC             ;set X-reg to smaller len
df9b: f0 08                    beq     LDFA5
df9d: a9 01                    lda     #$01
df9f: 90 04                    bcc     LDFA5
dfa1: a6 9d                    ldx     FAC
dfa3: a9 ff                    lda     #$ff
dfa5: 85 a2        LDFA5       sta     FAC_SIGN        ;flag which shorter
dfa7: a0 ff                    ldy     #$ff
dfa9: e8                       inx
dfaa: c8           STRCMP_1    iny
dfab: ca                       dex
dfac: d0 07                    bne     STRCMP_2        ;more chars in both strings
dfae: a6 a2                    ldx     FAC_SIGN        ;if = so far, decide by length
dfb0: 30 0f        NUMCMP      bmi     CMPDONE
dfb2: 18                       clc
dfb3: 90 0c                    bcc     CMPDONE         ;...always

dfb5: b1 a8        STRCMP_2    lda     (ARG+3),y
dfb7: d1 9e                    cmp     (FAC+1),y
dfb9: f0 ef                    beq     STRCMP_1        ;same, keep comparing
dfbb: a2 ff                    ldx     #$ff            ;in case ARG greater
dfbd: b0 02                    bcs     CMPDONE         ;it is
dfbf: a2 01                    ldx     #$01            ;FAC greater
dfc1: e8           CMPDONE     inx                     ;convert FF,0,1 to 0,1,2
dfc2: 8a                       txa
dfc3: 2a                       rol     A               ;and to 0,2,4 if C=0, else 1,2,5
dfc4: 25 16                    and     CPRMASK         ;00000<=>
dfc6: f0 02                    beq     LDFCA           ;if no match: false
dfc8: a9 01                    lda     #$01            ;at least one match: true
dfca: 4c 93 eb     LDFCA       jmp     FLOAT

                   * PDL statement                                                                *
                   *                                                                              *
                   * <<< note: arg < 4 is not checked >>                                          *
dfcd: 20 fb e6     PDL         jsr     CONINT          ;get # in X-reg
dfd0: 20 1e fb                 jsr     MON_PREAD       ;read paddle
dfd3: 4c 01 e3                 jmp     SNGFLT          ;float result

                   * DIM statement                                                                *
dfd6: 20 be de     NXDIM       jsr     CHKCOM          ;separated by commas
dfd9: aa           DIM         tax                     ;non-zero, flags PTRGET DIM called
dfda: 20 e8 df                 jsr     PTRGET2         ;allocate the array
dfdd: 20 b7 00                 jsr     CHRGOT          ;next char
dfe0: d0 f4                    bne     NXDIM           ;not end of statement
dfe2: 60                       rts

                   ; PTRGET - general variable scan
                   ; Scans variable name at TXTPTR, and searches the VARTAB and ARYTAB for the
                   ; name.  If not found, create variable of appropriate type.  Return with address
                   ; in VARPNT and (Y,A).
                   ; Actual activity controlled somewhat by two flags:
                   ;   DIMFLG - nonzero if called from DIM
                   ;            else = 0
                   ;   SUBFLG - = $00
                   ;            = $40 if called from GETARYPT
                   ;            = $80 if called from DEF FN
                   ;            = $C1-DA if called from FN
dfe3: a2 00        PTRGET      ldx     #$00
dfe5: 20 b7 00                 jsr     CHRGOT          ;get first char of variable name
dfe8: 86 10        PTRGET2     stx     DIMFLG          ;x is nonzero if from DIM
dfea: 85 81        PTRGET3     sta     VARNAM
dfec: 20 b7 00                 jsr     CHRGOT
dfef: 20 7d e0                 jsr     ISLETC          ;is it a letter?
dff2: b0 03                    bcs     NAMOK           ;yes, okay so far
dff4: 4c c9 de     BADNAM      jmp     SYNERR          ;no, syntax error

dff7: a2 00        NAMOK       ldx     #$00
dff9: 86 11                    stx     VALTYP
dffb: 86 12                    stx     VALTYP+1
dffd: 4c 07 e0                 jmp     PTRGET4         ;to branch across $e000 vectors

                   * DOS and monitor call BASIC at $E000 and $E003                                *
e000: 4c 28 f1                 jmp     COLD_START

e003: 4c 3c d4                 jmp     RESTART

e006: 00                       .dd1    $00             ;wasted byte

e007: 20 b1 00     PTRGET4     jsr     CHRGET          ;second char of variable name
e00a: 90 05                    bcc     LE011           ;numeric
e00c: 20 7d e0                 jsr     ISLETC          ;letter?
e00f: 90 0b                    bcc     LE01C           ;no, end of name
e011: aa           LE011       tax                     ;save second char of name in X-reg
e012: 20 b1 00     LE012       jsr     CHRGET          ;scan to end of variable name
e015: 90 fb                    bcc     LE012           ;numeric
e017: 20 7d e0                 jsr     ISLETC
e01a: b0 f6                    bcs     LE012           ;alpha
e01c: c9 24        LE01C       cmp     #‘$’            ;string?
e01e: d0 06                    bne     LE026           ;no
e020: a9 ff                    lda     #$ff
e022: 85 11                    sta     VALTYP
e024: d0 10                    bne     LE036           ;...always

e026: c9 25        LE026       cmp     #‘%’            ;integer?
e028: d0 13                    bne     LE03D           ;no
e02a: a5 14                    lda     SUBFLG          ;yes; integer variable allowed?
e02c: 30 c6                    bmi     BADNAM          ;no, syntax error
e02e: a9 80                    lda     #$80            ;yes
e030: 85 12                    sta     VALTYP+1        ;flag integer mode
e032: 05 81                    ora     VARNAM
e034: 85 81                    sta     VARNAM          ;set sign bit on varname
e036: 8a           LE036       txa                     ;second char of name
e037: 09 80                    ora     #$80            ;set sign
e039: aa                       tax
e03a: 20 b1 00                 jsr     CHRGET          ;get terminating char
e03d: 86 82        LE03D       stx     VARNAM+1        ;store second char of name
e03f: 38                       sec
e040: 05 14                    ora     SUBFLG          ;$00 or $40 if subscripts ok, else $80
e042: e9 28                    sbc     #‘(’            ;if subflg=$00 and char='('...
e044: d0 03                    bne     LE049           ;nope
e046: 4c 1e e1     LE046       jmp     ARRAY           ;yes

e049: 24 14        LE049       bit     SUBFLG          ;check top two bits of SUBFLG
e04b: 30 02                    bmi     LE04F           ;$80
e04d: 70 f7                    bvs     LE046           ;$40, called from GETARYPT
e04f: a9 00        LE04F       lda     #$00            ;clear SUBFLG
e051: 85 14                    sta     SUBFLG
e053: a5 69                    lda     VARTAB          ;start LOWTR at simple variable table
e055: a6 6a                    ldx     VARTAB+1
e057: a0 00                    ldy     #$00
e059: 86 9c        LE059       stx     LOWTR+1
e05b: 85 9b        LE05B       sta     LOWTR
e05d: e4 6c                    cpx     ARYTAB+1        ;end of simple variables?
e05f: d0 04                    bne     LE065           ;no, go on
e061: c5 6b                    cmp     ARYTAB          ;yes; end of arrays?
e063: f0 22                    beq     NAME_NOT_FOUND  ;yes, make one
e065: a5 81        LE065       lda     VARNAM          ;same first letter?
e067: d1 9b                    cmp     (LOWTR),y
e069: d0 08                    bne     LE073           ;not same first letter
e06b: a5 82                    lda     VARNAM+1        ;same second letter?
e06d: c8                       iny
e06e: d1 9b                    cmp     (LOWTR),y
e070: f0 6c                    beq     SET_VARPNT_AND_YA ;yes, same variable name
e072: 88                       dey                     ;no, bump to next name
e073: 18           LE073       clc
e074: a5 9b                    lda     LOWTR
e076: 69 07                    adc     #$07
e078: 90 e1                    bcc     LE05B
e07a: e8                       inx
e07b: d0 dc                    bne     LE059           ;...always

                   ; Check if A-reg is ASCII letter A-Z
                   ; Return carry = 1 if A-Z
                   ;              = 0 if not
                   ; <<< NOTE: faster and shorter code: >>>
                   ;    cmp #'Z'+1  ;compare hi end
                   ;    bcs .1      ;above A-Z
                   ;    cmp #'A'    ;compare lo end
                   ;    rts         ;C=0 if lo, C=1 if A-Z
                   ; .1 clc        ;C=0 if hi
                   ;    rts
e07d: c9 41        ISLETC      cmp     #‘A’            ;compare lo end
e07f: 90 05                    bcc     LE086           ;C=0 if low
e081: e9 5b                    sbc     #‘[’            ;(should be #'Z'+1)  prepare hi end test
e083: 38                       sec                     ;test hi end, restoring A-reg
e084: e9 a5                    sbc     #$a5            ;(should be #-1-'Z')  C=0 if lo, C=1 if A-Z
e086: 60           LE086       rts

                   ; Variable not found, so make one
e087: 68                       pla                     ;look at return address on stack to
e088: 48                       pha                     ; see if called from FRM_VARIABLE
e089: c9 d7                    cmp     #<FRM_VARIABLE+2
e08b: d0 0f                    bne     MAKE_NEW_VARIABLE ;no
e08d: ba                       tsx
e08e: bd 02 01                 lda     STACK+2,x
e091: c9 de                    cmp     #>FRM_VARIABLE
e093: d0 07                    bne     MAKE_NEW_VARIABLE ;no
e095: a9 9a                    lda     #<C_ZERO        ;yes, called from FRM_VARIABLE
e097: a0 e0                    ldy     #>C_ZERO        ;point to a constant zero
e099: 60                       rts                     ;new variable used in expression = 0

e09a: 00 00        C_ZERO      .dd2    $0000           ;integer or real zero, or null string

                   ; Make a new simple variable
                   ; Move arrays up 7 bytes to make room for new variable.  Enter 7-byte variable
                   ; data in the hole.
                   • Clear variables
                   NUMDIM      .var    $0f    {addr/1}
                   ARYPNT      .var    $94    {addr/2}
                   INDX        .var    $99    {addr/1}

e09c: a5 6b                    lda     ARYTAB          ;set up call to BLTU to
e09e: a4 6c                    ldy     ARYTAB+1        ; move from ARYTAB through STREND-1
e0a0: 85 9b                    sta     LOWTR           ; 7 bytes higher
e0a2: 84 9c        LE0A2       sty     LOWTR+1
e0a4: a5 6d                    lda     STREND
e0a6: a4 6e                    ldy     STREND+1
e0a8: 85 96                    sta     HIGHTR
e0aa: 84 97                    sty     HIGHTR+1
e0ac: 18                       clc
e0ad: 69 07                    adc     #7
e0af: 90 01                    bcc     LE0B2
e0b1: c8                       iny
e0b2: 85 94        LE0B2       sta     ARYPNT
e0b4: 84 95                    sty     ARYPNT+1
e0b6: 20 93 d3                 jsr     BLTU            ;move array block up
e0b9: a5 94                    lda     ARYPNT          ;store new start of arrays
e0bb: a4 95                    ldy     ARYPNT+1
e0bd: c8                       iny
e0be: 85 6b                    sta     ARYTAB
e0c0: 84 6c                    sty     ARYTAB+1
e0c2: a0 00                    ldy     #$00
e0c4: a5 81                    lda     VARNAM          ;first char of name
e0c6: 91 9b                    sta     (LOWTR),y
e0c8: c8                       iny
e0c9: a5 82                    lda     VARNAM+1        ;second char of name
e0cb: 91 9b                    sta     (LOWTR),y
e0cd: a9 00                    lda     #$00            ;set five-byte value to 0
e0cf: c8                       iny
e0d0: 91 9b                    sta     (LOWTR),y
e0d2: c8                       iny
e0d3: 91 9b                    sta     (LOWTR),y
e0d5: c8                       iny
e0d6: 91 9b                    sta     (LOWTR),y
e0d8: c8                       iny
e0d9: 91 9b                    sta     (LOWTR),y
e0db: c8                       iny
e0dc: 91 9b                    sta     (LOWTR),y
                   ; Put address of value of variable in VARPNT and (Y,A)
e0de: a5 9b                    lda     LOWTR           ;LOWTR points at name of variable
e0e0: 18                       clc                     ;so add 2 to get to value
e0e1: 69 02                    adc     #$02
e0e3: a4 9c                    ldy     LOWTR+1
e0e5: 90 01                    bcc     LE0E8
e0e7: c8                       iny
e0e8: 85 83        LE0E8       sta     VARPNT          ;address in VARPNT and (Y,A)
e0ea: 84 84                    sty     VARPNT+1
e0ec: 60                       rts

                   ; Compute address of first value in array
                   ; ARYPNT = LOWTR + #dims*2 + 5
e0ed: a5 0f        GETARY      lda     NUMDIM          ;get # of dimensions
e0ef: 0a           GETARY2     asl     A               ;#dims*2 (size of each dim in 2 bytes)
e0f0: 69 05                    adc     #5              ;+ 5 (2 for name, 2 for offset to next array, 1 for #dims)
e0f2: 65 9b                    adc     LOWTR           ;address of this array in ARYTAB
e0f4: a4 9c                    ldy     LOWTR+1
e0f6: 90 01                    bcc     LE0F9
e0f8: c8                       iny
e0f9: 85 94        LE0F9       sta     ARYPNT          ;address of first value in array
e0fb: 84 95                    sty     ARYPNT+1
e0fd: 60                       rts

                   ; <<< meant to be -32768, which would be 9080000000 >>>
                   ; <<< 1 byte short, so picks up $20 from next instruction >>>
e0fe: 90 80 00 00  NEG32768    .bulk   90800000        ;-32768.00049 in floating point

                   ; Evaluate numeric formula at TXTPTR, converting result to integer 0 <= X <=
                   ; 32767 in FAC+3,4
e102: 20 b1 00     MAKINT      jsr     CHRGET
e105: 20 67 dd                 jsr     FRMNUM
                   ; Convert FAC to integer.  Must be positive and less than 32768.
e108: a5 a2        MKINT       lda     FAC_SIGN        ;error if -
e10a: 30 0d                    bmi     MI1
                   ; Convert FAC to integer.  Must be -32767 <= FAC <= 32767.
e10c: a5 9d        AYINT       lda     FAC             ;exponent of value in FAC
e10e: c9 90                    cmp     #$90            ;abs(value) < 32768?
e110: 90 09                    bcc     MI2             ;yes, okay for integer
e112: a9 fe                    lda     #<NEG32768      ;no; next few lines are supposed
e114: a0 e0                    ldy     #>NEG32768      ;to allow -32768 ($8000), but do not!
e116: 20 b2 eb                 jsr     FCOMP           ;because compared to -32768.00049
                   ; <<< BUG: A=-32768.00049:A%=A is accepted, but PRINT A,A% shows that A=-
                   ; 32768.0005 (ok), A%=32767 (wrong!) >>>
e119: d0 7e        MI1         bne     IQERR           ;illegal quantity
e11b: 4c f2 eb     MI2         jmp     QINT            ;convert to integer

                   ; Locate array element or create an array
e11e: a5 14        ARRAY       lda     SUBFLG          ;subscripts given?
e120: d0 47                    bne     LE169           ;no
                   ; Parse the subscript list
e122: a5 10                    lda     DIMFLG          ;yes
e124: 05 12                    ora     VALTYP+1        ;set high bit if %
e126: 48                       pha                     ;save VALTYP and DIMFLG on stack
e127: a5 11                    lda     VALTYP
e129: 48                       pha
e12a: a0 00                    ldy     #$00            ;count # dimensions in Y-reg
e12c: 98           LE12C       tya                     ;save #dims on stack
e12d: 48                       pha
e12e: a5 82                    lda     VARNAM+1        ;save variable name on stack
e130: 48                       pha
e131: a5 81                    lda     VARNAM
e133: 48                       pha
e134: 20 02 e1                 jsr     MAKINT          ;evaluate subscript as integer
e137: 68                       pla                     ;restore variable name
e138: 85 81                    sta     VARNAM
e13a: 68                       pla
e13b: 85 82                    sta     VARNAM+1
e13d: 68                       pla                     ;restore # dims to Y-reg
e13e: a8                       tay
e13f: ba                       tsx                     ;copy VALTYP and DIMFLG on stack
e140: bd 02 01                 lda     STACK+2,x       ;to leave room for the subscript
e143: 48                       pha
e144: bd 01 01                 lda     STACK+1,x
e147: 48                       pha
e148: a5 a0                    lda     FAC+3           ;get subscript value and place in the
e14a: 9d 02 01                 sta     STACK+2,x       ; stack where valtyp & DIMFLG were
e14d: a5 a1                    lda     FAC+4
e14f: 9d 01 01                 sta     STACK+1,x
e152: c8                       iny                     ;count the subscript
e153: 20 b7 00                 jsr     CHRGOT          ;next char
e156: c9 2c                    cmp     #‘,’
e158: f0 d2                    beq     LE12C           ;comma, parse another subscript
e15a: 84 0f                    sty     NUMDIM          ;no more subscripts, save #
e15c: 20 b8 de                 jsr     CHKCLS          ;now need ")"
e15f: 68                       pla                     ;restore VALTYPE and DIMFLG
e160: 85 11                    sta     VALTYP
e162: 68                       pla
e163: 85 12                    sta     VALTYP+1
e165: 29 7f                    and     #$7f            ;isolate DIMFLG
e167: 85 10                    sta     DIMFLG
                   ; Search array table for this array name
e169: a6 6b        LE169       ldx     ARYTAB          ;(A,X) = start of array table
e16b: a5 6c                    lda     ARYTAB+1
e16d: 86 9b        LE16D       stx     LOWTR           ;use LOWTR for running pointer
e16f: 85 9c                    sta     LOWTR+1
e171: c5 6e                    cmp     STREND+1        ;did we reach the end of arrays yet?
e173: d0 04                    bne     LE179           ;no, keep searching
e175: e4 6d                    cpx     STREND
e177: f0 3f                    beq     MAKE_NEW_ARRAY  ;yes, this is a new array name
e179: a0 00        LE179       ldy     #$00            ;point at 1st char of array name
e17b: b1 9b                    lda     (LOWTR),y       ;get 1st char of name
e17d: c8                       iny                     ;point at 2nd char
e17e: c5 81                    cmp     VARNAM          ;1st char same?
e180: d0 06                    bne     LE188           ;no, move to next array
e182: a5 82                    lda     VARNAM+1        ;yes, try 2nd char
e184: d1 9b                    cmp     (LOWTR),y       ;same?
e186: f0 16                    beq     USE_OLD_ARRAY   ;yes, array found
e188: c8           LE188       iny                     ;point at offset to next array
e189: b1 9b                    lda     (LOWTR),y       ;add offset to running pointer
e18b: 18                       clc
e18c: 65 9b                    adc     LOWTR
e18e: aa                       tax
e18f: c8                       iny
e190: b1 9b                    lda     (LOWTR),y
e192: 65 9c                    adc     LOWTR+1
e194: 90 d7                    bcc     LE16D           ;...always

                   ; ERROR: bad subscripts
e196: a2 6b        SUBERR      ldx     #ERR_BADSUBS
e198: 2c                       bit ▼   $35a2           ;trick to skip next line
                   ; ERROR: illegal quantity
e199: a2 35        IQERR       ldx     #ERR_ILLQTY
e19b: 4c 12 d4     JER         jmp     ERROR

                   ; Found the array
e19e: a2 78                    ldx     #ERR_REDIMD     ;set up for redim'd array error
e1a0: a5 10                    lda     DIMFLG          ;called from DIM statement?
e1a2: d0 f7                    bne     JER             ;yes, error
e1a4: a5 14                    lda     SUBFLG          ;no, check if any subscripts
e1a6: f0 02                    beq     LE1AA           ;yes, need to check the number
e1a8: 38                       sec                     ;no, signal array found
e1a9: 60                       rts

e1aa: 20 ed e0     LE1AA       jsr     GETARY          ;set ARYPNT = addr of first element
e1ad: a5 0f                    lda     NUMDIM          ;compare number of dimensions
e1af: a0 04                    ldy     #4
e1b1: d1 9b                    cmp     (LOWTR),y
e1b3: d0 e1                    bne     SUBERR          ;not same, subscript error
e1b5: 4c 4b e2                 jmp     FIND_ARRAY_ELEMENT

                   ; Create a new array, unless called from GETARYPT.
e1b8: a5 14                    lda     SUBFLG          ;called from GETARYPT?
e1ba: f0 05                    beq     LE1C1           ;no
e1bc: a2 2a                    ldx     #ERR_NODATA     ;yes, give "out of data" error
e1be: 4c 12 d4                 jmp     ERROR

e1c1: 20 ed e0     LE1C1       jsr     GETARY          ;put addr of 1st element in ARYPNT
e1c4: 20 e3 d3                 jsr     REASON          ;make sure enough memory left
                   ; <<< next 3 lines could be written: >>>
                   ;   LDY #0
                   ;   STY STRING2+1
e1c7: a9 00                    lda     #$00            ;point Y-reg at variable name slot
e1c9: a8                       tay
e1ca: 85 ae                    sta     STRNG2+1        ;start size computation
e1cc: a2 05                    ldx     #$05            ;assume 5-bytes per element
e1ce: a5 81                    lda     VARNAM          ;stuff variable name in array
e1d0: 91 9b                    sta     (LOWTR),y
e1d2: 10 01                    bpl     LE1D5           ;not integer array
e1d4: ca                       dex                     ;integer array, decr. size to 4 bytes
e1d5: c8           LE1D5       iny                     ;point Y-reg at next char of name
e1d6: a5 82                    lda     VARNAM+1        ;rest of array name
e1d8: 91 9b                    sta     (LOWTR),y
e1da: 10 02                    bpl     LE1DE           ;real array, stick with size = 5 bytes
e1dc: ca                       dex                     ;integer or string array, adjust size
e1dd: ca                       dex                     ;to integer=3, string=2 bytes
e1de: 86 ad        LE1DE       stx     STRNG2          ;store low byte of array element size
e1e0: a5 0f                    lda     NUMDIM          ;store number of dimensions
e1e2: c8                       iny                     ; in 5th byte of array
e1e3: c8                       iny
e1e4: c8                       iny
e1e5: 91 9b                    sta     (LOWTR),y
e1e7: a2 0b        LE1E7       ldx     #11             ;default dimension = 11 elements
e1e9: a9 00                    lda     #0              ;for hi byte of dimension if default
e1eb: 24 10                    bit     DIMFLG          ;dimensioned array?
e1ed: 50 08                    bvc     LE1F7           ;no, use default value
e1ef: 68                       pla                     ;get specified dim in (A,X)
e1f0: 18                       clc                     ;# elements is 1 larger than
e1f1: 69 01                    adc     #$01            ; dimension value
e1f3: aa                       tax
e1f4: 68                       pla
e1f5: 69 00                    adc     #$00
e1f7: c8           LE1F7       iny                     ;add this dimension to array descriptor
e1f8: 91 9b                    sta     (LOWTR),y
e1fa: c8                       iny
e1fb: 8a                       txa
e1fc: 91 9b                    sta     (LOWTR),y
e1fe: 20 ad e2                 jsr     MULTIPLY_SUBSCRIPT ;multiply this dimension by running size (LOWTR*STRNG2->(A,X))
e201: 86 ad                    stx     STRNG2          ;store running size in STRNG2
e203: 85 ae                    sta     STRNG2+1
e205: a4 5e                    ldy     INDEX           ;retrieve Y saved by MULTIPLY_SUBSCRIPT
e207: c6 0f                    dec     NUMDIM          ;count down # dims
e209: d0 dc                    bne     LE1E7           ;loop till done
                   ; Now (A,X) has total # bytes of array elements
e20b: 65 95                    adc     ARYPNT+1        ;compute address of end of this array
e20d: b0 5d                    bcs     GME             ;...too large, error
e20f: 85 95                    sta     ARYPNT+1
e211: a8                       tay
e212: 8a                       txa
e213: 65 94                    adc     ARYPNT
e215: 90 03                    bcc     LE21A
e217: c8                       iny
e218: f0 52                    beq     GME             ;...too large, error
e21a: 20 e3 d3     LE21A       jsr     REASON          ;make sure there is room up to (Y,A)
e21d: 85 6d                    sta     STREND          ;there is room so save new end of table
e21f: 84 6e                    sty     STREND+1        ; and zero the array
e221: a9 00                    lda     #$00
e223: e6 ae                    inc     STRNG2+1        ;prepare for fast zeroing loop
e225: a4 ad                    ldy     STRNG2          ;# bytes mod 256
e227: f0 05                    beq     LE22E           ;full page
e229: 88           LE229       dey                     ;clear page full
e22a: 91 94                    sta     (ARYPNT),y
e22c: d0 fb                    bne     LE229
e22e: c6 95        LE22E       dec     ARYPNT+1        ;point to next page
e230: c6 ae                    dec     STRNG2+1        ;count the pages
e232: d0 f5                    bne     LE229           ;still more to clear
e234: e6 95                    inc     ARYPNT+1        ;recover last DEC, point at 1st element
e236: 38                       sec
e237: a5 6d                    lda     STREND          ;compute offset to end of arrays
e239: e5 9b                    sbc     LOWTR           ;and store in array descriptor
e23b: a0 02                    ldy     #2
e23d: 91 9b                    sta     (LOWTR),y
e23f: a5 6e                    lda     STREND+1
e241: c8                       iny
e242: e5 9c                    sbc     LOWTR+1
e244: 91 9b                    sta     (LOWTR),y
e246: a5 10                    lda     DIMFLG          ;was this called from DIM statement?
e248: d0 62                    bne     RTS_9           ;yes, we are finished
e24a: c8                       iny                     ;no, now need to find the element
                   ; Find specified array element
                   ; LOWTR,y points at # of dims in array descriptor.  The subscripts are all on
                   ; the stack as integers.
e24b: b1 9b                    lda     (LOWTR),y       ;get # of dimensions
e24d: 85 0f                    sta     NUMDIM
e24f: a9 00                    lda     #$00            ;zero subscript accumulator
e251: 85 ad                    sta     STRNG2
e253: 85 ae        FAE_1       sta     STRNG2+1
e255: c8                       iny
e256: 68                       pla                     ;pull next subscript from stack
e257: aa                       tax                     ;save in FAC+3,4
e258: 85 a0                    sta     FAC+3           ;and compare with dimensioned size
e25a: 68                       pla
e25b: 85 a1                    sta     FAC+4
e25d: d1 9b                    cmp     (LOWTR),y
e25f: 90 0e                    bcc     FAE_2           ;subscript not too large
e261: d0 06                    bne     GSE             ;subscript is too large
e263: c8                       iny                     ;check low byte of subscript
e264: 8a                       txa
e265: d1 9b                    cmp     (LOWTR),y
e267: 90 07                    bcc     FAE_3           ;not too large
e269: 4c 96 e1     GSE         jmp     SUBERR          ;bad subscripts error

e26c: 4c 10 d4     GME         jmp     MEMERR          ;mem full error

e26f: c8           FAE_2       iny                     ;bump pointer into descriptor
e270: a5 ae        FAE_3       lda     STRNG2+1        ;bypass multiplication if value so
e272: 05 ad                    ora     STRNG2          ; far = 0
e274: 18                       clc
e275: f0 0a                    beq     LE281           ;it is zero so far
e277: 20 ad e2                 jsr     MULTIPLY_SUBSCRIPT ;not zero, so multiply
e27a: 8a                       txa                     ;add current subscript
e27b: 65 a0                    adc     FAC+3
e27d: aa                       tax
e27e: 98                       tya
e27f: a4 5e                    ldy     INDEX           ;retrieve Y-reg saved by MULTIPLY_SUBSCRIPT
e281: 65 a1        LE281       adc     FAC+4           ;finish adding current subscript
e283: 86 ad                    stx     STRNG2          ;store accumulated offset
e285: c6 0f                    dec     NUMDIM          ;last subscript yet?
e287: d0 ca                    bne     FAE_1           ;no, loop till done
e289: 85 ae                    sta     STRNG2+1        ;yes, now multiply by element size
e28b: a2 05                    ldx     #5              ;start with size = 5
e28d: a5 81                    lda     VARNAM          ;determine variable type
e28f: 10 01                    bpl     LE292           ;not integer
e291: ca                       dex                     ;integer, back down size to 4 bytes
e292: a5 82        LE292       lda     VARNAM+1        ;discriminate between real and str
e294: 10 02                    bpl     LE298           ;it is real
e296: ca                       dex                     ;size = 3 if string, = 2 if integer
e297: ca                       dex
e298: 86 64        LE298       stx     RESULT+2        ;set up multiplier
e29a: a9 00                    lda     #$00            ;hi byte of multiplier
e29c: 20 b6 e2                 jsr     MULTIPLY_SUBS_1 ;STRNG2 by element size
e29f: 8a                       txa                     ;add accumulated offset
e2a0: 65 94                    adc     ARYPNT          ;to address of 1st element
e2a2: 85 83                    sta     VARPNT          ;to get address of specified element
e2a4: 98                       tya
e2a5: 65 95                    adc     ARYPNT+1
e2a7: 85 84                    sta     VARPNT+1
e2a9: a8                       tay                     ;return with addr in VARPNT
e2aa: a5 83                    lda     VARPNT          ; and in (Y,A)
e2ac: 60           RTS_9       rts

                   ; Multiply STRNG2 by (LOWTR,Y) leaving product in (A,X).  Hi-byte also in Y. 
                   ; Used only by array subscript routines.
e2ad: 84 5e                    sty     INDEX           ;save Y-reg
e2af: b1 9b                    lda     (LOWTR),y       ;get multiplier
e2b1: 85 64                    sta     RESULT+2        ;save in result+2,3
e2b3: 88                       dey
e2b4: b1 9b                    lda     (LOWTR),y
e2b6: 85 65                    sta     RESULT+3        ;low byte of multiplier
e2b8: a9 10                    lda     #16             ;multiply 16 bits
e2ba: 85 99                    sta     INDX
e2bc: a2 00                    ldx     #$00            ;product = 0 initially
e2be: a0 00                    ldy     #$00
e2c0: 8a           LE2C0       txa                     ;double product
e2c1: 0a                       asl     A               ;low byte
e2c2: aa                       tax
e2c3: 98                       tya                     ;high byte
e2c4: 2a                       rol     A               ;if too large, set carry
e2c5: a8                       tay
e2c6: b0 a4                    bcs     GME             ;too large, "mem full error"
e2c8: 06 ad                    asl     STRNG2          ;next bit of multiplicand
e2ca: 26 ae                    rol     STRNG2+1        ; into carry
e2cc: 90 0b                    bcc     LE2D9           ;bit=0, don't need to add
e2ce: 18                       clc                     ;bit=1, add into partial product
e2cf: 8a                       txa
e2d0: 65 64                    adc     RESULT+2
e2d2: aa                       tax
e2d3: 98                       tya
e2d4: 65 65                    adc     RESULT+3
e2d6: a8                       tay
e2d7: b0 93                    bcs     GME             ;too large, "mem full error"
e2d9: c6 99        LE2D9       dec     INDX            ;16 bits yet?
e2db: d0 e3                    bne     LE2C0           ;no, keep shuffling
e2dd: 60                       rts                     ;yes, product in (Y,X) and (A,X)

                   * FRE statement                                                                *
                   *                                                                              *
                   * Collects garbage and returns # bytes of memory left.                         *
e2de: a5 11        FRE         lda     VALTYP          ;look at value of argument
e2e0: f0 03                    beq     LE2E5           ;=0 means real, =$FF means string
e2e2: 20 00 e6                 jsr     FREFAC          ;string, so set it free if temp
e2e5: 20 84 e4     LE2E5       jsr     GARBAG          ;collect all the garbage in sight
e2e8: 38                       sec                     ;compute space between arrays and
e2e9: a5 6f                    lda     FRETOP          ; string temp area
e2eb: e5 6d                    sbc     STREND
e2ed: a8                       tay
e2ee: a5 70                    lda     FRETOP+1
e2f0: e5 6e                    sbc     STREND+1        ;free space in (Y,A)
                   ; Fall into GIVAYF to float the value.  Note that values over 32767 will return
                   ; as negative.
                   ; Float the signed integer in (A,Y).
e2f2: a2 00        GIVAYF      ldx     #$00            ;mark FAC value type real
e2f4: 86 11                    stx     VALTYP
e2f6: 85 9e                    sta     FAC+1           ;save value from A,Y in mantissa
e2f8: 84 9f                    sty     FAC+2
e2fa: a2 90                    ldx     #$90            ;set exponent to 2^16
e2fc: 4c 9b eb                 jmp     FLOAT_1         ;convert to signed fp

                   * POS statement                                                                *
                   *                                                                              *
                   * Returns current line position from MON_CH.                                   *
e2ff: a4 24        POS         ldy     MON_CH          ;Get (A,Y) = MON_CH, go to GIVAYF
                   ; Float Y-reg into FAC, giving value 0-255
e301: a9 00        SNGFLT      lda     #$00            ;MSB = 0
e303: 38                       sec                     ;<<< no purpose whatsoever >>>
e304: f0 ec                    beq     GIVAYF          ;...always

                   ; Check for direct or running mode, giving error if direct mode.
e306: a6 76        ERRDIR      ldx     CURLIN+1        ;=$FF if direct mode
e308: e8                       inx                     ;makes $FF into zero
e309: d0 a1                    bne     RTS_9           ;return if running mode
e30b: a2 95                    ldx     #ERR_ILLDIR     ;direct mode, give error
e30d: 2c                       bit ▼   LE0A2           ;trick to skip next 2 bytes
e30e: a2 e0        UNDFNC      ldx     #ERR_UNDEFFUNC  ;undefined function error
e310: 4c 12 d4                 jmp     ERROR

                   * DEF statement                                                                *
e313: 20 41 e3     DEF         jsr     FNC_            ;parse FN, function name
e316: 20 06 e3                 jsr     ERRDIR          ;error if in direct mode
e319: 20 bb de                 jsr     CHKOPN          ;need "("
e31c: a9 80                    lda     #$80            ;flag PRTGET that called from DEF FN
e31e: 85 14                    sta     SUBFLG          ;allow only simple fp variable for arg
e320: 20 e3 df                 jsr     PTRGET          ;get ptr to argument
e323: 20 6a dd                 jsr     CHKNUM          ;must be numeric
e326: 20 b8 de                 jsr     CHKCLS          ;must have ")" now
e329: a9 d0                    lda     #TOK_EQUAL      ;now need "="
e32b: 20 c0 de                 jsr     SYNCHR          ;or else syntax error
e32e: 48                       pha                     ;save char after "="
e32f: a5 84                    lda     VARPNT+1        ;save ptr to argument
e331: 48                       pha
e332: a5 83                    lda     VARPNT
e334: 48                       pha
e335: a5 b9                    lda     TXTPTR+1        ;save TXTPTR
e337: 48                       pha
e338: a5 b8                    lda     TXTPTR
e33a: 48                       pha
e33b: 20 95 d9                 jsr     DATA            ;scan to next statement
e33e: 4c af e3                 jmp     FNCDATA         ;store above 5 bytes in "value"

                   ; Common routine for DEF FN and FN, to parse FN and the function name
e341: a9 c2        FNC_        lda     #TOK_FN         ;must now see FN token
e343: 20 c0 de                 jsr     SYNCHR          ;or else syntax error
e346: 09 80                    ora     #$80            ;set sign bit on 1st char of name,
e348: 85 14                    sta     SUBFLG          ; making $C0 < SUBFLG < $DB
e34a: 20 ea df                 jsr     PTRGET3         ; which tells PTRGET who called
e34d: 85 8a                    sta     FNCNAM          ;found valid function name, so
e34f: 84 8b                    sty     FNCNAM+1        ; save address
e351: 4c 6a dd                 jmp     CHKNUM          ;must be numeric

                   * FN statement                                                                 *
e354: 20 41 e3     FUNCT       jsr     FNC_            ;parse FN, function name
e357: a5 8b                    lda     FNCNAM+1        ;stack function address
e359: 48                       pha                     ;in case of a nested FN call
e35a: a5 8a                    lda     FNCNAM
e35c: 48                       pha
e35d: 20 b2 de                 jsr     PARCHK          ;must now have "(expression)"
e360: 20 6a dd                 jsr     CHKNUM          ;must be numeric expression
e363: 68                       pla                     ;get function address back
e364: 85 8a                    sta     FNCNAM
e366: 68                       pla
e367: 85 8b                    sta     FNCNAM+1
e369: a0 02                    ldy     #$02            ;point at add of argument variable
e36b: b1 8a                    lda     (FNCNAM),y
e36d: 85 83                    sta     VARPNT
e36f: aa                       tax
e370: c8                       iny
e371: b1 8a                    lda     (FNCNAM),y
e373: f0 99                    beq     UNDFNC          ;undefined function
e375: 85 84                    sta     VARPNT+1
e377: c8                       iny                     ;Y=4 now
e378: b1 83        LE378       lda     (VARPNT),y      ;save old value of argument variable
e37a: 48                       pha                     ; on stack, in case also used as
e37b: 88                       dey                     ; a normal variable
e37c: 10 fa                    bpl     LE378
e37e: a4 84                    ldy     VARPNT+1        ;(Y,X) = address, store FAC in variable
e380: 20 2b eb                 jsr     STORE_FAC_AT_YX_ROUNDED
e383: a5 b9                    lda     TXTPTR+1        ;remember TXTPTR after FN call
e385: 48                       pha
e386: a5 b8                    lda     TXTPTR
e388: 48                       pha
e389: b1 8a                    lda     (FNCNAM),y      ;Y=0 from MOVMF
e38b: 85 b8                    sta     TXTPTR          ;point to function def'n
e38d: c8                       iny
e38e: b1 8a                    lda     (FNCNAM),y
e390: 85 b9                    sta     TXTPTR+1
e392: a5 84                    lda     VARPNT+1        ;save address of argument variable
e394: 48                       pha
e395: a5 83                    lda     VARPNT
e397: 48                       pha
e398: 20 67 dd                 jsr     FRMNUM          ;evaluate the function expression
e39b: 68                       pla                     ;get address of argument variable
e39c: 85 8a                    sta     FNCNAM          ; and save it
e39e: 68                       pla
e39f: 85 8b                    sta     FNCNAM+1
e3a1: 20 b7 00                 jsr     CHRGOT          ;must be at ":" or EOL
e3a4: f0 03                    beq     LE3A9           ;we are
e3a6: 4c c9 de                 jmp     SYNERR          ;we are not, syntax error

e3a9: 68           LE3A9       pla                     ;retrieve TXTPTR after FN call
e3aa: 85 b8                    sta     TXTPTR
e3ac: 68                       pla
e3ad: 85 b9                    sta     TXTPTR+1
                   ; Stack now has 5-byte value of the argument variable, and FNCNAM points at the
                   ; variable.
                   ; Store five bytes from stack at FNCNAM.
e3af: a0 00        FNCDATA     ldy     #$00
e3b1: 68                       pla
e3b2: 91 8a                    sta     (FNCNAM),y
e3b4: 68                       pla
e3b5: c8                       iny
e3b6: 91 8a                    sta     (FNCNAM),y
e3b8: 68                       pla
e3b9: c8                       iny
e3ba: 91 8a                    sta     (FNCNAM),y
e3bc: 68                       pla
e3bd: c8                       iny
e3be: 91 8a                    sta     (FNCNAM),y
e3c0: 68                       pla
e3c1: c8                       iny
e3c2: 91 8a                    sta     (FNCNAM),y
e3c4: 60                       rts

                   * STR$ statement                                                               *
e3c5: 20 6a dd     STR         jsr     CHKNUM          ;expresson must be numeric
e3c8: a0 00                    ldy     #$00            ;start string at STACK-1 ($00FF)
e3ca: 20 36 ed                 jsr     FOUT_1          ;convert FAC to string
e3cd: 68                       pla                     ;pop return off stack
e3ce: 68                       pla
e3cf: a9 ff                    lda     #<STACK+255     ;point to STACK-1
e3d1: a0 00                    ldy     #(>STACK)-1     ;which=0
e3d3: f0 12                    beq     STRLIT          ;...always, create desc & move string

                   ; Get space and make descriptor for string whose address is in FAC+3,4 and whose
                   ; length is in A-reg
e3d5: a6 a0        STRINI      ldx     FAC+3           ;Y,X = string address
e3d7: a4 a1                    ldy     FAC+4
e3d9: 86 8c                    stx     DSCPTR
e3db: 84 8d                    sty     DSCPTR+1
                   ; Get space and make descriptor for string whose address is in (Y,X) and whose
                   ; length is in A-reg.
e3dd: 20 52 e4     STRSPA      jsr     GETSPA          ;A-reg holds length
e3e0: 86 9e                    stx     FAC+1           ;save descriptor in FAC
e3e2: 84 9f                    sty     FAC+2           ;---FAC--- --FAC+1-- --FAC+2--
e3e4: 85 9d                    sta     FAC             ;<length>  <addr-lo> <addr-hi>
e3e6: 60                       rts

                   ; Build a descriptor for string starting at (Y,A) and terminated by $00 or
                   ; quotation mark.  Return with descriptor in a temporary and address of
                   ; descriptor in FAC+3,4.
e3e7: a2 22        STRLIT      ldx     #‘"’            ;set up literal scan to stop on
e3e9: 86 0d                    stx     CHARAC          ;quotation mark or $00
e3eb: 86 0e                    stx     ENDCHR
                   ; Build a descriptor for string starting at (Y,A) and terminated by $00, CHARAC,
                   ; or ENDCHR.
                   ; Return with descriptor in a temporary and address of descriptor in FAC+3,4.
e3ed: 85 ab        STRLT2      sta     STRNG1          ;save address of string
e3ef: 84 ac                    sty     STRNG1+1
e3f1: 85 9e                    sta     FAC+1           ;...again
e3f3: 84 9f                    sty     FAC+2
e3f5: a0 ff                    ldy     #$ff
e3f7: c8           LE3F7       iny                     ;find end of string
e3f8: b1 ab                    lda     (STRNG1),y      ;next string char
e3fa: f0 0c                    beq     LE408           ;end of string
e3fc: c5 0d                    cmp     CHARAC          ;alternate terminator #1?
e3fe: f0 04                    beq     LE404           ;yes
e400: c5 0e                    cmp     ENDCHR          ;alternate terminator #2?
e402: d0 f3                    bne     LE3F7           ;no, keep scanning
e404: c9 22        LE404       cmp     #‘"’            ;is string ended with quote mark?
e406: f0 01                    beq     LE409           ;yes, C=1 to include " in string
e408: 18           LE408       clc
e409: 84 9d        LE409       sty     FAC             ;save length
e40b: 98                       tya
e40c: 65 ab                    adc     STRNG1          ;compute address of end of string
e40e: 85 ad                    sta     STRNG2          ;(of 00 byte, or just after ")
e410: a6 ac                    ldx     STRNG1+1
e412: 90 01                    bcc     LE415
e414: e8                       inx
e415: 86 ae        LE415       stx     STRNG2+1
e417: a5 ac                    lda     STRNG1+1        ;where does the string start?
e419: f0 04                    beq     LE41F           ;page 0, must be from STR$ function
e41b: c9 02                    cmp     #2              ;page 2?
e41d: d0 0b                    bne     PUTNEW          ;no, not page 0 or 2
e41f: 98           LE41F       tya                     ;length of string
e420: 20 d5 e3                 jsr     STRINI          ;make space for string
e423: a6 ab                    ldx     STRNG1
e425: a4 ac                    ldy     STRNG1+1
e427: 20 e2 e5                 jsr     MOVSTR          ;move it in
                   ; Store descriptor in temporary descriptor stack.
                   ; The descriptor is now in FAC, FAC+1, FAC+2.  Put address of temp descriptor in
                   ; FAC+3,4.
e42a: a6 52        PUTNEW      ldx     TEMPPT          ;pointer to next temp string slot
e42c: e0 5e                    cpx     #TEMPST+9       ;max of 3 temp strings
e42e: d0 05                    bne     PUTEMP          ;room for another one
e430: a2 bf                    ldx     #ERR_FRMCPX     ;too many, formula too complex
e432: 4c 12 d4     JERR        jmp     ERROR

                   • Clear variables
                   GARFLG      .var    $13    {addr/1} ;overlaps DATAFLG
                   LASTPT      .var    $53    {addr/1} ;overlaps TEMPPT+1
                   ARYPNT      .var    $94    {addr/2} ;Overlaps HIGHDS

e435: a5 9d        PUTEMP      lda     FAC             ;copy temp descriptor into temp stack
e437: 95 00                    sta     0,x
e439: a5 9e                    lda     FAC+1
e43b: 95 01                    sta     1,x
e43d: a5 9f                    lda     FAC+2
e43f: 95 02                    sta     2,x
e441: a0 00                    ldy     #$00
e443: 86 a0                    stx     FAC+3           ;address of temp descriptor
e445: 84 a1                    sty     FAC+4           ;in (Y,X) and FAC+3,4
e447: 88                       dey                     ;Y=$FF
e448: 84 11                    sty     VALTYP          ;flag FAC as string
e44a: 86 53                    stx     LASTPT          ;index of last pointer
e44c: e8                       inx                     ;update for next temp entry
e44d: e8                       inx
e44e: e8                       inx
e44f: 86 52                    stx     TEMPPT
e451: 60                       rts

                   ; Make space for string at bottom of string space.
                   ;   A-reg = # bytes space to make
                   ; Return with A-reg same, and (Y,X) = address of space allocated
e452: 46 13        GETSPA      lsr     GARFLG          ;clear signbit of flag
e454: 48           LE454       pha                     ;A-reg holds length
e455: 49 ff                    eor     #$ff            ;get -length
e457: 38                       sec
e458: 65 6f                    adc     FRETOP          ;compute starting address of space
e45a: a4 70                    ldy     FRETOP+1        ;for the string
e45c: b0 01                    bcs     LE45F
e45e: 88                       dey
e45f: c4 6e        LE45F       cpy     STREND+1        ;see if fits in remaining memory
e461: 90 11                    bcc     LE474           ;no, try garbage
e463: d0 04                    bne     LE469           ;yes, it fits
e465: c5 6d                    cmp     STREND          ;have to check lower bytes
e467: 90 0b                    bcc     LE474           ;not enuf room yet
e469: 85 6f        LE469       sta     FRETOP          ;there is room so save new FRETOP
e46b: 84 70                    sty     FRETOP+1
e46d: 85 71                    sta     FRESPC
e46f: 84 72                    sty     FRESPC+1
e471: aa                       tax                     ;addr in (Y,X)
e472: 68                       pla                     ;length in A-reg
e473: 60                       rts

e474: a2 4d        LE474       ldx     #ERR_MEMFULL
e476: a5 13                    lda     GARFLG          ;garbage done yet?
e478: 30 b8                    bmi     JERR            ;yes, memory is really full
e47a: 20 84 e4                 jsr     GARBAG          ;no, try collecting now
e47d: a9 80                    lda     #$80            ;flag that collected garbage already
e47f: 85 13                    sta     GARFLG
e481: 68                       pla                     ;get string length again
e482: d0 d0                    bne     LE454           ;...always

                   ; Shove all referenced strings as high as possible in memory (against HIMEM),
                   ; freeing up space below string area down to STREND.
e484: a6 73        GARBAG      ldx     MEMSIZE         ;collect from top down
e486: a5 74                    lda     MEMSIZE+1
e488: 86 6f                    stx     FRETOP          ;one pass through all vars
e48a: 85 70                    sta     FRETOP+1        ;for each active string!
e48c: a0 00                    ldy     #$00
e48e: 84 8b                    sty     FNCNAM+1        ;flag in case no strings to collect
e490: a5 6d                    lda     STREND
e492: a6 6e                    ldx     STREND+1
e494: 85 9b                    sta     LOWTR
e496: 86 9c                    stx     LOWTR+1
                   ; Start by collecting temporaries.
e498: a9 55                    lda     #TEMPST
e49a: a2 00                    ldx     #>TEMPST
e49c: 85 5e                    sta     INDEX
e49e: 86 5f                    stx     INDEX+1
e4a0: c5 52        LE4A0       cmp     TEMPPT          ;finished with temps yet?
e4a2: f0 05                    beq     LE4A9           ;yes, now do simple variables
e4a4: 20 23 e5                 jsr     CHECK_VARIABLE  ;do a temp
e4a7: f0 f7                    beq     LE4A0           ;...always

                   ; Now collect simple variables.
e4a9: a9 07        LE4A9       lda     #7              ;length of each variable is 7 bytes
e4ab: 85 8f                    sta     DSCLEN
e4ad: a5 69                    lda     VARTAB          ;start at beginning of vartab
e4af: a6 6a                    ldx     VARTAB+1
e4b1: 85 5e                    sta     INDEX
e4b3: 86 5f                    stx     INDEX+1
e4b5: e4 6c        LE4B5       cpx     ARYTAB+1        ;finished with simple variables?
e4b7: d0 04                    bne     LE4BD           ;no
e4b9: c5 6b                    cmp     ARYTAB          ;maybe, check low byte
e4bb: f0 05                    beq     LE4C2           ;yes, now do arrays
e4bd: 20 19 e5     LE4BD       jsr     CHECK_SIMPLE_VARIABLE
e4c0: f0 f3                    beq     LE4B5           ;...always

                   ; Now collect array variables.
e4c2: 85 94        LE4C2       sta     ARYPNT
e4c4: 86 95                    stx     ARYPNT+1
e4c6: a9 03                    lda     #3              ;descriptors in arrays are 3 bytes each
e4c8: 85 8f                    sta     DSCLEN
e4ca: a5 94        LE4CA       lda     ARYPNT          ;compare to end of arrays
e4cc: a6 95                    ldx     ARYPNT+1
e4ce: e4 6e        LE4CE       cpx     STREND+1        ;finished with arrays yet?
e4d0: d0 07                    bne     LE4D9           ;not yet
e4d2: c5 6d                    cmp     STREND          ;maybe, check low byte
e4d4: d0 03                    bne     LE4D9           ;not finished yet
e4d6: 4c 62 e5                 jmp     MOVE_HIGHEST_STRING_TO_TOP ;finished

e4d9: 85 5e        LE4D9       sta     INDEX           ;set up ptr to start of array
e4db: 86 5f                    stx     INDEX+1
e4dd: a0 00                    ldy     #$00            ;point at name of array
e4df: b1 5e                    lda     (INDEX),y
e4e1: aa                       tax                     ;1st letter of name in X-reg
e4e2: c8                       iny
e4e3: b1 5e                    lda     (INDEX),y
e4e5: 08                       php                     ;status from second letter of name
e4e6: c8                       iny
e4e7: b1 5e                    lda     (INDEX),y       ;offset to next array
e4e9: 65 94                    adc     ARYPNT          ;(carry always clear)
e4eb: 85 94                    sta     ARYPNT          ;calculate start of next array
e4ed: c8                       iny
e4ee: b1 5e                    lda     (INDEX),y       ;hi byte of offset
e4f0: 65 95                    adc     ARYPNT+1
e4f2: 85 95                    sta     ARYPNT+1
e4f4: 28                       plp                     ;get status from 2nd char of name
e4f5: 10 d3                    bpl     LE4CA           ;not a string array
e4f7: 8a                       txa                     ;set status with 1st char of name
e4f8: 30 d0                    bmi     LE4CA           ;not a string array
e4fa: c8                       iny
e4fb: b1 5e                    lda     (INDEX),y       ;# of dimensions for this array
e4fd: a0 00                    ldy     #$00
e4ff: 0a                       asl     A               ;preamble size = 2*#dims + 5
e500: 69 05                    adc     #5
e502: 65 5e                    adc     INDEX           ;make index point at first element
e504: 85 5e                    sta     INDEX           ; in the array
e506: 90 02                    bcc     LE50A
e508: e6 5f                    inc     INDEX+1
e50a: a6 5f        LE50A       ldx     INDEX+1         ;step thru each string in this array
e50c: e4 95        LE50C       cpx     ARYPNT+1        ;array done?
e50e: d0 04                    bne     LE514           ;no, process next element
e510: c5 94                    cmp     ARYPNT          ;maybe, check low byte
e512: f0 ba                    beq     LE4CE           ;yes, move to next array
e514: 20 23 e5     LE514       jsr     CHECK_VARIABLE  ;process the array
e517: f0 f3                    beq     LE50C           ;...always

                   ; Process a simple variable.
e519: b1 5e                    lda     (INDEX),y       ;look at 1st char of name
e51b: 30 35                    bmi     CHECK_BUMP      ;not a string variable
e51d: c8                       iny
e51e: b1 5e                    lda     (INDEX),y       ;look at 2nd char of name
e520: 10 30                    bpl     CHECK_BUMP      ;not a string variable
e522: c8                       iny
                   ; If string is not empty, check if it is highest.
e523: b1 5e                    lda     (INDEX),y       ;get length of string
e525: f0 2b                    beq     CHECK_BUMP      ;ignore string if length is zero
e527: c8                       iny
e528: b1 5e                    lda     (INDEX),y       ;get address of string
e52a: aa                       tax
e52b: c8                       iny
e52c: b1 5e                    lda     (INDEX),y
e52e: c5 70                    cmp     FRETOP+1        ;check if already collected
e530: 90 06                    bcc     LE538           ;no, below FRETOP
e532: d0 1e                    bne     CHECK_BUMP      ;yes, above FRETOP
e534: e4 6f                    cpx     FRETOP          ;maybe, check low byte
e536: b0 1a                    bcs     CHECK_BUMP      ;yes, above FRETOP
e538: c5 9c        LE538       cmp     LOWTR+1         ;above highest string found?
e53a: 90 16                    bcc     CHECK_BUMP      ;no, ignore for now
e53c: d0 04                    bne     LE542           ;yes, this is the new highest
e53e: e4 9b                    cpx     LOWTR           ;maybe, try low byte
e540: 90 10                    bcc     CHECK_BUMP      ;no, ignore for now
e542: 86 9b        LE542       stx     LOWTR           ;make this the highest string
e544: 85 9c                    sta     LOWTR+1
e546: a5 5e                    lda     INDEX           ;save address of descriptor too
e548: a6 5f                    ldx     INDEX+1
e54a: 85 8a                    sta     FNCNAM
e54c: 86 8b                    stx     FNCNAM+1
e54e: a5 8f                    lda     DSCLEN
e550: 85 91                    sta     LENGTH
                   ; Add DSCLEN to ptr in INDEX.  Return with Y=0, ptr also in (X,A).
e552: a5 8f        CHECK_BUMP  lda     DSCLEN          ;bump to next variable
e554: 18                       clc
e555: 65 5e                    adc     INDEX
e557: 85 5e                    sta     INDEX
e559: 90 02                    bcc     CHECK_EXIT
e55b: e6 5f                    inc     INDEX+1
e55d: a6 5f        CHECK_EXIT  ldx     INDEX+1
e55f: a0 00                    ldy     #$00
e561: 60                       rts

                   ; Found highest non-empty string, so move it to top and go back for another.
                   • Clear variables
                   LASTPT      .var    $53    {addr/2} ;Overlaps TEMPPT+1

e562: a6 8b                    ldx     FNCNAM+1        ;any string found?
e564: f0 f7                    beq     CHECK_EXIT      ;no, return
e566: a5 91                    lda     LENGTH          ;get length of variable element
e568: 29 04                    and     #$04            ;was 7 or 3, make 4 or 0
e56a: 4a                       lsr     A               ;2 or 0; in simple variables,
e56b: a8                       tay                     ; name precedes descriptor
e56c: 85 91                    sta     LENGTH          ;2 or 0
e56e: b1 8a                    lda     (FNCNAM),y      ;get length from descriptor
e570: 65 9b                    adc     LOWTR           ;carry already cleared by LSR
e572: 85 96                    sta     HIGHTR          ;string is btwn LOWTR and HIGHTR
e574: a5 9c                    lda     LOWTR+1
e576: 69 00                    adc     #$00
e578: 85 97                    sta     HIGHTR+1
e57a: a5 6f                    lda     FRETOP          ;high end destination
e57c: a6 70                    ldx     FRETOP+1
e57e: 85 94                    sta     HIGHDS
e580: 86 95                    stx     HIGHDS+1
e582: 20 9a d3                 jsr     BLTU2           ;move string up
e585: a4 91                    ldy     LENGTH          ;fix its descriptor
e587: c8                       iny                     ;point at address in descriptor
e588: a5 94                    lda     HIGHDS          ;store new address
e58a: 91 8a                    sta     (FNCNAM),y
e58c: aa                       tax
e58d: e6 95                    inc     HIGHDS+1        ;correct BTLU's overshoot
e58f: a5 95                    lda     HIGHDS+1
e591: c8                       iny
e592: 91 8a                    sta     (FNCNAM),y
e594: 4c 88 e4                 jmp     FIND_HIGHEST_STRING

                   ; Concatenate two strings.
e597: a5 a1        CAT         lda     FAC+4           ;save address of first descriptor
e599: 48                       pha
e59a: a5 a0                    lda     FAC+3
e59c: 48                       pha
e59d: 20 60 de                 jsr     FRM_ELEMENT     ;get second string element
e5a0: 20 6c dd                 jsr     CHKSTR          ;must be a string
e5a3: 68                       pla                     ;recover address of 1st descriptor
e5a4: 85 ab                    sta     STRNG1
e5a6: 68                       pla
e5a7: 85 ac                    sta     STRNG1+1
e5a9: a0 00                    ldy     #$00
e5ab: b1 ab                    lda     (STRNG1),y      ;add lenghts, get concatenated size
e5ad: 18                       clc
e5ae: 71 a0                    adc     (FAC+3),y
e5b0: 90 05                    bcc     LE5B7           ;ok if < $100
e5b2: a2 b0                    ldx     #ERR_STRLONG
e5b4: 4c 12 d4                 jmp     ERROR

e5b7: 20 d5 e3     LE5B7       jsr     STRINI          ;get space for concatenated strings
e5ba: 20 d4 e5                 jsr     MOVINS          ;move 1st string
e5bd: a5 8c                    lda     DSCPTR
e5bf: a4 8d                    ldy     DSCPTR+1
e5c1: 20 04 e6                 jsr     FRETMP
e5c4: 20 e6 e5                 jsr     MOVSTR_1        ;move 2nd string
e5c7: a5 ab                    lda     STRNG1
e5c9: a4 ac                    ldy     STRNG1+1
e5cb: 20 04 e6                 jsr     FRETMP
e5ce: 20 2a e4                 jsr     PUTNEW          ;set up descriptor
e5d1: 4c 95 dd                 jmp     FRMEVL_2        ;finish expression

                   ; Get string descriptor pointed at by STRNG1 and move described string to
                   ; FRESPC.
e5d4: a0 00        MOVINS      ldy     #$00
e5d6: b1 ab                    lda     (STRNG1),y
e5d8: 48                       pha                     ;length
e5d9: c8                       iny
e5da: b1 ab                    lda     (STRNG1),y
e5dc: aa                       tax                     ;put string pointer in (X,Y)
e5dd: c8                       iny
e5de: b1 ab                    lda     (STRNG1),y
e5e0: a8                       tay
e5e1: 68                       pla                     ;retrieve length
                   ; Move string at (Y,X) with length in A-reg to destination whose address is in
                   ; FRESPC,FRESPC+1.
e5e2: 86 5e        MOVSTR      stx     INDEX           ;put pointer in INDEX
e5e4: 84 5f                    sty     INDEX+1
e5e6: a8           MOVSTR_1    tay                     ;length to Y-reg
e5e7: f0 0a                    beq     LE5F3           ;if length is zero, finished
e5e9: 48                       pha                     ;save length on stack
e5ea: 88           LE5EA       dey                     ;move bytes from INDEX to FRESPC
e5eb: b1 5e                    lda     (INDEX),y
e5ed: 91 71                    sta     (FRESPC),y
e5ef: 98                       tya                     ;test if any left to move
e5f0: d0 f8                    bne     LE5EA           ;yes, keep moving
e5f2: 68                       pla                     ;no, finished; get length
e5f3: 18           LE5F3       clc                     ; and add to FRESPC, so
e5f4: 65 71                    adc     FRESPC          ; FRESPC points to next higher
e5f6: 85 71                    sta     FRESPC          ; byte (used by concatenation)
e5f8: 90 02                    bcc     LE5FC
e5fa: e6 72                    inc     FRESPC+1
e5fc: 60           LE5FC       rts

                   ; If FAC is a temporary string, release descriptor.
e5fd: 20 6c dd     FRESTR      jsr     CHKSTR          ;last result a string?
                   ; If string descriptor pointed to be FAC+3,4 is a temporary string, release it.
e600: a5 a0        FREFAC      lda     FAC+3           ;get descriptor pointer
e602: a4 a1                    ldy     FAC+4
                   ; If string descriptor whose address is in (Y,A) is a temporary string, release
                   ; it.
e604: 85 5e        FRETMP      sta     INDEX           ;save the address of the descriptor
e606: 84 5f                    sty     INDEX+1
e608: 20 35 e6                 jsr     FRETMS          ;free descriptor if it is temporary
e60b: 08                       php                     ;remember if temp
e60c: a0 00                    ldy     #$00            ;point at length of string
e60e: b1 5e                    lda     (INDEX),y
e610: 48                       pha                     ;save length on stack
e611: c8                       iny
e612: b1 5e                    lda     (INDEX),y
e614: aa                       tax                     ;get address of string in (Y,X)
e615: c8                       iny
e616: b1 5e                    lda     (INDEX),y
e618: a8                       tay
e619: 68                       pla                     ;length in A-reg
e61a: 28                       plp                     ;retrieve status, Z=1 if temp
e61b: d0 13                    bne     LE630           ;not a temporary string
e61d: c4 70                    cpy     FRETOP+1        ;is it the lowest string?
e61f: d0 0f                    bne     LE630           ;no
e621: e4 6f                    cpx     FRETOP
e623: d0 0b                    bne     LE630           ;no
e625: 48                       pha                     ;yes, push length again
e626: 18                       clc                     ;recover the space used by
e627: 65 6f                    adc     FRETOP          ; the string
e629: 85 6f                    sta     FRETOP
e62b: 90 02                    bcc     LE62F
e62d: e6 70                    inc     FRETOP+1
e62f: 68           LE62F       pla                     ;retrieve length again
e630: 86 5e        LE630       stx     INDEX           ;address of string in (Y,X)
e632: 84 5f                    sty     INDEX+1         ;length of string in A-reg
e634: 60                       rts

                   ; Release temporary descriptor if (Y,A) = LASTPT.
e635: c4 54        FRETMS      cpy     LASTPT+1        ;compare (Y,A) to latest temp
e637: d0 0c                    bne     LE645           ;not same one, cannot release
e639: c5 53                    cmp     LASTPT
e63b: d0 08                    bne     LE645           ;not same one, cannot release
e63d: 85 52                    sta     TEMPPT          ;update TEMPPT for next temp
e63f: e9 03                    sbc     #3              ;back off LASTPT
e641: 85 53                    sta     LASTPT
e643: a0 00                    ldy     #$00            ;now (Y,A) points to top temp
e645: 60           LE645       rts                     ;Z=0 if not temp, Z=1 if temp

                   * CHR$ statement                                                               *
e646: 20 fb e6     CHRSTR      jsr     CONINT          ;convert argument to byte in X-reg
e649: 8a                       txa
e64a: 48                       pha                     ;save it
e64b: a9 01                    lda     #$01            ;get space for string of length 1
e64d: 20 dd e3                 jsr     STRSPA
e650: 68                       pla                     ;recall the character
e651: a0 00                    ldy     #$00            ;put in string
e653: 91 9e                    sta     (FAC+1),y
e655: 68                       pla                     ;pop return address
e656: 68                       pla
e657: 4c 2a e4                 jmp     PUTNEW          ;make it a temporary string

                   * LEFT$ statement                                                              *
e65a: 20 b9 e6     LEFTSTR     jsr     SUBSTRING_SETUP
e65d: d1 8c                    cmp     (DSCPTR),y      ;compare 1st parameter to length
e65f: 98                       tya                     ;Y=A=0
e660: 90 04        SUBSTRING_1 bcc     LE666           ;1st parameter smaller, use it
e662: b1 8c                    lda     (DSCPTR),y      ;1st is longer, use string length
e664: aa                       tax                     ;in X-reg
e665: 98                       tya                     ;Y=A=0 again
e666: 48           LE666       pha                     ;push left end of substring
e667: 8a           SUBSTRING_2 txa
e668: 48           SUBSTRING_3 pha                     ;push length of substring
e669: 20 dd e3                 jsr     STRSPA          ;make room for string of A-reg bytes
e66c: a5 8c                    lda     DSCPTR          ;release parameter string if temp
e66e: a4 8d                    ldy     DSCPTR+1
e670: 20 04 e6                 jsr     FRETMP
e673: 68                       pla                     ;get length of substring
e674: a8                       tay                     ;in Y-reg
e675: 68                       pla                     ;get left end of substring
e676: 18                       clc                     ;add to pointer to string
e677: 65 5e                    adc     INDEX
e679: 85 5e                    sta     INDEX
e67b: 90 02                    bcc     LE67F
e67d: e6 5f                    inc     INDEX+1
e67f: 98           LE67F       tya                     ;length
e680: 20 e6 e5                 jsr     MOVSTR_1        ;copy string into space
e683: 4c 2a e4                 jmp     PUTNEW          ;add to temps

                   * RIGHT$ statement                                                             *
e686: 20 b9 e6     RIGHTSTR    jsr     SUBSTRING_SETUP
e689: 18                       clc                     ;compute length-width of substring
e68a: f1 8c                    sbc     (DSCPTR),y      ;to get starting point in string
e68c: 49 ff                    eor     #$ff
e68e: 4c 60 e6                 jmp     SUBSTRING_1     ;join LEFT$

                   * MID$ statement                                                               *
e691: a9 ff        MIDSTR      lda     #$ff            ;flag whether 2nd parameter
e693: 85 a1                    sta     FAC+4
e695: 20 b7 00                 jsr     CHRGOT          ;see if ")" yet
e698: c9 29                    cmp     #‘)’
e69a: f0 06                    beq     LE6A2           ;yes, no 2nd parameter
e69c: 20 be de                 jsr     CHKCOM          ;no, must have comma
e69f: 20 f8 e6                 jsr     GETBYT          ;get 2nd param in X-reg
e6a2: 20 b9 e6     LE6A2       jsr     SUBSTRING_SETUP
e6a5: ca                       dex                     ;1st parameter - 1
e6a6: 8a                       txa
e6a7: 48                       pha
e6a8: 18                       clc
e6a9: a2 00                    ldx     #$00
e6ab: f1 8c                    sbc     (DSCPTR),y
e6ad: b0 b8                    bcs     SUBSTRING_2
e6af: 49 ff                    eor     #$ff
e6b1: c5 a1                    cmp     FAC+4           ;use smaller of two
e6b3: 90 b3                    bcc     SUBSTRING_3
e6b5: a5 a1                    lda     FAC+4
e6b7: b0 af                    bcs     SUBSTRING_3     ;...always

                   ; Common setup routine for LEFT$, RIGHT$, MID$: require ")"; pop return adrs,
                   ; get descriptor address, get 1st parameter of command
e6b9: 20 b8 de                 jsr     CHKCLS          ;require ")"
e6bc: 68                       pla                     ;save return address
e6bd: a8                       tay                     ; in Y-reg and LENGTH
e6be: 68                       pla
e6bf: 85 91                    sta     LENGTH
e6c1: 68                       pla                     ;pop previous return address
e6c2: 68                       pla                     ; (from GOROUT)
e6c3: 68                       pla                     ;retrieve 1st parameter
e6c4: aa                       tax
e6c5: 68                       pla                     ;get address of string descriptor
e6c6: 85 8c                    sta     DSCPTR
e6c8: 68                       pla
e6c9: 85 8d                    sta     DSCPTR+1
e6cb: a5 91                    lda     LENGTH          ;restore return address
e6cd: 48                       pha
e6ce: 98                       tya
e6cf: 48                       pha
e6d0: a0 00                    ldy     #$00
e6d2: 8a                       txa                     ;get 1st parameter in A-reg
e6d3: f0 1d                    beq     GOIQ            ;error if 0
e6d5: 60                       rts

                   * LEN statement                                                                *
e6d6: 20 dc e6     LEN         jsr     GETSTR          ;get length in Y-reg, make FAC numeric
e6d9: 4c 01 e3                 jmp     SNGFLT          ;float Y-reg into FAC

                   ; If last result is a temporary string, free it.  Make VALTYP numeric, return
                   ; length in Y-reg.
e6dc: 20 fd e5     GETSTR      jsr     FRESTR          ;if last result is a string, free it
e6df: a2 00                    ldx     #$00            ;make VALTYP numeric
e6e1: 86 11                    stx     VALTYP
e6e3: a8                       tay                     ;length of string to Y-reg
e6e4: 60                       rts

                   * ASC statement                                                                *
e6e5: 20 dc e6     ASC         jsr     GETSTR          ;get string, get length in Y-reg
e6e8: f0 08                    beq     GOIQ            ;error if length 0
e6ea: a0 00                    ldy     #$00
e6ec: b1 5e                    lda     (INDEX),y       ;get 1st char of string
e6ee: a8                       tay
e6ef: 4c 01 e3                 jmp     SNGFLT          ;float Y-reg into FAC

e6f2: 4c 99 e1     GOIQ        jmp     IQERR           ;illegal quantity error

                   ; Scan to next character and convert expression to single byte in X-reg.
e6f5: 20 b1 00     GTBYTC      jsr     CHRGET
                   ; Evaluate expression at TXTPTR, and convert it to single byte in X-reg.
e6f8: 20 67 dd     GETBYT      jsr     FRMNUM
                   ; Convert FAC to single-byte integer in X-reg.
e6fb: 20 08 e1     CONINT      jsr     MKINT           ;convert if in range -32767 to +32767
e6fe: a6 a0                    ldx     FAC+3           ;high byte must be zero
e700: d0 f0                    bne     GOIQ            ;value > 255, error
e702: a6 a1                    ldx     FAC+4           ;value in X-reg
e704: 4c b7 00                 jmp     CHRGOT          ;get next char in A-reg

                   * VAL statement                                                                *
e707: 20 dc e6     VAL         jsr     GETSTR          ;get pointer to string in index
e70a: d0 03                    bne     LE70F           ;length non-zero
e70c: 4c 4e e8                 jmp     ZERO_FAC        ;return 0 if length=0

e70f: a6 b8        LE70F       ldx     TXTPTR          ;save current TXTPTR
e711: a4 b9                    ldy     TXTPTR+1
e713: 86 ad                    stx     STRNG2
e715: 84 ae                    sty     STRNG2+1
e717: a6 5e                    ldx     INDEX
e719: 86 b8                    stx     TXTPTR          ;point TXTPTR to start of string
e71b: 18                       clc
e71c: 65 5e                    adc     INDEX           ;add length
e71e: 85 60                    sta     DEST            ;point DEST to end of string + 1
e720: a6 5f                    ldx     INDEX+1
e722: 86 b9                    stx     TXTPTR+1
e724: 90 01                    bcc     LE727
e726: e8                       inx
e727: 86 61        LE727       stx     DEST+1
e729: a0 00                    ldy     #$00            ;save byte that follows string
e72b: b1 60                    lda     (DEST),y        ; on stack
e72d: 48                       pha
e72e: a9 00                    lda     #$00            ;and store $00 in its place
e730: 91 60                    sta     (DEST),y
                   ; <<< That causes a bug if HIMEM=$BFFF, because storing $00 at $C000 is no use;
                   ; $C000 will always be last char typed, so FIN won't terminate until it sees a
                   ; zero at $C010! >>>
e732: 20 b7 00                 jsr     CHRGOT          ;prime the pump
e735: 20 4a ec                 jsr     FIN             ;evalute string
e738: 68                       pla                     ;get byte that should follow string
e739: a0 00                    ldy     #$00            ;and put it back
e73b: 91 60                    sta     (DEST),y
                   ; Copy STRNG2 into TXTPTR.
e73d: a6 ad        POINT       ldx     STRNG2
e73f: a4 ae                    ldy     STRNG2+1
e741: 86 b8                    stx     TXTPTR
e743: 84 b9                    sty     TXTPTR+1
e745: 60                       rts

                   ; Evalute "EXP1,EXP2"
                   ;   Convert EXP1 to 16-bit number in LINNUM
                   ;   Convert EXP2 to 8-bit number in X-reg
e746: 20 67 dd     GTNUM       jsr     FRMNUM
e749: 20 52 e7                 jsr     GETADR
                   ; Evaluate ",expression"
                   ;   Convert expression to single byte in X-reg
e74c: 20 be de     COMBYTE     jsr     CHKCOM          ;must have comma first
e74f: 4c f8 e6                 jmp     GETBYT          ;convert expression to byte in X-reg

                   ; Convert FAC to a 16-bit value in LINNUM.
e752: a5 9d        GETADR      lda     FAC             ;FAC < 2^16?
e754: c9 91                    cmp     #$91
e756: b0 9a                    bcs     GOIQ            ;no, illegal quantity
e758: 20 f2 eb                 jsr     QINT            ;convert to integer
e75b: a5 a0                    lda     FAC+3           ;copy it into LINNUM
e75d: a4 a1                    ldy     FAC+4
e75f: 84 50                    sty     LINNUM          ;to LINNUM
e761: 85 51                    sta     LINNUM+1
e763: 60                       rts

                   * PEEK statement                                                               *
e764: a5 50        PEEK        lda     LINNUM          ;save LINNUM on stack during peek
e766: 48                       pha
e767: a5 51                    lda     LINNUM+1
e769: 48                       pha
e76a: 20 52 e7                 jsr     GETADR          ;get address peeking at
e76d: a0 00                    ldy     #$00
e76f: b1 50                    lda     (LINNUM),y      ;take a quick look
e771: a8                       tay                     ;value in Y-reg
e772: 68                       pla                     ;restore LINNUM from stack
e773: 85 51                    sta     LINNUM+1
e775: 68                       pla
e776: 85 50                    sta     LINNUM
e778: 4c 01 e3                 jmp     SNGFLT          ;float Y-reg into FAC

                   * POKE statement                                                               *
e77b: 20 46 e7     POKE        jsr     GTNUM           ;get the address and value
e77e: 8a                       txa                     ;value in A,
e77f: a0 00                    ldy     #$00
e781: 91 50                    sta     (LINNUM),y      ;store it away,
e783: 60                       rts                     ;and that's all for today.

                   * WAIT statement                                                               *
e784: 20 46 e7     WAIT        jsr     GTNUM           ;get address in LINNUM, mask in X-reg
e787: 86 85                    stx     FORPNT          ;save mask
e789: a2 00                    ldx     #$00
e78b: 20 b7 00                 jsr     CHRGOT          ;another parameter?
e78e: f0 03                    beq     LE793           ;no, use $00 for exclusive-or
e790: 20 4c e7                 jsr     COMBYTE         ;get xor-mask
e793: 86 86        LE793       stx     FORPNT+1        ;save xor-mask here
e795: a0 00                    ldy     #$00
e797: b1 50        LE797       lda     (LINNUM),y      ;get byte at address
e799: 45 86                    eor     FORPNT+1        ;invert specified bits
e79b: 25 85                    and     FORPNT          ;select specified bits
e79d: f0 f8                    beq     LE797           ;loop till not 0
e79f: 60           RTS_10      rts

                   ; Add 0.5 to FAC
                   • Clear variables
                   ARG_EXTENSION .var  $92    {addr/1} ;Overlaps LENGTH+1
                   SGNCPR      .var    $ab    {addr/1} ;flags opp sign in fp routines
                   FAC_EXTENSION .var  $ac    {addr/1} ;Overlaps STRNG1+1

e7a0: a9 64        FADDH       lda     #<CON_HALF      ;FAC + 1/2 -> FAC
e7a2: a0 ee                    ldy     #>CON_HALF
e7a4: 4c be e7                 jmp     FADD

                   ; FAC = (Y,A) - FAC
e7a7: 20 e3 e9     FSUB        jsr     LOAD_ARG_FROM_YA
                   ; FAC = ARG - FAC
e7aa: a5 a2        FSUBT       lda     FAC_SIGN        ;complement FAC and add
e7ac: 49 ff                    eor     #$ff
e7ae: 85 a2                    sta     FAC_SIGN
e7b0: 45 aa                    eor     ARG_SIGN        ;fix SGNCPR too
e7b2: 85 ab                    sta     SGNCPR
e7b4: a5 9d                    lda     FAC             ;make status show FAC exponent
e7b6: 4c c1 e7                 jmp     FADDT           ;join FADD

                   ; Shift smaller argument more than 7 bits.
e7b9: 20 f0 e8     FADD_1      jsr     SHIFT_RIGHT     ;align radix by shifting
e7bc: 90 3c                    bcc     FADD_3          ;...always

                   ; FAC = (Y,A) + FAC
e7be: 20 e3 e9     FADD        jsr     LOAD_ARG_FROM_YA
                   ; FAC = ARG + FAC
e7c1: d0 03        FADDT       bne     LE7C6           ;FAC is non-zero
e7c3: 4c 53 eb                 jmp     COPY_ARG_TO_FAC ;FAC = 0 + ARG

e7c6: a6 ac        LE7C6       ldx     FAC_EXTENSION
e7c8: 86 92                    stx     ARG_EXTENSION
e7ca: a2 a5                    ldx     #ARG            ;set up to shift ARG
e7cc: a5 a5                    lda     ARG             ;exponent
e7ce: a8           FADD_2      tay
e7cf: f0 ce                    beq     RTS_10          ;if ARG=0, we are finished
e7d1: 38                       sec
e7d2: e5 9d                    sbc     FAC             ;get difference of exp
e7d4: f0 24                    beq     FADD_3          ;go add if same exp
e7d6: 90 12                    bcc     LE7EA           ;arg has smaller exponent
e7d8: 84 9d                    sty     FAC             ;exp has smaller exponent
e7da: a4 aa                    ldy     ARG_SIGN
e7dc: 84 a2                    sty     FAC_SIGN
e7de: 49 ff                    eor     #$ff            ;complement shift count
e7e0: 69 00                    adc     #$00            ;carry was set
e7e2: a0 00                    ldy     #$00
e7e4: 84 92                    sty     ARG_EXTENSION
e7e6: a2 9d                    ldx     #FAC            ;set up to shift FAC
e7e8: d0 04                    bne     LE7EE           ;...always

e7ea: a0 00        LE7EA       ldy     #$00
e7ec: 84 ac                    sty     FAC_EXTENSION
e7ee: c9 f9        LE7EE       cmp     #$f9            ;shift more than 7 bits?
e7f0: 30 c7                    bmi     FADD_1          ;yes
e7f2: a8                       tay                     ;index to # of shifts
e7f3: a5 ac                    lda     FAC_EXTENSION
e7f5: 56 01                    lsr     1,x             ;start shifting...
e7f7: 20 07 e9                 jsr     SHIFT_RIGHT_4   ;...complete shifting
e7fa: 24 ab        FADD_3      bit     SGNCPR          ;do FAC and ARG have same signs?
e7fc: 10 57                    bpl     FADD_4          ;yes, add the mantissas
e7fe: a0 9d                    ldy     #FAC            ;no, subtract smaller from larger
e800: e0 a5                    cpx     #ARG            ;which was adjusted?
e802: f0 02                    beq     LE806           ;if ARG, do FAC - ARG
e804: a0 a5                    ldy     #ARG            ;if FAC, do ARG - FAC
e806: 38           LE806       sec                     ;subtract smaller from larger (we hope)
e807: 49 ff                    eor     #$ff            ;(if exponents were equal, we might be
e809: 65 92                    adc     ARG_EXTENSION   ; subtracting larger from smaller)
e80b: 85 ac                    sta     FAC_EXTENSION
e80d: b9 04 00                 lda     4,y
e810: f5 04                    sbc     4,x
e812: 85 a1                    sta     FAC+4
e814: b9 03 00                 lda     3,y
e817: f5 03                    sbc     3,x
e819: 85 a0                    sta     FAC+3
e81b: b9 02 00                 lda     2,y
e81e: f5 02                    sbc     2,x
e820: 85 9f                    sta     FAC+2
e822: b9 01 00                 lda     1,y
e825: f5 01                    sbc     1,x
e827: 85 9e                    sta     FAC+1
                   ; Normalize value in FAC.
e829: b0 03                    bcs     NORMALIZE_FAC_2
e82b: 20 9e e8                 jsr     COMPLEMENT_FAC
e82e: a0 00                    ldy     #$00            ;shift up signif digit
e830: 98                       tya                     ;start A=0, count shifts in A-reg
e831: 18                       clc
e832: a6 9e        LE832       ldx     FAC+1           ;look at most significant byte
e834: d0 4a                    bne     NORMALIZE_FAC_4 ;some 1-bits here
e836: a6 9f                    ldx     FAC+2           ;high byte of mantissa still zero,
e838: 86 9e                    stx     FAC+1           ; so do a fast 8-bit shuffle
e83a: a6 a0                    ldx     FAC+3
e83c: 86 9f                    stx     FAC+2
e83e: a6 a1                    ldx     FAC+4
e840: 86 a0                    stx     FAC+3
e842: a6 ac                    ldx     FAC_EXTENSION
e844: 86 a1                    stx     FAC+4
e846: 84 ac                    sty     FAC_EXTENSION   ;zero extension byte
e848: 69 08                    adc     #8              ;bump shift count
e84a: c9 20                    cmp     #32             ;done 4 times yet?
e84c: d0 e4                    bne     LE832           ;no, still might be some 1's
                   ; Set FAC = 0 (only necessary to zero exponent and sign cells)
e84e: a9 00        ZERO_FAC    lda     #$00
e850: 85 9d                    sta     FAC
e852: 85 a2                    sta     FAC_SIGN
e854: 60                       rts

                   ; Add mantissas of FAC and ARG into FAC.
e855: 65 92        FADD_4      adc     ARG_EXTENSION
e857: 85 ac                    sta     FAC_EXTENSION
e859: a5 a1                    lda     FAC+4
e85b: 65 a9                    adc     ARG+4
e85d: 85 a1                    sta     FAC+4
e85f: a5 a0                    lda     FAC+3
e861: 65 a8                    adc     ARG+3
e863: 85 a0                    sta     FAC+3
e865: a5 9f                    lda     FAC+2
e867: 65 a7                    adc     ARG+2
e869: 85 9f                    sta     FAC+2
e86b: a5 9e                    lda     FAC+1
e86d: 65 a6                    adc     ARG+1
e86f: 85 9e                    sta     FAC+1
e871: 4c 8d e8                 jmp     NORMALIZE_FAC_5

                   ; Finish normalizing FAC.
e874: 69 01                    adc     #1              ;count bits shifted
e876: 06 ac                    asl     FAC_EXTENSION
e878: 26 a1                    rol     FAC+4
e87a: 26 a0                    rol     FAC+3
e87c: 26 9f                    rol     FAC+2
e87e: 26 9e                    rol     FAC+1
e880: 10 f2                    bpl     NORMALIZE_FAC_3 ;until top bit = 1
e882: 38                       sec
e883: e5 9d                    sbc     FAC             ;adjust exponent by bits shifted
e885: b0 c7                    bcs     ZERO_FAC        ;underflow, return zero
e887: 49 ff                    eor     #$ff
e889: 69 01                    adc     #$01            ;2's complement
e88b: 85 9d                    sta     FAC             ;carry=0 now
e88d: 90 0e                    bcc     RTS_11          ;unless mantissa carried
e88f: e6 9d                    inc     FAC             ;mantissa carried, so shift right
e891: f0 42                    beq     OVERFLOW        ;overflow if exponent too big
e893: 66 9e                    ror     FAC+1
e895: 66 9f                    ror     FAC+2
e897: 66 a0                    ror     FAC+3
e899: 66 a1                    ror     FAC+4
e89b: 66 ac                    ror     FAC_EXTENSION
e89d: 60           RTS_11      rts

                   ; 2's complement of FAC
e89e: a5 a2                    lda     FAC_SIGN
e8a0: 49 ff                    eor     #$ff
e8a2: 85 a2                    sta     FAC_SIGN
                   ; 2's complement of FAC mantissa only
e8a4: a5 9e                    lda     FAC+1
e8a6: 49 ff                    eor     #$ff
e8a8: 85 9e                    sta     FAC+1
e8aa: a5 9f                    lda     FAC+2
e8ac: 49 ff                    eor     #$ff
e8ae: 85 9f                    sta     FAC+2
e8b0: a5 a0                    lda     FAC+3
e8b2: 49 ff                    eor     #$ff
e8b4: 85 a0                    sta     FAC+3
e8b6: a5 a1                    lda     FAC+4
e8b8: 49 ff                    eor     #$ff
e8ba: 85 a1                    sta     FAC+4
e8bc: a5 ac                    lda     FAC_EXTENSION
e8be: 49 ff                    eor     #$ff
e8c0: 85 ac                    sta     FAC_EXTENSION
e8c2: e6 ac                    inc     FAC_EXTENSION   ;start incrementing mantissa
e8c4: d0 0e                    bne     RTS_12
                   ; Increment FAC mantissa.
e8c6: e6 a1                    inc     FAC+4           ;add carry from extra
e8c8: d0 0a                    bne     RTS_12
e8ca: e6 a0                    inc     FAC+3
e8cc: d0 06                    bne     RTS_12
e8ce: e6 9f                    inc     FAC+2
e8d0: d0 02                    bne     RTS_12
e8d2: e6 9e                    inc     FAC+1
e8d4: 60           RTS_12      rts

e8d5: a2 45        OVERFLOW    ldx     #ERR_OVERFLOW
e8d7: 4c 12 d4                 jmp     ERROR

                   ; Shift 1,X through 5,X right
                   ;   A-reg = negative of shift count
                   ;   X-reg = pointer to bytes to be shifted
                   ;   Return with Y-reg=0, carry=0, extension bits in A-reg
e8da: a2 61                    ldx     #RESULT-1       ;shift result right
e8dc: b4 04                    ldy     4,x             ;shift 8 bits right
e8de: 84 ac                    sty     FAC_EXTENSION
e8e0: b4 03                    ldy     3,x
e8e2: 94 04                    sty     4,x
e8e4: b4 02                    ldy     2,x
e8e6: 94 03                    sty     3,x
e8e8: b4 01                    ldy     1,x
e8ea: 94 02                    sty     2,x
e8ec: a4 a4                    ldy     SHIFT_SIGN_EXT  ;$00 if +, $FF if -
e8ee: 94 01                    sty     1,x
                   ; Main entry to right shift subroutine.
e8f0: 69 08        SHIFT_RIGHT adc     #8
e8f2: 30 e8                    bmi     SHIFT_RIGHT_2   ;still more than 8 bits to go
e8f4: f0 e6                    beq     SHIFT_RIGHT_2   ;exactly 8 more bits to go
e8f6: e9 08                    sbc     #8              ;undo ADC above
e8f8: a8                       tay                     ;remaining shift count
e8f9: a5 ac                    lda     FAC_EXTENSION
e8fb: b0 14                    bcs     SHIFT_RIGHT_5   ;finished shifiting
e8fd: 16 01                    asl     1,x             ;sign -> carry (sign extension)
e8ff: 90 02                    bcc     LE903           ;sign +
e901: f6 01                    inc     1,x             ;put sign in LSB
e903: 76 01        LE903       ror     1,x             ;restore value, sign still in carry
e905: 76 01                    ror     1,x             ;start right shift, inserting sign
                   ; Enter here for short shifts with no sign extension.
e907: 76 02                    ror     2,x
e909: 76 03                    ror     3,x
e90b: 76 04                    ror     4,x
e90d: 6a                       ror     A               ;extension
e90e: c8                       iny                     ;count the shift
e90f: d0 ec                    bne     SHIFT_RIGHT_3
e911: 18                       clc                     ;return with carry clear
e912: 60                       rts

e913: 81 00 00 00+ CON_ONE     .bulk   8100000000
e918: 03           POLY_LOG    .dd1    3               ;# of coefficients - 1
e919: 7f 5e 56 cb+             .bulk   7f5e56cb79      ;* X^7 +
e91e: 80 13 9b 0b+             .bulk   80139b0b64      ;* X^5 +
e923: 80 76 38 93+             .bulk   8076389316      ;* X^3 +
e928: 82 38 aa 3b+             .bulk   8238aa3b20      ;* X
e92d: 80 35 04 f3+             .bulk   803504f334
e932: 81 35 04 f3+ CON_SQR_TWO .bulk   813504f334
e937: 80 80 00 00+             .bulk   8080000000
e93c: 80 31 72 17+ CON_LOG_TWO .bulk   80317217f8

                   * LOG statement                                                                *
e941: 20 82 eb     LOG         jsr     SIGN            ;get -1,0,+1 in A-reg for FAC
e944: f0 02                    beq     GIQ             ;LOG(0) is illegal
e946: 10 03                    bpl     LOG_2           ;>0 is ok
e948: 4c 99 e1     GIQ         jmp     IQERR           ;<= 0 is no good

e94b: a5 9d        LOG_2       lda     FAC             ;first get log base 2
e94d: e9 7f                    sbc     #$7f            ;save unbiased exponent
e94f: 48                       pha
e950: a9 80                    lda     #$80            ;normalize between .5 and 1
e952: 85 9d                    sta     FAC
e954: a9 2d                    lda     #<CON_SQR_HALF
e956: a0 e9                    ldy     #>CON_SQR_HALF
e958: 20 be e7                 jsr     FADD            ;compute via series of odd
e95b: a9 32                    lda     #<CON_SQR_TWO   ; powers of
e95d: a0 e9                    ldy     #>CON_SQR_TWO   ; (SQR(2)X-1)/(SQR(2)X+1)
e95f: 20 66 ea                 jsr     FDIV
e962: a9 13                    lda     #<CON_ONE
e964: a0 e9                    ldy     #>CON_ONE
e966: 20 a7 e7                 jsr     FSUB
e969: a9 18                    lda     #<POLY_LOG
e96b: a0 e9                    ldy     #>POLY_LOG
e96d: 20 5c ef                 jsr     POLYNOMIAL_ODD
e970: a9 37                    lda     #<CON_NEG_HALF
e972: a0 e9                    ldy     #>CON_NEG_HALF
e974: 20 be e7                 jsr     FADD
e977: 68                       pla
e978: 20 d5 ec                 jsr     ADDACC          ;add original exponent
e97b: a9 3c                    lda     #<CON_LOG_TWO   ;multiply by log(2) to form
e97d: a0 e9                    ldy     #>CON_LOG_TWO   ; natural log of X
                   ; FAC = (Y,A) * FAC
e97f: 20 e3 e9     FMULT       jsr     LOAD_ARG_FROM_YA
                   ; FAC = ARG * FAC
e982: d0 03        FMULTT      bne     LE987           ;FAC .ne. zero
e984: 4c e2 e9                 jmp     RTS_13          ;FAC = 0 * ARG = 0

                   ; <<< why is line above just "RTS"? >>>
e987: 20 0e ea     LE987       jsr     ADD_EXPONENTS
e98a: a9 00                    lda     #$00
e98c: 85 62                    sta     RESULT          ;init product = 0
e98e: 85 63                    sta     RESULT+1
e990: 85 64                    sta     RESULT+2
e992: 85 65                    sta     RESULT+3
e994: a5 ac                    lda     FAC_EXTENSION
e996: 20 b0 e9                 jsr     MULTIPLY_1
e999: a5 a1                    lda     FAC+4
e99b: 20 b0 e9                 jsr     MULTIPLY_1
e99e: a5 a0                    lda     FAC+3
e9a0: 20 b0 e9                 jsr     MULTIPLY_1
e9a3: a5 9f                    lda     FAC+2
e9a5: 20 b0 e9                 jsr     MULTIPLY_1
e9a8: a5 9e                    lda     FAC+1
e9aa: 20 b5 e9                 jsr     MULTIPLY_2
e9ad: 4c e6 ea                 jmp     COPY_RESULT_INTO_FAC

                   ; Multiply ARG by A-reg into RESULT
e9b0: d0 03        MULTIPLY_1  bne     MULTIPLY_2      ;this byte non-zero
e9b2: 4c da e8                 jmp     SHIFT_RIGHT_1   ;A-reg=0, just shift ARG right 8

e9b5: 4a           MULTIPLY_2  lsr     A               ;shift bit into carry
e9b6: 09 80                    ora     #$80            ;supply sentinel bit
e9b8: a8           LE9B8       tay                     ;remaining multiplier to Y-reg
e9b9: 90 19                    bcc     LE9D4           ;this multiplier bit = 0
e9bb: 18                       clc                     ;= 1, so add ARG to RESULT
e9bc: a5 65                    lda     RESULT+3
e9be: 65 a9                    adc     ARG+4
e9c0: 85 65                    sta     RESULT+3
e9c2: a5 64                    lda     RESULT+2
e9c4: 65 a8                    adc     ARG+3
e9c6: 85 64                    sta     RESULT+2
e9c8: a5 63                    lda     RESULT+1
e9ca: 65 a7                    adc     ARG+2
e9cc: 85 63                    sta     RESULT+1
e9ce: a5 62                    lda     RESULT
e9d0: 65 a6                    adc     ARG+1
e9d2: 85 62                    sta     RESULT          ;shift RESULT right 1
e9d4: 66 62        LE9D4       ror     RESULT
e9d6: 66 63                    ror     RESULT+1
e9d8: 66 64                    ror     RESULT+2
e9da: 66 65                    ror     RESULT+3
e9dc: 66 ac                    ror     FAC_EXTENSION
e9de: 98                       tya                     ;remaining multiplier
e9df: 4a                       lsr     A               ;LSB into carry
e9e0: d0 d6                    bne     LE9B8           ;if sentinel still here, multiply
e9e2: 60           RTS_13      rts                     ;8 x 32 completed

                   ; Unpack number at (Y,A) into ARG
e9e3: 85 5e                    sta     INDEX           ;use INDEX for ptr
e9e5: 84 5f                    sty     INDEX+1
e9e7: a0 04                    ldy     #4              ;five bytes to move
e9e9: b1 5e                    lda     (INDEX),y
e9eb: 85 a9                    sta     ARG+4
e9ed: 88                       dey
e9ee: b1 5e                    lda     (INDEX),y
e9f0: 85 a8                    sta     ARG+3
e9f2: 88                       dey
e9f3: b1 5e                    lda     (INDEX),y
e9f5: 85 a7                    sta     ARG+2
e9f7: 88                       dey
e9f8: b1 5e                    lda     (INDEX),y
e9fa: 85 aa                    sta     ARG_SIGN
e9fc: 45 a2                    eor     FAC_SIGN        ;set combined sign for multi/div
e9fe: 85 ab                    sta     SGNCPR
ea00: a5 aa                    lda     ARG_SIGN        ;turn on normalized invisible bit
ea02: 09 80                    ora     #$80            ; to complete mantissa
ea04: 85 a6                    sta     ARG+1
ea06: 88                       dey
ea07: b1 5e                    lda     (INDEX),y
ea09: 85 a5                    sta     ARG             ;exponent
ea0b: a5 9d                    lda     FAC             ;set status bits on FAC exponent
ea0d: 60                       rts

                   ; Add exponents of ARG and FAC (called by FMULT and FDIV).
                   ; Also check for overflow, and set result sign.
ea0e: a5 a5                    lda     ARG
ea10: f0 1f                    beq     ZERO            ;if ARG=0, result is zero
ea12: 18                       clc
ea13: 65 9d                    adc     FAC
ea15: 90 04                    bcc     LEA1B           ;in range
ea17: 30 1d                    bmi     JOV             ;overflow
ea19: 18                       clc
ea1a: 2c                       bit ▼   $1410           ;trick to skip
ea1b: 10 14        LEA1B       bpl     ZERO            ;overflow
ea1d: 69 80                    adc     #$80            ;re-bias
ea1f: 85 9d                    sta     FAC             ;result
ea21: d0 03                    bne     LEA26
ea23: 4c 52 e8                 jmp     STA_IN_FAC_SIGN ;result is zero

                   ; <<< Crazy to jump way back there!  Same identical code is below!  Instead of
                   ; BNE .2, JMP STA_IN_FAC_SIGN, only needed BEQ .3 >>>
ea26: a5 ab        LEA26       lda     SGNCPR          ;set sign of result
ea28: 85 a2                    sta     FAC_SIGN
ea2a: 60                       rts

                   ; If FAC is positive, give "overflow" error.
                   ; If FAC is negative, set FAC=0, pop one return, and RTS.
                   ; Called from EXP function.
ea2b: a5 a2        OUTOFRNG    lda     FAC_SIGN
ea2d: 49 ff                    eor     #$ff
ea2f: 30 05                    bmi     JOV             ;error if positive #
                   ; Pop return address and set FAC=0.
ea31: 68           ZERO        pla
ea32: 68                       pla
ea33: 4c 4e e8                 jmp     ZERO_FAC

ea36: 4c d5 e8     JOV         jmp     OVERFLOW

                   ; Multiply FAC by 10.
ea39: 20 63 eb     MUL10       jsr     COPY_FAC_TO_ARG_ROUNDED
ea3c: aa                       tax                     ;test FAC exponent
ea3d: f0 10                    beq     LEA4F           ;finished if FAC=0
ea3f: 18                       clc
ea40: 69 02                    adc     #2              ;add 2 to exponent gives FAC*4
ea42: b0 f2                    bcs     JOV             ;overflow
ea44: a2 00                    ldx     #$00
ea46: 86 ab                    stx     SGNCPR
ea48: 20 ce e7                 jsr     FADD_2          ;makes FAC*5
ea4b: e6 9d                    inc     FAC             ;*2, makes FAC*10
ea4d: f0 e7                    beq     JOV             ;overflow
ea4f: 60           LEA4F       rts

ea50: 84 20 00 00+ CON_TEN     .bulk   8420000000

                   ; Divide FAC by 10.
ea55: 20 63 eb     DIV10       jsr     COPY_FAC_TO_ARG_ROUNDED
ea58: a9 50                    lda     #<CON_TEN       ;set up to put
ea5a: a0 ea                    ldy     #>CON_TEN       ; 10 in FAC
ea5c: a2 00                    ldx     #$00
                   ; FAC = ARG / (Y,A)
ea5e: 86 ab        DIV         stx     SGNCPR
ea60: 20 f9 ea     LEA60       jsr     LOAD_FAC_FROM_YA
ea63: 4c 69 ea                 jmp     FDIVT           ;divide ARG by FAC

                   ; FAC = (Y,A) / FAC
ea66: 20 e3 e9     FDIV        jsr     LOAD_ARG_FROM_YA
                   ; FAC = ARG / FAC
ea69: f0 76        FDIVT       beq     LEAE1           ;FAC = 0, divide by zero error
ea6b: 20 72 eb                 jsr     ROUND_FAC
ea6e: a9 00                    lda     #$00            ;negate FAC exponent, so
ea70: 38                       sec                     ; ADD_EXPONENTS forms difference
ea71: e5 9d                    sbc     FAC
ea73: 85 9d                    sta     FAC
ea75: 20 0e ea                 jsr     ADD_EXPONENTS
ea78: e6 9d                    inc     FAC
ea7a: f0 ba                    beq     JOV             ;overflow
ea7c: a2 fc                    ldx     #252            ;(should be -4) index for result
ea7e: a9 01                    lda     #$01            ;sentinel
ea80: a4 a6        LEA80       ldy     ARG+1           ;see if FAC can be subtracted
ea82: c4 9e                    cpy     FAC+1
ea84: d0 10                    bne     LEA96
ea86: a4 a7                    ldy     ARG+2
ea88: c4 9f                    cpy     FAC+2
ea8a: d0 0a                    bne     LEA96
ea8c: a4 a8                    ldy     ARG+3
ea8e: c4 a0                    cpy     FAC+3
ea90: d0 04                    bne     LEA96
ea92: a4 a9                    ldy     ARG+4
ea94: c4 a1                    cpy     FAC+4
ea96: 08           LEA96       php                     ;save the answer, and also roll the
ea97: 2a                       rol     A               ; bit into the quotient, sentinel out
ea98: 90 09                    bcc     LEAA3           ;no sentinel, still not 8 trips
ea9a: e8                       inx                     ;8 trips, store byte of quotient
ea9b: 95 65                    sta     RESULT+3,x
ea9d: f0 32                    beq     LEAD1           ;32 bits completed
ea9f: 10 34                    bpl     LEAD5           ;final exit when X-reg=1
eaa1: a9 01                    lda     #$01            ;re-start sentinel
eaa3: 28           LEAA3       plp                     ;get answer, can FAC be subtracted?
eaa4: b0 0e                    bcs     LEAB4           ;yes, do it
eaa6: 06 a9        LEAA6       asl     ARG+4           ;no, shift ARG left
eaa8: 26 a8                    rol     ARG+3
eaaa: 26 a7                    rol     ARG+2
eaac: 26 a6                    rol     ARG+1
eaae: b0 e6                    bcs     LEA96           ;another trip
eab0: 30 ce                    bmi     LEA80           ;have to compare first
eab2: 10 e2                    bpl     LEA96           ;...always

eab4: a8           LEAB4       tay                     ;save quotient/sentinel byte
eab5: a5 a9                    lda     ARG+4           ;subtract FAC from ARG once
eab7: e5 a1                    sbc     FAC+4
eab9: 85 a9                    sta     ARG+4
eabb: a5 a8                    lda     ARG+3
eabd: e5 a0                    sbc     FAC+3
eabf: 85 a8                    sta     ARG+3
eac1: a5 a7                    lda     ARG+2
eac3: e5 9f                    sbc     FAC+2
eac5: 85 a7                    sta     ARG+2
eac7: a5 a6                    lda     ARG+1
eac9: e5 9e                    sbc     FAC+1
eacb: 85 a6                    sta     ARG+1
eacd: 98                       tya                     ;restore quotient/sentinel byte
eace: 4c a6 ea                 jmp     LEAA6           ;go to shift arg and continue

ead1: a9 40        LEAD1       lda     #$40            ;do a few extension bits
ead3: d0 ce                    bne     LEAA3           ;...always

ead5: 0a           LEAD5       asl     A               ;left justify the extension bits we did
ead6: 0a                       asl     A
ead7: 0a                       asl     A
ead8: 0a                       asl     A
ead9: 0a                       asl     A
eada: 0a                       asl     A
eadb: 85 ac                    sta     FAC_EXTENSION
eadd: 28                       plp
eade: 4c e6 ea                 jmp     COPY_RESULT_INTO_FAC

eae1: a2 85        LEAE1       ldx     #ERR_ZERODIV
eae3: 4c 12 d4                 jmp     ERROR

                   ; Copy RESULT into FAC mantissa, and normalize.
eae6: a5 62                    lda     RESULT
eae8: 85 9e                    sta     FAC+1
eaea: a5 63                    lda     RESULT+1
eaec: 85 9f                    sta     FAC+2
eaee: a5 64                    lda     RESULT+2
eaf0: 85 a0                    sta     FAC+3
eaf2: a5 65                    lda     RESULT+3
eaf4: 85 a1                    sta     FAC+4
eaf6: 4c 2e e8                 jmp     NORMALIZE_FAC_2

                   ; Unpack (Y,A) into FAC.
eaf9: 85 5e                    sta     INDEX           ;use INDEX for ptr
eafb: 84 5f                    sty     INDEX+1
eafd: a0 04                    ldy     #4              ;pick up 5 bytes
eaff: b1 5e                    lda     (INDEX),y
eb01: 85 a1                    sta     FAC+4
eb03: 88                       dey
eb04: b1 5e                    lda     (INDEX),y
eb06: 85 a0                    sta     FAC+3
eb08: 88                       dey
eb09: b1 5e                    lda     (INDEX),y
eb0b: 85 9f                    sta     FAC+2
eb0d: 88                       dey
eb0e: b1 5e                    lda     (INDEX),y
eb10: 85 a2                    sta     FAC_SIGN        ;first bit is sign
eb12: 09 80                    ora     #$80            ;set normalized invisible bit
eb14: 85 9e                    sta     FAC+1
eb16: 88                       dey
eb17: b1 5e                    lda     (INDEX),y
eb19: 85 9d                    sta     FAC             ;exponent
eb1b: 84 ac                    sty     FAC_EXTENSION   ;Y-reg = 0
eb1d: 60                       rts

                   ; Round FAC, store in TEMP2.
eb1e: a2 98                    ldx     #TEMP2          ;pack FAC into TEMP2
eb20: 2c                       bit ▼   $93a2           ;trick to branch
                   ; Round FAC, store in TEMP1.
eb21: a2 93                    ldx     #TEMP1          ;pack FAC into TEMP1
eb23: a0 00                    ldy     #>TEMP1         ;hi-byte of TEMP1 same as TEMP2
eb25: f0 04                    beq     STORE_FAC_AT_YX_ROUNDED ;...always

                   ; Round FAC, and store where FORPNT points.
eb27: a6 85        SETFOR      ldx     FORPNT
eb29: a4 86                    ldy     FORPNT+1
                   ; Round FAC, and store at (Y,X).
eb2b: 20 72 eb                 jsr     ROUND_FAC       ;round value in FAC using extension
eb2e: 86 5e                    stx     INDEX           ;use INDEX for ptr
eb30: 84 5f                    sty     INDEX+1
eb32: a0 04                    ldy     #4              ;storing 5 packed bytes
eb34: a5 a1                    lda     FAC+4
eb36: 91 5e                    sta     (INDEX),y
eb38: 88                       dey
eb39: a5 a0                    lda     FAC+3
eb3b: 91 5e                    sta     (INDEX),y
eb3d: 88                       dey
eb3e: a5 9f                    lda     FAC+2
eb40: 91 5e                    sta     (INDEX),y
eb42: 88                       dey
eb43: a5 a2                    lda     FAC_SIGN        ;pack sign in top bit of mantissa
eb45: 09 7f                    ora     #$7f
eb47: 25 9e                    and     FAC+1
eb49: 91 5e                    sta     (INDEX),y
eb4b: 88                       dey
eb4c: a5 9d                    lda     FAC             ;exponent
eb4e: 91 5e                    sta     (INDEX),y
eb50: 84 ac                    sty     FAC_EXTENSION   ;zero the extension
eb52: 60                       rts

                   ; Copy ARG into FAC.
eb53: a5 aa                    lda     ARG_SIGN        ;copy sign
eb55: 85 a2        MFA         sta     FAC_SIGN
eb57: a2 05                    ldx     #5              ;move 5 bytes
eb59: b5 a4        LEB59       lda     ARG-1,x
eb5b: 95 9c                    sta     FAC-1,x
eb5d: ca                       dex
eb5e: d0 f9                    bne     LEB59
eb60: 86 ac                    stx     FAC_EXTENSION   ;zero extension
eb62: 60                       rts

                   ; Round FAC and copy to ARG.
eb63: 20 72 eb                 jsr     ROUND_FAC       ;round FAC using extension
eb66: a2 06        MAF         ldx     #6              ;copy 6 bytes, includes sign
eb68: b5 9c        LEB68       lda     FAC-1,x
eb6a: 95 a4                    sta     ARG-1,x
eb6c: ca                       dex
eb6d: d0 f9                    bne     LEB68
eb6f: 86 ac                    stx     FAC_EXTENSION   ;zero FAC extension
eb71: 60           RTS_14      rts

                   ; Round FAC using extension byte.
eb72: a5 9d        ROUND_FAC   lda     FAC
eb74: f0 fb                    beq     RTS_14          ;FAC = 0, return
eb76: 06 ac                    asl     FAC_EXTENSION   ;is FAC_EXTENSION >= 128?
eb78: 90 f7                    bcc     RTS_14          ;no, finished
                   ; Increment mantissa and re-normalize if carry.
eb7a: 20 c6 e8                 jsr     INCREMENT_FAC_MANTISSA ;yes, increment FAC
eb7d: d0 f2                    bne     RTS_14          ;high byte has bits, finished
eb7f: 4c 8f e8                 jmp     NORMALIZE_FAC_6 ;hi byte = 0, so shift left

                   ; Test FAC for zero and sign.
                   ;   FAC > 0, return +1
                   ;   FAC = 0, return  0
                   ;   FAC < 0, return -1
eb82: a5 9d        SIGN        lda     FAC             ;check sign of FAC and
eb84: f0 09                    beq     RTS_15          ; return -1,0,1 in A-reg
eb86: a5 a2        SIGN1       lda     FAC_SIGN
eb88: 2a           SIGN2       rol     A               ;msbit to carry
eb89: a9 ff                    lda     #$ff            ;-1
eb8b: b0 02                    bcs     RTS_15          ;msbit = 1
eb8d: a9 01                    lda     #$01            ;+1
eb8f: 60           RTS_15      rts

                   * SGN statement                                                                *
eb90: 20 82 eb     SGN         jsr     SIGN            ;convert FAC to -1,0,1
                   ; Convert A-reg into FAC, as signed value -128 to +127.
eb93: 85 9e        FLOAT       sta     FAC+1           ;put in high byte of mantissa
eb95: a9 00                    lda     #$00            ;clear 2nd byte of mantissa
eb97: 85 9f                    sta     FAC+2
eb99: a2 88                    ldx     #$88            ;use exponent 2^9
                   ; Float unsigned value in FAC+1,2.
                   ;   X-reg = exponent
eb9b: a5 9e        FLOAT_1     lda     FAC+1           ;msbit=0, set carry; =1, clear carry
eb9d: 49 ff                    eor     #$ff
eb9f: 2a                       rol     A
                   ; Float unsigned value in FAC+1,2
                   ;   X-reg = exponent
                   ;   C=0 to make value negative
                   ;   C=1 to make value positive
eba0: a9 00        FLOAT_2     lda     #$00            ;clear lower 16 bits of mantissa
eba2: 85 a1                    sta     FAC+4
eba4: 85 a0                    sta     FAC+3
eba6: 86 9d                    stx     FAC             ;store exponent
eba8: 85 ac                    sta     FAC_EXTENSION   ;clear extension
ebaa: 85 a2                    sta     FAC_SIGN        ;make sign positive
ebac: 4c 29 e8                 jmp     NORMALIZE_FAC_1 ;if C=0, will negate FAC

                   * ABS statement                                                                *
ebaf: 46 a2        ABS         lsr     FAC_SIGN        ;change sign to +
ebb1: 60                       rts

                   ; Compare FAC with packed # at (Y,A).
                   ; Return A=1,0,-1 as (Y,A) is <,=,> FAC.
ebb2: 85 60        FCOMP       sta     DEST            ;use DEST for ptr
                   ; Special entry from NEXT processor.  DEST already set up.
ebb4: 84 61        FCOMP2      sty     DEST+1
ebb6: a0 00                    ldy     #$00            ;get exponent of comparand
ebb8: b1 60                    lda     (DEST),y
ebba: c8                       iny                     ;point at next byte
ebbb: aa                       tax                     ;exponent to X-reg
ebbc: f0 c4                    beq     SIGN            ;if comparand=0, SIGN compares FAC
ebbe: b1 60                    lda     (DEST),y        ;get hi byte of mantissa
ebc0: 45 a2                    eor     FAC_SIGN        ;compare with FAC sign
ebc2: 30 c2                    bmi     SIGN1           ;different signs, SIGN gives answer
ebc4: e4 9d                    cpx     FAC             ;same sign, so compare exponents
ebc6: d0 21                    bne     LEBE9           ;different, so sufficient test
ebc8: b1 60                    lda     (DEST),y        ;same exponent, compare mantissa
ebca: 09 80                    ora     #$80            ;set invisible normalized bit
ebcc: c5 9e                    cmp     FAC+1
ebce: d0 19                    bne     LEBE9           ;not same, so sufficient
ebd0: c8                       iny                     ;same, compare more mantissa
ebd1: b1 60                    lda     (DEST),y
ebd3: c5 9f                    cmp     FAC+2
ebd5: d0 12                    bne     LEBE9           ;not same, so sufficient
ebd7: c8                       iny                     ;same, compare more mantissa
ebd8: b1 60                    lda     (DEST),y
ebda: c5 a0                    cmp     FAC+3
ebdc: d0 0b                    bne     LEBE9           ;not same, so sufficient
ebde: c8                       iny                     ;same, compare more mantissa
ebdf: a9 7f                    lda     #$7f            ;artificial extension byte for comparand
ebe1: c5 ac                    cmp     FAC_EXTENSION
ebe3: b1 60                    lda     (DEST),y
ebe5: e5 a1                    sbc     FAC+4
ebe7: f0 28                    beq     RTS_16          ;numbers are equal, return A-reg=0
ebe9: a5 a2        LEBE9       lda     FAC_SIGN        ;numbers are different
ebeb: 90 02                    bcc     LEBEF           ;FAC is larger magnitude
ebed: 49 ff                    eor     #$ff            ;FAC is smaller magnitude
                   ; <<< Note that above three lines can be shortened:
                   ;   .1 ROR            ;put carry into sign bit
                   ;      EOR FAC_SIGN   ;toggle with sign of FAC
                   ; >>>
ebef: 4c 88 eb     LEBEF       jmp     SIGN2           ;convert +1 or -1

                   ; Quick integer function.
                   ; Converts fp value in FAC to integer value in FAC+1 ... FAC+4, by shifting
                   ; right with sign extension until fractional bits are out.
                   ; This subroutine assumes the exponent < 32.
ebf2: a5 9d        QINT        lda     FAC             ;look at FAC exponent
ebf4: f0 4a                    beq     QINT_3          ;FAC=0, so finished
ebf6: 38                       sec                     ;get -(number of fractional bits)
ebf7: e9 a0                    sbc     #$a0            ; in A-reg for shift count
ebf9: 24 a2                    bit     FAC_SIGN        ;check sign of FAC
ebfb: 10 09                    bpl     LEC06           ;positive, continue
ebfd: aa                       tax                     ;negative, so complement mantissa
ebfe: a9 ff                    lda     #$ff            ;and set sign extension for shift
ec00: 85 a4                    sta     SHIFT_SIGN_EXT
ec02: 20 a4 e8                 jsr     COMPLEMENT_FAC_MANTISSA
ec05: 8a                       txa                     ;restore bit count to A-reg
ec06: a2 9d        LEC06       ldx     #FAC            ;point shift subroutine at FAC
ec08: c9 f9                    cmp     #$f9            ;more than 7 bits to shift?
ec0a: 10 06                    bpl     QINT_2          ;no, short shift
ec0c: 20 f0 e8                 jsr     SHIFT_RIGHT     ;yes, use general routine
ec0f: 84 a4                    sty     SHIFT_SIGN_EXT  ;Y=0, clear sign extension
ec11: 60           RTS_16      rts

ec12: a8           QINT_2      tay                     ;save shift count
ec13: a5 a2                    lda     FAC_SIGN        ;get sign bit
ec15: 29 80                    and     #$80
ec17: 46 9e                    lsr     FAC+1           ;start right shift
ec19: 05 9e                    ora     FAC+1           ;and merge with sign
ec1b: 85 9e                    sta     FAC+1
ec1d: 20 07 e9                 jsr     SHIFT_RIGHT_4   ;jump into middle of shifter
ec20: 84 a4                    sty     SHIFT_SIGN_EXT  ;Y=0, clear sign extension
ec22: 60                       rts

                   * INT statement                                                                *
                   *                                                                              *
                   * Uses QINT to convert FAC to integer form, and then refloats the integer.     *
                   * <<< A faster approach would simply clear the fractional bits by zeroing      *
                   * them. >>>                                                                    *
ec23: a5 9d        INT         lda     FAC             ;check if exponent < 32
ec25: c9 a0                    cmp     #$a0            ;because if > 31 there is no fraction
ec27: b0 20                    bcs     RTS_17          ;no fraction, we are finished
ec29: 20 f2 eb                 jsr     QINT            ;use general integer conversion
ec2c: 84 ac                    sty     FAC_EXTENSION   ;Y=0, clear extension
ec2e: a5 a2                    lda     FAC_SIGN        ;get sign of value
ec30: 84 a2                    sty     FAC_SIGN        ;Y=0, clear sign
ec32: 49 80                    eor     #$80            ;toggle actual sign
ec34: 2a                       rol     A               ;and save in carry
ec35: a9 a0                    lda     #$a0            ;set exponent to 32
ec37: 85 9d                    sta     FAC             ; because 4-byte integer now
ec39: a5 a1                    lda     FAC+4           ;save low 8 bits of integer form
ec3b: 85 0d                    sta     CHARAC          ; for exp and power
ec3d: 4c 29 e8                 jmp     NORMALIZE_FAC_1 ;normalize to finish conversion

ec40: 85 9e        QINT_3      sta     FAC+1           ;FAC=0, so clear all 4 bytes for
ec42: 85 9f                    sta     FAC+2           ; integer version
ec44: 85 a0                    sta     FAC+3
ec46: 85 a1                    sta     FAC+4
ec48: a8                       tay                     ;Y=0 too
ec49: 60           RTS_17      rts

                   ; Convert string to FP value in FAC.
                   ;   String pointed to by TXTPTR
                   ;   First char already scanned by CHRGET
                   ;   A-reg=first char, C=0 if digit
                   • Clear variables
                   LASTPT      .var    $53    {addr/2} ;Overlaps TEMPPT+1
                   ARG_EXTENSION .var  $92    {addr/1} ;Overlaps LENGTH+1
                   DPFLG       .var    $9b    {addr/1} ;Overlaps LOWTR
                   EXPSGN      .var    $9c    {addr/1} ;Overlaps LOWTR+1
                   SGNCPR      .var    $ab    {addr/1} ;Overlaps STRING1
                   FAC_EXTENSION .var  $ac    {addr/1} ;Overlaps STRING1+1

ec4a: a0 00        FIN         ldy     #$00            ;clear working area ($99..A3)
ec4c: a2 0a                    ldx     #10             ;TMPEXP, EXPON, DPFLG, EXPSGN, FAC, SERLEN
ec4e: 94 99        LEC4E       sty     TMPEXP,x
ec50: ca                       dex
ec51: 10 fb                    bpl     LEC4E
ec53: 90 0f                    bcc     FIN_2           ;first char is a digit
ec55: c9 2d                    cmp     #‘-’            ;check for leading sign
ec57: d0 04                    bne     LEC5D           ;not minus
ec59: 86 a3                    stx     SERLEN          ;minus, set SERLEN = $FF for flag
ec5b: f0 04                    beq     FIN_1           ;...always

ec5d: c9 2b        LEC5D       cmp     #‘+’            ;might be plus
ec5f: d0 05                    bne     FIN_3           ;not plus either, check decimal point
ec61: 20 b1 00     FIN_1       jsr     CHRGET          ;get next char of string
ec64: 90 5b        FIN_2       bcc     FIN_9           ;insert this digit
ec66: c9 2e        FIN_3       cmp     #‘.’            ;check for decimal point
ec68: f0 2e                    beq     FIN_10          ;yes
ec6a: c9 45                    cmp     #‘E’            ;check for exponent part
ec6c: d0 30                    bne     FIN_7           ;no, end of number
ec6e: 20 b1 00                 jsr     CHRGET          ;yes, start converting exponent
ec71: 90 17                    bcc     FIN_5           ;exponent digit
ec73: c9 c9                    cmp     #TOK_MINUS      ;negative exponent?
ec75: f0 0e                    beq     LEC85           ;yes
ec77: c9 2d                    cmp     #‘-’            ;might not be tokenized yet
ec79: f0 0a                    beq     LEC85           ;yes, it is negative
ec7b: c9 c8                    cmp     #TOK_PLUS       ;optional "+"
ec7d: f0 08                    beq     FIN_4           ;yes
ec7f: c9 2b                    cmp     #‘+’            ;might not be tokenized yet
ec81: f0 04                    beq     FIN_4           ;yes, found "+"
ec83: d0 07                    bne     FIN_6           ;...always, number completed

ec85: 66 9c        LEC85       ror     EXPSGN          ;C=1, set flag negative
ec87: 20 b1 00     FIN_4       jsr     CHRGET          ;get next digit of exponent
ec8a: 90 5c        FIN_5       bcc     GETEXP          ;char is a digit of exponent
ec8c: 24 9c        FIN_6       bit     EXPSGN          ;end of number, check exp sign
ec8e: 10 0e                    bpl     FIN_7           ;positive exponent
ec90: a9 00                    lda     #$00            ;negative exponent
ec92: 38                       sec                     ;make 2's complete of exponent
ec93: e5 9a                    sbc     EXPON
ec95: 4c a0 ec                 jmp     FIN_8

                   ; Found a decimal point.
ec98: 66 9b        FIN_10      ror     DPFLG           ;C=1, set DPFLG for decimal point
ec9a: 24 9b                    bit     DPFLG           ;check if previous dec. pt.
ec9c: 50 c3                    bvc     FIN_1           ;no previous decimal point
                   ; A second decimal point is taken as a terminator to the numeric string.
                   ; "A=11..22" will give a syntax error, because it is two numbers with no
                   ; operator between.
                   ; "PRINT 11..22" gives no error, because it is just the concatenation of two
                   ; numbers.
                   ; Number terminated, adjust exponent now.
ec9e: a5 9a        FIN_7       lda     EXPON           ;E-value
eca0: 38           FIN_8       sec                     ;modify with count of digits
eca1: e5 99                    sbc     TMPEXP          ; after the decimal point
eca3: 85 9a                    sta     EXPON           ;complete current exponent
eca5: f0 12                    beq     LECB9           ;no adjust needed if exp=0
eca7: 10 09                    bpl     LECB2           ;exp>0, multiply by ten
eca9: 20 55 ea     LECA9       jsr     DIV10           ;exp<0, divide by ten
ecac: e6 9a                    inc     EXPON           ;until exp=0
ecae: d0 f9                    bne     LECA9
ecb0: f0 07                    beq     LECB9           ;...always, we are finished

ecb2: 20 39 ea     LECB2       jsr     MUL10           ;exp>0, multiply by ten
ecb5: c6 9a                    dec     EXPON           ;until exp=0
ecb7: d0 f9                    bne     LECB2
ecb9: a5 a3        LECB9       lda     SERLEN          ;is whole number negative?
ecbb: 30 01                    bmi     LECBE           ;yes
ecbd: 60                       rts                     ;no, return, whole job done!

ecbe: 4c d0 ee     LECBE       jmp     NEGOP           ;negative number, so negate FAC

                   ; Accumulate a digit into FAC.
ecc1: 48           FIN_9       pha                     ;save digit
ecc2: 24 9b                    bit     DPFLG           ;seen a decimal point yet?
ecc4: 10 02                    bpl     LECC8           ;no, still in integer part
ecc6: e6 99                    inc     TMPEXP          ;yes, count the fractional digit
ecc8: 20 39 ea     LECC8       jsr     MUL10           ;FAC = FAC * 10
eccb: 68                       pla                     ;current digit
eccc: 38                       sec                     ;<<< shorter here to just "AND #$0F"
eccd: e9 30                    sbc     #‘0’            ; to convert ASCII to binary form >>>
eccf: 20 d5 ec                 jsr     ADDACC          ;add the digit
ecd2: 4c 61 ec                 jmp     FIN_1           ;go back for more

                   ; Add A-reg to FAC.
ecd5: 48           ADDACC      pha                     ;save addend
ecd6: 20 63 eb                 jsr     COPY_FAC_TO_ARG_ROUNDED
ecd9: 68                       pla                     ;get addend again
ecda: 20 93 eb                 jsr     FLOAT           ;convert to fp value in FAC
ecdd: a5 aa                    lda     ARG_SIGN
ecdf: 45 a2                    eor     FAC_SIGN
ece1: 85 ab                    sta     SGNCPR
ece3: a6 9d                    ldx     FAC             ;to signal if FAC=0
ece5: 4c c1 e7                 jmp     FADDT           ;perform the addition

                   ; Accumulate digit of exponent.
ece8: a5 9a        GETEXP      lda     EXPON           ;check current value
ecea: c9 0a                    cmp     #10             ;for more than 2 digits
ecec: 90 09                    bcc     LECF7           ;no, this is 1st or 2nd digit
ecee: a9 64                    lda     #100            ;exponent too big
ecf0: 24 9c                    bit     EXPSGN          ;unless it is negative
ecf2: 30 11                    bmi     LED05           ;large negative exponent makes FAC=0
ecf4: 4c d5 e8                 jmp     OVERFLOW        ;large positive exponent is error

ecf7: 0a           LECF7       asl     A               ;exponent times 10
ecf8: 0a                       asl     A
ecf9: 18                       clc
ecfa: 65 9a                    adc     EXPON
ecfc: 0a                       asl     A
ecfd: 18                       clc                     ;<<< ASL already did this! >>>
ecfe: a0 00                    ldy     #$00            ;add the new digit
ed00: 71 b8                    adc     (TXTPTR),y      ;but this is in ASCII
ed02: 38                       sec                     ; so adjust back to binary
ed03: e9 30                    sbc     #‘0’
ed05: 85 9a        LED05       sta     EXPON           ;new value
ed07: 4c 87 ec                 jmp     FIN_4           ;back for more

ed0a: 9b 3e bc 1f+             .bulk   9b3ebc1ffd      ;99,999,999.9
ed0f: 9e 6e 6b 27+             .bulk   9e6e6b27fd      ;999,999,999
ed14: 9e 6e 6b 28+ CON_BILLION .bulk   9e6e6b2800      ;1,000,000,000

                   ; Print "IN <LINE #>".
ed19: a9 58        INPRT       lda     #<QT_IN         ;print " IN "
ed1b: a0 d3                    ldy     #>QT_IN
ed1d: 20 31 ed                 jsr     GO_STROUT
ed20: a5 76                    lda     CURLIN+1
ed22: a6 75                    ldx     CURLIN
                   ; Print (A,X) as decimal integer.
ed24: 85 9e        LINPRT      sta     FAC+1           ;print A,X in decimal
ed26: 86 9f                    stx     FAC+2
ed28: a2 90                    ldx     #$90            ;exponent = 2 ^ 16
ed2a: 38                       sec                     ;convert unsigned
ed2b: 20 a0 eb                 jsr     FLOAT_2         ;convert line # to fp
                   ; Convert FAC to string, and print it.
ed2e: 20 34 ed     PRINT_FAC   jsr     FOUT            ;convert FAC to string at stack
                   ; Print string starting at (Y,A).
ed31: 4c 3a db     GO_STROUT   jmp     STROUT          ;print string at (Y,A)

                   ; Convert FAC to string starting at stack.
                   ; Return with (Y,A) pointing at string.
                   • Clear variables

ed34: a0 01        FOUT        ldy     #$01            ;normal entry puts string at stack...
                   ; STR$ function enters here, with Y-reg=0 so that result string starts at stack-
                   ; 1 (this is used as a flag).
ed36: a9 2d        FOUT_1      lda     #‘-’            ;in case value negative
ed38: 88                       dey                     ;back up ptr
ed39: 24 a2                    bit     FAC_SIGN
ed3b: 10 04                    bpl     LED41           ;value is +
ed3d: c8                       iny                     ;value is -
ed3e: 99 ff 00                 sta     STACK-1,y       ;emit "-"
ed41: 85 a2        LED41       sta     FAC_SIGN        ;make FAC_SIGN positive ($2D)
ed43: 84 ad                    sty     STRNG2          ;save string ptr
ed45: c8                       iny
ed46: a9 30                    lda     #‘0’            ;in case FAC=0
ed48: a6 9d                    ldx     FAC             ;number=0?
ed4a: d0 03                    bne     LED4F           ;no, FAC not zero
ed4c: 4c 57 ee                 jmp     FOUT_4          ;yes, finished

ed4f: a9 00        LED4F       lda     #$00            ;starting value for TMPEXP
ed51: e0 80                    cpx     #$80            ;any integer part?
ed53: f0 02                    beq     LED57           ;no, btwn .5 and .999999999
ed55: b0 09                    bcs     LED60           ;yes
ed57: a9 14        LED57       lda     #<CON_BILLION   ;multiply by 1e9
ed59: a0 ed                    ldy     #>CON_BILLION   ;to give adjustment a head start
ed5b: 20 7f e9                 jsr     FMULT
ed5e: a9 f7                    lda     #$f7            ;(should be -9) exponent adjustment
ed60: 85 99        LED60       sta     TMPEXP          ;0 or -9
                   ; Adjust until 1e8 <= FAC < 1e9.
ed62: a9 0f        LED62       lda     #<CON_999999999
ed64: a0 ed                    ldy     #>CON_999999999
ed66: 20 b2 eb                 jsr     FCOMP           ;compare to 1e9-1
ed69: f0 1e                    beq     LED89           ;FAC = 1e9-1
ed6b: 10 12                    bpl     LED7F           ;too large, divide by ten
ed6d: a9 0a        LED6D       lda     #<CON_99999999_9 ;compare to 1e8-.1
ed6f: a0 ed                    ldy     #>CON_99999999_9
ed71: 20 b2 eb                 jsr     FCOMP           ;compare to 1e8-.1
ed74: f0 02                    beq     LED78           ;FAC = 1e8-.1
ed76: 10 0e                    bpl     LED86           ;in range, adjustment finished
ed78: 20 39 ea     LED78       jsr     MUL10           ;too small, multiply by ten
ed7b: c6 99                    dec     TMPEXP          ;keep track of multiplies
ed7d: d0 ee                    bne     LED6D           ;...always

ed7f: 20 55 ea     LED7F       jsr     DIV10           ;too large, divide by ten
ed82: e6 99                    inc     TMPEXP          ;keep track of divisions
ed84: d0 dc                    bne     LED62           ;...always

ed86: 20 a0 e7     LED86       jsr     FADDH           ;round adjusted result
ed89: 20 f2 eb     LED89       jsr     QINT            ;convert adjusted value to 32-bit integer
                   ; FAC+1 ... FAC+4 is now in integer form with power of ten adjustment in TMPEXP.
                   ; If -10 < TMPEXP > 1, print in decimal form.  Otherwise, print in exponential
                   ; form.
ed8c: a2 01        FOUT_2      ldx     #$01            ;assume 1 digit before "."
ed8e: a5 99                    lda     TMPEXP          ;check range
ed90: 18                       clc
ed91: 69 0a                    adc     #10
ed93: 30 09                    bmi     LED9E           ;< .01, use exponential form
ed95: c9 0b                    cmp     #11
ed97: b0 06                    bcs     LED9F           ;>= 1e10, use exponential form
ed99: 69 ff                    adc     #$ff            ;less 1 gives index for "."
ed9b: aa                       tax
ed9c: a9 02                    lda     #$02            ;set remaining exponent = 0
ed9e: 38           LED9E       sec                     ;compute remaining exponent
ed9f: e9 02        LED9F       sbc     #$02
eda1: 85 9a                    sta     EXPON           ;value for "E+xx" or "E-xx"
eda3: 86 99                    stx     TMPEXP          ;index for decimal point
eda5: 8a                       txa                     ;see if "." comes first
eda6: f0 02                    beq     LEDAA           ;yes
eda8: 10 13                    bpl     LEDBD           ;no, later
edaa: a4 ad        LEDAA       ldy     STRNG2          ;get index into string being built
edac: a9 2e                    lda     #‘.’            ;store a decimal point
edae: c8                       iny
edaf: 99 ff 00                 sta     STACK-1,y
edb2: 8a                       txa                     ;see if need ".0"
edb3: f0 06                    beq     LEDBB           ;no
edb5: a9 30                    lda     #‘0’            ;yes, store "0"
edb7: c8                       iny
edb8: 99 ff 00                 sta     STACK-1,y
edbb: 84 ad        LEDBB       sty     STRNG2          ;save output index again
                   ; Now divide by powers of ten to get successive digits.
edbd: a0 00        LEDBD       ldy     #$00            ;index to table of powers of ten
edbf: a2 80                    ldx     #$80            ;starting value for digit with direction
edc1: a5 a1        LEDC1       lda     FAC+4           ;start by adding -100000000 until
edc3: 18                       clc                     ; overshoot.  Then add +10000000,
edc4: 79 6c ee                 adc     DECTBL+3,y      ; then add -1000000, then add
edc7: 85 a1                    sta     FAC+4           ; +100000, and so on.
edc9: a5 a0                    lda     FAC+3           ;the # of times each power is added
edcb: 79 6b ee                 adc     DECTBL+2,y      ; is 1 more than corresponding digit
edce: 85 a0                    sta     FAC+3
edd0: a5 9f                    lda     FAC+2
edd2: 79 6a ee                 adc     DECTBL+1,y
edd5: 85 9f                    sta     FAC+2
edd7: a5 9e                    lda     FAC+1
edd9: 79 69 ee                 adc     DECTBL,y
eddc: 85 9e                    sta     FAC+1
edde: e8                       inx                     ;count the add
eddf: b0 04                    bcs     LEDE5           ;if C=1 and X negative, keep adding
ede1: 10 de                    bpl     LEDC1           ;if C=0 and X positive, keep adding
ede3: 30 02                    bmi     LEDE7           ;if C=0 and X negative, we overshot

ede5: 30 da        LEDE5       bmi     LEDC1           ;if C=1 and X positive, we overshot
ede7: 8a           LEDE7       txa                     ;overshot, so make X into a digit
ede8: 90 04                    bcc     LEDEE           ;how depends on direction we were going
edea: 49 ff                    eor     #$ff            ;digit = 9-x
edec: 69 0a                    adc     #10
edee: 69 2f        LEDEE       adc     #‘/’            ;(should be #'0' - 1)  make digit into ASCII
edf0: c8                       iny                     ;advance to next smaller power of ten
edf1: c8                       iny
edf2: c8                       iny
edf3: c8                       iny
edf4: 84 83                    sty     VARPNT          ;save ptr to powers
edf6: a4 ad                    ldy     STRNG2          ;get output ptr
edf8: c8                       iny                     ;store the digit
edf9: aa                       tax                     ;save digit, hi bit is direction
edfa: 29 7f                    and     #$7f            ;make sure $30..39 for string
edfc: 99 ff 00                 sta     STACK-1,y
edff: c6 99                    dec     TMPEXP          ;count the digit
ee01: d0 06                    bne     LEE09           ;not time for "." yet
ee03: a9 2e                    lda     #‘.’            ;time, so store the decimal point
ee05: c8                       iny
ee06: 99 ff 00                 sta     STACK-1,y
ee09: 84 ad        LEE09       sty     STRNG2          ;save output ptr again
ee0b: a4 83                    ldy     VARPNT          ;get ptr to powers
ee0d: 8a                       txa                     ;get digit with hi bit = direction
ee0e: 49 ff                    eor     #$ff            ;change direction
ee10: 29 80                    and     #$80            ;$00 if adding, $80 if subtracting
ee12: aa                       tax
ee13: c0 24                    cpy     #<DECTBL-69     ;(should be DECTBL_END - DECTBL)
ee15: d0 aa                    bne     LEDC1           ;not finished yet
                   ; Nine digits have been stored in string.  Now look back and lop off trailing
                   ; zeroes and a trailing decimal point.
ee17: a4 ad        FOUT_3      ldy     STRNG2          ;points at last stored char
ee19: b9 ff 00     LEE19       lda     STACK-1,y       ;see if loppable
ee1c: 88                       dey
ee1d: c9 30                    cmp     #‘0’            ;suppress trailing zeroes
ee1f: f0 f8                    beq     LEE19           ;yes, keep looping
ee21: c9 2e                    cmp     #‘.’            ;suppress trailing decimal point
ee23: f0 01                    beq     LEE26           ;".", so write over it
ee25: c8                       iny                     ;not ".", so include in string again
ee26: a9 2b        LEE26       lda     #‘+’            ;prepare for positive exponent "E+xx"
ee28: a6 9a                    ldx     EXPON           ;see if any E-value
ee2a: f0 2e                    beq     FOUT_5          ;no, just mark end of string
ee2c: 10 08                    bpl     LEE36           ;yes, and it is positive
ee2e: a9 00                    lda     #$00            ;yes, and it is negative
ee30: 38                       sec                     ;complement the value
ee31: e5 9a                    sbc     EXPON
ee33: aa                       tax                     ;get magnitude in X-reg
ee34: a9 2d                    lda     #‘-’            ;E sign
ee36: 99 01 01     LEE36       sta     STACK+1,y       ;store sign in string
ee39: a9 45                    lda     #‘E’            ;store "E" in string before sign
ee3b: 99 00 01                 sta     STACK,y
ee3e: 8a                       txa                     ;exponent magnitude in A-reg
ee3f: a2 2f                    ldx     #‘/’            ;(should be #'0'-1) seed for exponent digit
ee41: 38                       sec                     ;convert to decimal
ee42: e8           LEE42       inx                     ;count the subtraction
ee43: e9 0a                    sbc     #10             ;ten's digit
ee45: b0 fb                    bcs     LEE42           ;more tens to subtract
ee47: 69 3a                    adc     #‘:’            ;(should be #'0'+10) convert remainder to one's digit
ee49: 99 03 01                 sta     STACK+3,y       ;store one's digit
ee4c: 8a                       txa
ee4d: 99 02 01                 sta     STACK+2,y       ;store ten's digit
ee50: a9 00                    lda     #$00            ;mark end of string with $00
ee52: 99 04 01                 sta     STACK+4,y
ee55: f0 08                    beq     FOUT_6          ;...always

ee57: 99 ff 00     FOUT_4      sta     STACK-1,y       ;store "0" in ASCII
ee5a: a9 00        FOUT_5      lda     #$00            ;store $00 on end of string
ee5c: 99 00 01                 sta     STACK,y
ee5f: a9 00        FOUT_6      lda     #<STACK         ;point (Y,A) at beginning of string
ee61: a0 01                    ldy     #>STACK         ;(STR$ started string at STACK-1, but
ee63: 60                       rts                     ; STR$ doesn't use (Y,A) anyway.)

ee64: 80 00 00 00+ CON_HALF    .bulk   8000000000      ;fp constant 0.5
                   ; Powers of 10 from 1e8 down to 1, as 32-bit integers, with alternating signs.
ee69: fa 0a 1f 00  DECTBL      .bulk   fa0a1f00        ;-100000000
ee6d: 00 98 96 80              .bulk   00989680        ;10000000
ee71: ff f0 bd c0              .bulk   fff0bdc0        ;-1000000
ee75: 00 01 86 a0              .bulk   000186a0        ;100000
ee79: ff ff d8 f0              .bulk   ffffd8f0        ;-10000
ee7d: 00 00 03 e8              .bulk   000003e8        ;1000
ee81: ff ff ff 9c              .bulk   ffffff9c        ;-100
ee85: 00 00 00 0a              .bulk   0000000a        ;10
ee89: ff ff ff ff              .bulk   ffffffff        ;-1

                   * SQR statement                                                                *
                   *                                                                              *
                   * <<< Unfortunately, rather than a Newton-Raphson iteration, Applesoft uses    *
                   * exponentiation SQR(x) = x^.5 >>>                                             *
ee8d: 20 63 eb     SQR         jsr     COPY_FAC_TO_ARG_ROUNDED
ee90: a9 64                    lda     #<CON_HALF      ;set up power of 0.5
ee92: a0 ee                    ldy     #>CON_HALF
ee94: 20 f9 ea                 jsr     LOAD_FAC_FROM_YA
                   ; Exponentiation operation
                   ; ARG ^ FAC = EXP( LOG(ARG) * FAC )
ee97: f0 70        FPWRT       beq     EXP             ;if FAC=0, ARG^FAC=EXP(0)
ee99: a5 a5                    lda     ARG             ;if ARG=0, ARG^FAC=0
ee9b: d0 03                    bne     LEEA0           ;neither is zero
ee9d: 4c 50 e8                 jmp     STA_IN_FAC_SIGN_AND_EXP ;set FAC = 0

eea0: a2 8a        LEEA0       ldx     #TEMP3          ;save FAC in TEMP3
eea2: a0 00                    ldy     #>TEMP3
eea4: 20 2b eb                 jsr     STORE_FAC_AT_YX_ROUNDED
eea7: a5 aa                    lda     ARG_SIGN        ;normally, ARG must be positive
eea9: 10 0f                    bpl     LEEBA           ;it is positive, so all is well
eeab: 20 23 ec                 jsr     INT             ;negative, but ok if integral power
eeae: a9 8a                    lda     #TEMP3          ;see if INT(FAC)=FAC
eeb0: a0 00                    ldy     #>TEMP3
eeb2: 20 b2 eb                 jsr     FCOMP           ;is it an integer power?
eeb5: d0 03                    bne     LEEBA           ;not integral, will cause error later
eeb7: 98                       tya                     ;mark ARG sign + as it is moved to FAC
eeb8: a4 0d                    ldy     CHARAC          ;integral, so allow negative ARG
eeba: 20 55 eb     LEEBA       jsr     MFA             ;move argument to FAC
eebd: 98                       tya                     ;save flag for negative ARG (0=+)
eebe: 48                       pha
eebf: 20 41 e9                 jsr     LOG             ;get log(ARG)
eec2: a9 8a                    lda     #TEMP3          ;multiply by power
eec4: a0 00                    ldy     #>TEMP3
eec6: 20 7f e9                 jsr     FMULT
eec9: 20 09 ef                 jsr     EXP             ;E ^ log(FAC)
eecc: 68                       pla                     ;get flag for negative ARG
eecd: 4a                       lsr     A               ;<<< LSR,BCC could be merely BPL >>>
eece: 90 0a                    bcc     RTS_18          ;not negative, finished
                   ; Negate value in FAC.
eed0: a5 9d        NEGOP       lda     FAC             ;if FAC=0, no need to complement
eed2: f0 06                    beq     RTS_18          ;yes, FAC=0
eed4: a5 a2                    lda     FAC_SIGN        ;no, so toggle sign
eed6: 49 ff                    eor     #$ff
eed8: 85 a2                    sta     FAC_SIGN
eeda: 60           RTS_18      rts

eedb: 81 38 aa 3b+ CON_LOG_E   .bulk   8138aa3b29      ;log(e) to base 2
eee0: 07           POLY_EXP    .dd1    7               ;(# of terms in polynomial) - 1
eee1: 71 34 58 3e+             .bulk   7134583e56      ;(LOG(2)^7)/8!
eee6: 74 16 7e b3+             .bulk   74167eb31b      ;(LOG(2)^6)/7!
eeeb: 77 2f ee e3+             .bulk   772feee385      ;(LOG(2)^5)/6!
eef0: 7a 1d 84 1c+             .bulk   7a1d841c2a      ;(LOG(2)^4)/5!
eef5: 7c 63 59 58+             .bulk   7c6359580a      ;(LOG(2)^3)/4!
eefa: 7e 75 fd e7+             .bulk   7e75fde7c6      ;(LOG(2)^2)/3!
eeff: 80 31 72 18+             .bulk   8031721810      ;LOG(2)/2!
ef04: 81 00 00 00+             .bulk   8100000000      ;1

                   * EXP statement                                                                *
                   *                                                                              *
                   * FAC = E ^ FAC                                                                *
                   SIGNFLG     .var    $16    {addr/1} ;Overlaps CPRMASK
                   ARG_EXTENSION .var  $92    {addr/1} ;Overlaps LENGTH+1
                   SGNCPR      .var    $ab    {addr/1} ;Overlaps STRNG1
                   FAC_EXTENSION .var  $ac    {addr/1} ;Overlaps STRNG1+1
                   SERPNT      .var    $ad    {addr/2} ;Overlaps STRNG2

ef09: a9 db        EXP         lda     #<CON_LOG_E     ;convert to power of two problem
ef0b: a0 ee                    ldy     #>CON_LOG_E     ;E^x = 2^(log2(e)*x)
ef0d: 20 7f e9                 jsr     FMULT
ef10: a5 ac                    lda     FAC_EXTENSION   ;non-standard rounding here
ef12: 69 50                    adc     #$50            ;round up if extension > $AF
ef14: 90 03                    bcc     LEF19           ;no, don't round up
ef16: 20 7a eb                 jsr     INCREMENT_MANTISSA
ef19: 85 92        LEF19       sta     ARG_EXTENSION   ;strange value
ef1b: 20 66 eb                 jsr     MAF             ;copy FAC into ARG
ef1e: a5 9d                    lda     FAC             ;maximum exponent is < 128
ef20: c9 88                    cmp     #$88            ;within range?
ef22: 90 03                    bcc     LEF27           ;yes
ef24: 20 2b ea     LEF24       jsr     OUTOFRNG        ;overflow if +, return 0.0 if -
ef27: 20 23 ec     LEF27       jsr     INT             ;get INT(FAC)
ef2a: a5 0d                    lda     CHARAC          ;this is the integral part of the power
ef2c: 18                       clc                     ;add to exponent bias + 1
ef2d: 69 81                    adc     #$81
ef2f: f0 f3                    beq     LEF24           ;overflow
ef31: 38                       sec                     ;back to normal bias
ef32: e9 01                    sbc     #$01
ef34: 48                       pha                     ;save exponent
ef35: a2 05                    ldx     #5              ;swap ARG and FAC
ef37: b5 a5        LEF37       lda     ARG,x           ;<<< why swap? it is doing      >>>
ef39: b4 9d                    ldy     FAC,x           ;<<< -(A-B) when (B-A) is the   >>>
ef3b: 95 9d                    sta     FAC,x           ;<<< same thing!                >>>
ef3d: 94 a5                    sty     ARG,x
ef3f: ca                       dex
ef40: 10 f5                    bpl     LEF37
ef42: a5 92                    lda     ARG_EXTENSION
ef44: 85 ac                    sta     FAC_EXTENSION
ef46: 20 aa e7                 jsr     FSUBT           ;power-INT(power) --> fractional part
ef49: 20 d0 ee                 jsr     NEGOP
ef4c: a9 e0                    lda     #<POLY_EXP
ef4e: a0 ee                    ldy     #>POLY_EXP
ef50: 20 72 ef                 jsr     POLYNOMIAL      ;compute F(x) on fractional part
ef53: a9 00                    lda     #$00
ef55: 85 ab                    sta     SGNCPR
ef57: 68                       pla                     ;get exponent
ef58: 20 10 ea                 jsr     ADD_EXPONENTS_1
ef5b: 60                       rts                     ;<<< wasted byte here, could have just JMP ADD_EXPONENTS_1 >>>

                   ; Odd polynomial subroutine
                   ;   F(x) = x * P(x^2)
                   ;   where: x is value in FAC
                   ;          (Y,A) points at coefficient table
                   ;          first byte of coeff. table is N
                   ;          coefficients follow, highest power first
                   ;   P(x^2) computed using normal polynomial subroutine
ef5c: 85 ad                    sta     SERPNT          ;save address of coefficient table
ef5e: 84 ae                    sty     SERPNT+1
ef60: 20 21 eb                 jsr     STORE_FAC_IN_TEMP1_ROUNDED
ef63: a9 93                    lda     #TEMP1          ;Y=0 already, so (Y,A) points at TEMP1
ef65: 20 7f e9                 jsr     FMULT           ;form x^2
ef68: 20 76 ef                 jsr     SERMAIN         ;do series in x^2
ef6b: a9 93                    lda     #TEMP1          ;get x again
ef6d: a0 00                    ldy     #>TEMP1
ef6f: 4c 7f e9                 jmp     FMULT           ;multiply x by P(x^2) and exit

                   ; Normal polynomial subroutine
                   ;   P(x) = C(0)*x^n + C(1)*x^(n-1) + ... + C(n)
                   ;   where: x is value in FAC
                   ;          (Y,A) points at coefficient table
                   ;          first byte of coeff. table is N
                   ;          coefficients follow, highest power first
ef72: 85 ad        POLYNOMIAL  sta     SERPNT          ;pointer to coefficient table
ef74: 84 ae                    sty     SERPNT+1
ef76: 20 1e eb     SERMAIN     jsr     STORE_FAC_IN_TEMP2_ROUNDED
ef79: b1 ad                    lda     (SERPNT),y      ;get N
ef7b: 85 a3                    sta     SERLEN          ;save N
ef7d: a4 ad                    ldy     SERPNT          ;bump ptr to highest coefficient
ef7f: c8                       iny                     ; and get ptr into (Y,A)
ef80: 98                       tya
ef81: d0 02                    bne     LEF85
ef83: e6 ae                    inc     SERPNT+1
ef85: 85 ad        LEF85       sta     SERPNT
ef87: a4 ae                    ldy     SERPNT+1
ef89: 20 7f e9     LEF89       jsr     FMULT           ;accumulate series terms
ef8c: a5 ad                    lda     SERPNT          ;bump ptr to next coefficient
ef8e: a4 ae                    ldy     SERPNT+1
ef90: 18                       clc
ef91: 69 05                    adc     #5
ef93: 90 01                    bcc     LEF96
ef95: c8                       iny
ef96: 85 ad        LEF96       sta     SERPNT
ef98: 84 ae                    sty     SERPNT+1
ef9a: 20 be e7                 jsr     FADD            ;add next coefficient
ef9d: a9 98                    lda     #TEMP2          ;point at x again
ef9f: a0 00                    ldy     #>TEMP2
efa1: c6 a3                    dec     SERLEN          ;if series not finished,
efa3: d0 e4                    bne     LEF89           ; then add another term
efa5: 60           RTS_19      rts                     ;finished

efa6: 98 35 44 7a  CON_RND_1   .bulk   9835447a        ;<<< these are missing one byte >>>
efaa: 68 28 b1 46  CON_RND_2   .bulk   6828b146        ;<<< for fp values              >>>

                   * RND statement                                                                *
efae: 20 82 eb     RND         jsr     SIGN            ;reduce argument to -1, 0, or +1
efb1: aa                       tax                     ;save argument
efb2: 30 18                    bmi     LEFCC           ;= -1, use current argument for seed
efb4: a9 c9                    lda     #RNDSEED        ;use current seed
efb6: a0 00                    ldy     #>RNDSEED
efb8: 20 f9 ea                 jsr     LOAD_FAC_FROM_YA
efbb: 8a                       txa                     ;recall sign of argument
efbc: f0 e7                    beq     RTS_19          ;=0, return seed unchanged
efbe: a9 a6                    lda     #<CON_RND_1     ;very poor RND algorithm
efc0: a0 ef                    ldy     #>CON_RND_1
efc2: 20 7f e9                 jsr     FMULT
efc5: a9 aa                    lda     #<CON_RND_2     ;also, constants are truncated
efc7: a0 ef                    ldy     #>CON_RND_2     ;<<< this does nothing, due to small exponent >>>
efc9: 20 be e7                 jsr     FADD
efcc: a6 a1        LEFCC       ldx     FAC+4           ;shuffle hi and lo bytes
efce: a5 9e                    lda     FAC+1           ;to supposedly make it more random
efd0: 85 a1                    sta     FAC+4
efd2: 86 9e                    stx     FAC+1
efd4: a9 00                    lda     #$00            ;make it positive
efd6: 85 a2                    sta     FAC_SIGN
efd8: a5 9d                    lda     FAC             ;a somewhat random extension
efda: 85 ac                    sta     FAC_EXTENSION
efdc: a9 80                    lda     #$80            ;exponent to make value < 1.0
efde: 85 9d                    sta     FAC
efe0: 20 2e e8                 jsr     NORMALIZE_FAC_2
efe3: a2 c9                    ldx     #RNDSEED        ;move FAC to RNDSEED
efe5: a0 00                    ldy     #>RNDSEED
efe7: 4c 2b eb     GO_MOVMF    jmp     STORE_FAC_AT_YX_ROUNDED

                   * COS statement                                                                *
efea: a9 66        COS         lda     #<CON_PI_HALF   ;cos(x)=sin(x + PI/2)
efec: a0 f0                    ldy     #>CON_PI_HALF
efee: 20 be e7                 jsr     FADD
                   * SIN statement                                                                *
eff1: 20 63 eb     SIN         jsr     COPY_FAC_TO_ARG_ROUNDED
eff4: a9 6b                    lda     #<CON_PI_DOUB   ;remove multiples of 2*PI
eff6: a0 f0                    ldy     #>CON_PI_DOUB   ; by dividing and saving
eff8: a6 aa                    ldx     ARG_SIGN        ; the fractional part
effa: 20 5e ea                 jsr     DIV             ;use sign of argument
effd: 20 63 eb                 jsr     COPY_FAC_TO_ARG_ROUNDED
f000: 20 23 ec                 jsr     INT             ;take integer part
f003: a9 00                    lda     #$00            ;<<< wasted lines, because FSUBT >>>
f005: 85 ab                    sta     SGNCPR          ;<<< changes SGNCPR again        >>>
f007: 20 aa e7                 jsr     FSUBT           ;subtract to get fractional part
                   ; FAC = angle as a fraction of a full circle
                   ; Now fold the range into a quarter circle.
                   ; <<< there are much simpler ways to do this >>>
f00a: a9 70                    lda     #<QUARTER       ;1/4 - fraction makes
f00c: a0 f0                    ldy     #>QUARTER       ;-3/4 <= fraction < 1/4
f00e: 20 a7 e7                 jsr     FSUB
f011: a5 a2                    lda     FAC_SIGN        ;test sign of result
f013: 48                       pha                     ;save sign for later unfolding
f014: 10 0d                    bpl     SIN_1           ;already 0...1/4
f016: 20 a0 e7                 jsr     FADDH           ;add 1/2 to shift to -1/4...1/2
f019: a5 a2                    lda     FAC_SIGN        ;test sign
f01b: 30 09                    bmi     SIN_2           ;-1/4...0
f01d: a5 16                    lda     SIGNFLG         ;0...1/2 ; SIGNFLG initialized = 0 in TAN
f01f: 49 ff                    eor     #$ff            ; function
f021: 85 16                    sta     SIGNFLG         ;TAN is only user of SIGNFLG too
                   ; if fall thru, range is 0...1/2
                   ; if branch here, range is 0...1/4
f023: 20 d0 ee     SIN_1       jsr     NEGOP
                   ; if fall thru, range is -1/2...0
                   ; if branch here, range is -1/4...0
f026: a9 70        SIN_2       lda     #<QUARTER       ;add 1/4 to shift range
f028: a0 f0                    ldy     #>QUARTER       ; to -1/4...1/4
f02a: 20 be e7                 jsr     FADD
f02d: 68                       pla                     ;get saved sign from above
f02e: 10 03                    bpl     LF033
f030: 20 d0 ee                 jsr     NEGOP           ;make range 0...1/4
f033: a9 75        LF033       lda     #<POLY_SIN      ;do standard SIN series
f035: a0 f0                    ldy     #>POLY_SIN
f037: 4c 5c ef                 jmp     POLYNOMIAL_ODD

                   * TAN statement                                                                *
                   *                                                                              *
                   * Compute TAN(x) = SIN(x) / COS(x)                                             *
f03a: 20 21 eb     TAN         jsr     STORE_FAC_IN_TEMP1_ROUNDED
f03d: a9 00                    lda     #$00            ;SIGNFLG will be toggled of 2nd or 3rd
f03f: 85 16                    sta     SIGNFLG         ; quadrant
f041: 20 f1 ef                 jsr     SIN             ;get SIN(x)
f044: a2 8a                    ldx     #TEMP3          ;save SIN(x) in TEMP3
f046: a0 00                    ldy     #>TEMP3
f048: 20 e7 ef                 jsr     GO_MOVMF        ;<<< funny way to call MOVMV! >>>
f04b: a9 93                    lda     #TEMP1          ;retrieve x
f04d: a0 00                    ldy     #>TEMP1
f04f: 20 f9 ea                 jsr     LOAD_FAC_FROM_YA
f052: a9 00                    lda     #$00            ;and compute COS(x)
f054: 85 a2                    sta     FAC_SIGN
f056: a5 16                    lda     SIGNFLG
f058: 20 62 f0                 jsr     TAN_1           ;weird & dangerous way to get into SIN
f05b: a9 8a                    lda     #TEMP3          ;now form SIN/COS
f05d: a0 00                    ldy     #>TEMP3
f05f: 4c 66 ea                 jmp     FDIV

f062: 48           TAN_1       pha                     ;shame, shame!
f063: 4c 23 f0                 jmp     SIN_1

f066: 81 49 0f da+ CON_PI_HALF .bulk   81490fdaa2
f06b: 83 49 0f da+ CON_PI_DOUB .bulk   83490fdaa2
f070: 7f 00 00 00+ QUARTER     .bulk   7f00000000
f075: 05           POLY_SIN    .dd1    5               ;power of polynomial
f076: 84 e6 1a 2d+             .bulk   84e61a2d1b      ;(2PI)^11/11!
f07b: 86 28 07 fb+             .bulk   862807fbf8      ;(2PI)^9/9!
f080: 87 99 68 89+             .bulk   8799688901      ;(2PI)^7/7!
f085: 87 23 35 df+             .bulk   872335dfe1      ;(2PI)^5/5!
f08a: 86 a5 5d e7+             .bulk   86a55de728      ;(2PI)^3/3!
f08f: 83 49 0f da+             .bulk   83490fdaa2      ;2PI
                   ; <<< next 10 bytes are never referenced >>>
f094: a6 d3 c1 c8+             .rstr   “JNDUHTHAS&”    ;xor with $87 to get "MICROSOFT!"

                   * ATN statement                                                                *
f09e: a5 a2        ATN         lda     FAC_SIGN        ;fold the argument range first
f0a0: 48                       pha                     ;save sign for later unfolding
f0a1: 10 03                    bpl     LF0A6           ;.ge. 0
f0a3: 20 d0 ee                 jsr     NEGOP           ;.lt. 0, so complement
f0a6: a5 9d        LF0A6       lda     FAC             ;if .ge. 1, form reciprocal
f0a8: 48                       pha                     ;save for later unfolding
f0a9: c9 81                    cmp     #$81            ;exponent for .ge. 1
f0ab: 90 07                    bcc     LF0B4           ;x < 1
f0ad: a9 13                    lda     #<CON_ONE       ;form 1/x
f0af: a0 e9                    ldy     #>CON_ONE
f0b1: 20 66 ea                 jsr     FDIV
                   ; 0 <= x <= 1
                   ; 0 <= ATN(x) <= PI/8
f0b4: a9 ce        LF0B4       lda     #<POLY_ATN      ;compute polynomial approximation
f0b6: a0 f0                    ldy     #>POLY_ATN
f0b8: 20 5c ef                 jsr     POLYNOMIAL_ODD
f0bb: 68                       pla                     ;start to unfold
f0bc: c9 81                    cmp     #$81            ;was it .ge. 1?
f0be: 90 07                    bcc     LF0C7           ;no
f0c0: a9 66                    lda     #<CON_PI_HALF   ;yes, subtract from PI/2
f0c2: a0 f0                    ldy     #>CON_PI_HALF
f0c4: 20 a7 e7                 jsr     FSUB
f0c7: 68           LF0C7       pla                     ;was it negative?
f0c8: 10 03                    bpl     RTS_20          ;no
f0ca: 4c d0 ee                 jmp     NEGOP           ;yes, complement

f0cd: 60           RTS_20      rts

f0ce: 0b           POLY_ATN    .dd1    11              ;power of polynomial
f0cf: 76 b3 83 bd+             .bulk   76b383bdd3
f0d4: 79 1e f4 a6+             .bulk   791ef4a6f5
f0d9: 7b 83 fc b0+             .bulk   7b83fcb010
f0de: 7c 0c 1f 67+             .bulk   7c0c1f67ca
f0e3: 7c de 53 cb+             .bulk   7cde53cbc1
f0e8: 7d 14 64 70+             .bulk   7d1464704c
f0ed: 7d b7 ea 51+             .bulk   7db7ea517a
f0f2: 7d 63 30 88+             .bulk   7d6330887e
f0f7: 7e 92 44 99+             .bulk   7e9244993a
f0fc: 7e 4c cc 91+             .bulk   7e4ccc91c7
f101: 7f aa aa aa+             .bulk   7faaaaaa13
f106: 81 00 00 00+             .bulk   8100000000

                   ; Generic copy of CHRGET subroutine, which is copied into $00B1...00C8 during
                   ; initialization.
                   ; Cornelis Bongers described several improvements to CHRGET in Micro magazine or
                   ; Call-A.P.P.L.E. (I don't remember which or exactly when).
f10b: e6 b8                    inc     TXTPTR
f10d: d0 02                    bne     GENERIC_TXTPTR
f10f: e6 b9                    inc     TXTPTR+1
f111: ad 60 ea                 lda     LEA60           ;<<< actual address filled in later >>>
f114: c9 3a                    cmp     #‘:’            ;EOS, also top of numeric range
f116: b0 0a                    bcs     LF122           ;not number, might be EOS
f118: c9 20                    cmp     #‘ ’            ;ignore blanks
f11a: f0 ef                    beq     GENERIC_CHRGET
f11c: 38                       sec                     ;test for numeric range in way that
f11d: e9 30                    sbc     #‘0’            ; clears carry if char is digit
f11f: 38                       sec                     ; and leaves char in A-reg
f120: e9 d0                    sbc     #$d0            ;(should be #-'0')
f122: 60           LF122       rts

                   ; Initial value for random number, also copied in along with CHRGET, but
                   ; erroneously:
                   ; <<< the last byte is not copied >>>
f123: 80 4f c7 52+             .bulk   804fc75258      ;approx. = .811635157

                   • Clear variables
                   LASTPT      .var    $53    {addr/2} ;Overlaps TEMPPT+1

f128: a2 ff        COLD_START  ldx     #$ff            ;set direct mode flag
f12a: 86 76                    stx     CURLIN+1
f12c: a2 fb                    ldx     #$fb            ;set stack pointer, leaving room for
f12e: 9a                       txs                     ; line buffer during parsing
f12f: a9 28                    lda     #<COLD_START    ;set RESTART to COLD_START
f131: a0 f1                    ldy     #>COLD_START    ; until cold start is completed
f133: 85 01                    sta     GOWARM+1
f135: 84 02                    sty     GOWARM+2
f137: 85 04                    sta     GOSTROUT+1      ;also second user vector...
f139: 84 05                    sty     GOSTROUT+2      ;...we simply must finish COLD_START!
f13b: 20 73 f2                 jsr     NORMAL          ;set normal display mode
f13e: a9 4c                    lda     #$4c            ;JMP opcode for 4 vectors
f140: 85 00                    sta     GOWARM          ;warm start
f142: 85 03                    sta     GOSTROUT        ;anyone ever use this one?
f144: 85 90                    sta     JMPADRS         ;used by functions (JMP JMPADRS)
f146: 85 0a                    sta     USRVEC          ;USR function vector
f148: a9 99                    lda     #<IQERR         ;point USR to illegal quantity
f14a: a0 e1                    ldy     #>IQERR         ; error, until user sets it up
f14c: 85 0b                    sta     USRVEC+1
f14e: 84 0c                    sty     USRVEC+2
                   ; Move generic CHRGET and random seed into place
                   ; <<< Note that loop value is wrong!  The last byte of the random seed is not
                   ; copied into page zero! >>>
f150: a2 1c                    ldx     #$1c            ;(should be #GENERIC_END-GENERIC_CHRGET-1)
f152: bd 0a f1     LF152       lda     GENERIC_CHRGET-1,x
f155: 95 b0                    sta     CHRGET-1,x
f157: 86 f1                    stx     SPEEDZ          ;on last pass stores $01
f159: ca                       dex
f15a: d0 f6                    bne     LF152
f15c: 86 f2                    stx     TRCFLG          ;X-reg=0, turn off tracing
f15e: 8a                       txa                     ;A-reg=0
f15f: 85 a4                    sta     SHIFT_SIGN_EXT
f161: 85 54                    sta     LASTPT+1
f163: 48                       pha                     ;put $00 on stack (what for?)
f164: a9 03                    lda     #3              ;set length of temp. string descriptors
f166: 85 8f                    sta     DSCLEN          ;for garbage collection subroutine
f168: 20 fb da                 jsr     CRDO            ;print <return>
f16b: a9 01                    lda     #$01            ;set up fake forward link
f16d: 8d fd 01                 sta     INPUT_BUFFER-3
f170: 8d fc 01                 sta     INPUT_BUFFER-4
f173: a2 55                    ldx     #TEMPST         ;init index to temp string descriptors
f175: 86 52                    stx     TEMPPT
                   ; Find high end of RAM
f177: a9 00                    lda     #$00            ;set up pointer to low end of RAM
f179: a0 08                    ldy     #$08
f17b: 85 50                    sta     LINNUM
f17d: 84 51                    sty     LINNUM+1
f17f: a0 00                    ldy     #$00
f181: e6 51        LF181       inc     LINNUM+1        ;test first byte of each page
f183: b1 50                    lda     (LINNUM),y      ;by complementing it and watching
f185: 49 ff                    eor     #$ff            ; it change the same way
f187: 91 50                    sta     (LINNUM),y
f189: d1 50                    cmp     (LINNUM),y      ;ROM or empty sockets won't track
f18b: d0 08                    bne     LF195           ;not RAM here
f18d: 49 ff                    eor     #$ff            ;restore original value
f18f: 91 50                    sta     (LINNUM),y
f191: d1 50                    cmp     (LINNUM),y      ;did it track again?
f193: f0 ec                    beq     LF181           ;yes, still in RAM
f195: a4 50        LF195       ldy     LINNUM          ;no, end of RAM
f197: a5 51                    lda     LINNUM+1
f199: 29 f0                    and     #$f0            ;force a multiple of 4096 bytes
f19b: 84 73                    sty     MEMSIZE         ;(bad RAM may have yielded a non-multiple)
f19d: 85 74                    sta     MEMSIZE+1
f19f: 84 6f                    sty     FRETOP          ;set HIMEM and bottom of strings
f1a1: 85 70                    sta     FRETOP+1
f1a3: a2 00                    ldx     #$00            ;set program pointer to $0800
f1a5: a0 08                    ldy     #$08
f1a7: 86 67                    stx     TEXTTAB
f1a9: 84 68                    sty     TEXTTAB+1
f1ab: a0 00                    ldy     #$00            ;turn off semi-secret LOCK flag
f1ad: 84 d6                    sty     LOCK
f1af: 98                       tya                     ;A-reg=0 too
f1b0: 91 67                    sta     (TEXTTAB),y     ;first byte in program space = 0
f1b2: e6 67                    inc     TEXTTAB         ;advance past the $00
f1b4: d0 02                    bne     LF1B8
f1b6: e6 68                    inc     TEXTTAB+1
f1b8: a5 67        LF1B8       lda     TEXTTAB
f1ba: a4 68                    ldy     TEXTTAB+1
f1bc: 20 e3 d3                 jsr     REASON          ;set rest of pointers up
f1bf: 20 4b d6                 jsr     SCRTCH          ;more pointers
f1c2: a9 3a                    lda     #<STROUT        ;put correct addresses in two
f1c4: a0 db                    ldy     #>STROUT        ; user vectors
f1c6: 85 04                    sta     GOSTROUT+1
f1c8: 84 05                    sty     GOSTROUT+2
f1ca: a9 3c                    lda     #<RESTART
f1cc: a0 d4                    ldy     #>RESTART
f1ce: 85 01                    sta     GOWARM+1
f1d0: 84 02                    sty     GOWARM+2
f1d2: 6c 01 00                 jmp     (GOWARM+1)      ;silly, why not just "JMP RESTART"

                   * CALL statement                                                               *
                   *                                                                              *
                   * Effectively performs a JSR to the specified address, with the following      *
                   * register contents:                                                           *
                   *                                                                              *
                   *   (A,Y) = call address                                                       *
                   *   X-reg = $9D                                                                *
                   *                                                                              *
                   * The called routine can return with RTS, and Applesoft will continue with the *
                   * next statement.                                                              *
f1d5: 20 67 dd     CALL        jsr     FRMNUM          ;evalute expression for CALL address
f1d8: 20 52 e7                 jsr     GETADR          ;convert expression to 16-bit integer
f1db: 6c 50 00                 jmp     (LINNUM)        ; in LINNUM, and jump there

                   * IN# statement                                                                *
                   *                                                                              *
                   * Note: no check for valid slot #, as long as value is < 256 it is accepted.   *
                   * Monitor masks value to 4 bits (0-15).                                        *
f1de: 20 f8 e6     IN_NUMBER   jsr     GETBYT          ;get slot number in X-reg
f1e1: 8a                       txa                     ;monitor will install in vector
f1e2: 4c 8b fe                 jmp     MON_INPORT      ;at $38,39

                   * PR# statement                                                                *
                   *                                                                              *
                   * Note: no check for valid slot #, as long as value is < 256 it is accepted.   *
                   * Monitor masks value to 4 bits (0-15).                                        *
f1e5: 20 f8 e6     PR_NUMBER   jsr     GETBYT          ;get slot number in X-reg
f1e8: 8a                       txa                     ;monitor will install in vector
f1e9: 4c 95 fe                 jmp     MON_OUTPORT     ;at $36,37

                   ; Get two values < 48, with comma separator
                   ; Called for PLOT X,Y
                   ;        and HLIN A,B at Y
                   ;        and VLIN A,B at X
f1ec: 20 f8 e6     PLOTFNS     jsr     GETBYT          ;get first value in X-reg
f1ef: e0 30                    cpx     #48             ;must be < 48
f1f1: b0 13                    bcs     GOERR           ;too large
f1f3: 86 f0                    stx     FIRST           ;save first value
f1f5: a9 2c                    lda     #‘,’            ;must have a comma
f1f7: 20 c0 de                 jsr     SYNCHR
f1fa: 20 f8 e6                 jsr     GETBYT          ;get second value in X-reg
f1fd: e0 30                    cpx     #48             ;must be < 48
f1ff: b0 05                    bcs     GOERR           ;too large
f201: 86 2c                    stx     MON_H2          ;save second value
f203: 86 2d                    stx     MON_V2
f205: 60                       rts                     ;second value still in X-reg

f206: 4c 99 e1     GOERR       jmp     IQERR           ;illegal quantity error

                   ; Get "A,B at C" values for HLIN and VLIN
                   ; Put smaller of (A,B) in FIRST, and larger of (A,B) in H2 and V2.  Return with
                   ; X-reg = C-value.
f209: 20 ec f1     LINCOOR     jsr     PLOTFNS         ;get A,B values
f20c: e4 f0                    cpx     FIRST           ;is A < B?
f20e: b0 08                    bcs     LF218           ;yes, in right order
f210: a5 f0                    lda     FIRST           ;no, interchange them
f212: 85 2c                    sta     MON_H2
f214: 85 2d                    sta     MON_V2
f216: 86 f0                    stx     FIRST
f218: a9 c5        LF218       lda     #TOK_AT         ;must have AT next
f21a: 20 c0 de                 jsr     SYNCHR
f21d: 20 f8 e6                 jsr     GETBYT          ;get C-value in X-reg
f220: e0 30                    cpx     #48             ;must be < 48
f222: b0 e2                    bcs     GOERR           ;too large
f224: 60                       rts                     ;C-value in X-reg

                   * PLOT statement                                                               *
f225: 20 ec f1     PLOT        jsr     PLOTFNS         ;get X,Y values
f228: 8a                       txa                     ;Y-coord to A-reg for monitor
f229: a4 f0                    ldy     FIRST           ;X-coord to Y-reg for monitor
f22b: c0 28                    cpy     #40             ;X-coord must be < 40
f22d: b0 d7                    bcs     GOERR           ;X-coord is too large
f22f: 4c 00 f8                 jmp     MON_PLOT        ;plot!

                   * HLIN statement                                                               *
f232: 20 09 f2     HLIN        jsr     LINCOOR         ;get "A,B at C"
f235: 8a                       txa                     ;Y-coord in A-reg
f236: a4 2c                    ldy     MON_H2          ;right end of line
f238: c0 28                    cpy     #40             ;must be < 40
f23a: b0 ca                    bcs     GOERR           ;too large
f23c: a4 f0                    ldy     FIRST           ;left end of line in Y-reg
f23e: 4c 19 f8                 jmp     MON_HLINE       ;let monitor draw line

                   * VLIN statement                                                               *
f241: 20 09 f2     VLIN        jsr     LINCOOR         ;get "A,B at C"
f244: 8a                       txa                     ;X-coord in Y-reg
f245: a8                       tay
f246: c0 28                    cpy     #40             ;X-coord must be < 40
f248: b0 bc                    bcs     GOERR           ;too large
f24a: a5 f0                    lda     FIRST           ;top end of line in A-reg
f24c: 4c 28 f8                 jmp     MON_VLINE       ;let monitor draw line

                   * COLOR= statement                                                             *
f24f: 20 f8 e6     COLOR       jsr     GETBYT          ;get color value in X-reg
f252: 8a                       txa
f253: 4c 64 f8                 jmp     MON_SETCOL      ;let monitor store color

                   * VTAB statement                                                               *
f256: 20 f8 e6     VTAB        jsr     GETBYT          ;get line # in X-reg
f259: ca                       dex                     ;convert to zero base
f25a: 8a                       txa
f25b: c9 18                    cmp     #24             ;must be 0-23
f25d: b0 a7                    bcs     GOERR           ;too large, or was "VTAB 0"
f25f: 4c 5b fb                 jmp     MON_TABV        ;let monitor compute base

                   * SPEED= statement                                                             *
f262: 20 f8 e6     SPEED       jsr     GETBYT          ;get speed setting in X-reg
f265: 8a                       txa                     ;SPEEDZ = $100 - speed
f266: 49 ff                    eor     #$ff            ;so "SPEED=255" is fastest
f268: aa                       tax
f269: e8                       inx
f26a: 86 f1                    stx     SPEEDZ
f26c: 60                       rts

                   * TRACE statement                                                              *
                   *                                                                              *
                   * Set sign bit in TRCFLG.                                                      *
f26d: 38           TRACE       sec
f26e: 90                       bcc ▼   HIMEM+2         ;fake BCC to skip next opcode
                   * NOTRACE statement                                                            *
f26f: 18           NOTRACE     clc
f270: 66 f2                    ror     TRCFLG          ;shift carry into TRCFLG
f272: 60                       rts

                   * NORMAL statement                                                             *
f273: a9 ff        NORMAL      lda     #$ff            ;set INVFLG = $FF
f275: d0 02                    bne     N_I_            ;and FLASH_BIT = $00

                   * INVERSE statement                                                            *
f277: a9 3f        INVERSE     lda     #$3f            ;set INVFLG = $3F
f279: a2 00        N_I_        ldx     #$00            ;and FLASH_BIT = $00
f27b: 85 32        N_I_F_      sta     MON_INVFLAG
f27d: 86 f3                    stx     FLASH_BIT
f27f: 60                       rts

                   * FLASH statement                                                              *
f280: a9 7f        FLASH       lda     #$7f            ;set INVFLG = $7F
f282: a2 40                    ldx     #$40            ;and FLASH_BIT = $40
f284: d0 f5                    bne     N_I_F_          ;...always

                   * HIMEM: statement                                                             *
f286: 20 67 dd     HIMEM       jsr     FRMNUM          ;get value specified for HIMEM
f289: 20 52 e7                 jsr     GETADR          ; as 16-bit integer
f28c: a5 50                    lda     LINNUM          ;must be above variables and arrays
f28e: c5 6d                    cmp     STREND
f290: a5 51                    lda     LINNUM+1
f292: e5 6e                    sbc     STREND+1
f294: b0 03                    bcs     SETHI           ;it is above them
f296: 4c 10 d4     JMM         jmp     MEMERR          ;not enough memory

f299: a5 50        SETHI       lda     LINNUM          ;store new HIMEM: value
f29b: 85 73                    sta     MEMSIZE
f29d: 85 6f                    sta     FRETOP          ;<<<note that HIMEM: does not>>>
f29f: a5 51                    lda     LINNUM+1        ;<<<clear string variables.  >>>
f2a1: 85 74                    sta     MEMSIZE+1       ;<<<this could be disastrous.>>>
f2a3: 85 70                    sta     FRETOP+1
f2a5: 60                       rts

                   * LOMEM: statement                                                             *
f2a6: 20 67 dd     LOMEM       jsr     FRMNUM          ;get value specified for LOMEM
f2a9: 20 52 e7                 jsr     GETADR          ; as 16-bit integer in LINNUM
f2ac: a5 50                    lda     LINNUM          ;must be below HIMEM
f2ae: c5 73                    cmp     MEMSIZE
f2b0: a5 51                    lda     LINNUM+1
f2b2: e5 74                    sbc     MEMSIZE+1
f2b4: b0 e0                    bcs     JMM             ;above HIMEM, memory error
f2b6: a5 50                    lda     LINNUM          ;must be above program
f2b8: c5 69                    cmp     VARTAB
f2ba: a5 51                    lda     LINNUM+1
f2bc: e5 6a                    sbc     VARTAB+1
f2be: 90 d6                    bcc     JMM             ;not above program, error
f2c0: a5 50                    lda     LINNUM          ;store new LOMEM value
f2c2: 85 69                    sta     VARTAB
f2c4: a5 51                    lda     LINNUM+1
f2c6: 85 6a                    sta     VARTAB+1
f2c8: 4c 6c d6                 jmp     CLEARC          ;LOMEM clears variables and arrays

                   * ONERR statement                                                              *
f2cb: a9 ab        ONERR       lda     #TOK_GOTO       ;must be GOTO next
f2cd: 20 c0 de                 jsr     SYNCHR
f2d0: a5 b8                    lda     TXTPTR          ;save TXTPTR for HANDLERR
f2d2: 85 f4                    sta     TXTPSV
f2d4: a5 b9                    lda     TXTPTR+1
f2d6: 85 f5                    sta     TXTPSV+1
f2d8: 38                       sec                     ;set sign bit of ERRFLG
f2d9: 66 d8                    ror     ERRFLG
f2db: a5 75                    lda     CURLIN          ;save line # of current line
f2dd: 85 f6                    sta     CURLSV
f2df: a5 76                    lda     CURLIN+1
f2e1: 85 f7                    sta     CURLSV+1
f2e3: 20 a6 d9                 jsr     REMN            ;ignore rest of line <<<why?>>>
f2e6: 4c 98 d9                 jmp     ADDON           ;continue program

                   ; Routine to handle errors if ONERR GOTO active.
f2e9: 86 de        HANDLERR    stx     ERRNUM          ;save error code number
f2eb: a6 f8                    ldx     REMSTK          ;get stack ptr saved at NEWSTT
f2ed: 86 df                    stx     ERRSTK          ;remember it
                   ; <<<could also have done TXS here; see ONERR correction in Applesoft manual.>>>
f2ef: a5 75                    lda     CURLIN          ;get line # of offending statement
f2f1: 85 da                    sta     ERRLIN          ;so user can see it if desired
f2f3: a5 76                    lda     CURLIN+1
f2f5: 85 db                    sta     ERRLIN+1
f2f7: a5 79                    lda     OLDTEXT         ;also the position in the line
f2f9: 85 dc                    sta     ERRPOS          ;in case user wants to RESUME
f2fb: a5 7a                    lda     OLDTEXT+1
f2fd: 85 dd                    sta     ERRPOS+1
f2ff: a5 f4                    lda     TXTPSV          ;set up TXTPTR to read target line #
f301: 85 b8                    sta     TXTPTR          ;in "ON ERR GO TO xxxx"
f303: a5 f5                    lda     TXTPSV+1
f305: 85 b9                    sta     TXTPTR+1
f307: a5 f6                    lda     CURLSV          ;line # of "ON ERR" statement
f309: 85 75                    sta     CURLIN
f30b: a5 f7                    lda     CURLSV+1
f30d: 85 76                    sta     CURLIN+1
f30f: 20 b7 00                 jsr     CHRGOT          ;start conversion
f312: 20 3e d9                 jsr     GOTO            ;goto specified ONERR line
f315: 4c d2 d7                 jmp     NEWSTT

                   * RESUME statement                                                             *
f318: a5 da        RESUME      lda     ERRLIN          ;restore line # and TXTPTR
f31a: 85 75                    sta     CURLIN          ; to re-try offending line
f31c: a5 db                    lda     ERRLIN+1
f31e: 85 76                    sta     CURLIN+1
f320: a5 dc                    lda     ERRPOS
f322: 85 b8                    sta     TXTPTR
f324: a5 dd                    lda     ERRPOS+1
f326: 85 b9                    sta     TXTPTR+1
                   ; <<< ONERR correction in manual is easily by CALL -3288, which is $F328 here.
                   ; >>>
f328: a6 df                    ldx     ERRSTK          ;retrieve stack ptr as it was
f32a: 9a                       txs                     ; before statement scanned
f32b: 4c d2 d7                 jmp     NEWSTT          ;do statement again

f32e: 4c c9 de     JSYN        jmp     SYNERR

                   * DEL statement                                                                *
                   • Clear variables

f331: b0 fb        DEL         bcs     JSYN            ;error if # not specified
f333: a6 af                    ldx     PRGEND
f335: 86 69                    stx     VARTAB
f337: a6 b0                    ldx     PRGEND+1
f339: 86 6a                    stx     VARTAB+1
f33b: 20 0c da                 jsr     LINGET          ;get beginning of range
f33e: 20 1a d6                 jsr     FNDLIN          ;find this line or next
f341: a5 9b                    lda     LOWTR           ;upper portion of program will
f343: 85 60                    sta     DEST            ;be moved down to here
f345: a5 9c                    lda     LOWTR+1
f347: 85 61                    sta     DEST+1
f349: a9 2c                    lda     #‘,’            ;must have a comma next
f34b: 20 c0 de                 jsr     SYNCHR
f34e: 20 0c da                 jsr     LINGET          ;get end range (does nothing if end range is not specified)
f351: e6 50                    inc     LINNUM          ;point one past it
f353: d0 02                    bne     LF357
f355: e6 51                    inc     LINNUM+1
f357: 20 1a d6     LF357       jsr     FNDLIN          ;find start line after specified line
f35a: a5 9b                    lda     LOWTR           ;which is beginning of portion
f35c: c5 60                    cmp     DEST            ;to be moved down
f35e: a5 9c                    lda     LOWTR+1         ;it must be above the target
f360: e5 61                    sbc     DEST+1
f362: b0 01                    bcs     LF365           ;it is okay
f364: 60                       rts                     ;nothing to delete

f365: a0 00        LF365       ldy     #$00            ;move upper portion down now
f367: b1 9b        LF367       lda     (LOWTR),y       ;source...
f369: 91 60                    sta     (DEST),y        ; destination
f36b: e6 9b                    inc     LOWTR           ;bump source ptr
f36d: d0 02                    bne     LF371
f36f: e6 9c                    inc     LOWTR+1
f371: e6 60        LF371       inc     DEST            ;bump destination ptr
f373: d0 02                    bne     LF377
f375: e6 61                    inc     DEST+1
f377: a5 69        LF377       lda     VARTAB          ;reached end of program yet?
f379: c5 9b                    cmp     LOWTR
f37b: a5 6a                    lda     VARTAB+1
f37d: e5 9c                    sbc     LOWTR+1
f37f: b0 e6                    bcs     LF367           ;no, keep moving
f381: a6 61                    ldx     DEST+1          ;store new end of program
f383: a4 60                    ldy     DEST            ;must subtract 1 first
f385: d0 01                    bne     LF388
f387: ca                       dex
f388: 88           LF388       dey
f389: 86 6a                    stx     VARTAB+1
f38b: 84 69                    sty     VARTAB
f38d: 4c f2 d4                 jmp     FIX_LINKS       ;reset links after a delete

                   * GR statement                                                                 *
f390: ad 56 c0     GR          lda     LORES
f393: ad 53 c0                 lda     MIXSET
f396: 4c 40 fb                 jmp     MON_SETGR

                   * TEXT statement                                                               *
                   *                                                                              *
                   * <<< better code would be:                                                    *
                   *   LDA MIXSET                                                                 *
                   *   JMP $FB33                                                                  *
                   * >>>                                                                          *
f399: ad 54 c0     TEXT        lda     TXTPAGE1        ;JMP $FB36 would have
f39c: 4c 39 fb                 jmp     MON_SETTXT      ; done both of these

                   * STORE statement                                                              *
f39f: 20 d9 f7     STORE       jsr     GETARYPT        ;get address of array to be saved
f3a2: a0 03                    ldy     #$03            ;forward offset - 1 is size of
f3a4: b1 9b                    lda     (LOWTR),y       ; this array
f3a6: aa                       tax
f3a7: 88                       dey
f3a8: b1 9b                    lda     (LOWTR),y
f3aa: e9 01                    sbc     #$01
f3ac: b0 01                    bcs     LF3AF
f3ae: ca                       dex
f3af: 85 50        LF3AF       sta     LINNUM
f3b1: 86 51                    stx     LINNUM+1
f3b3: 20 cd fe                 jsr     MON_WRITE
f3b6: 20 bc f7                 jsr     TAPEPNT
f3b9: 4c cd fe                 jmp     MON_WRITE

                   * RECALL statement                                                             *
f3bc: 20 d9 f7     RECALL      jsr     GETARYPT        ;find array in memory
f3bf: 20 fd fe                 jsr     MON_READ        ;read header
f3c2: a0 02                    ldy     #$02            ;make sure the new data fits
f3c4: b1 9b                    lda     (LOWTR),y
f3c6: c5 50                    cmp     LINNUM
f3c8: c8                       iny
f3c9: b1 9b                    lda     (LOWTR),y
f3cb: e5 51                    sbc     LINNUM+1
f3cd: b0 03                    bcs     LF3D2           ;it fits
f3cf: 4c 10 d4                 jmp     MEMERR          ;doesn't fit

f3d2: 20 bc f7     LF3D2       jsr     TAPEPNT         ;read the data
f3d5: 4c fd fe                 jmp     MON_READ

                   * HGR2 statement                                                               *
f3d8: 2c 55 c0     HGR2        bit     TXTPAGE2        ;select page 2 ($4000-5FFF)
f3db: 2c 52 c0                 bit     MIXCLR          ;default to full screen
f3de: a9 40                    lda     #$40            ;set starting page for hi-res
f3e0: d0 08                    bne     SETHPG          ;...always

                   * HGR statement                                                                *
f3e2: a9 20        HGR         lda     #$20            ;set starting page for hi-res
f3e4: 2c 54 c0                 bit     TXTPAGE1        ;select page 1 ($2000-3FFF)
f3e7: 2c 53 c0                 bit     MIXSET          ;default to mixed screen
f3ea: 85 e6        SETHPG      sta     HGR_PAGE        ;base page of hi-res buffer
f3ec: ad 57 c0                 lda     HIRES           ;turn on hi-res
f3ef: ad 50 c0                 lda     TXTCLR          ;turn on graphics
                   ; Clear screen.
f3f2: a9 00                    lda     #$00            ;set for black background
f3f4: 85 1c                    sta     HGR_BITS
                   ; Fill screen with HGR_BITS.
f3f6: a5 e6        BKGND       lda     HGR_PAGE        ;put buffer address in HGR_SHAPE
f3f8: 85 1b                    sta     HGR_SHAPE+1
f3fa: a0 00                    ldy     #$00
f3fc: 84 1a                    sty     HGR_SHAPE
f3fe: a5 1c        LF3FE       lda     HGR_BITS        ;color byte
f400: 91 1a                    sta     (HGR_SHAPE),y   ;clear hi-res to HGR_BITS
f402: 20 7e f4                 jsr     COLOR_SHIFT     ;correct for color shift
f405: c8                       iny                     ;(slows clear by factor of 2)
f406: d0 f6                    bne     LF3FE
f408: e6 1b                    inc     HGR_SHAPE+1
f40a: a5 1b                    lda     HGR_SHAPE+1
f40c: 29 1f                    and     #$1f            ;done? ($40 or $60)
f40e: d0 ee                    bne     LF3FE           ;no
f410: 60                       rts                     ;yes, return

                   ; Set the hi-res cursor position.
                   ;   (Y,X) = horizontal coordinate (0-279)
                   ;   A-reg = vertical coordinate   (0-191)
f411: 85 e2        HPOSN       sta     HGR_Y           ;save Y- and X-positions
f413: 86 e0                    stx     HGR_X
f415: 84 e1                    sty     HGR_X+1
f417: 48                       pha                     ;Y-pos also on stack
f418: 29 c0                    and     #$c0            ;calculate base address for Y-pos
f41a: 85 26                    sta     HBASL           ;for Y=ABCDEFGH
f41c: 4a                       lsr     A               ;HBASL=ABAB0000
f41d: 4a                       lsr     A
f41e: 05 26                    ora     HBASL
f420: 85 26                    sta     HBASL
f422: 68                       pla                     ;     A        HBASH     HBASL
f423: 85 27                    sta     HBASH           ;?-ABCDEFGH  ABCDEFGH  ABAB0000
f425: 0a                       asl     A               ;A-BCDEFGH0  ABCDEFGH  ABAB0000
f426: 0a                       asl     A               ;B-CDEFGH00  ABCDEFGH  ABAB0000
f427: 0a                       asl     A               ;C-DEFGH000  ABCDEFGH  ABAB0000
f428: 26 27                    rol     HBASH           ;A-DEFGH000  BCDEFGHC  ABAB0000
f42a: 0a                       asl     A               ;D-EFGH0000  BCDEFGHC  ABAB0000
f42b: 26 27                    rol     HBASH           ;B-EFGH0000  CDEFGHCD  ABAB0000
f42d: 0a                       asl     A               ;E-FGH00000  CDEFGHCD  ABAB0000
f42e: 66 26                    ror     HBASL           ;0-FGH00000  CDEFGHCD  EABAB000
f430: a5 27                    lda     HBASH           ;0-CDEFGHCD  CDEFGHCD  EABAB000
f432: 29 1f                    and     #$1f            ;0-000FGHCD  CDEFGHCD  EABAB000
f434: 05 e6                    ora     HGR_PAGE        ;0-PPPFGHCD  CDEFGHCD  EABAB000
f436: 85 27                    sta     HBASH           ;0-PPPFGHCD  PPPFGHCD  EABAB000
f438: 8a                       txa                     ;divide X-pos by 7 for index from base
f439: c0 00                    cpy     #$00            ;is X-pos < 256?
f43b: f0 05                    beq     LF442           ;yes
                   ; no: 256/7 = 36 rem 4
                   ; carry=1, so ADC #4 is too large; however, ADC #4 clears carry which makes SBC
                   ; #7 only -6, balancing it out.
f43d: a0 23                    ldy     #35
f43f: 69 04                    adc     #$04            ;following INY makes Y=36
f441: c8           LF441       iny
f442: e9 07        LF442       sbc     #$07
f444: b0 fb                    bcs     LF441
f446: 84 e5                    sty     HGR_HORIZ       ;horizontal index
f448: aa                       tax                     ;use remainder-7 to look up the
f449: bd b9 f4                 lda     MSKTBL-249,x    ; bit mask (should be MSKTBL-$100+7,X)
f44c: 85 30                    sta     HMASK
f44e: 98                       tya                     ;quotient gives byte index
f44f: 4a                       lsr     A               ;odd or even column?
f450: a5 e4                    lda     HGR_COLOR       ;if on odd byte (carry set)
f452: 85 1c                    sta     HGR_BITS        ; then rotate bits
f454: b0 28                    bcs     COLOR_SHIFT     ;odd column
f456: 60                       rts                     ;even column

                   ; Plot a dot
                   ;   (Y,X) = horizontal position
                   ;   A-reg = vertical position
f457: 20 11 f4     HPLOT0      jsr     HPOSN
f45a: a5 1c                    lda     HGR_BITS        ;calculate bit posn in GBAS,
f45c: 51 26                    eor     (HBASL),y       ; HGR_HORIZ, and HMASK from
f45e: 25 30                    and     HMASK           ; Y-coord in A-reg,
f460: 51 26                    eor     (HBASL),y       ; X-coord in X,Y regs.
f462: 91 26                    sta     (HBASL),y       ;for any 1-bits, substitute
f464: 60                       rts                     ; corresponding bit of HGR_BITS

                   ; Move left or right one pixel.
                   ; If status is +, move right; if -, move left
                   ; If already at left or right edge, wrap around
                   ; Remember bits in hi-res byte are backwards order:
                   ;   byte N  byte N+1
                   ; S7654321  SEDCBA98
f465: 10 23                    bpl     MOVE_RIGHT      ;+ move right, - move left
f467: a5 30                    lda     HMASK           ;move left one pixel
f469: 4a                       lsr     A               ;shift mask right, moves dot left
f46a: b0 05                    bcs     LR_2            ; moved to next byte
f46c: 49 c0                    eor     #$c0            ;move sign bit back where it was
f46e: 85 30        LR_1        sta     HMASK           ;new mask value
f470: 60                       rts

f471: 88           LR_2        dey                     ;moved to next byte, so decr index
f472: 10 02                    bpl     LR_3            ;still not past edge
f474: a0 27                    ldy     #39             ;off left edge, so wrap around screen
f476: a9 c0        LR_3        lda     #$c0            ;new HMASK, rightmost bit on screen
f478: 85 30        LR_4        sta     HMASK           ;new mask and index
f47a: 84 e5                    sty     HGR_HORIZ
f47c: a5 1c                    lda     HGR_BITS        ;also need to rotate color
f47e: 0a           COLOR_SHIFT asl     A               ;rotate low-order 7 bits
f47f: c9 c0                    cmp     #$c0            ; of HGR_BITS one bit posn
f481: 10 06                    bpl     LF489
f483: a5 1c                    lda     HGR_BITS
f485: 49 7f                    eor     #$7f
f487: 85 1c                    sta     HGR_BITS
f489: 60           LF489       rts

                   ; Move right one pixel.
                   ; If already at right edge, wrap around.
f48a: a5 30        MOVE_RIGHT  lda     HMASK
f48c: 0a                       asl     A               ;shifting byte left moves pixel right
f48d: 49 80                    eor     #$80
                   ; Original:  C0 A0 90 88 84 82 81
                   ; Shifted:   80 40 20 10 08 02 01
                   ; EOR #$80:  00 C0 A0 90 88 84 82
f48f: 30 dd                    bmi     LR_1            ;finished
f491: a9 81                    lda     #$81            ;new mask value
f493: c8                       iny                     ;move to next byte right
f494: c0 28                    cpy     #40             ;unless that is too far
f496: 90 e0                    bcc     LR_4            ;not too far
f498: a0 00                    ldy     #$00            ;too far, so wrap around
f49a: b0 dc                    bcs     LR_4            ;...always

                   ; "XDRAW" one bit
f49c: 18           LRUDX1      clc                     ;C=0 means no 90 degree rotation
f49d: a5 d1        LRUDX2      lda     HGR_DX+1        ;C=1 means rotate 90 degrees
f49f: 29 04                    and     #$04            ;if bit2=0 then don't plot
f4a1: f0 25                    beq     LRUD4           ;yes, do not plot
f4a3: a9 7f                    lda     #$7f            ;no, look at what is already there
f4a5: 25 30                    and     HMASK
f4a7: 31 26                    and     (HBASL),y       ;screen bit = 1?
f4a9: d0 19                    bne     LRUD3           ;yes, go clear it
f4ab: e6 ea                    inc     HGR_COLLISIONS  ;no, count the collision
f4ad: a9 7f                    lda     #$7f            ;and turn the bit on
f4af: 25 30                    and     HMASK
f4b1: 10 11                    bpl     LRUD3           ;...always

                   ; "DRAW" one bit
f4b3: 18           LRUD1       clc                     ;C=0 means no 90 degree rotation
f4b4: a5 d1        LRUD2       lda     HGR_DX+1        ;C=1 means rotate
f4b6: 29 04                    and     #$04            ;if bit2=0 then do not plot
f4b8: f0 0e                    beq     LRUD4           ;do not plot
f4ba: b1 26                    lda     (HBASL),y
f4bc: 45 1c                    eor     HGR_BITS        ;1's where any bits not in color
f4be: 25 30                    and     HMASK           ;look at just this bit position
f4c0: d0 02                    bne     LRUD3           ;the bit was zero, so plot it
f4c2: e6 ea                    inc     HGR_COLLISIONS  ;bit is already 1; count collsn
                   ; Toggle bit on screen with A-reg.
f4c4: 51 26        LRUD3       eor     (HBASL),y
f4c6: 91 26                    sta     (HBASL),y
                   ; Determine where next point will be, and move there.
                   ;   C=0 if no 90 degree rotation
                   ;   C=1 rotates 90 degrees
f4c8: a5 d1        LRUD4       lda     HGR_DX+1        ;calculate the direction to move
f4ca: 65 d3                    adc     HGR_QUAD
f4cc: 29 03        CON_03      and     #$03            ;wrap around the circle
                   ;   00 - up
                   ;   01 - down
                   ;   10 - right
                   ;   11 - left
f4ce: c9 02                    cmp     #$02            ;C=0 if 0 or 1, C=1 if 2 or 3
f4d0: 6a                       ror     A               ;put C into sign, odd/even into C
f4d1: b0 92                    bcs     MOVE_LEFT_OR_RIGHT
f4d3: 30 30                    bmi     MOVE_DOWN       ;sign for up/down select
                   ; Move up one pixel
                   ; If already at top, go to bottom.
                   ; Remember:  Y-coord   HBASH     HBASL
                   ;           ABCDEFGH  PPPFGHCD  EABAB000
f4d5: 18                       clc                     ;move up
f4d6: a5 27                    lda     HBASH           ;calc base address of prev line
f4d8: 2c b9 f5                 bit     CON_1C          ;look at bits 000FGH00 in HBASH
f4db: d0 22                    bne     LF4FF           ;simple , just FGH=FGH-1; GBASH=PPP000CD, GBASL=EABAB000
f4dd: 06 26                    asl     HBASL           ;what is "E"?
f4df: b0 1a                    bcs     LF4FB           ;E=1, then EFGH=EFGH-1
f4e1: 2c cd f4                 bit     CON_03+1        ;look at 000000CD in HBASH
f4e4: f0 05                    beq     LF4EB           ;Y-pos is AB000000 form
f4e6: 69 1f                    adc     #$1f            ;CD <> 0, so CDEFGH=CDEFGH-1
f4e8: 38                       sec
f4e9: b0 12                    bcs     LF4FD           ;...always

f4eb: 69 23        LF4EB       adc     #$23            ;enough to make HBASH=PPP11111 later
f4ed: 48                       pha                     ;save for later
f4ee: a5 26                    lda     HBASL           ;HBASL is now ABAB0000 (AB=00,01,10)
                   ;    0000+1011=1011 and carry clear
                   ; or 0101+1011=0000 and carry set
                   ; or 1010+1011=0101 and carry set
f4f0: 69 b0                    adc     #$b0
f4f2: b0 02                    bcs     LF4F6           ;no wrap-around needed
f4f4: 69 f0                    adc     #$f0            ;change 1011 to 1010 (wrap-around)
f4f6: 85 26        LF4F6       sta     HBASL           ;form is now still ABAB0000
f4f8: 68                       pla                     ;partially modified HBASH
f4f9: b0 02                    bcs     LF4FD           ;...always

f4fb: 69 1f        LF4FB       adc     #$1f
f4fd: 66 26        LF4FD       ror     HBASL           ;shift in E, to get EABAB000 form
f4ff: 69 fc        LF4FF       adc     #$fc            ;finish HBASH mods
f501: 85 27        UD_1        sta     HBASH
f503: 60                       rts

f504: 18                       .dd1    $18             ;<<< never used >>>

                   ; Move down one pixel
                   ; If already at bottom, go to top.
                   ; Remember:  Y-coord   HBASH     HBASL
                   ;           ABCDEFGH  PPPFGHCD  EABAB000
f505: a5 27        MOVE_DOWN   lda     HBASH           ;try it first, by FGH=FGH+1
f507: 69 04        CON_04      adc     #$04            ;HBASH = PPPFGHCD
f509: 2c b9 f5                 bit     CON_1C          ;is FGH field now zero?
f50c: d0 f3                    bne     UD_1            ;no so we are finished
f50e: 06 26                    asl     HBASL           ;yes, ripple the carry as high as necessary; look at "E" bit
f510: 90 18                    bcc     LF52A           ;now zero; make it 1 and leave
f512: 69 e0                    adc     #$e0            ;carry = 1, so adds $E1
f514: 18                       clc                     ;is "CD" not zero?
f515: 2c 08 f5                 bit     CON_04+1        ;tests bit 2 for carry out of "CD"
f518: f0 12                    beq     LF52C           ;no carry, finished
                   ; increment "AB" then
                   ; 0000 --> 0101
                   ; 0101 --> 1010
                   ; 1010 --> wrap around to line 0
f51a: a5 26                    lda     HBASL           ;0000  0101  1010
f51c: 69 50                    adc     #$50            ;0101  1010  1111
f51e: 49 f0                    eor     #$f0            ;1010  0101  0000
f520: f0 02                    beq     LF524
f522: 49 f0                    eor     #$f0            ;0101  1010
f524: 85 26        LF524       sta     HBASL           ;new ABAB0000
f526: a5 e6                    lda     HGR_PAGE        ;wrap around to line zero of group
f528: 90 02                    bcc     LF52C           ;...always
f52a: 69 e0        LF52A       adc     #$e0
f52c: 66 26        LF52C       ror     HBASL
f52e: 90 d1                    bcc     UD_1            ;...always

                   ; HLINRL
                   ; (never called by Applesoft)
                   ; Enter with: (A,X) = DX from current point
                   ;             Y-reg = DY from current point
f530: 48                       pha                     ;save A-reg
f531: a9 00                    lda     #$00            ;clear current point so HGLIN will
f533: 85 e0                    sta     HGR_X           ; act relatively
f535: 85 e1                    sta     HGR_X+1
f537: 85 e2                    sta     HGR_Y
f539: 68                       pla                     ;restore A-reg
                   ; Draw line from last plotted point to (A,X),Y
                   ; Enter with: (A,X) = X of target point
                   ;             Y-reg = Y of target point
f53a: 48           HGLIN       pha                     ;compute DX = X - X0
f53b: 38                       sec
f53c: e5 e0                    sbc     HGR_X
f53e: 48                       pha
f53f: 8a                       txa
f540: e5 e1                    sbc     HGR_X+1
f542: 85 d3                    sta     HGR_QUAD        ;save DX sign (+ = right, - = left)
f544: b0 0a                    bcs     LF550           ;now find abs(DX)
f546: 68                       pla                     ;forms 2's complement
f547: 49 ff                    eor     #$ff
f549: 69 01                    adc     #$01
f54b: 48                       pha
f54c: a9 00                    lda     #$00
f54e: e5 d3                    sbc     HGR_QUAD
f550: 85 d1        LF550       sta     HGR_DX+1
f552: 85 d5                    sta     HGR_E+1         ;init HGR_E to abs(X-X0)
f554: 68                       pla
f555: 85 d0                    sta     HGR_DX
f557: 85 d4                    sta     HGR_E
f559: 68                       pla
f55a: 85 e0                    sta     HGR_X           ;target X point
f55c: 86 e1                    stx     HGR_X+1
f55e: 98                       tya                     ;target Y point
f55f: 18                       clc                     ;compute DY = Y - HGR_Y
f560: e5 e2                    sbc     HGR_Y           ; and save -abs(Y - HGR_Y) - 1 in HGR_DY
f562: 90 04                    bcc     LF568           ;(so + means up, - means down)
f564: 49 ff                    eor     #$ff            ;2's complement of DY
f566: 69 fe                    adc     #$fe
f568: 85 d2        LF568       sta     HGR_DY
f56a: 84 e2                    sty     HGR_Y           ;target Y point
f56c: 66 d3                    ror     HGR_QUAD        ;shift Y-direction into quadrant
f56e: 38                       sec                     ;count = DX - (-DY) = # of dots needed
f56f: e5 d0                    sbc     HGR_DX
f571: aa                       tax                     ;countl is in X-reg
f572: a9 ff                    lda     #$ff
f574: e5 d1                    sbc     HGR_DX+1
f576: 85 1d                    sta     HGR_COUNT
f578: a4 e5                    ldy     HGR_HORIZ       ;horizontal index
f57a: b0 05                    bcs     MOVEX2          ;...always

                   ; Move left or right one pixel.  A-reg bit 6 has direction.
f57c: 0a           MOVEX       asl     A               ;put bit 6 into sign position
f57d: 20 65 f4                 jsr     MOVE_LEFT_OR_RIGHT
f580: 38                       sec
                   ; Draw line now.
f581: a5 d4        MOVEX2      lda     HGR_E           ;carry is set
f583: 65 d2                    adc     HGR_DY          ;E = E - deltaY
f585: 85 d4                    sta     HGR_E           ;note: DY is (-delta Y)-1
f587: a5 d5                    lda     HGR_E+1         ;carry clr if HGR_E goes negative
f589: e9 00                    sbc     #$00
f58b: 85 d5        LF58B       sta     HGR_E+1
f58d: b1 26                    lda     (HBASL),y
f58f: 45 1c                    eor     HGR_BITS        ;plot a dot
f591: 25 30                    and     HMASK
f593: 51 26                    eor     (HBASL),y
f595: 91 26                    sta     (HBASL),y
f597: e8                       inx                     ;finished all the dots?
f598: d0 04                    bne     LF59E           ;no
f59a: e6 1d                    inc     HGR_COUNT       ;test rest of count
f59c: f0 62                    beq     RTS_22          ;yes, finished
f59e: a5 d3        LF59E       lda     HGR_QUAD        ;test direction
f5a0: b0 da                    bcs     MOVEX           ;next move is in the X direction
f5a2: 20 d3 f4                 jsr     MOVE_UP_OR_DOWN ;if clr, neg, move
f5a5: 18                       clc                     ;E = E + DX
f5a6: a5 d4                    lda     HGR_E
f5a8: 65 d0                    adc     HGR_DX
f5aa: 85 d4                    sta     HGR_E
f5ac: a5 d5                    lda     HGR_E+1
f5ae: 65 d1                    adc     HGR_DX+1
f5b0: 50 d9                    bvc     LF58B           ;...always

f5b2: 81 82 84 88+ MSKTBL      .bulk   8182848890a0c0
f5b9: 1c           CON_1C      .dd1    $1c             ;mask for "FGH" bits
                   ; Table of COS(90*x/16 degrees)*$100 - 1, with one-byte precision, X=0 to 16
f5ba: ff fe fa f4+             .bulk   fffefaf4ece1d4c5b4a18d7861493118ff

                   ; HFIND - calculates current position of hi-res cursor
                   ; (not called by any Applesoft routine)
                   ; Calculate Y-coord from HBASH,L
                   ;       and X-coord from HORIZ and HMASK
f5cb: a5 26                    lda     HBASL           ;HBASL = EABAB000
f5cd: 0a                       asl     A               ;E into carry
f5ce: a5 27                    lda     HBASH           ;HBASH = PPPFGHCD
f5d0: 29 03                    and     #$03            ;000000CD
f5d2: 2a                       rol     A               ;00000CDE
f5d3: 05 26                    ora     HBASL           ;EABABCDE
f5d5: 0a                       asl     A               ;ABABCDE0
f5d6: 0a                       asl     A               ;BABCDE00
f5d7: 0a                       asl     A               ;ABCDE000
f5d8: 85 e2                    sta     HGR_Y           ;all but FGH
f5da: a5 27                    lda     HBASH           ;PPPFGHCD
f5dc: 4a                       lsr     A               ;0PPPFGHC
f5dd: 4a                       lsr     A               ;00PPPFGH
f5de: 29 07                    and     #$07            ;00000FGH
f5e0: 05 e2                    ora     HGR_Y           ;ABCDEFGH
f5e2: 85 e2                    sta     HGR_Y           ;that takes care of Y-coordinate
f5e4: a5 e5                    lda     HGR_HORIZ       ;X = 7*HORIZ + bit pos in HMASK
f5e6: 0a                       asl     A               ;multiply by 7
f5e7: 65 e5                    adc     HGR_HORIZ       ;3* so far
f5e9: 0a                       asl     A               ;6*
f5ea: aa                       tax                     ;since 7* might not fit in 1 byte,
f5eb: ca                       dex                     ; wait till later for last add
f5ec: a5 30                    lda     HMASK           ;now find bit position in HMASK
f5ee: 29 7f                    and     #$7f            ;only look at low seven
f5f0: e8           LF5F0       inx                     ;count a shift
f5f1: 4a                       lsr     A
f5f2: d0 fc                    bne     LF5F0           ;still in there
f5f4: 85 e1                    sta     HGR_X+1         ;zero to hi byte
f5f6: 8a                       txa                     ;6*HORIZ + log2(HMASK)
f5f7: 18                       clc                     ;add HORIZ one more time
f5f8: 65 e5                    adc     HGR_HORIZ       ;7*HORIZ + log2(HMASK)
f5fa: 90 02                    bcc     LF5FE           ;upper byte = 0
f5fc: e6 e1                    inc     HGR_X+1         ;upper byte = 1
f5fe: 85 e0        LF5FE       sta     HGR_X           ;store lower byte
f600: 60           RTS_22      rts

                   ; DRAW0
                   ; (not called by Applesoft)
f601: 86 1a                    stx     HGR_SHAPE       ;save shape address
f603: 84 1b                    sty     HGR_SHAPE+1
                   ; Draw a shape
                   ;   (Y,X) = shape starting address
                   ;   A-reg = rotation ($00-3F)
f605: aa           DRAW1       tax                     ;save rotation ($00-3F)
f606: 4a                       lsr     A               ;divide rotation by 16 to get
f607: 4a                       lsr     A               ; quadrant (0=up, 1=rt, 2=dwn, 3=lft)
f608: 4a                       lsr     A
f609: 4a                       lsr     A
f60a: 85 d3                    sta     HGR_QUAD
f60c: 8a                       txa                     ;use low 4 bits of rotation to index
f60d: 29 0f                    and     #$0f            ; the trig table
f60f: aa                       tax
f610: bc ba f5                 ldy     COSINE_TABLE,x  ;save cosine in HGR_DX
f613: 84 d0                    sty     HGR_DX
f615: 49 0f                    eor     #$0f            ;and sine in DY
f617: aa                       tax
f618: bc bb f5                 ldy     COSINE_TABLE+1,x
f61b: c8                       iny
f61c: 84 d2                    sty     HGR_DY
f61e: a4 e5                    ldy     HGR_HORIZ       ;index from HBASL,H to byte we're in
f620: a2 00                    ldx     #$00
f622: 86 ea                    stx     HGR_COLLISIONS  ;clear collision counter
f624: a1 1a                    lda     (HGR_SHAPE,x)   ;get first byte of shape defn
f626: 85 d1        LF626       sta     HGR_DX+1        ;keep shape byte in HGR_DX+1
f628: a2 80                    ldx     #$80            ;initial values for fractional vectors
f62a: 86 d4                    stx     HGR_E           ;.5 in cosine component
f62c: 86 d5                    stx     HGR_E+1         ;.5 in sine component
f62e: a6 e7                    ldx     HGR_SCALE       ;scale factor
f630: a5 d4        LF630       lda     HGR_E           ;add cosine value to X-value
f632: 38                       sec                     ;if >= 1, then draw
f633: 65 d0                    adc     HGR_DX
f635: 85 d4                    sta     HGR_E           ;only save fractional part
f637: 90 04                    bcc     LF63D           ;no integral part
f639: 20 b3 f4                 jsr     LRUD1           ;time to plot cosine component
f63c: 18                       clc
f63d: a5 d5        LF63D       lda     HGR_E+1         ;add sine value to Y-value
f63f: 65 d2                    adc     HGR_DY          ;if >= 1, then draw
f641: 85 d5                    sta     HGR_E+1         ;only save fractional part
f643: 90 03                    bcc     LF648           ;no integral part
f645: 20 b4 f4                 jsr     LRUD2           ;time to plot sine component
f648: ca           LF648       dex                     ;loop on scale factor
f649: d0 e5                    bne     LF630           ;still on same shape item
f64b: a5 d1                    lda     HGR_DX+1        ;get next shape item
f64d: 4a                       lsr     A               ;next 3-bit vector
f64e: 4a                       lsr     A
f64f: 4a                       lsr     A
f650: d0 d4                    bne     LF626           ;more in this shape byte
f652: e6 1a                    inc     HGR_SHAPE       ;go to next shape byte
f654: d0 02                    bne     LF658
f656: e6 1b                    inc     HGR_SHAPE+1
f658: a1 1a        LF658       lda     (HGR_SHAPE,x)   ;next byte of shape definition
f65a: d0 ca                    bne     LF626           ;process if not zero
f65c: 60                       rts                     ;finished

                   ; XDRAW0
                   ; (not called by Applesoft)
f65d: 86 1a                    stx     HGR_SHAPE       ;save shape address
f65f: 84 1b                    sty     HGR_SHAPE+1
                   ; XDRAW a shape (same as DRAW, except toggles screen)
                   ;   (Y,X) = shape starting address
                   ;   A-reg = rotation ($00-3F)
f661: aa           XDRAW1      tax                     ;save rotation ($00-3F)
f662: 4a                       lsr     A               ;divide rotation by 16 to get
f663: 4a                       lsr     A               ; quadrant (0=up, 1=rt, 2=dwn, 3=lft)
f664: 4a                       lsr     A
f665: 4a                       lsr     A
f666: 85 d3                    sta     HGR_QUAD
f668: 8a                       txa                     ;use lwo 4 bits of rotation to index
f669: 29 0f                    and     #$0f            ; the trig table
f66b: aa                       tax
f66c: bc ba f5                 ldy     COSINE_TABLE,x  ;save cosine in HGR_DX
f66f: 84 d0                    sty     HGR_DX
f671: 49 0f                    eor     #$0f            ;and sine in DY
f673: aa                       tax
f674: bc bb f5                 ldy     COSINE_TABLE+1,x
f677: c8                       iny
f678: 84 d2                    sty     HGR_DY
f67a: a4 e5                    ldy     HGR_HORIZ       ;index from HBASL,H to byte we're in
f67c: a2 00                    ldx     #$00
f67e: 86 ea                    stx     HGR_COLLISIONS  ;clear collision counter
f680: a1 1a                    lda     (HGR_SHAPE,x)   ;get first byte of shape defn
f682: 85 d1        LF682       sta     HGR_DX+1        ;keep shape byte in HGR_DX+1
f684: a2 80                    ldx     #$80            ;initial values for fractional vectors
f686: 86 d4                    stx     HGR_E           ;.5 in cosine component
f688: 86 d5                    stx     HGR_E+1         ;.5 in sine component
f68a: a6 e7                    ldx     HGR_SCALE       ;scale factor
f68c: a5 d4        LF68C       lda     HGR_E           ;add cosine value to X-value
f68e: 38                       sec                     ;if >= 1, then draw
f68f: 65 d0                    adc     HGR_DX
f691: 85 d4                    sta     HGR_E           ;only save fractional part
f693: 90 04                    bcc     LF699           ;no integral part
f695: 20 9c f4                 jsr     LRUDX1          ;time to plot cosine component
f698: 18                       clc
f699: a5 d5        LF699       lda     HGR_E+1         ;add sine value to Y-value
f69b: 65 d2                    adc     HGR_DY          ;if >= 1, then draw
f69d: 85 d5                    sta     HGR_E+1         ;only save fractional part
f69f: 90 03                    bcc     LF6A4           ;no integral part
f6a1: 20 9d f4                 jsr     LRUDX2          ;time to plot sine component
f6a4: ca           LF6A4       dex                     ;loop on scale factor
f6a5: d0 e5                    bne     LF68C           ;still on same shape item
f6a7: a5 d1                    lda     HGR_DX+1        ;get next shape item
f6a9: 4a                       lsr     A               ;next 3-bit vector
f6aa: 4a                       lsr     A
f6ab: 4a                       lsr     A
f6ac: d0 d4                    bne     LF682           ;more in this shape byte
f6ae: e6 1a                    inc     HGR_SHAPE       ;go to next shape byte
f6b0: d0 02                    bne     LF6B4
f6b2: e6 1b                    inc     HGR_SHAPE+1
f6b4: a1 1a        LF6B4       lda     (HGR_SHAPE,x)   ;next byte of shape definition
f6b6: d0 ca                    bne     LF682           ;process if not zero
f6b8: 60                       rts                     ;finished

                   ; Get hi-res plotting coordinates (0-279,0-191) from TXTPTR.  Leave registers
                   ; set up for HPOSN:
                   ;   (Y,X) = X-coord
                   ;   A-reg = Y-coord
f6b9: 20 67 dd     HFNS        jsr     FRMNUM          ;evaluate expression, must be numeric
f6bc: 20 52 e7                 jsr     GETADR          ;convert to 2-byte integer in LINNUM
f6bf: a4 51                    ldy     LINNUM+1        ;get horiz coord in X,Y
f6c1: a6 50                    ldx     LINNUM
f6c3: c0 01                    cpy     #$01            ;(should be #>280) make sure it is < 280
f6c5: 90 06                    bcc     LF6CD           ;in range
f6c7: d0 1d                    bne     GGERR
f6c9: e0 18                    cpx     #24             ;(should be #<280)
f6cb: b0 19                    bcs     GGERR
f6cd: 8a           LF6CD       txa                     ;save horiz coord on stack
f6ce: 48                       pha
f6cf: 98                       tya
f6d0: 48                       pha
f6d1: a9 2c                    lda     #‘,’            ;require a comma
f6d3: 20 c0 de                 jsr     SYNCHR
f6d6: 20 f8 e6                 jsr     GETBYT          ;eval exp to single byte in X-reg
f6d9: e0 c0                    cpx     #192            ;check for range
f6db: b0 09                    bcs     GGERR           ;too big
f6dd: 86 9d                    stx     FAC             ;save Y-coord
f6df: 68                       pla                     ;retrieve horizontal coordinate
f6e0: a8                       tay
f6e1: 68                       pla
f6e2: aa                       tax
f6e3: a5 9d                    lda     FAC             ;and vertical coordinate
f6e5: 60                       rts

f6e6: 4c 06 f2     GGERR       jmp     GOERR           ;illegal quantity error

                   * HCOLOR= statement                                                            *
f6e9: 20 f8 e6     HCOLOR      jsr     GETBYT          ;eval exp to single byte in X
f6ec: e0 08                    cpx     #8              ;value must be 0-7
f6ee: b0 f6                    bcs     GGERR           ;too big
f6f0: bd f6 f6                 lda     COLORTBL,x      ;get color pattern
f6f3: 85 e4                    sta     HGR_COLOR
f6f5: 60           RTS_23      rts

f6f6: 00 2a 55 7f+ COLORTBL    .bulk   002a557f80aad5ff

                   * HPLOT statement                                                              *
                   *                                                                              *
                   *   HPLOT X,Y                                                                  *
                   *   HPLOT TO X,Y                                                               *
                   *   HPLOT X1,Y1 to X2,Y2                                                       *
                   • Clear variables
                   DSCTMP      .var    $9d    {addr/1} ;Overlaps FAC

f6fe: c9 c1        HPLOT       cmp     #TOK_TO         ;HPLOT TO form?
f700: f0 0d                    beq     LF70F           ;yes, start from current location
f702: 20 b9 f6                 jsr     HFNS            ;no, get starting point of line
f705: 20 57 f4                 jsr     HPLOT0          ;plot the point, and set up for drawing a line from that point
f708: 20 b7 00     LF708       jsr     CHRGOT          ;character at end of expression
f70b: c9 c1                    cmp     #TOK_TO         ;is a line specified?
f70d: d0 e6                    bne     RTS_23          ;no, exit
f70f: 20 c0 de     LF70F       jsr     SYNCHR          ;yes, adv. TXTPTR (why not CHRGET)
f712: 20 b9 f6                 jsr     HFNS            ;get coordinates of line end
f715: 84 9d                    sty     DSCTMP          ;set up for line
f717: a8                       tay
f718: 8a                       txa
f719: a6 9d                    ldx     DSCTMP
f71b: 20 3a f5                 jsr     HGLIN           ;plot line
f71e: 4c 08 f7                 jmp     LF708           ;loop till no more "TO" phrases

                   * ROT= statement                                                               *
f721: 20 f8 e6     ROT         jsr     GETBYT          ;eval exp to a byte in X-reg
f724: 86 f9                    stx     HGR_ROTATION
f726: 60                       rts

                   * SCALE= statement                                                             *
f727: 20 f8 e6     SCALE       jsr     GETBYT          ;eval exp to a byte in X-reg
f72a: 86 e7                    stx     HGR_SCALE
f72c: 60                       rts

                   ; Set up for DRAW and XDRAW.
f72d: 20 f8 e6     DRWPNT      jsr     GETBYT          ;get shape number in X-reg
f730: a5 e8                    lda     HGR_SHAPE_PTR   ;search for that shape
f732: 85 1a                    sta     HGR_SHAPE       ;set up ptr to beginning of table
f734: a5 e9                    lda     HGR_SHAPE_PTR+1
f736: 85 1b                    sta     HGR_SHAPE+1
f738: 8a                       txa
f739: a2 00                    ldx     #$00
f73b: c1 1a                    cmp     (HGR_SHAPE,x)   ;compare to # of shapes in table
f73d: f0 02                    beq     LF741           ;last shape in table
f73f: b0 a5                    bcs     GGERR           ;shape # too large
f741: 0a           LF741       asl     A               ;double shape# to make an index
f742: 90 03                    bcc     LF747           ;add 256 if shape # > 127
f744: e6 1b                    inc     HGR_SHAPE+1
f746: 18                       clc
f747: a8           LF747       tay                     ;use index to look up offset for shape
f748: b1 1a                    lda     (HGR_SHAPE),y   ; in offset table
f74a: 65 1a                    adc     HGR_SHAPE
f74c: aa                       tax
f74d: c8                       iny
f74e: b1 1a                    lda     (HGR_SHAPE),y
f750: 65 e9                    adc     HGR_SHAPE_PTR+1
f752: 85 1b                    sta     HGR_SHAPE+1     ;save address of shape
f754: 86 1a                    stx     HGR_SHAPE
f756: 20 b7 00                 jsr     CHRGOT          ;is there any "AT" phrase?
f759: c9 c5                    cmp     #TOK_AT
f75b: d0 09                    bne     LF766           ;no, draw right where we are
f75d: 20 c0 de                 jsr     SYNCHR          ;scan over "AT"
f760: 20 b9 f6                 jsr     HFNS            ;get X- and Y-coords to start drawing it
f763: 20 11 f4                 jsr     HPOSN           ;set up cursor there
f766: a5 f9        LF766       lda     HGR_ROTATION    ;rotation value
f768: 60                       rts

                   * DRAW statement                                                               *
f769: 20 2d f7     DRAW        jsr     DRWPNT
f76c: 4c 05 f6                 jmp     DRAW1

                   * XDRAW statement                                                              *
f76f: 20 2d f7     XDRAW       jsr     DRWPNT
f772: 4c 61 f6                 jmp     XDRAW1

                   * SHLOAD statement                                                             *
                   *                                                                              *
                   * Reads a shape table from cassette tape to a position just below HIMEM.       *
                   * HIMEM is then moved to just below the table.                                 *
f775: a9 00        SHLOAD      lda     #>LINNUM        ;set up to read two bytes
f777: 85 3d                    sta     MON_A1H         ; into LINNUM,LINNUM+1
f779: 85 3f                    sta     MON_A2H
f77b: a0 50                    ldy     #LINNUM
f77d: 84 3c                    sty     MON_A1L
f77f: c8                       iny                     ;LINNUM+1
f780: 84 3e                    sty     MON_A2L
f782: 20 fd fe                 jsr     MON_READ        ;read tape
f785: 18                       clc                     ;setup to read LINNUM bytes
f786: a5 73                    lda     MEMSIZE         ;ending at HIMEM-1
f788: aa                       tax
f789: ca                       dex                     ;forming HIMEM-1
f78a: 86 3e                    stx     MON_A2L
f78c: e5 50                    sbc     LINNUM          ;forming HIMEM-LINNUM
f78e: 48                       pha
f78f: a5 74                    lda     MEMSIZE+1
f791: a8                       tay
f792: e8                       inx                     ;see if HIMEM low byte was zero
f793: d0 01                    bne     LF796           ;no
f795: 88                       dey                     ;yes, have to decrement high byte
f796: 84 3f        LF796       sty     MON_A2H
f798: e5 51                    sbc     LINNUM+1
f79a: c5 6e                    cmp     STREND+1        ;running into variables?
f79c: 90 02                    bcc     LF7A0           ;yes, out of memory
f79e: d0 03                    bne     LF7A3           ;no, still room
f7a0: 4c 10 d4     LF7A0       jmp     MEMERR          ;mem full err

f7a3: 85 74        LF7A3       sta     MEMSIZE+1
f7a5: 85 70                    sta     FRETOP+1        ;clear string space
f7a7: 85 3d                    sta     MON_A1H         ;(but names are still in VARTBL!)
f7a9: 85 e9                    sta     HGR_SHAPE_PTR+1
f7ab: 68                       pla
f7ac: 85 e8                    sta     HGR_SHAPE_PTR
f7ae: 85 73                    sta     MEMSIZE
f7b0: 85 6f                    sta     FRETOP
f7b2: 85 3c                    sta     MON_A1L
f7b4: 20 fa fc                 jsr     MON_RD2BIT      ;read to tape transitions
f7b7: a9 03                    lda     #$03            ;short delay for intermediate header
f7b9: 4c 02 ff                 jmp     MON_READ2       ;read shapes

                   ; Called from STORE and RECALL.
f7bc: 18           TAPEPNT     clc
f7bd: a5 9b                    lda     LOWTR
f7bf: 65 50                    adc     LINNUM
f7c1: 85 3e                    sta     MON_A2L
f7c3: a5 9c                    lda     LOWTR+1
f7c5: 65 51                    adc     LINNUM+1
f7c7: 85 3f                    sta     MON_A2H
f7c9: a0 04                    ldy     #$04
f7cb: b1 9b                    lda     (LOWTR),y
f7cd: 20 ef e0                 jsr     GETARY2
f7d0: a5 94                    lda     HIGHDS
f7d2: 85 3c                    sta     MON_A1L
f7d4: a5 95                    lda     HIGHDS+1
f7d6: 85 3d                    sta     MON_A1H
f7d8: 60                       rts

                   ; Called from STORE and RECALL.
f7d9: a9 40        GETARYPT    lda     #$40
f7db: 85 14                    sta     SUBFLG
f7dd: 20 e3 df                 jsr     PTRGET
f7e0: a9 00                    lda     #$00
f7e2: 85 14                    sta     SUBFLG
f7e4: 4c f0 d8                 jmp     VARTIO

                   * HTAB statement                                                               *
                   *                                                                              *
                   * Note that if WNDLEFT is not 0, HTAB can print outside the screen (e.g. in    *
                   * the program).                                                                *
f7e7: 20 f8 e6     HTAB        jsr     GETBYT
f7ea: ca                       dex
f7eb: 8a                       txa
f7ec: c9 28        LF7EC       cmp     #40
f7ee: 90 0a                    bcc     LF7FA
f7f0: e9 28                    sbc     #40
f7f2: 48                       pha
f7f3: 20 fb da                 jsr     CRDO
f7f6: 68                       pla
f7f7: 4c ec f7                 jmp     LF7EC

f7fa: 85 24        LF7FA       sta     MON_CH
f7fc: 60                       rts

f7fd: cb                       .dd1    “K”
f7fe: d2 d7                    .str    “RW”            ;Richard Weiland?

Symbol Table