Disassembly of D64 ROM - 32K mode
($A000 - $BFFF)

*** 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
    There is a logic bug in the serial system. The routines that call
    the serial I/O drivers expect to see the Z flag set for success. The
    serial drivers don't change the flags, however. Either re-write the
    drivers for correct operation or skip the checks by changing BNE to
    BRN at locations $a13d, $a16e & $a1ab.

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 5A         DECB
AAE1 8606       LDA   #$06
AAE3 3D         MUL
AAE4 DBBC       ADDB  <$BC      ;MSB of start of graphics page 1
AAE6 D119       CMPB  <$19      ;page address must be lower
AAE8 2403       BCC   $AAED     ;than BASIC program
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 CC7E7C     LDD   #$7E7C
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 867C       LDA   #$7C
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 867C       LDA   #$7C
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 867C       LDA   #$7C
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 $BB3C

*** 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
B47B 0F71       CLR   <$71      ;cold boot flag
B47D 7EC000     JMP   $C000

*** 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  BF49     (points to boot 64K BASIC routine)
      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 05 
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 26FA       BNE   $B8C8     ;keep going until filename block loaded
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 12         NOP
BAAE 5F         CLRB
BAAF 8D40       BSR   $BAF1     ;B=0 to select 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 867C       LDA   #$7C

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

*** reset routine continued

BB3C CC0034     LDD   #$0034    ;initialise PIA0:
BB3F 8EFF00     LDX   #$FF00    ;       $FF00 PDR rrrrrrrr
BB42 A701       STA   1,X       ;       $FF02 PDR wwwwwwww
BB44 A703       STA   3,X       ;       CA2 bit3 output mode
BB46 A784       STA   ,X        ;       CB2 bit3 output mode
BB48 43         COMA            ;       IRQA disabled (hsync)
BB49 A702       STA   2,X       ;       IRQB disabled (vsync)
BB4B E701       STB   1,X       ;
BB4D E703       STB   3,X       ;
BB4F 8EFF20     LDX   #$FF20    ;initialise PIA1:
BB52 6F01       CLR   1,X       ;       $FF20 PDR wwwwwwwr
BB54 6F03       CLR   3,X       ;       $FF22 PDR wwwwwrrr
BB56 4A         DECA            ;       CA2 bit3 output mode
BB57 A784       STA   ,X        ;       CB2 bit3 output mode
BB59 86F8       LDA   #$F8      ;       IRQA disabled (ack)
BB5B A702       STA   2,X       ;       IRQB disabled (cart)
BB5D E701       STB   1,X       ;
BB5F E703       STB   3,X       ;
BB61 6F84       CLR   ,X        ;
BB63 6F02       CLR   2,X       ;
BB65 CC0A98     LDD   #$0A98    ;initialise serial hardware:
BB68 FDFF06     STD   $FF06     ;       no parity, no IRQ, DTR low
BB6B B6FF04     LDA   $FF04     ;       1200 baud, 8 data, 2 stop
BB6E 8EFFC0     LDX   #$FFC0    ;initialise SAM:
BB71 C610       LDB   #$10      ;       512 byte display
BB73 A781       STA   ,X++      ;       display base 1024
BB75 5A         DECB            ;       mem page 0
BB76 26FB       BNE   $BB73     ;       slow MPU rate
BB78 F7FFC9     STB   $FFC9     ;       64K dynamic memory
BB7B F7FFDD     STB   $FFDD     ;       MAP 0
BB7E 2003       BRA   $BB83     ;

*** boot 64K BASIC

BB80 7EBF49     JMP   $BF49

*** reset routine continued

BB83 5F         CLRB
BB84 1F9B       TFR   B,DP
BB86 1F25       TFR   Y,PC      ;JMP to $B39B

*** 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 BDBEFF     JSR   $BEFF     ;set up serial printer parameters
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 0100 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 00 00 00 00

*** 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 7EBEE0     JMP   $BEE0

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 7D03FF     TST   $03FF     ;printer type flag
BCFA 7EBEC5     JMP   $BEC5     ;continued...

*** 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 7EBF0C     JMP   $BF0C     ;continued...
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 character from serial port into A

