(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 http://www.txbobsc.com/scsc/scdocumentor/ *
                   * 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.8.            *
                   * Created 2019/10/27                                                           *
                   * Last updated 2022/06/08                                                      *
                   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, used by GETLN
                   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)
                   TXTTAB          .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 from input device via $38-39
                   MON_GETLN       .eq     $fd6a             ;get a line of input
                   MON_COUT        .eq     $fded             ;print Acc to output device via $36-37
                   MON_INPORT      .eq     $fe8b             ;set char input handler to slot in A-reg
                   MON_OUTPORT     .eq     $fe95             ;set char output handler to slot in A-reg
                   MON_WRITE       .eq     $fecd             ;write data to cassette
                   MON_READ        .eq     $fefd             ;read data from cassette
                   MON_READ2       .eq     $ff02             ;read data from cassette

                   ; Branch table for tokens.  Entries are (address-1).
                                   .addrs  $d000
d000: 6f d8        TOKEN_ADDR_TABLE .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     TOKEN_NAME_TABLE .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    ‘&’ | $80         ;$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    ‘+’ | $80         ;$c8
d1fd: ad                           .dd1    ‘-’ | $80         ;$c9
d1fe: aa                           .dd1    ‘*’ | $80         ;$ca
d1ff: af                           .dd1    ‘/’ | $80         ;$cb
d200: de                           .dd1    ‘^’ | $80         ;$cc
d201: 41 4e c4                     .dstr   “AND”             ;$cd
d204: 4f d2                        .dstr   “OR”              ;$ce
d206: be                           .dd1    ‘>’ | $80         ;$cf
d207: bd                           .dd1    ‘=’ | $80         ;$d0
d208: bc                           .dd1    ‘<’ | $80         ;$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     PRINT_ERROR_LINNUM 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     #‘]’ | $80        ;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        NUMBERED_LINE   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     PUT_NEW_LINE    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     TXTTAB            ;point index at start of program
d4f7: a4 68                        ldy     TXTTAB+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        PARSE_INPUT_LINE 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     TXTTAB            ;search from beginning of program
d61c: a6 68                        ldx     TXTTAB+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     (TXTTAB),y
d652: c8                           iny
d653: 91 67                        sta     (TXTTAB),y
d655: a5 67                        lda     TXTTAB
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     TXTTAB+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     TXTTAB
d69a: 69 ff                        adc     #$ff
d69c: 85 b8                        sta     TXTPTR
d69e: a5 68                        lda     TXTTAB+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        EXECUTE_STATEMENT beq   RTS_3             ;end of line, null statement
d82a: e9 80        EXECUTE_STATEMENT_1 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     TXTTAB
d84c: e9 01                        sbc     #$01
d84e: a4 68                        ldy     TXTTAB+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        CTRL_C_TYPED    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     TXTTAB
d8b5: 85 50                        sta     LINNUM
d8b7: a5 b0                        lda     PRGEND+1
d8b9: e5 68                        sbc     TXTTAB+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     TXTTAB            ;compute end address
d8d2: 65 50                        adc     LINNUM
d8d4: 85 69                        sta     VARTAB
d8d6: a5 68                        lda     TXTTAB+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     TXTTAB            ;set up to read/write program
d903: a4 68                        ldy     TXTTAB+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     TXTTAB            ;get program beginning
d957: a6 68                        ldx     TXTTAB+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           PR_TAB_OR_SPC   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     PR_NEXT_CHAR    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        INPUT_FLAG_ZERO 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        PROCESS_INPUT_LIST sta  INPUTFLG
dbed: 86 7f                        stx     INPTR             ;address of input string
dbef: 84 80                        sty     INPTR+1
dbf1: 20 e3 df     PROCESS_INPUT_ITEM 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           FRM_PRECEDENCE_TEST 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        FRM_RELATIONAL  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        FRM_PERFORM_1   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           FRM_PERFORM_2   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     FRM_VARIABLE    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           NAME_NOT_FOUND  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        MAKE_NEW_VARIABLE 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        SET_VARPNT_AND_YA 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   $90,$80,$00,$00   ;-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        USE_OLD_ARRAY   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        MAKE_NEW_ARRAY  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        FIND_ARRAY_ELEMENT 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        MULTIPLY_SUBSCRIPT 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        MULTIPLY_SUBS_1 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     TEMP3             ;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     TEMP3
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     TEMP3
e366: 68                           pla
e367: 85 8b                        sta     FNCNAM+1
e369: a0 02                        ldy     #$02              ;point at add of argument variable
e36b: b1 8a                        lda     (TEMP3),y
e36d: 85 83                        sta     VARPNT
e36f: aa                           tax
e370: c8                           iny
e371: b1 8a                        lda     (TEMP3),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     (TEMP3),y         ;Y=0 from MOVMF
e38b: 85 b8                        sta     TXTPTR            ;point to function def'n
e38d: c8                           iny
e38e: b1 8a                        lda     (TEMP3),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     TEMP3             ; 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     (TEMP3),y
e3b4: 68                           pla
e3b5: c8                           iny
e3b6: 91 8a                        sta     (TEMP3),y
e3b8: 68                           pla
e3b9: c8                           iny
e3ba: 91 8a                        sta     (TEMP3),y
e3bc: 68                           pla
e3bd: c8                           iny
e3be: 91 8a                        sta     (TEMP3),y
e3c0: 68                           pla
e3c1: c8                           iny
e3c2: 91 8a                        sta     (TEMP3),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        FIND_HIGHEST_STRING 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        CHECK_SIMPLE_VARIABLE 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        CHECK_VARIABLE  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     TEMP3
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        MOVE_HIGHEST_STRING_TO_TOP 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     (TEMP3),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     (TEMP3),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     (TEMP3),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     SUBSTRING_SETUP 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        NORMALIZE_FAC_1 bcs     NORMALIZE_FAC_2
e82b: 20 9e e8                     jsr     COMPLEMENT_FAC
e82e: a0 00        NORMALIZE_FAC_2 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_IN_FAC_SIGN_AND_EXP sta FAC
e852: 85 a2        STA_IN_FAC_SIGN 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        NORMALIZE_FAC_3 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        NORMALIZE_FAC_4 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        NORMALIZE_FAC_5 bcc     RTS_11            ;unless mantissa carried
e88f: e6 9d        NORMALIZE_FAC_6 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        COMPLEMENT_FAC  lda     FAC_SIGN
e8a0: 49 ff                        eor     #$ff
e8a2: 85 a2                        sta     FAC_SIGN
                   ; 2's complement of FAC mantissa only
