Disassembly of D32 ROM

*** standard JMP vectors

*** hardware routines
8000 7EBB40     JMP   $BB40     ;reset
8003 7EBB88     JMP   $BB88     ;set up $8f - $9b
8006 7EBBE5     JMP   $BBE5     ;scan keyboard (A)
8009 7EBBB5     JMP   $BBB5     ;blink cursor
800C 7EBCAB     JMP   $BCAB     ;write to VDU (A)
800F 7EBD1A     JMP   $BD1A     ;write to printer (A)
8012 7EBD52     JMP   $BD52     ;update joysticks

*** tape routines
8015 7EBDCF     JMP   $BDCF     ;motoron
8018 7EBDDC     JMP   $BDDC     ;motoroff
801B 7EBE68     JMP   $BE68     ;write leader
801E 7EBE12     JMP   $BE12     ;byte out (A)
8021 7EBDE7     JMP   $BDE7     ;read leader
8024 7EBDAD     JMP   $BDAD     ;byte in (A)
8027 7EBDA5     JMP   $BDA5     ;bit in (C)

*** serial routines (not implemented)
802A 7EBE7B     JMP   $BE7B     ;read serial (A)  (RTS)
802D 7EBE7C     JMP   $BE7C     ;write serial (A) (RTS)
8030 7EBE7D     JMP   $BE7D     ;baud rate select (set carry & RTS)

*** command table : last byte of each string has MSB set
    (token in final column)

8033  464FD2         ;FOR     80
8036  47CF           ;GO      81
8038  5245CD         ;REM     82
803B  A7             ;'       83
803C  454C53C5       ;ELSE    84
8040  49C6           ;IF      85
8042  444154C1       ;DATA    86
8046  5052494ED4     ;PRINT   87
804B  4FCE           ;ON      88
804D  494E5055D4     ;INPUT   89
8052  454EC4         ;END     8A
8055  4E4558D4       ;NEXT    8B
8059  4449CD         ;DIM     8C
805C  524541C4       ;READ    8D
8060  4C45D4         ;LET     8E
8063  5255CE         ;RUN     8F
8066  524553544F52C5 ;RESTORE 90
806D  5245545552CE   ;RETURN  91
8073  53544FD0       ;STOP    92
8077  504F4BC5       ;POKE    93
807B  434F4ED4       ;CONT    94
807F  4C4953D4       ;LIST    95
8083  434C4541D2     ;CLEAR   96
8088  4E45D7         ;NEW     97
808B  4445C6         ;DEF     98
808E  434C4F41C4     ;CLOAD   99
8093  43534156C5     ;CSAVE   9A
8098  4F5045CE       ;OPEN    9B
809C  434C4F53C5     ;CLOSE   9C
80A1  4C4C4953D4     ;LLIST   9D
80A6  5345D4         ;SET     9E
80A9  52455345D4     ;RESET   9F
80AE  434CD3         ;CLS     A0
80B1  4D4F544FD2     ;MOTOR   A1
80B6  534F554EC4     ;SOUND   A2
80BB  41554449CF     ;AUDIO   A3
80C0  455845C3       ;EXEC    A4
80C4  534B4950C6     ;SKIPF   A5
80C9  4445CC         ;DEL     A6
80CC  454449D4       ;EDIT    A7
80D0  54524FCE       ;TRON    A8
80D4  54524F46C6     ;TROFF   A9
80D9  4C494EC5       ;LINE    AA
80DD  50434CD3       ;PCLS    AB
80E1  505345D4       ;PSET    AC
80E5  5052455345D4   ;PRESET  AD
80EB  5343524545CE   ;SCREEN  AE
80F1  50434C4541D2   ;PCLEAR  AF
80F7  434F4C4FD2     ;COLOR   B0
80FC  434952434CC5   ;CIRCLE  B1
8102  5041494ED4     ;PAINT   B2
8107  4745D4         ;GET     B3
810A  5055D4         ;PUT     B4
810D  445241D7       ;DRAW    B5
8111  50434F50D9     ;PCOPY   B6
8116  504D4F44C5     ;PMODE   B7
811B  504C41D9       ;PLAY    B8
811F  444C4F41C4     ;DLOAD   B9
8124  52454E55CD     ;RENUM   BA
8129  544142A8       ;TAB(    BB
812D  54CF           ;TO      BC
812F  5355C2         ;SUB     BD
8132  46CE           ;FN      BE
8134  544845CE       ;THEN    BF
8138  4E4FD4         ;NOT     C0
813B  535445D0       ;STEP    C1
813F  4F46C6         ;OFF     C2
8142  AB             ;+       C3
8143  AD             ;-       C4
8144  AA             ;*       C5
8145  AF             ;/       C6
8146  DE             ;^       C7
8147  414EC4         ;AND     C8
814A  4FD2           ;OR      C9
814C  BE             ;>       CA
814D  BD             ;=       CB
814E  BC             ;<       CC
814F  5553494EC7     ;USING   CD

*** command vectors

8154  8448 85B9 8616 8616   ;for go rem '
815C  8616 8647 8613 903D   ;else if data print
8164  8675 872B 8532 8829   ;on input end next
816C  8A8B 8777 86BC 85A5   ;dim read let run
8174  8514 85F3 8539 8E9D   ;restore return stop poke
817C  8560 8EAA 8571 8415   ;cont list clear new
8184  9C81 B6D4 B682 B828   ;def cload csave open
818C  B64C 8EA4 B9D2 BA03   ;close llist set reset
8194  BA5F B981 BA9A BADF   ;cls motor sound audio
819C  B770 B81E 9D61 9965   ;exec skipf del edit
81A4  9AD9 9ADA A749 A8C0   ;tron troff line pcls
81AC  A6EF A6F3 A9FE AA19   ;pset preset screen pclear
81B4  A8D4 B238 AC87 AAF0   ;color circle paint get
81BC  AAF3 B051 AABE A9AF   ;put draw pcopy pmode
81C4  ADBD A049 9DFA        ;play dload renum

*** function table : last byte of each string has MSB set
    (token in final column)

81CA  5347CE         ;SGN     FF80
81CD  494ED4         ;INT     FF81
81D0  4142D3         ;ABS     FF82
81D3  504FD3         ;POS     FF83
81D6  524EC4         ;RND     FF84
81D9  5351D2         ;SQR     FF85
81DC  4C4FC7         ;LOG     FF86
81DF  4558D0         ;EXP     FF87
81E2  5349CE         ;SIN     FF88
81E5  434FD3         ;COS     FF89
81E8  5441CE         ;TAN     FF8A
81EB  4154CE         ;ATN     FF8B
81EE  504545CB       ;PEEK    FF8C
81F2  4C45CE         ;LEN     FF8D
81F5  535452A4       ;STR$    FF8E
81F9  5641CC         ;VAL     FF8F
81FC  4153C3         ;ASC     FF90
81FF  434852A4       ;CHR$    FF91
8203  454FC6         ;EOF     FF92
8206  4A4F595354CB   ;JOYSTK  FF93
820C  4649D8         ;FIX     FF94
820F  484558A4       ;HEX$    FF95
8213  4C454654A4     ;LEFT$   FF96
8218  5249474854A4   ;RIGHT$  FF97
821E  4D4944A4       ;MID$    FF98
8222  504F494ED4     ;POINT   FF99
8227  494E4B4559A4   ;INKEY$  FF9A
822D  4D45CD         ;MEM     FF9B
8230  5641525054D2   ;VARPTR  FF9C
8236  494E5354D2     ;INSTR   FF9D
823B  54494D45D2     ;TIMER   FF9E
8240  50504F494ED4   ;PPOINT  FF9F
8246  535452494E47A4 ;STRING$ FFA0
824D  5553D2         ;USR     FFA1

*** function vectors

8250  9425 9499 943E 9ADE    ;sgn int abs pos
8258  9772 9697 923C 9713    ;rnd sqr log exp
8260  97D1 97CB 9816 9877    ;sin cos tan atn
8268  8E96 8DC7 8C40 8E5C    ;peek len str$ val
8270  8DE6 8DD2 B800 BB0D    ;asc chr$ eof joystk
8278  9956 A00E 8DF1 8E0E    ;fix hex$ left$ right$
8280  8E15 BA44 B796 8C31    ;mid$ point inkey$ mem
8288  9AF4 9BB4 9D59 A6C7    ;varptr instr timer ppoint
8290  9B84 9D1D              ;string$ usr

*** binary operator table used during expression evaluation
    (1st byte is precedence level followed by address of handler)

8294  79 910E     ; +
8297  79 9105     ; -
829A  7B 9275     ; *
829D  7B 933C     ; /
82A0  7F 96A0     ; ^
82A3  50 8A12     ; AND
82A6  46 8A11     ; OR

*** error code strings

82A9 4E46 534E    NF  SN
82AD 5247 4F44    RG  OD
82B1 4643 4F56    FC  OV
82B5 4F4D 554C    OM  UL
82B9 4253 4444    BS  DD
82BD 2F30 4944    /0  ID
82C1 544D 4F53    TM  OS
82C5 4C53 5354    LS  ST
82C9 434E 5546    CN  UF
82CD 4644 414F    FD  AO
82D1 444E 494F    DN  IO
82D5 464D 4E4F    FM  NO
82D9 4945 4453    IE  DS
82DD 4E45         NE

*** misc strings

82DF  204552524F5200     ;/ERROR /
82E6  20494E2000         ;/ IN /
82EB  0D4F4B0D00         ;CR/OK/CR
82F0  0D425245414B00     ;CR/BREAK/

*** examine BASIC stack (maintained 'under' machine return addresses)
    
    $3b = varptr of FOR control variable to search for (zero if none)
          set $3b to #$ff to skip all FOR entries
    returns X = $0f = pointer to matching entry for FOR / NEXT
    $3b = varptr of control variable for unspecified NEXT
    Z = 0 if matching FOR entry not found

82F7 3064       LEAX  4,S       ;point X past 2 return addresses
82F9 C612       LDB   #$12      ;size of FOR stack entry
82FB 9F0F       STX   <$0F      ;$0f = this entry
82FD A684       LDA   ,X
82FF 8080       SUBA  #$80
8301 2615       BNE   $8318     ;not a FOR entry
8303 AE01       LDX   1,X
8305 9F11       STX   <$11      ;varptr of control variable
8307 9E3B       LDX   <$3B
8309 2709       BEQ   $8314     ;we were called by NEXT with no variable
830B 9C11       CMPX  <$11
830D 2709       BEQ   $8318     ;found a matching entry
830F 9E0F       LDX   <$0F
8311 3A         ABX             ;point X to next stack entry
8312 20E5       BRA   $82F9     ;examine next entry
8314 9E11       LDX   <$11      ;set $3b up with varptr of control variable
8316 9F3B       STX   <$3B       ;for unspecified NEXT
8318 9E0F       LDX   <$0F
831A 4D         TSTA
831B 39         RTS

*** move memory contents up     
start address   - $47
end address     - $43
new end address - $41 (D = new end address for memory check)
returns $45 = U = start of relocated block

831C 8D17       BSR   $8335     ;memory check
831E DE41       LDU   <$41
8320 3341       LEAU  1,U
8322 9E43       LDX   <$43
8324 3001       LEAX  1,X
8326 A682       LDA   ,-X
8328 3602       PSHU  A
832A 9C47       CMPX  <$47
832C 26F8       BNE   $8326
832E DF45       STU   <$45
8330 39         RTS

*** check if there are B free words of storage left

8331 4F         CLRA
8332 58         ASLB
8333 D31F       ADDD  <$1F      ;end of BASIC storage
8335 C3003A     ADDD  #$003A
8338 2508       BCS   $8342      ;?OM ERROR
833A 10DF17     STS   <$17
833D 109317     CMPD  <$17
8340 25EE       BCS   $8330     ;RTS
8342 C60C       LDB   #$0C      ;?OM ERROR

*** ?xx ERROR - error code in B

8344 BD018E     JSR   $018E     ;user error trap
8347 BD0191     JSR   $0191     ;system error trap
834A BD8018     JSR   $8018     ;cassette relay off
834D BDBAC3     JSR   $BAC3     ;disable audio
8350 BD8434     JSR   $8434     ;reset stack & bits & pieces
8353 0F6F       CLR   <$6F      ;DEVN
8355 BD90A5     JSR   $90A5     ;initialise virtual DEVN device & new line
8358 BD90F8     JSR   $90F8     ;print '?' to DEVN
835B 8E82A9     LDX   #$82A9    ;error string table
835E 3A         ABX
835F 8D3D       BSR   $839E     ;output to DEVN from ,X+
8361 8D3B       BSR   $839E     ;output to DEVN from ,X+
8363 8E82DE     LDX   #$82DE    ;'ERROR'
8366 BD90E5     JSR   $90E5     ;print string to DEVN
8369 9668       LDA   <$68      ;current line number
836B 4C         INCA
836C 2703       BEQ   $8371     ;command mode
836E BD9573     JSR   $9573     ;print 'IN xxxx' (current line number)

*** command mode

8371 BD90A5     JSR   $90A5     ;initialise virtual DEVN device & new line
8374 8E82EB     LDX   #$82EB
8377 BD90E5     JSR   $90E5     ;print 'OK'
837A BDB5C6     JSR   $B5C6     ;line input from DEVN
837D CEFFFF     LDU   #$FFFF
8380 DF68       STU   <$68      ;current line number
8382 25F6       BCS   $837A     ;command mode without 'OK'
8384 0D70       TST   <$70      ;eof flag
8386 10263373  LBNE   $B6FD     ;close file & return to command mode
838A 9FA6       STX   <$A6      ;BASIC source pointer
838C 9D9F       JSR   <$9F      ;get next character from BASIC source
838E 27EA       BEQ   $837A     ;command mode without 'OK'
8390 2511       BCS   $83A3     ;enter BASIC line
8392 C632       LDB   #$32      ;?DS ERROR
8394 0D6F       TST   <$6F      ;DEVN
8396 26AC       BNE   $8344     ;cause error
8398 BD8F67     JSR   $8F67     ;tokenize BASIC line
839B 7E84D6     JMP   $84D6     ;enter interpreter loop

*** used by error routine to print error code

839E A680       LDA   ,X+
83A0 7E90FA     JMP   $90FA     ;output character to DEVN

*** enter a BASIC line

83A3 BD869A     JSR   $869A     ;read line number & store in $2b
83A6 9E2B       LDX   <$2B
83A8 BF02DA     STX   $02DA
83AB BD8F67     JSR   $8F67     ;tokenize BASIC line
83AE D703       STB   <$03      ;line length
83B0 8D4D       BSR   $83FF     ;search program for line number in <$2b
83B2 2512       BCS   $83C6     ;line number doesn't exist
83B4 DC47       LDD   <$47      ;address where line needs to go
83B6 A384       SUBD  ,X        ;subtract next line pointer (-ve result)
83B8 D31B       ADDD  <$1B      ;start of simple variables
83BA DD1B       STD   <$1B      ;new end of program
83BC EE84       LDU   ,X
83BE 3702       PULU  A         ;move program down, erasing existing line
83C0 A780       STA   ,X+       ;
83C2 9C1B       CMPX  <$1B      ;start of simple variables
83C4 26F8       BNE   $83BE     ;
83C6 B602DC     LDA   $02DC
83C9 271C       BEQ   $83E7     ;new line is empty
83CB DC1B       LDD   <$1B      ;start of simple variables
83CD DD43       STD   <$43
83CF DB03       ADDB  <$03      ;new line length
83D1 8900       ADCA  #$00
83D3 DD41       STD   <$41
83D5 BD831C     JSR   $831C     ;move memory contents up
83D8 CE02D8     LDU   #$02D8
83DB 3702       PULU  A         ;
83DD A780       STA   ,X+       ;copy new line into space just created
83DF 9C45       CMPX  <$45      ;
83E1 26F8       BNE   $83DB     ;
83E3 9E41       LDX   <$41
83E5 9F1B       STX   <$1B      ;new end of program
83E7 8D36       BSR   $841F     ;clear variables and reset stack & cmd ptr
83E9 8D02       BSR   $83ED     ;set up next line pointers in BASIC program
83EB 208D       BRA   $837A     ;command mode without 'OK'

*** set up next line pointers in BASIC program

83ED 9E19       LDX   <$19      ;start of BASIC program
83EF EC84       LDD   ,X
83F1 2721       BEQ   $8414     ;RTS
83F3 3304       LEAU  4,X
83F5 A6C0       LDA   ,U+
83F7 26FC       BNE   $83F5
83F9 EF84       STU   ,X
83FB AE84       LDX   ,X
83FD 20F0       BRA   $83EF

*** search program for line number in <$2b

83FF DC2B       LDD   <$2B
8401 9E19       LDX   <$19      ;start of BASIC program

*** scan ahead for line in D & store address in $47
    (first line after if it doesn't exist - carry clear if found)

8403 EE84       LDU   ,X
8405 2709       BEQ   $8410     ; end of program
8407 10A302     CMPD  2,X       ; scan program until line no. is greater
840A 2306       BLS   $8412     ; than D
840C AE84       LDX   ,X        ; next line
840E 20F3       BRA   $8403
8410 1A01       ORCC  #$01
8412 9F47       STX   <$47
8414 39         RTS

*** NEW

8415 26FB       BNE   $8412
8417 9E19       LDX   <$19      ;start of BASIC program
8419 6F80       CLR   ,X+
841B 6F80       CLR   ,X+
841D 9F1B       STX   <$1B      ;start of simple variables
841F 9E19       LDX   <$19      ;start of BASIC program
8421 BD85EE     JSR   $85EE     ;subtract 1 from X & store in $a6
8424 BD0197     JSR   $0197     ;PATCH - reset BASIC memory
8427 9E27       LDX   <$27      ;top of BASIC RAM
8429 9F23       STX   <$23      ;top of free string space
842B BD8514     JSR   $8514     ;RESTORE
842E 9E1B       LDX   <$1B      ;start of simple variables
8430 9F1D       STX   <$1D      ;start of array variables
8432 9F1F       STX   <$1F      ;end of BASIC storage
8434 8E01A9     LDX   #$01A9
8437 9F0B       STX   <$0B
8439 AEE4       LDX   ,S
843B 10DE21     LDS   <$21      ;stack root / string storage start
843E 6FE2       CLR   ,-S
8440 0F2D       CLR   <$2D      ;CONT source address
8442 0F2E       CLR   <$2E      ;
8444 0F08       CLR   <$08
8446 6E84       JMP   ,X

*** FOR

    creates following 18 byte stack entry:

      ,S   #$80
     1,S   varptr of control variable
     3,S   STEP value (unsigned FP)
     8,S   sign of STEP value (-1, 0 ,1)
     9,S   TO value (signed FP)
    14,S   line number of FOR statement
    16,S   address of statement after FOR

8448 8680       LDA   #$80
844A 9708       STA   <$08      ;array illegal flag
844C BD86BC     JSR   $86BC     ;LET
844F BD82F7     JSR   $82F7     ;examine BASIC stack
8452 3262       LEAS  2,S       ;lose return address
8454 2604       BNE   $845A     ;no FOR with same control variable already
8456 9E0F       LDX   <$0F
8458 3285       LEAS  B,X       ;overwrite duplicate FOR entry
845A C609       LDB   #$09
845C BD8331     JSR   $8331     ;memory check
845F BD861B     JSR   $861B     ;find end of statement
8462 DC68       LDD   <$68      ;current line number
8464 3416       PSHS  A,B,X     ;push next statement ptr & current line no.
8466 C6BC       LDB   #$BC      ;token TO
8468 BD89AC     JSR   $89AC     ;skip character in B
846B BD8874     JSR   $8874     ;validate numeric expression
846E BD8872     JSR   $8872     ;read numeric expression into FPA1
8471 D654       LDB   <$54      ;
8473 CA7F       ORB   #$7F      ;convert FPA1 back to standard variable
8475 D450       ANDB  <$50      ;
8477 D750       STB   <$50      ;
8479 108E8480   LDY   #$8480
847D 7E891B     JMP   $891B     ;push FPA1 onto stack & JMP ,Y
8480 8E920E     LDX   #$920E    ;FP constant 1
8483 BD93BF     JSR   $93BF     ;load variable into FPA1 (X is varptr)
8486 9DA5       JSR   <$A5      ;get current character from BASIC source
8488 81C1       CMPA  #$C1      ;token STEP
848A 2605       BNE   $8491     ;no STEP value specified
848C 9D9F       JSR   <$9F      ;get next character from BASIC source
848E BD8872     JSR   $8872     ;read numeric expression into FPA1
8491 BD9418     JSR   $9418     ;sets B to -1, 0 or 1 as per sign of FPA1
8494 BD8917     JSR   $8917     ;push B then FPA1 onto stack
8497 DC3B       LDD   <$3B      ;varptr of control variable
8499 3406       PSHS  A,B
849B 8680       LDA   #$80      ;FOR signature on stack
849D 3402       PSHS  A

*** interpreter loop

849F BD019A     JSR   $019A     ;PATCH - get command
84A2 1CAF       ANDCC #$AF      ;unmask interrupts
84A4 8D75       BSR   $851B     ;scan for BREAK / pause
84A6 9EA6       LDX   <$A6      ;BASIC source pointer
84A8 9F2F       STX   <$2F      ;address of current BASIC statement
84AA A680       LDA   ,X+
84AC 2707       BEQ   $84B5     ;end of line
84AE 813A       CMPA  #$3A   :
84B0 2724       BEQ   $84D6
84B2 7E89B4     JMP   $89B4     ;?SN ERROR
84B5 A681       LDA   ,X++
84B7 9700       STA   <$00      ;this will be zero when end reached
84B9 10270088  LBEQ   $8545     ;end of program
84BD EC80       LDD   ,X+
84BF DD68       STD   <$68      ;current line number
84C1 9FA6       STX   <$A6      ;BASIC source pointer
84C3 96AF       LDA   <$AF      ;trace flag
84C5 270F       BEQ   $84D6     ;trace off
84C7 865B       LDA   #$5B   [
84C9 BDB54A     JSR   $B54A     ;output character to DEVN
84CC 9668       LDA   <$68      ;current line number
84CE BD957A     JSR   $957A     ;print unsigned number in D
84D1 865D       LDA   #$5D   ]
84D3 BDB54A     JSR   $B54A     ;output character to DEVN
84D6 9D9F       JSR   <$9F      ;get next character from BASIC source
84D8 8D02       BSR   $84DC     ;interpret statement
84DA 20C3       BRA   $849F     ;interpreter loop

*** interpret statement

84DC 273C       BEQ   $851A     ;RTS
84DE BD0179     JSR   $0179     ;PATCH - interpreter
84E1 4D         TSTA
84E2 102A01D6  LBPL   $86BC     ;variable on LHS (LET)
84E6 81BA       CMPA  #$BA
84E8 220B       BHI   $84F5     ;not a BASIC command
84EA BE0123     LDX   $0123     ;command JMP table
84ED 48         ASLA
84EE 1F89       TFR   A,B
84F0 3A         ABX
84F1 9D9F       JSR   <$9F      ;get next character from BASIC source
84F3 6E94       JMP  (,X)
84F5 81FF       CMPA  #$FF
84F7 2708       BEQ   $8501     ;function
84F9 81CD       CMPA  #$CD
84FB 23B5       BLS   $84B2     ;?SN ERROR
84FD 6E9F012D   JMP  ($012D)    ;must be disk command
8501 9D9F       JSR   <$9F      ;get next character from BASIC source
8503 8198       CMPA  #$98
8505 10271603  LBEQ   $9B0C     ;MID$ on LHS
8509 819E       CMPA  #$9E
850B 10271842  LBEQ   $9D51     ;TIMER on LHS
850F BD01A0     JSR   $01A0     ;PATCH - CLS GET PUT ???
8512 209E       BRA   $84B2     ;?SN ERROR

*** RESTORE

8514 9E19       LDX   <$19      ;start of BASIC program
8516 301F       LEAX  -1,X
8518 9F33       STX   <$33      ;READ pointer
851A 39         RTS

*** scan keyboard for break & pause

851B BD8006     JSR   $8006     ;scan keyboard
851E 270A       BEQ   $852A
8520 8103       CMPA  #$03
8522 2715       BEQ   $8539     ;BREAK
8524 8113       CMPA  #$13
8526 2703       BEQ   $852B     ;SHIFT + @
8528 9787       STA   <$87
852A 39         RTS
852B BD8006     JSR   $8006     ;scan keyboard
852E 27FB       BEQ   $852B
8530 20EE       BRA   $8520

*** END

8532 BDB65C     JSR   $B65C     ;close cassette stream
8535 9DA5       JSR   <$A5      ;get current character from BASIC source
8537 2002       BRA   $853B

*** STOP

8539 1A01       ORCC  #$01
853B 2633       BNE   $8570     ;RTS
853D 9EA6       LDX   <$A6      ;BASIC source pointer
853F 9F2F       STX   <$2F      ;address of current BASIC statement
8541 0600       ROR   <$00      ;make -ve for STOP
8543 3262       LEAS  2,S       ;lose return address
8545 9E68       LDX   <$68      ;current line number
8547 8CFFFF     CMPX  #$FFFF
854A 2706       BEQ   $8552     ;already in command mode
854C 9F29       STX   <$29      ;CONT line number
854E 9E2F       LDX   <$2F      ;address of current BASIC statement
8550 9F2D       STX   <$2D      ;CONT source address
8552 0F6F       CLR   <$6F      ;DEVN
8554 8E82EF     LDX   #$82EF    ;/BREAK/
8557 0D00       TST   <$00
8559 102AFE14  LBPL   $8371     ;command mode
855D 7E8366     JMP   $8366     ;print BREAK message

*** CONT

8560 260E       BNE   $8570     ;RTS
8562 C620       LDB   #$20      ;?CN ERROR
8564 9E2D       LDX   <$2D      ;CONT source address
8566 1027FDDA  LBEQ   $8344     ;cause error
856A 9FA6       STX   <$A6      ;BASIC source pointer
856C 9E29       LDX   <$29      ;CONT line number
856E 9F68       STX   <$68      ;current line number
8570 39         RTS

*** CLEAR

8571 272C       BEQ   $859F     ;clear variables & reset stack
8573 BD8B23     JSR   $8B23     ;read unsigned number into $52 & D
8576 3406       PSHS  A,B
8578 9E27       LDX   <$27      ;top of BASIC RAM
857A 9DA5       JSR   <$A5      ;get current character from BASIC source
857C 270C       BEQ   $858A
857E BD89AA     JSR   $89AA     ;skip comma
8581 BD8E83     JSR   $8E83     ;read 16 bit number into X
8584 301F       LEAX  -1,X
8586 9C74       CMPX  <$74      ;top of RAM
8588 2218       BHI   $85A2     ;?OM ERROR
858A 1F10       TFR   X,D
858C A3E1       SUBD  ,S++
858E 2512       BCS   $85A2     ;?OM ERROR
8590 1F03       TFR   D,U
8592 83003A     SUBD  #$003A
8595 250B       BCS   $85A2     ;?OM ERROR
8597 931B       SUBD  <$1B      ;start of simple variables
8599 2507       BCS   $85A2     ;?OM ERROR
859B DF21       STU   <$21      ;new stack address
859D 9F27       STX   <$27      ;new top of BASIC RAM
859F 7E8424     JMP   $8424     ;clear variables & reset stack

85A2 7E8342     JMP   $8342     ;?OM ERROR

*** RUN

85A5 BD0194     JSR   $0194     ;PATCH - run
85A8 BD98E3     JSR   $98E3     ;set up sound & graphics variables
85AB BDB65C     JSR   $B65C     ;close cassette stream
85AE 9DA5       JSR   <$A5      ;get current character from BASIC source
85B0 1027FE6B  LBEQ   $841F     ;clear variables and reset stack & cmd ptr
85B4 BD8424     JSR   $8424     ;clear variables & reset stack
85B7 2019       BRA   $85D2     ;perform GOTO

*** GO  (TO/SUB)

    GOSUB creates following 5 byte stack entry:

     ,S     #$BD
    1,S     line number of GOSUB statement
    3,S     address of GOSUB statement (points to SUB token)

85B9 1F89       TFR   A,B
85BB 9D9F       JSR   <$9F      ;get next character from BASIC source
85BD C1BC       CMPB  #$BC      ;token TO
85BF 2716       BEQ   $85D7     ;perform GOTO
85C1 C1BD       CMPB  #$BD      ;token SUB
85C3 2645       BNE   $860A     ;?SN ERROR
85C5 C603       LDB   #$03
85C7 BD8331     JSR   $8331     ;memory check
85CA DEA6       LDU   <$A6      ;BASIC source pointer
85CC 9E68       LDX   <$68      ;current line number
85CE 86BD       LDA   #$BD      ;token SUB
85D0 3452       PSHS  A,X,U
85D2 8D03       BSR   $85D7     ;perform GOTO
85D4 7E849F     JMP   $849F     ;interpreter loop

*** perform GOTO

85D7 9DA5       JSR   <$A5      ;get current character from BASIC source
85D9 BD869A     JSR   $869A     ;read line number & store in $2b
85DC 8D40       BSR   $861E     ;find end of line
85DE 3001       LEAX  1,X
85E0 DC2B       LDD   <$2B
85E2 109368     CMPD  <$68      ;current line number
85E5 2202       BHI   $85E9
85E7 9E19       LDX   <$19      ;start of BASIC program
85E9 BD8403     JSR   $8403     ;scan for line D
85EC 2517       BCS   $8605     ;?UL ERROR
85EE 301F       LEAX  -1,X
85F0 9FA6       STX   <$A6      ;BASIC source pointer
85F2 39         RTS

*** RETURN

85F3 26FD       BNE   $85F2     ;RTS
85F5 86FF       LDA   #$FF
85F7 973B       STA   <$3B      ;set $3b to skip all FOR entries
85F9 BD82F7     JSR   $82F7     ;examine BASIC stack
85FC 1F14       TFR   X,S       ;point stack to this entry
85FE 813D       CMPA  #$3D
8600 270B       BEQ   $860D     ;GOSUB signature (#$BD - #$80)
8602 C604       LDB   #$04      ;?RG ERROR
8604 8C         CMPX  #
(8605 C60E       LDB   #$0E)    ;?UL ERROR
8607 7E8344     JMP   $8344     ;cause error

860A 7E89B4     JMP   $89B4     ;?SN ERROR

860D 3552       PULS  A,X,U
860F 9F68       STX   <$68      ;current line number
8611 DFA6       STU   <$A6      ;BASIC source pointer

*** DATA
    (simply skips to next statement)

8613 8D06       BSR   $861B     ;find end of statement
8615 8C         CMPX  #

*** REM / ELSE

(8616 8D06       BSR   $861E)   ;find end of line
8618 9FA6       STX   <$A6      ;BASIC source pointer
861A 39         RTS

*** find end of statement

861B C63A       LDB   #$3A   :
861D 86         LDA   #
(861E 5F         CLRB)
861F D701       STB   <$01
8621 5F         CLRB
8622 9EA6       LDX   <$A6      ;BASIC source pointer
8624 1F98       TFR   B,A
8626 D601       LDB   <$01
8628 9701       STA   <$01
862A A684       LDA   ,X
862C 27EC       BEQ   $861A     ;RTS
862E 3404       PSHS  B
8630 A1E0       CMPA  ,S+
8632 27E6       BEQ   $861A     ;RTS
8634 3001       LEAX  1,X
8636 8122       CMPA  #$22   "
8638 27EA       BEQ   $8624
863A 4C         INCA
863B 2602       BNE   $863F
863D 3001       LEAX  1,X
863F 8186       CMPA  #$86      ;token IF (+1)
8641 26E7       BNE   $862A
8643 0C04       INC   <$04      ;increment for each IF token encountered
8645 20E3       BRA   $862A

*** IF

    IF condition (THEN/GOTO) [IF...THEN [IF...THEN...ELSE] ELSE] ELSE
    --                                                           ----
    ELSEs are tied to previous IFs

8647 BD8872     JSR   $8872     ;read numeric expression into FPA1
864A 9DA5       JSR   <$A5      ;get current character from BASIC source
864C 8181       CMPA  #$81      ;token GO
864E 2705       BEQ   $8655
8650 C6BF       LDB   #$BF      ;token THEN
8652 BD89AC     JSR   $89AC     ;skip character in B
8655 964F       LDA   <$4F
8657 2613       BNE   $866C     ;IF condition true
8659 0F04       CLR   <$04      ;clear IF counter
865B 8DB6       BSR   $8613     ;skip to start of next statement
865D 4D         TSTA
865E 27BA       BEQ   $861A     ;RTS
8660 9D9F       JSR   <$9F      ;get next character from BASIC source
8662 8184       CMPA  #$84      ;token ELSE
8664 26F5       BNE   $865B     ;we're looking for ELSE
8666 0A04       DEC   <$04      ;any IFs skipped?
8668 2AF1       BPL   $865B     ;this ELSE doesn't go with this IF
866A 9D9F       JSR   <$9F      ;get next character from BASIC source
866C 9DA5       JSR   <$A5      ;get current character from BASIC source
866E 1025FF65  LBCS   $85D7     ;it's a number - perform GOTO
8672 7E84DC     JMP   $84DC     ;interpret statement

*** ON

8675 BD8E51     JSR   $8E51     ;get number into B
8678 C681       LDB   #$81      ;token GO
867A BD89AC     JSR   $89AC     ;skip character in B
867D 3402       PSHS  A
867F 81BD       CMPA  #$BD      ;token SUB
8681 2704       BEQ   $8687
8683 81BC       CMPA  #$BC      ;token TO
8685 2683       BNE   $860A     ;?SN ERROR
8687 0A53       DEC   <$53      ;control variable
8689 2605       BNE   $8690
868B 3504       PULS  B
868D 7E85BB     JMP   $85BB     ;GO (cmd pointer now at desired choice)
8690 9D9F       JSR   <$9F      ;get next character from BASIC source
8692 8D06       BSR   $869A     ;read line number & store in $2b
8694 812C       CMPA  #$2C   ,
8696 27EF       BEQ   $8687
8698 3584       PULS  B,PC

*** read line number from command & store in $2b

869A 9E8A       LDX   <$8A      ;zero
869C 9F2B       STX   <$2B
869E 2464       BCC   $8704     ;not a digit - RTS
86A0 8030       SUBA  #$30   0
86A2 9701       STA   <$01
86A4 DC2B       LDD   <$2B
86A6 8118       CMPA  #$18      ; D > 6399?
86A8 22DB       BHI   $8685     ;?SN ERROR
86AA 58         ASLB            ;
86AB 49         ROLA            ;
86AC 58         ASLB            ; D = D * 10
86AD 49         ROLA            ;
86AE D32B       ADDD  <$2B      ;
86B0 58         ASLB            ;
86B1 49         ROLA            ;
86B2 DB01       ADDB  <$01      ;add new digit
86B4 8900       ADCA  #$00      ;
86B6 DD2B       STD   <$2B
86B8 9D9F       JSR   <$9F      ;get next character from BASIC source
86BA 20E2       BRA   $869E     ;process another digit

*** LET

86BC BD8A94     JSR   $8A94     ;get varptr of variable in X
86BF 9F3B       STX   <$3B
86C1 C6CB       LDB   #$CB      ;token =
86C3 BD89AC     JSR   $89AC     ;skip character in B
86C6 9606       LDA   <$06      ;numeric / string flag
86C8 3402       PSHS  A
86CA BD8887     JSR   $8887     ;get expression
86CD 3502       PULS  A
86CF 46         RORA            ;check that variable & expression
86D0 BD8879     JSR   $8879      ;are of same type
86D3 10270D07  LBEQ   $93DE     ;assign FPA1 to varptr in <$3b
86D7 BD019D     JSR   $019D     ;PATCH - assign string variable
86DA 9E52       LDX   <$52
86DC DC21       LDD   <$21      ;stack root / string storage start
86DE 10A302     CMPD  2,X
86E1 2411       BCC   $86F4
86E3 9C1B       CMPX  <$1B      ;start of simple variables
86E5 250D       BCS   $86F4
86E7 E684       LDB   ,X
86E9 BD8C50     JSR   $8C50     ;reserve B bytes of string space
86EC 9E4D       LDX   <$4D
86EE BD8D89     JSR   $8D89     ;copy string (len B) from varptr X to ($25)+
86F1 8E0056     LDX   #$0056
86F4 9F4D       STX   <$4D
86F6 BD8DBB     JSR   $8DBB     ;if X is top of string stack then pull it
86F9 DE4D       LDU   <$4D
86FB 9E3B       LDX   <$3B
86FD 3726       PULU  A,B,Y
86FF A784       STA   ,X
8701 10AF02     STY   2,X
8704 39         RTS

*** string used by INPUT

8705  3F5245444F0D00     ;/?REDO/CR

*** take action for illegal input

870C C624       LDB   #$24      ;?FD ERROR
870E 0D6F       TST   <$6F      ;DEVN
8710 2703       BEQ   $8715
8712 7E8344     JMP   $8344     ;cause error
8715 9609       LDA   <$09
8717 2707       BEQ   $8720
8719 9E31       LDX   <$31      ;line number of current DATA statement
871B 9F68       STX   <$68      ;current line number
871D 7E89B4     JMP   $89B4     ;?SN ERROR
8720 8E8704     LDX   #$8704    ;/?REDO/
8723 BD90E5     JSR   $90E5     ;print string to DEVN
8726 9E2F       LDX   <$2F      ;address of current BASIC statement
8728 9FA6       STX   <$A6      ;BASIC source pointer
872A 39         RTS

*** INPUT

872B BD9C76     JSR   $9C76     ;test for command mode
872E 8D03       BSR   $8733
8730 0F6F       CLR   <$6F      ;DEVN
8732 39         RTS

8733 8123       CMPA  #$23   #
8735 2609       BNE   $8740
8737 BDB7D7     JSR   $B7D7     ;read #-n & set up DEVN
873A BDB623     JSR   $B623     ;test cassette status OK for input
873D BD89AA     JSR   $89AA     ;skip comma
8740 8122       CMPA  #$22   "
8742 260B       BNE   $874F     ;no prompt
8744 BD8975     JSR   $8975     ;read literal string
8747 C63B       LDB   #$3B   ;
8749 BD89AC     JSR   $89AC     ;skip character in B
874C BD90E8     JSR   $90E8     ;print prompt
874F 8E02DC     LDX   #$02DC
8752 6F84       CLR   ,X
8754 0D6F       TST   <$6F      ;DEVN
8756 2622       BNE   $877A
8758 8D06       BSR   $8760     ;get something into input buffer
875A C62C       LDB   #$2C   ,
875C E784       STB   ,X
875E 201A       BRA   $877A     ;read input into variables

8760 BD90F8     JSR   $90F8     ;print '?' to DEVN
8763 BD90F5     JSR   $90F5     ;print a space to DEVN
8766 BDB5C6     JSR   $B5C6     ;line input from DEVN
8769 2405       BCC   $8770
876B 3264       LEAS  4,S
876D 7E8541     JMP   $8541     ;BREAK
8770 C630       LDB   #$30      ;?IE ERROR
8772 0D70       TST   <$70      ;eof flag
8774 269C       BNE   $8712
8776 39         RTS

*** READ

8777 9E33       LDX   <$33      ;READ pointer
8779 864F       LDA   #$4F
877B 9709       STA   <$09
877D 9F35       STX   <$35
877F BD8A94     JSR   $8A94     ;get varptr of variable in X
8782 9F3B       STX   <$3B
8784 9EA6       LDX   <$A6      ;BASIC source pointer
8786 9F2B       STX   <$2B
8788 9E35       LDX   <$35
878A A684       LDA   ,X
878C 260C       BNE   $879A
878E 9609       LDA   <$09
8790 2658       BNE   $87EA
8792 BD017C     JSR   $017C     ;PATCH - re-request input
8795 BD90F8     JSR   $90F8     ;print '?' to DEVN
8798 8DC6       BSR   $8760
879A 9FA6       STX   <$A6      ;BASIC source pointer
879C 9D9F       JSR   <$9F      ;get next character from BASIC source
879E D606       LDB   <$06      ;numeric / string flag
87A0 2727       BEQ   $87C9
87A2 9EA6       LDX   <$A6      ;BASIC source pointer
87A4 9701       STA   <$01
87A6 8122       CMPA  #$22   "
87A8 2712       BEQ   $87BC
87AA 301F       LEAX  -1,X
87AC 4F         CLRA
87AD 9701       STA   <$01
87AF BDB595     JSR   $B595     ;initialise virtual DEVN device
87B2 0D6E       TST   <$6E      ;cassette IO flag
87B4 2606       BNE   $87BC     ;IO in progress
87B6 863A       LDA   #$3A   :
87B8 9701       STA   <$01
87BA 862C       LDA   #$2C   ,
87BC 9702       STA   <$02
87BE BD8C61     JSR   $8C61     ;compile literal string at X
87C1 BD897A     JSR   $897A
87C4 BD86D7     JSR   $86D7     ;assign string variable
87C7 2006       BRA   $87CF
87C9 BD94BD     JSR   $94BD     ;read numeric constant into FPA1
87CC BD93DE     JSR   $93DE     ;assign FPA1 to varptr in <$3b
87CF 9DA5       JSR   <$A5      ;get current character from BASIC source
87D1 2706       BEQ   $87D9
87D3 812C       CMPA  #$2C   ,
87D5 1026FF33  LBNE   $870C     ;take action for illegal input
87D9 9EA6       LDX   <$A6      ;BASIC source pointer
87DB 9F35       STX   <$35
87DD 9E2B       LDX   <$2B
87DF 9FA6       STX   <$A6      ;BASIC source pointer
87E1 9DA5       JSR   <$A5      ;get current character from BASIC source
87E3 2721       BEQ   $8806
87E5 BD89AA     JSR   $89AA     ;skip comma
87E8 2095       BRA   $877F
87EA 9FA6       STX   <$A6      ;BASIC source pointer
87EC BD861B     JSR   $861B     ;find end of statement
87EF 3001       LEAX  1,X
87F1 4D         TSTA
87F2 260A       BNE   $87FE
87F4 C606       LDB   #$06
87F6 EE81       LDU   ,X++
87F8 2741       BEQ   $883B
87FA EC81       LDD   ,X++
87FC DD31       STD   <$31      ;line number of current DATA statement
87FE A684       LDA   ,X
8800 8186       CMPA  #$86
8802 26E6       BNE   $87EA
8804 2094       BRA   $879A
8806 9E35       LDX   <$35
8808 D609       LDB   <$09
880A 1026FD0A  LBNE   $8518
880E A684       LDA   ,X
8810 2706       BEQ   $8818
8812 8E8818     LDX   #$8818
8815 7E90E5     JMP   $90E5     ;print string to DEVN
8818 39         RTS

*** string used by INPUT

8819  3F45585452412049474E4F5245440D00   ;/?EXTRA IGNORED/CR

*** NEXT

8829 2604       BNE   $882F     ;control variable specified
882B 9E8A       LDX   <$8A      ;zero
882D 2003       BRA   $8832
882F BD8A94     JSR   $8A94     ;get varptr of variable in X
8832 9F3B       STX   <$3B
8834 BD82F7     JSR   $82F7     ;examine BASIC stack
8837 2704       BEQ   $883D     ;found match
8839 C600       LDB   #$00      ;?NF ERROR
883B 2047       BRA   $8884
883D 1F14       TFR   X,S       ;point stack to this entry
883F 3003       LEAX  3,X       ;point X to STEP value
8841 BD93BF     JSR   $93BF     ;load variable into FPA1 (X is varptr)
8844 A668       LDA   8,S       ;sign of STEP value
8846 9754       STA   <$54
8848 9E3B       LDX   <$3B      ;varptr of control variable
884A BD910B     JSR   $910B     ;add varptr X to FPA1
884D BD93DE     JSR   $93DE     ;assign FPA1 to varptr in <$3b
8850 3069       LEAX  9,S       ;point X to terminating value
8852 BD9441     JSR   $9441     ;compare FPA1 - varptr X
8855 E068       SUBB  8,S       ;test depends on step direction
8857 270C       BEQ   $8865     ;terminating condition met
8859 AE6E       LDX   14,S
885B 9F68       STX   <$68      ;current line number
885D AEE810     LDX   16,S
8860 9FA6       STX   <$A6      ;BASIC source pointer
8862 7E849F     JMP   $849F     ;interpreter loop
8865 32E812     LEAS  18,S      ;finished with this entry
8868 9DA5       JSR   <$A5      ;get current character from BASIC source
886A 812C       CMPA  #$2C   ,
886C 26F4       BNE   $8862     ;no more variables after NEXT
886E 9D9F       JSR   <$9F      ;get next character from BASIC source
8870 8DBD       BSR   $882F     ;BSR used for correct stack structure
                                 ;(never returns to $8872)

*** get numeric expression into FPA1

8872 8D13       BSR   $8887     ;get expression

*** cause error if expression last evaluated not numeric

8874 1CFE       ANDCC #$FE
8876 7D         TST

*** cause error if expression last evaluated not string

(8877 1A01       ORCC  #$01)
8879 0D06       TST   <$06      ;numeric / string flag
887B 2503       BCS   $8880
887D 2A99       BPL   $8818     ;RTS
887F 8C         CMPX  #
(8880 2B96       BMI   $8818)   ;RTS
8882 C618       LDB   #$18      ;?TM ERROR
8884 7E8344     JMP   $8344     ;cause error

*** get expression

8887 8D6E       BSR   $88F7     ;move source pointer back one
8889 4F         CLRA
888A 8C         CMPX  #
(888B 3404       PSHS  B)
888D 3402       PSHS  A
888F C601       LDB   #$01
8891 BD8331     JSR   $8331     ;memory check
8894 BD8954     JSR   $8954     ;evaluate sub-expression
8897 0F3F       CLR   <$3F      ;flag used for relational operators
8899 9DA5       JSR   <$A5      ;get current character from BASIC source
889B 80CA       SUBA  #$CA      ;branch to $88B2 if token is not in the set
889D 2513       BCS   $88B2     ;  [ >, =, < ]
889F 8103       CMPA  #$03      ;
88A1 240F       BCC   $88B2     ;
88A3 8101       CMPA  #$01       ;map [0, 1, 2] to [1, 2, 4]
88A5 49         ROLA             ;
88A6 983F       EORA  <$3F      ;determine valid combination of > = <
88A8 913F       CMPA  <$3F      ;
88AA 2564       BCS   $8910     ;?SN ERROR
88AC 973F       STA   <$3F
88AE 9D9F       JSR   <$9F      ;get next character from BASIC source
88B0 20E9       BRA   $889B

*** 

88B2 D63F       LDB   <$3F      ; $3f = [ 1, 2, 3, 4, 5, 6 ]
88B4 2633       BNE   $88E9     ; for   [ >  =  >= <  <> <= ]
88B6 1024006B  LBCC   $8925
88BA 8B07       ADDA  #$07
88BC 2467       BCC   $8925     ;not a binary operator
88BE 9906       ADCA  <$06      ; A = A + 1 + ($06)
88C0 10270491  LBEQ   $8D55     ; '+' in a string expression
88C4 89FF       ADCA  #$FF      ; A = A - 1 if numeric expression
88C6 3402       PSHS  A         ;
88C8 48         ASLA            ;
88C9 ABE0       ADDA  ,S+       ; A = A * 3
88CB 8E8294     LDX   #$8294    ;binary operator precedence table
88CE 3086       LEAX  A,X
88D0 3502       PULS  A         ;precedence of last operator
88D2 A184       CMPA  ,X
88D4 2455       BCC   $892B     ;new op. has a lower precedence
88D6 8D9C       BSR   $8874     ;validate numeric expression
88D8 3402       PSHS  A
88DA 8D29       BSR   $8905     ;push op handler & FPA1 / get expression
88DC 9E3D       LDX   <$3D
88DE 3502       PULS  A
88E0 261D       BNE   $88FF
88E2 4D         TSTA
88E3 1027006A  LBEQ   $8951     ;LDB <$4F  RTS
88E7 204B       BRA   $8934

*** set up precedence / handler for rel. op.

88E9 0806       ASL   <$06      ;numeric / string flag
88EB 59         ROLB
88EC 8D09       BSR   $88F7     ;move source pointer back one
88EE 8E88FC     LDX   #$88FC
88F1 D73F       STB   <$3F
88F3 0F06       CLR   <$06      ;numeric / string flag
88F5 20D9       BRA   $88D0

*** move source pointer back one

88F7 9EA6       LDX   <$A6      ;BASIC source pointer
88F9 7E85EE     JMP   $85EE     ;subtract 1 from X & store in $a6

*** rel. op. precedence & handler

88FC  64  8A31

88FF A184       CMPA  ,X
8901 2431       BCC   $8934
8903 20D3       BRA   $88D8

*** push op handler & FPA1 onto stack / get expression

8905 EC01       LDD   1,X       ;op handler
8907 3406       PSHS  A,B
8909 8D08       BSR   $8913     ;push FPA1 onto stack
890B D63F       LDB   <$3F      ;rel. op. flag
890D 16FF7B     LBRA  $888B     ;get expression

8910 7E89B4     JMP   $89B4     ;?SN ERROR

*** push FPA1 onto stack

8913 D654       LDB   <$54
8915 A684       LDA   ,X
8917 3520       PULS  Y
8919 3404       PSHS  B
891B D64F       LDB   <$4F
891D 9E50       LDX   <$50
891F DE52       LDU   <$52
8921 3454       PSHS  B,X,U
8923 6EA4       JMP   ,Y

*** end of expression / execute operator

8925 9E8A       LDX   <$8A      ;zero
8927 A6E0       LDA   ,S+
8929 2726       BEQ   $8951     ;LDB <$4F  RTS
892B 8164       CMPA  #$64   d
892D 2703       BEQ   $8932
892F BD8874     JSR   $8874     ;validate numeric expression
8932 9F3D       STX   <$3D
8934 3504       PULS  B
8936 815A       CMPA  #$5A   Z
8938 2719       BEQ   $8953     ;RTS
893A 817D       CMPA  #$7D
893C 2715       BEQ   $8953     ;RTS
893E 54         LSRB            ;sets carry if rel. op. was for string
893F D70A       STB   <$0A      ;
8941 3552       PULS  A,X,U     ;pull FPA2 off stack
8943 975C       STA   <$5C      ;set $62 up with sign difference
8945 9F5D       STX   <$5D      ;
8947 DF5F       STU   <$5F      ;LDB <$4F
8949 3504       PULS  B         ;
894B D761       STB   <$61      ;RTS calls operator handler
894D D854       EORB  <$54      ;(with carry from above)
894F D762       STB   <$62      ;
8951 D64F       LDB   <$4F      ;
8953 39         RTS             ;

*** evaluate sub-expression ('+' & '-' treated as signs)

8954 BD018B     JSR   $018B     ;PATCH - evaluate expression
8957 0F06       CLR   <$06      ;numeric / string flag
8959 9D9F       JSR   <$9F      ;get next character from BASIC source
895B 2403       BCC   $8960
895D 7E94BD     JMP   $94BD     ;read numeric constant into FPA1
8960 BD8ADF     JSR   $8ADF     ;carry clear if A-Z
8963 245C       BCC   $89C1     ;evaluate variable
8965 812E       CMPA  #$2E   .
8967 27F4       BEQ   $895D
8969 81C4       CMPA  #$C4      ;token -
896B 274C       BEQ   $89B9     ;read expression & negate
896D 81C3       CMPA  #$C3      ;token +
896F 27E3       BEQ   $8954     ;ignore +
8971 8122       CMPA  #$22   "
8973 260A       BNE   $897F
8975 9EA6       LDX   <$A6      ;BASIC source pointer
8977 BD8C5B     JSR   $8C5B     ;compile literal string at X
897A 9E64       LDX   <$64
897C 9FA6       STX   <$A6      ;move source pointer to end of string
897E 39         RTS
897F 81C0       CMPA  #$C0      ;token NOT
8981 260D       BNE   $8990
8983 865A       LDA   #$5A   Z
8985 BD888B     JSR   $888B
8988 BD8B2D     JSR   $8B2D     ;read signed number from FPA1 to $52 & D
898B 43         COMA
898C 53         COMB
898D 7E8C37     JMP   $8C37     ;assign D to FPA1
8990 81BE       CMPA  #$BE      ;token FN
8992 1027132E  LBEQ   $9CC4
8996 8126       CMPA  #$26   &
8998 1027127F  LBEQ   $9C1B     ;read octal or hex number into $52 / $53
899C 4C         INCA
899D 272E       BEQ   $89CD     ;evaluate function
899F 8D06       BSR   $89A7     ;skip open bracket (only legal chr. left)
89A1 BD8887     JSR   $8887     ;get expression

*** check for close bracket

89A4 C629       LDB   #$29   )
89A6 8C         CMPX  #

*** check for open bracket

(89A7 C628       LDB   #$28)
89A9 8C         CMPX  #

*** check for comma

(89AA C62C       LDB   #$2C)

*** check for character in B

89AC E19F00A6   CMPB ($00A6)
89B0 2602       BNE   $89B4     ;?SN ERROR
89B2 0E9F       JMP   <$9F      ;get next character from BASIC source
89B4 C602       LDB   #$02      ;?SN ERROR
89B6 7E8344     JMP   $8344     ;cause error

*** read expression & negate FPA1

89B9 867D       LDA   #$7D
89BB BD888B     JSR   $888B
89BE 7E96DE     JMP   $96DE     ;COM $54 if FPA1 non zero

*** evaluate variable

89C1 BD8A94     JSR   $8A94     ;get varptr of variable in X
89C4 9F52       STX   <$52
89C6 9606       LDA   <$06      ;numeric / string flag
89C8 2689       BNE   $8953     ;RTS (string)
89CA 7E93BF     JMP   $93BF     ;load variable into FPA1 (X is varptr)

*** evaluate function

89CD 9D9F       JSR   <$9F      ;get next character from BASIC source
89CF 1F89       TFR   A,B
89D1 58         ASLB
89D2 9D9F       JSR   <$9F      ;get next character from BASIC source
89D4 C142       CMPB  #$42
89D6 2304       BLS   $89DC
89D8 6E9F0132   JMP  ($0132)    ;disk function despatch
89DC 3404       PSHS  B
89DE C12C       CMPB  #$2C
89E0 2522       BCS   $8A04     ;functions with single arguments
89E2 C134       CMPB  #$34
89E4 2420       BCC   $8A06     ;functions with special or no arguments
89E6 8DBF       BSR   $89A7     ;skip open bracket
89E8 A6E4       LDA   ,S
89EA 8132       CMPA  #$32
89EC 2418       BCC   $8A06     ;not LEFT$, RIGHT$ or MID$
89EE BD8887     JSR   $8887     ;get expression
89F1 8DB7       BSR   $89AA     ;skip comma
89F3 BD8877     JSR   $8877     ;validate string
89F6 3502       PULS  A
89F8 DE52       LDU   <$52
89FA 3442       PSHS  A,U
89FC BD8E51     JSR   $8E51     ;get number into B
89FF 3502       PULS  A
8A01 3406       PSHS  A,B
8A03 8E         LDX   #
(8A04 8D99       BSR   $899F)   ;get expression inside brackets
8A06 3504       PULS  B
8A08 BE0128     LDX   $0128     ;function despatch table
8A0B 3A         ABX
8A0C AD94       JSR  (,X)
8A0E 7E8874     JMP   $8874     ;validate numeric expression

*** OR

8A11 86         LDA   #

*** AND

(8A12 4F         CLRA)
8A13 9703       STA   <$03
8A15 BD8B2D     JSR   $8B2D     ;read signed number from FPA1 to $52 & D
8A18 DD01       STD   <$01
8A1A BD93F5     JSR   $93F5     ;copy FPA2 to FPA1
8A1D BD8B2D     JSR   $8B2D     ;read signed number from FPA1 to $52 & D
8A20 0D03       TST   <$03
8A22 2606       BNE   $8A2A
8A24 9401       ANDA  <$01
8A26 D402       ANDB  <$02
8A28 2004       BRA   $8A2E
8A2A 9A01       ORA   <$01
8A2C DA02       ORB   <$02
8A2E 7E8C37     JMP   $8C37     ;assign D to FPA1

*** handler for relational operators

8A31 BD8879     JSR   $8879     ;validate string / numeric using carry
8A34 2610       BNE   $8A46     ;valid string
8A36 9661       LDA   <$61
8A38 8A7F       ORA   #$7F
8A3A 945D       ANDA  <$5D
8A3C 975D       STA   <$5D
8A3E 8E005C     LDX   #$005C    ;FPA2
8A41 BD9441     JSR   $9441     ;compare FPA1 - varptr X
8A44 2036       BRA   $8A7C
8A46 0F06       CLR   <$06      ;numeric / string flag
8A48 0A3F       DEC   <$3F
8A4A BD8D9D     JSR   $8D9D     ;point X to string just compiled & len in B
8A4D D756       STB   <$56
8A4F 9F58       STX   <$58
8A51 9E5F       LDX   <$5F
8A53 BD8D9F     JSR   $8D9F     ;point X to string & length in B
8A56 9656       LDA   <$56
8A58 3404       PSHS  B
8A5A A0E0       SUBA  ,S+
8A5C 2707       BEQ   $8A65
8A5E 8601       LDA   #$01
8A60 2403       BCC   $8A65
8A62 D656       LDB   <$56
8A64 40         NEGA
8A65 9754       STA   <$54
8A67 DE58       LDU   <$58
8A69 5C         INCB
8A6A 5A         DECB
8A6B 2604       BNE   $8A71
8A6D D654       LDB   <$54
8A6F 200B       BRA   $8A7C
8A71 A680       LDA   ,X+
8A73 A1C0       CMPA  ,U+
8A75 27F3       BEQ   $8A6A
8A77 C6FF       LDB   #$FF
8A79 2401       BCC   $8A7C
8A7B 50         NEGB
8A7C CB01       ADDB  #$01      ;map [-1, 0, 1] to [1, 2, 4]
8A7E 59         ROLB            ;
8A7F D40A       ANDB  <$0A      ;rel. op. number
8A81 2702       BEQ   $8A85
8A83 C6FF       LDB   #$FF
8A85 7E9427     JMP   $9427     ;assign B to FPA1 (result of relation)

8A88 BD89AA     JSR   $89AA     ;skip comma

*** DIM

8A8B C601       LDB   #$01
8A8D 8D08       BSR   $8A97     ;create variable
8A8F 9DA5       JSR   <$A5      ;get current character from BASIC source
8A91 26F5       BNE   $8A88     ;skip comma & read next array
8A93 39         RTS

*** gets VARPTR address of following variable
    set $08 to #$80 to exclude array variables
    creates new variable if not found
    returns $39 = X = varptr address

8A94 5F         CLRB
8A95 9DA5       JSR   <$A5      ;get current character from BASIC source

*** set B to cause error if array variable already exists

8A97 D705       STB   <$05
8A99 9737       STA   <$37
8A9B 9DA5       JSR   <$A5      ;get current character from BASIC source
8A9D 8D40       BSR   $8ADF     ;carry clear if A-Z
8A9F 1025FF11  LBCS   $89B4     ;?SN ERROR
8AA3 5F         CLRB
8AA4 D706       STB   <$06      ;numeric / string flag
8AA6 9D9F       JSR   <$9F      ;get next character from BASIC source
8AA8 2504       BCS   $8AAE
8AAA 8D33       BSR   $8ADF     ;carry clear if A-Z
8AAC 250A       BCS   $8AB8
8AAE 1F89       TFR   A,B
8AB0 9D9F       JSR   <$9F      ;get next character from BASIC source
8AB2 25FC       BCS   $8AB0
8AB4 8D29       BSR   $8ADF     ;carry clear if A-Z
8AB6 24F8       BCC   $8AB0
8AB8 8124       CMPA  #$24   $
8ABA 2606       BNE   $8AC2     ;numeric variable
8ABC 0306       COM   <$06      ;numeric / string flag
8ABE CB80       ADDB  #$80
8AC0 9D9F       JSR   <$9F      ;get next character from BASIC source
8AC2 D738       STB   <$38
8AC4 9A08       ORA   <$08      ;set $08 to #$80 to exclude array variables
8AC6 8028       SUBA  #$28   (
8AC8 10270078  LBEQ   $8B44     ;array variable
8ACC 0F08       CLR   <$08
8ACE 9E1B       LDX   <$1B      ;start of simple variables
8AD0 DC37       LDD   <$37
8AD2 9C1D       CMPX  <$1D      ;start of array variables
8AD4 2712       BEQ   $8AE8     ;not found - create variable
8AD6 10A381     CMPD  ,X++
8AD9 273E       BEQ   $8B19     ;found existing variable - STX <$39 & RTS
8ADB 3005       LEAX  5,X
8ADD 20F3       BRA   $8AD2     ;keep looking

*** clear carry if A contains 'A'-'Z'

8ADF 8141       CMPA  #$41   A
8AE1 2504       BCS   $8AE7
8AE3 805B       SUBA  #$5B   [
8AE5 80A5       SUBA  #$A5
8AE7 39         RTS

*** create variable

8AE8 8E008A     LDX   #$008A
8AEB EEE4       LDU   ,S
8AED 118389C4   CMPU  #$89C4    ;if called by evaluate variable routine - RTS
8AF1 2728       BEQ   $8B1B      ;(with X pointing to zero)
8AF3 DC1F       LDD   <$1F      ;end of BASIC storage
8AF5 DD43       STD   <$43
8AF7 C30007     ADDD  #$0007
8AFA DD41       STD   <$41
8AFC 9E1D       LDX   <$1D      ;start of array variables
8AFE 9F47       STX   <$47
8B00 BD831C     JSR   $831C     ;move memory contents up
8B03 9E41       LDX   <$41
8B05 9F1F       STX   <$1F      ;end of BASIC storage
8B07 9E45       LDX   <$45
8B09 9F1D       STX   <$1D      ;start of array variables
8B0B 9E47       LDX   <$47
8B0D DC37       LDD   <$37      ;variable name
8B0F ED81       STD   ,X++
8B11 4F         CLRA
8B12 5F         CLRB
8B13 ED84       STD   ,X
8B15 ED02       STD   2,X
8B17 A704       STA   4,X
8B19 9F39       STX   <$39
8B1B 39         RTS

8B1C  90 80 00 00 00        ;FP constant -32768

*** read unsigned number into $52 & D

8B21 9D9F       JSR   <$9F      ;get next character from BASIC source
8B23 BD8872     JSR   $8872     ;read numeric expression into FPA1
8B26 BD8874     JSR   $8874     ;validate numeric expression

*** read +ve number from FPA1 into $52 & D

8B29 9654       LDA   <$54
8B2B 2B60       BMI   $8B8D     ;?FC ERROR

*** read signed number from FPA1 into $52 & D

8B2D BD8874     JSR   $8874     ;validate numeric expression
8B30 964F       LDA   <$4F
8B32 8190       CMPA  #$90
8B34 2508       BCS   $8B3E
8B36 8E8B1C     LDX   #$8B1C    ;only 16 bit number allowed is -32768
8B39 BD9441     JSR   $9441     ;compare FPA1 - varptr X
8B3C 264F       BNE   $8B8D     ;?FC ERROR
8B3E BD9473     JSR   $9473     ;denormalize FPA1 to an integer
8B41 DC52       LDD   <$52
8B43 39         RTS

*** get varptr of variable continued (handle arrays)

8B44 D605       LDB   <$05
8B46 9606       LDA   <$06      ;numeric / string flag
8B48 3406       PSHS  A,B
8B4A 5F         CLRB
8B4B 9E37       LDX   <$37
8B4D 3414       PSHS  B,X
8B4F 8DD0       BSR   $8B21     ;read unsigned number into $52 & D
8B51 3534       PULS  B,X,Y
8B53 9F37       STX   <$37
8B55 DE52       LDU   <$52
8B57 3460       PSHS  Y,U
8B59 5C         INCB
8B5A 9DA5       JSR   <$A5      ;get current character from BASIC source
8B5C 812C       CMPA  #$2C   ,
8B5E 27EB       BEQ   $8B4B     ;get next dimension
8B60 D703       STB   <$03      ;number of dimensions
8B62 BD89A4     JSR   $89A4     ;skip close bracket
8B65 3506       PULS  A,B
8B67 9706       STA   <$06      ;numeric / string flag
8B69 D705       STB   <$05
8B6B 9E1D       LDX   <$1D      ;start of array variables
8B6D 9C1F       CMPX  <$1F      ;end of BASIC storage
8B6F 2721       BEQ   $8B92     ;not found - create new array
8B71 DC37       LDD   <$37
8B73 10A384     CMPD  ,X
8B76 2706       BEQ   $8B7E     ;found array name
8B78 EC02       LDD   2,X
8B7A 308B       LEAX  D,X
8B7C 20EF       BRA   $8B6D     ;keep looking
8B7E C612       LDB   #$12      ;?DD ERROR
8B80 9605       LDA   <$05
8B82 260B       BNE   $8B8F     ;cause error if array exists & $05 set
8B84 D603       LDB   <$03
8B86 E104       CMPB  4,X
8B88 2759       BEQ   $8BE3     ;correct number of dimensions
8B8A C610       LDB   #$10      ;?BS ERROR
8B8C 8C         CMPX  #
(8B8D C608       LDB   #$08)    ;?FC ERROR
8B8F 7E8344     JMP   $8344     ;cause error
8B92 CC0005     LDD   #$0005    ;bytes per element
8B95 DD64       STD   <$64
8B97 DC37       LDD   <$37
8B99 ED84       STD   ,X        ;array name
8B9B D603       LDB   <$03
8B9D E704       STB   4,X       ;number of dimensions
8B9F BD8331     JSR   $8331     ;memory check
8BA2 9F41       STX   <$41      ;start of array header
8BA4 C60B       LDB   #$0B      ;default number of elements
8BA6 4F         CLRA
8BA7 0D05       TST   <$05
8BA9 2705       BEQ   $8BB0
8BAB 3506       PULS  A,B
8BAD C30001     ADDD  #$0001
8BB0 ED05       STD   5,X
8BB2 8D5D       BSR   $8C11     ;D = word at 5,X * word at $64
8BB4 DD64       STD   <$64
8BB6 3002       LEAX  2,X
8BB8 0A03       DEC   <$03
8BBA 26E8       BNE   $8BA4     ;next dimension
8BBC 9F0F       STX   <$0F      ;start of array element storage
8BBE D30F       ADDD  <$0F      ;D = end of array
8BC0 1025F77E  LBCS   $8342     ;?OM ERROR
8BC4 1F01       TFR   D,X
8BC6 BD8335     JSR   $8335     ;memory check (also adds #$3a to D)
8BC9 830035     SUBD  #$0035
8BCC DD1F       STD   <$1F      ;end of BASIC storage
8BCE 4F         CLRA
8BCF 301F       LEAX  -1,X      ;clear array
8BD1 A705       STA   5,X       ;
8BD3 9C0F       CMPX  <$0F      ;
8BD5 26F8       BNE   $8BCF     ;
8BD7 9E41       LDX   <$41      ;array header
8BD9 961F       LDA   <$1F      ;end of BASIC storage
8BDB 9341       SUBD  <$41
8BDD ED02       STD   2,X       ;offset to next array (when it's created)
8BDF 9605       LDA   <$05
8BE1 262D       BNE   $8C10     ;RTS
8BE3 E604       LDB   4,X
8BE5 D703       STB   <$03
8BE7 4F         CLRA
8BE8 5F         CLRB
8BE9 DD64       STD   <$64
8BEB 3506       PULS  A,B
8BED DD52       STD   <$52
8BEF 10A305     CMPD  5,X
8BF2 243A       BCC   $8C2E     ;?BS ERROR
8BF4 DE64       LDU   <$64
8BF6 2704       BEQ   $8BFC
8BF8 8D17       BSR   $8C11     ;D = word at 5,X * word at $64
8BFA D352       ADDD  <$52
8BFC 3002       LEAX  2,X
8BFE 0A03       DEC   <$03
8C00 26E7       BNE   $8BE9
8C02 EDE3       STD   ,--S      ;
8C04 58         ASLB            ;
8C05 49         ROLA            ;
8C06 58         ASLB            ;
8C07 49         ROLA            ;
8C08 E3E1       ADDD  ,S++      ; D = D * 5
8C0A 308B       LEAX  D,X
8C0C 3005       LEAX  5,X
8C0E 9F39       STX   <$39
8C10 39         RTS

*** D = word at 5,X * word at $64

8C11 8610       LDA   #$10
8C13 9745       STA   <$45
8C15 EC05       LDD   5,X
8C17 DD17       STD   <$17
8C19 4F         CLRA
8C1A 5F         CLRB
8C1B 58         ASLB
8C1C 49         ROLA
8C1D 250F       BCS   $8C2E     ;?BS ERROR
8C1F 0865       ASL   <$65
8C21 0964       ROL   <$64
8C23 2404       BCC   $8C29
8C25 D317       ADDD  <$17
8C27 2505       BCS   $8C2E     ;?BS ERROR
8C29 0A45       DEC   <$45
8C2B 26EE       BNE   $8C1B
8C2D 39         RTS

8C2E 7E8B8A     JMP   $8B8A     ;?BS ERROR

*** MEM

8C31 1F40       TFR   S,D
8C33 931F		SUBD   <$1F      ;end of BASIC storage
8C35 21			BRN   

*** assign B to FPA1

(8C36 4F         CLRA)

*** assign D to FPA1 (signed)

8C37 0F06       CLR   <$06      ;numeric / string flag
8C39 DD50       STD   <$50
8C3B C690       LDB   #$90
8C3D 7E942D     JMP   $942D     ;signed assign!

*** STR$

8C40 BD8874     JSR   $8874     ;validate numeric expression
8C43 CE03D9     LDU   #$03D9
8C46 BD958A     JSR   $958A     ;convert FPA1 to string at U
8C49 3262       LEAS  2,S       ;lose return address
8C4B 8E03D8     LDX   #$03D8
8C4E 200B       BRA   $8C5B     ;compile literal string at X

*** reserve B bytes of string space
    returns X = $58 = start of requested block
            B = $56 = length of block

8C50 9F4D       STX   <$4D
8C52 8D5F       BSR   $8CB3     ;reserve B bytes of string space
8C54 9F58       STX   <$58
8C56 D756       STB   <$56
8C58 39         RTS

*** register a delimited string pointed to by X
    if string is in keyboard buffer, then copy it into free string space.
    stores string start, end & length in $62, $64 & $56
    string start also in $58
    if copied to string space, start & end also in $58 & $4d

8C59 301F       LEAX  -1,X
8C5B 8622       LDA   #$22   "
8C5D 9701       STA   <$01
8C5F 9702       STA   <$02
8C61 3001       LEAX  1,X
8C63 9F62       STX   <$62
8C65 9F58       STX   <$58
8C67 C6FF       LDB   #$FF
8C69 5C         INCB
8C6A A680       LDA   ,X+
8C6C 270C       BEQ   $8C7A
8C6E 9101       CMPA  <$01
8C70 2704       BEQ   $8C76
8C72 9102       CMPA  <$02
8C74 26F3       BNE   $8C69
8C76 8122       CMPA  #$22   "
8C78 2702       BEQ   $8C7C
8C7A 301F       LEAX  -1,X
8C7C 9F64       STX   <$64
8C7E D756       STB   <$56
8C80 BD0197     JSR   $0197     ;PATCH - reset BASIC memory
8C83 DE62       LDU   <$62
8C85 118303D9   CMPU  #$03D9
8C89 2207       BHI   $8C92     ;push temp string onto varptr stack
8C8B 8DC3       BSR   $8C50     ;reserve B bytes of string space
8C8D 9E62       LDX   <$62
8C8F BD8D8B     JSR   $8D8B     ;copy string of length B from X+ to ($25)+
8C92 9E0B       LDX   <$0B
8C94 8C01D1     CMPX  #$01D1
8C97 2605       BNE   $8C9E
8C99 C61E       LDB   #$1E      ;?ST ERROR
8C9B 7E8344     JMP   $8344     ;cause error
8C9E 9656       LDA   <$56
8CA0 A700       STA   0,X
8CA2 DC58       LDD   <$58
8CA4 ED02       STD   2,X
8CA6 86FF       LDA   #$FF
8CA8 9706       STA   <$06      ;numeric / string flag
8CAA 9F0D       STX   <$0D
8CAC 9F52       STX   <$52
8CAE 3005       LEAX  5,X
8CB0 9F0B       STX   <$0B
8CB2 39         RTS

*** reserve B bytes of string space
    returns X = pointer to requested block & B = length
    requested block also in $25

8CB3 0F07       CLR   <$07
8CB5 4F         CLRA
8CB6 3406       PSHS  A,B
8CB8 DC23       LDD   <$23      ;top of free string space
8CBA A3E0       SUBD  ,S+
8CBC 109321     CMPD  <$21      ;stack root / string storage start
8CBF 250A       BCS   $8CCB     ;not enough space
8CC1 DD23       STD   <$23      ;new free pointer
8CC3 9E23       LDX   <$23
8CC5 3001       LEAX  1,X
8CC7 9F25       STX   <$25      ;points to requested block
8CC9 3584       PULS  B,PC

8CCB C61A       LDB   #$1A      ;?OS ERROR
8CCD 0307       COM   <$07
8CCF 27CA       BEQ   $8C9B     ;already done garbage collect - give up
8CD1 8D04       BSR   $8CD7     ;string garbage collect
8CD3 3504       PULS  B
8CD5 20DE       BRA   $8CB5     ;try to reserve space again

*** string space garbage collect

8CD7 9E27       LDX   <$27      ;top of BASIC RAM
8CD9 9F23       STX   <$23      ;top of free string space
8CDB 4F         CLRA
8CDC 5F         CLRB
8CDD DD4B       STD   <$4B
8CDF 9E21       LDX   <$21      ;stack root / string storage start
8CE1 9F47       STX   <$47
8CE3 8E01A9     LDX   #$01A9
8CE6 9C0B       CMPX  <$0B
8CE8 2704       BEQ   $8CEE
8CEA 8D32       BSR   $8D1E
8CEC 20F8       BRA   $8CE6
8CEE 9E1B       LDX   <$1B      ;start of simple variables
8CF0 9C1D       CMPX  <$1D      ;start of array variables
8CF2 2704       BEQ   $8CF8
8CF4 8D22       BSR   $8D18
8CF6 20F8       BRA   $8CF0
8CF8 9F41       STX   <$41
8CFA 9E41       LDX   <$41
8CFC 9C1F       CMPX  <$1F      ;end of BASIC storage
8CFE 2735       BEQ   $8D35
8D00 EC02       LDD   2,X
8D02 D341       ADDD  <$41
8D04 DD41       STD   <$41
8D06 A601       LDA   1,X
8D08 2AF0       BPL   $8CFA
8D0A E604       LDB   4,X
8D0C 58         ASLB
8D0D CB05       ADDB  #$05
8D0F 3A         ABX
8D10 9C41       CMPX  <$41
8D12 27E8       BEQ   $8CFC
8D14 8D08       BSR   $8D1E
8D16 20F8       BRA   $8D10
8D18 A601       LDA   1,X
8D1A 3002       LEAX  2,X
8D1C 2A14       BPL   $8D32
8D1E E684       LDB   ,X
8D20 2710       BEQ   $8D32
8D22 EC02       LDD   2,X
8D24 109323     CMPD  <$23      ;top of free string space
8D27 2209       BHI   $8D32
8D29 109347     CMPD  <$47
8D2C 2304       BLS   $8D32
8D2E 9F4B       STX   <$4B
8D30 DD47       STD   <$47
8D32 3005       LEAX  5,X
8D34 39         RTS
8D35 9E4B       LDX   <$4B
8D37 27FB       BEQ   $8D34
8D39 4F         CLRA
8D3A E684       LDB   ,X
8D3C 5A         DECB
8D3D D347       ADDD  <$47
8D3F DD43       STD   <$43
8D41 9E23       LDX   <$23      ;top of free string space
8D43 9F41       STX   <$41
8D45 BD831E     JSR   $831E     ;move memory contents up (no memory check)
8D48 9E4B       LDX   <$4B
8D4A DC45       LDD   <$45
8D4C ED02       STD   2,X
8D4E 9E45       LDX   <$45
8D50 301F       LEAX  -1,X
8D52 7E8CD9     JMP   $8CD9

*** handle '+' in a string expression (concatenate)

8D55 DC52       LDD   <$52
8D57 3406       PSHS  A,B
8D59 BD8954     JSR   $8954     ;evaluate sub-expression
8D5C BD8877     JSR   $8877     ;validate string expression
8D5F 3510       PULS  X
8D61 9F62       STX   <$62
8D63 E684       LDB   ,X
8D65 9E52       LDX   <$52
8D67 EB84       ADDB  ,X        ;add string lengths
8D69 2405       BCC   $8D70     ;not too long
8D6B C61C       LDB   #$1C      ;?LS ERROR
8D6D 7E8344     JMP   $8344     ;cause error
8D70 BD8C50     JSR   $8C50     ;reserve B bytes of string space
8D73 9E62       LDX   <$62
8D75 E684       LDB   ,X
8D77 8D10       BSR   $8D89     ;copy string (len B) from varptr X to ($25)+
8D79 9E4D       LDX   <$4D
8D7B 8D22       BSR   $8D9F     ;point X to string & length in B
8D7D 8D0C       BSR   $8D8B     ;copy string of length B from X+ to ($25)+
8D7F 9E62       LDX   <$62
8D81 8D1C       BSR   $8D9F     ;point X to string & length in B
8D83 BD8C92     JSR   $8C92     ;push temp string onto varptr stack
8D86 7E8899     JMP   $8899     ;back to expression handler

*** copy string of length B from varptr X to ($25)+

8D89 AE02       LDX   2,X

*** copy string of length B from X+ to ($25)+

8D8B DE25       LDU   <$25
8D8D 5C         INCB
8D8E 2004       BRA   $8D94
8D90 A680       LDA   ,X+
8D92 A7C0       STA   ,U+
8D94 5A         DECB
8D95 26F9       BNE   $8D90
8D97 DF25       STU   <$25
8D99 39         RTS

*** validate result of string expression
    point X to 1st character & length in B
    (if it is the most recent temp string then delete it)

8D9A BD8877     JSR   $8877     ;validate string expression
8D9D 9E52       LDX   <$52
8D9F E684       LDB   ,X
8DA1 8D18       BSR   $8DBB     ;if X is top of string stack then pull it
8DA3 2613       BNE   $8DB8     ;normal varptr
8DA5 AE07       LDX   7,X
8DA7 301F       LEAX  -1,X
8DA9 9C23       CMPX  <$23      ;top of free string space
8DAB 2608       BNE   $8DB5
8DAD 3404       PSHS  B
8DAF D323       ADDD  <$23      ;top of free string space
8DB1 DD23       STD   <$23      ;top of free string space
8DB3 3504       PULS  B
8DB5 3001       LEAX  1,X
8DB7 39         RTS
8DB8 AE02       LDX   2,X
8DBA 39         RTS

*** if X is top of string stack then pull it

8DBB 9C0D       CMPX  <$0D
8DBD 2607       BNE   $8DC6
8DBF 9F0B       STX   <$0B
8DC1 301B       LEAX  -5,X
8DC3 9F0D       STX   <$0D
8DC5 4F         CLRA
8DC6 39         RTS

*** LEN

8DC7 8D03       BSR   $8DCC     ;validate string & test length
8DC9 7E8C36     JMP   $8C36     ;assign B to FPA1

*** validate string & test length

8DCC 8DCC       BSR   $8D9A     ;validate string & point X to it
8DCE 0F06       CLR   <$06      ;numeric / string flag
8DD0 5D         TSTB
8DD1 39         RTS

*** CHR$

8DD2 BD8E54     JSR   $8E54     ;read 8 bit value into B from FPA1
8DD5 C601       LDB   #$01
8DD7 BD8CB3     JSR   $8CB3     ;reserve B bytes of string space
8DDA 9653       LDA   <$53
8DDC BD8C54     JSR   $8C54     ;store string details as for temp string
8DDF A784       STA   ,X
8DE1 3262       LEAS  2,S
8DE3 7E8C92     JMP   $8C92     ;push temp string onto varptr stack

*** ASC

8DE6 8D02       BSR   $8DEA     ;get 1st character of string into B
8DE8 20DF       BRA   $8DC9     ;assign B to FPA1

*** get 1st character of string into B

8DEA 8DE0       BSR   $8DCC     ;validate string & test length
8DEC 275E       BEQ   $8E4C     ;?FC ERROR
8DEE E684       LDB   ,X
8DF0 39         RTS

*** LEFT$

8DF1 8D48       BSR   $8E3B     ;get str varptr in X & $4D, arg. in A & B
8DF3 4F         CLRA
8DF4 E184       CMPB  ,X
8DF6 2303       BLS   $8DFB     ;number of chrs <= string length
8DF8 E684       LDB   ,X
8DFA 4F         CLRA
8DFB 3406       PSHS  A,B
8DFD BD8C52     JSR   $8C52     ;reserve B bytes of string space
8E00 9E4D       LDX   <$4D
8E02 8D9B       BSR   $8D9F     ;point X to string & length in B
8E04 3504       PULS  B
8E06 3A         ABX             ;adjust string start for MID$ / RIGHT$
8E07 3504       PULS  B
8E09 BD8D8B     JSR   $8D8B     ;copy string of length B from X+ to ($25)+
8E0C 20D5       BRA   $8DE3     ;push temp string onto varptr stack

*** RIGHT$

8E0E 8D2B       BSR   $8E3B     ;get str varptr in X & $4D, arg. in A & B
8E10 A084       SUBA  ,X
8E12 40         NEGA            ;A = string length - argument
8E13 20DF       BRA   $8DF4     ;create new string

*** MID$

8E15 C6FF       LDB   #$FF      ;default length
8E17 D753       STB   <$53
8E19 9DA5       JSR   <$A5      ;get current character from BASIC source
8E1B 8129       CMPA  #$29   )
8E1D 2705       BEQ   $8E24     ;length not specified
8E1F BD89AA     JSR   $89AA     ;skip comma
8E22 8D2D       BSR   $8E51     ;get number into B (& $53)
8E24 8D15       BSR   $8E3B     ;get str varptr in X & $4D, arg. in A & B
8E26 2724       BEQ   $8E4C     ;?FC ERROR
8E28 5F         CLRB
8E29 4A         DECA            ;A = pos - 1
8E2A A184       CMPA  ,X
8E2C 24CD       BCC   $8DFB     ;pos past end - create empty string
8E2E 1F89       TFR   A,B
8E30 E084       SUBB  ,X
8E32 50         NEGB            ;B = string length - pos
8E33 D153       CMPB  <$53
8E35 23C4       BLS   $8DFB     ;no. of chrs available <= requested length
8E37 D653       LDB   <$53
8E39 20C0       BRA   $8DFB     ;use requested length

*** called by LEFT$, RIGHT$ & MID$
    get string varptr in X & $4D, argument in A & B

8E3B BD89A4     JSR   $89A4     ;skip close bracket
8E3E EEE4       LDU   ,S
8E40 AE65       LDX   5,S
8E42 9F4D       STX   <$4D
8E44 A664       LDA   4,S
8E46 E664       LDB   4,S
8E48 3267       LEAS  7,S
8E4A 1F35       TFR   U,PC

8E4C 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** skip character & get 8 bit value into B

8E4F 9D9F       JSR   <$9F      ;get next character from BASIC source

*** read 8 bit value into B

8E51 BD8872     JSR   $8872     ;read numeric expression into FPA1

*** read 8 bit value into B from FPA1

8E54 BD8B26     JSR   $8B26     ;read unsigned number into $52 & D from FPA1
8E57 4D         TSTA
8E58 26F2       BNE   $8E4C     ;?FC ERROR
8E5A 0EA5       JMP   <$A5      ;get current character from BASIC source

*** VAL

8E5C BD8DCC     JSR   $8DCC     ;validate string & test length
8E5F 1027031F  LBEQ   $9182     ;clear exponents in FPA1 ($4f & $54)
8E63 DEA6       LDU   <$A6      ;save source pointer
8E65 9FA6       STX   <$A6      ;point source pointer to start of string
8E67 3A         ABX
8E68 A684       LDA   ,X        ;save byte at end of string
8E6A 3452       PSHS  A,X,U
8E6C 6F84       CLR   ,X        ;put a zero at end of string
8E6E 9DA5       JSR   <$A5      ;get current character from BASIC source
8E70 BD94BD     JSR   $94BD     ;read numeric expression into FPA1
8E73 3552       PULS  A,X,U
8E75 A784       STA   ,X        ;restore byte at end of string
8E77 DFA6       STU   <$A6      ;restore source pointer
8E79 39         RTS

*** read pair of numbers from command
    1st in $2b / $2c & 2nd in B

8E7A 8D07       BSR   $8E83     ;read 16 bit number into X
8E7C 9F2B       STX   <$2B
8E7E BD89AA     JSR   $89AA     ;skip comma
8E81 20CE       BRA   $8E51     ;get number into B

*** read 16 bit unsigned number into X

8E83 BD8872     JSR   $8872     ;read numeric expression into FPA1

*** read 16 bit unsigned number into X from FPA1

8E86 9654       LDA   <$54
8E88 2BC2       BMI   $8E4C     ;?FC ERROR
8E8A 964F       LDA   <$4F
8E8C 8190       CMPA  #$90
8E8E 22BC       BHI   $8E4C     ;?FC ERROR
8E90 BD9473     JSR   $9473     ;denormalize FPA1 to an integer
8E93 9E52       LDX   <$52
8E95 39         RTS

*** PEEK

8E96 8DEE       BSR   $8E86     ;read 16 bit number into X from FPA1
8E98 E684       LDB   ,X
8E9A 7E8C36     JMP   $8C36     ;assign B to FPA1

*** POKE

8E9D 8DDB       BSR   $8E7A     ;read pair of numbers into $2b/2c & B
8E9F 9E2B       LDX   <$2B
8EA1 E784       STB   ,X
8EA3 39         RTS

*** LLIST

8EA4 C6FE       LDB   #$FE
8EA6 D76F       STB   <$6F      ;DEVN
8EA8 9DA5       JSR   <$A5      ;get current character from BASIC source

*** LIST

8EAA 3401       PSHS  CC
8EAC BD869A     JSR   $869A     ;read line number & store in $2b
8EAF BD83FF     JSR   $83FF     ;search program for line number in <$2b
8EB2 9F66       STX   <$66
8EB4 3501       PULS  CC
8EB6 2712       BEQ   $8ECA
8EB8 9DA5       JSR   <$A5      ;get current character from BASIC source
8EBA 2713       BEQ   $8ECF
8EBC 81C4       CMPA  #$C4      ;token -
8EBE 2609       BNE   $8EC9
8EC0 9D9F       JSR   <$9F      ;get next character from BASIC source
8EC2 2706       BEQ   $8ECA
8EC4 BD869A     JSR   $869A     ;read line number & store in $2b
8EC7 2706       BEQ   $8ECF
8EC9 39         RTS
8ECA CEFFFF     LDU   #$FFFF
8ECD DF2B       STU   <$2B
8ECF 3262       LEAS  2,S
8ED1 9E66       LDX   <$66
8ED3 BD90A5     JSR   $90A5     ;initialise virtual DEVN device & new line
8ED6 BDB77B     JSR   $B77B     ;scan for BREAK & pause if DEVN is not -1
8ED9 EC84       LDD   ,X
8EDB 2608       BNE   $8EE5
8EDD BDB663     JSR   $B663     ;close DEVN stream
8EE0 0F6F       CLR   <$6F      ;DEVN
8EE2 7E8371     JMP   $8371     ;command mode
8EE5 9F66       STX   <$66
8EE7 EC02       LDD   2,X
8EE9 10932B     CMPD  <$2B
8EEC 22EF       BHI   $8EDD
8EEE BD957A     JSR   $957A     ;print unsigned number in D
8EF1 BD90F5     JSR   $90F5     ;print a space to DEVN
8EF4 9E66       LDX   <$66
8EF6 8D10       BSR   $8F08     ;detokenize BASIC line
8EF8 AE9F0066   LDX  ($0066)
8EFC CE02DD     LDU   #$02DD
8EFF A6C0       LDA   ,U+
8F01 27D0       BEQ   $8ED3
8F03 BD90FA     JSR   $90FA     ;output character to DEVN
8F06 20F7       BRA   $8EFF

*** detokenize BASIC line

8F08 BD01A6     JSR   $01A6     ;PATCH - detokenize
8F0B 3004       LEAX  4,X
8F0D 108E02DD   LDY   #$02DD
8F11 A680       LDA   ,X+
8F13 2751       BEQ   $8F66
8F15 2B15       BMI   $8F2C
8F17 813A       CMPA  #$3A   :
8F19 260D       BNE   $8F28
8F1B E684       LDB   ,X
8F1D C184       CMPB  #$84
8F1F 27F0       BEQ   $8F11
8F21 C183       CMPB  #$83
8F23 27EC       BEQ   $8F11
8F25 8C8621     CMPX  #$8621
8F28 8D30       BSR   $8F5A
8F2A 20E5       BRA   $8F11
8F2C CE0116     LDU   #$0116
8F2F 81FF       CMPA  #$FF
8F31 2604       BNE   $8F37
8F33 A680       LDA   ,X+
8F35 3345       LEAU  5,U
8F37 847F       ANDA  #$7F
8F39 334A       LEAU  10,U
8F3B 6DC4       TST   ,U
8F3D 27E7       BEQ   $8F26
8F3F A0C4       SUBA  ,U
8F41 2AF6       BPL   $8F39
8F43 ABC4       ADDA  ,U
8F45 EE41       LDU   1,U
8F47 4A         DECA
8F48 2B06       BMI   $8F50
8F4A 6DC0       TST   ,U+
8F4C 2AFC       BPL   $8F4A
8F4E 20F7       BRA   $8F47
8F50 A6C4       LDA   ,U
8F52 8D06       BSR   $8F5A
8F54 6DC0       TST   ,U+
8F56 2AF8       BPL   $8F50
8F58 20B7       BRA   $8F11
8F5A 108C03D6   CMPY  #$03D6
8F5E 2406       BCC   $8F66
8F60 847F       ANDA  #$7F
8F62 A7A0       STA   ,Y+
8F64 6FA4       CLR   ,Y
8F66 39         RTS

*** tokenize BASIC line

8F67 BD01A3     JSR   $01A3     ;PATCH - tokenize
8F6A 9EA6       LDX   <$A6      ;BASIC source pointer
8F6C CE02DC     LDU   #$02DC
8F6F 0F43       CLR   <$43
8F71 0F44       CLR   <$44
8F73 A680       LDA   ,X+
8F75 2721       BEQ   $8F98
8F77 0D43       TST   <$43
8F79 270F       BEQ   $8F8A
8F7B BD8ADF     JSR   $8ADF     ;carry clear if A-Z
8F7E 2418       BCC   $8F98
8F80 8130       CMPA  #$30   0
8F82 2504       BCS   $8F88
8F84 8139       CMPA  #$39   9
8F86 2310       BLS   $8F98
8F88 0F43       CLR   <$43
8F8A 8120       CMPA  #$20
8F8C 270A       BEQ   $8F98
8F8E 9742       STA   <$42
8F90 8122       CMPA  #$22   "
8F92 2738       BEQ   $8FCC
8F94 0D44       TST   <$44
8F96 2719       BEQ   $8FB1
8F98 A7C0       STA   ,U+
8F9A 2706       BEQ   $8FA2
8F9C 813A       CMPA  #$3A   :
8F9E 27CF       BEQ   $8F6F
8FA0 20D1       BRA   $8F73
8FA2 6FC0       CLR   ,U+
8FA4 6FC0       CLR   ,U+
8FA6 1F30       TFR   U,D
8FA8 8302DA     SUBD  #$02DA
8FAB 8E02DB     LDX   #$02DB
8FAE 9FA6       STX   <$A6      ;BASIC source pointer
8FB0 39         RTS
8FB1 813F       CMPA  #$3F   ?
8FB3 2604       BNE   $8FB9
8FB5 8687       LDA   #$87
8FB7 20DF       BRA   $8F98
8FB9 8127       CMPA  #$27   '
8FBB 2613       BNE   $8FD0
8FBD CC3A83     LDD   #$3A83
8FC0 EDC1       STD   ,U++
8FC2 0F42       CLR   <$42
8FC4 A680       LDA   ,X+
8FC6 27D0       BEQ   $8F98
8FC8 9142       CMPA  <$42
8FCA 27CC       BEQ   $8F98
8FCC A7C0       STA   ,U+
8FCE 20F4       BRA   $8FC4
8FD0 8130       CMPA  #$30   0
8FD2 2504       BCS   $8FD8
8FD4 813C       CMPA  #$3C   <
8FD6 25C0       BCS   $8F98
8FD8 301F       LEAX  -1,X
8FDA 3450       PSHS  X,U
8FDC 0F41       CLR   <$41
8FDE CE0116     LDU   #$0116
8FE1 0F42       CLR   <$42
8FE3 334A       LEAU  10,U
8FE5 A6C4       LDA   ,U
8FE7 2731       BEQ   $901A
8FE9 10AE41     LDY   1,U
8FEC AEE4       LDX   ,S
8FEE E6A0       LDB   ,Y+
8FF0 E080       SUBB  ,X+
8FF2 27FA       BEQ   $8FEE
8FF4 C180       CMPB  #$80
8FF6 2638       BNE   $9030
8FF8 3262       LEAS  2,S
8FFA 3540       PULS  U
8FFC DA42       ORB   <$42
8FFE 9641       LDA   <$41
9000 2606       BNE   $9008
9002 C184       CMPB  #$84
9004 2606       BNE   $900C
9006 863A       LDA   #$3A   :
9008 EDC1       STD   ,U++
900A 2094       BRA   $8FA0
900C E7C0       STB   ,U+
900E C186       CMPB  #$86
9010 2602       BNE   $9014
9012 0C44       INC   <$44
9014 C182       CMPB  #$82
9016 27AA       BEQ   $8FC2
9018 2086       BRA   $8FA0
901A CE011B     LDU   #$011B
901D 0341       COM   <$41
901F 26C0       BNE   $8FE1
9021 3550       PULS  X,U
9023 A680       LDA   ,X+
9025 A7C0       STA   ,U+
9027 BD8ADF     JSR   $8ADF     ;carry clear if A-Z
902A 25EC       BCS   $9018
902C 0343       COM   <$43
902E 20E8       BRA   $9018
9030 0C42       INC   <$42
9032 4A         DECA
9033 27AE       BEQ   $8FE3
9035 313F       LEAY  -1,Y
9037 E6A0       LDB   ,Y+
9039 2AFC       BPL   $9037
903B 20AF       BRA   $8FEC

*** PRINT

903D 2762       BEQ   $90A1     ;send CR to DEVN
903F 8D03       BSR   $9044
9041 0F6F       CLR   <$6F      ;DEVN
9043 39         RTS

9044 8140       CMPA  #$40   @
9046 2605       BNE   $904D
9048 BDB786     JSR   $B786     ;handle PRINT@
904B 200A       BRA   $9057
904D 8123       CMPA  #$23   #
904F 260D       BNE   $905E
9051 BDB7D7     JSR   $B7D7     ;read #-n & set up DEVN
9054 BDB63C     JSR   $B63C     ;if DEVN = -1, test cassette OK for output
9057 9DA5       JSR   <$A5      ;get current character from BASIC source
9059 2746       BEQ   $90A1     ;send CR to DEVN
905B BD89AA     JSR   $89AA     ;skip comma
905E 81CD       CMPA  #$CD      ;token USING
9060 102711C1  LBEQ   $A225
9064 2748       BEQ   $90AE     ;RTS
9066 81BB       CMPA  #$BB      ;token TAB(
9068 275D       BEQ   $90C7
906A 812C       CMPA  #$2C   ,
906C 2741       BEQ   $90AF
906E 813B       CMPA  #$3B   ;
9070 276E       BEQ   $90E0     ;skip semicolon
9072 BD8887     JSR   $8887     ;get expression
9075 9606       LDA   <$06      ;numeric / string flag
9077 3402       PSHS  A
9079 2606       BNE   $9081     ;string expression
907B BD9587     JSR   $9587     ;convert FPA1 to string at $3DA
907E BD8C59     JSR   $8C59     ;register string at X
9081 8D65       BSR   $90E8     ;print string just compiled
9083 3504       PULS  B
9085 BDB595     JSR   $B595     ;initialise virtual DEVN device
9088 0D6E       TST   <$6E      ;cassette IO flag
908A 2706       BEQ   $9092     ;no IO in progress
908C 8D13       BSR   $90A1     ;send CR to DEVN
908E 9DA5       JSR   <$A5      ;get current character from BASIC source
9090 20D2       BRA   $9064
9092 5D         TSTB
9093 2608       BNE   $909D     ;string just printed so no space
9095 9DA5       JSR   <$A5      ;get current character from BASIC source
9097 812C       CMPA  #$2C   ,
9099 2714       BEQ   $90AF
909B 8D58       BSR   $90F5     ;print a space to DEVN
909D 9DA5       JSR   <$A5      ;get current character from BASIC source
909F 26C5       BNE   $9066

*** send CR to DEVN

90A1 860D       LDA   #$0D
90A3 2055       BRA   $90FA     ;output character to DEVN

*** initialise virtual DEVN device & new line

90A5 BDB595     JSR   $B595     ;initialise virtual DEVN device
90A8 27F7       BEQ   $90A1     ;send CR to DEVN
90AA 966C       LDA   <$6C      ;device current column
90AC 26F3       BNE   $90A1     ;send CR to DEVN
90AE 39         RTS

*** called by PRINT to handle ,

90AF BDB595     JSR   $B595     ;initialise virtual DEVN device
90B2 270A       BEQ   $90BE
90B4 D66C       LDB   <$6C      ;device current column
90B6 D16B       CMPB  <$6B      ;device last comma field
90B8 2506       BCS   $90C0
90BA 8DE5       BSR   $90A1     ;send CR to DEVN
90BC 2022       BRA   $90E0
90BE D66C       LDB   <$6C      ;device current column
90C0 D06A       SUBB  <$6A      ;device comma field width
90C2 24FC       BCC   $90C0
90C4 50         NEGB
90C5 2010       BRA   $90D7

*** called by PRINT to handle TAB

90C7 BD8E4F     JSR   $8E4F     ;skip character & get number in B
90CA 8129       CMPA  #$29   )
90CC 1026F8E4  LBNE   $89B4     ;?SN ERROR
90D0 BDB595     JSR   $B595     ;initialise virtual DEVN device
90D3 D06C       SUBB  <$6C      ;device current column
90D5 2309       BLS   $90E0
90D7 0D6E       TST   <$6E      ;cassette IO flag
90D9 2605       BNE   $90E0     ;IO in progress
90DB 8D18       BSR   $90F5     ;print a space to DEVN
90DD 5A         DECB
90DE 26FB       BNE   $90DB
90E0 9D9F       JSR   <$9F      ;get next character from BASIC source
90E2 7E9064     JMP   $9064

*** print string to DEVN

90E5 BD8C5B     JSR   $8C5B     ;compile literal string at X
90E8 BD8D9D     JSR   $8D9D     ;point X to string just compiled & len in B
90EB 5C         INCB
90EC 5A         DECB
90ED 27BF       BEQ   $90AE     ;RTS
90EF A680       LDA   ,X+
90F1 8D07       BSR   $90FA     ;output character to DEVN
90F3 20F7       BRA   $90EC

*** print a space to DEVN

90F5 8620       LDA   #$20
90F7 8C         CMPX  #

*** print '?' to DEVN

(90F8 863F       LDA   #$3F)
90FA 7EB54A     JMP   $B54A     ;output character to DEVN

*** add 0.5 to FPA1

90FD 8E966E     LDX   #$966E    ;FP constant 0.5
9100 2009       BRA   $910B     ;add varptr X to FPA1

*** subtract FPA1 from varptr X

9102 BD92DA     JSR   $92DA     ;load FPA2 from varptr X
9105 0354       COM   <$54
9107 0362       COM   <$62
9109 2003       BRA   $910E

*** add varptr X to FPA1

910B BD92DA     JSR   $92DA     ;load FPA2 from varptr X
910E 5D         TSTB            ;FPA1 exponent
910F 102702E2  LBEQ   $93F5     ;copy FPA2 to FPA1 (because FPA1 zero)
9113 8E005C     LDX   #$005C    ;FPA2
9116 1F89       TFR   A,B       ;A = B = FPA2 exponent
9118 5D         TSTB
9119 276C       BEQ   $9187     ;RTS (FPA2 is zero)
911B D04F       SUBB  <$4F      ;B = FPA2 exponent - FPA1 exponent
911D 2769       BEQ   $9188     ;FPA1 & FPA2 same order
911F 250A       BCS   $912B     ;FPA1 higher order
9121 974F       STA   <$4F
9123 9661       LDA   <$61
9125 9754       STA   <$54
9127 8E004F     LDX   #$004F    ;FPA1
912A 50         NEGB
912B C1F8       CMPB  #$F8
912D 2F59       BLE   $9188     ;more than 8 bits to shift
912F 4F         CLRA
9130 6401       LSR   1,X
9132 BD9203     JSR   $9203     ;shift mantissa of varptr X right -B bits
9135 D662       LDB   <$62         ;(carries into A)
9137 2A0B       BPL   $9144     ;FPA1 & FPA2 same sign
9139 6301       COM   1,X       ;
913B 6302       COM   2,X       ;2's complement FPA1
913D 6303       COM   3,X       ;carry is picked up below
913F 6304       COM   4,X       ;
9141 43         COMA            ;
9142 8900       ADCA  #$00      ;
9144 9763       STA   <$63
9146 9653       LDA   <$53      ;
9148 9960       ADCA  <$60      ;add mantissa in FPA2 to FPA1
914A 9753       STA   <$53      ;
914C 9652       LDA   <$52      ;
914E 995F       ADCA  <$5F      ;
9150 9752       STA   <$52      ;
9152 9651       LDA   <$51      ;
9154 995E       ADCA  <$5E      ;
9156 9751       STA   <$51      ;
9158 9650       LDA   <$50      ;
915A 995D       ADCA  <$5D      ;
915C 9750       STA   <$50      ;
915E 5D         TSTB
915F 2A44       BPL   $91A5     ;signs were same
9161 2502       BCS   $9165     ;normalize FPA1
9163 8D5D       BSR   $91C2     ;2's complent mantissa in FPA1
9165 5F         CLRB
9166 9650       LDA   <$50
9168 262E       BNE   $9198     ;normalize bit-wise
916A 9651       LDA   <$51
916C 9750       STA   <$50
916E 9652       LDA   <$52
9170 9751       STA   <$51
9172 9653       LDA   <$53
9174 9752       STA   <$52
9176 9663       LDA   <$63
9178 9753       STA   <$53
917A 0F63       CLR   <$63
917C CB08       ADDB  #$08
917E C128       CMPB  #$28
9180 2DE4       BLT   $9166
9182 4F         CLRA
9183 974F       STA   <$4F
9185 9754       STA   <$54
9187 39         RTS
9188 8D6D       BSR   $91F7     ;shift mantissa of varptr X right -B bits
918A 5F         CLRB
918B 20A8       BRA   $9135

918D 5C         INCB
918E 0863       ASL   <$63
9190 0953       ROL   <$53
9192 0952       ROL   <$52
9194 0951       ROL   <$51
9196 0950       ROL   <$50
9198 2AF3       BPL   $918D
919A 964F       LDA   <$4F
919C 3404       PSHS  B
919E A0E0       SUBA  ,S+
91A0 974F       STA   <$4F
91A2 23DE       BLS   $9182     ;clear exponents in FPA1 ($4f & $54)
91A4 8C         CMPX  #
(91A5 2508       BCS   $91AF)
91A7 0863       ASL   <$63
91A9 8600       LDA   #$00
91AB 9763       STA   <$63
91AD 200C       BRA   $91BB
91AF 0C4F       INC   <$4F
91B1 2728       BEQ   $91DB     ;?OV ERROR
91B3 0650       ROR   <$50
91B5 0651       ROR   <$51
91B7 0652       ROR   <$52
91B9 0653       ROR   <$53
91BB 2404       BCC   $91C1
91BD 8D0D       BSR   $91CC     ;add the carry to mantissa in FPA1
91BF 27EE       BEQ   $91AF
91C1 39         RTS

*** 2's complement mantissa in FPA1

91C2 0354       COM   <$54
91C4 0350       COM   <$50
91C6 0351       COM   <$51
91C8 0352       COM   <$52
91CA 0353       COM   <$53
91CC 9E52       LDX   <$52
91CE 3001       LEAX  1,X
91D0 9F52       STX   <$52
91D2 2606       BNE   $91DA
91D4 9E50       LDX   <$50
91D6 3001       LEAX  1,X
91D8 9F50       STX   <$50
91DA 39         RTS

91DB C60A       LDB   #$0A      ;?OV ERROR
91DD 7E8344     JMP   $8344     ;cause error

*** shift $13 - $16 & $63 right -B bits
    (shifts 8 bits before testing B)

91E0 8E0012     LDX   #$0012
91E3 A604       LDA   4,X
91E5 9763       STA   <$63
91E7 A603       LDA   3,X
91E9 A704       STA   4,X
91EB A602       LDA   2,X
91ED A703       STA   3,X
91EF A601       LDA   1,X
91F1 A702       STA   2,X
91F3 965B       LDA   <$5B
91F5 A701       STA   1,X

*** shift mantissa of varptr X right -B bits

91F7 CB08       ADDB  #$08
91F9 2FE8       BLE   $91E3
91FB 9663       LDA   <$63
91FD C008       SUBB  #$08
91FF 270C       BEQ   $920D     ;RTS
9201 6701       ASR   1,X
9203 6602       ROR   2,X
9205 6603       ROR   3,X
9207 6604       ROR   4,X
9209 46         RORA
920A 5C         INCB
920B 26F4       BNE   $9201
920D 39         RTS

920E  8100000000     ;FP constant 1

*** log series coefficients

9213  03
9214  7F5E56CB79     ;FP constant .4342559419
9219  80139B0B64     ;FP constant .5765845412
921E  8076389316     ;FP constant .9618007592
9223  8238AA3B20     ;FP constant 2.885390073

9228  803504F334     ;FP constant root 2 / 2
922D  813504F334     ;FP constant root 2
9232  8080000000     ;FP constant -0.5
9237  80317217F8     ;FP constant ln2

*** LOG

923C BD9418     JSR   $9418     ;sets B to -1, 0 or 1 as per sign of FPA1
923F 102FF94A  LBLE   $8B8D     ;?FC ERROR
9243 8E9228     LDX   #$9228    ;FP constant root 2 / 2
9246 964F       LDA   <$4F
9248 8080       SUBA  #$80
924A 3402       PSHS  A
924C 8680       LDA   #$80
924E 974F       STA   <$4F
9250 BD910B     JSR   $910B     ;add varptr X to FPA1
9253 8E922D     LDX   #$922D    ;FP constant root 2
9256 BD933A     JSR   $933A     ;FPA1 = varptr X / FPA1
9259 8E920E     LDX   #$920E    ;FP constant 1
925C BD9102     JSR   $9102     ;FPA1 = varptr X - FPA1
925F 8E9213     LDX   #$9213    ;series coefficients
9262 BD9743     JSR   $9743     ;calculate odd power series
9265 8E9232     LDX   #$9232    ;FP constant -0.5
9268 BD910B     JSR   $910B     ;add varptr X to FPA1
926B 3504       PULS  B
926D BD9547     JSR   $9547     ;add B to FPA1
9270 8E9237     LDX   #$9237    ;FP constant ln2

*** multiply FPA1 by varptr X

9273 8D65       BSR   $92DA     ;load FPA2 from varptr X
9275 2762       BEQ   $92D9     ;RTS (FPA1 zero)
9277 8D7A       BSR   $92F3     ;add A to exponent in FPA1
9279 8600       LDA   #$00
927B 9713       STA   <$13
927D 9714       STA   <$14
927F 9715       STA   <$15
9281 9716       STA   <$16
9283 D653       LDB   <$53
9285 8D22       BSR   $92A9     ;multiply mantissa in FPA2 by B
9287 D663       LDB   <$63
9289 D7AE       STB   <$AE
928B D652       LDB   <$52
928D 8D1A       BSR   $92A9     ;multiply mantissa in FPA2 by B
928F D663       LDB   <$63
9291 D7AD       STB   <$AD
9293 D651       LDB   <$51
9295 8D12       BSR   $92A9     ;multiply mantissa in FPA2 by B
9297 D663       LDB   <$63
9299 D7AC       STB   <$AC
929B D650       LDB   <$50
929D 8D0E       BSR   $92AD
929F D663       LDB   <$63
92A1 D7AB       STB   <$AB
92A3 BD93B6     JSR   $93B6     ;copy mantissa from $13 - $16 to FPA1
92A6 7E9165     JMP   $9165     ;normalize FPA1

*** multiply mantissa in FPA2 by B
    accumulate result in $13 - $16 & $63 & shift result right 8 bits

92A9 1027FF33  LBEQ   $91E0     ;B=0 (shift $13 - $16 & $63 right 8 bits)
92AD 43         COMA
92AE 9613       LDA   <$13
92B0 56         RORB
92B1 2726       BEQ   $92D9     ;RTS
92B3 2416       BCC   $92CB
92B5 9616       LDA   <$16
92B7 9B60       ADDA  <$60
92B9 9716       STA   <$16
92BB 9615       LDA   <$15
92BD 995F       ADCA  <$5F
92BF 9715       STA   <$15
92C1 9614       LDA   <$14
92C3 995E       ADCA  <$5E
92C5 9714       STA   <$14
92C7 9613       LDA   <$13
92C9 995D       ADCA  <$5D
92CB 46         RORA
92CC 9713       STA   <$13
92CE 0614       ROR   <$14
92D0 0615       ROR   <$15
92D2 0616       ROR   <$16
92D4 0663       ROR   <$63
92D6 4F         CLRA
92D7 20D5       BRA   $92AE
92D9 39         RTS

*** load FPA2 from varptr X & set $62 with FPA1 / FPA2 sign difference 
    A = exponent from FPA2
    B = exponent from FPA1

92DA EC01       LDD   1,X
92DC 9761       STA   <$61
92DE 8A80       ORA   #$80
92E0 DD5D       STD   <$5D
92E2 D661       LDB   <$61
92E4 D854       EORB  <$54
92E6 D762       STB   <$62
92E8 EC03       LDD   3,X
92EA DD5F       STD   <$5F
92EC A684       LDA   ,X
92EE 975C       STA   <$5C
92F0 D64F       LDB   <$4F
92F2 39         RTS

*** add A to exponent in FPA1

92F3 4D         TSTA
92F4 2716       BEQ   $930C
92F6 9B4F       ADDA  <$4F
92F8 46         RORA
92F9 49         ROLA
92FA 2810       BVC   $930C
92FC 8B80       ADDA  #$80
92FE 974F       STA   <$4F
9300 270C       BEQ   $930E     ;clear exponents in FPA1 ($4f & $54)
9302 9662       LDA   <$62      ;sign difference FPA1 / FPA2
9304 9754       STA   <$54
9306 39         RTS

9307 9654       LDA   <$54
9309 43         COMA
930A 2002       BRA   $930E
930C 3262       LEAS  2,S
930E 102AFE70  LBPL   $9182     ;clear exponents in FPA1 ($4f & $54)
9312 7E91DB     JMP   $91DB     ;?OV ERROR

*** multiply FPA1 by 10

9315 BD940A     JSR   $940A     ;copy FPA1 to FPA2
9318 270D       BEQ   $9327
931A 8B02       ADDA  #$02      ; x4
931C 25F4       BCS   $9312     ;?OV ERROR
931E 0F62       CLR   <$62
9320 BD9116     JSR   $9116     ;add FPA2 to FPA1 (FPA1 exponent in A)
9323 0C4F       INC   <$4F      ;double result
9325 27EB       BEQ   $9312     ;?OV ERROR
9327 39         RTS

9328  8420000000     ;FP constant 10

*** divide FPA1 by 10

932D BD940A     JSR   $940A     ;copy FPA1 to FPA2
9330 8E9328     LDX   #$9328    ;FP constant 10
9333 5F         CLRB
9334 D762       STB   <$62
9336 BD93BF     JSR   $93BF     ;load variable into FPA1 (X is varptr)
9339 8C         CMPX  #

*** divide varptr X by FPA1

(933A 8D9E       BSR   $92DA)   ;load FPA2 from varptr X
933C 2773       BEQ   $93B1     ;?/0 ERROR (FPA1 zero)
933E 004F       NEG   <$4F
9340 8DB1       BSR   $92F3     ;add A to exponent in FPA1
9342 0C4F       INC   <$4F
9344 27CC       BEQ   $9312     ;?OV ERROR
9346 8E0013     LDX   #$0013
9349 C604       LDB   #$04
934B D703       STB   <$03
934D C601       LDB   #$01
934F 9650       LDA   <$50
9351 915D       CMPA  <$5D
9353 2613       BNE   $9368
9355 9651       LDA   <$51
9357 915E       CMPA  <$5E
9359 260D       BNE   $9368
935B 9652       LDA   <$52
935D 915F       CMPA  <$5F
935F 2607       BNE   $9368
9361 9653       LDA   <$53
9363 9160       CMPA  <$60
9365 2601       BNE   $9368
9367 43         COMA            ;identical mantissas - set carry
9368 1FA8       TFR   CC,A
936A 59         ROLB
936B 240A       BCC   $9377
936D E780       STB   ,X+
936F 0A03       DEC   <$03
9371 2B34       BMI   $93A7
9373 272E       BEQ   $93A3
9375 C601       LDB   #$01
9377 1F8A       TFR   A,CC
9379 250E       BCS   $9389
937B 0860       ASL   <$60
937D 095F       ROL   <$5F
937F 095E       ROL   <$5E
9381 095D       ROL   <$5D
9383 25E3       BCS   $9368
9385 2BC8       BMI   $934F
9387 20DF       BRA   $9368
9389 9660       LDA   <$60
938B 9053       SUBA  <$53
938D 9760       STA   <$60
938F 965F       LDA   <$5F
9391 9252       SBCA  <$52
9393 975F       STA   <$5F
9395 965E       LDA   <$5E
9397 9251       SBCA  <$51
9399 975E       STA   <$5E
939B 965D       LDA   <$5D
939D 9250       SBCA  <$50
939F 975D       STA   <$5D
93A1 20D8       BRA   $937B
93A3 C640       LDB   #$40   @
93A5 20D0       BRA   $9377
93A7 56         RORB
93A8 56         RORB
93A9 56         RORB
93AA D763       STB   <$63
93AC 8D08       BSR   $93B6     ;copy mantissa from $13 - $16 to FPA1
93AE 7E9165     JMP   $9165     ;normalize FPA1

93B1 C614       LDB   #$14      ;?/0 ERROR
93B3 7E8344     JMP   $8344     ;cause error

*** copy mantissa from $13 - $16 to FPA1

93B6 9E13       LDX   <$13
93B8 9F50       STX   <$50
93BA 9E15       LDX   <$15
93BC 9F52       STX   <$52
93BE 39         RTS

*** load variable into FPA1 (X is varptr)

93BF 3402       PSHS  A
93C1 EC01       LDD   1,X
93C3 9754       STA   <$54
93C5 8A80       ORA   #$80
93C7 DD50       STD   <$50
93C9 0F63       CLR   <$63
93CB E684       LDB   ,X
93CD AE03       LDX   3,X
93CF 9F52       STX   <$52
93D1 D74F       STB   <$4F
93D3 3582       PULS  A,PC

*** assign FPA1 to variable store $45 - $49

93D5 8E0045     LDX   #$0045
93D8 2006       BRA   $93E0     ;assign FPA1 to varptr in X

*** assign FPA1 to variable store $40 - $44

93DA 8E0040     LDX   #$0040
93DD 8C         CMPX  #

*** assign FPA1 to varptr in <$3b

(93DE 9E3B       LDX   <$3B)

*** assign FPA1 to varptr in X

93E0 964F       LDA   <$4F
93E2 A784       STA   ,X
93E4 9654       LDA   <$54
93E6 8A7F       ORA   #$7F
93E8 9450       ANDA  <$50
93EA A701       STA   1,X
93EC 9651       LDA   <$51
93EE A702       STA   2,X
93F0 DE52       LDU   <$52
93F2 EF03       STU   3,X
93F4 39         RTS

*** copy FPA2 to FPA1 (A = sign)

93F5 9661       LDA   <$61
93F7 9754       STA   <$54
93F9 9E5C       LDX   <$5C
93FB 9F4F       STX   <$4F
93FD 0F63       CLR   <$63
93FF 965E       LDA   <$5E
9401 9751       STA   <$51
9403 9654       LDA   <$54
9405 9E5F       LDX   <$5F
9407 9F52       STX   <$52
9409 39         RTS

*** copy FPA1 to FPA2 & test for exponent = 0

940A DC4F       LDD   <$4F
940C DD5C       STD   <$5C
940E 9E51       LDX   <$51
9410 9F5E       STX   <$5E
9412 9E53       LDX   <$53
9414 9F60       STX   <$60
9416 4D         TSTA
9417 39         RTS

*** sets B to -1, 0 or 1 according to sign of FPA1

9418 D64F       LDB   <$4F
941A 2708       BEQ   $9424
941C D654       LDB   <$54
941E 59         ROLB
941F C6FF       LDB   #$FF
9421 2501       BCS   $9424
9423 50         NEGB
9424 39         RTS

*** SGN

9425 8DF1       BSR   $9418     ;sets B to -1, 0 or 1 as per sign of FPA1
9427 D750       STB   <$50
9429 0F51       CLR   <$51
942B C688       LDB   #$88
942D 9650       LDA   <$50
942F 8080       SUBA  #$80      ;set carry according to sign
9431 D74F       STB   <$4F
9433 DC8A       LDD   <$8A      ;zero
9435 DD52       STD   <$52
9437 9763       STA   <$63
9439 9754       STA   <$54
943B 7E9161     JMP   $9161     ;normalize FPA1 (if carry clear, negate 1st)

*** ABS

943E 0F54       CLR   <$54      ;simply clear sign byte
9440 39         RTS

*** compare FPA1 - varptr X  (set B to -1, 0 or 1)

9441 E684       LDB   ,X
9443 27D3       BEQ   $9418     ;sets B to -1, 0 or 1 as per sign of FPA1
9445 E601       LDB   1,X
9447 D854       EORB  <$54
9449 2BD1       BMI   $941C     ;set B to -1 or 1 as per sign of FPA1

*** compare FPA1 - varptr X (of same sign)

944B D64F       LDB   <$4F
944D E184       CMPB  ,X
944F 261D       BNE   $946E
9451 E601       LDB   1,X
9453 CA7F       ORB   #$7F
9455 D450       ANDB  <$50
9457 E101       CMPB  1,X
9459 2613       BNE   $946E
945B D651       LDB   <$51
945D E102       CMPB  2,X
945F 260D       BNE   $946E
9461 D652       LDB   <$52
9463 E103       CMPB  3,X
9465 2607       BNE   $946E
9467 D653       LDB   <$53
9469 E004       SUBB  4,X
946B 2601       BNE   $946E
946D 39         RTS
946E 56         RORB            ;turn carry into sign
946F D854       EORB  <$54
9471 20AB       BRA   $941E     ;reduce B to +/- 1

*** denormalize FPA1 to an integer (but don't update exponent)

9473 D64F       LDB   <$4F
9475 273D       BEQ   $94B4     ;clear mantissa in FPA1
9477 C0A0       SUBB  #$A0
9479 9654       LDA   <$54
947B 2A05       BPL   $9482
947D 035B       COM   <$5B
947F BD91C4     JSR   $91C4     ;2's complement mantissa in FPA1 (not $54)
9482 8E004F     LDX   #$004F    ;FPA1
9485 C1F8       CMPB  #$F8
9487 2E06       BGT   $948F
9489 BD91F7     JSR   $91F7     ;shift mantissa of varptr X right -B bits
948C 0F5B       CLR   <$5B
948E 39         RTS
948F 0F5B       CLR   <$5B
9491 9654       LDA   <$54
9493 49         ROLA
9494 0650       ROR   <$50
9496 7E9203     JMP   $9203     ;shift mantissa of varptr X right -B bits

*** INT

9499 D64F       LDB   <$4F
949B C1A0       CMPB  #$A0      ;when exponent >= $A0, no fractional part
949D 241D       BCC   $94BC     ;RTS (already an integer)
949F 8DD2       BSR   $9473     ;denormalize FPA1 to an integer
94A1 D763       STB   <$63
94A3 9654       LDA   <$54
94A5 D754       STB   <$54
94A7 8080       SUBA  #$80
94A9 86A0       LDA   #$A0
94AB 974F       STA   <$4F
94AD 9653       LDA   <$53
94AF 9701       STA   <$01
94B1 7E9161     JMP   $9161     ;normalize FPA1 (if carry clear, negate 1st)

*** clear mantissa in FPA1

94B4 D750       STB   <$50
94B6 D751       STB   <$51
94B8 D752       STB   <$52
94BA D753       STB   <$53
94BC 39         RTS

*** read a numeric constant into FPA1

94BD 9E8A       LDX   <$8A      ;zero
94BF 9F54       STX   <$54
94C1 9F4F       STX   <$4F
94C3 9F51       STX   <$51
94C5 9F52       STX   <$52
94C7 9F47       STX   <$47      ;$47 & $48 = decimal exponent & sign 
94C9 9F45       STX   <$45      ;$45 & $46 decimal place counter & flag
94CB 2567       BCS   $9534     ;read sig. figs. into FPA1
94CD 8126       CMPA  #$26   &
94CF 10270748  LBEQ   $9C1B     ;read hex or octal
94D3 812D       CMPA  #$2D   -
94D5 2604       BNE   $94DB
94D7 0355       COM   <$55
94D9 2004       BRA   $94DF
94DB 812B       CMPA  #$2B   +
94DD 2604       BNE   $94E3
94DF 9D9F       JSR   <$9F      ;get next character from BASIC source
94E1 2551       BCS   $9534     ;read sig. figs. into FPA1
94E3 812E       CMPA  #$2E   .
94E5 2728       BEQ   $950F
94E7 8145       CMPA  #$45   E
94E9 2628       BNE   $9513     ;finished reading number, now finalise.
94EB 9D9F       JSR   <$9F      ;get next character from BASIC source
94ED 2564       BCS   $9553     ;read decimal exponent into $47
94EF 81C4       CMPA  #$C4      ;token -
94F1 270E       BEQ   $9501
94F3 812D       CMPA  #$2D   -
94F5 270A       BEQ   $9501
94F7 81C3       CMPA  #$C3      ;token +
94F9 2708       BEQ   $9503
94FB 812B       CMPA  #$2B   +
94FD 2704       BEQ   $9503
94FF 2006       BRA   $9507
9501 0348       COM   <$48
9503 9D9F       JSR   <$9F      ;get next character from BASIC source
9505 254C       BCS   $9553     ;read decimal exponent into $47
9507 0D48       TST   <$48
9509 2708       BEQ   $9513     ;finished reading number, now finalise.
950B 0047       NEG   <$47      ;-ve exponent
950D 2004       BRA   $9513     ;finished reading number, now finalise.
950F 0346       COM   <$46
9511 26CC       BNE   $94DF     ;1st decimal point encountered

*** finished reading number, now finalise.

9513 9647       LDA   <$47
9515 9045       SUBA  <$45
9517 9747       STA   <$47
9519 2712       BEQ   $952D
951B 2A09       BPL   $9526
951D BD932D     JSR   $932D     ;divide FPA1 by 10
9520 0C47       INC   <$47
9522 26F9       BNE   $951D
9524 2007       BRA   $952D
9526 BD9315     JSR   $9315     ;multiply FPA1 by 10
9529 0A47       DEC   <$47
952B 26F9       BNE   $9526
952D 9655       LDA   <$55
952F 2A8B       BPL   $94BC     ;RTS
9531 7E96DE     JMP   $96DE     ;COM $54 if FPA1 non zero

*** read sig. figs. into FPA1

9534 D645       LDB   <$45      ;increment decimal place counter
9536 D046       SUBB  <$46      ;if decimal point passed
9538 D745       STB   <$45      ;
953A 3402       PSHS  A
953C BD9315     JSR   $9315     ;multiply FPA1 by 10
953F 3504       PULS  B
9541 C030       SUBB  #$30   0
9543 8D02       BSR   $9547     ;add B to FPA1
9545 2098       BRA   $94DF

*** add B to FPA1

9547 BD93DA     JSR   $93DA     ;assign FPA1 to variable store $40 - $44
954A BD9427     JSR   $9427     ;assign B to FPA1
954D 8E0040     LDX   #$0040
9550 7E910B     JMP   $910B     ;add varptr X to FPA1

*** read decimal exponent into $47
    (note that it doesn't check for more than two digits)

9553 D647       LDB   <$47      ;
9555 58         ASLB            ;
9556 58         ASLB            ;
9557 DB47       ADDB  <$47      ;
9559 58         ASLB            ; B = 10 * $47
955A 8030       SUBA  #$30
955C 3404       PSHS  B
955E ABE0       ADDA  ,S+
9560 9747       STA   <$47
9562 209F       BRA   $9503

*** used by print number routine

9564  9B3EBC1FFD    ;FP constant 99999999.9
9569  9E6E6B27FD    ;FP constant 999999999
956E  9E6E6B2800    ;FP constant 1000000000

*** print 'IN xxxx' (current line number)

9573 8E82E5     LDX   #$82E5
9576 8D0C       BSR   $9584
9578 DC68       LDD   <$68      ;current line number

*** print unsigned number in D

957A DD50       STD   <$50
957C C690       LDB   #$90
957E 43         COMA            ;set carry for correct result
957F BD9431     JSR   $9431     ;normalize FPA1 using exponent in B
9582 8D03       BSR   $9587     ;convert FPA1 to string at $3DA
9584 7E90E5     JMP   $90E5     ;print string to DEVN

*** convert FPA1 to string at $3DA

9587 CE03DA     LDU   #$03DA
958A 8620       LDA   #$20
958C D654       LDB   <$54
958E 2A02       BPL   $9592
9590 862D       LDA   #$2D
9592 A7C0       STA   ,U+       ;print '-' for negative numbers else space
9594 DF64       STU   <$64
9596 9754       STA   <$54
9598 8630       LDA   #$30
959A D64F       LDB   <$4F
959C 102700C6  LBEQ   $9666     ;number is zero
95A0 4F         CLRA
95A1 C180       CMPB  #$80
95A3 2208       BHI   $95AD     ;number >= 1
95A5 8E956E     LDX   #$956E    ;FP constant 1000000000
95A8 BD9273     JSR   $9273     ;multiply varptr X & FPA1
95AB 86F7       LDA   #$F7      ;-9
95AD 9745       STA   <$45      ;decimal exponent
95AF 8E9569     LDX   #$9569    ;FP constant 999999999
95B2 BD944B     JSR   $944B     ;compare FPA1 - varptr X (of same sign)
95B5 2E0F       BGT   $95C6
95B7 8E9564     LDX   #$9564    ;FP constant 99999999.9
95BA BD944B     JSR   $944B     ;compare FPA1 - varptr X (of same sign)
95BD 2E0E       BGT   $95CD      ;(FPA1 is now 100000000 to 999999999)
95BF BD9315     JSR   $9315     ;multiply FPA1 by 10
95C2 0A45       DEC   <$45       ;correct exponent
95C4 20F1       BRA   $95B7
95C6 BD932D     JSR   $932D     ;divide FPA1 by 10
95C9 0C45       INC   <$45       ;correct exponent
95CB 20E2       BRA   $95AF
95CD BD90FD     JSR   $90FD     ;add 0.5 to FPA1 (round it up)
95D0 BD9473     JSR   $9473     ;denormalize FPA1 to an integer
95D3 C601       LDB   #$01      ;1 digit before point for sci. notation
95D5 9645       LDA   <$45
95D7 8B0A       ADDA  #$0A      ;exponent now 2 more than it should be
95D9 2B09       BMI   $95E4     ;actual exponent < -2 (use sci. notation)
95DB 810B       CMPA  #$0B
95DD 2405       BCC   $95E4     ;actual exponent >= 9 (use sci. notation)
95DF 4A         DECA
95E0 1F89       TFR   A,B       ;number of digits before point = exp + 1
95E2 8602       LDA   #$02
95E4 4A         DECA
95E5 4A         DECA
95E6 9747       STA   <$47      ;decimal exponent
95E8 D745       STB   <$45      ;number of digits before decimal point
95EA 2E0D       BGT   $95F9     ;no leading decimal point
95EC DE64       LDU   <$64
95EE 862E       LDA   #$2E
95F0 A7C0       STA   ,U+
95F2 5D         TSTB            ;can only be zero or -ve here
95F3 2704       BEQ   $95F9     ;no zero reqd after point & before 1st digit 
95F5 8630       LDA   #$30
95F7 A7C0       STA   ,U+
95F9 8E9673     LDX   #$9673
95FC C680       LDB   #$80      ;sign bit used for zero crossing logic
95FE 9653       LDA   <$53      ;resolves a decimal digit by adding powers
9600 AB03       ADDA  3,X       ;of 10 until zero is passed.
9602 9753       STA   <$53      ;
9604 9652       LDA   <$52      ;
9606 A902       ADCA  2,X       ;On 1st pass -ve values are used to get FPA1
9608 9752       STA   <$52      ;below zero. The digit is no. of loops - 1.
960A 9651       LDA   <$51      ;
960C A901       ADCA  1,X       ;On 2nd pass +ve values are used to get FPA1
960E 9751       STA   <$51      ;above zero. The digit is 10 - no. loops.
9610 9650       LDA   <$50      ;
9612 A984       ADCA  ,X        ;This continues with alternating signs.
9614 9750       STA   <$50
9616 5C         INCB            ;loop counter
9617 56         RORB            ;logic to test if zero passed
9618 59         ROLB            ;
9619 28E3       BVC   $95FE     ;
961B 2403       BCC   $9620     ;digit = loops - 1
961D C00B       SUBB  #$0B
961F 50         NEGB
9620 CB2F       ADDB  #$2F      ;1 less & ASCII conversion
9622 3004       LEAX  4,X
9624 1F98       TFR   B,A
9626 847F       ANDA  #$7F      ;lose sign bit
9628 A7C0       STA   ,U+
962A 0A45       DEC   <$45
962C 2604       BNE   $9632     ;haven't reached decimal point yet
962E 862E       LDA   #$2E
9630 A7C0       STA   ,U+
9632 53         COMB            ;alternates B between $00 & $80
9633 C480       ANDB  #$80      ;
9635 8C9697     CMPX  #$9697
9638 26C4       BNE   $95FE
963A A6C2       LDA   ,-U       ;backtrack over digits
963C 8130       CMPA  #$30      ;until non-zero found
963E 27FA       BEQ   $963A     ;
9640 812E       CMPA  #$2E
9642 2602       BNE   $9646     ;if no sig. figs. after decimal point
9644 335F       LEAU  -1,U      ;then lose it.
9646 862B       LDA   #$2B   +
9648 D647       LDB   <$47
964A 271C       BEQ   $9668     ;normal number (no decimal exponent)
964C 2A03       BPL   $9651     ;+ve exponent
964E 862D       LDA   #$2D   -
9650 50         NEGB
9651 A742       STA   2,U
9653 8645       LDA   #$45   E
9655 A741       STA   1,U
9657 862F       LDA   #$2F      ;convert B to ASCII number in D
9659 4C         INCA            ;
965A C00A       SUBB  #$0A      ;
965C 24FB       BCC   $9659     ;
965E CB3A       ADDB  #$3A      ;
9660 ED43       STD   3,U
9662 6F45       CLR   5,U       ;terminate string
9664 2004       BRA   $966A
9666 A7C4       STA   ,U
9668 6F41       CLR   1,U       ;terminate string
966A 8E03DA     LDX   #$03DA
966D 39         RTS

966E  8000000000    ;FP constant 0.5

*** table of 32 bit numbers used by convert number to string routine 
    (to resolve decimal digits)

9673  FA0A1F00      ; -100000000
9677  00989680      ;   10000000
967B  FFF0BDC0      ;   -1000000
967F  000186A0      ;     100000
9683  FFFFD8F0      ;     -10000
9687  000003E8      ;       1000
968B  FFFFFF9C      ;       -100
968F  0000000A      ;         10
9693  FFFFFFFF      ;         -1

*** SQR

9697 BD940A     JSR   $940A     ;copy FPA1 to FPA2
969A 8E966E     LDX   #$966E    ;FP constant 0.5

*** raise FPA2 to power varptr X

969D BD93BF     JSR   $93BF     ;load variable into FPA1 (X is varptr)
96A0 2771       BEQ   $9713     ;EXP
96A2 4D         TSTA
96A3 2609       BNE   $96AE
96A5 9654       LDA   <$54
96A7 102BFD06  LBMI   $93B1     ;?/0 ERROR
96AB 7E9183     JMP   $9183     ;clear FPA1 exponents
96AE 8E004A     LDX   #$004A
96B1 BD93E0     JSR   $93E0     ;assign FPA1 to varptr in X
96B4 5F         CLRB
96B5 9661       LDA   <$61
96B7 2A10       BPL   $96C9
96B9 BD9499     JSR   $9499     ;INT
96BC 8E004A     LDX   #$004A
96BF 9661       LDA   <$61
96C1 BD944B     JSR   $944B     ;compare FPA1 - varptr X (of same sign)
96C4 2603       BNE   $96C9
96C6 43         COMA
96C7 D601       LDB   <$01
96C9 BD93F7     JSR   $93F7     ;copy FPA2 to FPA1 & put A in $54
96CC 3404       PSHS  B
96CE BD923C     JSR   $923C     ;LOG
96D1 8E004A     LDX   #$004A
96D4 BD9273     JSR   $9273     ;multiply varptr X & FPA1
96D7 8D3A       BSR   $9713     ;EXP
96D9 3502       PULS  A
96DB 46         RORA
96DC 248F       BCC   $966D     ;RTS
96DE 964F       LDA   <$4F
96E0 2702       BEQ   $96E4
96E2 0354       COM   <$54
96E4 39         RTS

96E5  8138AA3B29    ;FP constant 1/ln 2

*** EXP series coefficient table
    values appear to be error compensated

96EA  07 
96EB  7134583E56    ;FP constant .0000214987637  (ln2)^7 / 7!
96F0  74167EB31B    ;FP constant .0001435231404  (ln2)^6 / 6!
96F5  772FEEE385    ;FP constant .001342263483   (ln2)^5 / 5!
96FA  7A1D841C2A    ;FP constant .009614017014   (ln2)^4 / 4!
96FF  7C6359580A    ;FP constant .05550512686    (ln2)^3 / 3!
9704  7E75FDE7C6    ;FP constant .2402263846     (ln2)^2 / 2!
9709  8031721810    ;FP constant .6931471862      ln2
970E  8100000000    ;FP constant 1

*** EXP

calculates exp(x) by first calculating q=x/ln2 such that exp(x) = 2^q
fractional part of q is used for good convergence
integer part of q is simply added to FPA1 exponent afterwards

9713 8E96E5     LDX   #$96E5    ;FP constant 1/ln 2
9716 8D37       BSR   $974F     ;multiply FPA1 by varptr X
9718 BD93DA     JSR   $93DA     ;assign FPA1 to variable store $40 - $44
971B 964F       LDA   <$4F
971D 8188       CMPA  #$88
971F 2503       BCS   $9724
9721 7E9307     JMP   $9307     ;?OV ERROR if FPA1 +ve else FPA1 = 0
9724 BD9499     JSR   $9499     ;INT
9727 9601       LDA   <$01      ;integer part of argument
9729 8B81       ADDA  #$81
972B 27F4       BEQ   $9721     ;?OV ERROR
972D 4A         DECA
972E 3402       PSHS  A
9730 8E0040     LDX   #$0040
9733 BD9102     JSR   $9102     ;FPA1 = varptr X - FPA1
9736 8E96EA     LDX   #$96EA    ;EXP coefficient table
9739 8D17       BSR   $9752     ;series calculation
973B 0F62       CLR   <$62
973D 3502       PULS  A
973F BD92F3     JSR   $92F3     ;add A to exponent in FPA1
9742 39         RTS

*** calculate odd power series
    
    X points to coefficient table (1st byte is n)
    x in FPA1
    result = (a0xx+a1)xx+a2)xx+a3 ...)xx+an) * x
    ( = a0*x^(2n+1) + a1*x^(2n-1) + ... + a(n-1)*x^3 + an*x )
    result in FPA1

9743 9F64       STX   <$64
9745 BD93DA     JSR   $93DA     ;assign FPA1 to variable store $40 - $44
9748 8D05       BSR   $974F     ;multiply varptr X & FPA1 (x squared)
974A 8D08       BSR   $9754     ;calculate series
974C 8E0040     LDX   #$0040
974F 7E9273     JMP   $9273     ;multiply varptr X & FPA1 (odd powers)

*** calculate power series (polynomial of nth order)
    
    X points to coefficient table (1st byte is n)
    x in FPA1
    result = (a0x+a1)x+a2)x+a3 ...)x+an
    ( = a0*x^n + a1*x^(n-1) + ... + a(n-1)*x + an )
    result in FPA1

9752 9F64       STX   <$64
9754 BD93D5     JSR   $93D5     ;assign FPA1 to variable store $45 - $49
9757 9E64       LDX   <$64
9759 E680       LDB   ,X+
975B D755       STB   <$55
975D 9F64       STX   <$64
975F 8DEE       BSR   $974F     ;multiply varptr X & FPA1
9761 9E64       LDX   <$64
9763 3005       LEAX  5,X
9765 9F64       STX   <$64
9767 BD910B     JSR   $910B     ;add varptr X to FPA1
976A 8E0045     LDX   #$0045
976D 0A55       DEC   <$55
976F 26EE       BNE   $975F
9771 39         RTS

*** RND

9772 BD9418     JSR   $9418     ;sets B to -1, 0 or 1 as per sign of FPA1
9775 2B21       BMI   $9798
9777 2715       BEQ   $978E
9779 8D10       BSR   $978B     ;INT
977B BD93DA     JSR   $93DA     ;assign FPA1 to variable store $40 - $44
977E 8D0E       BSR   $978E
9780 8E0040     LDX   #$0040
9783 8DCA       BSR   $974F     ;multiply varptr X & FPA1
9785 8E920E     LDX   #$920E    ;FP constant 1
9788 BD910B     JSR   $910B     ;add varptr X to FPA1
978B 7E9499     JMP   $9499     ;INT
978E BE0116     LDX   $0116
9791 9F50       STX   <$50
9793 BE0118     LDX   $0118
9796 9F52       STX   <$52
9798 BE97C7     LDX   $97C7
979B 9F5D       STX   <$5D
979D BE97C9     LDX   $97C9
97A0 9F5F       STX   <$5F
97A2 BD9279     JSR   $9279     ;multiply FPA1 by mantissa in FPA2
97A5 DCAD       LDD   <$AD
97A7 C3658B     ADDD  #$658B
97AA FD0118     STD   $0118
97AD DD52       STD   <$52
97AF DCAB       LDD   <$AB
97B1 C9B0       ADCB  #$B0
97B3 8905       ADCA  #$05
97B5 FD0116     STD   $0116
97B8 DD50       STD   <$50
97BA 0F54       CLR   <$54
97BC 8680       LDA   #$80
97BE 974F       STA   <$4F
97C0 9615       LDA   <$15
97C2 9763       STA   <$63
97C4 7E9165     JMP   $9165     ;normalize FPA1

*** RND multiplier

97C7 40E64DAB

*** COS ... cos x = sin (x+pi/2)

97CB 8E983F     LDX   #$983F    ;FP constant pi/2
97CE BD910B     JSR   $910B     ;add varptr X to FPA1

*** SIN

97D1 BD940A     JSR   $940A     ;copy FPA1 to FPA2
97D4 8E9844     LDX   #$9844    ;FP constant 2*pi
97D7 D661       LDB   <$61
97D9 BD9334     JSR   $9334     ;STB $62 & divide FPA2 by varptr X (result FPA1)
97DC BD940A     JSR   $940A     ;copy FPA1 to FPA2
97DF 8DAA       BSR   $978B     ;INT
97E1 0F62       CLR   <$62
97E3 965C       LDA   <$5C
97E5 D64F       LDB   <$4F
97E7 BD9105     JSR   $9105     ;subtract FPA1 from FPA2 (B=FPA1 exponent)
97EA 8E9849     LDX   #$9849    ;FP constant 0.25
97ED BD9102     JSR   $9102     ;FPA1 = varptr X - FPA1
97F0 9654       LDA   <$54
97F2 3402       PSHS  A
97F4 2A09       BPL   $97FF     ;angle is 1st quadrant
97F6 BD90FD     JSR   $90FD     ;add 0.5 to FPA1
97F9 9654       LDA   <$54
97FB 2B05       BMI   $9802
97FD 030A       COM   <$0A
97FF BD96DE     JSR   $96DE     ;COM $54 if FPA1 non zero
9802 8E9849     LDX   #$9849    ;FP constant 0.25
9805 BD910B     JSR   $910B     ;add varptr X to FPA1
9808 3502       PULS  A
980A 4D         TSTA
980B 2A03       BPL   $9810
980D BD96DE     JSR   $96DE     ;COM $54 if FPA1 non zero
9810 8E984E     LDX   #$984E    ;series coefficients
9813 7E9743     JMP   $9743     ;calculate odd power series

*** TAN ... tan x = sin x / cos x

9816 BD93DA     JSR   $93DA     ;assign FPA1 to variable store $40 - $44
9819 0F0A       CLR   <$0A
981B 8DB4       BSR   $97D1     ;SIN
981D 8E004A     LDX   #$004A
9820 BD93E0     JSR   $93E0     ;assign FPA1 to varptr in X
9823 8E0040     LDX   #$0040
9826 BD93BF     JSR   $93BF     ;load variable into FPA1 (X is varptr)
9829 0F54       CLR   <$54
982B 960A       LDA   <$0A
982D 8D0C       BSR   $983B     ;must calculate cos
982F 0D4F       TST   <$4F
9831 1027F9A6  LBEQ   $91DB     ;?OV ERROR
9835 8E004A     LDX   #$004A
9838 7E933A     JMP   $933A     ;FPA1 = varptr X / FPA1
983B 3402       PSHS  A
983D 20C0       BRA   $97FF

983F  81490FDAA2    ;FP constant pi/2
9844  83490FDAA2    ;FP constant 2*pi
9849  7F00000000    ;FP constant 0.25

*** sin series coefficient table
    values appear to be error compensated

984E  05
984F  84E61A2D1B    ;FP constant -14.38139067   -(2pi)^11 / 11!
9854  862807FBF8    ;FP constant  42.00779712    (2pi)^9 / 9!
9859  8799688901    ;FP constant -76.70417025   -(2pi)^7 / 7!
985E  872335DFE1    ;FP constant  81.60522368    (2pi)^5 / 5!
9863  86A55DE728    ;FP constant -41.34170211   -(2pi)^3 / 3!
9868  83490FDAA2    ;FP constant  2*pi

986D  A154468F13    ;FP constant  7324114470
9872  8F524389CD    ;FP constant  26913.76914

*** ATN

    calculates atn(x) or pi/2-atn(1/x)
    same result either way but series only works -1 < x <= 1

9877 9654       LDA   <$54
9879 3402       PSHS  A
987B 2A02       BPL   $987F
987D 8D23       BSR   $98A2     ;COM $54 if FPA1 non zero
987F 964F       LDA   <$4F
9881 3402       PSHS  A
9883 8181       CMPA  #$81
9885 2505       BCS   $988C
9887 8E920E     LDX   #$920E    ;FP constant 1
988A 8DAC       BSR   $9838     ;divide varptr X by FPA1
988C 8E98A6     LDX   #$98A6    ;series coefficients
988F 8D82       BSR   $9813     ;calculate odd power series
9891 3502       PULS  A
9893 8181       CMPA  #$81
9895 2506       BCS   $989D
9897 8E983F     LDX   #$983F    ;FP constant pi/2
989A BD9102     JSR   $9102     ;FPA1 = varptr X - FPA1
989D 3502       PULS  A
989F 4D         TSTA
98A0 2A03       BPL   $98A5
98A2 7E96DE     JMP   $96DE     ;COM $54 if FPA1 non zero
98A5 39         RTS

*** ATN series coefficients
    values appear to be error compensated

98A6  0B
98A7  76B383BDD3    ;FP constant -.0006847939119 
98AC  791EF4A6F5    ;FP constant  .004850942155
98B1  7B83FCB010    ;FP constant -.01611170184
98B6  7C0C1F67CA    ;FP constant  .03420963805
98BB  7CDE53CBC1    ;FP constant -.05427913276
98C0  7D1464704C    ;FP constant  .07245719654
98C5  7DB7EA517A    ;FP constant -.08980239538 
98CA  7D6330887E    ;FP constant  .1109324134
98CF  7E9244993A    ;FP constant -.1425398077
98D4  7E4CCC91C7    ;FP constant  .1999991205 
98D9  7FAAAAAA13    ;FP constant -.3333333157
98DE  8100000000    ;FP constant 1

*** part of reset routine: sets up sound & graphics variables

98E3 CCBA42     LDD   #$BA42
98E6 DDDF       STD   <$DF      ;PLAY volume data
98E8 8602       LDA   #$02
98EA 97E2       STA   <$E2      ;PLAY tempo
98EC 97DE       STA   <$DE      ;PLAY octave
98EE 48         ASLA
98EF 97E1       STA   <$E1      ;PLAY note length
98F1 0FE5       CLR   <$E5      ;PLAY duration
98F3 DC8A       LDD   <$8A      ;zero
98F5 DDE8       STD   <$E8      ;DRAW angle
98F7 C680       LDB   #$80
98F9 DDC7       STD   <$C7      ;graphics X
98FB C660       LDB   #$60
98FD DDC9       STD   <$C9      ;graphics Y
98FF 39         RTS

*** called by CSAVE to do CSAVEM

9900 9D9F       JSR   <$9F      ;get next character from BASIC source
9902 BDB7AA     JSR   $B7AA     ;get filename
9905 8D43       BSR   $994A     ;get start address
9907 BF01E7     STX   $01E7
990A 8D3E       BSR   $994A     ;get end address
990C AC62       CMPX  2,S
990E 1025F27B  LBCS   $8B8D     ;?FC ERROR
9912 8D36       BSR   $994A     ;get entry address
9914 BF01E5     STX   $01E5
9917 9DA5       JSR   <$A5      ;get current character from BASIC source
9919 26E4       BNE   $98FF
991B 8602       LDA   #$02      ;file type = 2 = binary
991D 9E8A       LDX   <$8A      ;non-ASCII & ungapped
991F BDB891     JSR   $B891     ;write filename block
9922 0F78       CLR   <$78      ;cassette status
9924 0C7C       INC   <$7C      ;block type
9926 BD801B     JSR   $801B     ;write leader
9929 AE64       LDX   4,S
992B 9F7E       STX   <$7E      ;IO buffer
992D 86FF       LDA   #$FF
992F 977D       STA   <$7D      ;block length
9931 EC62       LDD   2,S
9933 937E       SUBD  <$7E      ;IO buffer
9935 2405       BCC   $993C
9937 3266       LEAS  6,S
9939 7EB6CD     JMP   $B6CD     ;NEG $7c CLR $7d & write last block
993C 108300FF   CMPD  #$00FF
9940 2403       BCC   $9945
9942 5C         INCB
9943 D77D       STB   <$7D      ;block length
9945 BDB999     JSR   $B999     ;write block to tape
9948 20E1       BRA   $992B

*** get a number from command and leave it on stack

994A BD89AA     JSR   $89AA     ;skip comma
994D BD8E83     JSR   $8E83     ;read 16 bit number into X
9950 EEE4       LDU   ,S
9952 AFE4       STX   ,S
9954 1F35       TFR   U,PC

*** FIX

9956 BD9418     JSR   $9418     ;sets B to -1, 0 or 1 as per sign of FPA1
9959 2B03       BMI   $995E
995B 7E9499     JMP   $9499     ;INT
995E 0354       COM   <$54
9960 8DF9       BSR   $995B
9962 7E96DE     JMP   $96DE     ;COM $54 if FPA1 non zero

*** EDIT

9965 BD9D9F     JSR   $9D9F     ;get line number in $2b
9968 3262       LEAS  2,S       ;lose return address
996A 8601       LDA   #$01
996C 97D8       STA   <$D8
996E BD83FF     JSR   $83FF     ;search program for line number in <$2b
9971 1025EC90  LBCS   $8605     ;?UL ERROR
9975 BD8F08     JSR   $8F08     ;detokenize BASIC line
9978 1F20       TFR   Y,D
997A 8302DE     SUBD  #$02DE
997D D7D7       STB   <$D7      ;line length
997F DC2B       LDD   <$2B
9981 BD957A     JSR   $957A     ;print unsigned number in D
9984 BD90F5     JSR   $90F5     ;print a space to DEVN
9987 8E02DD     LDX   #$02DD
998A D6D8       LDB   <$D8
998C 2625       BNE   $99B3     ;print entire line
998E 5F         CLRB
998F BD9AB9     JSR   $9AB9     ;read keys (carry clear if control key)
9992 BDA438     JSR   $A438     ;set carry if A is non-numeric character
9995 250B       BCS   $99A2
9997 8030       SUBA  #$30      ;accumulate typed digits in B
9999 3402       PSHS  A         ;
999B 860A       LDA   #$0A      ;
999D 3D         MUL             ;
999E EBE0       ADDB  ,S+       ;
99A0 20ED       BRA   $998F     ;
99A2 C001       SUBB  #$01
99A4 C901       ADCB  #$01
99A6 8141       CMPA  #$41      ;(A = abandon changes & start again)
99A8 2605       BNE   $99AF
99AA BD90A1     JSR   $90A1     ;send CR to DEVN
99AD 20BB       BRA   $996A
99AF 814C       CMPA  #$4C      ;(L = show line in current state)
99B1 260B       BNE   $99BE
99B3 8D31       BSR   $99E6     ;output ASCIIZ string to DEVN (X is pointer)
99B5 0FD8       CLR   <$D8
99B7 BD90A1     JSR   $90A1     ;send CR to DEVN
99BA 20C3       BRA   $997F
99BC 3262       LEAS  2,S       ;lose return address
99BE 810D       CMPA  #$0D      ;(RETURN = save changes, show line & quit)
99C0 260D       BNE   $99CF
99C2 8D22       BSR   $99E6     ;output ASCIIZ string to DEVN (X is pointer)
99C4 BD90A1     JSR   $90A1     ;send CR to DEVN
99C7 8E02DD     LDX   #$02DD
99CA 9FA6       STX   <$A6      ;BASIC source pointer
99CC 7E83A6     JMP   $83A6     ;enter BASIC line
99CF 8145       CMPA  #$45      ;(E = save changes & quit)
99D1 27F1       BEQ   $99C4
99D3 8151       CMPA  #$51      ;(Q = discard changes & quit)
99D5 2606       BNE   $99DD
99D7 BD90A1     JSR   $90A1     ;send CR to DEVN
99DA 7E8371     JMP   $8371     ;command mode
99DD 8D02       BSR   $99E1
99DF 20AD       BRA   $998E
99E1 8120       CMPA  #$20      ;(SPACE = show more characters)
99E3 2610       BNE   $99F5
99E5 8C         CMPX  #

*** output ASCIIZ string to DEVN (stops at 249 characters)

(99E6 C6F9       LDB   #$F9)
99E8 A684       LDA   ,X
99EA 2708       BEQ   $99F4
99EC BDB54A     JSR   $B54A     ;output character to DEVN
99EF 3001       LEAX  1,X
99F1 5A         DECB
99F2 26F4       BNE   $99E8     ;show another (in EDIT context)
99F4 39         RTS

*** EDIT: test for Delete

99F5 8144       CMPA  #$44      ;(D = delete a number of characters)
99F7 2648       BNE   $9A41
99F9 6D84       TST   ,X
99FB 27F7       BEQ   $99F4
99FD 8D04       BSR   $9A03     ;close line up over removed character
99FF 5A         DECB
9A00 26F7       BNE   $99F9
9A02 39         RTS

*** EDIT: close line up over removed character

9A03 0AD7       DEC   <$D7
9A05 311F       LEAY  -1,X
9A07 3121       LEAY  1,Y
9A09 A621       LDA   1,Y
9A0B A7A4       STA   ,Y
9A0D 26F8       BNE   $9A07
9A0F 39         RTS

*** EDIT: test for insert mode functions

9A10 8149       CMPA  #$49      ;(I = insert mode)
9A12 2713       BEQ   $9A27
9A14 8158       CMPA  #$58      ;(X = insert mode at end of line)
9A16 270D       BEQ   $9A25
9A18 8148       CMPA  #$48      ;(H = wipe rest of line & insert)
9A1A 265C       BNE   $9A78
9A1C 6F84       CLR   ,X
9A1E 1F10       TFR   X,D
9A20 8302DE     SUBD  #$02DE
9A23 D7D7       STB   <$D7      ;updated line length
9A25 8DBF       BSR   $99E6     ;output ASCIIZ string to DEVN (X is pointer)
9A27 BD9AB9     JSR   $9AB9     ;read keys (carry clear if control key)
9A2A 810D       CMPA  #$0D
9A2C 278E       BEQ   $99BC     ;RETURN
9A2E 811B       CMPA  #$1B
9A30 2725       BEQ   $9A57     ;RTS (escape insert mode)
9A32 8108       CMPA  #$08
9A34 2622       BNE   $9A58     ;not backspace
9A36 8C02DD     CMPX  #$02DD
9A39 27EC       BEQ   $9A27     ;nothing to delete
9A3B 8D45       BSR   $9A82     ;delete it on screen
9A3D 8DC4       BSR   $9A03     ;delete it in memory
9A3F 20E6       BRA   $9A27

*** EDIT: test for Change

9A41 8143       CMPA  #$43      ;(C = change a number of characters)
9A43 26CB       BNE   $9A10
9A45 6D84       TST   ,X
9A47 270E       BEQ   $9A57     ;RTS
9A49 BD9AB9     JSR   $9AB9     ;read keys (carry clear if control key)
9A4C 2502       BCS   $9A50
9A4E 20F5       BRA   $9A45
9A50 A780       STA   ,X+
9A52 8D37       BSR   $9A8B     ;output character to DEVN
9A54 5A         DECB
9A55 26EE       BNE   $9A45     ;change another
9A57 39         RTS

*** EDIT: typed characters in insert mode

9A58 D6D7       LDB   <$D7
9A5A C1F9       CMPB  #$F9
9A5C 2602       BNE   $9A60
9A5E 20C7       BRA   $9A27     ;line full
9A60 3410       PSHS  X         
9A62 6D80       TST   ,X+       ;create a space for character
9A64 26FC       BNE   $9A62     ;
9A66 E682       LDB   ,-X       ;
9A68 E701       STB   1,X       ;
9A6A ACE4       CMPX  ,S        ;
9A6C 26F8       BNE   $9A66     ;
9A6E 3262       LEAS  2,S       
9A70 A780       STA   ,X+
9A72 8D17       BSR   $9A8B     ;output character to DEVN
9A74 0CD7       INC   <$D7
9A76 20AF       BRA   $9A27

*** EDIT: backspace over a number of characters

9A78 8108       CMPA  #$08
9A7A 2612       BNE   $9A8E
9A7C 8D04       BSR   $9A82
9A7E 5A         DECB
9A7F 26FB       BNE   $9A7C     ;backspace again
9A81 39         RTS

*** EDIT: backspace

9A82 8C02DD     CMPX  #$02DD
9A85 27D0       BEQ   $9A57     ;RTS
9A87 301F       LEAX  -1,X
9A89 8608       LDA   #$08
9A8B 7EB54A     JMP   $B54A     ;output character to DEVN

*** EDIT: test for search functions

9A8E 814B       CMPA  #$4B      ;(K = wipe chrs until nth occurrence of chr)
9A90 2705       BEQ   $9A97
9A92 8053       SUBA  #$53      ;(S = search for nth occurrence of chr)
9A94 2701       BEQ   $9A97
9A96 39         RTS

*** EDIT: search functions

9A97 3402       PSHS  A
9A99 8D1E       BSR   $9AB9     ;read keys (carry clear if control key)
9A9B 3402       PSHS  A
9A9D A684       LDA   ,X
9A9F 2716       BEQ   $9AB7     ;PULS Y,PC
9AA1 6D61       TST   1,S
9AA3 2606       BNE   $9AAB     ;Kill (not Search)
9AA5 8DE4       BSR   $9A8B     ;output character to DEVN
9AA7 3001       LEAX  1,X
9AA9 2003       BRA   $9AAE
9AAB BD9A03     JSR   $9A03     ;close line up over removed character
9AAE A684       LDA   ,X
9AB0 A1E4       CMPA  ,S
9AB2 26E9       BNE   $9A9D     ;not found
9AB4 5A         DECB
9AB5 26E6       BNE   $9A9D     ;find next occurrence
9AB7 35A0       PULS  Y,PC

*** read keys (carry clear if control key)

9AB9 BDB505     JSR   $B505     ;read character from DEVN & strip MSB
9ABC 817F       CMPA  #$7F      ;
9ABE 24F9       BCC   $9AB9     ;pointless test!
9AC0 815F       CMPA  #$5F
9AC2 2602       BNE   $9AC6     ;not shift + CU
9AC4 861B       LDA   #$1B
9AC6 810D       CMPA  #$0D
9AC8 270E       BEQ   $9AD8     ;return
9ACA 811B       CMPA  #$1B
9ACC 270A       BEQ   $9AD8     ;escape
9ACE 8108       CMPA  #$08
9AD0 2706       BEQ   $9AD8     ;backspace
9AD2 8120       CMPA  #$20
9AD4 25E3       BCS   $9AB9     ;illegal
9AD6 1A01       ORCC  #$01
9AD8 39         RTS

*** TRON

9AD9 86         LDA #

*** TROFF

(9ADA 4F         CLRA)
9ADB 97AF       STA   <$AF
9ADD 39         RTS

*** POS

9ADE 966F       LDA   <$6F      ;DEVN
9AE0 3402       PSHS  A
9AE2 BDB7E0     JSR   $B7E0     ;load DEVN from FPA1
9AE5 BDB63C     JSR   $B63C     ;if DEVN = -1, test cassette OK for output
9AE8 BDB595     JSR   $B595     ;initialise virtual DEVN device
9AEB D66C       LDB   <$6C      ;device current column
9AED 3502       PULS  A
9AEF 976F       STA   <$6F      ;DEVN
9AF1 7E8C36     JMP   $8C36     ;assign B to FPA1

*** VARPTR

9AF4 BD89A7     JSR   $89A7     ;skip open bracket
9AF7 DC1F       LDD   <$1F      ;end of BASIC storage
9AF9 3406       PSHS  A,B
9AFB BD8A94     JSR   $8A94     ;get varptr of variable in X
9AFE BD89A4     JSR   $89A4     ;skip close bracket
9B01 3506       PULS  A,B
9B03 1E10       EXG   X,D
9B05 9C1F       CMPX  <$1F      ;not allowed to create new variable
9B07 2651       BNE   $9B5A     ;?FC ERROR
9B09 7E8C37     JMP   $8C37     ;assign D to FPA1 (signed)

*** MID$ on LHS

9B0C 9D9F       JSR   <$9F      ;get next character from BASIC source
9B0E BD89A7     JSR   $89A7     ;skip open bracket
9B11 BD8A94     JSR   $8A94     ;get varptr of variable in X
9B14 3410       PSHS  X
9B16 EC02       LDD   2,X
9B18 109321     CMPD  <$21      ;stack root / string storage start
9B1B 2304       BLS   $9B21
9B1D 9327       SUBD  <$27      ;top of BASIC RAM
9B1F 2312       BLS   $9B33
9B21 E684       LDB   ,X
9B23 BD8CB3     JSR   $8CB3     ;reserve B bytes of string space
9B26 3410       PSHS  X
9B28 AE62       LDX   2,S
9B2A BD8D89     JSR   $8D89     ;copy string (len B) from varptr X to ($25)+
9B2D 3550       PULS  X,U
9B2F AF42       STX   2,U
9B31 3440       PSHS  U
9B33 BD8E7E     JSR   $8E7E
9B36 3404       PSHS  B
9B38 5D         TSTB
9B39 271F       BEQ   $9B5A     ;?FC ERROR
9B3B C6FF       LDB   #$FF
9B3D 8129       CMPA  #$29   )
9B3F 2703       BEQ   $9B44
9B41 BD8E7E     JSR   $8E7E
9B44 3404       PSHS  B
9B46 BD89A4     JSR   $89A4     ;skip close bracket
9B49 C6CB       LDB   #$CB
9B4B BD89AC     JSR   $89AC     ;skip character in B
9B4E 8D2E       BSR   $9B7E     ;get string expression & point X to it
9B50 1F13       TFR   X,U
9B52 AE62       LDX   2,S
9B54 A684       LDA   ,X
9B56 A061       SUBA  1,S
9B58 2403       BCC   $9B5D
9B5A 7E8B8D     JMP   $8B8D     ;?FC ERROR
9B5D 4C         INCA
9B5E A1E4       CMPA  ,S
9B60 2402       BCC   $9B64
9B62 A7E4       STA   ,S
9B64 A661       LDA   1,S
9B66 1E89       EXG   A,B
9B68 AE02       LDX   2,X
9B6A 5A         DECB
9B6B 3A         ABX
9B6C 4D         TSTA
9B6D 270D       BEQ   $9B7C
9B6F A1E4       CMPA  ,S
9B71 2302       BLS   $9B75
9B73 A6E4       LDA   ,S
9B75 1F89       TFR   A,B
9B77 1E31       EXG   U,X
9B79 BDB7CC     JSR   $B7CC     ;copy B bytes from X to U
9B7C 3596       PULS  A,B,X,PC

*** get string expression & point X to it (B=len)

9B7E BD8887     JSR   $8887     ;get expression
9B81 7E8D9A     JMP   $8D9A     ;validate string & point X to it (B=len)

*** STRING$

9B84 BD89A7     JSR   $89A7     ;skip open bracket
9B87 BD8E51     JSR   $8E51     ;get number into B
9B8A 3404       PSHS  B
9B8C BD89AA     JSR   $89AA     ;skip comma
9B8F BD8887     JSR   $8887     ;get expression
9B92 BD89A4     JSR   $89A4     ;skip close bracket
9B95 9606       LDA   <$06      ;numeric / string flag
9B97 2605       BNE   $9B9E
9B99 BD8E54     JSR   $8E54     ;read 8 bit value into B from FPA1
9B9C 2003       BRA   $9BA1
9B9E BD8DEA     JSR   $8DEA     ;get 1st character of string into B
9BA1 3404       PSHS  B
9BA3 E661       LDB   1,S       ;number of copies
9BA5 BD8C52     JSR   $8C52     ;reserve B bytes of string space
9BA8 3506       PULS  A,B
9BAA 2705       BEQ   $9BB1
9BAC A780       STA   ,X+
9BAE 5A         DECB
9BAF 26FB       BNE   $9BAC
9BB1 7E8DE1     JMP   $8DE1

*** INSTR

9BB4 BD89A7     JSR   $89A7     ;skip open bracket
9BB7 BD8887     JSR   $8887     ;get expression
9BBA C601       LDB   #$01      ;default start position
9BBC 3404       PSHS  B
9BBE 9606       LDA   <$06      ;numeric / string flag
9BC0 2610       BNE   $9BD2     ;start pos not specified
9BC2 BD8E54     JSR   $8E54     ;read 8 bit value into B from FPA1
9BC5 E7E4       STB   ,S
9BC7 2791       BEQ   $9B5A     ;?FC ERROR
9BC9 BD89AA     JSR   $89AA     ;skip comma
9BCC BD8887     JSR   $8887     ;get expression
9BCF BD8877     JSR   $8877     ;validate string expression
9BD2 9E52       LDX   <$52
9BD4 3410       PSHS  X
9BD6 BD89AA     JSR   $89AA     ;skip comma
9BD9 BD9B7E     JSR   $9B7E     ;get string expression & point X to it
9BDC 3414       PSHS  B,X
9BDE BD89A4     JSR   $89A4     ;skip close bracket
9BE1 AE63       LDX   3,S       ;varptr of main string
9BE3 BD8D9F     JSR   $8D9F     ;point X to string & length in B
9BE6 3404       PSHS  B
9BE8 E166       CMPB  6,S
9BEA 2523       BCS   $9C0F     ;main string is shorter than start pos
9BEC A661       LDA   1,S       ;target string length
9BEE 271C       BEQ   $9C0C
9BF0 E666       LDB   6,S       ;start pos
9BF2 5A         DECB
9BF3 3A         ABX
9BF4 3184       LEAY  ,X        ;Y = X = position to start search
9BF6 EE62       LDU   2,S       ;U -> target characters
9BF8 E661       LDB   1,S       ;B = target length
9BFA A6E4       LDA   ,S        ;A = main string length
9BFC A066       SUBA  6,S       ;
9BFE 4C         INCA            ;A = A - start pos + 1
9BFF A161       CMPA  1,S
9C01 250C       BCS   $9C0F     ;remaining length is shorter than target
9C03 A680       LDA   ,X+
9C05 A1C0       CMPA  ,U+
9C07 260C       BNE   $9C15     ;didn't match
9C09 5A         DECB
9C0A 26F7       BNE   $9C03     ;test next character in target
9C0C E666       LDB   6,S       ;found it
9C0E 21         BRN   $
(9C0F 5F         CLRB)
9C10 3267       LEAS  7,S
9C12 7E8C36     JMP   $8C36     ;assign B to FPA1
9C15 6C66       INC   6,S       ;
9C17 3021       LEAX  1,Y       ;advance start pos & try again
9C19 20D9       BRA   $9BF4     ;

*** read octal or hex number from command into $52 / $53

9C1B 0F52       CLR   <$52
9C1D 0F53       CLR   <$53
9C1F 8E0052     LDX   #$0052
9C22 9D9F       JSR   <$9F      ;get next character from BASIC source
9C24 814F       CMPA  #$4F   O
9C26 2712       BEQ   $9C3A
9C28 8148       CMPA  #$48   H
9C2A 2723       BEQ   $9C4F
9C2C 9DA5       JSR   <$A5      ;get current character from BASIC source
9C2E 200C       BRA   $9C3C
9C30 8138       CMPA  #$38   8
9C32 1022ED7E  LBHI   $89B4     ;?SN ERROR
9C36 C603       LDB   #$03
9C38 8D2A       BSR   $9C64     ;shift word at ,X left B bits
9C3A 9D9F       JSR   <$9F      ;get next character from BASIC source
9C3C 25F2       BCS   $9C30

*** assign contents of $52 / $53 to FPA1

9C3E 0F50       CLR   <$50
9C40 0F51       CLR   <$51
9C42 0F06       CLR   <$06      ;numeric / string flag
9C44 0F63       CLR   <$63
9C46 0F54       CLR   <$54
9C48 C6A0       LDB   #$A0
9C4A D74F       STB   <$4F
9C4C 7E9165     JMP   $9165     ;normalize FPA1

*** read hex digits from command into ,X

9C4F 9D9F       JSR   <$9F      ;get next character from BASIC source
9C51 250B       BCS   $9C5E
9C53 BD8ADF     JSR   $8ADF     ;carry clear if A-Z
9C56 25E6       BCS   $9C3E     ;assign contents of $52 / $53 to FPA1
9C58 8147       CMPA  #$47   G
9C5A 24E2       BCC   $9C3E     ;assign contents of $52 / $53 to FPA1
9C5C 8007       SUBA  #$07
9C5E C604       LDB   #$04
9C60 8D02       BSR   $9C64     ;shift word at ,X left B bits
9C62 20EB       BRA   $9C4F

*** shift word at ,X left B bits

9C64 6801       ASL   1,X
9C66 6984       ROL   ,X
9C68 1025F56F  LBCS   $91DB     ;?OV ERROR
9C6C 5A         DECB
9C6D 26F5       BNE   $9C64
9C6F 8030       SUBA  #$30   0
9C71 AB01       ADDA  1,X
9C73 A701       STA   1,X
9C75 39         RTS

*** cause error if in command mode

9C76 9E68       LDX   <$68      ;current line number
9C78 3001       LEAX  1,X
9C7A 26F9       BNE   $9C75     ;not in command mode
9C7C C616       LDB   #$16      ;?ID ERROR
9C7E 7E8344     JMP   $8344     ;cause error

*** DEF

9C81 AE9F00A6   LDX  ($00A6)
9C85 8CFFA1     CMPX  #$FFA1    ;DEF USR
9C88 10270074  LBEQ   $9D00
9C8C 8D23       BSR   $9CB1     
9C8E 8DE6       BSR   $9C76     ;test for command mode
9C90 BD89A7     JSR   $89A7     ;skip open bracket
9C93 C680       LDB   #$80
9C95 D708       STB   <$08      ;array illegal flag
9C97 BD8A94     JSR   $8A94     ;get varptr of variable in X
9C9A 8D25       BSR   $9CC1
9C9C BD89A4     JSR   $89A4     ;skip close bracket
9C9F C6CB       LDB   #$CB
9CA1 BD89AC     JSR   $89AC     ;skip character in B
9CA4 9E4B       LDX   <$4B
9CA6 DCA6       LDD   <$A6      ;BASIC source pointer
9CA8 ED84       STD   ,X
9CAA DC39       LDD   <$39
9CAC ED02       STD   2,X
9CAE 7E8613     JMP   $8613     ;skip to start of next statement

9CB1 C6BE       LDB   #$BE      ;token FN
9CB3 BD89AC     JSR   $89AC     ;skip character in B
9CB6 C680       LDB   #$80
9CB8 D708       STB   <$08      ;array illegal flag
9CBA 8A80       ORA   #$80
9CBC BD8A99     JSR   $8A99
9CBF 9F4B       STX   <$4B
9CC1 7E8874     JMP   $8874     ;validate numeric expression
9CC4 8DEB       BSR   $9CB1
9CC6 3410       PSHS  X
9CC8 BD899F     JSR   $899F     ;get expression inside brackets
9CCB 8DF4       BSR   $9CC1
9CCD 3540       PULS  U
9CCF C622       LDB   #$22      ;?UF ERROR
9CD1 AE42       LDX   2,U
9CD3 27A9       BEQ   $9C7E     ;cause error
9CD5 109EA6     LDY   <$A6      ;BASIC source pointer
9CD8 EEC4       LDU   ,U
9CDA DFA6       STU   <$A6      ;BASIC source pointer
9CDC A604       LDA   4,X
9CDE 3402       PSHS  A
9CE0 EC84       LDD   ,X
9CE2 EE02       LDU   2,X
9CE4 3476       PSHS  A,B,X,Y,U
9CE6 BD93E0     JSR   $93E0     ;assign FPA1 to varptr in X
9CE9 BD8872     JSR   $8872     ;read numeric expression into FPA1
9CEC 3576       PULS  A,B,X,Y,U
9CEE ED84       STD   ,X
9CF0 EF02       STU   2,X
9CF2 3502       PULS  A
9CF4 A704       STA   4,X
9CF6 9DA5       JSR   <$A5      ;get current character from BASIC source
9CF8 1026ECB8  LBNE   $89B4     ;?SN ERROR
9CFC 109FA6     STY   <$A6      ;BASIC source pointer
9CFF 39         RTS

*** DEF USRx = address

9D00 9D9F       JSR   <$9F      ;get next character from BASIC source
9D02 8D09       BSR   $9D0D
9D04 3410       PSHS  X
9D06 8D2D       BSR   $9D35		;skip = sign & read 16 bit number into X
9D08 3540		PULS  U
9D0A AFC4		STX   ,U
9D0C 39         RTS

*** called by USR: converts following digits into USR table pointer

9D0D 5F         CLRB
9D0E 9D9F       JSR   <$9F      ;get next character from BASIC source
9D10 2406       BCC   $9D18		;not digit
9D12 8030       SUBA  #$30   0
9D14 1F89       TFR   A,B
9D16 9D9F       JSR   <$9F      ;get next character from BASIC source
9D18 9EB0       LDX   <$B0      ;address of USR table
9D1A 58         ASLB
9D1B 3A         ABX
9D1C 39         RTS

*** USRx

9D1D 8DEE       BSR   $9D0D
9D1F AE84       LDX   ,X
9D21 3410       PSHS  X
9D23 BD899F     JSR   $899F     ;get expression inside brackets
9D26 8E004F     LDX   #$004F    ;FPA1
9D29 9606       LDA   <$06      ;numeric / string flag
9D2B 2707       BEQ   $9D34
9D2D BD8D9D     JSR   $8D9D     ;point X to string just compiled & len in B
9D30 9E52       LDX   <$52
9D32 9606       LDA   <$06      ;numeric / string flag
9D34 39         RTS

*** skips = sign & reads 16 bit number into X

9D35 C6CB       LDB   #$CB      ;token =
9D37 BD89AC     JSR   $89AC     ;skip character in B
9D3A 7E8E83     JMP   $8E83     ;read 16 bit number into X

*** IRQ service routine

9D3D B6FF03     LDA   $FF03
9D40 2B01       BMI   $9D43     ;vsync
9D42 3B         RTI
9D43 B6FF02     LDA   $FF02
9D46 BE0112     LDX   $0112     ;TIMER value
9D49 3001       LEAX  1,X
9D4B BF0112     STX   $0112
9D4E 7EAFD9     JMP   $AFD9     ;...continued

*** TIMER on LHS

9D51 9D9F       JSR   <$9F      ;get next character from BASIC source
9D53 8DE0       BSR   $9D35		;skip = sign & read 16 bit number into X
9D55 BF0112     STX   $0112     ;TIMER value
9D58 39         RTS

*** TIMER

9D59 BE0112     LDX   $0112     ;TIMER value
9D5C 9F52       STX   <$52
9D5E 7E9C3E     JMP   $9C3E     ;assign contents of $52 / $53 to FPA1

*** DEL

9D61 1027EE28  LBEQ   $8B8D     ;?FC ERROR
9D65 BD869A     JSR   $869A     ;read line number & store in $2b
9D68 BD83FF     JSR   $83FF     ;search program for line number in <$2b
9D6B 9FD3       STX   <$D3
9D6D 9DA5       JSR   <$A5      ;get current character from BASIC source
9D6F 2710       BEQ   $9D81
9D71 81C4       CMPA  #$C4      ;token -
9D73 263B       BNE   $9DB0
9D75 9D9F       JSR   <$9F      ;get next character from BASIC source
9D77 2704       BEQ   $9D7D
9D79 8D24       BSR   $9D9F
9D7B 2004       BRA   $9D81
9D7D 86FF       LDA   #$FF
9D7F 972B       STA   <$2B
9D81 DED3       LDU   <$D3
9D83 8C         CMPX  #
(9D84 EEC4       LDU   ,U)
9D86 ECC4       LDD   ,U
9D88 2706       BEQ   $9D90
9D8A EC42       LDD   2,U
9D8C 932B       SUBD  <$2B
9D8E 23F4       BLS   $9D84
9D90 9ED3       LDX   <$D3
9D92 8D15       BSR   $9DA9     ;move program down from U to X
9D94 BD841F     JSR   $841F     ;clear variables and reset stack & cmd ptr
9D97 9ED3       LDX   <$D3
9D99 BD83EF     JSR   $83EF     ;set up next line pointers from X onwards
9D9C 7E8371     JMP   $8371     ;command mode

9D9F BD869A     JSR   $869A     ;read line number & store in $2b
9DA2 7EB7F9     JMP   $B7F9     ;cause error if next byte is not zero

9DA5 A6C0       LDA   ,U+
9DA7 A780       STA   ,X+
9DA9 11931B     CMPU  <$1B      ;start of simple variables
9DAC 26F7       BNE   $9DA5
9DAE 9F1B       STX   <$1B      ;start of simple variables
9DB0 39         RTS

*** LINE INPUT

9DB1 BD9C76     JSR   $9C76     ;test for command mode
9DB4 9D9F       JSR   <$9F      ;get next character from BASIC source
9DB6 8123       CMPA  #$23   #
9DB8 2609       BNE   $9DC3
9DBA BDB7D7     JSR   $B7D7     ;read #-n & set up DEVN
9DBD BDB623     JSR   $B623     ;test cassette status OK for input
9DC0 BD89AA     JSR   $89AA     ;skip comma
9DC3 8122       CMPA  #$22   "
9DC5 260B       BNE   $9DD2     ;no prompt
9DC7 BD8975     JSR   $8975     ;read literal string
9DCA C63B       LDB   #$3B   ;
9DCC BD89AC     JSR   $89AC     ;skip character in B
9DCF BD90E8     JSR   $90E8     ;print string just compiled
9DD2 327E       LEAS  -2,S
9DD4 BD8766     JSR   $8766
9DD7 3262       LEAS  2,S
9DD9 0F6F       CLR   <$6F      ;DEVN
9DDB BD8A94     JSR   $8A94     ;get varptr of variable in X
9DDE 9F3B       STX   <$3B
9DE0 BD8877     JSR   $8877     ;validate string expression
9DE3 8E02DC     LDX   #$02DC
9DE6 4F         CLRA
9DE7 BD8C5D     JSR   $8C5D     ;compile literal string at X
9DEA 7E86D7     JMP   $86D7     ;assign string variable

*** read line number into X & $2b

9DED BD869A     JSR   $869A     ;read line number & store in $2b
9DF0 9E2B       LDX   <$2B
9DF2 39         RTS

*** RENUM: search for start line

9DF3 9ED1       LDX   <$D1
9DF5 9F2B       STX   <$2B
9DF7 7E83FF     JMP   $83FF     ;search program for line number in <$2b

*** RENUM

9DFA BD8424     JSR   $8424     ;clear variables & reset stack
9DFD CC000A     LDD   #$000A    ;
9E00 DDD5       STD   <$D5      ;default RENUM 10,0,10
9E02 DDCF       STD   <$CF      ;
9E04 5F         CLRB            ;
9E05 DDD1       STD   <$D1      ;
9E07 9DA5       JSR   <$A5      ;get current character from BASIC source
9E09 2406       BCC   $9E11
9E0B 8DE0       BSR   $9DED     ;read line number into X & $2b
9E0D 9FD5       STX   <$D5      ;new start line
9E0F 9DA5       JSR   <$A5      ;get current character from BASIC source
9E11 271B       BEQ   $9E2E
9E13 BD89AA     JSR   $89AA     ;skip comma
9E16 2406       BCC   $9E1E
9E18 8DD3       BSR   $9DED     ;read line number into X & $2b
9E1A 9FD1       STX   <$D1      ;line to start renumbering at
9E1C 9DA5       JSR   <$A5      ;get current character from BASIC source
9E1E 270E       BEQ   $9E2E
9E20 BD89AA     JSR   $89AA     ;skip comma
9E23 2406       BCC   $9E2B
9E25 8DC6       BSR   $9DED     ;read line number into X & $2b
9E27 9FCF       STX   <$CF      ;line increment
9E29 2749       BEQ   $9E74     ;?FC ERROR
9E2B BDB7F9     JSR   $B7F9     ;cause error if next byte is not zero
9E2E 8DC3       BSR   $9DF3     ;search for start line
9E30 9FD3       STX   <$D3      ;save address
9E32 9ED5       LDX   <$D5
9E34 8DBF       BSR   $9DF5     ;search for new start line
9E36 9CD3       CMPX  <$D3      ;not allowed to be lower than start line
9E38 253A       BCS   $9E74     ;?FC ERROR
9E3A 8D1C       BSR   $9E58     ;dry run - check lines don't get too high
9E3C BD9ECE     JSR   $9ECE     ;prepare line numbers in statements
9E3F BD83ED     JSR   $83ED     ;set up next line pointers in BASIC program
9E42 8DAF       BSR   $9DF3     ;search for start line
9E44 9FD3       STX   <$D3      ;save address
9E46 8D3A       BSR   $9E82     ;convert line numbers to addresses
9E48 8D0F       BSR   $9E59     ;do the actual renumbering
9E4A 8D36       BSR   $9E82     ;convert addresses to line numbers
9E4C BD9F6C     JSR   $9F6C     ;convert line numbers back to ASCII
9E4F BD8424     JSR   $8424     ;clear variables & reset stack
9E52 BD83ED     JSR   $83ED     ;set up next line pointers in BASIC program
9E55 7E8371     JMP   $8371     ;command mode

*** RENUM: dry run to check that line numbers don't get too high

9E58 86         LDA   #

*** RENUM: renumber!

(9E59 4F         CLRA)
9E5A 97D8       STA   <$D8
9E5C 9ED3       LDX   <$D3      ;start address
9E5E DCD5       LDD   <$D5      ;new start number
9E60 8D15       BSR   $9E77     ;test for end of program 
9E62 0DD8       TST   <$D8      ;dry run flag
9E64 2602       BNE   $9E68
9E66 ED02       STD   2,X       ;store new line number
9E68 AE84       LDX   ,X        ;point X to next line
9E6A 8D0B       BSR   $9E77     ;test for end of program 
9E6C D3CF       ADDD  <$CF      ;increment line number
9E6E 2504       BCS   $9E74     ;?FC ERROR
9E70 81FA       CMPA  #$FA
9E72 25EE       BCS   $9E62
9E74 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** RENUM: test for end of program 

9E77 3406       PSHS  A,B
9E79 EC84       LDD   ,X
9E7B 3506       PULS  A,B
9E7D 2602       BNE   $9E81
9E7F 3262       LEAS  2,S       ;return 2 levels if at end of program
9E81 39         RTS

*** RENUM: on 1st call converts the line numbers in each info block
           into line addresses. On 2nd call converts them back into
           line numbers.

9E82 9E19       LDX   <$19      ;start of BASIC program
9E84 301F       LEAX  -1,X
9E86 3001       LEAX  1,X
9E88 8DED       BSR   $9E77     ;test for end of program 
9E8A 3003       LEAX  3,X
9E8C 3001       LEAX  1,X
9E8E A684       LDA   ,X
9E90 27F4       BEQ   $9E86     ;end of line
9E92 9F0F       STX   <$0F
9E94 4A         DECA
9E95 270C       BEQ   $9EA3     ;1st pass - convert line number to address
9E97 4A         DECA
9E98 272A       BEQ   $9EC4     ;2nd pass - convert address to line number
9E9A 4A         DECA
9E9B 26EF       BNE   $9E8C
9E9D 8603       LDA   #$03
9E9F A780       STA   ,X+
9EA1 20E7       BRA   $9E8A
9EA3 EC01       LDD   1,X       ;reconstruct line number coded in block
9EA5 6A02       DEC   2,X       ;
9EA7 2701       BEQ   $9EAA     ;
9EA9 4F         CLRA            ;
9EAA E603       LDB   3,X       ;
9EAC 6A04       DEC   4,X       ;
9EAE 2701       BEQ   $9EB1     ;
9EB0 5F         CLRB            ;
9EB1 ED01       STD   1,X       ;
9EB3 DD2B       STD   <$2B
9EB5 BD83FF     JSR   $83FF     ;search program for line number in <$2b
9EB8 9E0F       LDX   <$0F
9EBA 25E1       BCS   $9E9D     ;line not found - store a 3 for 'UL'
9EBC DC47       LDD   <$47      ;address of line
9EBE 6C80       INC   ,X+
9EC0 ED84       STD   ,X
9EC2 20C6       BRA   $9E8A
9EC4 6F84       CLR   ,X        ;becomes a 1 in a moment
9EC6 AE01       LDX   1,X       ;address of line
9EC8 AE02       LDX   2,X       ;actual line number
9ECA 9F47       STX   <$47
9ECC 20EA       BRA   $9EB8     ;store it in info block

*** RENUM: prepare line numbers in statements
    (replaces line number digits with 5 byte info block)

9ECE 9E19       LDX   <$19      ;start of BASIC program
9ED0 2004       BRA   $9ED6
9ED2 9EA6       LDX   <$A6      ;BASIC source pointer
9ED4 3001       LEAX  1,X
9ED6 8D9F       BSR   $9E77     ;test for end of program 
9ED8 3002       LEAX  2,X
9EDA 3001       LEAX  1,X
9EDC 9FA6       STX   <$A6      ;BASIC source pointer
9EDE 9D9F       JSR   <$9F      ;get next character from BASIC source
9EE0 4D         TSTA
9EE1 27EF       BEQ   $9ED2     ;end of line
9EE3 2AF9       BPL   $9EDE     ;non-token
9EE5 9EA6       LDX   <$A6      ;BASIC source pointer
9EE7 81FF       CMPA  #$FF
9EE9 27EF       BEQ   $9EDA     ;skip function token
9EEB BD01A0     JSR   $01A0     ;PATCH - CLS GET PUT ???
9EEE 81BF       CMPA  #$BF      ;token THEN
9EF0 2712       BEQ   $9F04
9EF2 8184       CMPA  #$84      ;token ELSE
9EF4 270E       BEQ   $9F04
9EF6 8181       CMPA  #$81      ;token GO
9EF8 26E4       BNE   $9EDE
9EFA 9D9F       JSR   <$9F      ;get next character from BASIC source
9EFC 81BC       CMPA  #$BC      ;token TO
9EFE 2704       BEQ   $9F04
9F00 81BD       CMPA  #$BD      ;token SUB
9F02 26D8       BNE   $9EDC     ;keep looking for interesting stuff
9F04 9D9F       JSR   <$9F      ;get next character from BASIC source
9F06 2504       BCS   $9F0C     ;found digit
9F08 9DA5       JSR   <$A5      ;get current character from BASIC source
9F0A 20D4       BRA   $9EE0
9F0C 9EA6       LDX   <$A6      ;BASIC source pointer
9F0E 3410       PSHS  X         ;start of digits
9F10 BD869A     JSR   $869A     ;read line number & store in $2b
9F13 9EA6       LDX   <$A6      ;BASIC source pointer
9F15 A682       LDA   ,-X
9F17 BDA438     JSR   $A438     ;set carry if A is non-numeric character
9F1A 25F9       BCS   $9F15
9F1C 3001       LEAX  1,X       ;end of digits
9F1E 1F10       TFR   X,D
9F20 E061       SUBB  1,S
9F22 C005       SUBB  #$05 
9F24 2720       BEQ   $9F46     ;exactly 5 digits
9F26 250A       BCS   $9F32     ;less than 5 digits
9F28 3384       LEAU  ,X
9F2A 50         NEGB
9F2B 3085       LEAX  B,X
9F2D BD9DA9     JSR   $9DA9     ;move program down from U to X
9F30 2014       BRA   $9F46
9F32 9F47       STX   <$47
9F34 9E1B       LDX   <$1B      ;start of simple variables
9F36 9F43       STX   <$43
9F38 50         NEGB
9F39 3085       LEAX  B,X
9F3B 9F41       STX   <$41
9F3D 9F1B       STX   <$1B      ;start of simple variables
9F3F BD831C     JSR   $831C     ;move memory contents up
9F42 9E45       LDX   <$45
9F44 9FA6       STX   <$A6      ;BASIC source pointer
9F46 3510       PULS  X         ;start of digits
9F48 8601       LDA   #$01      ;
9F4A A784       STA   ,X        ;replace line number with 5 byte info block
9F4C A702       STA   2,X       ;line number coded to avoid zeros
9F4E A704       STA   4,X       ;otherwise world would fall apart
9F50 D62B       LDB   <$2B      ;
9F52 2604       BNE   $9F58     ;
9F54 C601       LDB   #$01      ;
9F56 6C02       INC   2,X       ;
9F58 E701       STB   1,X       ;
9F5A D62C       LDB   <$2C      ;
9F5C 2604       BNE   $9F62     ;
9F5E C601       LDB   #$01      ;
9F60 6C04       INC   4,X       ;
9F62 E703       STB   3,X       ;
9F64 9DA5       JSR   <$A5      ;get current character from BASIC source
9F66 812C       CMPA  #$2C
9F68 279A       BEQ   $9F04     ;comma - look for another line number
9F6A 209C       BRA   $9F08

*** RENUM: convert line numbers into ASCII again (also flags UL errors)

9F6C 9E19       LDX   <$19      ;start of BASIC program
9F6E 301F       LEAX  -1,X
9F70 3001       LEAX  1,X
9F72 EC02       LDD   2,X
9F74 DD68       STD   <$68      ;current line number
9F76 BD9E77     JSR   $9E77     ;test for end of program 
9F79 3003       LEAX  3,X
9F7B 3001       LEAX  1,X
9F7D A684       LDA   ,X
9F7F 27EF       BEQ   $9F70     ;end of line
9F81 4A         DECA
9F82 271B       BEQ   $9F9F     ;found an info block
9F84 8002       SUBA  #$02
9F86 26F3       BNE   $9F7B
9F88 3410       PSHS  X
9F8A 8E9FC9     LDX   #$9FC9    ;/UL /
9F8D BD90E5     JSR   $90E5     ;print string to DEVN
9F90 AEE4       LDX   ,S
9F92 EC01       LDD   1,X
9F94 BD957A     JSR   $957A     ;print unsigned number in D
9F97 BD9573     JSR   $9573     ;print 'IN xxxx' (current line number)
9F9A BD90A1     JSR   $90A1     ;send CR to DEVN
9F9D 3510       PULS  X
9F9F 3410       PSHS  X
9FA1 EC01       LDD   1,X       ;adjusted line number
9FA3 DD52       STD   <$52
9FA5 BD9C3E     JSR   $9C3E     ;assign contents of $52 / $53 to FPA1
9FA8 BD9587     JSR   $9587     ;convert FPA1 to string at $3DA
9FAB 3540       PULS  U
9FAD C605       LDB   #$05
9FAF 3001       LEAX  1,X       ;write line number into program
9FB1 A684       LDA   ,X        ;
9FB3 2705       BEQ   $9FBA     ;
9FB5 5A         DECB            ;
9FB6 A7C0       STA   ,U+       ;
9FB8 20F5       BRA   $9FAF     ;
9FBA 30C4       LEAX  ,U
9FBC 5D         TSTB
9FBD 27BE       BEQ   $9F7D     ;exactly 5 digits - no problem
9FBF 31C4       LEAY  ,U
9FC1 33C5       LEAU  B,U
9FC3 BD9DA9     JSR   $9DA9     ;move program down from U to X
9FC6 30A4       LEAX  ,Y
9FC8 20B3       BRA   $9F7D

9FCA  554C2000      ;/UL /

*** unused

9FCE to
9FFF


*** indirect jump vectors

A000 8006   ;scan keyboard
A002 B54A   ;output character to DEVN
A004 8021   ;read leader
A006 B93E   ;read block
A008 B999   ;write block
A00A 8012   ;update joysticks
A00C 801B   ;write leader

*** HEX$

A00E BD8E86     JSR   $8E86     ;read 16 bit number into X from FPA1 (& $52)
A011 8E03D9     LDX   #$03D9
A014 C604       LDB   #$04
A016 3404       PSHS  B
A018 5F         CLRB
A019 8604       LDA   #$04      ;
A01B 0853       ASL   <$53      ;get a nibble into B
A01D 0952       ROL   <$52      ;
A01F 59         ROLB            ;
A020 4A         DECA            ;
A021 26F8       BNE   $A01B     ;
A023 5D         TSTB
A024 260A       BNE   $A030     ;digit non-zero
A026 A6E4       LDA   ,S
A028 4A         DECA
A029 2705       BEQ   $A030     ;at last digit
A02B 8C03D9     CMPX  #$03D9
A02E 270C       BEQ   $A03C     ;don't store leading zeroes
A030 CB30       ADDB  #$30   0
A032 C139       CMPB  #$39   9
A034 2302       BLS   $A038     ;not A - F
A036 CB07       ADDB  #$07
A038 E780       STB   ,X+
A03A 6F84       CLR   ,X
A03C 3504       PULS  B
A03E 5A         DECB
A03F 26D5       BNE   $A016
A041 3262       LEAS  2,S       ;lose return address
A043 8E03D8     LDX   #$03D8
A046 7E8C5B     JMP   $8C5B     ;register string at X

*** DLOAD
;Non-functional because serial I/O routines not implemented

A049 BDB65F     JSR   $B65F     ;close cassette stream & set DEVN to 0
A04C 6FE2       CLR   ,-S
A04E 9DA5       JSR   <$A5      ;get current character from BASIC source
A050 814D       CMPA  #$4D   M
A052 2604       BNE   $A058
A054 A7E4       STA   ,S
A056 9D9F       JSR   <$9F      ;get next character from BASIC source
A058 BDB7AA     JSR   $B7AA     ;get filename
A05B 9DA5       JSR   <$A5      ;get current character from BASIC source
A05D 2711       BEQ   $A070
A05F BD89AA     JSR   $89AA     ;check comma
A062 812C       CMPA  #$2C   ,
A064 270A       BEQ   $A070
A066 BD8E51     JSR   $8E51     ;get number in B
A069 BD8030     JSR   $8030     ;select baud rate
A06C 1025EB1D  LBCS   $8B8D     ;?FC ERROR
A070 BDA0F4     JSR   $A0F4     ;send filename & get 1st block
A073 3402       PSHS  A
A075 86FD       LDA   #$FD
A077 976F       STA   <$6F      ;DEVN = -3
A079 3502       PULS  A
A07B 6DE0       TST   ,S+
A07D 262A       BNE   $A0A9     ;DLOADM
A07F BDB7F9     JSR   $B7F9     ;ensure nothing else on command line
A082 5D         TSTB            ;B must not be 0
A083 2706       BEQ   $A08B     ;?FM ERROR
A085 BD8417     JSR   $8417     ;NEW BASIC
A088 7E837A     JMP   $837A     ;command mode / no device initialise

A08B 7EB848     JMP   $B848     ;?FM ERROR

*** called by CLOAD to handle CLOADM

A08E 0F78       CLR   <$78      ;cassette IO status
A090 9D9F       JSR   <$9F      ;get next character from BASIC source
A092 BDB7AA     JSR   $B7AA     ;get filename
A095 BDB87A     JSR   $B87A     ;find file & set up buffer
A098 7D01E4     TST   $01E4     ;gap flag
A09B 1027169D  LBEQ   $B73C     ;continuous file
A09F FE01E2     LDU   $01E2     ;U = file type & ASCII flag
A0A2 0A6F       DEC   <$6F      ;DEVN
A0A4 BDB867     JSR   $B867     ;get block from tape
A0A7 1F30       TFR   U,D

*** called by DLOAD to handle DLOADM
    
    For both CLOADM & DLOADM, this is now a gapped binary file, with data
    being read on a character by character basis. Note that data blocks do
    not have to align with physical file blocks; the data is treated as a
    continuous stream.
    Within the file data itself, the first byte is an end of file marker.
    Next 4 bytes are the data length and the load address, followed by the 
    data. This repeats until the end of file marker is true, whereupon
    the final load address encountered becomes the EXEC address. There is
    no data in the EOF block.

A0A9 830200     SUBD  #$0200
A0AC 26DD       BNE   $A08B     ;?FM ERROR
A0AE 9E8A       LDX   <$8A      ;zero
A0B0 9DA5       JSR   <$A5      ;get current character from BASIC source
A0B2 2706       BEQ   $A0BA
A0B4 BD89AA     JSR   $89AA     ;check comma
A0B7 BD8E83     JSR   $8E83     ;get 16 bit number into X
A0BA 9FD3       STX   <$D3      ;load offset
A0BC BDB7F9     JSR   $B7F9     ;ensure nothing else on command line
A0BF 8D29       BSR   $A0EA     ;read character from DEVN
A0C1 3402       PSHS  A
A0C3 8D1E       BSR   $A0E3     ;read 2 characters from DEVN into D
A0C5 1F02       TFR   D,Y         ;Y = data length
A0C7 8D1A       BSR   $A0E3     ;read 2 characters from DEVN into D
A0C9 D3D3       ADDD  <$D3
A0CB DD9D       STD   <$9D      ;default EXEC address
A0CD 1F01       TFR   D,X         ;X = load address (inc. offset)
A0CF A6E0       LDA   ,S+
A0D1 1026158E  LBNE   $B663     ;close DEVN stream & set DEVN to 0
A0D5 8D13       BSR   $A0EA     ;read character from DEVN
A0D7 A784       STA   ,X
A0D9 A180       CMPA  ,X+       ;checks that we are loading into RAM
A0DB 2614       BNE   $A0F1     ;?IO ERROR
A0DD 313F       LEAY  -1,Y
A0DF 26F4       BNE   $A0D5
A0E1 20DC       BRA   $A0BF

*** read 2 characters from DEVN into D

A0E3 8D00       BSR   $A0E5
A0E5 8D03       BSR   $A0EA     ;read character from DEVN
A0E7 1E89       EXG   A,B
A0E9 39         RTS

*** read character from device DEVN
    (+cause error if EOF)

A0EA BDB50A     JSR   $B50A
A0ED 0D70       TST   <$70      ;EOF flag
A0EF 27F8       BEQ   $A0E9
A0F1 7EB84B     JMP   $B84B     ;?IO ERROR

*** send filename & get 1st block

A0F4 8D1F       BSR   $A115     ;send filename to serial port
A0F6 3406       PSHS  A,B
A0F8 4C         INCA
A0F9 2706       BEQ   $A101
A0FB DE8A       LDU   <$8A      ;zero
A0FD 8D09       BSR   $A108     ;get block from serial port
A0FF 3586       PULS  A,B,PC
A101 C634       LDB   #$34      ;?NE ERROR
A103 7E8344     JMP   $8344

*** get block from serial port into IO buffer

A106 DE7E       LDU   <$7E
A108 3041       LEAX  1,U
A10A 9F7E       STX   <$7E
A10C 8E01DA     LDX   #$01DA    ;IO buffer
A10F BDA17E     JSR   $A17E     ;get serial block & store at X
A112 7EB876     JMP   $B876     ;update IO buffer size / reset header address

*** send filename to serial port

A115 4F         CLRA
A116 3416       PSHS  A,B,X
A118 31E4       LEAY  ,S
A11A 2002       BRA   $A11E
A11C 8D2B       BSR   $A149     ;5 retries only
A11E 868A       LDA   #$8A
A120 8D37       BSR   $A159     ;clear checksum, write, read & compare
A122 26F8       BNE   $A11C
A124 8E01D2     LDX   #$01D2    ;filename
A127 A680       LDA   ,X+
A129 BDA1C1     JSR   $A1C1     ;update checksum & write serial
A12C 8C01DA     CMPX  #$01DA    ;IO buffer
A12F 26F6       BNE   $A127     ;filename now sent
A131 8D30       BSR   $A163     ;send checksum & clear, read & compare #$c8
A133 26E7       BNE   $A11C
A135 8D3C       BSR   $A173     ;read serial & update checksum
A137 26E3       BNE   $A11C
A139 A722       STA   2,Y
A13B 8D36       BSR   $A173     ;read serial & update checksum
A13D 26DD       BNE   $A11C
A13F A723       STA   3,Y
A141 8D29       BSR   $A16C     ;read serial, update checksum & load A
A143 26D7       BNE   $A11C
A145 3262       LEAS  2,S
A147 3586       PULS  A,B,PC

*** retry count - cause error if count reaches 5

A149 6CA4       INC   ,Y
A14B A6A4       LDA   ,Y
A14D 8105       CMPA  #$05
A14F 251A       BCS   $A16B
A151 86BC       LDA   #$BC
A153 BD802D     JSR   $802D     ;write serial character
A156 7EB84B     JMP   $B84B     ;?IO ERROR

*** clear checksum, write serial, read & compare

A159 3402       PSHS  A
A15B 8D5D       BSR   $A1BA     ;clear checksum, write serial & read
A15D 2602       BNE   $A161
A15F A1E4       CMPA  ,S
A161 3582       PULS  A,PC

*** send checksum & clear, read & compare #$c8

A163 A621       LDA   1,Y
A165 8D53       BSR   $A1BA     ;clear checksum, write serial & read
A167 2602       BNE   $A16B
A169 81C8       CMPA  #$C8
A16B 39         RTS

*** read serial, update checksum & load A

A16C 8D05       BSR   $A173     ;read serial & update checksum
A16E 26FB       BNE   $A16B
A170 A621       LDA   1,Y
A172 39         RTS

*** read serial & update checksum

A173 BD802A     JSR   $802A     ;read serial character
A176 3403       PSHS  CC,A
A178 A821       EORA  1,Y
A17A A721       STA   1,Y
A17C 3583       PULS  CC,A,PC

*** get block from serial & store starting at X

A17E 4F         CLRA
A17F 3476       PSHS  A,B,X,Y,U
A181 6867       ASL   7,S
A183 6966       ROL   6,S
A185 6467       LSR   7,S
A187 31E4       LEAY  ,S
A189 2002       BRA   $A18D
A18B 8DBC       BSR   $A149     ;5 retries only
A18D 8697       LDA   #$97
A18F 8DC8       BSR   $A159     ;clear checksum, write, read & compare
A191 26F8       BNE   $A18B
A193 A626       LDA   6,Y
A195 8D2A       BSR   $A1C1     ;update checksum & write serial
A197 A627       LDA   7,Y
A199 8D26       BSR   $A1C1     ;update checksum & write serial
A19B 8DC6       BSR   $A163     ;send checksum & clear, read & compare #$c8
A19D 26EC       BNE   $A18B
A19F 8DD2       BSR   $A173     ;read serial & update checksum
A1A1 26E8       BNE   $A18B
A1A3 A724       STA   4,Y
A1A5 AE22       LDX   2,Y
A1A7 C680       LDB   #$80
A1A9 8DC8       BSR   $A173     ;read serial & update checksum
A1AB 26DE       BNE   $A18B
A1AD A780       STA   ,X+
A1AF 5A         DECB
A1B0 26F7       BNE   $A1A9
A1B2 8DB8       BSR   $A16C     ;read serial, update checksum & load A
A1B4 26D5       BNE   $A18B
A1B6 3264       LEAS  4,S
A1B8 3596       PULS  A,B,X,PC

*** clear checksum, write serial & read

A1BA 6F21       CLR   1,Y
A1BC 8D0B       BSR   $A1C9
A1BE 7E802A     JMP   $802A     ;read serial character

*** update checksum & write serial

A1C1 3402       PSHS  A
A1C3 A821       EORA  1,Y
A1C5 A721       STA   1,Y
A1C7 3502       PULS  A
A1C9 7E802D     JMP   $802D     ;write serial character

*** handle ! (PRINT USING 1st character)

A1CC 8601       LDA   #$01
A1CE 97D9       STA   <$D9
A1D0 5A         DECB
A1D1 BDA366     JSR   $A366     ;print a plus sign to DEVN if $DA set
A1D4 9DA5       JSR   <$A5      ;get current character from BASIC source
A1D6 1027008C  LBEQ   $A266
A1DA D7D3       STB   <$D3
A1DC BD8887     JSR   $8887     ;get expression
A1DF BD8877     JSR   $8877     ;validate string
A1E2 9E52       LDX   <$52
A1E4 9F4D       STX   <$4D
A1E6 D6D9       LDB   <$D9
A1E8 BD8DF3     JSR   $8DF3     ;perform left$ of B chrs on varptr X
A1EB BD90E8     JSR   $90E8     ;print string just compiled to DEVN
A1EE 9E52       LDX   <$52
A1F0 D6D9       LDB   <$D9
A1F2 E084       SUBB  ,X
A1F4 5A         DECB
A1F5 102B0148  LBMI   $A341
A1F9 BD90F5     JSR   $90F5     ;send a space to DEVN
A1FC 20F6       BRA   $A1F4

*** handle % (PRINT USING string field)

A1FE D7D3       STB   <$D3
A200 9F0F       STX   <$0F
A202 8602       LDA   #$02
A204 97D9       STA   <$D9
A206 A684       LDA   ,X
A208 8125       CMPA  #$25   %
A20A 27C4       BEQ   $A1D0
A20C 8120       CMPA  #$20
A20E 2607       BNE   $A217
A210 0CD9       INC   <$D9
A212 3001       LEAX  1,X
A214 5A         DECB
A215 26EF       BNE   $A206
A217 9E0F       LDX   <$0F
A219 D6D3       LDB   <$D3
A21B 8625       LDA   #$25   %
A21D BDA366     JSR   $A366     ;print a plus sign to DEVN if $DA set
A220 BDB54A     JSR   $B54A     ;output character to DEVN
A223 2022       BRA   $A247

*** called by PRINT to handle USING

A225 BD8889     JSR   $8889     ;get expression
A228 BD8877     JSR   $8877     ;validate string
A22B C63B       LDB   #$3B
A22D BD89AC     JSR   $89AC     ;skip semicolon
A230 9E52       LDX   <$52
A232 9FD5       STX   <$D5      ;varptr of USING string
A234 2006       BRA   $A23C
A236 96D7       LDA   <$D7
A238 2708       BEQ   $A242     ;?FC ERROR
A23A 9ED5       LDX   <$D5
A23C 0FD7       CLR   <$D7      ;comma counter?
A23E E684       LDB   ,X
A240 2603       BNE   $A245     ;USING string has a length
A242 7E8B8D     JMP   $8B8D     ;?FC ERROR
A245 AE02       LDX   2,X       ;point X to USING string
A247 0FDA       CLR   <$DA
A249 0FD9       CLR   <$D9
A24B A680       LDA   ,X+
A24D 8121       CMPA  #$21   !
A24F 1027FF79  LBEQ   $A1CC     ;print 1st character
A253 8123       CMPA  #$23   #
A255 275B       BEQ   $A2B2     ;numeric field
A257 5A         DECB
A258 2616       BNE   $A270
A25A BDA366     JSR   $A366     ;print a plus sign to DEVN if $DA set
A25D BDB54A     JSR   $B54A     ;output character to DEVN
A260 9DA5       JSR   <$A5      ;get current character from BASIC source
A262 26D2       BNE   $A236
A264 96D7       LDA   <$D7
A266 2603       BNE   $A26B
A268 BD90A1     JSR   $90A1     ;send CR to DEVN
A26B 9ED5       LDX   <$D5
A26D 7E8D9F     JMP   $8D9F     ;point X to string & length in B

A270 812B       CMPA  #$2B   +
A272 2609       BNE   $A27D
A274 BDA366     JSR   $A366     ;print a plus sign to DEVN if $DA set
A277 8608       LDA   #$08
A279 97DA       STA   <$DA
A27B 20CC       BRA   $A249
A27D 812E       CMPA  #$2E   .
A27F 274E       BEQ   $A2CF
A281 8125       CMPA  #$25   %
A283 1027FF77  LBEQ   $A1FE
A287 A184       CMPA  ,X
A289 2692       BNE   $A21D
A28B 8124       CMPA  #$24   $
A28D 2719       BEQ   $A2A8
A28F 812A       CMPA  #$2A   *
A291 26F6       BNE   $A289
A293 96DA       LDA   <$DA
A295 8A20       ORA   #$20
A297 97DA       STA   <$DA
A299 C102       CMPB  #$02
A29B 2511       BCS   $A2AE
A29D A601       LDA   1,X
A29F 8124       CMPA  #$24   $
A2A1 260B       BNE   $A2AE
A2A3 5A         DECB
A2A4 3001       LEAX  1,X
A2A6 0CD9       INC   <$D9
A2A8 96DA       LDA   <$DA
A2AA 8A10       ORA   #$10
A2AC 97DA       STA   <$DA
A2AE 3001       LEAX  1,X
A2B0 0CD9       INC   <$D9
A2B2 0FD8       CLR   <$D8
A2B4 0CD9       INC   <$D9
A2B6 5A         DECB
A2B7 2749       BEQ   $A302
A2B9 A680       LDA   ,X+
A2BB 812E       CMPA  #$2E   .
A2BD 271E       BEQ   $A2DD
A2BF 8123       CMPA  #$23   #
A2C1 27F1       BEQ   $A2B4
A2C3 812C       CMPA  #$2C   ,
A2C5 2621       BNE   $A2E8
A2C7 96DA       LDA   <$DA
A2C9 8A40       ORA   #$40   @
A2CB 97DA       STA   <$DA
A2CD 20E5       BRA   $A2B4
A2CF A684       LDA   ,X
A2D1 8123       CMPA  #$23   #
A2D3 1026FF46  LBNE   $A21D
A2D7 8601       LDA   #$01
A2D9 97D8       STA   <$D8
A2DB 3001       LEAX  1,X
A2DD 0CD8       INC   <$D8
A2DF 5A         DECB
A2E0 2720       BEQ   $A302
A2E2 A680       LDA   ,X+
A2E4 8123       CMPA  #$23   #
A2E6 27F5       BEQ   $A2DD
A2E8 815E       CMPA  #$5E   ^
A2EA 2616       BNE   $A302
A2EC A184       CMPA  ,X
A2EE 2612       BNE   $A302
A2F0 A101       CMPA  1,X
A2F2 260E       BNE   $A302
A2F4 A102       CMPA  2,X
A2F6 260A       BNE   $A302
A2F8 C104       CMPB  #$04
A2FA 2506       BCS   $A302
A2FC C004       SUBB  #$04
A2FE 3004       LEAX  4,X
A300 0CDA       INC   <$DA
A302 301F       LEAX  -1,X
A304 0CD9       INC   <$D9
A306 96DA       LDA   <$DA
A308 8508       BITA  #$08
A30A 2618       BNE   $A324
A30C 0AD9       DEC   <$D9
A30E 5D         TSTB
A30F 2713       BEQ   $A324
A311 A684       LDA   ,X
A313 802D       SUBA  #$2D   -
A315 2706       BEQ   $A31D
A317 81FE       CMPA  #$FE
A319 2609       BNE   $A324
A31B 8608       LDA   #$08
A31D 8A04       ORA   #$04
A31F 9ADA       ORA   <$DA
A321 97DA       STA   <$DA
A323 5A         DECB
A324 9DA5       JSR   <$A5      ;get current character from BASIC source
A326 1027FF3C  LBEQ   $A266
A32A D7D3       STB   <$D3
A32C BD8872     JSR   $8872
A32F 96D9       LDA   <$D9
A331 9BD8       ADDA  <$D8
A333 8111       CMPA  #$11
A335 1022E854  LBHI   $8B8D     ;?FC ERROR
A339 BDA373     JSR   $A373
A33C 301F       LEAX  -1,X
A33E BD90E5     JSR   $90E5     ;print string to DEVN
A341 0FD7       CLR   <$D7
A343 9DA5       JSR   <$A5      ;get current character from BASIC source
A345 270D       BEQ   $A354
A347 97D7       STA   <$D7
A349 813B       CMPA  #$3B   ;
A34B 2705       BEQ   $A352
A34D BD89AA     JSR   $89AA     ;check comma
A350 2002       BRA   $A354
A352 9D9F       JSR   <$9F      ;get next character from BASIC source
A354 9ED5       LDX   <$D5
A356 E684       LDB   ,X
A358 D0D3       SUBB  <$D3
A35A AE02       LDX   2,X
A35C 3A         ABX
A35D D6D3       LDB   <$D3
A35F 1026FEE4  LBNE   $A247
A363 7EA260     JMP   $A260

*** print a plus sign to DEVN if $DA set

A366 3402       PSHS  A
A368 862B       LDA   #$2B   +
A36A 0DDA       TST   <$DA
A36C 2703       BEQ   $A371
A36E BDB54A     JSR   $B54A     ;output character to DEVN
A371 3582       PULS  A,PC

A373 CE03DB     LDU   #$03DB
A376 C620       LDB   #$20
A378 96DA       LDA   <$DA
A37A 8508       BITA  #$08
A37C 2702       BEQ   $A380
A37E C62B       LDB   #$2B   +
A380 0D54       TST   <$54
A382 2A04       BPL   $A388
A384 0F54       CLR   <$54
A386 C62D       LDB   #$2D   -
A388 E7C0       STB   ,U+
A38A C630       LDB   #$30   0
A38C E7C0       STB   ,U+
A38E 8401       ANDA  #$01
A390 10260107  LBNE   $A49B
A394 8E956E     LDX   #$956E    ;FP constant 1000000000
A397 BD944B     JSR   $944B     ;compare FPA1 - varptr X (of same sign)
A39A 2B15       BMI   $A3B1
A39C BD9587     JSR   $9587     ;convert FPA1 to string at $3da
A39F A680       LDA   ,X+
A3A1 26FC       BNE   $A39F
A3A3 A682       LDA   ,-X
A3A5 A701       STA   1,X
A3A7 8C03DA     CMPX  #$03DA
A3AA 26F7       BNE   $A3A3
A3AC 8625       LDA   #$25   %
A3AE A784       STA   ,X
A3B0 39         RTS

A3B1 964F       LDA   <$4F
A3B3 9747       STA   <$47
A3B5 2703       BEQ   $A3BA
A3B7 BDA55B     JSR   $A55B     ;convert FPA1 to sig figs & exponent in $47
A3BA 9647       LDA   <$47
A3BC 102B0081  LBMI   $A441
A3C0 40         NEGA
A3C1 9BD9       ADDA  <$D9
A3C3 8009       SUBA  #$09
A3C5 BDA478     JSR   $A478
A3C8 BDA5F1     JSR   $A5F1
A3CB BDA590     JSR   $A590     ;print number to U (commas & point if reqd)
A3CE 9647       LDA   <$47
A3D0 BDA60F     JSR   $A60F
A3D3 9647       LDA   <$47
A3D5 BDA5D7     JSR   $A5D7
A3D8 96D8       LDA   <$D8
A3DA 2602       BNE   $A3DE
A3DC 335F       LEAU  -1,U
A3DE 4A         DECA
A3DF BDA478     JSR   $A478
A3E2 BDA513     JSR   $A513
A3E5 4D         TSTA
A3E6 2706       BEQ   $A3EE
A3E8 C12A       CMPB  #$2A   *
A3EA 2702       BEQ   $A3EE
A3EC E7C0       STB   ,U+
A3EE 6FC4       CLR   ,U
A3F0 8E03DA     LDX   #$03DA
A3F3 3001       LEAX  1,X
A3F5 9F0F       STX   <$0F
A3F7 963A       LDA   <$3A
A3F9 9010       SUBA  <$10
A3FB 90D9       SUBA  <$D9
A3FD 2738       BEQ   $A437
A3FF A684       LDA   ,X
A401 8120       CMPA  #$20
A403 27EE       BEQ   $A3F3
A405 812A       CMPA  #$2A   *
A407 27EA       BEQ   $A3F3
A409 4F         CLRA
A40A 3402       PSHS  A
A40C A680       LDA   ,X+
A40E 812D       CMPA  #$2D   -
A410 27F8       BEQ   $A40A
A412 812B       CMPA  #$2B   +
A414 27F4       BEQ   $A40A
A416 8124       CMPA  #$24   $
A418 27F0       BEQ   $A40A
A41A 8130       CMPA  #$30   0
A41C 260E       BNE   $A42C
A41E A601       LDA   1,X
A420 8D16       BSR   $A438     ;carry set if A non-numeric
A422 2508       BCS   $A42C
A424 3502       PULS  A
A426 A782       STA   ,-X
A428 26FA       BNE   $A424
A42A 20C7       BRA   $A3F3
A42C 3502       PULS  A
A42E 4D         TSTA
A42F 26FB       BNE   $A42C
A431 9E0F       LDX   <$0F
A433 8625       LDA   #$25   %
A435 A782       STA   ,-X
A437 39         RTS

*** carry clear if A is ASCII digit

A438 8130       CMPA  #$30   0
A43A 2504       BCS   $A440
A43C 803A       SUBA  #$3A   :
A43E 80C6       SUBA  #$C6
A440 39         RTS

A441 96D8       LDA   <$D8
A443 2701       BEQ   $A446
A445 4A         DECA
A446 9B47       ADDA  <$47
A448 2B01       BMI   $A44B
A44A 4F         CLRA
A44B 3402       PSHS  A
A44D 2A0A       BPL   $A459
A44F 3402       PSHS  A
A451 BD932D     JSR   $932D     ;divide FPA1 by 10
A454 3502       PULS  A
A456 4C         INCA
A457 20F4       BRA   $A44D
A459 9647       LDA   <$47
A45B A0E0       SUBA  ,S+
A45D 9747       STA   <$47
A45F 8B09       ADDA  #$09
A461 2B19       BMI   $A47C
A463 96D9       LDA   <$D9
A465 8009       SUBA  #$09
A467 9047       SUBA  <$47
A469 8D0D       BSR   $A478
A46B BDA5F1     JSR   $A5F1
A46E 201D       BRA   $A48D
A470 3402       PSHS  A
A472 8630       LDA   #$30   0
A474 A7C0       STA   ,U+
A476 3502       PULS  A
A478 4A         DECA
A479 2AF5       BPL   $A470
A47B 39         RTS

A47C 96D9       LDA   <$D9
A47E 8DF8       BSR   $A478
A480 BDA5DB     JSR   $A5DB
A483 86F7       LDA   #$F7
A485 9047       SUBA  <$47
A487 8DEF       BSR   $A478
A489 0F45       CLR   <$45
A48B 0FD7       CLR   <$D7
A48D BDA590     JSR   $A590     ;print number to U (commas & point if reqd)
A490 96D8       LDA   <$D8
A492 2602       BNE   $A496
A494 DE39       LDU   <$39
A496 9B47       ADDA  <$47
A498 16FF43     LBRA  $A3DE
A49B 964F       LDA   <$4F
A49D 3402       PSHS  A
A49F 2703       BEQ   $A4A4
A4A1 BDA55B     JSR   $A55B     ;convert FPA1 to sig figs & exponent in $47
A4A4 96D8       LDA   <$D8
A4A6 2701       BEQ   $A4A9
A4A8 4A         DECA
A4A9 9BD9       ADDA  <$D9
A4AB 7F03DA     CLR   $03DA
A4AE D6DA       LDB   <$DA
A4B0 C404       ANDB  #$04
A4B2 2603       BNE   $A4B7
A4B4 7303DA     COM   $03DA
A4B7 BB03DA     ADDA  $03DA
A4BA 8009       SUBA  #$09
A4BC 3402       PSHS  A
A4BE 2A0A       BPL   $A4CA
A4C0 3402       PSHS  A
A4C2 BD932D     JSR   $932D     ;divide FPA1 by 10
A4C5 3502       PULS  A
A4C7 4C         INCA
A4C8 20F4       BRA   $A4BE
A4CA A6E4       LDA   ,S
A4CC 2B01       BMI   $A4CF
A4CE 4F         CLRA
A4CF 40         NEGA
A4D0 9BD9       ADDA  <$D9
A4D2 4C         INCA
A4D3 BB03DA     ADDA  $03DA
A4D6 9745       STA   <$45
A4D8 0FD7       CLR   <$D7
A4DA BDA590     JSR   $A590     ;print number to U (commas & point if reqd)
A4DD 3502       PULS  A
A4DF BDA60F     JSR   $A60F
A4E2 96D8       LDA   <$D8
A4E4 2602       BNE   $A4E8
A4E6 335F       LEAU  -1,U
A4E8 E6E0       LDB   ,S+
A4EA 2709       BEQ   $A4F5
A4EC D647       LDB   <$47
A4EE CB09       ADDB  #$09
A4F0 D0D9       SUBB  <$D9
A4F2 F003DA     SUBB  $03DA
A4F5 862B       LDA   #$2B   +
A4F7 5D         TSTB
A4F8 2A03       BPL   $A4FD
A4FA 862D       LDA   #$2D   -
A4FC 50         NEGB
A4FD A741       STA   1,U
A4FF 8645       LDA   #$45   E
A501 A7C1       STA   ,U++
A503 862F       LDA   #$2F   /
A505 4C         INCA
A506 C00A       SUBB  #$0A
A508 24FB       BCC   $A505
A50A CB3A       ADDB  #$3A   :
A50C EDC1       STD   ,U++
A50E 6FC4       CLR   ,U
A510 7EA3E2     JMP   $A3E2
A513 8E03DB     LDX   #$03DB
A516 E684       LDB   ,X
A518 3404       PSHS  B
A51A 8620       LDA   #$20
A51C D6DA       LDB   <$DA
A51E C520       BITB  #$20
A520 3504       PULS  B
A522 2708       BEQ   $A52C
A524 862A       LDA   #$2A   *
A526 C120       CMPB  #$20
A528 2602       BNE   $A52C
A52A 1F89       TFR   A,B
A52C 3404       PSHS  B
A52E A780       STA   ,X+
A530 E684       LDB   ,X
A532 2710       BEQ   $A544
A534 C145       CMPB  #$45   E
A536 270C       BEQ   $A544
A538 C130       CMPB  #$30   0
A53A 27F2       BEQ   $A52E
A53C C12C       CMPB  #$2C   ,
A53E 27EE       BEQ   $A52E
A540 C12E       CMPB  #$2E   .
A542 2604       BNE   $A548
A544 8630       LDA   #$30   0
A546 A782       STA   ,-X
A548 96DA       LDA   <$DA
A54A 8510       BITA  #$10
A54C 2704       BEQ   $A552
A54E C624       LDB   #$24   $
A550 E782       STB   ,-X
A552 8404       ANDA  #$04
A554 3504       PULS  B
A556 2602       BNE   $A55A
A558 E782       STB   ,-X
A55A 39         RTS

*** convert FPA1 to sig figs & exponent in $47

A55B 3440       PSHS  U
A55D 4F         CLRA
A55E 9747       STA   <$47
A560 D64F       LDB   <$4F
A562 C180       CMPB  #$80
A564 2211       BHI   $A577
A566 8E956E     LDX   #$956E    ;FP constant 1000000000
A569 BD9273     JSR   $9273     ;FPA1 = varptr X * FPA1
A56C 9647       LDA   <$47
A56E 8009       SUBA  #$09
A570 20EC       BRA   $A55E
A572 BD932D     JSR   $932D     ;divide FPA1 by 10
A575 0C47       INC   <$47
A577 8E9569     LDX   #$9569    ;FP constant 999999999
A57A BD944B     JSR   $944B     ;compare FPA1 - varptr X (of same sign)
A57D 2EF3       BGT   $A572
A57F 8E9564     LDX   #$9564    ;FP constant 99999999.9
A582 BD944B     JSR   $944B     ;compare FPA1 - varptr X (of same sign)
A585 2E07       BGT   $A58E
A587 BD9315     JSR   $9315     ;multiply FPA1 by 10
A58A 0A47       DEC   <$47
A58C 20F1       BRA   $A57F
A58E 35C0       PULS  U,PC

*** print number to U (commas & point if reqd)

A590 3440       PSHS  U
A592 BD90FD     JSR   $90FD     ;add 0.5 to FPA1
A595 BD9473     JSR   $9473     ;denormalize FPA1 to an integer
A598 3540       PULS  U
A59A 8E9673     LDX   #$9673    ;powers of 10 table
A59D C680       LDB   #$80
A59F 8D36       BSR   $A5D7
A5A1 9653       LDA   <$53
A5A3 AB03       ADDA  3,X
A5A5 9753       STA   <$53
A5A7 9652       LDA   <$52
A5A9 A902       ADCA  2,X
A5AB 9752       STA   <$52
A5AD 9651       LDA   <$51
A5AF A901       ADCA  1,X
A5B1 9751       STA   <$51
A5B3 9650       LDA   <$50
A5B5 A984       ADCA  ,X
A5B7 9750       STA   <$50
A5B9 5C         INCB
A5BA 56         RORB
A5BB 59         ROLB
A5BC 28E3       BVC   $A5A1
A5BE 2403       BCC   $A5C3
A5C0 C00B       SUBB  #$0B
A5C2 50         NEGB
A5C3 CB2F       ADDB  #$2F   /
A5C5 3004       LEAX  4,X
A5C7 1F98       TFR   B,A
A5C9 847F       ANDA  #$7F
A5CB A7C0       STA   ,U+
A5CD 53         COMB
A5CE C480       ANDB  #$80
A5D0 8C9697     CMPX  #$9697
A5D3 26CA       BNE   $A59F
A5D5 6FC4       CLR   ,U
A5D7 0A45       DEC   <$45
A5D9 2609       BNE   $A5E4
A5DB DF39       STU   <$39
A5DD 862E       LDA   #$2E   .
A5DF A7C0       STA   ,U+
A5E1 0FD7       CLR   <$D7
A5E3 39         RTS

*** store a comma if required

A5E4 0AD7       DEC   <$D7
A5E6 2608       BNE   $A5F0
A5E8 8603       LDA   #$03
A5EA 97D7       STA   <$D7
A5EC 862C       LDA   #$2C   ,
A5EE A7C0       STA   ,U+
A5F0 39         RTS

A5F1 9647       LDA   <$47
A5F3 8B0A       ADDA  #$0A
A5F5 9745       STA   <$45
A5F7 4C         INCA
A5F8 8003       SUBA  #$03
A5FA 24FC       BCC   $A5F8
A5FC 8B05       ADDA  #$05
A5FE 97D7       STA   <$D7
A600 96DA       LDA   <$DA
A602 8440       ANDA  #$40   @
A604 2602       BNE   $A608
A606 97D7       STA   <$D7
A608 39         RTS

A609 3402       PSHS  A
A60B 8DCA       BSR   $A5D7
A60D 3502       PULS  A
A60F 4A         DECA
A610 2B0A       BMI   $A61C
A612 3402       PSHS  A
A614 8630       LDA   #$30   0
A616 A7C0       STA   ,U+
A618 A6E0       LDA   ,S+
A61A 26ED       BNE   $A609
A61C 39         RTS

*** get address of pixel calc routine for current PMODE

A61D CEA62A     LDU   #$A62A
A620 96B6       LDA   <$B6      ;current PMODE
A622 48         ASLA
A623 EEC6       LDU   A,U
A625 39         RTS

*** call relevant pixel calc routine for PMODE

A626 8DF5       BSR   $A61D
A628 6EC4       JMP   ,U

*** JMP table containing pixel calc routines for each PMODE

A62A  A634 A650 A634 A650 A634

*** calculate pixel address & mask for 2 colour modes

A634 3444       PSHS  B,U
A636 D6B9       LDB   <$B9      ;bytes per line in current graphics mode 
A638 96C0       LDA   <$C0
A63A 3D         MUL
A63B D3BA       ADDD  <$BA      ;start of current graphics
A63D 1F01       TFR   D,X
A63F D6BE       LDB   <$BE
A641 54         LSRB
A642 54         LSRB
A643 54         LSRB
A644 3A         ABX
A645 96BE       LDA   <$BE
A647 8407       ANDA  #$07
A649 CEA66B     LDU   #$A66B
A64C A6C6       LDA   A,U
A64E 35C4       PULS  B,U,PC

*** calculate pixel address & mask for 4 colour modes

A650 3444       PSHS  B,U
A652 D6B9       LDB   <$B9      ;bytes per line in current graphics mode 
A654 96C0       LDA   <$C0
A656 3D         MUL
A657 D3BA       ADDD  <$BA      ;start of current graphics
A659 1F01       TFR   D,X
A65B D6BE       LDB   <$BE
A65D 54         LSRB
A65E 54         LSRB
A65F 3A         ABX
A660 96BE       LDA   <$BE
A662 8403       ANDA  #$03
A664 CEA673     LDU   #$A673
A667 A6C6       LDA   A,U
A669 35C4       PULS  B,U,PC

*** pixel mask table for 2 colour modes

A66B  80 40 20 10 08 04 02 01

*** pixel mask table for 4 colour modes

A673  C0 30 0C 03

*** move X one line down for all PMODEs

A677 D6B9       LDB   <$B9      ;bytes per line in current graphics mode 
A679 3A         ABX
A67A 39         RTS

*** pixel step routine for 2 colour PMODEs
    used by LINE

A67B 44         LSRA
A67C 2403       BCC   $A681
A67E 46         RORA
A67F 3001       LEAX  1,X
A681 39         RTS

*** pixel step routine for 4 colour PMODEs
    used by LINE

A682 44         LSRA
A683 24F6       BCC   $A67B
A685 86C0       LDA   #$C0
A687 3001       LEAX  1,X
A689 39         RTS

*** read coordinates into $bd & $bf

A68A BD8E7A     JSR   $8E7A     ;read pair of numbers into $2b/$2c & B
A68D 108E00BD   LDY   #$00BD
A691 C1C0       CMPB  #$C0
A693 2502       BCS   $A697
A695 C6BF       LDB   #$BF
A697 4F         CLRA
A698 ED22       STD   2,Y
A69A DC2B       LDD   <$2B
A69C 10830100   CMPD  #$0100
A6A0 2503       BCS   $A6A5
A6A2 CC00FF     LDD   #$00FF
A6A5 EDA4       STD   ,Y
A6A7 39         RTS

*** read coords into $bd & $bf and adjust for PMODE

A6A8 BDA68A     JSR   $A68A     ;read coordinates into $bd & $bf

*** adjust standard coords into true pixel coords

A6AB CE00BD     LDU   #$00BD
A6AE 96B6       LDA   <$B6      ;current PMODE
A6B0 8102       CMPA  #$02
A6B2 2406       BCC   $A6BA
A6B4 EC42       LDD   2,U       ;adjust Y for PMODEs 0 & 1
A6B6 44         LSRA
A6B7 56         RORB
A6B8 ED42       STD   2,U
A6BA 96B6       LDA   <$B6      ;current PMODE
A6BC 8104       CMPA  #$04
A6BE 2406       BCC   $A6C6
A6C0 ECC4       LDD   ,U        ;adjust X for PMODEs 0 to 3
A6C2 44         LSRA
A6C3 56         RORB
A6C4 EDC4       STD   ,U
A6C6 39         RTS

*** PPOINT

A6C7 BDA740     JSR   $A740     ;get coords into $bd / $bf
A6CA BDA6AB     JSR   $A6AB     ;adjust coords for PMODE
A6CD BDA626     JSR   $A626     ;call relevant pixel calc routine for PMODE
A6D0 A484       ANDA  ,X
A6D2 D6B6       LDB   <$B6      ;current PMODE
A6D4 56         RORB
A6D5 2412       BCC   $A6E9
A6D7 8104       CMPA  #$04
A6D9 2504       BCS   $A6DF
A6DB 46         RORA
A6DC 46         RORA
A6DD 20F8       BRA   $A6D7
A6DF 4C         INCA
A6E0 48         ASLA
A6E1 9BC1       ADDA  <$C1      ;current colour set
A6E3 44         LSRA
A6E4 1F89       TFR   A,B
A6E6 7E8C36     JMP   $8C36     ;assign B to FPA1
A6E9 4D         TSTA
A6EA 27F8       BEQ   $A6E4
A6EC 4F         CLRA
A6ED 20F0       BRA   $A6DF

*** PSET

A6EF 8601       LDA   #$01
A6F1 2001       BRA   $A6F4

*** PRESET

A6F3 4F         CLRA
A6F4 97C2       STA   <$C2      ;PRESET / PSET flag
A6F6 BD89A7     JSR   $89A7     ;skip open bracket
A6F9 BDA6A8     JSR   $A6A8     ;read coords into $bd & $bf and adjust
A6FC BDA90F     JSR   $A90F     ;read optional colour
A6FF BD89A4     JSR   $89A4     ;skip close bracket
A702 BDA626     JSR   $A626     ;call relevant pixel calc routine for PMODE

*** called by LINE to plot pixel

A705 E684       LDB   ,X
A707 3404       PSHS  B
A709 1F89       TFR   A,B
A70B 43         COMA
A70C A484       ANDA  ,X
A70E D4B5       ANDB  <$B5      ;byte value of plot colour
A710 3404       PSHS  B
A712 AAE0       ORA   ,S+
A714 A784       STA   ,X
A716 A0E0       SUBA  ,S+
A718 9ADB       ORA   <$DB
A71A 97DB       STA   <$DB
A71C 39         RTS

*** reads coordinate pair into $bd / $bf & $c3 / $c5
    if first pair is missing then current coords are used

A71D 9EC7       LDX   <$C7
A71F 9FBD       STX   <$BD
A721 9EC9       LDX   <$C9
A723 9FBF       STX   <$BF
A725 81C4       CMPA  #$C4      ;token -
A727 2703       BEQ   $A72C
A729 BDA740     JSR   $A740
A72C C6C4       LDB   #$C4
A72E BD89AC     JSR   $89AC
A731 BD89A7     JSR   $89A7     ;skip open bracket
A734 BD8E7A     JSR   $8E7A     ;read pair of numbers into $2b/$2c & B
A737 108E00C3   LDY   #$00C3
A73B BDA691     JSR   $A691
A73E 2006       BRA   $A746     ;skip close bracket

*** read coordinates inside brackets
    (into $bd & $bf)

A740 BD89A7     JSR   $89A7     ;skip open bracket
A743 BDA68A     JSR   $A68A     ;read coordinates into $bd & $bf
A746 7E89A4     JMP   $89A4     ;skip close bracket

*** LINE

A749 8189       CMPA  #$89      ;token INPUT
A74B 1027F662  LBEQ   $9DB1     ;LINE INPUT
A74F 8128       CMPA  #$28   (
A751 2709       BEQ   $A75C
A753 81C4       CMPA  #$C4      ;token -
A755 2705       BEQ   $A75C
A757 C640       LDB   #$40   @
A759 BD89AC     JSR   $89AC     ;optional @ before coords
A75C BDA71D     JSR   $A71D     ;sets up $bd/$bf & $c3/$c5
A75F 9EC3       LDX   <$C3      ;with coords
A761 9FC7       STX   <$C7
A763 9EC5       LDX   <$C5
A765 9FC9       STX   <$C9
A767 BD89AA     JSR   $89AA     ;check comma
A76A 81AD       CMPA  #$AD      ;token PRESET
A76C 2709       BEQ   $A777
A76E 81AC       CMPA  #$AC      ;token PSET
A770 1026E240  LBNE   $89B4     ;?SN ERROR
A774 C601       LDB   #$01
A776 86         LDA   #
(A777 5F         CLRB)
A778 3404       PSHS  B
A77A 9D9F       JSR   <$9F      ;get next character from BASIC source
A77C BDA7AE     JSR   $A7AE     ;adjust coords for PMODE
A77F 3504       PULS  B
A781 D7C2       STB   <$C2      ;PRESET / PSET flag
A783 BDA928     JSR   $A928     ;set up current colour
A786 9DA5       JSR   <$A5      ;get current character from BASIC source
A788 102700A3  LBEQ   $A82F     ;must be a normal line
A78C BD89AA     JSR   $89AA     ;check comma
A78F C642       LDB   #$42   B
A791 BD89AC     JSR   $89AC     ;check for 'B'
A794 2621       BNE   $A7B7

*** draw empty rectangle

A796 8D3A       BSR   $A7D2
A798 8D62       BSR   $A7FC
A79A 9EBD       LDX   <$BD
A79C 3410       PSHS  X
A79E 9EC3       LDX   <$C3
A7A0 9FBD       STX   <$BD
A7A2 8D58       BSR   $A7FC
A7A4 3510       PULS  X
A7A6 9FBD       STX   <$BD
A7A8 9EC5       LDX   <$C5
A7AA 9FBF       STX   <$BF
A7AC 2024       BRA   $A7D2

*** adjust line's coords for current PMODE

A7AE BDA6AB     JSR   $A6AB
A7B1 CE00C3     LDU   #$00C3
A7B4 7EA6AE     JMP   $A6AE

*** only 'F' allowed after 'B'

A7B7 C646       LDB   #$46   F
A7B9 BD89AC     JSR   $89AC
A7BC 2004       BRA   $A7C2

A7BE 301F       LEAX  -1,X
A7C0 9FBF       STX   <$BF

*** draw a solid rectangle

A7C2 BDA7D2     JSR   $A7D2     ;draw horizontal line
A7C5 9EBF       LDX   <$BF
A7C7 9CC5       CMPX  <$C5
A7C9 2706       BEQ   $A7D1
A7CB 24F1       BCC   $A7BE     ;next Y up or down?
A7CD 3001       LEAX  1,X
A7CF 20EF       BRA   $A7C0
A7D1 39         RTS

*** draw horizontal line from left to right

A7D2 9EBD       LDX   <$BD
A7D4 3410       PSHS  X
A7D6 BDAAB8     JSR   $AAB8     ;calc +ve difference in x ords
A7D9 2404       BCC   $A7DF
A7DB 9EC3       LDX   <$C3
A7DD 9FBD       STX   <$BD      ;store lower of two values for calc
A7DF 1F02       TFR   D,Y
A7E1 3121       LEAY  1,Y
A7E3 BDA626     JSR   $A626     ;calc pixel
A7E6 3540       PULS  U
A7E8 DFBD       STU   <$BD
A7EA 8D36       BSR   $A822     ;get address of pixel stepper in U
A7EC 97D7       STA   <$D7      ;store pixel mask
A7EE BDA705     JSR   $A705     ;plot
A7F1 96D7       LDA   <$D7
A7F3 ADC4       JSR   ,U        ;next pixel
A7F5 313F       LEAY  -1,Y
A7F7 26F3       BNE   $A7EC
A7F9 39         RTS

*** jumped from general line routine

A7FA 3506       PULS  A,B

*** draw vertical line downwards

A7FC DCBF       LDD   <$BF
A7FE 3406       PSHS  A,B
A800 BDAAAB     JSR   $AAAB     ;+ve difference in Y ords
A803 2404       BCC   $A809
A805 9EC5       LDX   <$C5
A807 9FBF       STX   <$BF
A809 1F02       TFR   D,Y
A80B 3121       LEAY  1,Y
A80D BDA626     JSR   $A626     ;call relevant pixel calc routine for PMODE
A810 3540       PULS  U
A812 DFBF       STU   <$BF
A814 8D15       BSR   $A82B
A816 20D4       BRA   $A7EC

*** table of addresses of pixel step routines according to PMODE

A818  A67B A682 A67B A682 A67B

*** get address of pixel step routine according to PMODE

A822 CEA818     LDU   #$A818
A825 D6B6       LDB   <$B6      ;current PMODE
A827 58         ASLB
A828 EEC5       LDU   B,U
A82A 39         RTS

*** set U up with address of vertical pixel stepper

A82B CEA677     LDU   #$A677
A82E 39         RTS

*** draw general line

A82F 108EA89B   LDY   #$A89B     ;increment Y ord
A833 BDAAAB     JSR   $AAAB     ;+ve difference in Y ords
A836 1027FF98  LBEQ   $A7D2     ;horizontal line
A83A 2404       BCC   $A840     ;draw left to right
A83C 108EA8A9   LDY   #$A8A9     ;decrement Y ord
A840 3406       PSHS  A,B       
A842 CEA894     LDU   #$A894     ;increment X ord
A845 BDAAB8     JSR   $AAB8     ;+ve difference in X ords
A848 27B0       BEQ   $A7FA     ;vertical line
A84A 2403       BCC   $A84F     ;draw top to bottom
A84C CEA8A2     LDU   #$A8A2     ;decrement X ord
A84F 10A3E4     CMPD  ,S
A852 3510       PULS  X
A854 2404       BCC   $A85A     ;delta X >= delta Y
A856 1E32       EXG   U,Y       ;get main stepper in U
A858 1E01       EXG   D,X       ;get larger delta in D
A85A 3446       PSHS  A,B,U
A85C 3406       PSHS  A,B
A85E 44         LSRA            ;make initial total 1/2 of large
A85F 56         RORB             ;delta for equal end segments
A860 2509       BCS   $A86B     ;large delta was odd
A862 1183A89C   CMPU  #$A89C
A866 2503       BCS   $A86B     ;main stepper is in +ve direction
A868 830001     SUBD  #$0001    ;mystery tweak
A86B 3416       PSHS  A,B,X
A86D BDA61D     JSR   $A61D     ;get pixel calc in U
A870 ADC4       JSR   ,U
A872 BDA705     JSR   $A705     ;plot
A875 AE66       LDX   6,S
A877 2717       BEQ   $A890
A879 301F       LEAX  -1,X
A87B AF66       STX   6,S       ;dec counter
A87D ADF808     JSR  (8,S)      ;step pixel in main direction
A880 ECE4       LDD   ,S
A882 E362       ADDD  2,S       ;add small delta
A884 EDE4       STD   ,S        ;to total
A886 A364       SUBD  4,S       ;subtract larger delta
A888 25E6       BCS   $A870     ;threshold not reached
A88A EDE4       STD   ,S
A88C ADA4       JSR   ,Y        ;step pixel in lesser direction
A88E 20E0       BRA   $A870
A890 3510       PULS  X
A892 35F6       PULS  A,B,X,Y,U,PC

*** increment X ord (LINE / PAINT)

A894 9EBD       LDX   <$BD
A896 3001       LEAX  1,X
A898 9FBD       STX   <$BD
A89A 39         RTS

*** increment Y ord (LINE)

A89B 9EBF       LDX   <$BF
A89D 3001       LEAX  1,X
A89F 9FBF       STX   <$BF
A8A1 39         RTS

*** decrement X ord (LINE / PAINT)

A8A2 9EBD       LDX   <$BD
A8A4 301F       LEAX  -1,X
A8A6 9FBD       STX   <$BD
A8A8 39         RTS

*** decrement Y ord (LINE)

A8A9 9EBF       LDX   <$BF
A8AB 301F       LEAX  -1,X
A8AD 9FBF       STX   <$BF
A8AF 39         RTS

*** sets up $d3 / $d5 with max coords adjusted for PMODE

A8B0 CE00D3     LDU   #$00D3
A8B3 8E00FF     LDX   #$00FF
A8B6 AFC4       STX   ,U
A8B8 8E00BF     LDX   #$00BF
A8BB AF42       STX   2,U
A8BD 7EA6AE     JMP   $A6AE

*** PCLS

A8C0 270E       BEQ   $A8D0
A8C2 8D24       BSR   $A8E8
A8C4 8655       LDA   #$55   U
A8C6 3D         MUL
A8C7 9EBA       LDX   <$BA      ;start of current graphics
A8C9 E780       STB   ,X+
A8CB 9CB7       CMPX  <$B7      ;1st byte after current graphics
A8CD 26FA       BNE   $A8C9
A8CF 39         RTS
A8D0 D6B3       LDB   <$B3      ;current background colour
A8D2 20F0       BRA   $A8C4

*** COLOR

A8D4 812C       CMPA  #$2C   ,
A8D6 2708       BEQ   $A8E0
A8D8 8D0E       BSR   $A8E8
A8DA D7B2       STB   <$B2      ;current foreground colour
A8DC 9DA5       JSR   <$A5      ;get current character from BASIC source
A8DE 2707       BEQ   $A8E7
A8E0 BD89AA     JSR   $89AA     ;check comma
A8E3 8D03       BSR   $A8E8
A8E5 D7B3       STB   <$B3      ;current background colour
A8E7 39         RTS

*** read number and interpret as colour
    (returns 0 - 3)

A8E8 BD8E51     JSR   $8E51     ;get number in B
A8EB C109       CMPB  #$09
A8ED 1024E29C  LBCC   $8B8D     ;?FC ERROR
A8F1 4F         CLRA
A8F2 C105       CMPB  #$05
A8F4 2504       BCS   $A8FA
A8F6 8608       LDA   #$08
A8F8 C004       SUBB  #$04
A8FA 3402       PSHS  A
A8FC 96B6       LDA   <$B6      ;current PMODE
A8FE 46         RORA
A8FF 2408       BCC   $A909
A901 5D         TSTB
A902 2602       BNE   $A906
A904 C604       LDB   #$04
A906 5A         DECB
A907 3582       PULS  A,PC
A909 56         RORB
A90A 25F8       BCS   $A904
A90C 5F         CLRB
A90D 20F8       BRA   $A907

*** read optional colour & set up $b5 accordingly

A90F BDA928     JSR   $A928     ;set up colours
A912 9DA5       JSR   <$A5      ;get current character from BASIC source
A914 2710       BEQ   $A926
A916 8129       CMPA  #$29   )
A918 270C       BEQ   $A926
A91A BD89AA     JSR   $89AA     ;check comma
A91D 812C       CMPA  #$2C   ,
A91F 2705       BEQ   $A926
A921 BDA8E8     JSR   $A8E8
A924 8D0A       BSR   $A930
A926 0EA5       JMP   <$A5      ;get current character from BASIC source

*** stores either foreground or background colour
    as current depending on plot flag $c2

A928 D6B2       LDB   <$B2      ;current foreground colour
A92A 0DC2       TST   <$C2      ;PRESET / PSET flag
A92C 2602       BNE   $A930
A92E D6B3       LDB   <$B3      ;current background colour
A930 D7B4       STB   <$B4      ;plot colour
A932 8655       LDA   #$55
A934 3D         MUL
A935 D7B5       STB   <$B5      ;byte value of plot colour
A937 39         RTS

*** called by SCREEN: sets up text or graphics according to Z

A938 2623       BNE   $A95D

*** reset VDU

A93A 3416       PSHS  A,B,X
A93C 8EFFC8     LDX   #$FFC8
A93F A70A       STA   10,X
A941 A708       STA   8,X
A943 A706       STA   6,X
A945 A704       STA   4,X
A947 A702       STA   2,X
A949 A701       STA   1,X
A94B A71E       STA   -2,X
A94D A71C       STA   -4,X
A94F A71A       STA   -6,X
A951 A718       STA   -8,X
A953 B6FF22     LDA   $FF22
A956 8407       ANDA  #$07
A958 B7FF22     STA   $FF22
A95B 3596       PULS  A,B,X,PC

*** set up graphics display

A95D 3416       PSHS  A,B,X
A95F 96B6       LDA   <$B6      ;current PMODE
A961 8B03       ADDA  #$03
A963 C610       LDB   #$10
A965 3D         MUL
A966 CA80       ORB   #$80
A968 DAC1       ORB   <$C1      ;current colour set
A96A B6FF22     LDA   $FF22
A96D 8407       ANDA  #$07
A96F 3402       PSHS  A
A971 EAE0       ORB   ,S+
A973 F7FF22     STB   $FF22
A976 96BA       LDA   <$BA      ;start of current graphics
A978 44         LSRA
A979 BDA99D     JSR   $A99D     ;set up SAM VDG base
A97C 96B6       LDA   <$B6      ;current PMODE
A97E 8B03       ADDA  #$03
A980 8107       CMPA  #$07
A982 2601       BNE   $A985
A984 4A         DECA
A985 8D02       BSR   $A989     ;set up SAM VDG mem mode
A987 3596       PULS  A,B,X,PC

*** set up SAM VDG mode

A989 C603       LDB   #$03
A98B 8EFFC0     LDX   #$FFC0
A98E 46         RORA
A98F 2404       BCC   $A995
A991 A701       STA   1,X
A993 2002       BRA   $A997
A995 A784       STA   ,X
A997 3002       LEAX  2,X
A999 5A         DECB
A99A 26F2       BNE   $A98E
A99C 39         RTS

*** set up VDG offset

A99D C607       LDB   #$07
A99F 8EFFC6     LDX   #$FFC6
A9A2 20EA       BRA   $A98E

*** select VDG colour set

A9A4 B6FF22     LDA   $FF22
A9A7 84F7       ANDA  #$F7
A9A9 9AC1       ORA   <$C1      ;current colour set
A9AB B7FF22     STA   $FF22
A9AE 39         RTS

*** PMODE

A9AF 812C       CMPA  #$2C   ,
A9B1 272B       BEQ   $A9DE
A9B3 BD8E51     JSR   $8E51     ;get number in B
A9B6 C105       CMPB  #$05
A9B8 2441       BCC   $A9FB     ;?FC ERROR
A9BA 96BC       LDA   <$BC      ;MSB of start of graphics page 1
A9BC 97BA       STA   <$BA      ;start of current graphics
A9BE 58         ASLB
A9BF CEAAA2     LDU   #$AAA2    ;PMODE setup table + 1
A9C2 ABC5       ADDA  B,U
A9C4 9119       CMPA  <$19      ;start of BASIC program
A9C6 2233       BHI   $A9FB     ;?FC ERROR
A9C8 97B7       STA   <$B7      ;1st byte after current graphics
A9CA 335F       LEAU  -1,U
A9CC A6C5       LDA   B,U
A9CE 97B9       STA   <$B9      ;bytes per line in current graphics mode 
A9D0 54         LSRB
A9D1 D7B6       STB   <$B6      ;current PMODE
A9D3 4F         CLRA
A9D4 97B3       STA   <$B3      ;current background colour
A9D6 8603       LDA   #$03
A9D8 97B2       STA   <$B2      ;current foreground colour
A9DA 9DA5       JSR   <$A5      ;get current character from BASIC source
A9DC 271C       BEQ   $A9FA     ;RTS
A9DE BD8E7E     JSR   $8E7E     ;skip comma & get number in B
A9E1 5D         TSTB
A9E2 2717       BEQ   $A9FB     ;?FC ERROR
A9E4 5A         DECB
A9E5 8606       LDA   #$06
A9E7 3D         MUL
A9E8 DBBC       ADDB  <$BC      ;MSB of start of graphics page 1
A9EA 3404       PSHS  B
A9EC DBB7       ADDB  <$B7      ;1st byte after current graphics
A9EE D0BA       SUBB  <$BA      ;start of current graphics
A9F0 D119       CMPB  <$19      ;start of BASIC program
A9F2 2207       BHI   $A9FB     ;?FC ERROR
A9F4 D7B7       STB   <$B7      ;1st byte after current graphics
A9F6 3504       PULS  B
A9F8 D7BA       STB   <$BA      ;start of current graphics
A9FA 39         RTS
A9FB 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** SCREEN

A9FE 812C       CMPA  #$2C   ,
AA00 270B       BEQ   $AA0D
AA02 BD8E51     JSR   $8E51     ;get number in B
AA05 5D         TSTB
AA06 BDA938     JSR   $A938
AA09 9DA5       JSR   <$A5      ;get current character from BASIC source
AA0B 27ED       BEQ   $A9FA
AA0D BD8E7E     JSR   $8E7E     ;skip comma & get number in B
AA10 5D         TSTB
AA11 2702       BEQ   $AA15
AA13 C608       LDB   #$08
AA15 D7C1       STB   <$C1      ;current colour set
AA17 208B       BRA   $A9A4

*** PCLEAR

AA19 BD8E51     JSR   $8E51     ;get number in B
AA1C 5D         TSTB
AA1D 27DC       BEQ   $A9FB     ;?FC ERROR
AA1F C109       CMPB  #$09
AA21 24D8       BCC   $A9FB     ;?FC ERROR
AA23 8606       LDA   #$06
AA25 3D         MUL
AA26 DBBC       ADDB  <$BC      ;MSB of start of graphics page 1
AA28 1F98       TFR   B,A
AA2A C601       LDB   #$01
AA2C 1F02       TFR   D,Y
AA2E 1093B7     CMPD  <$B7      ;1st byte after current graphics
AA31 1025E158  LBCS   $8B8D     ;?FC ERROR
AA35 9319       SUBD  <$19      ;start of BASIC program
AA37 D31B       ADDD  <$1B      ;start of simple variables
AA39 1F01       TFR   D,X
AA3B C300C8     ADDD  #$00C8
AA3E 9321       SUBD  <$21      ;stack root / string storage start
AA40 24B9       BCC   $A9FB     ;?FC ERROR
AA42 9668       LDA   <$68      ;current line number
AA44 4C         INCA
AA45 2708       BEQ   $AA4F
AA47 1F20       TFR   Y,D
AA49 9319       SUBD  <$19      ;start of BASIC program
AA4B D3A6       ADDD  <$A6      ;BASIC source pointer
AA4D DDA6       STD   <$A6
AA4F DE1B       LDU   <$1B      ;start of simple variables
AA51 9F1B       STX   <$1B
AA53 11931B     CMPU  <$1B
AA56 2417       BCC   $AA6F
AA58 A6C2       LDA   ,-U
AA5A A782       STA   ,-X
AA5C 119319     CMPU  <$19      ;start of BASIC program
AA5F 26F7       BNE   $AA58
AA61 109F19     STY   <$19      ;start of BASIC program
AA64 6F3F       CLR   -1,Y
AA66 BD83ED     JSR   $83ED     ;set up next line pointers in BASIC program
AA69 BD8424     JSR   $8424     ;clear variables & reset stack
AA6C 7E849F     JMP   $849F     ;interpreter loop
AA6F DE19       LDU   <$19      ;start of BASIC program
AA71 109F19     STY   <$19
AA74 6F3F       CLR   -1,Y
AA76 A6C0       LDA   ,U+
AA78 A7A0       STA   ,Y+
AA7A 109C1B     CMPY  <$1B      ;start of simple variables
AA7D 26F7       BNE   $AA76
AA7F 20E5       BRA   $AA66

*** called by reset routine to PCLEAR 4

AA81 C61E       LDB   #$1E
AA83 D719       STB   <$19      ;start of BASIC program
AA85 8606       LDA   #$06
AA87 97BC       STA   <$BC      ;MSB of start of graphics page 1
AA89 97BA       STA   <$BA      ;start of current graphics
AA8B 4F         CLRA
AA8C 97B6       STA   <$B6      ;current PMODE
AA8E 8610       LDA   #$10
AA90 97B9       STA   <$B9      ;bytes per line in current graphics mode 
AA92 8603       LDA   #$03
AA94 97B2       STA   <$B2      ;current foreground colour
AA96 860C       LDA   #$0C
AA98 97B7       STA   <$B7      ;1st byte after current graphics
AA9A 9E19       LDX   <$19      ;start of BASIC program
AA9C 6F1F       CLR   -1,X
AA9E 7E8417     JMP   $8417     ;NEW BASIC

*** PMODE setup table: bytes/line + MSB of display size

AAA1  10 06  20 0C  10 0C  20 18  20 18

*** calc +ve difference in Y ords

AAAB DCC5       LDD   <$C5
AAAD 93BF       SUBD  <$BF
AAAF 243B       BCC   $AAEC
AAB1 3401       PSHS  CC
AAB3 BDB15E     JSR   $B15E     ; D = -D
AAB6 3581       PULS  CC,PC

*** calc +ve difference in X ords

AAB8 DCC3       LDD   <$C3
AABA 93BD       SUBD  <$BD
AABC 20F1       BRA   $AAAF

*** PCOPY

AABE 8D1A       BSR   $AADA
AAC0 3406       PSHS  A,B
AAC2 C6BC       LDB   #$BC
AAC4 BD89AC     JSR   $89AC     ;check for token TO
AAC7 8D11       BSR   $AADA
AAC9 3510       PULS  X
AACB 1F03       TFR   D,U
AACD 108E0300   LDY   #$0300
AAD1 EC81       LDD   ,X++
AAD3 EDC1       STD   ,U++
AAD5 313F       LEAY  -1,Y
AAD7 26F8       BNE   $AAD1
AAD9 39         RTS

*** converts number into graphics page address

AADA BD8E51     JSR   $8E51     ;get number in B
AADD 5D         TSTB
AADE 270D       BEQ   $AAED     ;?FC ERROR
AAE0 D119       CMPB  <$19      ;page address must be lower
AAE2 2209       BHI   $AAED     ;than BASIC program
AAE4 5A         DECB
AAE5 8606       LDA   #$06
AAE7 3D			MUL
AAE8 DBBC       ADDB  <$BC      ;MSB of start of graphics page 1
AAEA 1E89       EXG   A,B
AAEC 39         RTS
AAED 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** notes concerning GET & PUT:

    when G is not specified for GET, whole bytes are transferred from the
    screen to the array. The effective width will therefore be a multiple
    of 8. Using such an array, PUT with no action will only display correctly
    on byte boundaries. (although it will be fast)

    If G is specified for GET then screen bits are packed into the array.
    PUT with no action will only work if the array image width is a multiple
    of 8 and then only on a screen byte boundary.

    PUT with an action works as long as the effective array image width is 
    observed in the first case of GET. In the second case, the precise width
    is used as expected.

*** GET

AAF0 5F         CLRB
AAF1 2002       BRA   $AAF5

*** PUT

AAF3 C601       LDB   #$01
AAF5 D7D8       STB   <$D8
AAF7 BD01A0     JSR   $01A0     ;PATCH - CLS GET PUT
AAFA 8140       CMPA  #$40
AAFC 2602       BNE   $AB00     ;optional @ before coords
AAFE 9D9F       JSR   <$9F      ;get next character from BASIC source
AB00 BDA71D     JSR   $A71D     ;get coords into $bd/$bf & $c3/$c5
AB03 BD89AA     JSR   $89AA     ;check comma
AB06 BDAC67     JSR   $AC67     ;validate & get varptr of array
AB09 1F10       TFR   X,D
AB0B EE84       LDU   ,X
AB0D 335E       LEAU  -2,U
AB0F 33CB       LEAU  D,U
AB11 DFD1       STU   <$D1      ;address of last byte of array+1
AB13 3002       LEAX  2,X
AB15 E684       LDB   ,X        ;no. of dimensions
AB17 58         ASLB
AB18 3A         ABX
AB19 9FCF       STX   <$CF      ;address of first byte of array
AB1B 9606       LDA   <$06      ;string arrays not allowed
AB1D 26CE       BNE   $AAED     ;?FC ERROR
AB1F 0FD4       CLR   <$D4
AB21 9DA5       JSR   <$A5      ;get current character from BASIC source
AB23 272D       BEQ   $AB52     ;no parameter after array
AB25 03D4       COM   <$D4
AB27 BD89AA     JSR   $89AA     ;check comma
AB2A 0DD8       TST   <$D8
AB2C 2607       BNE   $AB35     ;PUT
AB2E C647       LDB   #$47
AB30 BD89AC     JSR   $89AC     ;skip G
AB33 2030       BRA   $AB65     ;GET ,G
AB35 C605       LDB   #$05
AB37 8EABD4     LDX   #$ABD4    ;
AB3A EE81       LDU   ,X++      ;set up action routines for PUT
AB3C 10AE81     LDY   ,X++      ;
AB3F A180       CMPA  ,X+       ;
AB41 2706       BEQ   $AB49     ;
AB43 5A         DECB            ;
AB44 26F4       BNE   $AB3A     ;
AB46 7E89B4     JMP   $89B4     ;?SN ERROR
AB49 109FD5     STY   <$D5
AB4C DFD9       STU   <$D9
AB4E 9D9F       JSR   <$9F      ;get next character from BASIC source
AB50 2013       BRA   $AB65

*** bytewise GET / PUT

AB52 C6F8       LDB   #$F8
AB54 96B6       LDA   <$B6      ;current PMODE
AB56 46         RORA
AB57 2402       BCC   $AB5B     ;2 colour modes
AB59 C6FC       LDB   #$FC
AB5B 1F98       TFR   B,A
AB5D D4BE       ANDB  <$BE      ;adjust horizontal coords to align with bytes
AB5F D7BE       STB   <$BE      ;
AB61 94C4       ANDA  <$C4      ;
AB63 97C4       STA   <$C4      ;
AB65 BDAAB8     JSR   $AAB8     ;calc +ve difference in x ords
AB68 2404       BCC   $AB6E     ;1st is less than 2nd
AB6A 9EC3       LDX   <$C3
AB6C 9FBD       STX   <$BD
AB6E DDC3       STD   <$C3      ;x ord difference
AB70 BDAAAB     JSR   $AAAB     ;+ve difference in Y ords
AB73 2404       BCC   $AB79     ;1st is less than 2nd
AB75 9EC5       LDX   <$C5
AB77 9FBF       STX   <$BF
AB79 DDC5       STD   <$C5      ;y ord difference
AB7B 96B6       LDA   <$B6      ;current PMODE
AB7D 46         RORA
AB7E DCC3       LDD   <$C3
AB80 2404       BCC   $AB86     ;2 colour modes
AB82 D3C3       ADDD  <$C3
AB84 DDC3       STD   <$C3
AB86 BDA7AE     JSR   $A7AE     ;adjust coords for PMODE
AB89 DCC3       LDD   <$C3
AB8B 9EC5       LDX   <$C5
AB8D 3001       LEAX  1,X
AB8F 9FC5       STX   <$C5      ;add 1 to y difference to get height
AB91 0DD4       TST   <$D4
AB93 2658       BNE   $ABED     ;action specified
AB95 44         LSRA
AB96 56         RORB
AB97 44         LSRA
AB98 56         RORB
AB99 44         LSRA
AB9A 56         RORB
AB9B C30001     ADDD  #$0001
AB9E DDC3       STD   <$C3      ;width of image in bytes
ABA0 BDA626     JSR   $A626     ;call relevant pixel calc routine for PMODE
ABA3 D6C4       LDB   <$C4
ABA5 3410       PSHS  X
ABA7 0DD8       TST   <$D8
ABA9 2721       BEQ   $ABCC     ;GET
ABAB 8D11       BSR   $ABBE     ;increment array pointer (U)
ABAD A6C4       LDA   ,U
ABAF A780       STA   ,X+
ABB1 5A         DECB
ABB2 26F3       BNE   $ABA7     ;repeat until line done
ABB4 3510       PULS  X
ABB6 BDA677     JSR   $A677     ;move X one line down for all PMODEs
ABB9 0AC6       DEC   <$C6
ABBB 26E6       BNE   $ABA3     ;another line
ABBD 39         RTS

*** increment array pointer (U)

ABBE DECF       LDU   <$CF
ABC0 3341       LEAU  1,U
ABC2 DFCF       STU   <$CF
ABC4 1193D1     CMPU  <$D1
ABC7 26F4       BNE   $ABBD     ;RTS
ABC9 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** action for GET without G parameter

ABCC A680       LDA   ,X+
ABCE 8DEE       BSR   $ABBE     ;increment array pointer (U)
ABD0 A7C4       STA   ,U
ABD2 20DD       BRA   $ABB1

*** PUT action JMP table
    action for a clear array bit / action for a set array bit / token

ABD4  AC2F AC36 AC     ;PSET
ABD9  AC36 AC2F AD     ;PRESET
ABDE  AC4C AC36 C9     ;OR
ABE3  AC2F AC4C C8     ;AND
ABE8  AC3C AC3C C0     ;NOT

*** GET(G) & PUT(action) - does it bitwise

ABED C30001     ADDD  #$0001
ABF0 DDC3       STD   <$C3      ;width of image in bits
ABF2 96D8       LDA   <$D8
ABF4 2609       BNE   $ABFF     ;PUT
ABF6 DED1       LDU   <$D1       ;
ABF8 A7C2       STA   ,-U        ;clear array for GET
ABFA 1193CF     CMPU  <$CF       ;
ABFD 22F9       BHI   $ABF8      ;
ABFF BDA626     JSR   $A626     ;call relevant pixel calc routine for PMODE
AC02 D6B6       LDB   <$B6      ;current PMODE
AC04 56         RORB
AC05 2402       BCC   $AC09     ;2 colour modes
AC07 84AA       ANDA  #$AA      ;reduce mask to single bit
AC09 C601       LDB   #$01
AC0B 109ECF     LDY   <$CF
AC0E 3412       PSHS  A,X
AC10 DEC3       LDU   <$C3      ;U = image width in bits
AC12 3442       PSHS  A,U
AC14 54         LSRB            ;step array bit pointer
AC15 2408       BCC   $AC1F     ;
AC17 56         RORB            ;B = $80
AC18 3121       LEAY  1,Y       ;filled an array byte, so point to next one
AC1A 109CD1     CMPY  <$D1      ;test for end of array
AC1D 27AA       BEQ   $ABC9     ;?FC ERROR
AC1F 0DD8       TST   <$D8
AC21 271F       BEQ   $AC42     ;GET
AC23 E5A4       BITB  ,Y        ;test array bit
AC25 2704       BEQ   $AC2B
AC27 6E9F00D5   JMP  ($00D5)    ;action if array bit set
AC2B 6E9F00D9   JMP  ($00D9)    ;action if array bit clear

*** action for PSET 0, PRESET 1, AND 0

AC2F 43         COMA            ;
AC30 A484       ANDA  ,X        ;
AC32 A784       STA   ,X        ;clear screen bit
AC34 2016       BRA   $AC4C     ;next bit

*** action for PSET 1, PRESET 0, OR 1

AC36 AA84       ORA   ,X        ;
AC38 A784       STA   ,X        ;set screen bit
AC3A 2010       BRA   $AC4C     ;next bit

*** action for NOT 0, NOT 1

AC3C A884       EORA  ,X        ;
AC3E A784       STA   ,X        ;invert screen bit
AC40 200A       BRA   $AC4C     ;next bit

*** GET bit

AC42 A584       BITA  ,X        ;test screen bit
AC44 2706       BEQ   $AC4C     ;don't set array bit - next pixel
AC46 1F98       TFR   B,A       ;
AC48 AAA4       ORA   ,Y        ;
AC4A A7A4       STA   ,Y        ;set array bit

*** next bit (also action for OR 0, AND 1)

AC4C 3542       PULS  A,U       ;pixel mask & width counter
AC4E BDA67B     JSR   $A67B     ;step bit one to right
AC51 335F       LEAU  -1,U
AC53 11938A     CMPU  <$8A      ;zero
AC56 26BA       BNE   $AC12     ;not end of line
AC58 AE61       LDX   1,S
AC5A 96B9       LDA   <$B9      ;bytes per line in current graphics mode 
AC5C 3086       LEAX  A,X       ;point X to next line
AC5E 3502       PULS  A
AC60 3262       LEAS  2,S
AC62 0AC6       DEC   <$C6
AC64 26A8       BNE   $AC0E     ;do another line
AC66 39         RTS

*** called by GET / PUT: get varptr for specified array

AC67 BD8A94     JSR   $8A94     ;get varptr address
AC6A E682       LDB   ,-X
AC6C A682       LDA   ,-X
AC6E 1F03       TFR   D,U       ;get variable name in U
AC70 9E1D       LDX   <$1D
AC72 9C1F       CMPX  <$1F
AC74 1027DF15  LBEQ   $8B8D     ;?FC ERROR
AC78 11A384     CMPU  ,X        ;search array storage to ensure
AC7B 2706       BEQ   $AC83     ;that specified variable is an
AC7D EC02       LDD   2,X       ;array
AC7F 308B       LEAX  D,X
AC81 20EF       BRA   $AC72
AC83 3002       LEAX  2,X       ;varptr
AC85 39         RTS
AC86 39         RTS

*** PAINT

AC87 8140       CMPA  #$40   @
AC89 2602       BNE   $AC8D     ;optional @ before coords
AC8B 9D9F       JSR   <$9F      ;get next character from BASIC source
AC8D BDA740     JSR   $A740     ;get coords into $bd / $bf
AC90 BDA6AB     JSR   $A6AB     ;adjust coords for PMODE
AC93 8601       LDA   #$01
AC95 97C2       STA   <$C2      ;PRESET / PSET flag
AC97 BDA90F     JSR   $A90F     ;read optional colour
AC9A DCB4       LDD   <$B4      ;plot colour
AC9C 3406       PSHS  A,B
AC9E 9DA5       JSR   <$A5      ;get current character from BASIC source
ACA0 2703       BEQ   $ACA5
ACA2 BDA90F     JSR   $A90F     ;read optional colour
ACA5 96B5       LDA   <$B5      ;byte value of plot colour
ACA7 97D8       STA   <$D8
ACA9 3506       PULS  A,B
ACAB DDB4       STD   <$B4      ;plot colour
ACAD 4F         CLRA
ACAE 3456       PSHS  A,B,X,U
ACB0 BDA8B0     JSR   $A8B0     ;set up max coords for PMODE
ACB3 BDA61D     JSR   $A61D     ;get address of pixel calc routine
ACB6 DFD9       STU   <$D9      ;pixel calc
ACB8 BDAD7A     JSR   $AD7A     ;paint left & count pixels in U, D & X
ACBB 270F       BEQ   $ACCC     ;none painted
ACBD BDAD66     JSR   $AD66     ;paint right after previous left
ACC0 8601       LDA   #$01
ACC2 97D7       STA   <$D7
ACC4 BDAD55     JSR   $AD55     ;save pos on stack
ACC7 00D7       NEG   <$D7
ACC9 BDAD55     JSR   $AD55     ;save pos on stack
ACCC 10DFDC     STS   <$DC

*** (main loop)

ACCF 0DDB       TST   <$DB
ACD1 2603       BNE   $ACD6     ;pixels were painted on previous line
ACD3 10DEDC     LDS   <$DC
ACD6 3556       PULS  A,B,X,U
ACD8 0FDB       CLR   <$DB      ;pixel changed flag (updated by plot)
ACDA 10DFDC     STS   <$DC
ACDD 3001       LEAX  1,X
ACDF 9FBD       STX   <$BD      ;current x pos
ACE1 DFD1       STU   <$D1      ;no. of pixels painted on previous line
ACE3 97D7       STA   <$D7      ;up / down flag
ACE5 279F       BEQ   $AC86     ;RTS - pulled final stack entry
ACE7 2B06       BMI   $ACEF     ;paint up
ACE9 5C         INCB
ACEA D1D6       CMPB  <$D6
ACEC 2305       BLS   $ACF3     ;not off bottom of screen
ACEE 5F         CLRB
ACEF 5D         TSTB
ACF0 27DD       BEQ   $ACCF     ;at top/bottom of screen
ACF2 5A         DECB
ACF3 D7C0       STB   <$C0
ACF5 BDAD7A     JSR   $AD7A     ;paint left & count pixels in U, D & X
ACF8 270F       BEQ   $AD09     ;none painted
ACFA 10830003   CMPD  #$0003
ACFE 2504       BCS   $AD04     ;only 1 or 2 pixels painted
AD00 301E       LEAX  -2,X
AD02 8D38       BSR   $AD3C     ;save pos on stack with reverse direction
AD04 BDAD66     JSR   $AD66     ;paint right after previous left
AD07 8D4C       BSR   $AD55     ;save pos on stack
AD09 43         COMA
AD0A 53         COMB
AD0B D3D1       ADDD  <$D1
AD0D DDD1       STD   <$D1
AD0F 2F16       BLE   $AD27
AD11 BDA894     JSR   $A894     ;increment X ord
AD14 BDADAD     JSR   $ADAD     ;calc pixel & test for border colour
AD17 2605       BNE   $AD1E
AD19 CCFFFF     LDD   #$FFFF
AD1C 20ED       BRA   $AD0B
AD1E BDA8A2     JSR   $A8A2     ;decrement X ord
AD21 8D3E       BSR   $AD61     ;copy X ord to $c3
AD23 8D5E       BSR   $AD83     ;paint right & count pixels in U, D & X
AD25 20E0       BRA   $AD07
AD27 BDA894     JSR   $A894     ;increment X ord
AD2A 308B       LEAX  D,X
AD2C 9FBD       STX   <$BD
AD2E 43         COMA
AD2F 53         COMB
AD30 830001     SUBD  #$0001
AD33 2F04       BLE   $AD39
AD35 1F01       TFR   D,X
AD37 8D03       BSR   $AD3C     ;save pos on stack with reverse direction
AD39 7EACCF     JMP   $ACCF     ;loop again

*** save pos with reverse direction

AD3C DDCB       STD   <$CB
AD3E 3520       PULS  Y
AD40 DCBD       LDD   <$BD
AD42 3416       PSHS  A,B,X
AD44 96D7       LDA   <$D7
AD46 40         NEGA
AD47 D6C0       LDB   <$C0
AD49 3406       PSHS  A,B
AD4B 3420       PSHS  Y
AD4D C602       LDB   #$02
AD4F BD8331     JSR   $8331     ;memory check
AD52 DCCB       LDD   <$CB
AD54 39         RTS

*** save pos on stack

AD55 DDCB       STD   <$CB
AD57 3520       PULS  Y
AD59 DCC3       LDD   <$C3
AD5B 3416       PSHS  A,B,X
AD5D 96D7       LDA   <$D7
AD5F 20E6       BRA   $AD47

*** copy X ord to $c3

AD61 9EBD       LDX   <$BD
AD63 9FC3       STX   <$C3
AD65 39         RTS

*** paint right after previous left
    X = total no. of pixels painted left & right
    D = no. of pixels painted right + 1

AD66 DDCD       STD   <$CD
AD68 109EC3     LDY   <$C3
AD6B 8DF4       BSR   $AD61     ;copy X ord to $c3
AD6D 109FBD     STY   <$BD
AD70 8D11       BSR   $AD83     ;paint right & count pixels in U, D & X
AD72 9ECD       LDX   <$CD
AD74 308B       LEAX  D,X
AD76 C30001     ADDD  #$0001
AD79 39         RTS

*** paint left & return pixel count in U, D & X

AD7A BDAD61     JSR   $AD61     ;copy X ord to $c3
AD7D 108EA8A2   LDY   #$A8A2     ;decrement X ord
AD81 2006       BRA   $AD89

*** paint right & return pixel count in U, D & X

AD83 108EA894   LDY   #$A894     ;increment X ord
AD87 ADA4       JSR   ,Y        ;step X ord
AD89 DE8A       LDU   <$8A      ;zero
AD8B 9EBD       LDX   <$BD
AD8D 2B17       BMI   $ADA6     ;< min X
AD8F 9CD3       CMPX  <$D3
AD91 2213       BHI   $ADA6     ;> max X
AD93 3460       PSHS  Y,U
AD95 8D16       BSR   $ADAD     ;calc pixel & test for border colour
AD97 270B       BEQ   $ADA4
AD99 BDA705     JSR   $A705     ;plot
AD9C 3560       PULS  Y,U
AD9E 3341       LEAU  1,U
ADA0 ADA4       JSR   ,Y        ;step X ord
ADA2 20E9       BRA   $AD8D
ADA4 3560       PULS  Y,U
ADA6 1F30       TFR   U,D
ADA8 1F01       TFR   D,X
ADAA 938A       SUBD  <$8A      ;CMPD #0
ADAC 39         RTS

*** calc pixel & test for border colour

ADAD AD9F00D9   JSR  ($00D9)      ;pixel calc
ADB1 1F89       TFR   A,B
ADB3 D4D8       ANDB  <$D8
ADB5 3406       PSHS  A,B
ADB7 A484       ANDA  ,X
ADB9 A161       CMPA  1,S
ADBB 3586       PULS  A,B,PC

*** PLAY

ADBD 9E8A       LDX   <$8A      ;zero
ADBF C601       LDB   #$01
ADC1 3414       PSHS  B,X
ADC3 BD8887     JSR   $8887     ;get expression
ADC6 5F         CLRB
ADC7 BDBAF1     JSR   $BAF1     ;B=0 to select d/a sound
ADCA BDBAC5     JSR   $BAC5     ;enable audio
ADCD BD8D9A     JSR   $8D9A     ;validate string & point X to it (len in B)
ADD0 2002       BRA   $ADD4
ADD2 3514       PULS  B,X
ADD4 D7D8       STB   <$D8      ;string length
ADD6 27FA       BEQ   $ADD2
ADD8 9FD9       STX   <$D9      ;1st byte in string
ADDA 10270CE5  LBEQ   $BAC3     ;nothing to do - disable audio & quit
ADDE 0DD8       TST   <$D8      ;remaining string length
ADE0 27F0       BEQ   $ADD2
ADE2 BDAF33     JSR   $AF33     ;get character
ADE5 813B       CMPA  #$3B   ;
ADE7 27F5       BEQ   $ADDE
ADE9 8127       CMPA  #$27   '
ADEB 27F1       BEQ   $ADDE
ADED 8158       CMPA  #$58   X
ADEF 102701B2  LBEQ   $AFA5     ;execute substring
ADF3 8D02       BSR   $ADF7     ;interpret meta-command
ADF5 20E7       BRA   $ADDE

*** change octave

ADF7 814F       CMPA  #$4F   O
ADF9 260D       BNE   $AE08
ADFB D6DE       LDB   <$DE      ;PLAY octave
ADFD 5C         INCB
ADFE 8D5B       BSR   $AE5B     ;modify B according to PLAY parameter
AE00 5A         DECB
AE01 C104       CMPB  #$04
AE03 2263       BHI   $AE68     ;?FC ERROR
AE05 D7DE       STB   <$DE      ;PLAY octave
AE07 39         RTS

*** change volume

AE08 8156       CMPA  #$56   V
AE0A 261A       BNE   $AE26
AE0C D6DF       LDB   <$DF      ;PLAY d/a high value
AE0E 54         LSRB
AE0F 54         LSRB
AE10 C01F       SUBB  #$1F
AE12 8D47       BSR   $AE5B     ;modify B according to PLAY parameter
AE14 C11F       CMPB  #$1F
AE16 2250       BHI   $AE68     ;?FC ERROR
AE18 58         ASLB
AE19 58         ASLB
AE1A 3404       PSHS  B
AE1C CC7E7E     LDD   #$7E7E
AE1F ABE4       ADDA  ,S
AE21 E0E0       SUBB  ,S+
AE23 DDDF       STD   <$DF      ;PLAY volume data
AE25 39         RTS

*** change note length

AE26 814C       CMPA  #$4C   L
AE28 2623       BNE   $AE4D
AE2A D6E1       LDB   <$E1      ;PLAY note length
AE2C 8D2D       BSR   $AE5B     ;modify B according to PLAY parameter
AE2E 5D         TSTB
AE2F 2737       BEQ   $AE68     ;?FC ERROR
AE31 D7E1       STB   <$E1      ;PLAY note length
AE33 0FE5       CLR   <$E5      ;duration modifier (no. of dots)
AE35 8D03       BSR   $AE3A
AE37 24FC       BCC   $AE35
AE39 39         RTS

AE3A 0DD8       TST   <$D8      ;remaining string length
AE3C 270A       BEQ   $AE48
AE3E BDAF33     JSR   $AF33     ;get character
AE41 812E       CMPA  #$2E   .
AE43 2705       BEQ   $AE4A
AE45 BDAF7D     JSR   $AF7D     ;move string pointer back one
AE48 43         COMA
AE49 39         RTS
AE4A 0CE5       INC   <$E5      ;duration modifier (no. of dots)
AE4C 39         RTS

*** change tempo

AE4D 8154       CMPA  #$54   T
AE4F 260D       BNE   $AE5E
AE51 D6E2       LDB   <$E2      ;PLAY tempo
AE53 8D06       BSR   $AE5B     ;modify B according to PLAY parameter
AE55 5D         TSTB
AE56 2710       BEQ   $AE68     ;?FC ERROR
AE58 D7E2       STB   <$E2      ;PLAY tempo
AE5A 39         RTS

*** change a PLAY parameter (modifies value in B)

AE5B 7EAF47     JMP   $AF47

*** play a pause

AE5E 8150       CMPA  #$50   P
AE60 2624       BNE   $AE86
AE62 BDB066     JSR   $B066     ;check for number or =variable (get into B)
AE65 5D         TSTB
AE66 2603       BNE   $AE6B
AE68 7E8B8D     JMP   $8B8D     ;?FC ERROR
AE6B 96E5       LDA   <$E5      ;duration modifier (no. of dots)
AE6D 9EDF       LDX   <$DF      ;PLAY volume data
AE6F 3412       PSHS  A,X
AE71 867E       LDA   #$7E
AE73 97DF       STA   <$DF      ;PLAY d/a high value
AE75 97E0       STA   <$E0      ;PLAY d/a low value
AE77 0FE5       CLR   <$E5      ;duration modifier (no. of dots)
AE79 8D07       BSR   $AE82
AE7B 3512       PULS  A,X
AE7D 97E5       STA   <$E5      ;duration modifier (no. of dots)
AE7F 9FDF       STX   <$DF      ;PLAY volume data
AE81 39         RTS
AE82 6FE2       CLR   ,-S
AE84 2040       BRA   $AEC6

*** ignore an N!

AE86 814E       CMPA  #$4E   N
AE88 2603       BNE   $AE8D
AE8A BDAF33     JSR   $AF33     ;get character

AE8D 8141       CMPA  #$41   A
AE8F 2504       BCS   $AE95
AE91 8147       CMPA  #$47   G
AE93 2305       BLS   $AE9A

AE95 BDAF59     JSR   $AF59     ;check for number or =variable (get into B)
AE98 2023       BRA   $AEBD

AE9A 8041       SUBA  #$41   A
AE9C 8EAFF6     LDX   #$AFF6    ;note number XLAT table
AE9F E686       LDB   A,X       ;XLAT into number
AEA1 0DD8       TST   <$D8      ;remaining string length
AEA3 2718       BEQ   $AEBD
AEA5 BDAF33     JSR   $AF33     ;get character
AEA8 8123       CMPA  #$23   #
AEAA 2704       BEQ   $AEB0
AEAC 812B       CMPA  #$2B   +
AEAE 2603       BNE   $AEB3
AEB0 5C         INCB            ;sharpen note
AEB1 200A       BRA   $AEBD
AEB3 812D       CMPA  #$2D   -
AEB5 2603       BNE   $AEBA
AEB7 5A         DECB            ;flatten note
AEB8 2003       BRA   $AEBD
AEBA BDAF7D     JSR   $AF7D     ;move string pointer back one
AEBD 5A         DECB
AEBE C10B       CMPB  #$0B
AEC0 22A6       BHI   $AE68     ;?FC ERROR
AEC2 3404       PSHS  B
AEC4 D6E1       LDB   <$E1      ;PLAY note length
AEC6 96E2       LDA   <$E2      ;PLAY tempo
AEC8 3D         MUL
AEC9 DDD5       STD   <$D5      ;PLAY duration decrement value
AECB 3361       LEAU  1,S       ;point U to return address ($ADF5)
AECD 96DE       LDA   <$DE      ;PLAY octave
AECF 8101       CMPA  #$01
AED1 222C       BHI   $AEFF
AED3 8EAFFD     LDX   #$AFFD    ;pitch XLAT table for octaves 1 & 2
AED6 C618       LDB   #$18
AED8 3D         MUL
AED9 3A         ABX
AEDA 3504       PULS  B
AEDC 58         ASLB
AEDD 3A         ABX
AEDE 3184       LEAY  ,X        ;XLAT note for octaves 1 & 2
AEE0 8D45       BSR   $AF27     ;compute PLAY duration
AEE2 DDE3       STD   <$E3      ;PLAY duration counter
AEE4 8D0C       BSR   $AEF2     ;zero d/a
AEE6 96DF       LDA   <$DF      ;PLAY d/a high value
AEE8 8D0B       BSR   $AEF5     ;set d/a
AEEA 8D06       BSR   $AEF2     ;zero d/a
AEEC 96E0       LDA   <$E0      ;PLAY d/a low value
AEEE 8D05       BSR   $AEF5     ;set d/a
AEF0 20F2       BRA   $AEE4     ;irq routine controls duration
                                ;forces jump to $adf5
AEF2 867E       LDA   #$7E
AEF4 12         NOP
AEF5 B7FF20     STA   $FF20
AEF8 AEA4       LDX   ,Y
AEFA 301F       LEAX  -1,X
AEFC 26FC       BNE   $AEFA
AEFE 39         RTS

AEFF 8EB015     LDX   #$B015    ;XLAT table for octaves 3 - 5 (-$18)
AF02 C60C       LDB   #$0C
AF04 3D         MUL
AF05 3A         ABX
AF06 3504       PULS  B
AF08 3A         ABX             ;XLAT note for octaves 3 - 5
AF09 8D1C       BSR   $AF27     ;compute PLAY duration
AF0B DDE3       STD   <$E3      ;PLAY duration counter
AF0D 8D0C       BSR   $AF1B     ;zero d/a
AF0F 96DF       LDA   <$DF      ;PLAY d/a high value
AF11 8D0B       BSR   $AF1E     ;set d/a
AF13 8D06       BSR   $AF1B     ;zero d/a
AF15 96E0       LDA   <$E0      ;PLAY d/a low value
AF17 8D05       BSR   $AF1E     ;set d/a
AF19 20F2       BRA   $AF0D     ;irq routine controls duration
                                ;forces jump to $adf5
AF1B 867E       LDA   #$7E
AF1D 12         NOP
AF1E B7FF20     STA   $FF20
AF21 A684       LDA   ,X
AF23 4A         DECA
AF24 26FD       BNE   $AF23
AF26 39         RTS

*** compute PLAY duration

AF27 C6FF       LDB   #$FF
AF29 96E5       LDA   <$E5      ;duration modifier (no. of dots)
AF2B 2705       BEQ   $AF32
AF2D 8B02       ADDA  #$02
AF2F 3D         MUL
AF30 44         LSRA
AF31 56         RORB
AF32 39         RTS

*** get next character in string, skipping over spaces
    (called by PLAY & DRAW)

AF33 3410       PSHS  X
AF35 0DD8       TST   <$D8      ;remaining string length
AF37 274D       BEQ   $AF86
AF39 9ED9       LDX   <$D9      ;string pointer
AF3B A680       LDA   ,X+
AF3D 9FD9       STX   <$D9      ;string pointer
AF3F 0AD8       DEC   <$D8      ;remaining string length
AF41 8120       CMPA  #$20
AF43 27F0       BEQ   $AF35
AF45 3590       PULS  X,PC

*** change a PLAY parameter (modifies value in B)

AF47 8DEA       BSR   $AF33     ;get character
AF49 812B       CMPA  #$2B   +  ;inc
AF4B 273C       BEQ   $AF89
AF4D 812D       CMPA  #$2D   -  ;dec
AF4F 273C       BEQ   $AF8D
AF51 813E       CMPA  #$3E   >  ;double
AF53 2742       BEQ   $AF97
AF55 813C       CMPA  #$3C   <  ;halve
AF57 2739       BEQ   $AF92
AF59 813D       CMPA  #$3D   =  ;equals a variable
AF5B 273F       BEQ   $AF9C
AF5D BDA438     JSR   $A438     ;carry set if A non-numeric
AF60 2524       BCS   $AF86     ;?FC ERROR
AF62 5F         CLRB
AF63 8030       SUBA  #$30   0
AF65 97D7       STA   <$D7
AF67 860A       LDA   #$0A
AF69 3D         MUL
AF6A 4D         TSTA
AF6B 2619       BNE   $AF86     ;?FC ERROR
AF6D DBD7       ADDB  <$D7
AF6F 2515       BCS   $AF86     ;?FC ERROR
AF71 0DD8       TST   <$D8      ;remaining string length
AF73 2717       BEQ   $AF8C
AF75 BDAF33     JSR   $AF33     ;get character
AF78 BDA438     JSR   $A438     ;carry set if A non-numeric
AF7B 24E6       BCC   $AF63
AF7D 0CD8       INC   <$D8      ;remaining string length
AF7F 9ED9       LDX   <$D9      ;string pointer
AF81 301F       LEAX  -1,X
AF83 9FD9       STX   <$D9      ;string pointer
AF85 39         RTS
AF86 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** increment PLAY parameter

AF89 5C         INCB
AF8A 27FA       BEQ   $AF86     ;?FC ERROR
AF8C 39         RTS

*** decrement PLAY parameter

AF8D 5D         TSTB
AF8E 27F6       BEQ   $AF86     ;?FC ERROR
AF90 5A         DECB
AF91 39         RTS

*** halve PLAY parameter

AF92 5D         TSTB
AF93 27F1       BEQ   $AF86     ;?FC ERROR
AF95 54         LSRB
AF96 39         RTS

*** double PLAY parameter

AF97 5D         TSTB
AF98 2BEC       BMI   $AF86     ;?FC ERROR
AF9A 58         ASLB
AF9B 39         RTS

*** PLAY parameter equals a variable

AF9C 3460       PSHS  Y,U
AF9E 8D16       BSR   $AFB6     ;validate variable
AFA0 BD8E54     JSR   $8E54     ;get number in B from FPA1
AFA3 35E0       PULS  Y,U,PC

*** execute PLAY substring

AFA5 BDAFB6     JSR   $AFB6     ;validate variable
AFA8 C602       LDB   #$02
AFAA BD8331     JSR   $8331     ;memory check
AFAD D6D8       LDB   <$D8      ;remaining string length
AFAF 9ED9       LDX   <$D9      ;string pointer
AFB1 3414       PSHS  B,X
AFB3 7EADCD     JMP   $ADCD

*** validate PLAY / DRAW variable

AFB6 9ED9       LDX   <$D9      ;string pointer
AFB8 3410       PSHS  X
AFBA BDAF33     JSR   $AF33     ;get character
AFBD BD8ADF     JSR   $8ADF     ;carry clear if A-Z
AFC0 25C4       BCS   $AF86     ;?FC ERROR
AFC2 BDAF33     JSR   $AF33     ;get character
AFC5 813B       CMPA  #$3B   ;
AFC7 26F9       BNE   $AFC2
AFC9 3510       PULS  X
AFCB DEA6       LDU   <$A6      ;BASIC source pointer
AFCD 3440       PSHS  U
AFCF 9FA6       STX   <$A6      ;BASIC source pointer
AFD1 BD89C1     JSR   $89C1
AFD4 3510       PULS  X
AFD6 9FA6       STX   <$A6      ;BASIC source pointer
AFD8 39         RTS

*** IRQ service routine continued

AFD9 4F         CLRA
AFDA 1F8B       TFR   A,DP
AFDC DCE3       LDD   <$E3      ;PLAY duration counter
AFDE 10270B20  LBEQ   $BB02
AFE2 93D5       SUBD  <$D5      ;must be in PLAY loop
AFE4 DDE3       STD   <$E3      ;therefore calculate
AFE6 220D       BHI   $AFF5     ;duration remaining
AFE8 0FE3       CLR   <$E3      ;PLAY duration counter
AFEA 0FE4       CLR   <$E4      ;
AFEC 3502       PULS  A
AFEE 10EE67     LDS   7,S       ;points S to old U (=$adf5)
AFF1 847F       ANDA  #$7F      ;mask entire state save
AFF3 3402       PSHS  A         ;RTI will now return to $adf5
AFF5 3B         RTI

*** PLAY letter to note number XLAT table

AFF6  0A 0C 01 03 05 06 08

*** PLAY pitch XLAT table for octaves 1 & 2

AFFD  01A8 0190 017A 0164 0150 013D 
B009  012B 011A 010A 00FB 00ED 00DF 
B015  00D3 00C7 00BB 00B1 00A6 009D 
B021  0094 008B 0083 007C 0075 006E

*** PLAY pitch XLAT table for octaves 3 - 5

B02D  A6 9C 93 8B 83 7B 74 6D 67 61 5B 56 
B039  51 4C 47 43 3F 3B 37 34 31 2E 2B 28 
B045  26 23 21 1F 1D 1B 19 18 16 14 13 12

*** DRAW

B051 9E8A       LDX   <$8A      ;zero
B053 C601       LDB   #$01
B055 3414       PSHS  B,X
B057 D7C2       STB   <$C2      ;PRESET / PSET flag
B059 9FD5       STX   <$D5
B05B BDA928     JSR   $A928     ;set up colours
B05E BD8887     JSR   $8887     ;get expression
B061 BD8D9A     JSR   $8D9A     ;validate string & point X to it (len in B)
B064 2008       BRA   $B06E

B066 BDAF33     JSR   $AF33     ;get character
B069 7EAF59     JMP   $AF59     ;check for number or =variable (get into B)

B06C 3514       PULS  B,X
B06E D7D8       STB   <$D8      ;remaining string length
B070 27FA       BEQ   $B06C
B072 9FD9       STX   <$D9      ;string pointer
B074 102700EA  LBEQ   $B162     ;nothing left to do - RTS
B078 0DD8       TST   <$D8      ;remaining string length
B07A 27F0       BEQ   $B06C
B07C BDAF33     JSR   $AF33     ;get character
B07F 813B       CMPA  #$3B   ;
B081 27F5       BEQ   $B078
B083 8127       CMPA  #$27   '
B085 27F1       BEQ   $B078
B087 814E       CMPA  #$4E   N
B089 2604       BNE   $B08F
B08B 03D5       COM   <$D5
B08D 20E9       BRA   $B078
B08F 8142       CMPA  #$42   B
B091 2604       BNE   $B097
B093 03D6       COM   <$D6
B095 20E1       BRA   $B078
B097 8158       CMPA  #$58   X
B099 10270096  LBEQ   $B133
B09D 814D       CMPA  #$4D   M
B09F 1027012A  LBEQ   $B1CD
B0A3 3402       PSHS  A
B0A5 C601       LDB   #$01
B0A7 0DD8       TST   <$D8      ;remaining string length
B0A9 2711       BEQ   $B0BC
B0AB BDAF33     JSR   $AF33     ;get character
B0AE BD8ADF     JSR   $8ADF     ;carry clear if A-Z
B0B1 3401       PSHS  CC
B0B3 BDAF7D     JSR   $AF7D     ;move string pointer back one
B0B6 3501       PULS  CC
B0B8 2402       BCC   $B0BC
B0BA 8DAA       BSR   $B066     ;check for number or =variable (get into B)
B0BC 3502       PULS  A
B0BE 8143       CMPA  #$43   C
B0C0 2728       BEQ   $B0EA
B0C2 8141       CMPA  #$41   A
B0C4 272E       BEQ   $B0F4
B0C6 8153       CMPA  #$53   S
B0C8 2732       BEQ   $B0FC
B0CA 8155       CMPA  #$55   U
B0CC 275C       BEQ   $B12A
B0CE 8144       CMPA  #$44   D
B0D0 2755       BEQ   $B127
B0D2 814C       CMPA  #$4C   L
B0D4 274C       BEQ   $B122
B0D6 8152       CMPA  #$52   R
B0D8 2743       BEQ   $B11D
B0DA 8045       SUBA  #$45   E
B0DC 272F       BEQ   $B10D
B0DE 4A         DECA
B0DF 2727       BEQ   $B108
B0E1 4A         DECA
B0E2 2732       BEQ   $B116
B0E4 4A         DECA
B0E5 271D       BEQ   $B104
B0E7 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** DRAW 'C'

B0EA BDA8EB     JSR   $A8EB     ;interpret colour in B
B0ED D7B2       STB   <$B2      ;foreground colour
B0EF BDA928     JSR   $A928     ;set up colours
B0F2 2084       BRA   $B078

*** DRAW 'A'

B0F4 C104       CMPB  #$04
B0F6 24EF       BCC   $B0E7     ;?FC ERROR
B0F8 D7E8       STB   <$E8      ;angle
B0FA 20F6       BRA   $B0F2

*** DRAW 'S'

B0FC C13F       CMPB  #$3F
B0FE 24E7       BCC   $B0E7     ;?FC ERROR
B100 D7E9       STB   <$E9      ;scale
B102 20EE       BRA   $B0F2

*** DRAW 'H'    (D = X = -B)

B104 4F         CLRA
B105 8D58       BSR   $B15F     ;NEGB, A=A-C
B107 21         BRN   $

*** DRAW 'F'    (D = X = B)

(B108 4F         CLRA)
B109 1F01       TFR   D,X
B10B 2059       BRA   $B166

*** DRAW 'E'    (D = B, X = -B)

B10D 4F         CLRA
B10E 1F01       TFR   D,X
B110 8D4D       BSR   $B15F     ;NEGB, A=A-C
B112 1E01       EXG   D,X
B114 2050       BRA   $B166

*** DRAW 'G'    (D = -B, X = B)

B116 4F         CLRA
B117 1F01       TFR   D,X
B119 8D44       BSR   $B15F     ;NEGB, A=A-C
B11B 2049       BRA   $B166

*** DRAW 'R'    (D = B, X = 0)

B11D 4F         CLRA
B11E 9E8A       LDX   <$8A      ;zero
B120 2044       BRA   $B166

*** DRAW 'L'    (D = -B, X = 0)

B122 4F         CLRA
B123 8D3A       BSR   $B15F     ;NEGB, A=A-C
B125 20F7       BRA   $B11E

*** DRAW 'D'    (D = 0, X = B)

B127 4F         CLRA
B128 2003       BRA   $B12D

*** DRAW 'U'    (D = 0, X = -B)

B12A 4F         CLRA
B12B 8D32       BSR   $B15F     ;NEGB, A=A-C
B12D 9E8A       LDX   <$8A      ;zero
B12F 1E10       EXG   X,D
B131 2033       BRA   $B166

*** DRAW 'X'

B133 BDAFB6     JSR   $AFB6     ;validate variable
B136 C602       LDB   #$02
B138 BD8331     JSR   $8331     ;memory check
B13B D6D8       LDB   <$D8      ;remaining string length
B13D 9ED9       LDX   <$D9      ;string pointer
B13F 3414       PSHS  B,X       ;store current string
B141 7EB061     JMP   $B061     ;start again with new string

*** apply DRAW scale factor to X

B144 D6E9       LDB   <$E9
B146 271B       BEQ   $B163
B148 4F         CLRA
B149 1E01       EXG   D,X
B14B A7E2       STA   ,-S
B14D 2A02       BPL   $B151
B14F 8D0D       BSR   $B15E     ; D = -D
B151 BDB350     JSR   $B350     ; Y:U = D * X
B154 1F30       TFR   U,D
B156 44         LSRA
B157 56         RORB
B158 44         LSRA
B159 56         RORB
B15A 6DE0       TST   ,S+
B15C 2A04       BPL   $B162
B15E 40         NEGA
B15F 50         NEGB
B160 8200       SBCA  #$00
B162 39         RTS
B163 1F10       TFR   X,D
B165 39         RTS

*** apply scale & angle to relative movement vector in D & X, 
    calculate new pos & draw.
    (D = horizontal component, X = vertical component)

B166 3406       PSHS  A,B
B168 8DDA       BSR   $B144     ;scale X into D
B16A 3510       PULS  X
B16C 3406       PSHS  A,B
B16E 8DD4       BSR   $B144     ;scale X into D
B170 3510       PULS  X
B172 109EE8     LDY   <$E8      ;angle
B175 3420       PSHS  Y
B177 6DE4       TST   ,S
B179 2708       BEQ   $B183
B17B 1E10       EXG   X,D       ; swap vector components
B17D 8DDF       BSR   $B15E     ; D = -D
B17F 6AE4       DEC   ,S
B181 20F4       BRA   $B177     ;rotate another 90 degrees
B183 3520       PULS  Y
B185 DE8A       LDU   <$8A      ;zero
B187 D3C7       ADDD  <$C7      ;current X
B189 2B02       BMI   $B18D
B18B 1F03       TFR   D,U       ; U = new X
B18D 1F10       TFR   X,D
B18F 9E8A       LDX   <$8A      ;zero
B191 D3C9       ADDD  <$C9      ;current Y
B193 2B02       BMI   $B197
B195 1F01       TFR   D,X
B197 11830100   CMPU  #$0100
B19B 2503       BCS   $B1A0
B19D CE00FF     LDU   #$00FF
B1A0 8C00C0     CMPX  #$00C0
B1A3 2503       BCS   $B1A8
B1A5 8E00BF     LDX   #$00BF    ; X = new Y
B1A8 DCC7       LDD   <$C7
B1AA DDBD       STD   <$BD
B1AC DCC9       LDD   <$C9
B1AE DDBF       STD   <$BF
B1B0 9FC5       STX   <$C5
B1B2 DFC3       STU   <$C3
B1B4 0DD5       TST   <$D5
B1B6 2604       BNE   $B1BC     ;no position update
B1B8 9FC9       STX   <$C9
B1BA DFC7       STU   <$C7
B1BC BDA7AE     JSR   $A7AE     ;adjust coords for PMODE
B1BF 0DD6       TST   <$D6
B1C1 2603       BNE   $B1C6     ;blank move
B1C3 BDA82F     JSR   $A82F     ;draw line
B1C6 0FD5       CLR   <$D5
B1C8 0FD6       CLR   <$D6
B1CA 7EB078     JMP   $B078

*** DRAW 'M'

B1CD BDAF33     JSR   $AF33     ;get character
B1D0 3402       PSHS  A
B1D2 BDB1F9     JSR   $B1F9     ;get ordinate into D
B1D5 3406       PSHS  A,B
B1D7 BDAF33     JSR   $AF33     ;get character
B1DA 812C       CMPA  #$2C   ,
B1DC 1026FF07  LBNE   $B0E7
B1E0 BDB1F6     JSR   $B1F6     ;get ordinate into D
B1E3 1F01       TFR   D,X
B1E5 3540       PULS  U
B1E7 3502       PULS  A
B1E9 812B       CMPA  #$2B   +
B1EB 2704       BEQ   $B1F1
B1ED 812D       CMPA  #$2D   -
B1EF 26A6       BNE   $B197     ;absolute position
B1F1 1F30       TFR   U,D
B1F3 7EB166     JMP   $B166     ;relative movement

*** get ordinate for Move

B1F6 BDAF33     JSR   $AF33     ;get character
B1F9 812B       CMPA  #$2B   +
B1FB 2707       BEQ   $B204
B1FD 812D       CMPA  #$2D   -
B1FF 2704       BEQ   $B205
B201 BDAF7D     JSR   $AF7D     ;move string pointer back one
B204 4F         CLRA
B205 3402       PSHS  A
B207 BDB066     JSR   $B066     ;check for number or =variable (get into B)
B20A 3502       PULS  A
B20C 4D         TSTA
B20D 2704       BEQ   $B213
B20F 4F         CLRA
B210 50         NEGB
B211 8200       SBCA  #$00
B213 39         RTS

*** CIRCLE trig factor look-up table
    circle is drawn in 8 main sectors with 8 or 9 subdivisions each

B214  0000 0001
B218  FEC5 1919
B21C  FB16 31F2
B220  F4FB 4A51
B224  EC84 61F9
B228  E1C7 78AE
B22C  D4DC 8E3B
B230  C5E5 A269
B234  B506 B506

*** CIRCLE

B238 8140       CMPA  #$40   @
B23A 2602       BNE   $B23E     ;optional @ before coords
B23C 9D9F       JSR   <$9F      ;get next character from BASIC source
B23E BDA8B0     JSR   $A8B0     ;set up max coords for PMODE
B241 BDA740     JSR   $A740     ;get coords from command into $bd / $bf
B244 BDA6AB     JSR   $A6AB     ;adjust coords for PMODE
B247 AEC4       LDX   ,U
B249 9FCB       STX   <$CB
B24B AE42       LDX   2,U
B24D 9FCD       STX   <$CD
B24F BD89AA     JSR   $89AA     ;check comma
B252 BD8E83     JSR   $8E83     ;get 16 bit number into X
B255 CE00CF     LDU   #$00CF
B258 AFC4       STX   ,U        ;circle radius
B25A BDA6AE     JSR   $A6AE     ;adjust radius correct for PMODE
B25D 8601       LDA   #$01
B25F 97C2       STA   <$C2      ;PRESET / PSET flag
B261 BDA90F     JSR   $A90F     ;read optional colour
B264 8E0100     LDX   #$0100
B267 9DA5       JSR   <$A5      ;get current character from BASIC source
B269 270F       BEQ   $B27A
B26B BD89AA     JSR   $89AA     ;check comma
B26E BD8872     JSR   $8872     ;get FP number (h/w ratio)
B271 964F       LDA   <$4F
B273 8B08       ADDA  #$08
B275 974F       STA   <$4F      ;multiply FP number by 256
B277 BD8E86     JSR   $8E86     ;read 16 bit number into X from FPA1
B27A 96B6       LDA   <$B6      ;current PMODE
B27C 8502       BITA  #$02
B27E 2704       BEQ   $B284
B280 1F10       TFR   X,D
B282 308B       LEAX  D,X       ;double hw ratio for PMODEs 2 & 3
B284 9FD1       STX   <$D1
B286 C601       LDB   #$01
B288 D7C2       STB   <$C2      ;PRESET / PSET flag
B28A D7D8       STB   <$D8
B28C BDB37D     JSR   $B37D     ;read optional start value
B28F 3406       PSHS  A,B
B291 BDB37D     JSR   $B37D     ;read optional end value
B294 DDD9       STD   <$D9
B296 3506       PULS  A,B
B298 3406       PSHS  A,B       ;loop starts here
B29A 9EC3       LDX   <$C3      ;move old end coords to start coords
B29C 9FBD       STX   <$BD
B29E 9EC5       LDX   <$C5
B2A0 9FBF       STX   <$BF
B2A2 CEB216     LDU   #$B216
B2A5 8401       ANDA  #$01
B2A7 2703       BEQ   $B2AC
B2A9 50         NEGB
B2AA CB08       ADDB  #$08      ;B = 8-B for odd sectors
B2AC 58         ASLB
B2AD 58         ASLB
B2AE 33C5       LEAU  B,U
B2B0 3440       PSHS  U
B2B2 BDB342     JSR   $B342     ;X= (,U) x radius
B2B5 3540       PULS  U
B2B7 335E       LEAU  -2,U
B2B9 3410       PSHS  X
B2BB BDB342     JSR   $B342     ;X= (,U) x radius
B2BE 3520       PULS  Y         ;X & Y now hold circle coord offsets
B2C0 A6E4       LDA   ,S
B2C2 8403       ANDA  #$03
B2C4 2706       BEQ   $B2CC
B2C6 8103       CMPA  #$03
B2C8 2702       BEQ   $B2CC
B2CA 1E12       EXG   X,Y       ;swap X & Y for sectors 1,2,5,6
B2CC 9FC3       STX   <$C3      ;x offset
B2CE 1F21       TFR   Y,X
B2D0 DCD1       LDD   <$D1
B2D2 BDB350     JSR   $B350     ; Y:U = D * X
B2D5 1F20       TFR   Y,D       ;D = hw ratio x y ord
B2D7 4D         TSTA
B2D8 1026D8B1  LBNE   $8B8D     ;?FC ERROR
B2DC D7C5       STB   <$C5      ;MSB of y offset
B2DE 1F30       TFR   U,D
B2E0 97C6       STA   <$C6      ;LSB of y offset
B2E2 A6E4       LDA   ,S
B2E4 8102       CMPA  #$02
B2E6 250E       BCS   $B2F6
B2E8 8106       CMPA  #$06
B2EA 240A       BCC   $B2F6
B2EC DCCB       LDD   <$CB
B2EE 93C3       SUBD  <$C3      ;x = centre - offset
B2F0 2411       BCC   $B303     ;for sectors 2,3,4,5
B2F2 4F         CLRA            ;keep on screen
B2F3 5F         CLRB
B2F4 200D       BRA   $B303
B2F6 DCCB       LDD   <$CB
B2F8 D3C3       ADDD  <$C3      ;x = centre + offset
B2FA 2505       BCS   $B301     ;for sectors 0,1,6,7
B2FC 1093D3     CMPD  <$D3      ;keep on screen
B2FF 2502       BCS   $B303
B301 DCD3       LDD   <$D3
B303 DDC3       STD   <$C3      ;circle x ord now calculated
B305 A6E4       LDA   ,S
B307 8104       CMPA  #$04
B309 250A       BCS   $B315
B30B DCCD       LDD   <$CD
B30D 93C5       SUBD  <$C5      ;y = centre - offset
B30F 2411       BCC   $B322     ;for sectors 4,5,6,7
B311 4F         CLRA            ;keep on screen
B312 5F         CLRB
B313 200D       BRA   $B322
B315 DCCD       LDD   <$CD
B317 D3C5       ADDD  <$C5      ;y = centre + offset
B319 2505       BCS   $B320     ;for sectors 0,1,2,3
B31B 1093D5     CMPD  <$D5      ;keep on screen
B31E 2502       BCS   $B322
B320 DCD5       LDD   <$D5
B322 DDC5       STD   <$C5      ;circle y ord now calculated
B324 0DD8       TST   <$D8 
B326 2602       BNE   $B32A     ;1st loop - don't draw
B328 8D50       BSR   $B37A     ;draw line ($bd,$bf)-($c3,$c5)
B32A 3506       PULS  A,B
B32C 04D8       LSR   <$D8
B32E 2505       BCS   $B335     ;1st loop - don't test end condition
B330 1093D9     CMPD  <$D9      ;reached end angle?
B333 270C       BEQ   $B341
B335 5C         INCB            ;increment angle counter
B336 C108       CMPB  #$08
B338 2604       BNE   $B33E
B33A 4C         INCA
B33B 5F         CLRB
B33C 8407       ANDA  #$07
B33E 7EB298     JMP   $B298
B341 39         RTS

*** multiply radius by value pointed to by U

B342 9ECF       LDX   <$CF      ;radius
B344 ECC4       LDD   ,U
B346 2707       BEQ   $B34F
B348 830001     SUBD  #$0001
B34B 8D03       BSR   $B350     ; Y:U = D * X
B34D 1F21       TFR   Y,X
B34F 39         RTS

*** multiplies D by X & leaves result in Y:U

B350 3476       PSHS  A,B,X,Y,U
B352 6F64       CLR   4,S
B354 A663       LDA   3,S
B356 3D         MUL
B357 ED66       STD   6,S
B359 EC61       LDD   1,S
B35B 3D         MUL
B35C EB66       ADDB  6,S
B35E 8900       ADCA  #$00
B360 ED65       STD   5,S
B362 E6E4       LDB   ,S
B364 A663       LDA   3,S
B366 3D         MUL
B367 E365       ADDD  5,S
B369 ED65       STD   5,S
B36B 2402       BCC   $B36F
B36D 6C64       INC   4,S
B36F A6E4       LDA   ,S
B371 E662       LDB   2,S
B373 3D         MUL
B374 E364       ADDD  4,S
B376 ED64       STD   4,S
B378 35F6       PULS  A,B,X,Y,U,PC

*** called by CIRCLE

B37A 7EA82F     JMP   $A82F     ;draw line

*** called by CIRCLE: reads optional start/end value
    reduces to 6 bits and leaves top 3 bits in A
    & bottom 3 bits in B

B37D 5F         CLRB
B37E 9DA5       JSR   <$A5      ;get current character from BASIC source
B380 2711       BEQ   $B393
B382 BD89AA     JSR   $89AA     ;check comma
B385 BD8872     JSR   $8872     ;get FP number
B388 964F       LDA   <$4F
B38A 8B06       ADDA  #$06
B38C 974F       STA   <$4F      ;multiply FP number by 64
B38E BD8E54     JSR   $8E54     ;get FP number in B
B391 C43F       ANDB  #$3F
B393 1F98       TFR   B,A
B395 C407       ANDB  #$07
B397 44         LSRA
B398 44         LSRA
B399 44         LSRA
B39A 39         RTS

*** reset routine continued

B39B 10CE03D7   LDS   #$03D7
B39F 8637       LDA   #$37      ;enable cart FIRQ
B3A1 B7FF23     STA   $FF23     ;
B3A4 9671       LDA   <$71      ;cold boot flag
B3A6 8155       CMPA  #$55
B3A8 2610       BNE   $B3BA     ;cold boot
B3AA 9E72       LDX   <$72      ;soft reset vector
B3AC A684       LDA   ,X
B3AE 8112       CMPA  #$12
B3B0 2608       BNE   $B3BA     ;cold boot
B3B2 6E84       JMP   ,X        ;soft reset

*** reset routine (CPU vector)

B3B4 318CE4     LEAY  $B39B,PCR
B3B7 7E8000     JMP   $8000     ;JMP to $BB40

*** reset routine - invalid soft vector

B3BA 8E0401     LDX   #$0401    ;clear 0 - 3ff
B3BD 6F83       CLR   ,--X      ;
B3BF 3001       LEAX  1,X       ;
B3C1 26FA       BNE   $B3BD     ;
B3C3 BDBA77     JSR   $BA77     ;clear text screen
B3C6 6F80       CLR   ,X+
B3C8 9F19       STX   <$19      ;start of BASIC program
B3CA A602       LDA   2,X       ;memory test
B3CC 43         COMA            ;
B3CD A702       STA   2,X       ;
B3CF A102       CMPA  2,X       ;
B3D1 2606       BNE   $B3D9     ;
B3D3 3001       LEAX  1,X       ;
B3D5 6301       COM   1,X       ;
B3D7 20F1       BRA   $B3CA     ;
B3D9 9F74       STX   <$74      ;top of RAM
B3DB 9F27       STX   <$27      ;top of BASIC RAM
B3DD 9F23       STX   <$23      ;top of free string space
B3DF 3089FF38   LEAX  $FF38,X
B3E3 9F21       STX   <$21      ;stack root / string storage start
B3E5 1F14       TFR   X,S
B3E7 BD8003     JSR   $8003     ;calls $BB88
B3EA 8EB487     LDX   #$B487
B3ED CE009D     LDU   #$009D    ;initialise system variables
B3F0 C60E       LDB   #$0E
B3F2 BDB7CC     JSR   $B7CC     ;copy B bytes from X to U
B3F5 CE010C     LDU   #$010C    ;initialise system variables   
B3F8 C61E       LDB   #$1E
B3FA BDB7CC     JSR   $B7CC     ;copy B bytes from X to U
B3FD 8E89B4     LDX   #$89B4    ;?SN ERROR
B400 AF43       STX   3,U       ;dummy disk command jump
B402 AF48       STX   8,U       ;dummy disk function jump
B404 8E015E     LDX   #$015E    ;set patch vectors to RTS
B407 CC394B     LDD   #$394B
B40A A780       STA   ,X+
B40C 5A         DECB
B40D 26FB       BNE   $B40A
B40F B702D9     STA   $02D9     ;mystery RTS
B412 BD8417     JSR   $8417     ;NEW BASIC
B415 BD98E3     JSR   $98E3     ;set up PLAY & graphics variables
B418 8E0134     LDX   #$0134    ;set up USR vectors
B41B 9FB0       STX   <$B0      ;address of USR table
B41D CE8B8D     LDU   #$8B8D    ;?FC ERROR
B420 C60A       LDB   #$0A
B422 EF81       STU   ,X++
B424 5A         DECB
B425 26FB       BNE   $B422
B427 BDAA81     JSR   $AA81     ;PCLEAR 4
B42A B6FF03     LDA   $FF03
B42D 8A01       ORA   #$01
B42F B7FF03     STA   $FF03     ;enable vsync irq
B432 8E444B     LDX   #$444B    ;check for 'DK' disk
B435 BCC000     CMPX  $C000     ;cartridge sigature
B438 10270BC6  LBEQ   $C002
B43C 1CAF       ANDCC #$AF      ;enable interrupts
B43E 8EB4B2     LDX   #$B4B2
B441 BD90E5     JSR   $90E5     ;display copyright message
B444 8EB44F     LDX   #$B44F    ;set up soft reset vector
B447 9F72       STX   <$72      ;soft reset vector
B449 8655       LDA   #$55
B44B 9771       STA   <$71      ;cold boot flag
B44D 2017       BRA   $B466     ;(JMP $8371 - command mode)

*** normal soft reset routine

B44F 12         NOP
B450 0FE3       CLR   <$E3      ;clear PLAY duration counter
B452 0FE4       CLR   <$E4      ;
B454 B6FF03     LDA   $FF03     ;enable vsync irq
B457 8A01       ORA   #$01      ;
B459 B7FF03     STA   $FF03     ;
B45C 0F6F       CLR   <$6F      ;DEVN = VDU
B45E BD8434     JSR   $8434     ;reset stack
B461 1CAF       ANDCC #$AF      ;enable interrupts
B463 BDBA77     JSR   $BA77     ;clear screen
B466 7E8371     JMP   $8371     ;command mode

*** FIRQ service routine

B469 7DFF23     TST   $FF23
B46C 2B01       BMI   $B46F     ;cartridge
B46E 3B         RTI
B46F BDB480     JSR   $B480     ;delay
B472 BDB480     JSR   $B480
B475 318C03     LEAY  $B47B,PCR
B478 7E8000     JMP   $8000		;reset
B47B 0F71       CLR   <$71      ;cold boot flag
B47D 7EC000     JMP   $C000		;jump to cartridge rom

*** delay before starting FIRQ cartrige

B480 9E8A       LDX   <$8A      ;zero
B482 301F       LEAX  -1,X
B484 26FC       BNE   $B482
B486 39         RTS

*** copied to $9d - $aa on start up
    (default EXEC & get character routine)

B487  8B8D     (points to ?FC ERROR)
      0CA7     INC   <$A7 
      2602     BNE   +02
      0CA6     INC   <$A6
      B60000   LDA   $0000
      7EBB26   JMP   $BB26

*** copied to $10c - $129 on start up
    (IRQ, FIRQ, RND seeds, key delay, command addresses)

B495  7E9D3D 7EB469 0000 00 80 4F C7 52 59
B4A3  00 0000 00 00 00 
B4A9  4E 8033 8154 22 81CA 8250

*** copyright message

B4B3 28 43 29 20    (  C  )   
B4B7 31 39 38 32    1  9  8  2
B4BB 20 44 52 41       D  R  A
B4BF 47 4F 4E 20    G  O  N   
B4C3 44 41 54 41    D  A  T  A
B4C7 20 4C 54 44       L  T  D
B4CB 20 0D 31 36       .  1  6
B4CF 4B 20 42 41    K     B  A
B4D3 53 49 43 20    S  I  C   
B4D7 49 4E 54 45    I  N  T  E
B4DB 52 50 52 45    R  P  R  E
B4DF 54 45 52 20    T  E  R   
B4E3 31 2E 30 20    1  .  0   
B4E7 20 20 20 20              
B4EB 20 0D 28 43       .  (  C
B4EF 29 20 31 39    )     1  9
B4F3 38 32 20 42    8  2     B
B4F7 59 20 4D 49    Y     M  I
B4FB 43 52 4F 53    C  R  O  S
B4FF 4F 46 54 0D    O  F  T  .
B503 0D 00

*** read 7 bit character from device DEVN

B505 8D03       BSR   $B50A
B507 847F       ANDA  #$7F
B509 39         RTS

*** read character from device DEVN
    (+set EOF file flag if applicable)

B50A BD016A     JSR   $016A     ;PATCH - input character from DEVN
B50D 0F70       CLR   <$70      ;EOF flag
B50F 0D6F       TST   <$6F      ;DEVN
B511 2725       BEQ   $B538     ;get character from keyboard
B513 0D79       TST   <$79      ;no. of characters in buffer
B515 2603       BNE   $B51A     ;get character from file
B517 0370       COM   <$70      ;set EOF flag
B519 39         RTS

*** read character from file

B51A 3474       PSHS  B,X,Y,U
B51C 9E7A       LDX   <$7A      ;buffer pointer
B51E A680       LDA   ,X+
B520 3402       PSHS  A
B522 9F7A       STX   <$7A      ;buffer pointer
B524 0A79       DEC   <$79      ;no. of characters in buffer
B526 2609       BNE   $B531
B528 966F       LDA   <$6F      ;DEVN
B52A 81FD       CMPA  #$FD
B52C 2705       BEQ   $B533     ;serial
B52E BDB867     JSR   $B867     ;get block from tape
B531 35F6       PULS  A,B,X,Y,U,PC
B533 BDA106     JSR   $A106     ;get block from serial
B536 20F9       BRA   $B531

*** wait for character from keyboard
    (with cursor)

B538 3414       PSHS  B,X
B53A BD8009     JSR   $8009     ;blink cursor
B53D BD8006     JSR   $8006     ;scan keyboard
B540 27F8       BEQ   $B53A
B542 C660       LDB   #$60
B544 E79F0088   STB  ($0088)    ;text cursor address
B548 3594       PULS  B,X,PC

*** output character to device DEVN

B54A BD0167     JSR   $0167     ;PATCH - output character to DEVN
B54D 3404       PSHS  B
B54F D66F       LDB   <$6F      ;DEVN
B551 C1FD       CMPB  #$FD
B553 2602       BNE   $B557     ;not -3 (serial output not supported)
B555 3584       PULS  B,PC
B557 5C         INCB
B558 3504       PULS  B
B55A 102BCAB1  LBMI   $800F     ;send to printer
B55E 262F       BNE   $B58F     ;send to VDU
B560 3416       PSHS  A,B,X     ;send to file
B562 D678       LDB   <$78      ;cassette IO status
B564 5A         DECB
B565 270F       BEQ   $B576     ;input - quit
B567 D679       LDB   <$79      ;no. of characters in buffer
B569 5C         INCB
B56A 2602       BNE   $B56E
B56C 8D0A       BSR   $B578     ;flush tape buffer
B56E 9E7A       LDX   <$7A      ;buffer pointer
B570 A780       STA   ,X+
B572 9F7A       STX   <$7A      ;buffer pointer
B574 0C79       INC   <$79      ;no. of characters in buffer
B576 3596       PULS  A,B,X,PC

*** flush tape buffer

B578 C601       LDB   #$01
B57A D77C       STB   <$7C      ;block type
B57C 8E01DA     LDX   #$01DA    ;IO buffer
B57F 9F7E       STX   <$7E
B581 D679       LDB   <$79      ;no. of characters in buffer
B583 D77D       STB   <$7D      ;block length
B585 3462       PSHS  A,Y,U
B587 BDB991     JSR   $B991     ;write leader & block to tape
B58A 3562       PULS  A,Y,U
B58C 7EB882     JMP   $B882     ;reset IO buffer

*** send character to VDU

B58F BDA93A     JSR   $A93A     ;reset VDU
B592 7E800C     JMP   $800C     ;write to VDU

*** initialise virtual DEVN device

B595 BD0164     JSR   $0164     ;PATCH - device initialisation
B598 3416       PSHS  A,B,X
B59A 0F6E       CLR   <$6E      ;cassette IO flag
B59C 966F       LDA   <$6F      ;DEVN
B59E 2709       BEQ   $B5A9     ;VDU
B5A0 4C         INCA
B5A1 2717       BEQ   $B5BA     ;cassette
B5A3 9E99       LDX   <$99      ;printer comma field width / last comma field
B5A5 DC9B       LDD   <$9B      ;printer line width / head pos
B5A7 2009       BRA   $B5B2
B5A9 D689       LDB   <$89      ;
B5AB C41F       ANDB  #$1F      ;get VDU column number
B5AD 8E1010     LDX   #$1010
B5B0 8620       LDA   #$20
B5B2 9F6A       STX   <$6A      ;comma field width / last comma field
B5B4 D76C       STB   <$6C      ;current column number
B5B6 976D       STA   <$6D      ;line width
B5B8 3596       PULS  A,B,X,PC
B5BA 036E       COM   <$6E      ;set cassette IO flag
B5BC 8E0100     LDX   #$0100
B5BF 4F         CLRA
B5C0 5F         CLRB
B5C1 20EF       BRA   $B5B2

*** clear screen

B5C3 BDBA77     JSR   $BA77     ;clear screen

*** command mode line input from DEVN

B5C6 BD0182     JSR   $0182     ;PATCH - line input file
B5C9 0F87       CLR   <$87      ;last key pressed
B5CB 8E02DD     LDX   #$02DD
B5CE C601       LDB   #$01      ;B = character count
B5D0 BDB505     JSR   $B505     ;read 7 bit character from DEVN
B5D3 0D70       TST   <$70      ;EOF flag
B5D5 262B       BNE   $B602     ;EOF
B5D7 0D6F       TST   <$6F      ;DEVN
B5D9 2623       BNE   $B5FE     ;not keyed input
B5DB 810C       CMPA  #$0C      ;CLEAR key
B5DD 27E4       BEQ   $B5C3
B5DF 8108       CMPA  #$08      ;backspace
B5E1 2607       BNE   $B5EA
B5E3 5A         DECB
B5E4 27E0       BEQ   $B5C6     ;nothing to delete
B5E6 301F       LEAX  -1,X
B5E8 2034       BRA   $B61E
B5EA 8115       CMPA  #$15      ;shift + backspace
B5EC 260A       BNE   $B5F8
B5EE 5A         DECB
B5EF 27D5       BEQ   $B5C6     ;nothing to delete
B5F1 8608       LDA   #$08
B5F3 BDB54A     JSR   $B54A     ;output character to DEVN
B5F6 20F6       BRA   $B5EE
B5F8 8103       CMPA  #$03      ;BREAK
B5FA 1A01       ORCC  #$01
B5FC 2705       BEQ   $B603
B5FE 810D       CMPA  #$0D      ;RETURN
B600 260D       BNE   $B60F
B602 4F         CLRA
B603 3401       PSHS  CC
B605 BD90A1     JSR   $90A1     ;send CR to DEVN
B608 6F84       CLR   ,X
B60A 8E02DC     LDX   #$02DC    ;return with carry set if
B60D 3581       PULS  CC,PC      ;input aborted with BREAK
B60F 8120       CMPA  #$20 
B611 25BD       BCS   $B5D0     ;chr < $20
B613 817B       CMPA  #$7B
B615 24B9       BCC   $B5D0     ;chr >= $7b 
B617 C1FA       CMPB  #$FA
B619 24B5       BCC   $B5D0     ;max no. of characters = $fa
B61B A780       STA   ,X+
B61D 5C         INCB
B61E BDB54A     JSR   $B54A     ;echo typed character
B621 20AD       BRA   $B5D0

*** test cassette status OK for input

B623 BD016D     JSR   $016D     ;PATCH - input file
B626 966F       LDA   <$6F      ;DEVN
B628 2721       BEQ   $B64B     ;RTS
B62A 4C         INCA
B62B 260C       BNE   $B639     ;?FM ERROR
B62D 9678       LDA   <$78      ;cassette IO status
B62F 2605       BNE   $B636     ;open
B631 C62E       LDB   #$2E      ;?NO ERROR
B633 7E8344     JMP   $8344
B636 4A         DECA
B637 2712       BEQ   $B64B     ;input - RTS
B639 7EB848     JMP   $B848     ;?FM ERROR

*** if DEVN = -1 test cassette status for output

B63C BD0170     JSR   $0170     ;PATCH - output file
B63F 966F       LDA   <$6F      ;DEVN
B641 4C         INCA
B642 2607       BNE   $B64B     ;not cassette
B644 9678       LDA   <$78      ;cassette IO status
B646 27E9       BEQ   $B631     ;?NO ERROR
B648 4A         DECA
B649 27EE       BEQ   $B639     ;?FM ERROR
B64B 39         RTS

*** CLOSE

    Format: CLOSE [#-n[,#-n]]

B64C 270E       BEQ   $B65C     ;no parameter so close #-1
B64E BDB7D7     JSR   $B7D7     ;read #-n & set up DEVN (no skip comma)
B651 8D10       BSR   $B663     ;close DEVN stream & set DEVN to 0
B653 9DA5       JSR   <$A5      ;get current character from BASIC source
B655 272A       BEQ   $B681     ;RTS
B657 BDB7D4     JSR   $B7D4     ;read #-n & set up DEVN
B65A 20F5       BRA   $B651     ;read next stream no.
B65C BD0173     JSR   $0173     ;PATCH - close all files

*** close cassette stream & set DEVN to 0

B65F 86FF       LDA   #$FF
B661 976F       STA   <$6F      ;DEVN
B663 BD0176     JSR   $0176     ;PATCH - close file
B666 966F       LDA   <$6F      ;DEVN
B668 0F6F       CLR   <$6F      ;DEVN
B66A 4C         INCA
B66B 2614       BNE   $B681     ;not cassette
B66D 9678       LDA   <$78      ;cassette IO status
B66F 8102       CMPA  #$02
B671 260C       BNE   $B67F     ;not output
B673 9679       LDA   <$79      ;no. of characters in buffer
B675 2703       BEQ   $B67A
B677 BDB578     JSR   $B578     ;flush tape buffer
B67A C6FF       LDB   #$FF
B67C BDB57A     JSR   $B57A     ;B = $FF = EOF block
B67F 0F78       CLR   <$78      ;cassette IO status
B681 39         RTS

*** CSAVE

B682 814D       CMPA  #$4D
B684 1027E278  LBEQ   $9900     ;CSAVEM
B688 BDB7AA     JSR   $B7AA     ;get filename
B68B 9DA5       JSR   <$A5      ;get current character from BASIC source
B68D 2716       BEQ   $B6A5     ;normal CSAVE
B68F BD89AA     JSR   $89AA     ;check comma
B692 C641       LDB   #$41   A
B694 BD89AC     JSR   $89AC     ;skip over 'A'
B697 26E8       BNE   $B681     ;return if anything else on command line
B699 4F         CLRA            ;file type = 0 = tokenized BASIC
B69A BDB88E     JSR   $B88E     ;write filename block for gapped ASCII
B69D 86FF       LDA   #$FF
B69F 976F       STA   <$6F      ;DEVN = -1
B6A1 4F         CLRA
B6A2 7E8EAA     JMP   $8EAA     ;LIST to DEVN - very clever!

*** ungapped CSAVE

B6A5 4F         CLRA            ;tokenized BASIC
B6A6 9E8A       LDX   <$8A      ;non-ASCII & ungapped
B6A8 BDB891     JSR   $B891     ;write filename block
B6AB 0F78       CLR   <$78      ;cassette IO status
B6AD 0C7C       INC   <$7C      ;block type
B6AF BD801B     JSR   $801B     ;write leader
B6B2 9E19       LDX   <$19      ;start of BASIC program
B6B4 9F7E       STX   <$7E      ;IO buffer
B6B6 86FF       LDA   #$FF
B6B8 977D       STA   <$7D      ;block length
B6BA DC1B       LDD   <$1B      ;start of simple variables
B6BC 937E       SUBD  <$7E      ;IO buffer
B6BE 270D       BEQ   $B6CD
B6C0 108300FF   CMPD  #$00FF
B6C4 2402       BCC   $B6C8
B6C6 D77D       STB   <$7D      ;block length
B6C8 BDB999     JSR   $B999     ;write block to tape
B6CB 20E7       BRA   $B6B4
B6CD 007C       NEG   <$7C      ;block type
B6CF 0F7D       CLR   <$7D      ;block length
B6D1 7EB994     JMP   $B994     ;write block & cassette relay off

*** CLOAD

B6D4 0F78       CLR   <$78      ;cassette IO status
B6D6 814D       CMPA  #$4D
B6D8 1027E9B2  LBEQ   $A08E     ;CLOADM (returns to $b73c if not gapped)
B6DC 3262       LEAS  2,S
B6DE BDB7F7     JSR   $B7F7     ;get filename
B6E1 BDB87A     JSR   $B87A     ;find file & set up buffer
B6E4 7D01E4     TST   $01E4     ;gap flag
B6E7 271D       BEQ   $B706
B6E9 B601E3     LDA   $01E3     ;ASCII flag
B6EC 271D       BEQ   $B70B     ;?FM ERROR
B6EE BD8417     JSR   $8417     ;NEW BASIC
B6F1 86FF       LDA   #$FF
B6F3 976F       STA   <$6F      ;DEVN = -1
B6F5 0C78       INC   <$78      ;cassette status 1 = input
B6F7 BDB867     JSR   $B867     ;get block from tape
B6FA 7E837A     JMP   $837A     ;command mode / no device initialise

*** close file & return to command mode

B6FD BD0185     JSR   $0185     ;PATCH - close ASCII file
B700 BDB663     JSR   $B663     ;close DEVN stream & set DEVN to 0
B703 7E8371     JMP   $8371     ;command mode

*** ungapped CLOAD

B706 B601E2     LDA   $01E2     ;file type 0 = tokenized BASIC
B709 2703       BEQ   $B70E
B70B 7EB848     JMP   $B848     ;?FM ERROR
B70E BD8417     JSR   $8417     ;NEW BASIC
B711 BD8021     JSR   $8021     ;read leader from tape
B714 9E19       LDX   <$19      ;start of BASIC program
B716 9F7E       STX   <$7E      ;IO buffer
B718 DC7E       LDD   <$7E
B71A 4C         INCA
B71B BD8335     JSR   $8335     ;memory check
B71E BDB93E     JSR   $B93E     ;read block from tape
B721 2613       BNE   $B736     ;error
B723 967C       LDA   <$7C      ;block type
B725 270F       BEQ   $B736     ;error
B727 2AED       BPL   $B716
B729 9F1B       STX   <$1B      ;start of simple variables
B72B 8D40       BSR   $B76D     ;cassette relay off
B72D 8E82EA     LDX   #$82EA
B730 BD90E5     JSR   $90E5     ;print string to DEVN
B733 7E83E7     JMP   $83E7     ;set up new BASIC program & go command mode
B736 BD8417     JSR   $8417     ;NEW BASIC
B739 7EB84B     JMP   $B84B     ;?IO ERROR

*** returned to do ungapped CLOADM

B73C 9E8A       LDX   <$8A      ;zero
B73E 9DA5       JSR   <$A5      ;get current character from BASIC source
B740 2706       BEQ   $B748
B742 BD89AA     JSR   $89AA     ;check comma
B745 BD8E83     JSR   $8E83     ;get 16 bit number into X
B748 B601E2     LDA   $01E2     ;file type
B74B 8102       CMPA  #$02      ;2 = binary
B74D 26BC       BNE   $B70B     ;?FM ERROR
B74F FC01E5     LDD   $01E5     ;entry address
B752 338B       LEAU  D,X       ;apply offset
B754 DF9D       STU   <$9D      ;EXEC address
B756 FC01E7     LDD   $01E7     ;load address
B759 308B       LEAX  D,X
B75B 9F7E       STX   <$7E      ;IO buffer
B75D BD8021     JSR   $8021     ;read leader from tape
B760 BDB93E     JSR   $B93E     ;read block from tape
B763 26D4       BNE   $B739     ;?IO ERROR
B765 9F7E       STX   <$7E      ;IO buffer
B767 0D7C       TST   <$7C      ;block type
B769 27CE       BEQ   $B739     ;?IO ERROR
B76B 2AF3       BPL   $B760
B76D 7E8018     JMP   $8018     ;cassette relay off

*** EXEC

B770 2705       BEQ   $B777
B772 BD8E83     JSR   $8E83     ;get 16 bit number into X
B775 9F9D       STX   <$9D      ;default EXEC address
B777 6E9F009D   JMP  ($009D)

*** scan for break & pause if DEVN not -1

B77B BD017F     JSR   $017F     ;PATCH - check break & pause
B77E 966F       LDA   <$6F      ;DEVN
B780 4C         INCA
B781 2750       BEQ   $B7D3     ;RTS
B783 7E851B     JMP   $851B     ;scan keyboard for break & pause

*** called by PRINT to handle PRINT@

B786 BD8B21     JSR   $8B21     ;get unsigned number into D & $52 from FPA1
B789 8301FF     SUBD  #$01FF
B78C 1022D3FD  LBHI   $8B8D     ;?FC ERROR
B790 C305FF     ADDD  #$05FF
B793 DD88       STD   <$88      ;text cursor address
B795 39         RTS

*** INKEY$

B796 9687       LDA   <$87      ;last key pressed
B798 2603       BNE   $B79D     ;key ready
B79A BD8006     JSR   $8006     ;scan keyboard
B79D 0F87       CLR   <$87      ;last key pressed
B79F 9753       STA   <$53
B7A1 1026D630  LBNE   $8DD5     ;set up character & put on varptr stack
B7A5 9756       STA   <$56
B7A7 7E8DE1     JMP   $8DE1     ;leas 2,s & put temp string on varptr stack

*** called by get filename routine
    (reads filename from command into usual location)

B7AA 8E01D1     LDX   #$01D1
B7AD 6F80       CLR   ,X+
B7AF 8620       LDA   #$20
B7B1 A780       STA   ,X+
B7B3 8C01DA     CMPX  #$01DA    ;IO buffer
B7B6 26F9       BNE   $B7B1
B7B8 9DA5       JSR   <$A5      ;get current character from BASIC source
B7BA 2717       BEQ   $B7D3     ;RTS
B7BC BD8887     JSR   $8887     ;get expression
B7BF BD8D9A     JSR   $8D9A     ;validate string & point X to it (len in B)
B7C2 CE01D1     LDU   #$01D1
B7C5 E7C0       STB   ,U+       ;store length
B7C7 270A       BEQ   $B7D3
B7C9 8C         CMPX  #

*** copy 8 bytes from X to U

(B7CA C608       LDB   #$08)

*** copy B bytes from X to U

B7CC A680       LDA   ,X+
B7CE A7C0       STA   ,U+
B7D0 5A         DECB
B7D1 26F9       BNE   $B7CC
B7D3 39         RTS

*** read #-n from command and sets up DEVN

B7D4 BD89AA     JSR   $89AA     ;check comma
B7D7 8123       CMPA  #$23   #
B7D9 2602       BNE   $B7DD
B7DB 9D9F       JSR   <$9F      ;get next character from BASIC source
B7DD BD8872     JSR   $8872     ;get numeric expression into FPA1
B7E0 BD8B2D     JSR   $8B2D     ;get 16 bit number into D & $52 from FPA1
B7E3 59         ROLB
B7E4 8900       ADCA  #$00
B7E6 2669       BNE   $B851     ;?DN ERROR
B7E8 56         RORB
B7E9 D76F       STB   <$6F      ;DEVN
B7EB BD0161     JSR   $0161     ;PATCH - check device number
B7EE 2706       BEQ   $B7F6
B7F0 2A5F       BPL   $B851     ;?DN ERROR
B7F2 C1FE       CMPB  #$FE
B7F4 2D5B       BLT   $B851     ;?DN ERROR
B7F6 39         RTS

*** get filename from command
    (sets up filename locations)

B7F7 8DB1       BSR   $B7AA     ;get filename
B7F9 9DA5       JSR   <$A5      ;get current character from BASIC source
B7FB 27F9       BEQ   $B7F6     ;RTS
B7FD 7E89B4     JMP   $89B4     ;?SN ERROR

*** EOF

B800 BD0188     JSR   $0188     ;PATCH - check eof
B803 966F       LDA   <$6F      ;DEVN
B805 3402       PSHS  A
B807 8DD7       BSR   $B7E0     ;get device number from command
B809 BDB623     JSR   $B623     ;test cassette status OK for input
B80C 5F         CLRB
B80D 966F       LDA   <$6F      ;DEVN
B80F 2705       BEQ   $B816     ;VDU
B811 0D79       TST   <$79      ;no. of characters in buffer
B813 2601       BNE   $B816     ;not EOF
B815 53         COMB
B816 3502       PULS  A
B818 976F       STA   <$6F      ;DEVN
B81A 1D         SEX
B81B 7E8C37     JMP   $8C37     ;assign D to FPA1

*** SKIPF

B81E 8DD7       BSR   $B7F7     ;get filename
B820 8D58       BSR   $B87A     ;find file & set up buffer
B822 BDB903     JSR   $B903     ;skip rest of file
B825 2624       BNE   $B84B     ;?IO ERROR
B827 39         RTS

*** OPEN

B828 BD015E     JSR   $015E     ;PATCH - device open
B82B BD8887     JSR   $8887     ;get expression
B82E BD8DEA     JSR   $8DEA     ;get 1st character of string into B
B831 3404       PSHS  B
B833 8D9F       BSR   $B7D4     ;read #-n & set up DEVN
B835 BD89AA     JSR   $89AA     ;check comma
B838 8DBD       BSR   $B7F7     ;get filename
B83A 966F       LDA   <$6F      ;DEVN
B83C 0F6F       CLR   <$6F      ;DEVN
B83E 3504       PULS  B
B840 C149       CMPB  #$49   I
B842 2712       BEQ   $B856     ;open for input
B844 C14F       CMPB  #$4F   O
B846 2742       BEQ   $B88A     ;write filename block if A = -1
B848 C62C       LDB   #$2C      ;?FM ERROR
B84A 8C         CMPX  #
(B84B C62A       LDB   #$2A)    ;?IO ERROR
B84D 8C         CMPX  #
(B84E C626       LDB   #$26)    ;?AO ERROR
B850 8C         CMPX  #
(B851 C628       LDB   #$28)    ;?DN ERROR
B853 7E8344     JMP   $8344
B856 4C         INCA            ;input stream must be >= -1
B857 2BEF       BMI   $B848     ;?FM ERROR
B859 262E       BNE   $B889     ;return if stream <> -1
B85B 8D1D       BSR   $B87A     ;find file & set up buffer
B85D B601E3     LDA   $01E3     ;must be ASCII
B860 B401E4     ANDA  $01E4      ;and gapped
B863 27E3       BEQ   $B848     ;?FM ERROR
B865 0C78       INC   <$78      ;cassette IO status
B867 BDB933     JSR   $B933     ;read leader & block from tape
B86A 26DF       BNE   $B84B     ;?IO ERROR
B86C 0D7C       TST   <$7C      ;block must be data or EOF
B86E 27DB       BEQ   $B84B     ;?IO ERROR
B870 2B17       BMI   $B889     ;return if EOF block
B872 967D       LDA   <$7D      ;block length
B874 27F1       BEQ   $B867     ;get another block if zero length
B876 9779       STA   <$79      ;no. of characters in buffer
B878 200A       BRA   $B884     ;finish setting up buffer

*** find file & set up buffer

B87A 0D78       TST   <$78      ;cassette IO status
B87C 26D0       BNE   $B84E     ;?AO ERROR
B87E 8D33       BSR   $B8B3     ;find file
B880 26C9       BNE   $B84B     ;?IO ERROR
B882 0F79       CLR   <$79      ;no. of characters in buffer
B884 8E01DA     LDX   #$01DA    ;IO buffer
B887 9F7A       STX   <$7A      ;buffer pointer
B889 39         RTS

*** if A = -1 then write filename block for gapped ASCII

B88A 4C         INCA
B88B 26FC       BNE   $B889     ;RTS
B88D 4C         INCA            ;A = 1

*** write filename block for gapped ASCII (file type in A)
    
B88E 8EFFFF     LDX   #$FFFF
B891 0D78       TST   <$78      ;cassette IO status
B893 26B9       BNE   $B84E     ;?AO ERROR
B895 CE01DA     LDU   #$01DA    ;IO buffer
B898 DF7E       STU   <$7E
B89A A748       STA   8,U       ;file type
B89C AF49       STX   9,U       ;ASCII flag & gap flag
B89E 8E01D2     LDX   #$01D2    ;filename
B8A1 BDB7CA     JSR   $B7CA     ;copy 8 bytes from X to U
B8A4 0F7C       CLR   <$7C      ;block type
B8A6 860F       LDA   #$0F
B8A8 977D       STA   <$7D      ;block length
B8AA BDB991     JSR   $B991     ;write leader & block to tape
B8AD 8602       LDA   #$02      ;2 = output
B8AF 9778       STA   <$78      ;cassette IO status
B8B1 20CF       BRA   $B882     ;reset IO buffer

*** find file

B8B3 8E01DA     LDX   #$01DA    ;IO buffer
B8B6 9F7E       STX   <$7E
B8B8 9668       LDA   <$68      ;current line number
B8BA 4C         INCA
B8BB 260B       BNE   $B8C8     ;not in command mode
B8BD BDBA77     JSR   $BA77     ;clear screen
B8C0 9E88       LDX   <$88      ;text cursor address
B8C2 C653       LDB   #$53   S
B8C4 E781       STB   ,X++
B8C6 9F88       STX   <$88      ;text cursor address
B8C8 8D69       BSR   $B933     ;read leader & block from tape
B8CA DA7C       ORB   <$7C      ;block type
B8CC 2634       BNE   $B902     ;return with error if not filename block
B8CE 8E01DA     LDX   #$01DA    ;IO buffer
B8D1 CE01D2     LDU   #$01D2    ;filename to find
B8D4 C608       LDB   #$08
B8D6 6FE2       CLR   ,-S
B8D8 A680       LDA   ,X+
B8DA 109E68     LDY   <$68      ;current line number
B8DD 3121       LEAY  1,Y
B8DF 2605       BNE   $B8E6     ;not in command mode
B8E1 0F6F       CLR   <$6F      ;DEVN
B8E3 BDB54A     JSR   $B54A     ;output character to DEVN
B8E6 A0C0       SUBA  ,U+
B8E8 AAE4       ORA   ,S
B8EA A7E4       STA   ,S
B8EC 5A         DECB
B8ED 26E9       BNE   $B8D8
B8EF A6E0       LDA   ,S+
B8F1 270A       BEQ   $B8FD     ;matched filename
B8F3 6D57       TST   -9,U
B8F5 2706       BEQ   $B8FD     ;no filename specified
B8F7 8D0A       BSR   $B903     ;skip rest of file
B8F9 2607       BNE   $B902     ;return with error
B8FB 20BB       BRA   $B8B8     ;try next file
B8FD 8646       LDA   #$46   F
B8FF 8D29       BSR   $B92A     ;display 'F'
B901 4F         CLRA
B902 39         RTS

*** skip rest of file

B903 7D01E4     TST   $01E4     ;gap flag
B906 2609       BNE   $B911     ;gapped file
B908 BD8021     JSR   $8021     ;read leader from tape
B90B 8D31       BSR   $B93E     ;read block from tape
B90D 8D08       BSR   $B917     ;test file status
B90F 20FA       BRA   $B90B     ;do next block
B911 8D20       BSR   $B933     ;read leader & block from tape
B913 8D02       BSR   $B917     ;test file status
B915 20FA       BRA   $B911     ;do next block

*** test file status

B917 2606       BNE   $B91F
B919 967C       LDA   <$7C      ;block type
B91B 40         NEGA
B91C 2B14       BMI   $B932     ;normal block - RTS
B91E 4A         DECA
B91F 9781       STA   <$81      ;error status
B921 3262       LEAS  2,S
B923 2013       BRA   $B938     ;cassette relay off & get status in B

*** flash loading cursor

B925 B60400     LDA   $0400
B928 8840       EORA  #$40
B92A D668       LDB   <$68      ;current line number
B92C 5C         INCB
B92D 2603       BNE   $B932     ;not in command mode
B92F B70400     STA   $0400
B932 39         RTS

*** read leader & block from tape

B933 BD8021     JSR   $8021     ;read leader from tape
B936 8D06       BSR   $B93E     ;read block from tape
B938 BD8018     JSR   $8018     ;cassette relay off
B93B D681       LDB   <$81      ;error status
B93D 39         RTS

*** read block from tape

B93E 1A50       ORCC  #$50      ;mask interrupts
B940 8DE3       BSR   $B925     ;flash loading cursor
B942 9E7E       LDX   <$7E      ;IO buffer
B944 4F         CLRA
B945 BD8027     JSR   $8027     ;bit in
B948 46         RORA
B949 813C       CMPA  #$3C
B94B 26F8       BNE   $B945     ;wait for sync byte
B94D BD8024     JSR   $8024     ;byte in
B950 977C       STA   <$7C      ;block type
B952 BD8024     JSR   $8024     ;byte in
B955 977D       STA   <$7D      ;block length
B957 9B7C       ADDA  <$7C      ;block type
B959 9780       STA   <$80      ;checksum
B95B 967D       LDA   <$7D      ;block length
B95D 9781       STA   <$81      ;use error status as counter
B95F 2711       BEQ   $B972     ;no data
B961 BD8024     JSR   $8024     ;byte in
B964 A784       STA   ,X
B966 A180       CMPA  ,X+       ;check that we are loading into RAM
B968 2612       BNE   $B97C
B96A 9B80       ADDA  <$80
B96C 9780       STA   <$80      ;checksum
B96E 0A81       DEC   <$81
B970 26EF       BNE   $B961     ;get next data byte
B972 BD8024     JSR   $8024     ;byte in
B975 9080       SUBA  <$80      ;checksum
B977 2705       BEQ   $B97E     ;status = OK
B979 8601       LDA   #$01      ;status = CRC error
B97B 8C         CMPX  #
(B97C 8602       LDA   #$02)    ;status = no RAM
B97E 9781       STA   <$81      ;status
B980 39         RTS

*** MOTOR

B981 1F89       TFR   A,B
B983 9D9F       JSR   <$9F      ;get next character from BASIC source
B985 C1C2       CMPB  #$C2      ;token OFF
B987 270D       BEQ   $B996     ;cassette relay off
B989 C188       CMPB  #$88      ;token ON
B98B BDB7FB     JSR   $B7FB     ;?SN ERROR if <>0
B98E 7E8015     JMP   $8015     ;cassette relay on

*** write leader & block to tape

B991 BD801B     JSR   $801B     ;write leader
B994 8D03       BSR   $B999     ;write block to tape
B996 7E8018     JMP   $8018     ;cassette relay off

*** write block to tape

B999 1A50       ORCC  #$50      ;mask interrupts
B99B D67D       LDB   <$7D      ;block length
B99D D781       STB   <$81      ;use error status as counter
B99F 967D       LDA   <$7D      ;block length
B9A1 2707       BEQ   $B9AA     ;no data
B9A3 9E7E       LDX   <$7E      ;IO buffer address
B9A5 AB80       ADDA  ,X+       ;
B9A7 5A         DECB            ;
B9A8 26FB       BNE   $B9A5     ;calculate checksum
B9AA 9B7C       ADDA  <$7C      ;block type
B9AC 9780       STA   <$80      ;checksum
B9AE 9E7E       LDX   <$7E      ;IO buffer address
B9B0 8D1B       BSR   $B9CD     ;write single leader byte
B9B2 863C       LDA   #$3C      ;sync byte
B9B4 8D19       BSR   $B9CF     ;byte out
B9B6 967C       LDA   <$7C      ;block type
B9B8 8D15       BSR   $B9CF     ;byte out
B9BA 967D       LDA   <$7D      ;block length
B9BC 8D11       BSR   $B9CF     ;byte out
B9BE 4D         TSTA
B9BF 2708       BEQ   $B9C9     ;no data
B9C1 A680       LDA   ,X+
B9C3 8D0A       BSR   $B9CF     ;byte out
B9C5 0A81       DEC   <$81
B9C7 26F8       BNE   $B9C1     ;keep going until all data sent
B9C9 9680       LDA   <$80      ;checksum
B9CB 8D02       BSR   $B9CF     ;byte out
B9CD 8655       LDA   #$55      ;leader byte
B9CF 7E801E     JMP   $801E     ;byte out

*** SET

B9D2 8D3F       BSR   $BA13     ;read coords & calc pixel
B9D4 3410       PSHS  X
B9D6 BD8E7E     JSR   $8E7E     ;skip comma & get number in B
B9D9 3510       PULS  X
B9DB C108       CMPB  #$08
B9DD 2245       BHI   $BA24     ;?FC ERROR
B9DF 5A         DECB
B9E0 2B05       BMI   $B9E7     ;black
B9E2 8610       LDA   #$10
B9E4 3D         MUL
B9E5 2008       BRA   $B9EF
B9E7 E684       LDB   ,X
B9E9 2A03       BPL   $B9EE     ;non-graphics block present
B9EB C470       ANDB  #$70
B9ED 21         BRN   $
(B9EE 5F         CLRB)
B9EF 3404       PSHS  B
B9F1 8D69       BSR   $BA5C     ;skip close bracket
B9F3 A684       LDA   ,X
B9F5 2B01       BMI   $B9F8
B9F7 4F         CLRA            ;non-graphics block present
B9F8 840F       ANDA  #$0F
B9FA 9A86       ORA   <$86      ;lo-res pixel mask
B9FC AAE0       ORA   ,S+
B9FE 8A80       ORA   #$80
BA00 A784       STA   ,X
BA02 39         RTS

*** RESET

BA03 8D0E       BSR   $BA13     ;read coords & calc pixel
BA05 8D55       BSR   $BA5C     ;skip close bracket
BA07 4F         CLRA
BA08 E684       LDB   ,X
BA0A 2AF2       BPL   $B9FE
BA0C 0386       COM   <$86      ;lo-res pixel mask
BA0E D486       ANDB  <$86
BA10 E784       STB   ,X
BA12 39         RTS

*** read coords & calc pixel for SET / RESET / POINT

BA13 BD89A7     JSR   $89A7     ;skip open bracket
BA16 BD8E51     JSR   $8E51     ;get number in B
BA19 C13F       CMPB  #$3F
BA1B 2207       BHI   $BA24     ;?FC ERROR
BA1D 3404       PSHS  B
BA1F BD8E7E     JSR   $8E7E     ;skip comma & get number in B
BA22 C11F       CMPB  #$1F
BA24 2271       BHI   $BA97     ;?FC ERROR
BA26 3404       PSHS  B
BA28 54         LSRB
BA29 8620       LDA   #$20
BA2B 3D         MUL
BA2C 8E0400     LDX   #$0400
BA2F 308B       LEAX  D,X
BA31 E661       LDB   1,S
BA33 54         LSRB
BA34 3A         ABX
BA35 3506       PULS  A,B
BA37 8401       ANDA  #$01
BA39 56         RORB
BA3A 49         ROLA
BA3B C610       LDB   #$10
BA3D 54         LSRB
BA3E 4A         DECA
BA3F 2AFC       BPL   $BA3D
BA41 D786       STB   <$86      ;lo-res pixel mask
BA43 39         RTS

*** POINT

BA44 8DD0       BSR   $BA16     ;read coords
BA46 C6FF       LDB   #$FF
BA48 A684       LDA   ,X
BA4A 2A0D       BPL   $BA59     ;non-graphics block
BA4C 9486       ANDA  <$86      ;lo-res pixel mask
BA4E 2708       BEQ   $BA58
BA50 E684       LDB   ,X
BA52 54         LSRB
BA53 54         LSRB
BA54 54         LSRB
BA55 54         LSRB
BA56 C407       ANDB  #$07
BA58 5C         INCB
BA59 BDB81A     JSR   $B81A     ;return number to BASIC
BA5C 7E89A4     JMP   $89A4     ;skip close bracket

*** CLS

BA5F BD01A0     JSR   $01A0     ;PATCH - CLS GET PUT
BA62 2713       BEQ   $BA77     ;no parameter - clear to spaces
BA64 BD8E51     JSR   $8E51     ;get number in B
BA67 C108       CMPB  #$08
BA69 221B       BHI   $BA86     ;CLS 9+
BA6B 5D         TSTB
BA6C 2706       BEQ   $BA74     ;CLS 0
BA6E 5A         DECB
BA6F 8610       LDA   #$10
BA71 3D         MUL
BA72 CA0F       ORB   #$0F
BA74 CA80       ORB   #$80
BA76 8C         CMPX  #

*** clear text screen

(BA77 C660       LDB   #$60)
BA79 8E0400     LDX   #$0400
BA7C 9F88       STX   <$88      ;text cursor address
BA7E E780       STB   ,X+
BA80 8C05FF     CMPX  #$05FF
BA83 23F9       BLS   $BA7E
BA85 39         RTS

*** clear text screen & print copyright message for CLS9+

BA86 8DEF       BSR   $BA77     ;clear screen
BA88 8EB4EC     LDX   #$B4EC
BA8B 7E90E5     JMP   $90E5     ;print string to DEVN

*** get parameter for SOUND

BA8E BD89AA     JSR   $89AA     ;check comma
BA91 BD8E51     JSR   $8E51     ;get number in B
BA94 5D         TSTB
BA95 263C       BNE   $BAD3     ;RTS
BA97 7E8B8D     JMP   $8B8D     ;?FC ERROR

*** SOUND

BA9A 8DF5       BSR   $BA91     ;get pitch
BA9C D78C       STB   <$8C      ;pitch
BA9E 8DEE       BSR   $BA8E     ;skip comma & get duration
BAA0 8604       LDA   #$04
BAA2 3D         MUL
BAA3 DD8D       STD   <$8D      ;duration x 4
BAA5 B6FF03     LDA   $FF03
BAA8 8A01       ORA   #$01
BAAA B7FF03     STA   $FF03     ;enable vsync irq
BAAD 0F08		CLR   <$08		;array illegal flag
BAAF 8D40       BSR   $BAF1     ;B=xxxxxx00 selects d/a sound
BAB1 8D12       BSR   $BAC5     ;enable audio
BAB3 8D1F       BSR   $BAD4     ; centre d/a
BAB5 86FC       LDA   #$FC
BAB7 8D1D       BSR   $BAD6     ; max d/a
BAB9 8D19       BSR   $BAD4     ; centre d/a
BABB 8600       LDA   #$00
BABD 8D17       BSR   $BAD6     ; min d/a
BABF 9E8D       LDX   <$8D      ;loop until irq routine
BAC1 26F0       BNE   $BAB3      ;decrements duration to zero

*** disable audio

BAC3 4F         CLRA
BAC4 8C         CMPX #

*** enable audio

(BAC5 8608       LDA #$08)
BAC7 A7E2       STA   ,-S
BAC9 B6FF23     LDA   $FF23
BACC 84F7       ANDA  #$F7
BACE AAE0       ORA   ,S+
BAD0 B7FF23     STA   $FF23
BAD3 39         RTS

*** reset D/A and delay

BAD4 867E       LDA   #$7E

*** store A in D/A and delay

BAD6 B7FF20     STA   $FF20
BAD9 968C       LDA   <$8C      ;SOUND pitch value
BADB 4C         INCA
BADC 26FD       BNE   $BADB
BADE 39         RTS

*** AUDIO

BADF 1F89       TFR   A,B
BAE1 9D9F       JSR   <$9F      ;get next character from BASIC source
BAE3 C1C2       CMPB  #$C2      ;token OFF
BAE5 27DC       BEQ   $BAC3
BAE7 C088       SUBB  #$88      ;token ON
BAE9 BDB7FB     JSR   $B7FB     ;?SN ERROR if <>0
BAEC 5C         INCB            
BAED 8D02       BSR   $BAF1     ;B=1 for cassette sound
BAEF 20D4       BRA   $BAC5     ;enable audio

*** select sound source

BAF1 CEFF01     LDU   #$FF01
BAF4 8D00       BSR   $BAF6
BAF6 A6C4       LDA   ,U
BAF8 84F7       ANDA  #$F7
BAFA 57         ASRB
BAFB 2402       BCC   $BAFF
BAFD 8A08       ORA   #$08
BAFF A7C1       STA   ,U++
BB01 39         RTS

*** SOUND duration counter
    (called by IRQ service routine)

BB02 BE008D     LDX   $008D     ;SOUND counter
BB05 2705       BEQ   $BB0C
BB07 301F       LEAX  -1,X
BB09 BF008D     STX   $008D     ;SOUND counter
BB0C 3B         RTI

*** JOYSTK

BB0D BD8E54     JSR   $8E54     ;get number in B from FPA1
BB10 C103       CMPB  #$03
BB12 1022D077  LBHI   $8B8D     ;?FC ERROR
BB16 5D         TSTB            ;
BB17 2603       BNE   $BB1C     ;
BB19 BD8012     JSR   $8012     ;update joysticks if B = 0
BB1C 8E015A     LDX   #$015A    ;joystick value table
BB1F D653       LDB   <$53      ;get number again
BB21 E685       LDB   B,X
BB23 7E8C36     JMP   $8C36     ;assign B to FPA1

*** continued from fetch character routine at $9f
    skips spaces and returns with carry set if
    character is a digit

BB26 813A       CMPA  #$3A
BB28 240A       BCC   $BB34     ;higher than '9'
BB2A 8120       CMPA  #$20
BB2C 2602       BNE   $BB30     ;not a space
BB2E 0E9F       JMP   <$9F      ;get next character from BASIC source
BB30 8030       SUBA  #$30      ;
BB32 80D0       SUBA  #$D0      ;set carry if >= '0'
BB34 39         RTS

*** unused

BB35 to BB3B	; filled with RTS

BB3C 6EA4       JMP   ,Y
BB3E 39         RTS
BB3F 39         RTS

*** reset routine continued

BB40 CC0034     LDD   #$0034    ;initialise PIA0:
BB43 8EFF00     LDX   #$FF00	;       $FF00 PDR rrrrrrrr
BB46 A701       STA   1,X       ;       $FF02 PDR wwwwwwww
BB48 A703       STA   3,X       ;       CA2 bit3 output mode
BB4A A784       STA   ,X        ;       CB2 bit3 output mode
BB4C 43         COMA            ;       IRQA disabled (hsync)
BB4D A702       STA   2,X       ;       IRQB disabled (vsync)
BB4F E701       STB   1,X		;
BB51 E703       STB   3,X		;
BB53 8EFF20     LDX   #$FF20    ;initialise PIA1:
BB56 6F01       CLR   1,X       ;       $FF20 PDR wwwwwwwr
BB58 6F03       CLR   3,X       ;       $FF22 PDR wwwwwrrr
BB5A 4A         DECA            ;       CA2 bit3 output mode
BB5B A784       STA   ,X        ;       CB2 bit3 output mode
BB5D 86F8       LDA   #$F8      ;       IRQA disabled (ack)
BB5F A702       STA   2,X       ;       IRQB disabled (cart)
BB61 E701       STB   1,X       ;
BB63 E703       STB   3,X       ;
BB65 6F84       CLR   ,X        ;
BB67 6F02       CLR   2,X       ;
BB69 A602       LDA   2,X       ;
BB6B 8EFFC0     LDX   #$FFC0    ;initialise SAM:
BB6E C610       LDB   #$10      ;       512 byte display
BB70 A781       STA   ,X++      ;       mem page 0
BB72 5A         DECB            ;       slow MPU rate
BB73 26FB       BNE   $BB70     ;       MAP 0
BB75 F7FFC9     STB   $FFC9     ;       display base 1024
BB78 8504       BITA  #$04      ;       memory size select
BB7A 2705       BEQ   $BB81     ;
BB7C F7FFDB     STB   $FFDB		;		16K dynamic memory
BB7F 2003       BRA   $BB84		;
BB81 F7FFDD     STB   $FFDD		;		64K dynamic memory
BB84 1F9B       TFR   B,DP		;DP=0
BB86 1F25       TFR   Y,PC      ;JMP to $B39B on cold start
								;JMP to $B47B on cart firq

*** part of start up reset routine

BB88 8EBB9F     LDX   #$BB9F
BB8B CE008F     LDU   #$008F
BB8E C60D       LDB   #$0D
BB90 8D05       BSR   $BB97     ;copy B bytes from X to U
BB92 CE0148     LDU   #$0148
BB95 C609       LDB   #$09
BB97 A680       LDA   ,X+
BB99 A7C0       STA   ,U+
BB9B 5A         DECB
BB9C 26F9       BNE   $BB97     ;copy B bytes from X to U
BB9E 39         RTS

*** copied to $8f - $9b on start up
    (cursor counter, leader count, COS timing, motor on delay,
     key scan delay, printer parameters)

BB9F  32 0080 12 0A 12 DA5C 045E 10 74 84

*** copied to $148 - $150 on start up
    (auto LF flag, caps flag, printer EOL sequence)

BBAC  FF FF 01 0D 0A 20 44 4E 53  (last 3 chars 'DNS' initials)

*** blink cursor

BBB5 0A8F       DEC   <$8F       ;cursor flash counter
BBB7 260C       BNE   $BBC5
BBB9 8632       LDA   #$32
BBBB 978F       STA   <$8F       ;cursor flash counter
BBBD 9E88       LDX   <$88       ;text cursor address
BBBF A684       LDA   ,X
BBC1 8840       EORA  #$40
BBC3 A784       STA   ,X
BBC5 8E045E     LDX   #$045E
BBC8 301F       LEAX  -1,X
BBCA 26FC       BNE   $BBC8
BBCC 39         RTS

*** read key matrix & mask SHIFT key

BBCD F6FF00     LDB   $FF00
BBD0 CA80       ORB   #$80       ;mask analogue comp.
BBD2 7DFF02     TST   $FF02
BBD5 2B02       BMI   $BBD9
BBD7 CA40       ORB   #$40
BBD9 39         RTS

*** test for SHIFT key

BBDA C67F       LDB   #$7F
BBDC F7FF02     STB   $FF02
BBDF F6FF00     LDB   $FF00
BBE2 C440       ANDB  #$40
BBE4 39         RTS

*** scan keyboard & return ASCII

BBE5 3414       PSHS  B,X
BBE7 8D03       BSR   $BBEC
BBE9 4D         TSTA
BBEA 3594       PULS  B,X,PC

BBEC 327E       LEAS  -2,S
BBEE 8E0151     LDX   #$0151    ;key rollover table
BBF1 7FFF02     CLR   $FF02     ;test all keys
BBF4 F6FF00     LDB   $FF00
BBF7 CA80       ORB   #$80      ;mask analogue comp.
BBF9 E184       CMPB  ,X
BBFB 2772       BEQ   $BC6F     ;nothing changed - return NUL
BBFD 1F98       TFR   B,A
BBFF 73FF02     COM   $FF02     ;disable all keys
BC02 8DC9       BSR   $BBCD     ;read matrix & mask shift
BC04 C1FF       CMPB  #$FF      ;
BC06 2667       BNE   $BC6F     ;joystick button pressed - return NUL
BC08 A780       STA   ,X+       ; $0151 = keyboard state
BC0A 6FE4       CLR   ,S        ;row counter
BC0C C6FE       LDB   #$FE
BC0E F7FF02     STB   $FF02
BC11 8DBA       BSR   $BBCD     ;read matrix & mask shift
BC13 E761       STB   1,S
BC15 E884       EORB  ,X        ;
BC17 E484       ANDB  ,X        ;sets bits in B for new keys pressed
BC19 A661       LDA   1,S
BC1B A780       STA   ,X+       ;save new scan code
BC1D 5D         TSTB
BC1E 260A       BNE   $BC2A     ;new keys pressed
BC20 6CE4       INC   ,S
BC22 43         COMA            ;set carry
BC23 79FF02     ROL   $FF02     ;next row
BC26 25E9       BCS   $BC11     ;more rows to do
BC28 2045       BRA   $BC6F     ;no new keys pressed - return NUL
BC2A 9E97       LDX   <$97      ;
BC2C 8D9A       BSR   $BBC8     ;debounce delay
BC2E 1E89       EXG   A,B
BC30 8D9B       BSR   $BBCD     ;read matrix & mask shift
BC32 E161       CMPB  1,S
BC34 1E89       EXG   A,B
BC36 2637       BNE   $BC6F     ;key state changed during delay - return NUL
BC38 A6E4       LDA   ,S        ;row number
BC3A 8008       SUBA  #$08
BC3C 8B08       ADDA  #$08      ;convert scan code into a number
BC3E 54         LSRB            ;between 0 and 54
BC3F 24FB       BCC   $BC3C     ;(nb. shift masked out)
BC41 4D         TSTA
BC42 2732       BEQ   $BC76     ;zero key
BC44 810C       CMPA  #$0C
BC46 2517       BCS   $BC5F     ; keys 1 to 9 : ;
BC48 8111       CMPA  #$11
BC4A 2528       BCS   $BC74     ; keys , - . / @
BC4C 812A       CMPA  #$2A
BC4E 2222       BHI   $BC72     ; arrows SPC RET CLR BRK
BC50 8B30       ADDA  #$30      ;ASCII A - Z
BC52 8D86       BSR   $BBDA     ;test for SHIFT key
BC54 2712       BEQ   $BC68     ;SHIFT pressed
BC56 7D0149     TST   $0149     ;CAPS flag
BC59 260D       BNE   $BC68     ;upper case
BC5B 8A20       ORA   #$20      ;convert to lower case
BC5D 2009       BRA   $BC68
BC5F 8B30       ADDA  #$30      ;ASCII 1 to 9 : ;
BC61 17FF76     LBSR  $BBDA     ;test for SHIFT key
BC64 2602       BNE   $BC68     ;SHIFT not pressed
BC66 8010       SUBA  #$10
BC68 8112       CMPA  #$12
BC6A 2604       BNE   $BC70     ;not shift + 0
BC6C 730149     COM   $0149     ;CAPS flag
BC6F 4F         CLRA
BC70 3590       PULS  X,PC

*** XLAT key scan code to ASCII

BC72 801A       SUBA  #$1A
BC74 800B       SUBA  #$0B
BC76 48         ASLA
BC77 17FF60     LBSR  $BBDA      ;test for SHIFT key
BC7A 2601       BNE   $BC7D
BC7C 4C         INCA
BC7D 8EBC84     LDX   #$BC84
BC80 A686       LDA   A,X
BC82 20E4       BRA   $BC68

*** keyboard XLAT table
    (two bytes per entry - unshifted & shifted)

BC84 30 12 2C 3C     ; 0      ,
BC88 2D 3D 2E 3E     ; -      .
BC8C 2F 3F 40 13     ; /      @
BC90 5E 5F 0A 5B     ; CU     CD
BC94 08 15 09 5D     ; CL     CR
BC98 20 20 0D 0D     ; SPC    RET
BC9C 0C 5C 03 03     ; CLR    BRK

*** clear VDU line + CR/LF

BCA0 8660       LDA   #$60
BCA2 A780       STA   ,X+
BCA4 1F10       TFR   X,D
BCA6 C41F       ANDB  #$1F
BCA8 26F6       BNE   $BCA0
BCAA 39         RTS

*** write character to VDU

BCAB 3416       PSHS  A,B,X
BCAD 9E88       LDX   <$88      ;text cursor address
BCAF 8108       CMPA  #$08
BCB1 260B       BNE   $BCBE
BCB3 8C0400     CMPX  #$0400    ;backspace
BCB6 273B       BEQ   $BCF3
BCB8 8660       LDA   #$60
BCBA A782       STA   ,-X
BCBC 201D       BRA   $BCDB
BCBE 810D       CMPA  #$0D      ;return
BCC0 2604       BNE   $BCC6
BCC2 8DDC       BSR   $BCA0     ;clear VDU line + CR/LF
BCC4 2015       BRA   $BCDB
BCC6 8120       CMPA  #$20
BCC8 2529       BCS   $BCF3     ; chr < $20
BCCA 4D         TSTA
BCCB 2B0C       BMI   $BCD9     ; chr >= 128
BCCD 8140       CMPA  #$40
BCCF 2506       BCS   $BCD7     ; $20 <= chr < $40
BCD1 8160       CMPA  #$60
BCD3 2504       BCS   $BCD9     ; $40 <= chr < $60
BCD5 84DF       ANDA  #$DF
BCD7 8840       EORA  #$40
BCD9 A780       STA   ,X+
BCDB 9F88       STX   <$88      ;text cursor address
BCDD 8C05FF     CMPX  #$05FF
BCE0 2311       BLS   $BCF3
BCE2 8E0400     LDX   #$0400    ;scroll
BCE5 EC8820     LDD   32,X      ;
BCE8 ED81       STD   ,X++      ;
BCEA 8C05E0     CMPX  #$05E0    ;
BCED 25F6       BCS   $BCE5     ;
BCEF 9F88       STX   <$88      ;text cursor address
BCF1 8DAD       BSR   $BCA0     ;clear VDU line + CR/LF
BCF3 3596       PULS  A,B,X,PC

*** write character direct to printer

BCF5 3404       PSHS  B
BCF7 F6FF22     LDB   $FF22     ;wait for printer not busy
BCFA 56         RORB            ;
BCFB 25FA       BCS   $BCF7     ;

*** write character to parallel port

BCFD B7FF02     STA   $FF02
BD00 C602       LDB   #$02      ;
BD02 F7FF20     STB   $FF20     ;
BD05 7FFF20     CLR   $FF20     ;strobe
BD08 3584       PULS  B,PC

*** send EOL characters to printer

BD0A 8E014A     LDX   #$014A
BD0D E680       LDB   ,X+
BD0F 5D         TSTB
BD10 2707       BEQ   $BD19
BD12 A680       LDA   ,X+
BD14 8DDF       BSR   $BCF5     ;send character direct to printer
BD16 5A         DECB
BD17 20F6       BRA   $BD0F
BD19 39         RTS

*** write character to printer

BD1A 3416       PSHS  A,B,X
BD1C 810D       CMPA  #$0D
BD1E 2713       BEQ   $BD33
BD20 8120       CMPA  #$20
BD22 2502       BCS   $BD26     ;don't advance head pos for CTRL chrs
BD24 0C9C       INC   <$9C      ;printer head pos
BD26 8DCD       BSR   $BCF5     ;send character to printer
BD28 D69C       LDB   <$9C      ;printer head pos
BD2A D19B       CMPB  <$9B      ;printer line width
BD2C 2511       BCS   $BD3F
BD2E 7D0148     TST   $0148     ;printer auto LF flag
BD31 260A       BNE   $BD3D
BD33 0D9C       TST   <$9C      ;printer head pos
BD35 2604       BNE   $BD3B
BD37 8620       LDA   #$20
BD39 8DBA       BSR   $BCF5     ;send character to printer
BD3B 8DCD       BSR   $BD0A     ;send EOL sequence
BD3D 0F9C       CLR   <$9C      ;printer head pos
BD3F 3596       PULS  A,B,X,PC

*** select joystick source B (0-3)

BD41 CEFF01     LDU   #$FF01
BD44 8D00       BSR   $BD46
BD46 A6C4       LDA   ,U
BD48 84F7       ANDA  #$F7
BD4A 56         RORB
BD4B 2402       BCC   $BD4F
BD4D 8A08       ORA   #$08
BD4F A7C1       STA   ,U++
BD51 39         RTS

*** update joystick values in locations $15a - $15d
    (reads each channel up to 10 times until stable result is obtained)

BD52 327D       LEAS  -3,S
BD54 8E015E     LDX   #$015E    ;end of joystick table + 1
BD57 C603       LDB   #$03      
BD59 860A       LDA   #$0A
BD5B ED61       STD   1,S
BD5D 8DE2       BSR   $BD41     ;select joystick source B
BD5F CC4080     LDD   #$4080
BD62 A7E4       STA   ,S
BD64 F7FF20     STB   $FF20     ;
BD67 7DFF00     TST   $FF00     ;test analogue comp.
BD6A 2B04       BMI   $BD70     ;approximation low
BD6C E0E4       SUBB  ,S        ;try smaller value
BD6E 2002       BRA   $BD72
BD70 EBE4       ADDB  ,S        ;try larger value
BD72 44         LSRA            ;
BD73 8101       CMPA  #$01      ;
BD75 26EB       BNE   $BD62     ;do finer approximation
BD77 54         LSRB            ;
BD78 54         LSRB            ;convert range to 0-63
BD79 E11F       CMPB  -1,X
BD7B 2704       BEQ   $BD81     ;reading stable
BD7D 6A61       DEC   1,S
BD7F 26DE       BNE   $BD5F     ;do up to 10 readings until stable
BD81 E782       STB   ,-X
BD83 E662       LDB   2,S       ;
BD85 5A         DECB            ;
BD86 2AD1       BPL   $BD59     ;do next joystick channel
BD88 3592       PULS  A,X,PC

***  read state of cassette input comparator into carry
     (+update wavelength timer)

BD8A 0C82       INC   <$82      ;wavelength timer
BD8C F6FF20     LDB   $FF20
BD8F 56         RORB
BD90 39         RTS

*** wave timer

BD91 0F82       CLR   <$82      ;wavelength timer
BD93 0D84       TST   <$84      ;phase flag
BD95 2607       BNE   $BD9E     ;time antiphase wave
BD97 8D07       BSR   $BDA0     ;time +ve going wave

*** time -ve going wave
BD99 8DEF       BSR   $BD8A     ;read cassette input & update timer
BD9B 24FC       BCC   $BD99
BD9D 39         RTS

*** alternative wave timer (antiphase)

BD9E 8DF9       BSR   $BD99     ;time -ve going wave

*** time +ve going wave
BDA0 8DE8       BSR   $BD8A     ;read cassette input & update timer
BDA2 25FC       BCS   $BDA0
BDA4 39         RTS

*** read bit from tape into carry

BDA5 8DEA       BSR   $BD91
BDA7 D682       LDB   <$82      ;wavelength timer
BDA9 5A         DECB
BDAA D192       CMPB  <$92      ;wavelength threshold
BDAC 39         RTS

*** read byte from tape into A

BDAD 8608       LDA   #$08
BDAF 9783       STA   <$83
BDB1 8DF2       BSR   $BDA5     ;read bit from tape into carry
BDB3 46         RORA            ;LSB first
BDB4 0A83       DEC   <$83
BDB6 26F9       BNE   $BDB1     ;do next bit
BDB8 39         RTS

*** called by read leader routine - test +ve going wave

BDB9 0F82       CLR   <$82      ;wavelength timer
BDBB 8DE3       BSR   $BDA0     ;time +ve going wave
BDBD 2004       BRA   $BDC3

*** called by read leader routine - test -ve going wave

BDBF 0F82       CLR   <$82      ;wavelength timer
BDC1 8DD6       BSR   $BD99     ;time -ve going wave
BDC3 D682       LDB   <$82      ;wavelength timer
BDC5 D194       CMPB  <$94      ;rejection threshold
BDC7 2203       BHI   $BDCC     ;bad wave - clear counter
BDC9 D193       CMPB  <$93      ;discrimination threshold
BDCB 39         RTS
BDCC 0F83       CLR   <$83      ;phase lock counter
BDCE 39         RTS

*** turn cassette relay on

BDCF B6FF21     LDA   $FF21
BDD2 8A08       ORA   #$08
BDD4 B7FF21     STA   $FF21
BDD7 9E95       LDX   <$95
BDD9 16FDEC     LBRA  $BBC8

*** turn cassette relay off

BDDC B6FF21     LDA   $FF21
BDDF 84F7       ANDA  #$F7
BDE1 B7FF21     STA   $FF21
BDE4 1CAF       ANDCC #$AF
BDE6 39         RTS

*** read leader from tape
    (+determine phase of signal)

BDE7 1A50       ORCC  #$50      ;mask interrupts
BDE9 8DE4       BSR   $BDCF     ;cassette relay on
BDEB 0F83       CLR   <$83      ;phase lock counter
BDED 8DA8       BSR   $BD97     ;synchronise to in-phase wave (+ve then -ve)
BDEF 8DC8       BSR   $BDB9     ;test +ve wave
BDF1 220C       BHI   $BDFF     ;0 or bad
BDF3 8DCA       BSR   $BDBF     ;test -ve wave
BDF5 250C       BLO   $BE03     ;1 or bad
BDF7 0C83       INC   <$83      ;add 1 for each antiphase pair of cycles
BDF9 9683       LDA   <$83
BDFB 8160       CMPA  #$60
BDFD 200E       BRA   $BE0D
BDFF 8DBE       BSR   $BDBF     ;test -ve wave
BE01 22EC       BHI   $BDEF     ;0 or bad
BE03 8DB4       BSR   $BDB9     ;test +ve wave
BE05 25EC       BLO   $BDF3     ;1 or bad
BE07 0A83       DEC   <$83      ;subtract 1 for each in-phase pair of cycles
BE09 9683       LDA   <$83
BE0B 8B60       ADDA  #$60      ;SUBA #-$60
BE0D 26DE       BNE   $BDED     ;need $60 locks in a row ($18 leader bytes)
BE0F 9784       STA   <$84      ;phase flag
BE11 39         RTS

*** write byte out to tape (A)

BE12 3402       PSHS  A
BE14 C601       LDB   #$01      ;send LSB first
BE16 108EBE44   LDY   #$BE44    ;wave table
BE1A 9685       LDA   <$85      ;inter-wave level
BE1C B7FF20     STA   $FF20
BE1F E5E4       BITB  ,S
BE21 260D       BNE   $BE30     ;high frequency for 1
BE23 A6A0       LDA   ,Y+       ;low frequency for 0
BE25 108CBE68   CMPY  #$BE68
BE29 2412       BCC   $BE3D     ;done 0
BE2B B7FF20     STA   $FF20
BE2E 20F3       BRA   $BE23
BE30 A6A1       LDA   ,Y++
BE32 108CBE68   CMPY  #$BE68
BE36 2405       BCC   $BE3D     ;done 1
BE38 B7FF20     STA   $FF20
BE3B 20F3       BRA   $BE30
BE3D 9785       STA   <$85      ;inter-wave level
BE3F 58         ASLB            ;
BE40 24D4       BCC   $BE16     ;do next bit
BE42 3582       PULS  A,PC

*** wave table for cassette output

BE44  80 90 A8 B8 C8 D8 E8 F0
BE4C  F8 F8 F8 F0 E8 D8 C8 B8
BE54  A8 90 78 68 50 40 30 20
BE5C  10 08 00 00 00 08 10 20
BE64  30 40 50 68

*** write leader to tape

BE68 3424       PSHS  B,Y
BE6A 1A50       ORCC  #$50      ;mask interrupts
BE6C 17FF60     LBSR  $BDCF     ;cassette relay on
BE6F 8655       LDA   #$55
BE71 9E90       LDX   <$90      ;cassette leader byte count
BE73 8D9D       BSR   $BE12     ;write byte out to tape
BE75 301F       LEAX  -1,X      ;
BE77 26FA       BNE   $BE73     ;do next byte
BE79 35A4       PULS  B,Y,PC


*** read serial (not implemented)

BE7B 39         RTS

*** write serial (not implemented)

BE7C 39

*** baud rate select (not implemented)

BE7D 53         COMB		; set carry
BE7E 39			RTS

*** unused

BE7F-BFF1

*** interrupt vectors

BFF2  0100      ;SWI3
BFF4  0103      ;SWI2
BFF6  010F      ;FIRQ
BFF8  010C      ;IRQ
BFFA  0106      ;SWI
BFFC  0109      ;NMI
BFFE  B3B4      ;RESET