BE7B 3405       PSHS  CC,B
BE7D 1A50       ORCC  #$50      ;mask interrupts
BE7F 8608       LDA   #$08
BE81 F6FF06     LDB   $FF06     ;
BE84 CA01       ORB   #$01      ;
BE86 F7FF06     STB   $FF06     ;set DTR
BE89 C4FE       ANDB  #$FE
BE8B B5FF05     BITA  $FF05     ;wait until RX full
BE8E 27FB       BEQ   $BE8B     ;
BE90 F7FF06     STB   $FF06     ;clear DTR
BE93 B6FF04     LDA   $FF04
BE96 3585       PULS  CC,B,PC

*** write character to serial port (A)

BE98 3405       PSHS  CC,B
BE9A C610       LDB   #$10
BE9C F5FF05     BITB  $FF05     ;wait until TX ready
BE9F 27FB       BEQ   $BE9C     ;
BEA1 B7FF04     STA   $FF04
BEA4 3585       PULS  CC,B,PC

*** serial baud rate select
    (parameter in B is as per DLOAD)

BEA6 C107       CMPB  #$07
BEA8 2412       BCC   $BEBC     ;B must be 0 - 6
BEAA 8EBEBE     LDX   #$BEBE    ;serial baud setup table
BEAD 3A         ABX
BEAE F6FF07     LDB   $FF07
BEB1 C4F0       ANDB  #$F0
BEB3 EA84       ORB   ,X
BEB5 F7FF07     STB   $FF07
BEB8 1CFE       ANDCC #$FE
BEBA 2001       BRA   $BEBD
BEBC 53         COMB
BEBD 39         RTS

*** serial port baud setup table

BEBE  03 06 07 08 0A 0C 0E

*** odd byte?

BEC4  26

*** printer direct out (continued from $BCF5)

BEC5 2614       BNE   $BEDB
BEC7 F6FF22     LDB   $FF22
BECA 56         RORB
BECB 25FA       BCS   $BEC7     ;printer busy
BECD 7FFF02     CLR   $FF02
BED0 F6FF00     LDB   $FF00
BED3 CA80       ORB   #$80
BED5 5C         INCB
BED6 26F5       BNE   $BECD     ;wait until keys released
BED8 7EBCFD     JMP   $BCFD

BEDB 3504       PULS  B
BEDD 7EBE98     JMP   $BE98     ;send character to serial port

*** scan keyboard continued

BEE0 F60151     LDB   $0151
BEE3 5C         INCB
BEE4 2603       BNE   $BEE9      ;key pressed
BEE6 F7011D     STB   $011D      ;stores a zero
BEE9 4D         TSTA
BEEA 2711       BEQ   $BEFD      ;ASCII NUL
BEEC F6011F     LDB   $011F      ;repeat delay
BEEF B1011D     CMPA  $011D      ;current key
BEF2 2703       BEQ   $BEF7      ;same key pressed - use normal repeat rate
BEF4 58         ASLB             ;
BEF5 58         ASLB             ;set up initial repeat delay
BEF6 58         ASLB             ;
BEF7 F7011E     STB   $011E      ;repeat counter
BEFA B7011D     STA   $011D      ;current key
BEFD 3594       PULS  B,X,PC

*** D64 extension to start up reset routine

BEFF 7F03FF     CLR   $03FF     ;printer type flag
BF02 7F03FD     CLR   $03FD     ;serial printer EOL delay
BF05 7F03FE     CLR   $03FE     ;
BF08 CE0148     LDU   #$0148
BF0B 39         RTS

*** send printer EOL characters (continued)

BF0C 5A         DECB
BF0D 2703       BEQ   $BF12
BF0F 7EBD0F     JMP   $BD0F
BF12 10BE03FD   LDY   $03FD     ;EOL delay
BF16 2707       BEQ   $BF1F
BF18 BDBBC5     JSR   $BBC5     ;10ms delay
BF1B 313F       LEAY  -1,Y
BF1D 26F9       BNE   $BF18
BF1F 39         RTS

*** D64 alternative IRQ service routine
    (gives autorepeat keys)