e8a4: a5 9e        COMPLEMENT_FAC_MANTISSA 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        INCREMENT_FAC_MANTISSA 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        SHIFT_RIGHT_1   ldx     #RESULT-1         ;shift result right
e8dc: b4 04        SHIFT_RIGHT_2   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        SHIFT_RIGHT_3   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        SHIFT_RIGHT_4   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           SHIFT_RIGHT_5   clc                       ;return with carry clear
e912: 60                           rts

e913: 81 00 00 00+ CON_ONE         .bulk   $81,$00,$00,$00,$00
e918: 03           POLY_LOG        .dd1    3                 ;# of coefficients - 1
e919: 7f 5e 56 cb+                 .bulk   $7f,$5e,$56,$cb,$79 ;* X^7 +
e91e: 80 13 9b 0b+                 .bulk   $80,$13,$9b,$0b,$64 ;* X^5 +
e923: 80 76 38 93+                 .bulk   $80,$76,$38,$93,$16 ;* X^3 +
e928: 82 38 aa 3b+                 .bulk   $82,$38,$aa,$3b,$20 ;* X
e92d: 80 35 04 f3+ CON_SQR_HALF    .bulk   $80,$35,$04,$f3,$34
e932: 81 35 04 f3+ CON_SQR_TWO     .bulk   $81,$35,$04,$f3,$34
e937: 80 80 00 00+ CON_NEG_HALF    .bulk   $80,$80,$00,$00,$00
e93c: 80 31 72 17+ CON_LOG_TWO     .bulk   $80,$31,$72,$17,$f8

                   * 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        LOAD_ARG_FROM_YA 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        ADD_EXPONENTS   lda     ARG
ea10: f0 1f        ADD_EXPONENTS_1 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   $84,$20,$00,$00,$00

                   ; 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        COPY_RESULT_INTO_FAC 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        LOAD_FAC_FROM_YA 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        STORE_FAC_IN_TEMP2_ROUNDED ldx #TEMP2     ;pack FAC into TEMP2
eb20: 2c                           bit ▼   $93a2             ;trick to branch
                   ; Round FAC, store in TEMP1.