BF20 F6FF05     LDB   $FF05
BF23 2A0D       BPL   $BF32      ;not serial interrupt
BF25 C408       ANDB  #$08
BF27 2708       BEQ   $BF31      ;RX not full
BF29 B6FF06     LDA   $FF06
BF2C 84FE       ANDA  #$FE       ;
BF2E B7FF06     STA   $FF06      ;set DTR low
BF31 3B         RTI
BF32 740151     LSR   $0151      ;force complete keyboard read
BF35 7A011E     DEC   $011E      ;key repeat counter
BF38 260C       BNE   $BF46      ;not yet...
BF3A 86FF       LDA   #$FF       ;clear key rollover table
BF3C 8E0151     LDX   #$0151     ;
BF3F A780       STA   ,X+        ;
BF41 8C015A     CMPX  #$015A     ;
BF44 25F9       BCS   $BF3F      ;
BF46 7E9D3D     JMP   $9D3D      ;resume with normal IRQ routine

*** boot 64K BASIC continued
    (doubles as 64K BASIC soft reset)

BF49 12         NOP
BF4A 1A50       ORCC  #$50      ;mask interrupts
BF4C 8EBF5A     LDX   #$BF5A
BF4F CE01DA     LDU   #$01DA    ;IO buffer
BF52 C68F       LDB   #$8F
BF54 17FC40     LBSR  $BB97     ;copy B bytes from X to U
BF57 7E01DA     JMP   $01DA     ;IO buffer

*** copied to cassette buffer & executed

BF5A B6011A     LDA   $011A     ;64K BASIC flag
BF5D 8155       CMPA  #$55
BF5F 2616       BNE   $BF77
BF61 B7FFDF     STA   $FFDF
BF64 8EC000     LDX   #$C000
BF67 CC0000     LDD   #$0000
BF6A E381       ADDD  ,X++
BF6C 8CFF00     CMPX  #$FF00
BF6F 25F9       BCS   $BF6A
BF71 10B3011B   CMPD  $011B     ;64K BASIC checksum
BF75 276F       BEQ   $BFE6
BF77 B7FFDE     STA   $FFDE
BF7A B6FF23     LDA   $FF23
BF7D 84FB       ANDA  #$FB
BF7F B7FF23     STA   $FF23
BF82 F6FF22     LDB   $FF22
BF85 CA04       ORB   #$04
BF87 F7FF22     STB   $FF22
BF8A 8A04       ORA   #$04
BF8C B7FF23     STA   $FF23
BF8F B6FF22     LDA   $FF22
BF92 84FB       ANDA  #$FB
BF94 B7FF22     STA   $FF22
BF97 FEBFF0     LDU   $BFF0
BF9A 11833634   CMPU  #$3634
BF9E 2708       BEQ   $BFA8
BFA0 8A04       ORA   #$04
BFA2 B7FF22     STA   $FF22
BFA5 7E8B8D     JMP   $8B8D     ;?FC ERROR
BFA8 7F011B     CLR   $011B     ;64K BASIC checksum
BFAB 7F011C     CLR   $011C     ;
BFAE 8E8000     LDX   #$8000
BFB1 108EC000   LDY   #$C000
BFB5 EC81       LDD   ,X++
BFB7 B7FFDF     STA   $FFDF
BFBA EDA1       STD   ,Y++
BFBC F3011B     ADDD  $011B     ;64K BASIC checksum
BFBF FD011B     STD   $011B     ;
BFC2 108CFF00   CMPY  #$FF00
BFC6 2405       BCC   $BFCD
BFC8 B7FFDE     STA   $FFDE
BFCB 20E8       BRA   $BFB5
BFCD 8EBFF0     LDX   #$BFF0
BFD0 9F74       STX   <$74      ;top of RAM
BFD2 9F27       STX   <$27      ;top of BASIC RAM
BFD4 9F23       STX   <$23      ;top of free string space
BFD6 3089FF38   LEAX  $FF38,X
BFDA 9F21       STX   <$21      ;stack root / string storage start
BFDC 1F14       TFR   X,S
BFDE 8EBF49     LDX   #$BF49
BFE1 9F72       STX   <$72      ;soft reset vector
BFE3 7EC000     JMP   $C000
BFE6 7EC003     JMP   $C003

*** unused

$BFE9 to 
$BFF1

*** interrupt vectors

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