eb21: a2 93        STORE_FAC_IN_TEMP1_ROUNDED 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     STORE_FAC_AT_YX_ROUNDED 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        COPY_ARG_TO_FAC 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     COPY_FAC_TO_ARG_ROUNDED 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     INCREMENT_MANTISSA 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+ CON_99999999_9  .bulk   $9b,$3e,$bc,$1f,$fd ;99,999,999.9
ed0f: 9e 6e 6b 27+ CON_999999999   .bulk   $9e,$6e,$6b,$27,$fd ;999,999,999
ed14: 9e 6e 6b 28+ CON_BILLION     .bulk   $9e,$6e,$6b,$28,$00 ;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   $80,$00,$00,$00,$00 ;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   $fa,$0a,$1f,$00   ;-100000000
ee6d: 00 98 96 80                  .bulk   $00,$98,$96,$80   ;10000000
ee71: ff f0 bd c0                  .bulk   $ff,$f0,$bd,$c0   ;-1000000
ee75: 00 01 86 a0                  .bulk   $00,$01,$86,$a0   ;100000
ee79: ff ff d8 f0                  .bulk   $ff,$ff,$d8,$f0   ;-10000
ee7d: 00 00 03 e8                  .bulk   $00,$00,$03,$e8   ;1000
ee81: ff ff ff 9c                  .bulk   $ff,$ff,$ff,$9c   ;-100
ee85: 00 00 00 0a                  .bulk   $00,$00,$00,$0a   ;10
ee89: ff ff ff ff                  .bulk   $ff,$ff,$ff,$ff   ;-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   $81,$38,$aa,$3b,$29 ;log(e) to base 2
eee0: 07           POLY_EXP        .dd1    7                 ;(# of terms in polynomial) - 1
eee1: 71 34 58 3e+                 .bulk   $71,$34,$58,$3e,$56 ;(LOG(2)^7)/8!
eee6: 74 16 7e b3+                 .bulk   $74,$16,$7e,$b3,$1b ;(LOG(2)^6)/7!
eeeb: 77 2f ee e3+                 .bulk   $77,$2f,$ee,$e3,$85 ;(LOG(2)^5)/6!
eef0: 7a 1d 84 1c+                 .bulk   $7a,$1d,$84,$1c,$2a ;(LOG(2)^4)/5!
eef5: 7c 63 59 58+                 .bulk   $7c,$63,$59,$58,$0a ;(LOG(2)^3)/4!
eefa: 7e 75 fd e7+                 .bulk   $7e,$75,$fd,$e7,$c6 ;(LOG(2)^2)/3!
eeff: 80 31 72 18+                 .bulk   $80,$31,$72,$18,$10 ;LOG(2)/2!
ef04: 81 00 00 00+                 .bulk   $81,$00,$00,$00,$00 ;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        POLYNOMIAL_ODD  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   $98,$35,$44,$7a   ;<<< these are missing one byte >>>
efaa: 68 28 b1 46  CON_RND_2       .bulk   $68,$28,$b1,$46   ;<<< 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   $81,$49,$0f,$da,$a2
f06b: 83 49 0f da+ CON_PI_DOUB     .bulk   $83,$49,$0f,$da,$a2
f070: 7f 00 00 00+ QUARTER         .bulk   $7f,$00,$00,$00,$00
f075: 05           POLY_SIN        .dd1    5                 ;power of polynomial
f076: 84 e6 1a 2d+                 .bulk   $84,$e6,$1a,$2d,$1b ;(2PI)^11/11!
f07b: 86 28 07 fb+                 .bulk   $86,$28,$07,$fb,$f8 ;(2PI)^9/9!
f080: 87 99 68 89+                 .bulk   $87,$99,$68,$89,$01 ;(2PI)^7/7!
f085: 87 23 35 df+                 .bulk   $87,$23,$35,$df,$e1 ;(2PI)^5/5!
f08a: 86 a5 5d e7+                 .bulk   $86,$a5,$5d,$e7,$28 ;(2PI)^3/3!
f08f: 83 49 0f da+                 .bulk   $83,$49,$0f,$da,$a2 ;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   $76,$b3,$83,$bd,$d3
f0d4: 79 1e f4 a6+                 .bulk   $79,$1e,$f4,$a6,$f5
f0d9: 7b 83 fc b0+                 .bulk   $7b,$83,$fc,$b0,$10
f0de: 7c 0c 1f 67+                 .bulk   $7c,$0c,$1f,$67,$ca
f0e3: 7c de 53 cb+                 .bulk   $7c,$de,$53,$cb,$c1
f0e8: 7d 14 64 70+                 .bulk   $7d,$14,$64,$70,$4c
f0ed: 7d b7 ea 51+                 .bulk   $7d,$b7,$ea,$51,$7a
f0f2: 7d 63 30 88+                 .bulk   $7d,$63,$30,$88,$7e
f0f7: 7e 92 44 99+                 .bulk   $7e,$92,$44,$99,$3a
f0fc: 7e 4c cc 91+                 .bulk   $7e,$4c,$cc,$91,$c7
f101: 7f aa aa aa+                 .bulk   $7f,$aa,$aa,$aa,$13
f106: 81 00 00 00+                 .bulk   $81,$00,$00,$00,$00

                   ; 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        GENERIC_CHRGET  inc     TXTPTR
f10d: d0 02                        bne     GENERIC_TXTPTR
f10f: e6 b9                        inc     TXTPTR+1
f111: ad 60 ea     GENERIC_TXTPTR  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   $80,$4f,$c7,$52,$58 ;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     TXTTAB
f1a9: 84 68                        sty     TXTTAB+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     (TXTTAB),y        ;first byte in program space = 0
f1b2: e6 67                        inc     TXTTAB            ;advance past the $00
f1b4: d0 02                        bne     LF1B8
f1b6: e6 68                        inc     TXTTAB+1
f1b8: a5 67        LF1B8           lda     TXTTAB
f1ba: a4 68                        ldy     TXTTAB+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          ;...to 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        MOVE_LEFT_OR_RIGHT 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              ;...dot 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        MOVE_UP_OR_DOWN 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   $81,$82,$84,$88,$90,$a0,$c0
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+ COSINE_TABLE    .bulk   $ff,$fe,$fa,$f4,$ec,$e1,$d4,$c5,$b4,$a1,$8d,$78,$61,$49,$31,$18
                                    +      $ff

                   ; 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   $00,$2a,$55,$7f,$80,$aa,$d5,$ff

                   * 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’ | $80
f7fe: d2 d7                        .str    ↑“RW”             ;Richard Weiland?
                                   .adrend ↑ ~$d000

Symbol Table