c64rom_en.txt

- Fully Commented Commodore 64 ROM Disassembly (English)
-
- CBMBASIC and KERNAL
-
- The comments have been taken from
-    The almost completely commented C64 ROM disassembly. V1.01 Lee Davison 2012
-
- The ROM is the 901227-03 version ($FF80 = 3).
-
- Converted and formatted by Michael Steil <mist64@mac.com>
-
- Corrections (typos, formatting, content) welcome at:
- https://github.com/mist64/c64rom
-
------------------------------------------------------------
-
# This plain text file is formatted so that it can be automatically
# parsed in order to create cross-references etc.
# * Lines starting with "-" is top-level information. The first line
#   is the title. Lines starting with "--" are separators.
# * Lines starting with "#" are internal comments.
# * Lines starting with ".," indicate code to be disassembled.
# * Lines starting with ".:" indicate bytes to be dumped.
# * Comments start at the 33rd column.
# * 32 leading spaces and "***" indicate a heading. (Please leave one
#   line blank above every heading.)
# * Otherwise, 32 leading spaces indicate an overflow comment.
# The encoding is UTF-8.

                                *** start of the BASIC ROM
.:A000 94 E3                    BASIC cold start entry point
.:A002 7B E3                    BASIC warm start entry point

.:A004 43 42 4D 42 41 53 49 43  'cbmbasic', ROM name, unreferenced

                                *** action addresses for primary commands
                                these are called by pushing the address onto the stack and doing an RTS so the
                                actual address -1 needs to be pushed
.:A00C 30 A8                    perform END     $80
.:A00E 41 A7                    perform FOR     $81
.:A010 1D AD                    perform NEXT    $82
.:A012 F7 A8                    perform DATA    $83
.:A014 A4 AB                    perform INPUT#  $84
.:A016 BE AB                    perform INPUT   $85
.:A018 80 B0                    perform DIM     $86
.:A01A 05 AC                    perform READ    $87
.:A01C A4 A9                    perform LET     $88
.:A01E 9F A8                    perform GOTO    $89
.:A020 70 A8                    perform RUN     $8A
.:A022 27 A9                    perform IF      $8B
.:A024 1C A8                    perform RESTORE $8C
.:A026 82 A8                    perform GOSUB   $8D
.:A028 D1 A8                    perform RETURN  $8E
.:A02A 3A A9                    perform REM     $8F
.:A02C 2E A8                    perform STOP    $90
.:A02E 4A A9                    perform ON      $91
.:A030 2C B8                    perform WAIT    $92
.:A032 67 E1                    perform LOAD    $93
.:A034 55 E1                    perform SAVE    $94
.:A036 64 E1                    perform VERIFY  $95
.:A038 B2 B3                    perform DEF     $96
.:A03A 23 B8                    perform POKE    $97
.:A03C 7F AA                    perform PRINT#  $98
.:A03E 9F AA                    perform PRINT   $99
.:A040 56 A8                    perform CONT    $9A
.:A042 9B A6                    perform LIST    $9B
.:A044 5D A6                    perform CLR     $9C
.:A046 85 AA                    perform CMD     $9D
.:A048 29 E1                    perform SYS     $9E
.:A04A BD E1                    perform OPEN    $9F
.:A04C C6 E1                    perform CLOSE   $A0
.:A04E 7A AB                    perform GET     $A1
.:A050 41 A6                    perform NEW     $A2

                                *** action addresses for functions
.:A052 39 BC                    perform SGN     $B4
.:A054 CC BC                    perform INT     $B5
.:A056 58 BC                    perform ABS     $B6
.:A058 10 03                    perform USR     $B7
.:A05A 7D B3                    perform FRE     $B8
.:A05C 9E B3                    perform POS     $B9
.:A05E 71 BF                    perform SQR     $BA
.:A060 97 E0                    perform RND     $BB
.:A062 EA B9                    perform LOG     $BC
.:A064 ED BF                    perform EXP     $BD
.:A066 64 E2                    perform COS     $BE
.:A068 6B E2                    perform SIN     $BF
.:A06A B4 E2                    perform TAN     $C0
.:A06C 0E E3                    perform ATN     $C1
.:A06E 0D B8                    perform PEEK    $C2
.:A070 7C B7                    perform LEN     $C3
.:A072 65 B4                    perform STR$    $C4
.:A074 AD B7                    perform VAL     $C5
.:A076 8B B7                    perform ASC     $C6
.:A078 EC B6                    perform CHR$    $C7
.:A07A 00 B7                    perform LEFT$   $C8
.:A07C 2C B7                    perform RIGHT$  $C9
.:A07E 37 B7                    perform MID$    $CA

                                *** precedence byte and action addresses for operators
                                like the primary commands these are called by pushing the address onto the stack
                                and doing an RTS, so again the actual address -1 needs to be pushed
.:A080 79 69 B8                 +
.:A083 79 52 B8                 -
.:A086 7B 2A BA                 *
.:A089 7B 11 BB                 /
.:A08C 7F 7A BF                 ^
.:A08F 50 E8 AF                 AND
.:A092 46 E5 AF                 OR
.:A095 7D B3 BF                 >
.:A098 5A D3 AE                 =
.:A09B 64 15 B0                 <

                                *** BASIC keywords
                                each word has b7 set in it's last character as an end marker, even
                                the one character keywords such as "<" or "="
                                first are the primary command keywords, only these can start a statement
.:A09E 45 4E                    end
.:A0A0 C4 46 4F D2 4E 45 58 D4  for next
.:A0A8 44 41 54 C1 49 4E 50 55  data input#
.:A0B0 54 A3 49 4E 50 55 D4 44  input dim
.:A0B8 49 CD 52 45 41 C4 4C 45  read let
.:A0C0 D4 47 4F 54 CF 52 55 CE  goto run
.:A0C8 49 C6 52 45 53 54 4F 52  if restore
.:A0D0 C5 47 4F 53 55 C2 52 45  gosub return
.:A0D8 54 55 52 CE 52 45 CD 53  rem stop
.:A0E0 54 4F D0 4F CE 57 41 49  on wait
.:A0E8 D4 4C 4F 41 C4 53 41 56  load save
.:A0F0 C5 56 45 52 49 46 D9 44  verify def
.:A0F8 45 C6 50 4F 4B C5 50 52  poke print#
.:A100 49 4E 54 A3 50 52 49 4E  print
.:A108 D4 43 4F 4E D4 4C 49 53  cont list
.:A110 D4 43 4C D2 43 4D C4 53  clr cmd sys
.:A118 59 D3 4F 50 45 CE 43 4C  open close
.:A120 4F 53 C5 47 45 D4 4E 45  get new

                                next are the secondary command keywords, these can not start a statement
.:A128 D7 54 41 42 A8 54 CF 46  tab( to
.:A130 CE 53 50 43 A8 54 48 45  spc( then
.:A138 CE 4E 4F D4 53 54 45 D0  not stop
                                next are the operators
.:A140 AB AD AA AF DE 41 4E C4  + - * / ' and
.:A148 4F D2 BE BD BC           or <=>
.:A14D                53 47 CE  sgn

                                and finally the functions
.:A150 49 4E D4 41 42 D3 55 53  int abs usr
.:A158 D2 46 52 C5 50 4F D3 53  fre pos sqr
.:A160 51 D2 52 4E C4 4C 4F C7  rnd log
.:A168 45 58 D0 43 4F D3 53 49  exp cos sin
.:A170 CE 54 41 CE 41 54 CE 50  tan atn peek
.:A178 45 45 CB 4C 45 CE 53 54  len str$
.:A180 52 A4 56 41 CC 41 53 C3  val asc
.:A188 43 48 52 A4 4C 45 46 54  chr$ left$
.:A190 A4 52 49 47 48 54 A4 4D  right$ mid$

                                lastly is GO, this is an add on so that GO TO, as well as GOTO, will work
.:A198 49 44 A4 47 CF           go
.:A19F 00                       end marker

                                *** BASIC error messages
.:A1A0 54 4F                    1 too many files
.:A1A0 4F 20 4D 41 4E 59 20 46
.:A1A8 49 4C 45 D3 46 49 4C 45  2 file open
.:A1B0 20 4F 50 45 CE 46 49 4C  3 file not open
.:A1B8 45 20 4E 4F 54 20 4F 50
.:A1C0 45 CE 46 49 4C 45 20 4E  4 file not found
.:A1C8 4F 54 20 46 4F 55 4E C4  5 device not present
.:A1D0 44 45 56 49 43 45 20 4E
.:A1D8 4F 54 20 50 52 45 53 45
.:A1E0 4E D4 4E 4F 54 20 49 4E  6 not input file
.:A1E8 50 55 54 20 46 49 4C C5
.:A1F0 4E 4F 54 20 4F 55 54 50  7 not output file
.:A1F8 55 54 20 46 49 4C C5 4D
.:A200 49 53 53 49 4E 47 20 46  8 missing filename
.:A208 49 4C 45 20 4E 41 4D C5
.:A210 49 4C 4C 45 47 41 4C 20  9 illegal device number
.:A218 44 45 56 49 43 45 20 4E
.:A220 55 4D 42 45 D2 4E 45 58  10 next without for
.:A228 54 20 57 49 54 48 4F 55
.:A230 54 20 46 4F D2 53 59 4E  11 syntax
.:A238 54 41 D8 52 45 54 55 52  12 return without gosub
.:A240 4E 20 57 49 54 48 4F 55
.:A248 54 20 47 4F 53 55 C2 4F  13 out of data
.:A250 55 54 20 4F 46 20 44 41
.:A258 54 C1 49 4C 4C 45 47 41  14 illegal quantity
.:A260 4C 20 51 55 41 4E 54 49
.:A268 54 D9 4F 56 45 52 46 4C  15 overflow
.:A270 4F D7 4F 55 54 20 4F 46  16 out of memory
.:A278 20 4D 45 4D 4F 52 D9 55  17 undef'd statement
.:A280 4E 44 45 46 27 44 20 53
.:A288 54 41 54 45 4D 45 4E D4
.:A290 42 41 44 20 53 55 42 53  18 bad subscript
.:A298 43 52 49 50 D4 52 45 44  19 redim'd array
.:A2A0 49 4D 27 44 20 41 52 52
.:A2A8 41 D9 44 49 56 49 53 49  20 division by zero
.:A2B0 4F 4E 20 42 59 20 5A 45
.:A2B8 52 CF 49 4C 4C 45 47 41  21 illegal direct
.:A2C0 4C 20 44 49 52 45 43 D4
.:A2C8 54 59 50 45 20 4D 49 53  22 type mismatch
.:A2D0 4D 41 54 43 C8 53 54 52  23 string too long
.:A2D8 49 4E 47 20 54 4F 4F 20
.:A2E0 4C 4F 4E C7 46 49 4C 45  24 file data
.:A2E8 20 44 41 54 C1 46 4F 52  25 formula too complex
.:A2F0 4D 55 4C 41 20 54 4F 4F
.:A2F8 20 43 4F 4D 50 4C 45 D8
.:A300 43 41 4E 27 54 20 43 4F  26 can't continue
.:A308 4E 54 49 4E 55 C5 55 4E  27 undef'd function
.:A310 44 45 46 27 44 20 46 55
.:A318 4E 43 54 49 4F CE 56 45  28 verify
.:A320 52 49 46 D9 4C 4F 41 C4  29 load

                                *** error message pointer table
.:A328 9E A1 AC A1 B5 A1 C2 A1
.:A330 D0 A1 E2 A1 F0 A1 FF A1
.:A338 10 A2 25 A2 35 A2 3B A2
.:A340 4F A2 5A A2 6A A2 72 A2
.:A348 7F A2 90 A2 9D A2 AA A2
.:A350 BA A2 C8 A2 D5 A2 E4 A2
.:A358 ED A2 00 A3 0E A3 1E A3
.:A360 24 A3 83 A3

                                *** BASIC messages
.:A364 0D 4F 4B 0D              OK
.:A368 00 20 20 45 52 52 4F 52  ERROR
.:A370 00 20 49 4E 20 00 0D 0A  IN
.:A378 52 45 41 44 59 2E 0D 0A  READY.
.:A380 00 0D 0A 42 52 45 41 4B  BREAK
.:A388 00

                                *** spare byte, not referenced
.:A389 A0                       unused

                                *** search the stack for FOR or GOSUB activity
                                return Zb=1 if FOR variable found
.,A38A BA       TSX             copy stack pointer
.,A38B E8       INX             +1 pass return address
.,A38C E8       INX             +2 pass return address
.,A38D E8       INX             +3 pass calling routine return address
.,A38E E8       INX             +4 pass calling routine return address
.,A38F BD 01 01 LDA $0101,X     get the token byte from the stack
.,A392 C9 81    CMP #$81        is it the FOR token
.,A394 D0 21    BNE $A3B7       if not FOR token just exit
                                it was the FOR token
.,A396 A5 4A    LDA $4A         get FOR/NEXT variable pointer high byte
.,A398 D0 0A    BNE $A3A4       branch if not null
.,A39A BD 02 01 LDA $0102,X     get FOR variable pointer low byte
.,A39D 85 49    STA $49         save FOR/NEXT variable pointer low byte
.,A39F BD 03 01 LDA $0103,X     get FOR variable pointer high byte
.,A3A2 85 4A    STA $4A         save FOR/NEXT variable pointer high byte
.,A3A4 DD 03 01 CMP $0103,X     compare variable pointer with stacked variable pointer
                                high byte
.,A3A7 D0 07    BNE $A3B0       branch if no match
.,A3A9 A5 49    LDA $49         get FOR/NEXT variable pointer low byte
.,A3AB DD 02 01 CMP $0102,X     compare variable pointer with stacked variable pointer
                                low byte
.,A3AE F0 07    BEQ $A3B7       exit if match found
.,A3B0 8A       TXA             copy index
.,A3B1 18       CLC             clear carry for add
.,A3B2 69 12    ADC #$12        add FOR stack use size
.,A3B4 AA       TAX             copy back to index
.,A3B5 D0 D8    BNE $A38F       loop if not at start of stack
.,A3B7 60       RTS             

                                *** open up a space in the memory, set the end of arrays
.,A3B8 20 08 A4 JSR $A408       check available memory, do out of memory error if no room
.,A3BB 85 31    STA $31         set end of arrays low byte
.,A3BD 84 32    STY $32         set end of arrays high byte
                                open up a space in the memory, don't set the array end
.,A3BF 38       SEC             set carry for subtract
.,A3C0 A5 5A    LDA $5A         get block end low byte
.,A3C2 E5 5F    SBC $5F         subtract block start low byte
.,A3C4 85 22    STA $22         save MOD(block length/$100) byte
.,A3C6 A8       TAY             copy MOD(block length/$100) byte to Y
.,A3C7 A5 5B    LDA $5B         get block end high byte
.,A3C9 E5 60    SBC $60         subtract block start high byte
.,A3CB AA       TAX             copy block length high byte to X
.,A3CC E8       INX             +1 to allow for count=0 exit
.,A3CD 98       TYA             copy block length low byte to A
.,A3CE F0 23    BEQ $A3F3       branch if length low byte=0
                                block is (X-1)*256+Y bytes, do the Y bytes first
.,A3D0 A5 5A    LDA $5A         get block end low byte
.,A3D2 38       SEC             set carry for subtract
.,A3D3 E5 22    SBC $22         subtract MOD(block length/$100) byte
.,A3D5 85 5A    STA $5A         save corrected old block end low byte
.,A3D7 B0 03    BCS $A3DC       branch if no underflow
.,A3D9 C6 5B    DEC $5B         else decrement block end high byte
.,A3DB 38       SEC             set carry for subtract
.,A3DC A5 58    LDA $58         get destination end low byte
.,A3DE E5 22    SBC $22         subtract MOD(block length/$100) byte
.,A3E0 85 58    STA $58         save modified new block end low byte
.,A3E2 B0 08    BCS $A3EC       branch if no underflow
.,A3E4 C6 59    DEC $59         else decrement block end high byte
.,A3E6 90 04    BCC $A3EC       branch always
.,A3E8 B1 5A    LDA ($5A),Y     get byte from source
.,A3EA 91 58    STA ($58),Y     copy byte to destination
.,A3EC 88       DEY             decrement index
.,A3ED D0 F9    BNE $A3E8       loop until Y=0
                                now do Y=0 indexed byte
.,A3EF B1 5A    LDA ($5A),Y     get byte from source
.,A3F1 91 58    STA ($58),Y     save byte to destination
.,A3F3 C6 5B    DEC $5B         decrement source pointer high byte
.,A3F5 C6 59    DEC $59         decrement destination pointer high byte
.,A3F7 CA       DEX             decrement block count
.,A3F8 D0 F2    BNE $A3EC       loop until count = $0
.,A3FA 60       RTS             

                                *** check room on stack for A bytes
                                if stack too deep do out of memory error
.,A3FB 0A       ASL             *2
.,A3FC 69 3E    ADC #$3E        need at least $3E bytes free
.,A3FE B0 35    BCS $A435       if overflow go do out of memory error then warm start
.,A400 85 22    STA $22         save result in temp byte
.,A402 BA       TSX             copy stack
.,A403 E4 22    CPX $22         compare new limit with stack
.,A405 90 2E    BCC $A435       if stack < limit do out of memory error then warm start
.,A407 60       RTS             

                                *** check available memory, do out of memory error if no room
.,A408 C4 34    CPY $34         compare with bottom of string space high byte
.,A40A 90 28    BCC $A434       if less then exit (is ok)
.,A40C D0 04    BNE $A412       skip next test if greater (tested <)
                                high byte was =, now do low byte
.,A40E C5 33    CMP $33         compare with bottom of string space low byte
.,A410 90 22    BCC $A434       if less then exit (is ok)
                                address is > string storage ptr (oops!)
.,A412 48       PHA             push address low byte
.,A413 A2 09    LDX #$09        set index to save $57 to $60 inclusive
.,A415 98       TYA             copy address high byte (to push on stack)
                                save misc numeric work area
.,A416 48       PHA             push byte
.,A417 B5 57    LDA $57,X       get byte from $57 to $60
.,A419 CA       DEX             decrement index
.,A41A 10 FA    BPL $A416       loop until all done
.,A41C 20 26 B5 JSR $B526       do garbage collection routine
                                restore misc numeric work area
.,A41F A2 F7    LDX #$F7        set index to restore bytes
.,A421 68       PLA             pop byte
.,A422 95 61    STA $61,X       save byte to $57 to $60
.,A424 E8       INX             increment index
.,A425 30 FA    BMI $A421       loop while -ve
.,A427 68       PLA             pop address high byte
.,A428 A8       TAY             copy back to Y
.,A429 68       PLA             pop address low byte
.,A42A C4 34    CPY $34         compare with bottom of string space high byte
.,A42C 90 06    BCC $A434       if less then exit (is ok)
.,A42E D0 05    BNE $A435       if greater do out of memory error then warm start
                                high byte was =, now do low byte
.,A430 C5 33    CMP $33         compare with bottom of string space low byte
.,A432 B0 01    BCS $A435       if >= do out of memory error then warm start
                                ok exit, carry clear
.,A434 60       RTS             

                                *** do out of memory error then warm start
.,A435 A2 10    LDX #$10        error code $10, out of memory error
                                do error #X then warm start
.,A437 6C 00 03 JMP ($0300)     do error message

                                *** do error #X then warm start, the error message vector is initialised to point here
.,A43A 8A       TXA             copy error number
.,A43B 0A       ASL             *2
.,A43C AA       TAX             copy to index
.,A43D BD 26 A3 LDA $A326,X     get error message pointer low byte
.,A440 85 22    STA $22         save it
.,A442 BD 27 A3 LDA $A327,X     get error message pointer high byte
.,A445 85 23    STA $23         save it
.,A447 20 CC FF JSR $FFCC       close input and output channels
.,A44A A9 00    LDA #$00        clear A
.,A44C 85 13    STA $13         clear current I/O channel, flag default
.,A44E 20 D7 AA JSR $AAD7       print CR/LF
.,A451 20 45 AB JSR $AB45       print "?"
.,A454 A0 00    LDY #$00        clear index
.,A456 B1 22    LDA ($22),Y     get byte from message
.,A458 48       PHA             save status
.,A459 29 7F    AND #$7F        mask 0xxx xxxx, clear b7
.,A45B 20 47 AB JSR $AB47       output character
.,A45E C8       INY             increment index
.,A45F 68       PLA             restore status
.,A460 10 F4    BPL $A456       loop if character was not end marker
.,A462 20 7A A6 JSR $A67A       flush BASIC stack and clear continue pointer
.,A465 A9 69    LDA #$69        set " ERROR" pointer low byte
.,A467 A0 A3    LDY #$A3        set " ERROR" pointer high byte

                                *** print string and do warm start, break entry
.,A469 20 1E AB JSR $AB1E       print null terminated string
.,A46C A4 3A    LDY $3A         get current line number high byte
.,A46E C8       INY             increment it
.,A46F F0 03    BEQ $A474       branch if was in immediate mode
.,A471 20 C2 BD JSR $BDC2       do " IN " line number message

                                *** do warm start
.,A474 A9 76    LDA #$76        set "READY." pointer low byte
.,A476 A0 A3    LDY #$A3        set "READY." pointer high byte
.,A478 20 1E AB JSR $AB1E       print null terminated string
.,A47B A9 80    LDA #$80        set for control messages only
.,A47D 20 90 FF JSR $FF90       control kernal messages
.,A480 6C 02 03 JMP ($0302)     do BASIC warm start

                                *** BASIC warm start, the warm start vector is initialised to point here
.,A483 20 60 A5 JSR $A560       call for BASIC input
.,A486 86 7A    STX $7A         save BASIC execute pointer low byte
.,A488 84 7B    STY $7B         save BASIC execute pointer high byte
.,A48A 20 73 00 JSR $0073       increment and scan memory
.,A48D AA       TAX             copy byte to set flags
.,A48E F0 F0    BEQ $A480       loop if no input
                                got to interpret the input line now ....
.,A490 A2 FF    LDX #$FF        current line high byte to -1, indicates immediate mode
.,A492 86 3A    STX $3A         set current line number high byte
.,A494 90 06    BCC $A49C       if numeric character go handle new BASIC line
                                no line number .. immediate mode
.,A496 20 79 A5 JSR $A579       crunch keywords into BASIC tokens
.,A499 4C E1 A7 JMP $A7E1       go scan and interpret code

                                *** handle new BASIC line
.,A49C 20 6B A9 JSR $A96B       get fixed-point number into temporary integer
.,A49F 20 79 A5 JSR $A579       crunch keywords into BASIC tokens
.,A4A2 84 0B    STY $0B         save index pointer to end of crunched line
.,A4A4 20 13 A6 JSR $A613       search BASIC for temporary integer line number
.,A4A7 90 44    BCC $A4ED       if not found skip the line delete
                                line # already exists so delete it
.,A4A9 A0 01    LDY #$01        set index to next line pointer high byte
.,A4AB B1 5F    LDA ($5F),Y     get next line pointer high byte
.,A4AD 85 23    STA $23         save it
.,A4AF A5 2D    LDA $2D         get start of variables low byte
.,A4B1 85 22    STA $22         save it
.,A4B3 A5 60    LDA $60         get found line pointer high byte
.,A4B5 85 25    STA $25         save it
.,A4B7 A5 5F    LDA $5F         get found line pointer low byte
.,A4B9 88       DEY             decrement index
.,A4BA F1 5F    SBC ($5F),Y     subtract next line pointer low byte
.,A4BC 18       CLC             clear carry for add
.,A4BD 65 2D    ADC $2D         add start of variables low byte
.,A4BF 85 2D    STA $2D         set start of variables low byte
.,A4C1 85 24    STA $24         save destination pointer low byte
.,A4C3 A5 2E    LDA $2E         get start of variables high byte
.,A4C5 69 FF    ADC #$FF        -1 + carry
.,A4C7 85 2E    STA $2E         set start of variables high byte
.,A4C9 E5 60    SBC $60         subtract found line pointer high byte
.,A4CB AA       TAX             copy to block count
.,A4CC 38       SEC             set carry for subtract
.,A4CD A5 5F    LDA $5F         get found line pointer low byte
.,A4CF E5 2D    SBC $2D         subtract start of variables low byte
.,A4D1 A8       TAY             copy to bytes in first block count
.,A4D2 B0 03    BCS $A4D7       branch if no underflow
.,A4D4 E8       INX             increment block count, correct for = 0 loop exit
.,A4D5 C6 25    DEC $25         decrement destination high byte
.,A4D7 18       CLC             clear carry for add
.,A4D8 65 22    ADC $22         add source pointer low byte
.,A4DA 90 03    BCC $A4DF       branch if no overflow
.,A4DC C6 23    DEC $23         else decrement source pointer high byte
.,A4DE 18       CLC             clear carry
                                close up memory to delete old line
.,A4DF B1 22    LDA ($22),Y     get byte from source
.,A4E1 91 24    STA ($24),Y     copy to destination
.,A4E3 C8       INY             increment index
.,A4E4 D0 F9    BNE $A4DF       while <> 0 do this block
.,A4E6 E6 23    INC $23         increment source pointer high byte
.,A4E8 E6 25    INC $25         increment destination pointer high byte
.,A4EA CA       DEX             decrement block count
.,A4EB D0 F2    BNE $A4DF       loop until all done
                                got new line in buffer and no existing same #
.,A4ED 20 59 A6 JSR $A659       reset execution to start, clear variables, flush stack
                                and return
.,A4F0 20 33 A5 JSR $A533       rebuild BASIC line chaining
.,A4F3 AD 00 02 LDA $0200       get first byte from buffer
.,A4F6 F0 88    BEQ $A480       if no line go do BASIC warm start
                                else insert line into memory
.,A4F8 18       CLC             clear carry for add
.,A4F9 A5 2D    LDA $2D         get start of variables low byte
.,A4FB 85 5A    STA $5A         save as source end pointer low byte
.,A4FD 65 0B    ADC $0B         add index pointer to end of crunched line
.,A4FF 85 58    STA $58         save as destination end pointer low byte
.,A501 A4 2E    LDY $2E         get start of variables high byte
.,A503 84 5B    STY $5B         save as source end pointer high byte
.,A505 90 01    BCC $A508       branch if no carry to high byte
.,A507 C8       INY             else increment high byte
.,A508 84 59    STY $59         save as destination end pointer high byte
.,A50A 20 B8 A3 JSR $A3B8       open up space in memory
                                most of what remains to do is copy the crunched line into the space opened up in memory,
                                however, before the crunched line comes the next line pointer and the line number. the
                                line number is retrieved from the temporary integer and stored in memory, this
                                overwrites the bottom two bytes on the stack. next the line is copied and the next line
                                pointer is filled with whatever was in two bytes above the line number in the stack.
                                this is ok because the line pointer gets fixed in the line chain re-build.
.,A50D A5 14    LDA $14         get line number low byte
.,A50F A4 15    LDY $15         get line number high byte
.,A511 8D FE 01 STA $01FE       save line number low byte before crunched line
.,A514 8C FF 01 STY $01FF       save line number high byte before crunched line
.,A517 A5 31    LDA $31         get end of arrays low byte
.,A519 A4 32    LDY $32         get end of arrays high byte
.,A51B 85 2D    STA $2D         set start of variables low byte
.,A51D 84 2E    STY $2E         set start of variables high byte
.,A51F A4 0B    LDY $0B         get index to end of crunched line
.,A521 88       DEY             -1
.,A522 B9 FC 01 LDA $01FC,Y     get byte from crunched line
.,A525 91 5F    STA ($5F),Y     save byte to memory
.,A527 88       DEY             decrement index
.,A528 10 F8    BPL $A522       loop while more to do
                                reset execution, clear variables, flush stack, rebuild BASIC chain and do warm start
.,A52A 20 59 A6 JSR $A659       reset execution to start, clear variables and flush stack
.,A52D 20 33 A5 JSR $A533       rebuild BASIC line chaining
.,A530 4C 80 A4 JMP $A480       go do BASIC warm start

                                *** rebuild BASIC line chaining
.,A533 A5 2B    LDA $2B         get start of memory low byte
.,A535 A4 2C    LDY $2C         get start of memory high byte
.,A537 85 22    STA $22         set line start pointer low byte
.,A539 84 23    STY $23         set line start pointer high byte
.,A53B 18       CLC             clear carry for add
.,A53C A0 01    LDY #$01        set index to pointer to next line high byte
.,A53E B1 22    LDA ($22),Y     get pointer to next line high byte
.,A540 F0 1D    BEQ $A55F       exit if null, [EOT]
.,A542 A0 04    LDY #$04        point to first code byte of line
                                there is always 1 byte + [EOL] as null entries are deleted
.,A544 C8       INY             next code byte
.,A545 B1 22    LDA ($22),Y     get byte
.,A547 D0 FB    BNE $A544       loop if not [EOL]
.,A549 C8       INY             point to byte past [EOL], start of next line
.,A54A 98       TYA             copy it
.,A54B 65 22    ADC $22         add line start pointer low byte
.,A54D AA       TAX             copy to X
.,A54E A0 00    LDY #$00        clear index, point to this line's next line pointer
.,A550 91 22    STA ($22),Y     set next line pointer low byte
.,A552 A5 23    LDA $23         get line start pointer high byte
.,A554 69 00    ADC #$00        add any overflow
.,A556 C8       INY             increment index to high byte
.,A557 91 22    STA ($22),Y     set next line pointer high byte
.,A559 86 22    STX $22         set line start pointer low byte
.,A55B 85 23    STA $23         set line start pointer high byte
.,A55D 90 DD    BCC $A53C       go do next line, branch always
.,A55F 60       RTS             
                                call for BASIC input
.,A560 A2 00    LDX #$00        set channel $00, keyboard
.,A562 20 12 E1 JSR $E112       input character from channel with error check
.,A565 C9 0D    CMP #$0D        compare with [CR]
.,A567 F0 0D    BEQ $A576       if [CR] set XY to $200 - 1, print [CR] and exit
                                character was not [CR]
.,A569 9D 00 02 STA $0200,X     save character to buffer
.,A56C E8       INX             increment buffer index
.,A56D E0 59    CPX #$59        compare with max+1
.,A56F 90 F1    BCC $A562       branch if < max+1
.,A571 A2 17    LDX #$17        error $17, string too long error
.,A573 4C 37 A4 JMP $A437       do error #X then warm start
.,A576 4C CA AA JMP $AACA       set XY to $200 - 1 and print [CR]

                                *** crunch BASIC tokens vector
.,A579 6C 04 03 JMP ($0304)     do crunch BASIC tokens

                                *** crunch BASIC tokens, the crunch BASIC tokens vector is initialised to point here
.,A57C A6 7A    LDX $7A         get BASIC execute pointer low byte
.,A57E A0 04    LDY #$04        set save index
.,A580 84 0F    STY $0F         clear open quote/DATA flag
.,A582 BD 00 02 LDA $0200,X     get a byte from the input buffer
.,A585 10 07    BPL $A58E       if b7 clear go do crunching
.,A587 C9 FF    CMP #$FF        compare with the token for PI, this toke is input
                                directly from the keyboard as the PI character
.,A589 F0 3E    BEQ $A5C9       if PI save byte then continue crunching
                                this is the bit of code that stops you being able to enter
                                some keywords as just single shifted characters. If this
                                dropped through you would be able to enter GOTO as just
                                [SHIFT]G
.,A58B E8       INX             increment read index
.,A58C D0 F4    BNE $A582       loop if more to do, branch always
.,A58E C9 20    CMP #$20        compare with [SPACE]
.,A590 F0 37    BEQ $A5C9       if [SPACE] save byte then continue crunching
.,A592 85 08    STA $08         save buffer byte as search character
.,A594 C9 22    CMP #$22        compare with quote character
.,A596 F0 56    BEQ $A5EE       if quote go copy quoted string
.,A598 24 0F    BIT $0F         get open quote/DATA token flag
.,A59A 70 2D    BVS $A5C9       branch if b6 of Oquote set, was DATA
                                go save byte then continue crunching
.,A59C C9 3F    CMP #$3F        compare with "?" character
.,A59E D0 04    BNE $A5A4       if not "?" continue crunching
.,A5A0 A9 99    LDA #$99        else the keyword token is $99, PRINT
.,A5A2 D0 25    BNE $A5C9       go save byte then continue crunching, branch always
.,A5A4 C9 30    CMP #$30        compare with "0"
.,A5A6 90 04    BCC $A5AC       branch if <, continue crunching
.,A5A8 C9 3C    CMP #$3C        compare with "<"
.,A5AA 90 1D    BCC $A5C9       if <, 0123456789:; go save byte then continue crunching
                                gets here with next character not numeric, ";" or ":"
.,A5AC 84 71    STY $71         copy save index
.,A5AE A0 00    LDY #$00        clear table pointer
.,A5B0 84 0B    STY $0B         clear word index
.,A5B2 88       DEYadjust for pre increment loop
.,A5B3 86 7A    STX $7A         save BASIC execute pointer low byte, buffer index
.,A5B5 CA       DEX             adjust for pre increment loop
.,A5B6 C8       INY             next table byte
.,A5B7 E8       INX             next buffer byte
.,A5B8 BD 00 02 LDA $0200,X     get byte from input buffer
.,A5BB 38       SEC             set carry for subtract
.,A5BC F9 9E A0 SBC $A09E,Y     subtract table byte
.,A5BF F0 F5    BEQ $A5B6       go compare next if match
.,A5C1 C9 80    CMP #$80        was it end marker match ?
.,A5C3 D0 30    BNE $A5F5       branch if not, not found keyword
                                actually this works even if the input buffer byte is the
                                end marker, i.e. a shifted character. As you can't enter
                                any keywords as a single shifted character, see above,
                                you can enter keywords in shorthand by shifting any
                                character after the first. so RETURN can be entered as
                                R[SHIFT]E, RE[SHIFT]T, RET[SHIFT]U or RETU[SHIFT]R.
                                RETUR[SHIFT]N however will not work because the [SHIFT]N
                                will match the RETURN end marker so the routine will try
                                to match the next character.
                                else found keyword
.,A5C5 05 0B    ORA $0B         OR with word index, +$80 in A makes token
.,A5C7 A4 71    LDY $71         restore save index
                                save byte then continue crunching
.,A5C9 E8       INXincrement buffer read index
.,A5CA C8       INY             increment save index
.,A5CB 99 FB 01 STA $01FB,Y     save byte to output
.,A5CE B9 FB 01 LDA $01FB,Y     get byte from output, set flags
.,A5D1 F0 36    BEQ $A609       branch if was null [EOL]
                                A holds the token here
.,A5D3 38       SEC             set carry for subtract
.,A5D4 E9 3A    SBC #$3A        subtract ":"
.,A5D6 F0 04    BEQ $A5DC       branch if it was (is now $00)
                                A now holds token-':'
.,A5D8 C9 49    CMP #$49        compare with the token for DATA-':'
.,A5DA D0 02    BNE $A5DE       if not DATA go try REM
                                token was : or DATA
.,A5DC 85 0F    STA $0F         save the token-$3A
.,A5DE 38       SEC             set carry for subtract
.,A5DF E9 55    SBC #$55        subtract the token for REM-':'
.,A5E1 D0 9F    BNE $A582       if wasn't REM crunch next bit of line
.,A5E3 85 08    STA $08         else was REM so set search for [EOL]
                                loop for "..." etc.
.,A5E5 BD 00 02 LDA $0200,X     get byte from input buffer
.,A5E8 F0 DF    BEQ $A5C9       if null [EOL] save byte then continue crunching
.,A5EA C5 08    CMP $08         compare with stored character
.,A5EC F0 DB    BEQ $A5C9       if match save byte then continue crunching
.,A5EE C8       INY             increment save index
.,A5EF 99 FB 01 STA $01FB,Y     save byte to output
.,A5F2 E8       INX             increment buffer index
.,A5F3 D0 F0    BNE $A5E5       loop while <> 0, should never reach 0
                                not found keyword this go
.,A5F5 A6 7A    LDX $7A         restore BASIC execute pointer low byte
.,A5F7 E6 0B    INC $0B         increment word index (next word)
                                now find end of this word in the table
.,A5F9 C8       INY             increment table index
.,A5FA B9 9D A0 LDA $A09D,Y     get table byte
.,A5FD 10 FA    BPL $A5F9       loop if not end of word yet
.,A5FF B9 9E A0 LDA $A09E,Y     get byte from keyword table
.,A602 D0 B4    BNE $A5B8       go test next word if not zero byte, end of table
                                reached end of table with no match
.,A604 BD 00 02 LDA $0200,X     restore byte from input buffer
.,A607 10 BE    BPL $A5C7       branch always, all unmatched bytes in the buffer are
                                $00 to $7F, go save byte in output and continue crunching
                                reached [EOL]
.,A609 99 FD 01 STA $01FD,Y     save [EOL]
.,A60C C6 7B    DEC $7B         decrement BASIC execute pointer high byte
.,A60E A9 FF    LDA #$FF        point to start of buffer-1
.,A610 85 7A    STA $7A         set BASIC execute pointer low byte
.,A612 60       RTS             

                                *** search BASIC for temporary integer line number
.,A613 A5 2B    LDA $2B         get start of memory low byte
.,A615 A6 2C    LDX $2C         get start of memory high byte

                                *** search Basic for temp integer line number from AX
                                returns carry set if found
.,A617 A0 01    LDY #$01        set index to next line pointer high byte
.,A619 85 5F    STA $5F         save low byte as current
.,A61B 86 60    STX $60         save high byte as current
.,A61D B1 5F    LDA ($5F),Y     get next line pointer high byte from address
.,A61F F0 1F    BEQ $A640       pointer was zero so done, exit
.,A621 C8       INY             increment index ...
.,A622 C8       INY             ... to line # high byte
.,A623 A5 15    LDA $15         get temporary integer high byte
.,A625 D1 5F    CMP ($5F),Y     compare with line # high byte
.,A627 90 18    BCC $A641       exit if temp < this line, target line passed
.,A629 F0 03    BEQ $A62E       go check low byte if =
.,A62B 88       DEY             else decrement index
.,A62C D0 09    BNE $A637       branch always
.,A62E A5 14    LDA $14         get temporary integer low byte
.,A630 88       DEY             decrement index to line # low byte
.,A631 D1 5F    CMP ($5F),Y     compare with line # low byte
.,A633 90 0C    BCC $A641       exit if temp < this line, target line passed
.,A635 F0 0A    BEQ $A641       exit if temp = (found line#)
                                not quite there yet
.,A637 88       DEY             decrement index to next line pointer high byte
.,A638 B1 5F    LDA ($5F),Y     get next line pointer high byte
.,A63A AA       TAX             copy to X
.,A63B 88       DEY             decrement index to next line pointer low byte
.,A63C B1 5F    LDA ($5F),Y     get next line pointer low byte
.,A63E B0 D7    BCS $A617       go search for line # in temporary integer
                                from AX, carry always set
.,A640 18       CLC             clear found flag
.,A641 60       RTS             

                                *** perform NEW
.,A642 D0 FD    BNE $A641       exit if following byte to allow syntax error
.,A644 A9 00    LDA #$00        clear A
.,A646 A8       TAY             clear index
.,A647 91 2B    STA ($2B),Y     clear pointer to next line low byte
.,A649 C8       INY             increment index
.,A64A 91 2B    STA ($2B),Y     clear pointer to next line high byte, erase program
.,A64C A5 2B    LDA $2B         get start of memory low byte
.,A64E 18       CLC             clear carry for add
.,A64F 69 02    ADC #$02        add null program length
.,A651 85 2D    STA $2D         set start of variables low byte
.,A653 A5 2C    LDA $2C         get start of memory high byte
.,A655 69 00    ADC #$00        add carry
.,A657 85 2E    STA $2E         set start of variables high byte

                                *** reset execute pointer and do CLR
.,A659 20 8E A6 JSR $A68E       set BASIC execute pointer to start of memory - 1
.,A65C A9 00    LDA #$00        set Zb for CLR entry

                                *** perform CLR
.,A65E D0 2D    BNE $A68D       exit if following byte to allow syntax error
.,A660 20 E7 FF JSR $FFE7       close all channels and files
.,A663 A5 37    LDA $37         get end of memory low byte
.,A665 A4 38    LDY $38         get end of memory high byte
.,A667 85 33    STA $33         set bottom of string space low byte, clear strings
.,A669 84 34    STY $34         set bottom of string space high byte
.,A66B A5 2D    LDA $2D         get start of variables low byte
.,A66D A4 2E    LDY $2E         get start of variables high byte
.,A66F 85 2F    STA $2F         set end of variables low byte, clear variables
.,A671 84 30    STY $30         set end of variables high byte
.,A673 85 31    STA $31         set end of arrays low byte, clear arrays
.,A675 84 32    STY $32         set end of arrays high byte

                                *** do RESTORE and clear stack
.,A677 20 1D A8 JSR $A81D       perform RESTORE

                                *** flush BASIC stack and clear the continue pointer
.,A67A A2 19    LDX #$19        get the descriptor stack start
.,A67C 86 16    STX $16         set the descriptor stack pointer
.,A67E 68       PLA             pull the return address low byte
.,A67F A8       TAY             copy it
.,A680 68       PLA             pull the return address high byte
.,A681 A2 FA    LDX #$FA        set the cleared stack pointer
.,A683 9A       TXS             set the stack
.,A684 48       PHA             push the return address high byte
.,A685 98       TYA             restore the return address low byte
.,A686 48       PHA             push the return address low byte
.,A687 A9 00    LDA #$00        clear A
.,A689 85 3E    STA $3E         clear the continue pointer high byte
.,A68B 85 10    STA $10         clear the subscript/FNX flag
.,A68D 60       RTS             

                                *** set BASIC execute pointer to start of memory - 1
.,A68E 18       CLC             clear carry for add
.,A68F A5 2B    LDA $2B         get start of memory low byte
.,A691 69 FF    ADC #$FF        add -1 low byte
.,A693 85 7A    STA $7A         set BASIC execute pointer low byte
.,A695 A5 2C    LDA $2C         get start of memory high byte
.,A697 69 FF    ADC #$FF        add -1 high byte
.,A699 85 7B    STA $7B         save BASIC execute pointer high byte
.,A69B 60       RTS             

                                *** perform LIST
.,A69C 90 06    BCC $A6A4       branch if next character not token (LIST n...)
.,A69E F0 04    BEQ $A6A4       branch if next character [NULL] (LIST)
.,A6A0 C9 AB    CMP #$AB        compare with token for -
.,A6A2 D0 E9    BNE $A68D       exit if not - (LIST -m)
                                LIST [[n][-m]]
                                this bit sets the n , if present, as the start and end
.,A6A4 20 6B A9 JSR $A96B       get fixed-point number into temporary integer
.,A6A7 20 13 A6 JSR $A613       search BASIC for temporary integer line number
.,A6AA 20 79 00 JSR $0079       scan memory
.,A6AD F0 0C    BEQ $A6BB       branch if no more chrs
                                this bit checks the - is present
.,A6AF C9 AB    CMP #$AB        compare with token for -
.,A6B1 D0 8E    BNE $A641       return if not "-" (will be SN error)
                                LIST [n]-m
                                the - was there so set m as the end value
.,A6B3 20 73 00 JSR $0073       increment and scan memory
.,A6B6 20 6B A9 JSR $A96B       get fixed-point number into temporary integer
.,A6B9 D0 86    BNE $A641       exit if not ok
.,A6BB 68       PLA             dump return address low byte, exit via warm start
.,A6BC 68       PLA             dump return address high byte
.,A6BD A5 14    LDA $14         get temporary integer low byte
.,A6BF 05 15    ORA $15         OR temporary integer high byte
.,A6C1 D0 06    BNE $A6C9       branch if start set
.,A6C3 A9 FF    LDA #$FF        set for -1
.,A6C5 85 14    STA $14         set temporary integer low byte
.,A6C7 85 15    STA $15         set temporary integer high byte
.,A6C9 A0 01    LDY #$01        set index for line
.,A6CB 84 0F    STY $0F         clear open quote flag
.,A6CD B1 5F    LDA ($5F),Y     get next line pointer high byte
.,A6CF F0 43    BEQ $A714       if null all done so exit
.,A6D1 20 2C A8 JSR $A82C       do CRTL-C check vector
.,A6D4 20 D7 AA JSR $AAD7       print CR/LF
.,A6D7 C8       INY             increment index for line
.,A6D8 B1 5F    LDA ($5F),Y     get line number low byte
.,A6DA AA       TAX             copy to X
.,A6DB C8       INY             increment index
.,A6DC B1 5F    LDA ($5F),Y     get line number high byte
.,A6DE C5 15    CMP $15         compare with temporary integer high byte
.,A6E0 D0 04    BNE $A6E6       branch if no high byte match
.,A6E2 E4 14    CPX $14         compare with temporary integer low byte
.,A6E4 F0 02    BEQ $A6E8       branch if = last line to do, < will pass next branch
                                else
.,A6E6 B0 2C    BCS $A714       if greater all done so exit
.,A6E8 84 49    STY $49         save index for line
.,A6EA 20 CD BD JSR $BDCD       print XA as unsigned integer
.,A6ED A9 20    LDA #$20        space is the next character
.,A6EF A4 49    LDY $49         get index for line
.,A6F1 29 7F    AND #$7F        mask top out bit of character
.,A6F3 20 47 AB JSR $AB47       go print the character
.,A6F6 C9 22    CMP #$22        was it " character
.,A6F8 D0 06    BNE $A700       if not skip the quote handle
                                we are either entering or leaving a pair of quotes
.,A6FA A5 0F    LDA $0F         get open quote flag
.,A6FC 49 FF    EOR #$FF        toggle it
.,A6FE 85 0F    STA $0F         save it back
.,A700 C8       INY             increment index
.,A701 F0 11    BEQ $A714       line too long so just bail out and do a warm start
.,A703 B1 5F    LDA ($5F),Y     get next byte
.,A705 D0 10    BNE $A717       if not [EOL] (go print character)
                                was [EOL]
.,A707 A8       TAY             else clear index
.,A708 B1 5F    LDA ($5F),Y     get next line pointer low byte
.,A70A AA       TAX             copy to X
.,A70B C8       INY             increment index
.,A70C B1 5F    LDA ($5F),Y     get next line pointer high byte
.,A70E 86 5F    STX $5F         set pointer to line low byte
.,A710 85 60    STA $60         set pointer to line high byte
.,A712 D0 B5    BNE $A6C9       go do next line if not [EOT]
                                else ...
.,A714 4C 86 E3 JMP $E386       do warm start
.,A717 6C 06 03 JMP ($0306)     do uncrunch BASIC tokens

                                *** uncrunch BASIC tokens, the uncrunch BASIC tokens vector is initialised to point here
.,A71A 10 D7    BPL $A6F3       just go print it if not token byte
                                else was token byte so uncrunch it
.,A71C C9 FF    CMP #$FF        compare with the token for PI. in this case the token
                                is the same as the PI character so it just needs printing
.,A71E F0 D3    BEQ $A6F3       just print it if so
.,A720 24 0F    BIT $0F         test the open quote flag
.,A722 30 CF    BMI $A6F3       just go print character if open quote set
.,A724 38       SEC             else set carry for subtract
.,A725 E9 7F    SBC #$7F        reduce token range to 1 to whatever
.,A727 AA       TAX             copy token # to X
.,A728 84 49    STY $49         save index for line
.,A72A A0 FF    LDY #$FF        start from -1, adjust for pre increment
.,A72C CA       DEX             decrement token #
.,A72D F0 08    BEQ $A737       if now found go do printing
.,A72F C8       INY             else increment index
.,A730 B9 9E A0 LDA $A09E,Y     get byte from keyword table
.,A733 10 FA    BPL $A72F       loop until keyword end marker
.,A735 30 F5    BMI $A72C       go test if this is required keyword, branch always
                                found keyword, it's the next one
.,A737 C8       INY             increment keyword table index
.,A738 B9 9E A0 LDA $A09E,Y     get byte from table
.,A73B 30 B2    BMI $A6EF       go restore index, mask byte and print if
                                byte was end marker
.,A73D 20 47 AB JSR $AB47       else go print the character
.,A740 D0 F5    BNE $A737       go get next character, branch always

                                *** perform FOR
.,A742 A9 80    LDA #$80        set FNX
.,A744 85 10    STA $10         set subscript/FNX flag
.,A746 20 A5 A9 JSR $A9A5       perform LET
.,A749 20 8A A3 JSR $A38A       search the stack for FOR or GOSUB activity
.,A74C D0 05    BNE $A753       branch if FOR, this variable, not found
                                FOR, this variable, was found so first we dump the old one
.,A74E 8A       TXA             copy index
.,A74F 69 0F    ADC #$0F        add FOR structure size-2
.,A751 AA       TAX             copy to index
.,A752 9A       TXS             set stack (dump FOR structure (-2 bytes))
.,A753 68       PLA             pull return address
.,A754 68       PLA             pull return address
.,A755 A9 09    LDA #$09        we need 18d bytes !
.,A757 20 FB A3 JSR $A3FB       check room on stack for 2*A bytes
.,A75A 20 06 A9 JSR $A906       scan for next BASIC statement ([:] or [EOL])
.,A75D 18       CLC             clear carry for add
.,A75E 98       TYA             copy index to A
.,A75F 65 7A    ADC $7A         add BASIC execute pointer low byte
.,A761 48       PHA             push onto stack
.,A762 A5 7B    LDA $7B         get BASIC execute pointer high byte
.,A764 69 00    ADC #$00        add carry
.,A766 48       PHA             push onto stack
.,A767 A5 3A    LDA $3A         get current line number high byte
.,A769 48       PHA             push onto stack
.,A76A A5 39    LDA $39         get current line number low byte
.,A76C 48       PHA             push onto stack
.,A76D A9 A4    LDA #$A4        set "TO" token
.,A76F 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,A772 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,A775 20 8A AD JSR $AD8A       evaluate expression and check is numeric, else do
                                type mismatch
.,A778 A5 66    LDA $66         get FAC1 sign (b7)
.,A77A 09 7F    ORA #$7F        set all non sign bits
.,A77C 25 62    AND $62         and FAC1 mantissa 1
.,A77E 85 62    STA $62         save FAC1 mantissa 1
.,A780 A9 8B    LDA #$8B        set return address low byte
.,A782 A0 A7    LDY #$A7        set return address high byte
.,A784 85 22    STA $22         save return address low byte
.,A786 84 23    STY $23         save return address high byte
.,A788 4C 43 AE JMP $AE43       round FAC1 and put on stack, returns to next instruction
.,A78B A9 BC    LDA #$BC        set 1 pointer low address, default step size
.,A78D A0 B9    LDY #$B9        set 1 pointer high address
.,A78F 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1
.,A792 20 79 00 JSR $0079       scan memory
.,A795 C9 A9    CMP #$A9        compare with STEP token
.,A797 D0 06    BNE $A79F       if not "STEP" continue
                                was step so ....
.,A799 20 73 00 JSR $0073       increment and scan memory
.,A79C 20 8A AD JSR $AD8A       evaluate expression and check is numeric, else do
                                type mismatch
.,A79F 20 2B BC JSR $BC2B       get FAC1 sign, return A = $FF -ve, A = $01 +ve
.,A7A2 20 38 AE JSR $AE38       push sign, round FAC1 and put on stack
.,A7A5 A5 4A    LDA $4A         get FOR/NEXT variable pointer high byte
.,A7A7 48       PHA             push on stack
.,A7A8 A5 49    LDA $49         get FOR/NEXT variable pointer low byte
.,A7AA 48       PHA             push on stack
.,A7AB A9 81    LDA #$81        get FOR token
.,A7AD 48       PHA             push on stack

                                *** interpreter inner loop
.,A7AE 20 2C A8 JSR $A82C       do CRTL-C check vector
.,A7B1 A5 7A    LDA $7A         get the BASIC execute pointer low byte
.,A7B3 A4 7B    LDY $7B         get the BASIC execute pointer high byte
.,A7B5 C0 02    CPY #$02        compare the high byte with $02xx
.,A7B7 EA       NOP             unused byte
.,A7B8 F0 04    BEQ $A7BE       if immediate mode skip the continue pointer save
.,A7BA 85 3D    STA $3D         save the continue pointer low byte
.,A7BC 84 3E    STY $3E         save the continue pointer high byte
.,A7BE A0 00    LDY #$00        clear the index
.,A7C0 B1 7A    LDA ($7A),Y     get a BASIC byte
.,A7C2 D0 43    BNE $A807       if not [EOL] go test for ":"
.,A7C4 A0 02    LDY #$02        else set the index
.,A7C6 B1 7A    LDA ($7A),Y     get next line pointer high byte
.,A7C8 18       CLC             clear carry for no "BREAK" message
.,A7C9 D0 03    BNE $A7CE       branch if not end of program
.,A7CB 4C 4B A8 JMP $A84B       else go to immediate mode,was immediate or [EOT] marker
.,A7CE C8       INY             increment index
.,A7CF B1 7A    LDA ($7A),Y     get line number low byte
.,A7D1 85 39    STA $39         save current line number low byte
.,A7D3 C8       INY             increment index
.,A7D4 B1 7A    LDA ($7A),Y     get line # high byte
.,A7D6 85 3A    STA $3A         save current line number high byte
.,A7D8 98       TYA             A now = 4
.,A7D9 65 7A    ADC $7A         add BASIC execute pointer low byte, now points to code
.,A7DB 85 7A    STA $7A         save BASIC execute pointer low byte
.,A7DD 90 02    BCC $A7E1       branch if no overflow
.,A7DF E6 7B    INC $7B         else increment BASIC execute pointer high byte
.,A7E1 6C 08 03 JMP ($0308)     do start new BASIC code

                                *** start new BASIC code, the start new BASIC code vector is initialised to point here
.,A7E4 20 73 00 JSR $0073       increment and scan memory
.,A7E7 20 ED A7 JSR $A7ED       go interpret BASIC code from BASIC execute pointer
.,A7EA 4C AE A7 JMP $A7AE       loop

                                *** go interpret BASIC code from BASIC execute pointer
.,A7ED F0 3C    BEQ $A82B       if the first byte is null just exit
.,A7EF E9 80    SBC #$80        normalise the token
.,A7F1 90 11    BCC $A804       if wasn't token go do LET
.,A7F3 C9 23    CMP #$23        compare with token for TAB(-$80
.,A7F5 B0 17    BCS $A80E       branch if >= TAB(
.,A7F7 0A       ASL             *2 bytes per vector
.,A7F8 A8       TAY             copy to index
.,A7F9 B9 0D A0 LDA $A00D,Y     get vector high byte
.,A7FC 48       PHA             push on stack
.,A7FD B9 0C A0 LDA $A00C,Y     get vector low byte
.,A800 48       PHA             push on stack
.,A801 4C 73 00 JMP $0073       increment and scan memory and return. the return in
                                this case calls the command code, the return from
                                that will eventually return to the interpreter inner
                                loop above
.,A804 4C A5 A9 JMP $A9A5       perform LET
                                was not [EOL]
.,A807 C9 3A    CMP #$3A        comapre with ":"
.,A809 F0 D6    BEQ $A7E1       if ":" go execute new code
                                else ...
.,A80B 4C 08 AF JMP $AF08       do syntax error then warm start
                                token was >= TAB(
.,A80E C9 4B    CMP #$4B        compare with the token for GO
.,A810 D0 F9    BNE $A80B       if not "GO" do syntax error then warm start
                                else was "GO"
.,A812 20 73 00 JSR $0073       increment and scan memory
.,A815 A9 A4    LDA #$A4        set "TO" token
.,A817 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,A81A 4C A0 A8 JMP $A8A0       perform GOTO

                                *** perform RESTORE
.,A81D 38       SEC             set carry for subtract
.,A81E A5 2B    LDA $2B         get start of memory low byte
.,A820 E9 01    SBC #$01        -1
.,A822 A4 2C    LDY $2C         get start of memory high byte
.,A824 B0 01    BCS $A827branch if no rollunder
.,A826 88       DEY             else decrement high byte
.,A827 85 41    STA $41         set DATA pointer low byte
.,A829 84 42    STY $42         set DATA pointer high byte
.,A82B 60       RTS             

                                *** do CRTL-C check vector
.,A82C 20 E1 FF JSR $FFE1       scan stop key

                                *** perform STOP
.,A82F B0 01    BCS $A832       if carry set do BREAK instead of just END

                                *** perform END
.,A831 18       CLC             clear carry
.,A832 D0 3C    BNE $A870       return if wasn't CTRL-C
.,A834 A5 7A    LDA $7A         get BASIC execute pointer low byte
.,A836 A4 7B    LDY $7B         get BASIC execute pointer high byte
.,A838 A6 3A    LDX $3A         get current line number high byte
.,A83A E8       INX             increment it
.,A83B F0 0C    BEQ $A849       branch if was immediate mode
.,A83D 85 3D    STA $3D         save continue pointer low byte
.,A83F 84 3E    STY $3E         save continue pointer high byte
.,A841 A5 39    LDA $39         get current line number low byte
.,A843 A4 3A    LDY $3A         get current line number high byte
.,A845 85 3B    STA $3B         save break line number low byte
.,A847 84 3C    STY $3C         save break line number high byte
.,A849 68       PLA             dump return address low byte
.,A84A 68       PLA             dump return address high byte
.,A84B A9 81    LDA #$81        set [CR][LF]"BREAK" pointer low byte
.,A84D A0 A3    LDY #$A3        set [CR][LF]"BREAK" pointer high byte
.,A84F 90 03    BCC $A854       if was program end skip the print string
.,A851 4C 69 A4 JMP $A469       print string and do warm start
.,A854 4C 86 E3 JMP $E386       do warm start

                                *** perform CONT
.,A857 D0 17    BNE $A870       exit if following byte to allow syntax error
.,A859 A2 1A    LDX #$1A        error code $1A, can't continue error
.,A85B A4 3E    LDY $3E         get continue pointer high byte
.,A85D D0 03    BNE $A862       go do continue if we can
.,A85F 4C 37 A4 JMP $A437       else do error #X then warm start
                                we can continue so ...
.,A862 A5 3D    LDA $3D         get continue pointer low byte
.,A864 85 7A    STA $7A         save BASIC execute pointer low byte
.,A866 84 7B    STY $7B         save BASIC execute pointer high byte
.,A868 A5 3B    LDA $3B         get break line low byte
.,A86A A4 3C    LDY $3C         get break line high byte
.,A86C 85 39    STA $39         set current line number low byte
.,A86E 84 3A    STY $3A         set current line number high byte
.,A870 60       RTS             

                                *** perform RUN
.,A871 08       PHP             save status
.,A872 A9 00    LDA #$00        no control or kernal messages
.,A874 20 90 FF JSR $FF90       control kernal messages
.,A877 28       PLP             restore status
.,A878 D0 03    BNE $A87D       branch if RUN n
.,A87A 4C 59 A6 JMP $A659       reset execution to start, clear variables, flush stack
                                and return
.,A87D 20 60 A6 JSR $A660       go do "CLEAR"
.,A880 4C 97 A8 JMP $A897       get n and do GOTO n

                                *** perform GOSUB
.,A883 A9 03    LDA #$03        need 6 bytes for GOSUB
.,A885 20 FB A3 JSR $A3FB       check room on stack for 2*A bytes
.,A888 A5 7B    LDA $7B         get BASIC execute pointer high byte
.,A88A 48       PHA             save it
.,A88B A5 7A    LDA $7A         get BASIC execute pointer low byte
.,A88D 48       PHA             save it
.,A88E A5 3A    LDA $3A         get current line number high byte
.,A890 48       PHA             save it
.,A891 A5 39    LDA $39         get current line number low byte
.,A893 48       PHA             save it
.,A894 A9 8D    LDA #$8D        token for GOSUB
.,A896 48       PHA             save it
.,A897 20 79 00 JSR $0079       scan memory
.,A89A 20 A0 A8 JSR $A8A0       perform GOTO
.,A89D 4C AE A7 JMP $A7AE       go do interpreter inner loop

                                *** perform GOTO
.,A8A0 20 6B A9 JSR $A96B       get fixed-point number into temporary integer
.,A8A3 20 09 A9 JSR $A909       scan for next BASIC line
.,A8A6 38       SEC             set carry for subtract
.,A8A7 A5 39    LDA $39         get current line number low byte
.,A8A9 E5 14    SBC $14         subtract temporary integer low byte
.,A8AB A5 3A    LDA $3A         get current line number high byte
.,A8AD E5 15    SBC $15         subtract temporary integer high byte
.,A8AF B0 0B    BCS $A8BC       if current line number >= temporary integer, go search
                                from the start of memory
.,A8B1 98       TYA             else copy line index to A
.,A8B2 38       SEC             set carry (+1)
.,A8B3 65 7A    ADC $7A         add BASIC execute pointer low byte
.,A8B5 A6 7B    LDX $7B         get BASIC execute pointer high byte
.,A8B7 90 07    BCC $A8C0       branch if no overflow to high byte
.,A8B9 E8       INX             increment high byte
.,A8BA B0 04    BCS $A8C0       branch always (can never be carry)

                                *** search for line number in temporary integer from start of memory pointer
.,A8BC A5 2B    LDA $2B         get start of memory low byte
.,A8BE A6 2C    LDX $2Cget start of memory high byte

                                *** search for line # in temporary integer from (AX)
.,A8C0 20 17 A6 JSR $A617       search Basic for temp integer line number from AX
.,A8C3 90 1E    BCC $A8E3       if carry clear go do unsdefined statement error
                                carry all ready set for subtract
.,A8C5 A5 5F    LDA $5F         get pointer low byte
.,A8C7 E9 01    SBC #$01        -1
.,A8C9 85 7A    STA $7A         save BASIC execute pointer low byte
.,A8CB A5 60    LDA $60         get pointer high byte
.,A8CD E9 00    SBC #$00        subtract carry
.,A8CF 85 7B    STA $7B         save BASIC execute pointer high byte
.,A8D1 60       RTS             

                                *** perform RETURN
.,A8D2 D0 FD    BNE $A8D1       exit if following token to allow syntax error
.,A8D4 A9 FF    LDA #$FF        set byte so no match possible
.,A8D6 85 4A    STA $4A         save FOR/NEXT variable pointer high byte
.,A8D8 20 8A A3 JSR $A38A       search the stack for FOR or GOSUB activity,
                                get token off stack
.,A8DB 9A       TXScorrect the stack
.,A8DC C9 8D    CMP #$8D        compare with GOSUB token
.,A8DE F0 0B    BEQ $A8EB       if matching GOSUB go continue RETURN
.,A8E0 A2 0C    LDX #$0C        else error code $04, return without gosub error
.:A8E2 2C       .BYTE $2C       makes next line BIT $11A2
.,A8E3 A2 11    LDX #$02        error code $11, undefined statement error
.,A8E5 4C 37 A4 JMP $A437       do error #X then warm start
.,A8E8 4C 08 AF JMP $AF08       do syntax error then warm start
                                was matching GOSUB token
.,A8EB 68       PLA             dump token byte
.,A8EC 68       PLA             pull return line low byte
.,A8ED 85 39    STA $39         save current line number low byte
.,A8EF 68       PLA             pull return line high byte
.,A8F0 85 3A    STA $3A         save current line number high byte
.,A8F2 68       PLA             pull return address low byte
.,A8F3 85 7A    STA $7A         save BASIC execute pointer low byte
.,A8F5 68       PLA             pull return address high byte
.,A8F6 85 7B    STA $7B         save BASIC execute pointer high byte

                                *** perform DATA
.,A8F8 20 06 A9 JSR $A906       scan for next BASIC statement ([:] or [EOL])

                                *** add Y to the BASIC execute pointer
.,A8FB 98       TYA             copy index to A
.,A8FC 18       CLC             clear carry for add
.,A8FD 65 7A    ADC $7A         add BASIC execute pointer low byte
.,A8FF 85 7A    STA $7A         save BASIC execute pointer low byte
.,A901 90 02    BCC $A905       skip increment if no carry
.,A903 E6 7B    INC $7B         else increment BASIC execute pointer high byte
.,A905 60       RTS             

                                *** scan for next BASIC statement ([:] or [EOL])
                                returns Y as index to [:] or [EOL]
.,A906 A2 3A    LDX #$3A        set look for character = ":"
.:A908 2C       .BYTE $2C       makes next line BIT $00A2

                                *** scan for next BASIC line
                                returns Y as index to [EOL]
.,A909 A2 00    LDX #$00        set alternate search character = [EOL]
.,A90B 86 07    STX $07         store alternate search character
.,A90D A0 00    LDY #$00        set search character = [EOL]
.,A90F 84 08    STY $08         save the search character
.,A911 A5 08    LDA $08         get search character
.,A913 A6 07    LDX $07         get alternate search character
.,A915 85 07    STA $07         make search character = alternate search character
.,A917 86 08    STX $08         make alternate search character = search character
.,A919 B1 7A    LDA ($7A),Y     get BASIC byte
.,A91B F0 E8    BEQ $A905       exit if null [EOL]
.,A91D C5 08    CMP $08         compare with search character
.,A91F F0 E4    BEQ $A905       exit if found
.,A921 C8       INY             else increment index
.,A922 C9 22    CMP #$22        compare current character with open quote
.,A924 D0 F3    BNE $A919       if found go swap search character for alternate search
                                character
.,A926 F0 E9    BEQ $A911       loop for next character, branch always

                                *** perform IF
.,A928 20 9E AD JSR $AD9E       evaluate expression
.,A92B 20 79 00 JSR $0079       scan memory
.,A92E C9 89    CMP #$89        compare with "GOTO" token
.,A930 F0 05    BEQ $A937       if it was  the token for GOTO go do IF ... GOTO
                                wasn't IF ... GOTO so must be IF ... THEN
.,A932 A9 A7    LDA #$A7        set "THEN" token
.,A934 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,A937 A5 61    LDA $61         get FAC1 exponent
.,A939 D0 05    BNE $A940       if result was non zero continue execution
                                else REM rest of line

                                *** perform REM
.,A93B 20 09 A9 JSR $A909       scan for next BASIC line
.,A93E F0 BB    BEQ $A8FB       add Y to the BASIC execute pointer and return, branch
                                always
                                result was non zero so do rest of line
.,A940 20 79 00 JSR $0079       scan memory
.,A943 B0 03    BCS $A948       branch if not numeric character, is variable or keyword
.,A945 4C A0 A8 JMP $A8A0       else perform GOTO n
                                is variable or keyword
.,A948 4C ED A7 JMP $A7ED       interpret BASIC code from BASIC execute pointer

                                *** perform ON
.,A94B 20 9E B7 JSR $B79E       get byte parameter
.,A94E 48       PHA             push next character
.,A94F C9 8D    CMP #$8D        compare with GOSUB token
.,A951 F0 04    BEQ $A957       if GOSUB go see if it should be executed
.,A953 C9 89    CMP #$89        compare with GOTO token
.,A955 D0 91    BNE $A8E8       if not GOTO do syntax error then warm start
                                next character was GOTO or GOSUB, see if it should be executed
.,A957 C6 65    DEC $65         decrement the byte value
.,A959 D0 04    BNE $A95F       if not zero go see if another line number exists
.,A95B 68       PLA             pull keyword token
.,A95C 4C EF A7 JMP $A7EF       go execute it
.,A95F 20 73 00 JSR $0073       increment and scan memory
.,A962 20 6B A9 JSR $A96B       get fixed-point number into temporary integer
                                skip this n
.,A965 C9 2C    CMP #$2C        compare next character with ","
.,A967 F0 EE    BEQ $A957       loop if ","
.,A969 68       PLA             else pull keyword token, ran out of options
.,A96A 60       RTS             

                                *** get fixed-point number into temporary integer
.,A96B A2 00    LDX #$00        clear X
.,A96D 86 14    STX $14         clear temporary integer low byte
.,A96F 86 15    STX $15         clear temporary integer high byte
.,A971 B0 F7    BCS $A96A       return if carry set, end of scan, character was not 0-9
.,A973 E9 2F    SBC #$2F        subtract $30, $2F+carry, from byte
.,A975 85 07    STA $07         store #
.,A977 A5 15    LDA $15         get temporary integer high byte
.,A979 85 22    STA $22         save it for now
.,A97B C9 19    CMP #$19        compare with $19
.,A97D B0 D4    BCS $A953       branch if >= this makes the maximum line number 63999
                                because the next bit does $1900 * $0A = $FA00 = 64000
                                decimal. the branch target is really the SYNTAX error
                                at $A8E8 but that is too far so an intermediate
                                compare and branch to that location is used. the problem
                                with this is that line number that gives a partial result
                                from $8900 to $89FF, 35072x to 35327x, will pass the new
                                target compare and will try to execute the remainder of
                                the ON n GOTO/GOSUB. a solution to this is to copy the
                                byte in A before the branch to X and then branch to
                                $A955 skipping the second compare
.,A97F A5 14    LDA $14         get temporary integer low byte
.,A981 0A       ASL             *2 low byte
.,A982 26 22    ROL $22         *2 high byte
.,A984 0A       ASL             *2 low byte
.,A985 26 22    ROL $22         *2 high byte (*4)
.,A987 65 14    ADC $14         + low byte (*5)
.,A989 85 14    STA $14         save it
.,A98B A5 22    LDA $22         get high byte temp
.,A98D 65 15    ADC $15         + high byte (*5)
.,A98F 85 15    STA $15         save it
.,A991 06 14    ASL $14         *2 low byte (*10d)
.,A993 26 15    ROL $15         *2 high byte (*10d)
.,A995 A5 14    LDA $14         get low byte
.,A997 65 07    ADC $07         add #
.,A999 85 14    STA $14         save low byte
.,A99B 90 02    BCC $A99F       branch if no overflow to high byte
.,A99D E6 15    INC $15         else increment high byte
.,A99F 20 73 00 JSR $0073       increment and scan memory
.,A9A2 4C 71 A9 JMP $A971       loop for next character

                                *** perform LET
.,A9A5 20 8B B0 JSR $B08B       get variable address
.,A9A8 85 49    STA $49         save variable address low byte
.,A9AA 84 4A    STY $4A         save variable address high byte
.,A9AC A9 B2    LDA #$B2        $B2 is "=" token
.,A9AE 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,A9B1 A5 0E    LDA $0E         get data type flag, $80 = integer, $00 = float
.,A9B3 48       PHA             push data type flag
.,A9B4 A5 0D    LDA $0D         get data type flag, $FF = string, $00 = numeric
.,A9B6 48       PHA             push data type flag
.,A9B7 20 9E AD JSR $AD9E       evaluate expression
.,A9BA 68       PLA             pop data type flag
.,A9BB 2A       ROL             string bit into carry
.,A9BC 20 90 AD JSR $AD90       do type match check
.,A9BF D0 18    BNE $A9D9       branch if string
.,A9C1 68       PLA             pop integer/float data type flag
                                assign value to numeric variable
.,A9C2 10 12    BPL $A9D6       branch if float
                                expression is numeric integer
.,A9C4 20 1B BC JSR $BC1B       round FAC1
.,A9C7 20 BF B1 JSR $B1BF       evaluate integer expression, no sign check
.,A9CA A0 00    LDY #$00        clear index
.,A9CC A5 64    LDA $64         get FAC1 mantissa 3
.,A9CE 91 49    STA ($49),Y     save as integer variable low byte
.,A9D0 C8       INY             increment index
.,A9D1 A5 65    LDA $65         get FAC1 mantissa 4
.,A9D3 91 49    STA ($49),Y     save as integer variable high byte
.,A9D5 60       RTS             
.,A9D6 4C D0 BB JMP $BBD0       pack FAC1 into variable pointer and return
                                assign value to numeric variable
.,A9D9 68       PLA             dump integer/float data type flag
.,A9DA A4 4A    LDY $4A         get variable pointer high byte
.,A9DC C0 BF    CPY #$BF        was it TI$ pointer
.,A9DE D0 4C    BNE $AA2C       branch if not
                                else it's TI$ = <expr$>
.,A9E0 20 A6 B6 JSR $B6A6       pop string off descriptor stack, or from top of string
                                space returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,A9E3 C9 06    CMP #$06        compare length with 6
.,A9E5 D0 3D    BNE $AA24       if length not 6 do illegal quantity error then warm start
.,A9E7 A0 00    LDY #$00        clear index
.,A9E9 84 61    STY $61         clear FAC1 exponent
.,A9EB 84 66    STY $66         clear FAC1 sign (b7)
.,A9ED 84 71    STY $71         save index
.,A9EF 20 1D AA JSR $AA1D       check and evaluate numeric digit
.,A9F2 20 E2 BA JSR $BAE2       multiply FAC1 by 10
.,A9F5 E6 71    INC $71         increment index
.,A9F7 A4 71    LDY $71         restore index
.,A9F9 20 1D AA JSR $AA1D       check and evaluate numeric digit
.,A9FC 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,A9FF AA       TAX             copy FAC1 exponent
.,AA00 F0 05    BEQ $AA07       branch if FAC1 zero
.,AA02 E8       INX             increment index, * 2
.,AA03 8A       TXA             copy back to A
.,AA04 20 ED BA JSR $BAED       FAC1 = (FAC1 + (FAC2 * 2)) * 2 = FAC1 * 6
.,AA07 A4 71    LDY $71         get index
.,AA09 C8       INY             increment index
.,AA0A C0 06    CPY #$06        compare index with 6
.,AA0C D0 DF    BNE $A9ED       loop if not 6
.,AA0E 20 E2 BA JSR $BAE2       multiply FAC1 by 10
.,AA11 20 9B BC JSR $BC9B       convert FAC1 floating to fixed
.,AA14 A6 64    LDX $64         get FAC1 mantissa 3
.,AA16 A4 63    LDY $63         get FAC1 mantissa 2
.,AA18 A5 65    LDA $65         get FAC1 mantissa 4
.,AA1A 4C DB FF JMP $FFDB       set real time clock and return

                                *** check and evaluate numeric digit
.,AA1D B1 22    LDA ($22),Y     get byte from string
.,AA1F 20 80 00 JSR $0080       clear Cb if numeric. this call should be to $84
                                as the code from $80 first comapres the byte with
                                [SPACE] and does a BASIC increment and get if it is
.,AA22 90 03    BCC $AA27       branch if numeric
.,AA24 4C 48 B2 JMP $B248       do illegal quantity error then warm start
.,AA27 E9 2F    SBC #$2F        subtract $2F + carry to convert ASCII to binary
.,AA29 4C 7E BD JMP $BD7E       evaluate new ASCII digit and return

                                *** assign value to numeric variable, but not TI$
.,AA2C A0 02    LDY #$02        index to string pointer high byte
.,AA2E B1 64    LDA ($64),Y     get string pointer high byte
.,AA30 C5 34    CMP $34         compare with bottom of string space high byte
.,AA32 90 17    BCC $AA4B       branch if string pointer high byte is less than bottom
                                of string space high byte
.,AA34 D0 07    BNE $AA3D       branch if string pointer high byte is greater than
                                bottom of string space high byte
                                else high bytes were equal
.,AA36 88       DEY             decrement index to string pointer low byte
.,AA37 B1 64    LDA ($64),Y     get string pointer low byte
.,AA39 C5 33    CMP $33         compare with bottom of string space low byte
.,AA3B 90 0E    BCC $AA4B       branch if string pointer low byte is less than bottom
                                of string space low byte
.,AA3D A4 65    LDY $65         get descriptor pointer high byte
.,AA3F C4 2E    CPY $2E         compare with start of variables high byte
.,AA41 90 08    BCC $AA4B       branch if less, is on string stack
.,AA43 D0 0D    BNE $AA52       if greater make space and copy string
                                else high bytes were equal
.,AA45 A5 64    LDA $64         get descriptor pointer low byte
.,AA47 C5 2D    CMP $2D         compare with start of variables low byte
.,AA49 B0 07    BCS $AA52       if greater or equal make space and copy string
.,AA4B A5 64    LDA $64         get descriptor pointer low byte
.,AA4D A4 65    LDY $65         get descriptor pointer high byte
.,AA4F 4C 68 AA JMP $AA68       go copy descriptor to variable
.,AA52 A0 00    LDY #$00        clear index
.,AA54 B1 64    LDA ($64),Y     get string length
.,AA56 20 75 B4 JSR $B475       copy descriptor pointer and make string space A bytes long
.,AA59 A5 50    LDA $50         copy old descriptor pointer low byte
.,AA5B A4 51    LDY $51         copy old descriptor pointer high byte
.,AA5D 85 6F    STA $6F         save old descriptor pointer low byte
.,AA5F 84 70    STY $70         save old descriptor pointer high byte
.,AA61 20 7A B6 JSR $B67A       copy string from descriptor to utility pointer
.,AA64 A9 61    LDA #$61        get descriptor pointer low byte
.,AA66 A0 00    LDY #$00        get descriptor pointer high byte
.,AA68 85 50    STA $50         save descriptor pointer low byte
.,AA6A 84 51    STY $51         save descriptor pointer high byte
.,AA6C 20 DB B6 JSR $B6DB       clean descriptor stack, YA = pointer
.,AA6F A0 00    LDY #$00        clear index
.,AA71 B1 50    LDA ($50),Y     get string length from new descriptor
.,AA73 91 49    STA ($49),Y     copy string length to variable
.,AA75 C8       INY             increment index
.,AA76 B1 50    LDA ($50),Y     get string pointer low byte from new descriptor
.,AA78 91 49    STA ($49),Y     copy string pointer low byte to variable
.,AA7A C8       INY             increment index
.,AA7B B1 50    LDA ($50),Y     get string pointer high byte from new descriptor
.,AA7D 91 49    STA ($49),Y     copy string pointer high byte to variable
.,AA7F 60       RTS             

                                *** perform PRINT#
.,AA80 20 86 AA JSR $AA86       perform CMD
.,AA83 4C B5 AB JMP $ABB5       close input and output channels and return

                                *** perform CMD
.,AA86 20 9E B7 JSR $B79E       get byte parameter
.,AA89 F0 05    BEQ $AA90       branch if following byte is ":" or [EOT]
.,AA8B A9 2C    LDA #$2C        set ","
.,AA8D 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,AA90 08       PHP             save status
.,AA91 86 13    STX $13         set current I/O channel
.,AA93 20 18 E1 JSR $E118       open channel for output with error check
.,AA96 28       PLP             restore status
.,AA97 4C A0 AA JMP $AAA0       perform PRINT
.,AA9A 20 21 AB JSR $AB21       print string from utility pointer
.,AA9D 20 79 00 JSR $0079       scan memory

                                *** perform PRINT
.,AAA0 F0 35    BEQ $AAD7       if nothing following just print CR/LF
.,AAA2 F0 43    BEQ $AAE7       exit if nothing following, end of PRINT branch
.,AAA4 C9 A3    CMP #$A3        compare with token for TAB(
.,AAA6 F0 50    BEQ $AAF8       if TAB( go handle it
.,AAA8 C9 A6    CMP #$A6        compare with token for SPC(
.,AAAA 18       CLC             flag SPC(
.,AAAB F0 4B    BEQ $AAF8       if SPC( go handle it
.,AAAD C9 2C    CMP #$2C        compare with ","
.,AAAF F0 37    BEQ $AAE8       if "," go skip to the next TAB position
.,AAB1 C9 3B    CMP #$3B        compare with ";"
.,AAB3 F0 5E    BEQ $AB13       if ";" go continue the print loop
.,AAB5 20 9E AD JSR $AD9E       evaluate expression
.,AAB8 24 0D    BIT $0D         test data type flag, $FF = string, $00 = numeric
.,AABA 30 DE    BMI $AA9A       if string go print string, scan memory and continue PRINT
.,AABC 20 DD BD JSR $BDDD       convert FAC1 to ASCII string result in (AY)
.,AABF 20 87 B4 JSR $B487       print " terminated string to utility pointer
.,AAC2 20 21 AB JSR $AB21       print string from utility pointer
.,AAC5 20 3B AB JSR $AB3B       print [SPACE] or [CURSOR RIGHT]
.,AAC8 D0 D3    BNE $AA9D       go scan memory and continue PRINT, branch always

                                *** set XY to $0200 - 1 and print [CR]
.,AACA A9 00    LDA #$00        clear A
.,AACC 9D 00 02 STA $0200,X     clear first byte of input buffer
.,AACF A2 FF    LDX #$FF        $0200 - 1 low byte
.,AAD1 A0 01    LDY #$01        $0200 - 1 high byte
.,AAD3 A5 13    LDA $13         get current I/O channel
.,AAD5 D0 10    BNE $AAE7       exit if not default channel

                                *** print CR/LF
.,AAD7 A9 0D    LDA #$0D        set [CR]
.,AAD9 20 47 AB JSR $AB47       print the character
.,AADC 24 13    BIT $13         test current I/O channel
.,AADE 10 05    BPL $AAE5       if ?? toggle A, EOR #$FF and return
.,AAE0 A9 0A    LDA #$0A        set [LF]
.,AAE2 20 47 AB JSR $AB47       print the character
                                toggle A
.,AAE5 49 FF    EOR #$FF        invert A
.,AAE7 60       RTS             
                                was ","
.,AAE8 38       SEC             set Cb for read cursor position
.,AAE9 20 F0 FF JSR $FFF0       read/set X,Y cursor position
.,AAEC 98       TYA             copy cursor Y
.,AAED 38       SEC             set carry for subtract
.,AAEE E9 0A    SBC #$0A        subtract one TAB length
.,AAF0 B0 FC    BCS $AAEE       loop if result was +ve
.,AAF2 49 FF    EOR #$FF        complement it
.,AAF4 69 01    ADC #$01        +1, twos complement
.,AAF6 D0 16    BNE $AB0E       always print A spaces, result is never $00
.,AAF8 08       PHP             save TAB( or SPC( status
.,AAF9 38       SEC             set Cb for read cursor position
.,AAFA 20 F0 FF JSR $FFF0       read/set X,Y cursor position
.,AAFD 84 09    STY $09         save current cursor position
.,AAFF 20 9B B7 JSR $B79B       scan and get byte parameter
.,AB02 C9 29    CMP #$29        compare with ")"
.,AB04 D0 59    BNE $AB5F       if not ")" do syntax error
.,AB06 28       PLP             restore TAB( or SPC( status
.,AB07 90 06    BCC $AB0F       branch if was SPC(
                                else was TAB(
.,AB09 8A       TXA             copy TAB() byte to A
.,AB0A E5 09    SBC $09         subtract current cursor position
.,AB0C 90 05    BCC $AB13       go loop for next if already past requited position
.,AB0E AA       TAX             copy [SPACE] count to X
.,AB0F E8       INX             increment count
.,AB10 CA       DEX             decrement count
.,AB11 D0 06    BNE $AB19       branch if count was not zero
                                was ";" or [SPACES] printed
.,AB13 20 73 00 JSR $0073       increment and scan memory
.,AB16 4C A2 AA JMP $AAA2       continue print loop
.,AB19 20 3B AB JSR $AB3B       print [SPACE] or [CURSOR RIGHT]
.,AB1C D0 F2    BNE $AB10       loop, branch always

                                *** print null terminated string
.,AB1E 20 87 B4 JSR $B487       print " terminated string to utility pointer

                                *** print string from utility pointer
.,AB21 20 A6 B6 JSR $B6A6       pop string off descriptor stack, or from top of string
                                space returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,AB24 AA       TAX             copy length
.,AB25 A0 00    LDY #$00        clear index
.,AB27 E8       INX             increment length, for pre decrement loop
.,AB28 CA       DEX             decrement length
.,AB29 F0 BC    BEQ $AAE7       exit if done
.,AB2B B1 22    LDA ($22),Y     get byte from string
.,AB2D 20 47 AB JSR $AB47       print the character
.,AB30 C8       INY             increment index
.,AB31 C9 0D    CMP #$0D        compare byte with [CR]
.,AB33 D0 F3    BNE $AB28       loop if not [CR]
.,AB35 20 E5 AA JSR $AAE5       toggle A, EOR #$FF. what is the point of this ??
.,AB38 4C 28 AB JMP $AB28       loop

                                *** print [SPACE] or [CURSOR RIGHT]
.,AB3B A5 13    LDA $13         get current I/O channel
.,AB3D F0 03    BEQ $AB42       if default channel go output [CURSOR RIGHT]
.,AB3F A9 20    LDA #$20        else output [SPACE]
.:AB41 2C       .BYTE $2C       makes next line BIT $1DA9
.,AB42 A9 1D    LDA #$1D        set [CURSOR RIGHT]
.:AB44 2C       .BYTE $2C       makes next line BIT $3FA9

                                *** print "?"
.,AB45 A9 3F    LDA #$3F        set "?"

                                *** print character
.,AB47 20 0C E1 JSR $E10C       output character to channel with error check
.,AB4A 29 FF    AND #$FF        set the flags on A
.,AB4C 60       RTS             

                                *** bad input routine
.,AB4D A5 11    LDA $11         get INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
.,AB4F F0 11    BEQ $AB62       branch if INPUT
.,AB51 30 04    BMI $AB57       branch if READ
                                else was GET
.,AB53 A0 FF    LDY #$FF        set current line high byte to -1, indicate immediate mode
.,AB55 D0 04    BNE $AB5B       branch always
.,AB57 A5 3F    LDA $3F         get current DATA line number low byte
.,AB59 A4 40    LDY $40         get current DATA line number high byte
.,AB5B 85 39    STA $39         set current line number low byte
.,AB5D 84 3A    STY $3A         set current line number high byte
.,AB5F 4C 08 AF JMP $AF08       do syntax error then warm start
                                was INPUT
.,AB62 A5 13    LDA $13         get current I/O channel
.,AB64 F0 05    BEQ $AB6B       branch if default channel
.,AB66 A2 18    LDX #$18        else error $18, file data error
.,AB68 4C 37 A4 JMP $A437       do error #X then warm start
.,AB6B A9 0C    LDA #$0C        set "?REDO FROM START" pointer low byte
.,AB6D A0 AD    LDY #$AD        set "?REDO FROM START" pointer high byte
.,AB6F 20 1E AB JSR $AB1E       print null terminated string
.,AB72 A5 3D    LDA $3D         get continue pointer low byte
.,AB74 A4 3E    LDY $3E         get continue pointer high byte
.,AB76 85 7A    STA $7A         save BASIC execute pointer low byte
.,AB78 84 7B    STY $7B         save BASIC execute pointer high byte
.,AB7A 60       RTS             

                                *** perform GET
.,AB7B 20 A6 B3 JSR $B3A6       check not Direct, back here if ok
.,AB7E C9 23    CMP #$23        compare with "#"
.,AB80 D0 10    BNE $AB92       branch if not GET#
.,AB82 20 73 00 JSR $0073       increment and scan memory
.,AB85 20 9E B7 JSR $B79E       get byte parameter
.,AB88 A9 2C    LDA #$2C        set ","
.,AB8A 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,AB8D 86 13    STX $13         set current I/O channel
.,AB8F 20 1E E1 JSR $E11E       open channel for input with error check
.,AB92 A2 01    LDX #$01        set pointer low byte
.,AB94 A0 02    LDY #$02        set pointer high byte
.,AB96 A9 00    LDA #$00        clear A
.,AB98 8D 01 02 STA $0201       ensure null terminator
.,AB9B A9 40    LDA #$40        input mode = GET
.,AB9D 20 0F AC JSR $AC0F       perform the GET part of READ
.,ABA0 A6 13    LDX $13         get current I/O channel
.,ABA2 D0 13    BNE $ABB7       if not default channel go do channel close and return
.,ABA4 60       RTS             

                                *** perform INPUT#
.,ABA5 20 9E B7 JSR $B79E       get byte parameter
.,ABA8 A9 2C    LDA #$2C        set ","
.,ABAA 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,ABAD 86 13    STX $13         set current I/O channel
.,ABAF 20 1E E1 JSR $E11E       open channel for input with error check
.,ABB2 20 CE AB JSR $ABCE       perform INPUT with no prompt string

                                *** close input and output channels
.,ABB5 A5 13    LDA $13         get current I/O channel
.,ABB7 20 CC FF JSR $FFCC       close input and output channels
.,ABBA A2 00    LDX #$00        clear X
.,ABBC 86 13    STX $13         clear current I/O channel, flag default
.,ABBE 60       RTS             

                                *** perform INPUT
.,ABBF C9 22    CMP #$22        compare next byte with open quote
.,ABC1 D0 0B    BNE $ABCE       if no prompt string just do INPUT
.,ABC3 20 BD AE JSR $AEBD       print "..." string
.,ABC6 A9 3B    LDA #$3B        load A with ";"
.,ABC8 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,ABCB 20 21 AB JSR $AB21       print string from utility pointer
                                done with prompt, now get data
.,ABCE 20 A6 B3 JSR $B3A6       check not Direct, back here if ok
.,ABD1 A9 2C    LDA #$2C        set ","
.,ABD3 8D FF 01 STA $01FF       save to start of buffer - 1
.,ABD6 20 F9 AB JSR $ABF9       print "? " and get BASIC input
.,ABD9 A5 13    LDA $13         get current I/O channel
.,ABDB F0 0D    BEQ $ABEA       branch if default I/O channel
.,ABDD 20 B7 FF JSR $FFB7       read I/O status word
.,ABE0 29 02    AND #$02        mask no DSR/timeout
.,ABE2 F0 06    BEQ $ABEA       branch if not error
.,ABE4 20 B5 AB JSR $ABB5       close input and output channels
.,ABE7 4C F8 A8 JMP $A8F8       perform DATA
.,ABEA AD 00 02 LDA $0200       get first byte in input buffer
.,ABED D0 1E    BNE $AC0D       branch if not null
                                else ..
.,ABEF A5 13    LDA $13         get current I/O channel
.,ABF1 D0 E3    BNE $ABD6       if not default channel go get BASIC input
.,ABF3 20 06 A9 JSR $A906       scan for next BASIC statement ([:] or [EOL])
.,ABF6 4C FB A8 JMP $A8FB       add Y to the BASIC execute pointer and return

                                *** print "? " and get BASIC input
.,ABF9 A5 13    LDA $13         get current I/O channel
.,ABFB D0 06    BNE $AC03       skip "?" prompt if not default channel
.,ABFD 20 45 AB JSR $AB45       print "?"
.,AC00 20 3B AB JSR $AB3B       print [SPACE] or [CURSOR RIGHT]
.,AC03 4C 60 A5 JMP $A560       call for BASIC input and return

                                *** perform READ
.,AC06 A6 41    LDX $41         get DATA pointer low byte
.,AC08 A4 42    LDY $42         get DATA pointer high byte
.,AC0A A9 98    LDA #$98        set input mode = READ
.:AC0C 2C       .BYTE $2C       makes next line BIT $00A9
.,AC0D A9 00    LDA #$00        set input mode = INPUT

                                *** perform GET
.,AC0F 85 11    STA $11         set input mode flag, $00 = INPUT, $40 = GET, $98 = READ
.,AC11 86 43    STX $43         save READ pointer low byte
.,AC13 84 44    STY $44         save READ pointer high byte
                                READ, GET or INPUT next variable from list
.,AC15 20 8B B0 JSR $B08B       get variable address
.,AC18 85 49    STA $49         save address low byte
.,AC1A 84 4A    STY $4A         save address high byte
.,AC1C A5 7A    LDA $7A         get BASIC execute pointer low byte
.,AC1E A4 7B    LDY $7B         get BASIC execute pointer high byte
.,AC20 85 4B    STA $4B         save BASIC execute pointer low byte
.,AC22 84 4C    STY $4C         save BASIC execute pointer high byte
.,AC24 A6 43    LDX $43         get READ pointer low byte
.,AC26 A4 44    LDY $44         get READ pointer high byte
.,AC28 86 7A    STX $7A         save as BASIC execute pointer low byte
.,AC2A 84 7B    STY $7B         save as BASIC execute pointer high byte
.,AC2C 20 79 00 JSR $0079       scan memory
.,AC2F D0 20    BNE $AC51       branch if not null
                                pointer was to null entry
.,AC31 24 11    BIT $11         test input mode flag, $00 = INPUT, $40 = GET, $98 = READ
.,AC33 50 0C    BVC $AC41       branch if not GET
                                else was GET
.,AC35 20 24 E1 JSR $E124       get character from input device with error check
.,AC38 8D 00 02 STA $0200       save to buffer
.,AC3B A2 FF    LDX #$FF        set pointer low byte
.,AC3D A0 01    LDY #$01        set pointer high byte
.,AC3F D0 0C    BNE $AC4D       go interpret single character
.,AC41 30 75    BMI $ACB8       branch if READ
                                else was INPUT
.,AC43 A5 13    LDA $13         get current I/O channel
.,AC45 D0 03    BNE $AC4A       skip "?" prompt if not default channel
.,AC47 20 45 AB JSR $AB45       print "?"
.,AC4A 20 F9 AB JSR $ABF9       print "? " and get BASIC input
.,AC4D 86 7A    STX $7A         save BASIC execute pointer low byte
.,AC4F 84 7B    STY $7B         save BASIC execute pointer high byte
.,AC51 20 73 00 JSR $0073       increment and scan memory, execute pointer now points to
                                start of next data or null terminator
.,AC54 24 0D    BIT $0D         test data type flag, $FF = string, $00 = numeric
.,AC56 10 31    BPL $AC89       branch if numeric
                                type is string
.,AC58 24 11    BIT $11         test INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
.,AC5A 50 09    BVC $AC65       branch if not GET
                                else do string GET
.,AC5C E8       INX             clear X ??
.,AC5D 86 7A    STX $7A         save BASIC execute pointer low byte
.,AC5F A9 00    LDA #$00        clear A
.,AC61 85 07    STA $07         clear search character
.,AC63 F0 0C    BEQ $AC71       branch always
                                is string INPUT or string READ
.,AC65 85 07    STA $07         save search character
.,AC67 C9 22    CMP #$22        compare with "
.,AC69 F0 07    BEQ $AC72       branch if quote
                                string is not in quotes so ":", "," or $00 are the
                                termination characters
.,AC6B A9 3A    LDA #$3A        set ":"
.,AC6D 85 07    STA $07         set search character
.,AC6F A9 2C    LDA #$2C        set ","
.,AC71 18       CLC             clear carry for add
.,AC72 85 08    STA $08         set scan quotes flag
.,AC74 A5 7A    LDA $7A         get BASIC execute pointer low byte
.,AC76 A4 7B    LDY $7B         get BASIC execute pointer high byte
.,AC78 69 00    ADC #$00        add to pointer low byte. this add increments the pointer
                                if the mode is INPUT or READ and the data is a "..."
                                string
.,AC7A 90 01    BCC $AC7D       branch if no rollover
.,AC7C C8       INY             else increment pointer high byte
.,AC7D 20 8D B4 JSR $B48D       print string to utility pointer
.,AC80 20 E2 B7 JSR $B7E2       restore BASIC execute pointer from temp
.,AC83 20 DA A9 JSR $A9DA       perform string LET
.,AC86 4C 91 AC JMP $AC91       continue processing command
                                GET, INPUT or READ is numeric
.,AC89 20 F3 BC JSR $BCF3       get FAC1 from string
.,AC8C A5 0E    LDA $0E         get data type flag, $80 = integer, $00 = float
.,AC8E 20 C2 A9 JSR $A9C2       assign value to numeric variable
.,AC91 20 79 00 JSR $0079       scan memory
.,AC94 F0 07    BEQ $AC9D       branch if ":" or [EOL]
.,AC96 C9 2C    CMP #$2C        comparte with ","
.,AC98 F0 03    BEQ $AC9D       branch if ","
.,AC9A 4C 4D AB JMP $AB4D       else go do bad input routine
                                string terminated with ":", "," or $00
.,AC9D A5 7A    LDA $7A         get BASIC execute pointer low byte
.,AC9F A4 7B    LDY $7B         get BASIC execute pointer high byte
.,ACA1 85 43    STA $43         save READ pointer low byte
.,ACA3 84 44    STY $44         save READ pointer high byte
.,ACA5 A5 4B    LDA $4B         get saved BASIC execute pointer low byte
.,ACA7 A4 4C    LDY $4C         get saved BASIC execute pointer high byte
.,ACA9 85 7A    STA $7A         restore BASIC execute pointer low byte
.,ACAB 84 7B    STY $7B         restore BASIC execute pointer high byte
.,ACAD 20 79 00 JSR $0079       scan memory
.,ACB0 F0 2D    BEQ $ACDF       branch if ":" or [EOL]
.,ACB2 20 FD AE JSR $AEFD       scan for ",", else do syntax error then warm start
.,ACB5 4C 15 AC JMP $AC15       go READ or INPUT next variable from list
                                was READ
.,ACB8 20 06 A9 JSR $A906       scan for next BASIC statement ([:] or [EOL])
.,ACBB C8       INY             increment index to next byte
.,ACBC AA       TAX             copy byte to X
.,ACBD D0 12    BNE $ACD1       branch if ":"
.,ACBF A2 0D    LDX #$0D        else set error $0D, out of data error
.,ACC1 C8       INY             increment index to next line pointer high byte
.,ACC2 B1 7A    LDA ($7A),Y     get next line pointer high byte
.,ACC4 F0 6C    BEQ $AD32       branch if program end, eventually does error X
.,ACC6 C8       INY             increment index
.,ACC7 B1 7A    LDA ($7A),Y     get next line # low byte
.,ACC9 85 3F    STA $3F         save current DATA line low byte
.,ACCB C8       INY             increment index
.,ACCC B1 7A    LDA ($7A),Y     get next line # high byte
.,ACCE C8       INY             increment index
.,ACCF 85 40    STA $40         save current DATA line high byte
.,ACD1 20 FB A8 JSR $A8FB       add Y to the BASIC execute pointer
.,ACD4 20 79 00 JSR $0079       scan memory
.,ACD7 AA       TAX             copy the byte
.,ACD8 E0 83    CPX #$83        compare it with token for DATA
.,ACDA D0 DC    BNE $ACB8       loop if not DATA
.,ACDC 4C 51 AC JMP $AC51       continue evaluating READ
.,ACDF A5 43    LDA $43         get READ pointer low byte
.,ACE1 A4 44    LDY $44         get READ pointer high byte
.,ACE3 A6 11    LDX $11         get INPUT mode flag, $00 = INPUT, $40 = GET, $98 = READ
.,ACE5 10 03    BPL $ACEA       branch if INPUT or GET
.,ACE7 4C 27 A8 JMP $A827       else set data pointer and exit
.,ACEA A0 00    LDY #$00        clear index
.,ACEC B1 43    LDA ($43),Y     get READ byte
.,ACEE F0 0B    BEQ $ACFB       exit if [EOL]
.,ACF0 A5 13    LDA $13         get current I/O channel
.,ACF2 D0 07    BNE $ACFB       exit if not default channel
.,ACF4 A9 FC    LDA #$FC        set "?EXTRA IGNORED" pointer low byte
.,ACF6 A0 AC    LDY #$AC        set "?EXTRA IGNORED" pointer high byte
.,ACF8 4C 1E AB JMP $AB1E       print null terminated string
.,ACFB 60       RTS             

                                *** input error messages
.:ACFC 3F 45 58 54 52 41 20 49  '?extra ignored'
.:AD04 47 4E 4F 52 45 44 0D 00
.:AD0C 3F 52 45 44 4F 20 46 52  '?redo from start'
.:AD14 4F 4D 20 53 54 41 52 54
.:AD1C 0D 00

                                *** perform NEXT
.,AD1E D0 04    BNE $AD24       branch if NEXT variable
.,AD20 A0 00    LDY #$00        else clear Y
.,AD22 F0 03    BEQ $AD27       branch always
                                NEXT variable
.,AD24 20 8B B0 JSR $B08B       get variable address
.,AD27 85 49    STA $49         save FOR/NEXT variable pointer low byte
.,AD29 84 4A    STY $4A         save FOR/NEXT variable pointer high byte
                                (high byte cleared if no variable defined)
.,AD2B 20 8A A3 JSR $A38A       search the stack for FOR or GOSUB activity
.,AD2E F0 05    BEQ $AD35       branch if FOR, this variable, found
.,AD30 A2 0A    LDX #$0A        else set error $0A, next without for error
.,AD32 4C 37 A4 JMP $A437       do error #X then warm start
                                found this FOR variable
.,AD35 9A       TXS             update stack pointer
.,AD36 8A       TXA             copy stack pointer
.,AD37 18       CLC             clear carry for add
.,AD38 69 04    ADC #$04        point to STEP value
.,AD3A 48       PHA             save it
.,AD3B 69 06    ADC #$06        point to TO value
.,AD3D 85 24    STA $24         save pointer to TO variable for compare
.,AD3F 68       PLA             restore pointer to STEP value
.,AD40 A0 01    LDY #$01        point to stack page
.,AD42 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1
.,AD45 BA       TSX             get stack pointer back
.,AD46 BD 09 01 LDA $0109,X     get step sign
.,AD49 85 66    STA $66         save FAC1 sign (b7)
.,AD4B A5 49    LDA $49         get FOR/NEXT variable pointer low byte
.,AD4D A4 4A    LDY $4A         get FOR/NEXT variable pointer high byte
.,AD4F 20 67 B8 JSR $B867       add FOR variable to FAC1
.,AD52 20 D0 BB JSR $BBD0       pack FAC1 into FOR variable
.,AD55 A0 01    LDY #$01        point to stack page
.,AD57 20 5D BC JSR $BC5D       compare FAC1 with TO value
.,AD5A BA       TSX             get stack pointer back
.,AD5B 38       SEC             set carry for subtract
.,AD5C FD 09 01 SBC $0109,X     subtract step sign
.,AD5F F0 17    BEQ $AD78       branch if =, loop complete
                                loop back and do it all again
.,AD61 BD 0F 01 LDA $010F,X     get FOR line low byte
.,AD64 85 39    STA $39         save current line number low byte
.,AD66 BD 10 01 LDA $0110,X     get FOR line high byte
.,AD69 85 3A    STA $3A         save current line number high byte
.,AD6B BD 12 01 LDA $0112,X     get BASIC execute pointer low byte
.,AD6E 85 7A    STA $7A         save BASIC execute pointer low byte
.,AD70 BD 11 01 LDA $0111,X     get BASIC execute pointer high byte
.,AD73 85 7B    STA $7B         save BASIC execute pointer high byte
.,AD75 4C AE A7 JMP $A7AE       go do interpreter inner loop
                                NEXT loop comlete
.,AD78 8A       TXA             stack copy to A
.,AD79 69 11    ADC #$11        add $12, $11 + carry, to dump FOR structure
.,AD7B AA       TAX             copy back to index
.,AD7C 9A       TXS             copy to stack pointer
.,AD7D 20 79 00 JSR $0079       scan memory
.,AD80 C9 2C    CMP #$2C        compare with ","
.,AD82 D0 F1    BNE $AD75       if not "," go do interpreter inner loop
                                was "," so another NEXT variable to do
.,AD84 20 73 00 JSR $0073       increment and scan memory
.,AD87 20 24 AD JSR $AD24       do NEXT variable

                                *** evaluate expression and check type mismatch
.,AD8A 20 9E AD JSR $AD9E       evaluate expression
                                check if source and destination are numeric
.,AD8D 18       CLC             
.:AD8E 24       .BYTE $24       makes next line BIT $38
                                check if source and destination are string
.,AD8F 38       SEC             destination is string
                                type match check, set C for string, clear C for numeric
.,AD90 24 0D    BIT $0D         test data type flag, $FF = string, $00 = numeric
.,AD92 30 03    BMI $AD97       branch if string
.,AD94 B0 03    BCS $AD99       if destiantion is numeric do type missmatch error
.,AD96 60       RTS             
.,AD97 B0 FD    BCS $AD96       exit if destination is string
                                do type missmatch error
.,AD99 A2 16    LDX #$16        error code $16, type missmatch error
.,AD9B 4C 37 A4 JMP $A437       do error #X then warm start

                                *** evaluate expression
.,AD9E A6 7A    LDX $7A         get BASIC execute pointer low byte
.,ADA0 D0 02    BNE $ADA4       skip next if not zero
.,ADA2 C6 7B    DEC $7B         else decrement BASIC execute pointer high byte
.,ADA4 C6 7A    DEC $7A         decrement BASIC execute pointer low byte
.,ADA6 A2 00    LDX #$00        set null precedence, flag done
.:ADA8 24       .BYTE $24       makes next line BIT $48
.,ADA9 48       PHA             push compare evaluation byte if branch to here
.,ADAA 8A       TXA             copy precedence byte
.,ADAB 48       PHA             push precedence byte
.,ADAC A9 01    LDA #$01        2 bytes
.,ADAE 20 FB A3 JSR $A3FB       check room on stack for A*2 bytes
.,ADB1 20 83 AE JSR $AE83       get value from line
.,ADB4 A9 00    LDA #$00        clear A
.,ADB6 85 4D    STA $4D         clear comparrison evaluation flag
.,ADB8 20 79 00 JSR $0079       scan memory
.,ADBB 38       SEC             set carry for subtract
.,ADBC E9 B1    SBC #$B1        subtract the token for ">"
.,ADBE 90 17    BCC $ADD7       branch if < ">"
.,ADC0 C9 03    CMP #$03        compare with ">" to +3
.,ADC2 B0 13    BCS $ADD7       branch if >= 3
                                was token for ">" "=" or "<"
.,ADC4 C9 01    CMP #$01compare with token for =
.,ADC6 2A       ROL             *2, b0 = carry (=1 if token was = or <)
.,ADC7 49 01    EOR #$01        toggle b0
.,ADC9 45 4D    EOR $4D         EOR with comparrison evaluation flag
.,ADCB C5 4D    CMP $4D         compare with comparrison evaluation flag
.,ADCD 90 61    BCC $AE30       if < saved flag do syntax error then warm start
.,ADCF 85 4D    STA $4D         save new comparrison evaluation flag
.,ADD1 20 73 00 JSR $0073       increment and scan memory
.,ADD4 4C BB AD JMP $ADBB       go do next character
.,ADD7 A6 4D    LDX $4D         get comparrison evaluation flag
.,ADD9 D0 2C    BNE $AE07       branch if compare function
.,ADDB B0 7B    BCS $AE58       go do functions
                                else was < TK_GT so is operator or lower
.,ADDD 69 07    ADC #$07        add # of operators (+, -, *, /, ^, AND or OR)
.,ADDF 90 77    BCC $AE58       branch if < + operator
                                carry was set so token was +, -, *, /, ^, AND or OR
.,ADE1 65 0D    ADC $0D         add data type flag, $FF = string, $00 = numeric
.,ADE3 D0 03    BNE $ADE8       branch if not string or not + token
                                will only be $00 if type is string and token was +
.,ADE5 4C 3D B6 JMP $B63D       add strings, string 1 is in the descriptor, string 2
                                is in line, and return
.,ADE8 69 FF    ADC #$FF        -1 (corrects for carry add)
.,ADEA 85 22    STA $22         save it
.,ADEC 0A       ASL             *2
.,ADED 65 22    ADC $22         *3
.,ADEF A8       TAY             copy to index
.,ADF0 68       PLA             pull previous precedence
.,ADF1 D9 80 A0 CMP $A080,Y     compare with precedence byte
.,ADF4 B0 67    BCS $AE5D       branch if A >=
.,ADF6 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,ADF9 48       PHA             save precedence
.,ADFA 20 20 AE JSR $AE20       get vector, execute function then continue evaluation
.,ADFD 68       PLArestore precedence
.,ADFE A4 4B    LDY $4B         get precedence stacked flag
.,AE00 10 17    BPL $AE19       branch if stacked values
.,AE02 AA       TAX             copy precedence, set flags
.,AE03 F0 56    BEQ $AE5B       exit if done
.,AE05 D0 5F    BNE $AE66       else pop FAC2 and return, branch always
.,AE07 46 0D    LSR $0D         clear data type flag, $FF = string, $00 = numeric
.,AE09 8A       TXA             copy compare function flag
.,AE0A 2A       ROL             <<1, shift data type flag into b0, 1 = string, 0 = num
.,AE0B A6 7A    LDX $7A         get BASIC execute pointer low byte
.,AE0D D0 02    BNE $AE11       branch if no underflow
.,AE0F C6 7B    DEC $7B         else decrement BASIC execute pointer high byte
.,AE11 C6 7A    DEC $7A         decrement BASIC execute pointer low byte
.,AE13 A0 1B    LDY #$1B        
                                set offset to = operator precedence entry
.,AE15 85 4D    STA $4D         save new comparrison evaluation flag
.,AE17 D0 D7    BNE $ADF0       branch always
.,AE19 D9 80 A0 CMP $A080,Y     compare with stacked function precedence
.,AE1C B0 48    BCS $AE66       if A >=, pop FAC2 and return
.,AE1E 90 D9    BCC $ADF9       else go stack this one and continue, branch always

                                *** get vector, execute function then continue evaluation
.,AE20 B9 82 A0 LDA $A082,Y     get function vector high byte
.,AE23 48       PHA             onto stack
.,AE24 B9 81 A0 LDA $A081,Y     get function vector low byte
.,AE27 48       PHA             onto stack
                                now push sign, round FAC1 and put on stack
.,AE28 20 33 AE JSR $AE33       function will return here, then the next RTS will call
                                the function
.,AE2B A5 4D    LDA $4D         get comparrison evaluation flag
.,AE2D 4C A9 AD JMP $ADA9       continue evaluating expression
.,AE30 4C 08 AF JMP $AF08       do syntax error then warm start
.,AE33 A5 66    LDA $66         get FAC1 sign (b7)
.,AE35 BE 80 A0 LDX $A080,Y     get precedence byte

                                *** push sign, round FAC1 and put on stack
.,AE38 A8       TAY             copy sign
.,AE39 68       PLA             get return address low byte
.,AE3A 85 22    STA $22         save it
.,AE3C E6 22    INC $22         increment it as return-1 is pushed
                                note, no check is made on the high byte so if the calling
                                routine ever assembles to a page edge then this all goes
                                horribly wrong!
.,AE3E 68       PLA             get return address high byte
.,AE3F 85 23    STA $23         save it
.,AE41 98       TYA             restore sign
.,AE42 48       PHA             push sign

                                *** round FAC1 and put on stack
.,AE43 20 1B BC JSR $BC1B       round FAC1
.,AE46 A5 65    LDA $65         get FAC1 mantissa 4
.,AE48 48       PHA             save it
.,AE49 A5 64    LDA $64         get FAC1 mantissa 3
.,AE4B 48       PHA             save it
.,AE4C A5 63    LDA $63         get FAC1 mantissa 2
.,AE4E 48       PHA             save it
.,AE4F A5 62    LDA $62         get FAC1 mantissa 1
.,AE51 48       PHA             save it
.,AE52 A5 61    LDA $61         get FAC1 exponent
.,AE54 48       PHA             save it
.,AE55 6C 22 00 JMP ($0022)     return, sort of

                                *** do functions
.,AE58 A0 FF    LDY #$FF        flag function
.,AE5A 68       PLA             pull precedence byte
.,AE5B F0 23    BEQ $AE80       exit if done
.,AE5D C9 64    CMP #$64        compare previous precedence with $64
.,AE5F F0 03    BEQ $AE64       branch if was $64 (< function)
.,AE61 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,AE64 84 4B    STY $4B         save precedence stacked flag
                                pop FAC2 and return
.,AE66 68       PLA             pop byte
.,AE67 4A       LSR             shift out comparison evaluation lowest bit
.,AE68 85 12    STA $12         save the comparison evaluation flag
.,AE6A 68       PLA             pop exponent
.,AE6B 85 69    STA $69         save FAC2 exponent
.,AE6D 68       PLA             pop mantissa 1
.,AE6E 85 6A    STA $6A         save FAC2 mantissa 1
.,AE70 68       PLA             pop mantissa 2
.,AE71 85 6B    STA $6B         save FAC2 mantissa 2
.,AE73 68       PLA             pop mantissa 3
.,AE74 85 6C    STA $6C         save FAC2 mantissa 3
.,AE76 68       PLA             pop mantissa 4
.,AE77 85 6D    STA $6D         save FAC2 mantissa 4
.,AE79 68       PLA             pop sign
.,AE7A 85 6E    STA $6E         save FAC2 sign (b7)
.,AE7C 45 66    EOR $66         EOR FAC1 sign (b7)
.,AE7E 85 6F    STA $6F         save sign compare (FAC1 EOR FAC2)
.,AE80 A5 61    LDA $61         get FAC1 exponent
.,AE82 60       RTS             

                                *** get value from line
.,AE83 6C 0A 03 JMP ($030A)     get arithmetic element

                                *** get arithmetic element, the get arithmetic element vector is initialised to point here
.,AE86 A9 00    LDA #$00        clear byte
.,AE88 85 0D    STA $0D         clear data type flag, $FF = string, $00 = numeric
.,AE8A 20 73 00 JSR $0073       increment and scan memory
.,AE8D B0 03    BCS $AE92       branch if not numeric character
                                else numeric string found (e.g. 123)
.,AE8F 4C F3 BC JMP $BCF3       get FAC1 from string and return
                                get value from line .. continued
                                wasn't a number so ...
.,AE92 20 13 B1 JSR $B113       check byte, return Cb = 0 if<"A" or >"Z"
.,AE95 90 03    BCC $AE9A       branch if not variable name
.,AE97 4C 28 AF JMP $AF28       variable name set-up and return
.,AE9A C9 FF    CMP #$FF        compare with token for PI
.,AE9C D0 0F    BNE $AEAD       branch if not PI
.,AE9E A9 A8    LDA #$A8        get PI pointer low byte
.,AEA0 A0 AE    LDY #$AE        get PI pointer high byte
.,AEA2 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1
.,AEA5 4C 73 00 JMP $0073       increment and scan memory and return

                                *** PI as floating number
.:AEA8 82 49 0F DA A1           3.141592653

                                *** get value from line .. continued
                                wasn't variable name so ...
.,AEAD C9 2E    CMP #$2E        compare with "."
.,AEAF F0 DE    BEQ $AE8F       if so get FAC1 from string and return, e.g. was .123
                                wasn't .123 so ...
.,AEB1 C9 AB    CMP #$AB        compare with token for -
.,AEB3 F0 58    BEQ $AF0D       branch if - token, do set-up for functions
                                wasn't -123 so ...
.,AEB5 C9 AA    CMP #$AA        compare with token for +
.,AEB7 F0 D1    BEQ $AE8A       branch if + token, +1 = 1 so ignore leading +
                                it wasn't any sort of number so ...
.,AEB9 C9 22    CMP #$22        compare with "
.,AEBB D0 0F    BNE $AECC       branch if not open quote
                                was open quote so get the enclosed string

                                *** print "..." string to string utility area
.,AEBD A5 7A    LDA $7A         get BASIC execute pointer low byte
.,AEBF A4 7B    LDY $7B         get BASIC execute pointer high byte
.,AEC1 69 00    ADC #$00        add carry to low byte
.,AEC3 90 01    BCC $AEC6       branch if no overflow
.,AEC5 C8       INY             increment high byte
.,AEC6 20 87 B4 JSR $B487       print " terminated string to utility pointer
.,AEC9 4C E2 B7 JMP $B7E2       restore BASIC execute pointer from temp and return
                                get value from line .. continued
                                wasn't a string so ...
.,AECC C9 A8    CMP #$A8        compare with token for NOT
.,AECE D0 13    BNE $AEE3       branch if not token for NOT
                                was NOT token
.,AED0 A0 18    LDY #$18        offset to NOT function
.,AED2 D0 3B    BNE $AF0F       do set-up for function then execute, branch always
                                do = compare
.,AED4 20 BF B1 JSR $B1BF       evaluate integer expression, no sign check
.,AED7 A5 65    LDA $65         get FAC1 mantissa 4
.,AED9 49 FF    EOR #$FF        invert it
.,AEDB A8       TAY             copy it
.,AEDC A5 64    LDA $64         get FAC1 mantissa 3
.,AEDE 49 FF    EOR #$FF        invert it
.,AEE0 4C 91 B3 JMP $B391       convert fixed integer AY to float FAC1 and return
                                get value from line .. continued
                                wasn't a string or NOT so ...
.,AEE3 C9 A5    CMP #$A5        compare with token for FN
.,AEE5 D0 03    BNE $AEEA       branch if not token for FN
.,AEE7 4C F4 B3 JMP $B3F4       else go evaluate FNx
                                get value from line .. continued
                                wasn't a string, NOT or FN so ...
.,AEEA C9 B4    CMP #$B4        compare with token for SGN
.,AEEC 90 03    BCC $AEF1       if less than SGN token evaluate expression in parentheses
                                else was a function token
.,AEEE 4C A7 AF JMP $AFA7       go set up function references, branch always
                                get value from line .. continued
                                if here it can only be something in brackets so ....
                                evaluate expression within parentheses
.,AEF1 20 FA AE JSR $AEFA       scan for "(", else do syntax error then warm start
.,AEF4 20 9E AD JSR $AD9E       evaluate expression
                                all the 'scan for' routines return the character after the sought character
                                scan for ")", else do syntax error then warm start
.,AEF7 A9 29    LDA #$29        load A with ")"
.:AEF9 2C       .BYTE $2C       makes next line BIT $28A9
                                scan for "(", else do syntax error then warm start
.,AEFA A9 28    LDA #$28        load A with "("
.:AEFC 2C       .BYTE $2C       makes next line BIT $2CA9
                                scan for ",", else do syntax error then warm start
.,AEFD A9 2C    LDA #$2C        load A with ","
                                scan for CHR$(A), else do syntax error then warm start
.,AEFF A0 00    LDY #$00        clear index
.,AF01 D1 7A    CMP ($7A),Y     compare with BASIC byte
.,AF03 D0 03    BNE $AF08       if not expected byte do syntax error then warm start
.,AF05 4C 73 00 JMP $0073       else increment and scan memory and return
                                syntax error then warm start
.,AF08 A2 0B    LDX #$0B        error code $0B, syntax error
.,AF0A 4C 37 A4 JMP $A437       do error #X then warm start
.,AF0D A0 15    LDY #$15        set offset from base to > operator
.,AF0F 68       PLA             dump return address low byte
.,AF10 68       PLA             dump return address high byte
.,AF11 4C FA AD JMP $ADFA       execute function then continue evaluation

                                *** check address range, return Cb = 1 if address in BASIC ROM
.,AF14 38       SEC             set carry for subtract
.,AF15 A5 64    LDA $64         get variable address low byte
.,AF17 E9 00    SBC #$00        subtract $A000 low byte
.,AF19 A5 65    LDA $65         get variable address high byte
.,AF1B E9 A0    SBC #$A0        subtract $A000 high byte
.,AF1D 90 08    BCC $AF27       exit if address < $A000
.,AF1F A9 A2    LDA #$A2        get end of BASIC marker low byte
.,AF21 E5 64    SBC $64         subtract variable address low byte
.,AF23 A9 E3    LDA #$E3        get end of BASIC marker high byte
.,AF25 E5 65    SBC $65         subtract variable address high byte
.,AF27 60       RTS             

                                *** variable name set-up
.,AF28 20 8B B0 JSR $B08B       get variable address
.,AF2B 85 64    STA $64         save variable pointer low byte
.,AF2D 84 65    STY $65         save variable pointer high byte
.,AF2F A6 45    LDX $45         get current variable name first character
.,AF31 A4 46    LDY $46         get current variable name second character
.,AF33 A5 0D    LDA $0D         get data type flag, $FF = string, $00 = numeric
.,AF35 F0 26    BEQ $AF5D       branch if numeric
                                variable is string
.,AF37 A9 00    LDA #$00        else clear A
.,AF39 85 70    STA $70         clear FAC1 rounding byte
.,AF3B 20 14 AF JSR $AF14       check address range
.,AF3E 90 1C    BCC $AF5C       exit if not in BASIC ROM
.,AF40 E0 54    CPX #$54        compare variable name first character with "T"
.,AF42 D0 18    BNE $AF5C       exit if not "T"
.,AF44 C0 C9    CPY #$C9        compare variable name second character with "I$"
.,AF46 D0 14    BNE $AF5C       exit if not "I$"
                                variable name was "TI$"
.,AF48 20 84 AF JSR $AF84       read real time clock into FAC1 mantissa, 0HML
.,AF4B 84 5E    STY $5E         clear exponent count adjust
.,AF4D 88       DEY             Y = $FF
.,AF4E 84 71    STY $71         set output string index, -1 to allow for pre increment
.,AF50 A0 06    LDY #$06        HH:MM:SS is six digits
.,AF52 84 5D    STY $5D         set number of characters before the decimal point
.,AF54 A0 24    LDY #$24        
                                index to jiffy conversion table
.,AF56 20 68 BE JSR $BE68       convert jiffy count to string
.,AF59 4C 6F B4 JMP $B46F       exit via STR$() code tail
.,AF5C 60       RTS             
                                variable name set-up, variable is numeric
.,AF5D 24 0E    BIT $0E         test data type flag, $80 = integer, $00 = float
.,AF5F 10 0D    BPL $AF6E       branch if float
.,AF61 A0 00    LDY #$00        clear index
.,AF63 B1 64    LDA ($64),Y     get integer variable low byte
.,AF65 AA       TAX             copy to X
.,AF66 C8       INY             increment index
.,AF67 B1 64    LDA ($64),Y     get integer variable high byte
.,AF69 A8       TAY             copy to Y
.,AF6A 8A       TXA             copy loa byte to A
.,AF6B 4C 91 B3 JMP $B391       convert fixed integer AY to float FAC1 and return
                                variable name set-up, variable is float
.,AF6E 20 14 AF JSR $AF14       check address range
.,AF71 90 2D    BCC $AFA0       if not in BASIC ROM get pointer and unpack into FAC1
.,AF73 E0 54    CPX #$54        compare variable name first character with "T"
.,AF75 D0 1B    BNE $AF92       branch if not "T"
.,AF77 C0 49    CPY #$49        compare variable name second character with "I"
.,AF79 D0 25    BNE $AFA0       branch if not "I"
                                variable name was "TI"
.,AF7B 20 84 AF JSR $AF84       read real time clock into FAC1 mantissa, 0HML
.,AF7E 98       TYA             clear A
.,AF7F A2 A0    LDX #$A0        set exponent to 32 bit value
.,AF81 4C 4F BC JMP $BC4F       set exponent = X and normalise FAC1

                                *** read real time clock into FAC1 mantissa, 0HML
.,AF84 20 DE FF JSR $FFDE       read real time clock
.,AF87 86 64    STX $64         save jiffy clock mid byte as  FAC1 mantissa 3
.,AF89 84 63    STY $63         save jiffy clock high byte as  FAC1 mantissa 2
.,AF8B 85 65    STA $65         save jiffy clock low byte as  FAC1 mantissa 4
.,AF8D A0 00    LDY #$00        clear Y
.,AF8F 84 62    STY $62         clear FAC1 mantissa 1
.,AF91 60       RTS             
                                variable name set-up, variable is float and not "Tx"
.,AF92 E0 53    CPX #$53        compare variable name first character with "S"
.,AF94 D0 0A    BNE $AFA0       if not "S" go do normal floating variable
.,AF96 C0 54    CPY #$54        compare variable name second character with "
.,AF98 D0 06    BNE $AFA0       if not "T" go do normal floating variable
                                variable name was "ST"
.,AF9A 20 B7 FF JSR $FFB7       read I/O status word
.,AF9D 4C 3C BC JMP $BC3C       save A as integer byte and return
                                variable is float
.,AFA0 A5 64    LDA $64         get variable pointer low byte
.,AFA2 A4 65    LDY $65         get variable pointer high byte
.,AFA4 4C A2 BB JMP $BBA2       unpack memory (AY) into FAC1

                                *** get value from line continued
                                only functions left so ..
                                set up function references
.,AFA7 0A       ASL             *2 (2 bytes per function address)
.,AFA8 48       PHA             save function offset
.,AFA9 AA       TAX             copy function offset
.,AFAA 20 73 00 JSR $0073       increment and scan memory
.,AFAD E0 8F    CPX #$8F        compare function offset to CHR$ token offset+1
.,AFAF 90 20    BCC $AFD1       branch if < LEFT$ (can not be =)
                                get value from line .. continued
                                was LEFT$, RIGHT$ or MID$ so..
.,AFB1 20 FA AE JSR $AEFA       scan for "(", else do syntax error then warm start
.,AFB4 20 9E AD JSR $AD9E       evaluate, should be string, expression
.,AFB7 20 FD AE JSR $AEFD       scan for ",", else do syntax error then warm start
.,AFBA 20 8F AD JSR $AD8F       check if source is string, else do type mismatch
.,AFBD 68       PLA             restore function offset
.,AFBE AA       TAX             copy it
.,AFBF A5 65    LDA $65         get descriptor pointer high byte
.,AFC1 48       PHA             push string pointer high byte
.,AFC2 A5 64    LDA $64         get descriptor pointer low byte
.,AFC4 48       PHA             push string pointer low byte
.,AFC5 8A       TXA             restore function offset
.,AFC6 48       PHA             save function offset
.,AFC7 20 9E B7 JSR $B79E       get byte parameter
.,AFCA 68       PLA             restore function offset
.,AFCB A8       TAY             copy function offset
.,AFCC 8A       TXA             copy byte parameter to A
.,AFCD 48       PHA             push byte parameter
.,AFCE 4C D6 AF JMP $AFD6       go call function
                                get value from line .. continued
                                was SGN() to CHR$() so..
.,AFD1 20 F1 AE JSR $AEF1       evaluate expression within parentheses
.,AFD4 68       PLA             restore function offset
.,AFD5 A8       TAY             copy to index
.,AFD6 B9 EA 9F LDA $9FEA,Y     get function jump vector low byte
.,AFD9 85 55    STA $55         save functions jump vector low byte
.,AFDB B9 EB 9F LDA $9FEB,Y     get function jump vector high byte
.,AFDE 85 56    STA $56         save functions jump vector high byte
.,AFE0 20 54 00 JSR $0054       do function call
.,AFE3 4C 8D AD JMP $AD8D       check if source is numeric and RTS, else do type mismatch
                                string functions avoid this by dumping the return address

                                *** perform OR
                                this works because NOT(NOT(x) AND NOT(y)) = x OR y
.,AFE6 A0 FF    LDY #$FF        set Y for OR
.:AFE8 2C       .BYTE $2C       makes next line BIT $00A0

                                *** perform AND
.,AFE9 A0 00    LDY #$00        clear Y for AND
.,AFEB 84 0B    STY $0B         set AND/OR invert value
.,AFED 20 BF B1 JSR $B1BF       evaluate integer expression, no sign check
.,AFF0 A5 64    LDA $64         get FAC1 mantissa 3
.,AFF2 45 0B    EOR $0B         EOR low byte
.,AFF4 85 07    STA $07         save it
.,AFF6 A5 65    LDA $65         get FAC1 mantissa 4
.,AFF8 45 0B    EOR $0B         EOR high byte
.,AFFA 85 08    STA $08         save it
.,AFFC 20 FC BB JSR $BBFC       copy FAC2 to FAC1, get 2nd value in expression
.,AFFF 20 BF B1 JSR $B1BF       evaluate integer expression, no sign check
.,B002 A5 65    LDA $65         get FAC1 mantissa 4
.,B004 45 0B    EOR $0B         EOR high byte
.,B006 25 08    AND $08         AND with expression 1 high byte
.,B008 45 0B    EOR $0B         EOR result high byte
.,B00A A8       TAY             save in Y
.,B00B A5 64    LDA $64         get FAC1 mantissa 3
.,B00D 45 0B    EOR $0B         EOR low byte
.,B00F 25 07    AND $07         AND with expression 1 low byte
.,B011 45 0B    EOR $0B         EOR result low byte
.,B013 4C 91 B3 JMP $B391       convert fixed integer AY to float FAC1 and return

                                *** perform comparisons
                                do < compare
.,B016 20 90 AD JSR $AD90       type match check, set C for string
.,B019 B0 13    BCS $B02E       branch if string
                                do numeric < compare
.,B01B A5 6E    LDA $6E         get FAC2 sign (b7)
.,B01D 09 7F    ORA #$7F        set all non sign bits
.,B01F 25 6A    AND $6A         and FAC2 mantissa 1 (AND in sign bit)
.,B021 85 6A    STA $6A         save FAC2 mantissa 1
.,B023 A9 69    LDA #$69        set pointer low byte to FAC2
.,B025 A0 00    LDY #$00        set pointer high byte to FAC2
.,B027 20 5B BC JSR $BC5B       compare FAC1 with (AY)
.,B02A AA       TAXcopy the result
.,B02B 4C 61 B0 JMP $B061       go evaluate result
                                do string < compare
.,B02E A9 00    LDA #$00        clear byte
.,B030 85 0D    STA $0D         clear data type flag, $FF = string, $00 = numeric
.,B032 C6 4D    DEC $4D         clear < bit in comparrison evaluation flag
.,B034 20 A6 B6 JSR $B6A6       pop string off descriptor stack, or from top of string
                                space returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,B037 85 61    STA $61         save length
.,B039 86 62    STX $62         save string pointer low byte
.,B03B 84 63    STY $63         save string pointer high byte
.,B03D A5 6C    LDA $6C         get descriptor pointer low byte
.,B03F A4 6D    LDY $6D         get descriptor pointer high byte
.,B041 20 AA B6 JSR $B6AA       pop (YA) descriptor off stack or from top of string space
                                returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,B044 86 6C    STX $6C         save string pointer low byte
.,B046 84 6D    STY $6D         save string pointer high byte
.,B048 AA       TAX             copy length
.,B049 38       SEC             set carry for subtract
.,B04A E5 61    SBC $61         subtract string 1 length
.,B04C F0 08    BEQ $B056       branch if str 1 length = string 2 length
.,B04E A9 01    LDA #$01        set str 1 length > string 2 length
.,B050 90 04    BCC $B056       branch if so
.,B052 A6 61    LDX $61         get string 1 length
.,B054 A9 FF    LDA #$FF        set str 1 length < string 2 length
.,B056 85 66    STA $66         save length compare
.,B058 A0 FF    LDY #$FF        set index
.,B05A E8       INX             adjust for loop
.,B05B C8       INY             increment index
.,B05C CA       DEX             decrement count
.,B05D D0 07    BNE $B066       branch if still bytes to do
.,B05F A6 66    LDX $66         get length compare back
.,B061 30 0F    BMI $B072       branch if str 1 < str 2
.,B063 18       CLC             flag str 1 <= str 2
.,B064 90 0C    BCC $B072       go evaluate result
.,B066 B1 6C    LDA ($6C),Y     get string 2 byte
.,B068 D1 62    CMP ($62),Y     compare with string 1 byte
.,B06A F0 EF    BEQ $B05B       loop if bytes =
.,B06C A2 FF    LDX #$FF        set str 1 < string 2
.,B06E B0 02    BCS $B072       branch if so
.,B070 A2 01    LDX #$01        set str 1 > string 2
.,B072 E8       INX             x = 0, 1 or 2
.,B073 8A       TXA             copy to A
.,B074 2A       ROL             * 2 (1, 2 or 4)
.,B075 25 12    AND $12         AND with the comparison evaluation flag
.,B077 F0 02    BEQ $B07B       branch if 0 (compare is false)
.,B079 A9 FF    LDA #$FFelse set result true
.,B07B 4C 3C BC JMP $BC3C       save A as integer byte and return
.,B07E 20 FD AE JSR $AEFD       scan for ",", else do syntax error then warm start

                                *** perform DIM
.,B081 AA       TAX             copy "DIM" flag to X
.,B082 20 90 B0 JSR $B090       search for variable
.,B085 20 79 00 JSR $0079       scan memory
.,B088 D0 F4    BNE $B07E       scan for "," and loop if not null
.,B08A 60       RTS             

                                *** search for variable
.,B08B A2 00    LDX #$00        set DIM flag = $00
.,B08D 20 79 00 JSR $0079       scan memory, 1st character
.,B090 86 0C    STX $0C         save DIM flag
.,B092 85 45    STA $45         save 1st character
.,B094 20 79 00 JSR $0079       scan memory
.,B097 20 13 B1 JSR $B113       check byte, return Cb = 0 if<"A" or >"Z"
.,B09A B0 03    BCS $B09F       branch if ok
.,B09C 4C 08 AF JMP $AF08       else syntax error then warm start
                                was variable name so ...
.,B09F A2 00    LDX #$00        clear 2nd character temp
.,B0A1 86 0D    STX $0D         clear data type flag, $FF = string, $00 = numeric
.,B0A3 86 0E    STX $0E         clear data type flag, $80 = integer, $00 = float
.,B0A5 20 73 00 JSR $0073       increment and scan memory, 2nd character
.,B0A8 90 05    BCC $B0AF       if character = "0"-"9" (ok) go save 2nd character
                                2nd character wasn't "0" to "9" so ...
.,B0AA 20 13 B1 JSR $B113       check byte, return Cb = 0 if<"A" or >"Z"
.,B0AD 90 0B    BCC $B0BA       branch if <"A" or >"Z" (go check if string)
.,B0AF AA       TAX             copy 2nd character
                                ignore further (valid) characters in the variable name
.,B0B0 20 73 00 JSR $0073       increment and scan memory, 3rd character
.,B0B3 90 FB    BCC $B0B0       loop if character = "0"-"9" (ignore)
.,B0B5 20 13 B1 JSR $B113       check byte, return Cb = 0 if<"A" or >"Z"
.,B0B8 B0 F6    BCS $B0B0       loop if character = "A"-"Z" (ignore)
                                check if string variable
.,B0BA C9 24    CMP #$24        compare with "$"
.,B0BC D0 06    BNE $B0C4       branch if not string
                                type is string
.,B0BE A9 FF    LDA #$FF        set data type = string
.,B0C0 85 0D    STA $0D         set data type flag, $FF = string, $00 = numeric
.,B0C2 D0 10    BNE $B0D4       branch always
.,B0C4 C9 25    CMP #$25        compare with "%"
.,B0C6 D0 13    BNE $B0DB       branch if not integer
.,B0C8 A5 10    LDA $10         get subscript/FNX flag
.,B0CA D0 D0    BNE $B09C       if ?? do syntax error then warm start
.,B0CC A9 80    LDA #$80        set integer type
.,B0CE 85 0E    STA $0E         set data type = integer
.,B0D0 05 45    ORA $45         OR current variable name first byte
.,B0D2 85 45    STA $45         save current variable name first byte
.,B0D4 8A       TXA             get 2nd character back
.,B0D5 09 80    ORA #$80        set top bit, indicate string or integer variable
.,B0D7 AA       TAX             copy back to 2nd character temp
.,B0D8 20 73 00 JSR $0073       increment and scan memory
.,B0DB 86 46    STX $46         save 2nd character
.,B0DD 38       SEC             set carry for subtract
.,B0DE 05 10    ORA $10         or with subscript/FNX flag - or FN name
.,B0E0 E9 28    SBC #$28        subtract "("
.,B0E2 D0 03    BNE $B0E7       branch if not "("
.,B0E4 4C D1 B1 JMP $B1D1       go find, or make, array
                                either find or create variable
                                variable name wasn't xx(.... so look for plain variable
.,B0E7 A0 00    LDY #$00        clear A
.,B0E9 84 10    STY $10         clear subscript/FNX flag
.,B0EB A5 2D    LDA $2D         get start of variables low byte
.,B0ED A6 2E    LDX $2E         get start of variables high byte
.,B0EF 86 60    STX $60         save search address high byte
.,B0F1 85 5F    STA $5F         save search address low byte
.,B0F3 E4 30    CPX $30         compare with end of variables high byte
.,B0F5 D0 04    BNE $B0FB       skip next compare if <>
                                high addresses were = so compare low addresses
.,B0F7 C5 2F    CMP $2F         compare low address with end of variables low byte
.,B0F9 F0 22    BEQ $B11D       if not found go make new variable
.,B0FB A5 45    LDA $45         get 1st character of variable to find
.,B0FD D1 5F    CMP ($5F),Y     compare with variable name 1st character
.,B0FF D0 08    BNE $B109       branch if no match
                                1st characters match so compare 2nd character
.,B101 A5 46    LDA $46         get 2nd character of variable to find
.,B103 C8       INY             index to point to variable name 2nd character
.,B104 D1 5F    CMP ($5F),Y     compare with variable name 2nd character
.,B106 F0 7D    BEQ $B185       branch if match (found variable)
.,B108 88       DEY             else decrement index (now = $00)
.,B109 18       CLC             clear carry for add
.,B10A A5 5F    LDA $5F         get search address low byte
.,B10C 69 07    ADC #$07        +7, offset to next variable name
.,B10E 90 E1    BCC $B0F1       loop if no overflow to high byte
.,B110 E8       INX             else increment high byte
.,B111 D0 DC    BNE $B0EF       loop always, RAM doesn't extend to $FFFF
                                check byte, return Cb = 0 if<"A" or >"Z"
.,B113 C9 41    CMP #$41        compare with "A"
.,B115 90 05    BCC $B11C       exit if less
                                carry is set
.,B117 E9 5B    SBC #$5B        subtract "Z"+1
.,B119 38       SEC             set carry
.,B11A E9 A5    SBC #$A5        subtract $A5 (restore byte)
                                carry clear if byte > $5A
.,B11C 60       RTS             
                                reached end of variable memory without match
                                ... so create new variable
.,B11D 68       PLApop return address low byte
.,B11E 48       PHA             push return address low byte
.,B11F C9 2A    CMP #$2A        compare with expected calling routine return low byte
.,B121 D0 05    BNE $B128       if not get variable go create new variable
                                this will only drop through if the call was from $AF28 and is only called
                                from there if it is searching for a variable from the right hand side of a LET a=b
                                statement, it prevents the creation of variables not assigned a value.
                                value returned by this is either numeric zero, exponent byte is $00, or null string,
                                descriptor length byte is $00. in fact a pointer to any $00 byte would have done.
                                else return dummy null value
.,B123 A9 13    LDA #$13        set result pointer low byte
.,B125 A0 BF    LDY #$BF        set result pointer high byte
.,B127 60       RTS             
                                create new numeric variable
.,B128 A5 45    LDA $45         get variable name first character
.,B12A A4 46    LDY $46         get variable name second character
.,B12C C9 54    CMP #$54        compare first character with "T"
.,B12E D0 0B    BNE $B13B       branch if not "T"
.,B130 C0 C9    CPY #$C9        compare second character with "I$"
.,B132 F0 EF    BEQ $B123       if "I$" return null value
.,B134 C0 49    CPY #$49        compare second character with "I"
.,B136 D0 03    BNE $B13B       branch if not "I"
                                if name is "TI" do syntax error
.,B138 4C 08 AF JMP $AF08       do syntax error then warm start
.,B13B C9 53    CMP #$53        compare first character with "S"
.,B13D D0 04    BNE $B143       branch if not "S"
.,B13F C0 54    CPY #$54        compare second character with "T"
.,B141 F0 F5    BEQ $B138       if name is "ST" do syntax error
.,B143 A5 2F    LDA $2F         get end of variables low byte
.,B145 A4 30    LDY $30         get end of variables high byte
.,B147 85 5F    STA $5F         save old block start low byte
.,B149 84 60    STY $60         save old block start high byte
.,B14B A5 31    LDA $31         get end of arrays low byte
.,B14D A4 32    LDY $32         get end of arrays high byte
.,B14F 85 5A    STA $5A         save old block end low byte
.,B151 84 5B    STY $5B         save old block end high byte
.,B153 18       CLC             clear carry for add
.,B154 69 07    ADC #$07        +7, space for one variable
.,B156 90 01    BCC $B159       branch if no overflow to high byte
.,B158 C8       INY             else increment high byte
.,B159 85 58    STA $58         set new block end low byte
.,B15B 84 59    STY $59         set new block end high byte
.,B15D 20 B8 A3 JSR $A3B8       open up space in memory
.,B160 A5 58    LDA $58         get new start low byte
.,B162 A4 59    LDY $59         get new start high byte (-$100)
.,B164 C8       INY             correct high byte
.,B165 85 2F    STA $2F         set end of variables low byte
.,B167 84 30    STY $30         set end of variables high byte
.,B169 A0 00    LDY #$00        clear index
.,B16B A5 45    LDA $45         get variable name 1st character
.,B16D 91 5F    STA ($5F),Y     save variable name 1st character
.,B16F C8       INY             increment index
.,B170 A5 46    LDA $46         get variable name 2nd character
.,B172 91 5F    STA ($5F),Y     save variable name 2nd character
.,B174 A9 00    LDA #$00        clear A
.,B176 C8       INY             increment index
.,B177 91 5F    STA ($5F),Y     initialise variable byte
.,B179 C8       INY             increment index
.,B17A 91 5F    STA ($5F),Y     initialise variable byte
.,B17C C8       INY             increment index
.,B17D 91 5F    STA ($5F),Y     initialise variable byte
.,B17F C8       INY             increment index
.,B180 91 5F    STA ($5F),Y     initialise variable byte
.,B182 C8       INY             increment index
.,B183 91 5F    STA ($5F),Y     initialise variable byte
                                found a match for variable
.,B185 A5 5F    LDA $5F         get variable address low byte
.,B187 18       CLC             clear carry for add
.,B188 69 02    ADC #$02        +2, offset past variable name bytes
.,B18A A4 60    LDY $60         get variable address high byte
.,B18C 90 01    BCC $B18F       branch if no overflow from add
.,B18E C8       INYelse increment high byte
.,B18F 85 47    STA $47         save current variable pointer low byte
.,B191 84 48    STY $48         save current variable pointer high byte
.,B193 60       RTS             
                                set-up array pointer to first element in array
.,B194 A5 0B    LDA $0B         get # of dimensions (1, 2 or 3)
.,B196 0A       ASL             *2 (also clears the carry !)
.,B197 69 05    ADC #$05        +5 (result is 7, 9 or 11 here)
.,B199 65 5F    ADC $5F         add array start pointer low byte
.,B19B A4 60    LDY $60         get array pointer high byte
.,B19D 90 01    BCC $B1A0       branch if no overflow
.,B19F C8       INY             else increment high byte
.,B1A0 85 58    STA $58         save array data pointer low byte
.,B1A2 84 59    STY $59         save array data pointer high byte
.,B1A4 60       RTS             

                                *** -32768 as floating value
.:B1A5 90 80 00 00 00           -32768

                                *** convert float to fixed
.,B1AA 20 BF B1 JSR $B1BF       evaluate integer expression, no sign check
.,B1AD A5 64    LDA $64         get result low byte
.,B1AF A4 65    LDY $65         get result high byte
.,B1B1 60       RTS             

                                *** evaluate integer expression
.,B1B2 20 73 00 JSR $0073       increment and scan memory
.,B1B5 20 9E AD JSR $AD9E       evaluate expression
                                evaluate integer expression, sign check
.,B1B8 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,B1BB A5 66    LDA $66         get FAC1 sign (b7)
.,B1BD 30 0D    BMI $B1CC       do illegal quantity error if -ve
                                evaluate integer expression, no sign check
.,B1BF A5 61    LDA $61         get FAC1 exponent
.,B1C1 C9 90    CMP #$90        compare with exponent = 2^16 (n>2^15)
.,B1C3 90 09    BCC $B1CE       if n<2^16 go convert FAC1 floating to fixed and return
.,B1C5 A9 A5    LDA #$A5        set pointer low byte to -32768
.,B1C7 A0 B1    LDY #$B1        set pointer high byte to -32768
.,B1C9 20 5B BC JSR $BC5B       compare FAC1 with (AY)
.,B1CC D0 7A    BNE $B248       if <> do illegal quantity error then warm start
.,B1CE 4C 9B BC JMP $BC9B       convert FAC1 floating to fixed and return

                                *** find or make array
                                an array is stored as follows
                                
                                array name             two bytes with the following patterns for different types
                                                       1st char    2nd char
                                                          b7          b7       type             element size
                                                       --------    --------    -----            ------------
                                                          0           0        floating point   5
                                                          0           1        string           3
                                                          1           1        integer          2
                                offset to next array   word
                                dimension count        byte
                                1st dimension size     word, this is the number of elements including 0
                                2nd dimension size     word, only here if the array has a second dimension
                                2nd dimension size     word, only here if the array has a third dimension
                                                       note: the dimension size word is in high byte low byte
                                                       format, not like most 6502 words
                                then for each element the required number of bytes given as the element size above
.,B1D1 A5 0C    LDA $0C         get DIM flag
.,B1D3 05 0E    ORA $0E         OR with data type flag
.,B1D5 48       PHA             push it
.,B1D6 A5 0D    LDA $0D         get data type flag, $FF = string, $00 = numeric
.,B1D8 48       PHA             push it
.,B1D9 A0 00    LDY #$00        clear dimensions count
                                now get the array dimension(s) and stack it (them) before the data type and DIM flag
.,B1DB 98       TYA             copy dimensions count
.,B1DC 48       PHA             save it
.,B1DD A5 46    LDA $46         get array name 2nd byte
.,B1DF 48       PHA             save it
.,B1E0 A5 45    LDA $45         get array name 1st byte
.,B1E2 48       PHA             save it
.,B1E3 20 B2 B1 JSR $B1B2       evaluate integer expression
.,B1E6 68       PLA             pull array name 1st byte
.,B1E7 85 45    STA $45         restore array name 1st byte
.,B1E9 68       PLA             pull array name 2nd byte
.,B1EA 85 46    STA $46         restore array name 2nd byte
.,B1EC 68       PLA             pull dimensions count
.,B1ED A8       TAY             restore it
.,B1EE BA       TSX             copy stack pointer
.,B1EF BD 02 01 LDA $0102,X     get DIM flag
.,B1F2 48       PHA             push it
.,B1F3 BD 01 01 LDA $0101,X     get data type flag
.,B1F6 48       PHA             push it
.,B1F7 A5 64    LDA $64         get this dimension size high byte
.,B1F9 9D 02 01 STA $0102,X     stack before flag bytes
.,B1FC A5 65    LDA $65         get this dimension size low byte
.,B1FE 9D 01 01 STA $0101,X     stack before flag bytes
.,B201 C8       INY             increment dimensions count
.,B202 20 79 00 JSR $0079       scan memory
.,B205 C9 2C    CMP #$2C        compare with ","
.,B207 F0 D2    BEQ $B1DB       if found go do next dimension
.,B209 84 0B    STY $0B         store dimensions count
.,B20B 20 F7 AE JSR $AEF7       scan for ")", else do syntax error then warm start
.,B20E 68       PLA             pull data type flag
.,B20F 85 0D    STA $0D         restore data type flag, $FF = string, $00 = numeric
.,B211 68       PLA             pull data type flag
.,B212 85 0E    STA $0E         restore data type flag, $80 = integer, $00 = float
.,B214 29 7F    AND #$7F        mask dim flag
.,B216 85 0C    STA $0C         restore DIM flag
.,B218 A6 2F    LDX $2F         set end of variables low byte
                                (array memory start low byte)
.,B21A A5 30    LDA $30         set end of variables high byte
                                (array memory start high byte)
                                now check to see if we are at the end of array memory, we would be if there were
                                no arrays.
.,B21C 86 5F    STX $5F         save as array start pointer low byte
.,B21E 85 60    STA $60         save as array start pointer high byte
.,B220 C5 32    CMP $32         compare with end of arrays high byte
.,B222 D0 04    BNE $B228       branch if not reached array memory end
.,B224 E4 31    CPX $31         else compare with end of arrays low byte
.,B226 F0 39    BEQ $B261       go build array if not found
                                search for array
.,B228 A0 00    LDY #$00        clear index
.,B22A B1 5F    LDA ($5F),Y     get array name first byte
.,B22C C8       INY             increment index to second name byte
.,B22D C5 45    CMP $45         compare with this array name first byte
.,B22F D0 06    BNE $B237       branch if no match
.,B231 A5 46    LDA $46         else get this array name second byte
.,B233 D1 5F    CMP ($5F),Y     compare with array name second byte
.,B235 F0 16    BEQ $B24D       array found so branch
                                no match
.,B237 C8       INY             increment index
.,B238 B1 5F    LDA ($5F),Y     get array size low byte
.,B23A 18       CLC             clear carry for add
.,B23B 65 5F    ADC $5F         add array start pointer low byte
.,B23D AA       TAX             copy low byte to X
.,B23E C8       INY             increment index
.,B23F B1 5F    LDA ($5F),Y     get array size high byte
.,B241 65 60    ADC $60         add array memory pointer high byte
.,B243 90 D7    BCC $B21C       if no overflow go check next array

                                *** do bad subscript error
.,B245 A2 12    LDX #$12        error $12, bad subscript error
.:B247 2C       .BYTE $2C       makes next line BIT $0EA2

                                *** do illegal quantity error
.,B248 A2 0E    LDX #$0E        error $0E, illegal quantity error
.,B24A 4C 37 A4 JMP $A437       do error #X then warm start

                                *** found the array
.,B24D A2 13    LDX #$13        set error $13, double dimension error
.,B24F A5 0C    LDA $0C         get DIM flag
.,B251 D0 F7    BNE $B24A       if we are trying to dimension it do error #X then warm
                                start
                                found the array and we're not dimensioning it so we must find an element in it
.,B253 20 94 B1 JSR $B194       set-up array pointer to first element in array
.,B256 A5 0B    LDA $0B         get dimensions count
.,B258 A0 04    LDY #$04        set index to array's # of dimensions
.,B25A D1 5F    CMP ($5F),Y     compare with no of dimensions
.,B25C D0 E7    BNE $B245       if wrong do bad subscript error
.,B25E 4C EA B2 JMP $B2EA       found array so go get element
                                array not found, so build it
.,B261 20 94 B1 JSR $B194       set-up array pointer to first element in array
.,B264 20 08 A4 JSR $A408       check available memory, do out of memory error if no room
.,B267 A0 00    LDY #$00        clear Y
.,B269 84 72    STY $72         clear array data size high byte
.,B26B A2 05    LDX #$05        set default element size
.,B26D A5 45    LDA $45         get variable name 1st byte
.,B26F 91 5F    STA ($5F),Y     save array name 1st byte
.,B271 10 01    BPL $B274       branch if not string or floating point array
.,B273 CA       DEX             decrement element size, $04
.,B274 C8       INY             increment index
.,B275 A5 46    LDA $46         get variable name 2nd byte
.,B277 91 5F    STA ($5F),Y     save array name 2nd byte
.,B279 10 02    BPL $B27D       branch if not integer or string
.,B27B CA       DEX             decrement element size, $03
.,B27C CA       DEX             decrement element size, $02
.,B27D 86 71    STX $71         save element size
.,B27F A5 0B    LDA $0B         get dimensions count
.,B281 C8       INY             increment index ..
.,B282 C8       INY             .. to array  ..
.,B283 C8       INY             .. dimension count
.,B284 91 5F    STA ($5F),Y     save array dimension count
.,B286 A2 0B    LDX #$0B        set default dimension size low byte
.,B288 A9 00    LDA #$00        set default dimension size high byte
.,B28A 24 0C    BIT $0C         test DIM flag
.,B28C 50 08    BVC $B296       branch if default to be used
.,B28E 68       PLA             pull dimension size low byte
.,B28F 18       CLC             clear carry for add
.,B290 69 01    ADC #$01        add 1, allow for zeroeth element
.,B292 AA       TAX             copy low byte to X
.,B293 68       PLA             pull dimension size high byte
.,B294 69 00    ADC #$00        add carry to high byte
.,B296 C8       INY             incement index to dimension size high byte
.,B297 91 5F    STA ($5F),Y     save dimension size high byte
.,B299 C8       INY             incement index to dimension size low byte
.,B29A 8A       TXA             copy dimension size low byte
.,B29B 91 5F    STA ($5F),Y     save dimension size low byte
.,B29D 20 4C B3 JSR $B34C       compute array size
.,B2A0 86 71    STX $71         save result low byte
.,B2A2 85 72    STA $72         save result high byte
.,B2A4 A4 22    LDY $22         restore index
.,B2A6 C6 0B    DEC $0B         decrement dimensions count
.,B2A8 D0 DC    BNE $B286       loop if not all done
.,B2AA 65 59    ADC $59         add array data pointer high byte
.,B2AC B0 5D    BCS $B30B       if overflow do out of memory error then warm start
.,B2AE 85 59    STA $59         save array data pointer high byte
.,B2B0 A8       TAY             copy array data pointer high byte
.,B2B1 8A       TXA             copy array size low byte
.,B2B2 65 58    ADC $58         add array data pointer low byte
.,B2B4 90 03    BCC $B2B9       branch if no rollover
.,B2B6 C8       INY             else increment next array pointer high byte
.,B2B7 F0 52    BEQ $B30B       if rolled over do out of memory error then warm start
.,B2B9 20 08 A4 JSR $A408       check available memory, do out of memory error if no room
.,B2BC 85 31    STA $31         set end of arrays low byte
.,B2BE 84 32    STY $32         set end of arrays high byte
                                now the aray is created we need to zero all the elements in it
.,B2C0 A9 00    LDA #$00        clear A for array clear
.,B2C2 E6 72    INC $72increment array size high byte, now block count
.,B2C4 A4 71    LDY $71         get array size low byte, now index to block
.,B2C6 F0 05    BEQ $B2CD       branch if $00
.,B2C8 88       DEY             decrement index, do 0 to n-1
.,B2C9 91 58    STA ($58),Y     clear array element byte
.,B2CB D0 FB    BNE $B2C8       loop until this block done
.,B2CD C6 59    DEC $59decrement array pointer high byte
.,B2CF C6 72    DEC $72decrement block count high byte
.,B2D1 D0 F5    BNE $B2C8loop until all blocks done
.,B2D3 E6 59    INC $59correct for last loop
.,B2D5 38       SEC             set carry for subtract
.,B2D6 A5 31    LDA $31         get end of arrays low byte
.,B2D8 E5 5F    SBC $5F         subtract array start low byte
.,B2DA A0 02    LDY #$02        index to array size low byte
.,B2DC 91 5F    STA ($5F),Y     save array size low byte
.,B2DE A5 32    LDA $32         get end of arrays high byte
.,B2E0 C8       INY             index to array size high byte
.,B2E1 E5 60    SBC $60         subtract array start high byte
.,B2E3 91 5F    STA ($5F),Y     save array size high byte
.,B2E5 A5 0C    LDA $0C         get default DIM flag
.,B2E7 D0 62    BNE $B34B       exit if this was a DIM command
                                else, find element
.,B2E9 C8       INY             set index to # of dimensions, the dimension indeces
                                are on the stack and will be removed as the position
                                of the array element is calculated
.,B2EA B1 5F    LDA ($5F),Y     get array's dimension count
.,B2EC 85 0B    STA $0B         save it
.,B2EE A9 00    LDA #$00        clear byte
.,B2F0 85 71    STA $71         clear array data pointer low byte
.,B2F2 85 72    STA $72         save array data pointer high byte
.,B2F4 C8       INY             increment index, point to array bound high byte
.,B2F5 68       PLA             pull array index low byte
.,B2F6 AA       TAX             copy to X
.,B2F7 85 64    STA $64         save index low byte to FAC1 mantissa 3
.,B2F9 68       PLA             pull array index high byte
.,B2FA 85 65    STA $65         save index high byte to FAC1 mantissa 4
.,B2FC D1 5F    CMP ($5F),Y     compare with array bound high byte
.,B2FE 90 0E    BCC $B30E       branch if within bounds
.,B300 D0 06    BNE $B308       if outside bounds do bad subscript error
                                else high byte was = so test low bytes
.,B302 C8       INY             index to array bound low byte
.,B303 8A       TXA             get array index low byte
.,B304 D1 5F    CMP ($5F),Y     compare with array bound low byte
.,B306 90 07    BCC $B30F       branch if within bounds
.,B308 4C 45 B2 JMP $B245       do bad subscript error
.,B30B 4C 35 A4 JMP $A435       do out of memory error then warm start
.,B30E C8       INY             index to array bound low byte
.,B30F A5 72    LDA $72         get array data pointer high byte
.,B311 05 71    ORA $71         OR with array data pointer low byte
.,B313 18       CLC             clear carry for either add, carry always clear here ??
.,B314 F0 0A    BEQ $B320       branch if array data pointer = null, skip multiply
.,B316 20 4C B3 JSR $B34C       compute array size
.,B319 8A       TXA             get result low byte
.,B31A 65 64    ADC $64add index low byte from FAC1 mantissa 3
.,B31C AA       TAX             save result low byte
.,B31D 98       TYAget result high byte
.,B31E A4 22    LDY $22         restore index
.,B320 65 65    ADC $65add index high byte from FAC1 mantissa 4
.,B322 86 71    STX $71save array data pointer low byte
.,B324 C6 0B    DEC $0B         decrement dimensions count
.,B326 D0 CA    BNE $B2F2       loop if dimensions still to do
.,B328 85 72    STA $72save array data pointer high byte
.,B32A A2 05    LDX #$05        set default element size
.,B32C A5 45    LDA $45         get variable name 1st byte
.,B32E 10 01    BPL $B331       branch if not string or floating point array
.,B330 CA       DEX             decrement element size, $04
.,B331 A5 46    LDA $46         get variable name 2nd byte
.,B333 10 02    BPL $B337       branch if not integer or string
.,B335 CA       DEX             decrement element size, $03
.,B336 CA       DEX             decrement element size, $02
.,B337 86 28    STX $28         save dimension size low byte
.,B339 A9 00    LDA #$00        clear dimension size high byte
.,B33B 20 55 B3 JSR $B355       compute array size
.,B33E 8A       TXA             copy array size low byte
.,B33F 65 58    ADC $58         add array data start pointer low byte
.,B341 85 47    STA $47         save as current variable pointer low byte
.,B343 98       TYA             copy array size high byte
.,B344 65 59    ADC $59         add array data start pointer high byte
.,B346 85 48    STA $48         save as current variable pointer high byte
.,B348 A8       TAY             copy high byte to Y
.,B349 A5 47    LDA $47         get current variable pointer low byte
                                pointer to element is now in AY
.,B34B 60       RTS             
                                compute array size, result in XY
.,B34C 84 22    STY $22         save index
.,B34E B1 5F    LDA ($5F),Y     get dimension size low byte
.,B350 85 28    STA $28         save dimension size low byte
.,B352 88       DEY             decrement index
.,B353 B1 5F    LDA ($5F),Y     get dimension size high byte
.,B355 85 29    STA $29         save dimension size high byte
.,B357 A9 10    LDA #$10        count = $10 (16 bit multiply)
.,B359 85 5D    STA $5D         save bit count
.,B35B A2 00    LDX #$00        clear result low byte
.,B35D A0 00    LDY #$00        clear result high byte
.,B35F 8A       TXA             get result low byte
.,B360 0A       ASL             *2
.,B361 AA       TAX             save result low byte
.,B362 98       TYA             get result high byte
.,B363 2A       ROL             *2
.,B364 A8       TAY             save result high byte
.,B365 B0 A4    BCS $B30B       if overflow go do "Out of memory" error
.,B367 06 71    ASL $71         shift element size low byte
.,B369 26 72    ROL $72         shift element size high byte
.,B36B 90 0B    BCC $B378       skip add if no carry
.,B36D 18       CLC             else clear carry for add
.,B36E 8A       TXA             get result low byte
.,B36F 65 28    ADC $28         add dimension size low byte
.,B371 AA       TAX             save result low byte
.,B372 98       TYA             get result high byte
.,B373 65 29    ADC $29         add dimension size high byte
.,B375 A8       TAY             save result high byte
.,B376 B0 93    BCS $B30B       if overflow go do "Out of memory" error
.,B378 C6 5D    DEC $5D         decrement bit count
.,B37A D0 E3    BNE $B35F       loop until all done
.,B37C 60       RTS             
                                perform FRE()
.,B37D A5 0D    LDA $0D         get data type flag, $FF = string, $00 = numeric
.,B37F F0 03    BEQ $B384       branch if numeric
.,B381 20 A6 B6 JSR $B6A6       pop string off descriptor stack, or from top of string
                                space returns with A = length, X=$71=pointer low byte,
                                Y=$72=pointer high byte
                                FRE(n) was numeric so do this
.,B384 20 26 B5 JSR $B526       go do garbage collection
.,B387 38       SEC             set carry for subtract
.,B388 A5 33    LDA $33         get bottom of string space low byte
.,B38A E5 31    SBC $31         subtract end of arrays low byte
.,B38C A8       TAY             copy result to Y
.,B38D A5 34    LDA $34         get bottom of string space high byte
.,B38F E5 32    SBC $32         subtract end of arrays high byte

                                *** convert fixed integer AY to float FAC1
.,B391 A2 00    LDX #$00        set type = numeric
.,B393 86 0D    STX $0D         clear data type flag, $FF = string, $00 = numeric
.,B395 85 62    STA $62         save FAC1 mantissa 1
.,B397 84 63    STY $63         save FAC1 mantissa 2
.,B399 A2 90    LDX #$90        set exponent=2^16 (integer)
.,B39B 4C 44 BC JMP $BC44       set exp = X, clear FAC1 3 and 4, normalise and return

                                *** perform POS()
.,B39E 38       SEC             set Cb for read cursor position
.,B39F 20 F0 FF JSR $FFF0       read/set X,Y cursor position
.,B3A2 A9 00    LDA #$00        clear high byte
.,B3A4 F0 EB    BEQ $B391       convert fixed integer AY to float FAC1, branch always
                                check not Direct, used by DEF and INPUT
.,B3A6 A6 3A    LDX $3A         get current line number high byte
.,B3A8 E8       INX             increment it
.,B3A9 D0 A0    BNE $B34B       return if not direct mode
                                else do illegal direct error
.,B3AB A2 15    LDX #$15        error $15, illegal direct error
.:B3AD 2C       .BYTE $2C       makes next line BIT $1BA2
.,B3AE A2 1B    LDX #$1B        error $1B, undefined function error
.,B3B0 4C 37 A4 JMP $A437       do error #X then warm start

                                *** perform DEF
.,B3B3 20 E1 B3 JSR $B3E1       check FNx syntax
.,B3B6 20 A6 B3 JSR $B3A6       check not direct, back here if ok
.,B3B9 20 FA AE JSR $AEFA       scan for "(", else do syntax error then warm start
.,B3BC A9 80    LDA #$80        set flag for FNx
.,B3BE 85 10    STA $10         save subscript/FNx flag
.,B3C0 20 8B B0 JSR $B08B       get variable address
.,B3C3 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,B3C6 20 F7 AE JSR $AEF7       scan for ")", else do syntax error then warm start
.,B3C9 A9 B2    LDA #$B2        get = token
.,B3CB 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,B3CE 48       PHA             push next character
.,B3CF A5 48    LDA $48         get current variable pointer high byte
.,B3D1 48       PHA             push it
.,B3D2 A5 47    LDA $47         get current variable pointer low byte
.,B3D4 48       PHA             push it
.,B3D5 A5 7B    LDA $7B         get BASIC execute pointer high byte
.,B3D7 48       PHA             push it
.,B3D8 A5 7A    LDA $7A         get BASIC execute pointer low byte
.,B3DA 48       PHA             push it
.,B3DB 20 F8 A8 JSR $A8F8       perform DATA
.,B3DE 4C 4F B4 JMP $B44F       put execute pointer and variable pointer into function
                                and return

                                *** check FNx syntax
.,B3E1 A9 A5    LDA #$A5        set FN token
.,B3E3 20 FF AE JSR $AEFF       scan for CHR$(A), else do syntax error then warm start
.,B3E6 09 80    ORA #$80        set FN flag bit
.,B3E8 85 10    STA $10         save FN name
.,B3EA 20 92 B0 JSR $B092       search for FN variable
.,B3ED 85 4E    STA $4E         save function pointer low byte
.,B3EF 84 4F    STY $4F         save function pointer high byte
.,B3F1 4C 8D AD JMP $AD8D       check if source is numeric and return, else do type
                                mismatch

                                *** Evaluate FNx
.,B3F4 20 E1 B3 JSR $B3E1       check FNx syntax
.,B3F7 A5 4F    LDA $4F         get function pointer high byte
.,B3F9 48       PHA             push it
.,B3FA A5 4E    LDA $4E         get function pointer low byte
.,B3FC 48       PHA             push it
.,B3FD 20 F1 AE JSR $AEF1       evaluate expression within parentheses
.,B400 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,B403 68       PLA             pop function pointer low byte
.,B404 85 4E    STA $4E         restore it
.,B406 68       PLA             pop function pointer high byte
.,B407 85 4F    STA $4F         restore it
.,B409 A0 02    LDY #$02        index to variable pointer high byte
.,B40B B1 4E    LDA ($4E),Y     get variable address low byte
.,B40D 85 47    STA $47         save current variable pointer low byte
.,B40F AA       TAX             copy address low byte
.,B410 C8       INY             index to variable address high byte
.,B411 B1 4E    LDA ($4E),Y     get variable pointer high byte
.,B413 F0 99    BEQ $B3AE       branch if high byte zero
.,B415 85 48    STA $48         save current variable pointer high byte
.,B417 C8       INY             index to mantissa 3
                                now stack the function variable value before use
.,B418 B1 47    LDA ($47),Y     get byte from variable
.,B41A 48       PHA             stack it
.,B41B 88       DEY             decrement index
.,B41C 10 FA    BPL $B418       loop until variable stacked
.,B41E A4 48    LDY $48get current variable pointer high byte
.,B420 20 D4 BB JSR $BBD4       pack FAC1 into (XY)
.,B423 A5 7B    LDA $7B         get BASIC execute pointer high byte
.,B425 48       PHA             push it
.,B426 A5 7A    LDA $7A         get BASIC execute pointer low byte
.,B428 48       PHA             push it
.,B429 B1 4E    LDA ($4E),Y     get function execute pointer low byte
.,B42B 85 7A    STA $7A         save BASIC execute pointer low byte
.,B42D C8       INY             index to high byte
.,B42E B1 4E    LDA ($4E),Y     get function execute pointer high byte
.,B430 85 7B    STA $7B         save BASIC execute pointer high byte
.,B432 A5 48    LDA $48         get current variable pointer high byte
.,B434 48       PHA             push it
.,B435 A5 47    LDA $47         get current variable pointer low byte
.,B437 48       PHA             push it
.,B438 20 8A AD JSR $AD8A       evaluate expression and check is numeric, else do
                                type mismatch
.,B43B 68       PLA             pull variable address low byte
.,B43C 85 4E    STA $4E         save variable address low byte
.,B43E 68       PLA             pull variable address high byte
.,B43F 85 4F    STA $4F         save variable address high byte
.,B441 20 79 00 JSR $0079       scan memory
.,B444 F0 03    BEQ $B449       branch if null (should be [EOL] marker)
.,B446 4C 08 AF JMP $AF08       else syntax error then warm start

                                *** restore BASIC execute pointer and function variable from stack
.,B449 68       PLA             pull BASIC execute pointer low byte
.,B44A 85 7A    STA $7A         save BASIC execute pointer low byte
.,B44C 68       PLA             pull BASIC execute pointer high byte
.,B44D 85 7B    STA $7B         save BASIC execute pointer high byte
                                put execute pointer and variable pointer into function
.,B44F A0 00    LDY #$00        clear index
.,B451 68       PLA             pull BASIC execute pointer low byte
.,B452 91 4E    STA ($4E),Y     save to function
.,B454 68       PLA             pull BASIC execute pointer high byte
.,B455 C8       INY             increment index
.,B456 91 4E    STA ($4E),Y     save to function
.,B458 68       PLA             pull current variable address low byte
.,B459 C8       INY             increment index
.,B45A 91 4E    STA ($4E),Y     save to function
.,B45C 68       PLA             pull current variable address high byte
.,B45D C8       INY             increment index
.,B45E 91 4E    STA ($4E),Y     save to function
.,B460 68       PLA             pull ??
.,B461 C8       INY             increment index
.,B462 91 4E    STA ($4E),Y     save to function
.,B464 60       RTS             

                                *** perform STR$()
.,B465 20 8D AD JSR $AD8D       check if source is numeric, else do type mismatch
.,B468 A0 00    LDY #$00        set string index
.,B46A 20 DF BD JSR $BDDF       convert FAC1 to string
.,B46D 68       PLA             dump return address (skip type check)
.,B46E 68       PLA             dump return address (skip type check)
.,B46F A9 FF    LDA #$FF        set result string low pointer
.,B471 A0 00    LDY #$00        set result string high pointer
.,B473 F0 12    BEQ $B487print null terminated string to utility pointer

                                *** do string vector
                                copy descriptor pointer and make string space A bytes long
.,B475 A6 64    LDX $64         get descriptor pointer low byte
.,B477 A4 65    LDY $65         get descriptor pointer high byte
.,B479 86 50    STX $50         save descriptor pointer low byte
.,B47B 84 51    STY $51         save descriptor pointer high byte

                                *** make string space A bytes long
.,B47D 20 F4 B4 JSR $B4F4       make space in string memory for string A long
.,B480 86 62    STX $62         save string pointer low byte
.,B482 84 63    STY $63         save string pointer high byte
.,B484 85 61    STA $61         save length
.,B486 60       RTS

                                *** scan, set up string
                                print " terminated string to utility pointer
.,B487 A2 22    LDX #$22        set terminator to "
.,B489 86 07    STX $07         set search character, terminator 1
.,B48B 86 08    STX $08         set terminator 2
                                print search or alternate terminated string to utility pointer
                                source is AY
.,B48D 85 6F    STA $6F         store string start low byte
.,B48F 84 70    STY $70         store string start high byte
.,B491 85 62    STA $62         save string pointer low byte
.,B493 84 63    STY $63         save string pointer high byte
.,B495 A0 FF    LDY #$FF        set length to -1
.,B497 C8       INY             increment length
.,B498 B1 6F    LDA ($6F),Y     get byte from string
.,B49A F0 0C    BEQ $B4A8       exit loop if null byte [EOS]
.,B49C C5 07    CMP $07         compare with search character, terminator 1
.,B49E F0 04    BEQ $B4A4       branch if terminator
.,B4A0 C5 08    CMP $08         compare with terminator 2
.,B4A2 D0 F3    BNE $B497       loop if not terminator 2
.,B4A4 C9 22    CMP #$22        compare with "
.,B4A6 F0 01    BEQ $B4A9       branch if " (carry set if = !)
.,B4A8 18       CLC             clear carry for add (only if [EOL] terminated string)
.,B4A9 84 61    STY $61         save length in FAC1 exponent
.,B4AB 98       TYA             copy length to A
.,B4AC 65 6F    ADC $6F         add string start low byte
.,B4AE 85 71    STA $71         save string end low byte
.,B4B0 A6 70    LDX $70         get string start high byte
.,B4B2 90 01    BCC $B4B5       branch if no low byte overflow
.,B4B4 E8       INX             else increment high byte
.,B4B5 86 72    STX $72         save string end high byte
.,B4B7 A5 70    LDA $70         get string start high byte
.,B4B9 F0 04    BEQ $B4BF       branch if in utility area
.,B4BB C9 02    CMP #$02        compare with input buffer memory high byte
.,B4BD D0 0B    BNE $B4CA       branch if not in input buffer memory
                                string in input buffer or utility area, move to string
                                memory
.,B4BF 98       TYA             copy length to A
.,B4C0 20 75 B4 JSR $B475       copy descriptor pointer and make string space A bytes long
.,B4C3 A6 6F    LDX $6F         get string start low byte
.,B4C5 A4 70    LDY $70         get string start high byte
.,B4C7 20 88 B6 JSR $B688       store string A bytes long from XY to utility pointer
                                check for space on descriptor stack then ...
                                put string address and length on descriptor stack and update stack pointers
.,B4CA A6 16    LDX $16         get the descriptor stack pointer
.,B4CC E0 22    CPX #$22        compare it with the maximum + 1
.,B4CE D0 05    BNE $B4D5       if there is space on the string stack continue
                                else do string too complex error
.,B4D0 A2 19    LDX #$19        error $19, string too complex error
.,B4D2 4C 37 A4 JMP $A437       do error #X then warm start
                                put string address and length on descriptor stack and update stack pointers
.,B4D5 A5 61    LDA $61         get the string length
.,B4D7 95 00    STA $00,X       put it on the string stack
.,B4D9 A5 62    LDA $62         get the string pointer low byte
.,B4DB 95 01    STA $01,X       put it on the string stack
.,B4DD A5 63    LDA $63         get the string pointer high byte
.,B4DF 95 02    STA $02,X       put it on the string stack
.,B4E1 A0 00    LDY #$00        clear Y
.,B4E3 86 64    STX $64         save the string descriptor pointer low byte
.,B4E5 84 65    STY $65         save the string descriptor pointer high byte, always $00
.,B4E7 84 70    STY $70         clear FAC1 rounding byte
.,B4E9 88       DEY             Y = $FF
.,B4EA 84 0D    STY $0D         save the data type flag, $FF = string
.,B4EC 86 17    STX $17         save the current descriptor stack item pointer low byte
.,B4EE E8       INX             update the stack pointer
.,B4EF E8       INX             update the stack pointer
.,B4F0 E8       INX             update the stack pointer
.,B4F1 86 16    STX $16         save the new descriptor stack pointer
.,B4F3 60       RTS             

                                *** make space in string memory for string A long
                                return X = pointer low byte, Y = pointer high byte
.,B4F4 46 0F    LSR $0F         clear garbage collected flag (b7)
                                make space for string A long
.,B4F6 48       PHA             save string length
.,B4F7 49 FF    EOR #$FF        complement it
.,B4F9 38       SEC             set carry for subtract, two's complement add
.,B4FA 65 33    ADC $33         add bottom of string space low byte, subtract length
.,B4FC A4 34    LDY $34         get bottom of string space high byte
.,B4FE B0 01    BCS $B501       skip decrement if no underflow
.,B500 88       DEY             decrement bottom of string space high byte
.,B501 C4 32    CPY $32         compare with end of arrays high byte
.,B503 90 11    BCC $B516       do out of memory error if less
.,B505 D0 04    BNE $B50B       if not = skip next test
.,B507 C5 31    CMP $31         compare with end of arrays low byte
.,B509 90 0B    BCC $B516       do out of memory error if less
.,B50B 85 33    STA $33         save bottom of string space low byte
.,B50D 84 34    STY $34         save bottom of string space high byte
.,B50F 85 35    STA $35         save string utility ptr low byte
.,B511 84 36    STY $36         save string utility ptr high byte
.,B513 AA       TAX             copy low byte to X
.,B514 68       PLA             get string length back
.,B515 60       RTS             
.,B516 A2 10    LDX #$10        error code $10, out of memory error
.,B518 A5 0F    LDA $0F         get garbage collected flag
.,B51A 30 B6    BMI $B4D2       if set then do error code X
.,B51C 20 26 B5 JSR $B526       else go do garbage collection
.,B51F A9 80    LDA #$80        flag for garbage collected
.,B521 85 0F    STA $0F         set garbage collected flag
.,B523 68       PLA             pull length
.,B524 D0 D0    BNE $B4F6       go try again (loop always, length should never be = $00)

                                *** garbage collection routine
.,B526 A6 37    LDX $37         get end of memory low byte
.,B528 A5 38    LDA $38         get end of memory high byte
                                re-run routine from last ending
.,B52A 86 33    STX $33         set bottom of string space low byte
.,B52C 85 34    STA $34         set bottom of string space high byte
.,B52E A0 00    LDY #$00        clear index
.,B530 84 4F    STY $4F         clear working pointer high byte
.,B532 84 4E    STY $4E         clear working pointer low byte
.,B534 A5 31    LDA $31         get end of arrays low byte
.,B536 A6 32    LDX $32         get end of arrays high byte
.,B538 85 5F    STA $5F         save as highest uncollected string pointer low byte
.,B53A 86 60    STX $60         save as highest uncollected string pointer high byte
.,B53C A9 19    LDA #$19        set descriptor stack pointer
.,B53E A2 00    LDX #$00        clear X
.,B540 85 22    STA $22         save descriptor stack pointer low byte
.,B542 86 23    STX $23         save descriptor stack pointer high byte ($00)
.,B544 C5 16    CMP $16         compare with descriptor stack pointer
.,B546 F0 05    BEQ $B54D       branch if =
.,B548 20 C7 B5 JSR $B5C7       check string salvageability
.,B54B F0 F7    BEQ $B544       loop always
                                done stacked strings, now do string variables
.,B54D A9 07    LDA #$07        set step size = $07, collecting variables
.,B54F 85 53    STA $53         save garbage collection step size
.,B551 A5 2D    LDA $2D         get start of variables low byte
.,B553 A6 2E    LDX $2E         get start of variables high byte
.,B555 85 22    STA $22         save as pointer low byte
.,B557 86 23    STX $23         save as pointer high byte
.,B559 E4 30    CPX $30         compare end of variables high byte,
                                start of arrays high byte
.,B55B D0 04    BNE $B561       branch if no high byte match
.,B55D C5 2F    CMP $2F         else compare end of variables low byte,
                                start of arrays low byte
.,B55F F0 05    BEQ $B566       branch if = variable memory end
.,B561 20 BD B5 JSR $B5BD       check variable salvageability
.,B564 F0 F3    BEQ $B559       loop always
                                done string variables, now do string arrays
.,B566 85 58    STA $58         save start of arrays low byte as working pointer
.,B568 86 59    STX $59         save start of arrays high byte as working pointer
.,B56A A9 03    LDA #$03        set step size, collecting descriptors
.,B56C 85 53    STA $53         save step size
.,B56E A5 58    LDA $58         get pointer low byte
.,B570 A6 59    LDX $59         get pointer high byte
.,B572 E4 32    CPX $32         compare with end of arrays high byte
.,B574 D0 07    BNE $B57D       branch if not at end
.,B576 C5 31    CMP $31         else compare with end of arrays low byte
.,B578 D0 03    BNE $B57D       branch if not at end
.,B57A 4C 06 B6 JMP $B606       collect string, tidy up and exit if at end ??
.,B57D 85 22    STA $22         save pointer low byte
.,B57F 86 23    STX $23         save pointer high byte
.,B581 A0 00    LDY #$00        set index
.,B583 B1 22    LDA ($22),Y     get array name first byte
.,B585 AA       TAX             copy it
.,B586 C8       INY             increment index
.,B587 B1 22    LDA ($22),Y     get array name second byte
.,B589 08       PHP             push the flags
.,B58A C8       INY             increment index
.,B58B B1 22    LDA ($22),Y     get array size low byte
.,B58D 65 58    ADC $58         add start of this array low byte
.,B58F 85 58    STA $58         save start of next array low byte
.,B591 C8       INY             increment index
.,B592 B1 22    LDA ($22),Y     get array size high byte
.,B594 65 59    ADC $59         add start of this array high byte
.,B596 85 59    STA $59         save start of next array high byte
.,B598 28       PLP             restore the flags
.,B599 10 D3    BPL $B56E       skip if not string array
                                was possibly string array so ...
.,B59B 8A       TXA             get name first byte back
.,B59C 30 D0    BMI $B56E       skip if not string array
.,B59E C8       INY             increment index
.,B59F B1 22    LDA ($22),Y     get # of dimensions
.,B5A1 A0 00    LDY #$00        clear index
.,B5A3 0A       ASL             *2
.,B5A4 69 05    ADC #$05        +5 (array header size)
.,B5A6 65 22    ADC $22         add pointer low byte
.,B5A8 85 22    STA $22         save pointer low byte
.,B5AA 90 02    BCC $B5AE       branch if no rollover
.,B5AC E6 23    INC $23         else increment pointer hgih byte
.,B5AE A6 23    LDX $23         get pointer high byte
.,B5B0 E4 59    CPX $59         compare pointer high byte with end of this array high byte
.,B5B2 D0 04    BNE $B5B8       branch if not there yet
.,B5B4 C5 58    CMP $58         compare pointer low byte with end of this array low byte
.,B5B6 F0 BA    BEQ $B572       if at end of this array go check next array
.,B5B8 20 C7 B5 JSR $B5C7       check string salvageability
.,B5BB F0 F3    BEQ $B5B0       loop
                                check variable salvageability
.,B5BD B1 22    LDA ($22),Y     get variable name first byte
.,B5BF 30 35    BMI $B5F6       add step and exit if not string
.,B5C1 C8       INY             increment index
.,B5C2 B1 22    LDA ($22),Y     get variable name second byte
.,B5C4 10 30    BPL $B5F6       add step and exit if not string
.,B5C6 C8       INY             increment index
                                check string salvageability
.,B5C7 B1 22    LDA ($22),Y     get string length
.,B5C9 F0 2B    BEQ $B5F6       add step and exit if null string
.,B5CB C8       INY             increment index
.,B5CC B1 22    LDA ($22),Y     get string pointer low byte
.,B5CE AA       TAX             copy to X
.,B5CF C8       INY             increment index
.,B5D0 B1 22    LDA ($22),Y     get string pointer high byte
.,B5D2 C5 34    CMP $34         compare string pointer high byte with bottom of string
                                space high byte
.,B5D4 90 06    BCC $B5DC       if bottom of string space greater go test against highest
                                uncollected string
.,B5D6 D0 1E    BNE $B5F6       if bottom of string space less string has been collected
                                so go update pointers, step to next and return
                                high bytes were equal so test low bytes
.,B5D8 E4 33    CPX $33         compare string pointer low byte with bottom of string
                                space low byte
.,B5DA B0 1A    BCS $B5F6       if bottom of string space less string has been collected
                                so go update pointers, step to next and return
                                else test string against highest uncollected string so far
.,B5DC C5 60    CMP $60         compare string pointer high byte with highest uncollected
                                string high byte
.,B5DE 90 16    BCC $B5F6       if highest uncollected string is greater then go update
                                pointers, step to next and return
.,B5E0 D0 04    BNE $B5E6       if highest uncollected string is less then go set this
                                string as highest uncollected so far
                                high bytes were equal so test low bytes
.,B5E2 E4 5F    CPX $5F         compare string pointer low byte with highest uncollected
                                string low byte
.,B5E4 90 10    BCC $B5F6       if highest uncollected string is greater then go update
                                pointers, step to next and return
                                else set current string as highest uncollected string
.,B5E6 86 5F    STX $5F         save string pointer low byte as highest uncollected string
                                low byte
.,B5E8 85 60    STA $60         save string pointer high byte as highest uncollected
                                string high byte
.,B5EA A5 22    LDA $22         get descriptor pointer low byte
.,B5EC A6 23    LDX $23         get descriptor pointer high byte
.,B5EE 85 4E    STA $4E         save working pointer high byte
.,B5F0 86 4F    STX $4F         save working pointer low byte
.,B5F2 A5 53    LDA $53         get step size
.,B5F4 85 55    STA $55         copy step size
.,B5F6 A5 53    LDA $53         get step size
.,B5F8 18       CLC             clear carry for add
.,B5F9 65 22    ADC $22         add pointer low byte
.,B5FB 85 22    STA $22         save pointer low byte
.,B5FD 90 02    BCC $B601       branch if no rollover
.,B5FF E6 23    INC $23         else increment pointer high byte
.,B601 A6 23    LDX $23         get pointer high byte
.,B603 A0 00    LDY #$00        flag not moved
.,B605 60       RTS             
                                collect string
.,B606 A5 4F    LDA $4F         get working pointer low byte
.,B608 05 4E    ORA $4E         OR working pointer high byte
.,B60A F0 F5    BEQ $B601       exit if nothing to collect
.,B60C A5 55    LDA $55         get copied step size
.,B60E 29 04    AND #$04        mask step size, $04 for variables, $00 for array or stack
.,B610 4A       LSR             >> 1
.,B611 A8       TAY             copy to index
.,B612 85 55    STA $55         save offset to descriptor start
.,B614 B1 4E    LDA ($4E),Y     get string length low byte
.,B616 65 5F    ADC $5F         add string start low byte
.,B618 85 5A    STA $5A         set block end low byte
.,B61A A5 60    LDA $60         get string start high byte
.,B61C 69 00    ADC #$00        add carry
.,B61E 85 5B    STA $5B         set block end high byte
.,B620 A5 33    LDA $33         get bottom of string space low byte
.,B622 A6 34    LDX $34         get bottom of string space high byte
.,B624 85 58    STA $58         save destination end low byte
.,B626 86 59    STX $59         save destination end high byte
.,B628 20 BF A3 JSR $A3BF       open up space in memory, don't set array end. this
                                copies the string from where it is to the end of the
                                uncollected string memory
.,B62B A4 55    LDY $55         restore offset to descriptor start
.,B62D C8       INY             increment index to string pointer low byte
.,B62E A5 58    LDA $58         get new string pointer low byte
.,B630 91 4E    STA ($4E),Y     save new string pointer low byte
.,B632 AA       TAX             copy string pointer low byte
.,B633 E6 59    INC $59         increment new string pointer high byte
.,B635 A5 59    LDA $59         get new string pointer high byte
.,B637 C8       INY             increment index to string pointer high byte
.,B638 91 4E    STA ($4E),Y     save new string pointer high byte
.,B63A 4C 2A B5 JMP $B52A       re-run routine from last ending, XA holds new bottom
                                of string memory pointer

                                *** concatenate
                                add strings, the first string is in the descriptor, the second string is in line
.,B63D A5 65    LDA $65         get descriptor pointer high byte
.,B63F 48       PHA             put on stack
.,B640 A5 64    LDA $64         get descriptor pointer low byte
.,B642 48       PHA             put on stack
.,B643 20 83 AE JSR $AE83       get value from line
.,B646 20 8F AD JSR $AD8F       check if source is string, else do type mismatch
.,B649 68       PLA             get descriptor pointer low byte back
.,B64A 85 6F    STA $6F         set pointer low byte
.,B64C 68       PLA             get descriptor pointer high byte back
.,B64D 85 70    STA $70         set pointer high byte
.,B64F A0 00    LDY #$00        clear index
.,B651 B1 6F    LDA ($6F),Y     get length of first string from descriptor
.,B653 18       CLC             clear carry for add
.,B654 71 64    ADC ($64),Y     add length of second string
.,B656 90 05    BCC $B65D       branch if no overflow
.,B658 A2 17    LDX #$17        else error $17, string too long error
.,B65A 4C 37 A4 JMP $A437       do error #X then warm start
.,B65D 20 75 B4 JSR $B475       copy descriptor pointer and make string space A bytes long
.,B660 20 7A B6 JSR $B67A       copy string from descriptor to utility pointer
.,B663 A5 50    LDA $50         get descriptor pointer low byte
.,B665 A4 51    LDY $51         get descriptor pointer high byte
.,B667 20 AA B6 JSR $B6AA       pop (YA) descriptor off stack or from top of string space
                                returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,B66A 20 8C B6 JSR $B68C       store string from pointer to utility pointer
.,B66D A5 6F    LDA $6F         get descriptor pointer low byte
.,B66F A4 70    LDY $70         get descriptor pointer high byte
.,B671 20 AA B6 JSR $B6AA       pop (YA) descriptor off stack or from top of string space
                                returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,B674 20 CA B4 JSR $B4CA       check space on descriptor stack then put string address
                                and length on descriptor stack and update stack pointers
.,B677 4C B8 AD JMP $ADB8       continue evaluation

                                *** copy string from descriptor to utility pointer
.,B67A A0 00    LDY #$00        clear index
.,B67C B1 6F    LDA ($6F),Y     get string length
.,B67E 48       PHA             save it
.,B67F C8       INY             increment index
.,B680 B1 6F    LDA ($6F),Y     get string pointer low byte
.,B682 AA       TAX             copy to X
.,B683 C8       INY             increment index
.,B684 B1 6F    LDA ($6F),Y     get string pointer high byte
.,B686 A8       TAY             copy to Y
.,B687 68       PLA             get length back
.,B688 86 22    STX $22         save string pointer low byte
.,B68A 84 23    STY $23         save string pointer high byte
                                store string from pointer to utility pointer
.,B68C A8       TAY             copy length as index
.,B68D F0 0A    BEQ $B699       branch if null string
.,B68F 48       PHA             save length
.,B690 88       DEY             decrement length/index
.,B691 B1 22    LDA ($22),Y     get byte from string
.,B693 91 35    STA ($35),Y     save byte to destination
.,B695 98       TYA             copy length/index
.,B696 D0 F8    BNE $B690       loop if not all done yet
.,B698 68       PLA             restore length
.,B699 18       CLC             clear carry for add
.,B69A 65 35    ADC $35         add string utility ptr low byte
.,B69C 85 35    STA $35         save string utility ptr low byte
.,B69E 90 02    BCC $B6A2       branch if no rollover
.,B6A0 E6 36    INC $36         increment string utility ptr high byte
.,B6A2 60       RTS             

                                *** evaluate string
.,B6A3 20 8F AD JSR $AD8F       check if source is string, else do type mismatch
                                pop string off descriptor stack, or from top of string space
                                returns with A = length, X = pointer low byte, Y = pointer high byte
.,B6A6 A5 64    LDA $64         get descriptor pointer low byte
.,B6A8 A4 65    LDY $65         get descriptor pointer high byte
                                pop (YA) descriptor off stack or from top of string space
                                returns with A = length, X = pointer low byte, Y = pointer high byte
.,B6AA 85 22    STA $22         save string pointer low byte
.,B6AC 84 23    STY $23         save string pointer high byte
.,B6AE 20 DB B6 JSR $B6DB       clean descriptor stack, YA = pointer
.,B6B1 08       PHP             save status flags
.,B6B2 A0 00    LDY #$00        clear index
.,B6B4 B1 22    LDA ($22),Y     get length from string descriptor
.,B6B6 48       PHA             put on stack
.,B6B7 C8       INY             increment index
.,B6B8 B1 22    LDA ($22),Y     get string pointer low byte from descriptor
.,B6BA AA       TAX             copy to X
.,B6BB C8       INY             increment index
.,B6BC B1 22    LDA ($22),Y     get string pointer high byte from descriptor
.,B6BE A8       TAY             copy to Y
.,B6BF 68       PLA             get string length back
.,B6C0 28       PLP             restore status
.,B6C1 D0 13    BNE $B6D6       branch if pointer <> last_sl,last_sh
.,B6C3 C4 34    CPY $34         compare with bottom of string space high byte
.,B6C5 D0 0F    BNE $B6D6       branch if <>
.,B6C7 E4 33    CPX $33         else compare with bottom of string space low byte
.,B6C9 D0 0B    BNE $B6D6       branch if <>
.,B6CB 48       PHA             save string length
.,B6CC 18       CLC             clear carry for add
.,B6CD 65 33    ADC $33         add bottom of string space low byte
.,B6CF 85 33    STA $33         set bottom of string space low byte
.,B6D1 90 02    BCC $B6D5       skip increment if no overflow
.,B6D3 E6 34    INC $34         increment bottom of string space high byte
.,B6D5 68       PLA             restore string length
.,B6D6 86 22    STX $22         save string pointer low byte
.,B6D8 84 23    STY $23         save string pointer high byte
.,B6DA 60       RTS             
                                clean descriptor stack, YA = pointer
                                checks if AY is on the descriptor stack, if so does a stack discard
.,B6DB C4 18    CPY $18         compare high byte with current descriptor stack item
                                pointer high byte
.,B6DD D0 0C    BNE $B6EB       exit if <>
.,B6DF C5 17    CMP $17         compare low byte with current descriptor stack item
                                pointer low byte
.,B6E1 D0 08    BNE $B6EB       exit if <>
.,B6E3 85 16    STA $16         set descriptor stack pointer
.,B6E5 E9 03    SBC #$03        update last string pointer low byte
.,B6E7 85 17    STA $17         save current descriptor stack item pointer low byte
.,B6E9 A0 00    LDY #$00        clear high byte
.,B6EB 60       RTS             

                                *** perform CHR$()
.,B6EC 20 A1 B7 JSR $B7A1       evaluate byte expression, result in X
.,B6EF 8A       TXA             copy to A
.,B6F0 48       PHA             save character
.,B6F1 A9 01    LDA #$01        string is single byte
.,B6F3 20 7D B4 JSR $B47D       make string space A bytes long
.,B6F6 68       PLA             get character back
.,B6F7 A0 00    LDY #$00        clear index
.,B6F9 91 62    STA ($62),Y     save byte in string - byte IS string!
.,B6FB 68       PLA             dump return address (skip type check)
.,B6FC 68       PLA             dump return address (skip type check)
.,B6FD 4C CA B4 JMP $B4CA       check space on descriptor stack then put string address
                                and length on descriptor stack and update stack pointers

                                *** perform LEFT$()
.,B700 20 61 B7 JSR $B761       pull string data and byte parameter from stack
                                return pointer in descriptor, byte in A (and X), Y=0
.,B703 D1 50    CMP ($50),Y     compare byte parameter with string length
.,B705 98       TYA             clear A
.,B706 90 04    BCC $B70C       branch if string length > byte parameter
.,B708 B1 50    LDA ($50),Y     else make parameter = length
.,B70A AA       TAX             copy to byte parameter copy
.,B70B 98       TYA             clear string start offset
.,B70C 48       PHA             save string start offset
.,B70D 8A       TXA             copy byte parameter (or string length if <)
.,B70E 48       PHA             save string length
.,B70F 20 7D B4 JSR $B47D       make string space A bytes long
.,B712 A5 50    LDA $50         get descriptor pointer low byte
.,B714 A4 51    LDY $51         get descriptor pointer high byte
.,B716 20 AA B6 JSR $B6AA       pop (YA) descriptor off stack or from top of string space
                                returns with A = length, X = pointer low byte,
                                Y = pointer high byte
.,B719 68       PLA             get string length back
.,B71A A8       TAY             copy length to Y
.,B71B 68       PLA             get string start offset back
.,B71C 18       CLC             clear carry for add
.,B71D 65 22    ADC $22         add start offset to string start pointer low byte
.,B71F 85 22    STA $22         save string start pointer low byte
.,B721 90 02    BCC $B725       branch if no overflow
.,B723 E6 23    INC $23         else increment string start pointer high byte
.,B725 98       TYA             copy length to A
.,B726 20 8C B6 JSR $B68C       store string from pointer to utility pointer
.,B729 4C CA B4 JMP $B4CA       check space on descriptor stack then put string address
                                and length on descriptor stack and update stack pointers

                                *** perform RIGHT$()
.,B72C 20 61 B7 JSR $B761       pull string data and byte parameter from stack
                                return pointer in descriptor, byte in A (and X), Y=0
.,B72F 18       CLC             clear carry for add-1
.,B730 F1 50    SBC ($50),Y     subtract string length
.,B732 49 FF    EOR #$FF        invert it (A=LEN(expression$)-l)
.,B734 4C 06 B7 JMP $B706       go do rest of LEFT$()

                                *** perform MID$()
.,B737 A9 FF    LDA #$FF        set default length = 255
.,B739 85 65    STA $65         save default length
.,B73B 20 79 00 JSR $0079       scan memory
.,B73E C9 29    CMP #$29        compare with ")"
.,B740 F0 06    BEQ $B748       branch if = ")" (skip second byte get)
.,B742 20 FD AE JSR $AEFD       scan for ",", else do syntax error then warm start
.,B745 20 9E B7 JSR $B79E       get byte parameter
.,B748 20 61 B7 JSR $B761       pull string data and byte parameter from stack
                                return pointer in descriptor, byte in A (and X), Y=0
.,B74B F0 4B    BEQ $B798       if null do illegal quantity error then warm start
.,B74D CA       DEX             decrement start index
.,B74E 8A       TXA             copy to A
.,B74F 48       PHA             save string start offset
.,B750 18       CLC             clear carry for sub-1
.,B751 A2 00    LDX #$00        clear output string length
.,B753 F1 50    SBC ($50),Y     subtract string length
.,B755 B0 B6    BCS $B70D       if start>string length go do null string
.,B757 49 FF    EOR #$FF        complement -length
.,B759 C5 65    CMP $65         compare byte parameter
.,B75B 90 B1    BCC $B70E       if length>remaining string go do RIGHT$
.,B75D A5 65    LDA $65         get length byte
.,B75F B0 AD    BCS $B70E       go do string copy, branch always

                                *** pull string data and byte parameter from stack
                                return pointer in descriptor, byte in A (and X), Y=0
.,B761 20 F7 AE JSR $AEF7       scan for ")", else do syntax error then warm start
.,B764 68       PLA             pull return address low byte
.,B765 A8       TAY             save return address low byte
.,B766 68       PLA             pull return address high byte
.,B767 85 55    STA $55         save return address high byte
.,B769 68       PLA             dump call to function vector low byte
.,B76A 68       PLA             dump call to function vector high byte
.,B76B 68       PLA             pull byte parameter
.,B76C AA       TAX             copy byte parameter to X
.,B76D 68       PLA             pull string pointer low byte
.,B76E 85 50    STA $50         save it
.,B770 68       PLA             pull string pointer high byte
.,B771 85 51    STA $51         save it
.,B773 A5 55    LDA $55         get return address high byte
.,B775 48       PHA             back on stack
.,B776 98       TYA             get return address low byte
.,B777 48       PHA             back on stack
.,B778 A0 00    LDY #$00        clear index
.,B77A 8A       TXA             copy byte parameter
.,B77B 60       RTS             

                                *** perform LEN()
.,B77C 20 82 B7 JSR $B782       evaluate string, get length in A (and Y)
.,B77F 4C A2 B3 JMP $B3A2       convert Y to byte in FAC1 and return

                                *** evaluate string, get length in Y
.,B782 20 A3 B6 JSR $B6A3       evaluate string
.,B785 A2 00    LDX #$00        set data type = numeric
.,B787 86 0D    STX $0D         clear data type flag, $FF = string, $00 = numeric
.,B789 A8       TAY             copy length to Y
.,B78A 60       RTS             

                                *** perform ASC()
.,B78B 20 82 B7 JSR $B782       evaluate string, get length in A (and Y)
.,B78E F0 08    BEQ $B798       if null do illegal quantity error then warm start
.,B790 A0 00    LDY #$00        set index to first character
.,B792 B1 22    LDA ($22),Y     get byte
.,B794 A8       TAY             copy to Y
.,B795 4C A2 B3 JMP $B3A2       convert Y to byte in FAC1 and return

                                *** do illegal quantity error then warm start
.,B798 4C 48 B2 JMP $B248       do illegal quantity error then warm start

                                *** scan and get byte parameter
.,B79B 20 73 00 JSR $0073       increment and scan memory

                                *** get byte parameter
.,B79E 20 8A AD JSR $AD8A       evaluate expression and check is numeric, else do
                                type mismatch

                                *** evaluate byte expression, result in X
.,B7A1 20 B8 B1 JSR $B1B8       evaluate integer expression, sign check
.,B7A4 A6 64    LDX $64         get FAC1 mantissa 3
.,B7A6 D0 F0    BNE $B798       if not null do illegal quantity error then warm start
.,B7A8 A6 65    LDX $65         get FAC1 mantissa 4
.,B7AA 4C 79 00 JMP $0079       scan memory and return

                                *** perform VAL()
.,B7AD 20 82 B7 JSR $B782       evaluate string, get length in A (and Y)
.,B7B0 D0 03    BNE $B7B5       branch if not null string
                                string was null so set result = $00
.,B7B2 4C F7 B8 JMP $B8F7       clear FAC1 exponent and sign and return
.,B7B5 A6 7A    LDX $7A         get BASIC execute pointer low byte
.,B7B7 A4 7B    LDY $7B         get BASIC execute pointer high byte
.,B7B9 86 71    STX $71         save BASIC execute pointer low byte
.,B7BB 84 72    STY $72         save BASIC execute pointer high byte
.,B7BD A6 22    LDX $22         get string pointer low byte
.,B7BF 86 7A    STX $7A         save BASIC execute pointer low byte
.,B7C1 18       CLC             clear carry for add
.,B7C2 65 22    ADC $22         add string length
.,B7C4 85 24    STA $24         save string end low byte
.,B7C6 A6 23    LDX $23         get string pointer high byte
.,B7C8 86 7B    STX $7B         save BASIC execute pointer high byte
.,B7CA 90 01    BCC $B7CD       branch if no high byte increment
.,B7CC E8       INX             increment string end high byte
.,B7CD 86 25    STX $25         save string end high byte
.,B7CF A0 00    LDY #$00        set index to $00
.,B7D1 B1 24    LDA ($24),Y     get string end byte
.,B7D3 48       PHA             push it
.,B7D4 98       TYA             clear A
.,B7D5 91 24    STA ($24),Y     terminate string with $00
.,B7D7 20 79 00 JSR $0079       scan memory
.,B7DA 20 F3 BC JSR $BCF3       get FAC1 from string
.,B7DD 68       PLA             restore string end byte
.,B7DE A0 00    LDY #$00        clear index
.,B7E0 91 24    STA ($24),Y     put string end byte back

                                *** restore BASIC execute pointer from temp
.,B7E2 A6 71    LDX $71         get BASIC execute pointer low byte back
.,B7E4 A4 72    LDY $72         get BASIC execute pointer high byte back
.,B7E6 86 7A    STX $7A         save BASIC execute pointer low byte
.,B7E8 84 7B    STY $7B         save BASIC execute pointer high byte
.,B7EA 60       RTS             

                                *** get parameters for POKE/WAIT
.,B7EB 20 8A AD JSR $AD8A       evaluate expression and check is numeric, else do
                                type mismatch
.,B7EE 20 F7 B7 JSR $B7F7       convert FAC_1 to integer in temporary integer
.,B7F1 20 FD AE JSR $AEFD       scan for ",", else do syntax error then warm start
.,B7F4 4C 9E B7 JMP $B79E       get byte parameter and return

                                *** convert FAC_1 to integer in temporary integer
.,B7F7 A5 66    LDA $66         get FAC1 sign
.,B7F9 30 9D    BMI $B798       if -ve do illegal quantity error then warm start
.,B7FB A5 61    LDA $61         get FAC1 exponent
.,B7FD C9 91    CMP #$91        compare with exponent = 2^16
.,B7FF B0 97    BCS $B798       if >= do illegal quantity error then warm start
.,B801 20 9B BC JSR $BC9B       convert FAC1 floating to fixed
.,B804 A5 64    LDA $64         get FAC1 mantissa 3
.,B806 A4 65    LDY $65         get FAC1 mantissa 4
.,B808 84 14    STY $14         save temporary integer low byte
.,B80A 85 15    STA $15         save temporary integer high byte
.,B80C 60       RTS             

                                *** perform PEEK()
.,B80D A5 15    LDA $15         get line number high byte
.,B80F 48       PHA             save line number high byte
.,B810 A5 14    LDA $14         get line number low byte
.,B812 48       PHA             save line number low byte
.,B813 20 F7 B7 JSR $B7F7       convert FAC_1 to integer in temporary integer
.,B816 A0 00    LDY #$00        clear index
.,B818 B1 14    LDA ($14),Y     read byte
.,B81A A8       TAY             copy byte to A
.,B81B 68       PLA             pull byte
.,B81C 85 14    STA $14         restore line number low byte
.,B81E 68       PLA             pull byte
.,B81F 85 15    STA $15         restore line number high byte
.,B821 4C A2 B3 JMP $B3A2       convert Y to byte in FAC_1 and return

                                *** perform POKE
.,B824 20 EB B7 JSR $B7EB       get parameters for POKE/WAIT
.,B827 8A       TXA             copy byte to A
.,B828 A0 00    LDY #$00        clear index
.,B82A 91 14    STA ($14),Y     write byte
.,B82C 60       RTS             

                                *** perform WAIT
.,B82D 20 EB B7 JSR $B7EB       get parameters for POKE/WAIT
.,B830 86 49    STX $49         save byte
.,B832 A2 00    LDX #$00        clear mask
.,B834 20 79 00 JSR $0079       scan memory
.,B837 F0 03    BEQ $B83C       skip if no third argument
.,B839 20 F1 B7 JSR $B7F1       scan for "," and get byte, else syntax error then
                                warm start
.,B83C 86 4A    STX $4A         save EOR argument
.,B83E A0 00    LDY #$00        clear index
.,B840 B1 14    LDA ($14),Y     get byte via temporary integer (address)
.,B842 45 4A    EOR $4A         EOR with second argument       (mask)
.,B844 25 49    AND $49         AND with first argument        (byte)
.,B846 F0 F8    BEQ $B840       loop if result is zero
.,B848 60       RTS             

                                *** add 0.5 to FAC1 (round FAC1)
.,B849 A9 11    LDA #$11        set 0.5 pointer low byte
.,B84B A0 BF    LDY #$BF        set 0.5 pointer high byte
.,B84D 4C 67 B8 JMP $B867       add (AY) to FAC1

                                *** perform subtraction, FAC1 from (AY)
.,B850 20 8C BA JSR $BA8C       unpack memory (AY) into FAC2

                                *** perform subtraction, FAC1 from FAC2
.,B853 A5 66    LDA $66         get FAC1 sign (b7)
.,B855 49 FF    EOR #$FF        complement it
.,B857 85 66    STA $66         save FAC1 sign (b7)
.,B859 45 6E    EOR $6E         EOR with FAC2 sign (b7)
.,B85B 85 6F    STA $6F         save sign compare (FAC1 EOR FAC2)
.,B85D A5 61    LDA $61         get FAC1 exponent
.,B85F 4C 6A B8 JMP $B86A       add FAC2 to FAC1 and return
.,B862 20 99 B9 JSR $B999       shift FACX A times right (>8 shifts)
.,B865 90 3C    BCC $B8A3       go subtract mantissas

                                *** add (AY) to FAC1
.,B867 20 8C BA JSR $BA8C       unpack memory (AY) into FAC2

                                *** add FAC2 to FAC1
.,B86A D0 03    BNE $B86F       branch if FAC1 is not zero
.,B86C 4C FC BB JMP $BBFC       FAC1 was zero so copy FAC2 to FAC1 and return
                                FAC1 is non zero
.,B86F A6 70    LDX $70         get FAC1 rounding byte
.,B871 86 56    STX $56         save as FAC2 rounding byte
.,B873 A2 69    LDX #$69        set index to FAC2 exponent address
.,B875 A5 69    LDA $69         get FAC2 exponent
.,B877 A8       TAY             copy exponent
.,B878 F0 CE    BEQ $B848       exit if zero
.,B87A 38       SEC             set carry for subtract
.,B87B E5 61    SBC $61         subtract FAC1 exponent
.,B87D F0 24    BEQ $B8A3       if equal go add mantissas
.,B87F 90 12    BCC $B893       if FAC2 < FAC1 then go shift FAC2 right
                                else FAC2 > FAC1
.,B881 84 61    STY $61         save FAC1 exponent
.,B883 A4 6E    LDY $6E         get FAC2 sign (b7)
.,B885 84 66    STY $66         save FAC1 sign (b7)
.,B887 49 FF    EOR #$FF        complement A
.,B889 69 00    ADC #$00        +1, twos complement, carry is set
.,B88B A0 00    LDY #$00        clear Y
.,B88D 84 56    STY $56         clear FAC2 rounding byte
.,B88F A2 61    LDX #$61        set index to FAC1 exponent address
.,B891 D0 04    BNE $B897       branch always
                                FAC2 < FAC1
.,B893 A0 00    LDY #$00        clear Y
.,B895 84 70    STY $70         clear FAC1 rounding byte
.,B897 C9 F9    CMP #$F9        compare exponent diff with $F9
.,B899 30 C7    BMI $B862       branch if range $79-$F8
.,B89B A8       TAY             copy exponent difference to Y
.,B89C A5 70    LDA $70         get FAC1 rounding byte
.,B89E 56 01    LSR $01,X       shift FAC? mantissa 1
.,B8A0 20 B0 B9 JSR $B9B0       shift FACX Y times right
                                exponents are equal now do mantissa subtract
.,B8A3 24 6F    BIT $6F         test sign compare (FAC1 EOR FAC2)
.,B8A5 10 57    BPL $B8FE       if = add FAC2 mantissa to FAC1 mantissa and return
.,B8A7 A0 61    LDY #$61        set the Y index to FAC1 exponent address
.,B8A9 E0 69    CPX #$69        compare X to FAC2 exponent address
.,B8AB F0 02    BEQ $B8AF       if = continue, Y = FAC1, X = FAC2
.,B8AD A0 69    LDY #$69        else set the Y index to FAC2 exponent address
                                subtract the smaller from the bigger (take the sign of
                                the bigger)
.,B8AF 38       SEC             set carry for subtract
.,B8B0 49 FF    EOR #$FF        ones complement A
.,B8B2 65 56    ADC $56         add FAC2 rounding byte
.,B8B4 85 70    STA $70         save FAC1 rounding byte
.,B8B6 B9 04 00 LDA $0004,Y     get FACY mantissa 4
.,B8B9 F5 04    SBC $04,X       subtract FACX mantissa 4
.,B8BB 85 65    STA $65         save FAC1 mantissa 4
.,B8BD B9 03 00 LDA $0003,Y     get FACY mantissa 3
.,B8C0 F5 03    SBC $03,X       subtract FACX mantissa 3
.,B8C2 85 64    STA $64         save FAC1 mantissa 3
.,B8C4 B9 02 00 LDA $0002,Y     get FACY mantissa 2
.,B8C7 F5 02    SBC $02,X       subtract FACX mantissa 2
.,B8C9 85 63    STA $63         save FAC1 mantissa 2
.,B8CB B9 01 00 LDA $0001,Y     get FACY mantissa 1
.,B8CE F5 01    SBC $01,X       subtract FACX mantissa 1
.,B8D0 85 62    STA $62         save FAC1 mantissa 1

                                *** do ABS and normalise FAC1
.,B8D2 B0 03    BCS $B8D7       branch if number is +ve
.,B8D4 20 47 B9 JSR $B947       negate FAC1

                                *** normalise FAC1
.,B8D7 A0 00    LDY #$00        clear Y
.,B8D9 98       TYA             clear A
.,B8DA 18       CLC             clear carry for add
.,B8DB A6 62    LDX $62         get FAC1 mantissa 1
.,B8DD D0 4A    BNE $B929       if not zero normalise FAC1
.,B8DF A6 63    LDX $63         get FAC1 mantissa 2
.,B8E1 86 62    STX $62         save FAC1 mantissa 1
.,B8E3 A6 64    LDX $64         get FAC1 mantissa 3
.,B8E5 86 63    STX $63         save FAC1 mantissa 2
.,B8E7 A6 65    LDX $65         get FAC1 mantissa 4
.,B8E9 86 64    STX $64         save FAC1 mantissa 3
.,B8EB A6 70    LDX $70         get FAC1 rounding byte
.,B8ED 86 65    STX $65         save FAC1 mantissa 4
.,B8EF 84 70    STY $70         clear FAC1 rounding byte
.,B8F1 69 08    ADC #$08        add x to exponent offset
.,B8F3 C9 20    CMP #$20        compare with $20, max offset, all bits would be = 0
.,B8F5 D0 E4    BNE $B8DB       loop if not max

                                *** clear FAC1 exponent and sign
.,B8F7 A9 00    LDA #$00        clear A
.,B8F9 85 61    STA $61         set FAC1 exponent

                                *** save FAC1 sign
.,B8FB 85 66    STA $66         save FAC1 sign (b7)
.,B8FD 60       RTS             

                                *** add FAC2 mantissa to FAC1 mantissa
.,B8FE 65 56    ADC $56         add FAC2 rounding byte
.,B900 85 70    STA $70         save FAC1 rounding byte
.,B902 A5 65    LDA $65         get FAC1 mantissa 4
.,B904 65 6D    ADC $6D         add FAC2 mantissa 4
.,B906 85 65    STA $65         save FAC1 mantissa 4
.,B908 A5 64    LDA $64         get FAC1 mantissa 3
.,B90A 65 6C    ADC $6C         add FAC2 mantissa 3
.,B90C 85 64    STA $64         save FAC1 mantissa 3
.,B90E A5 63    LDA $63         get FAC1 mantissa 2
.,B910 65 6B    ADC $6B         add FAC2 mantissa 2
.,B912 85 63    STA $63         save FAC1 mantissa 2
.,B914 A5 62    LDA $62         get FAC1 mantissa 1
.,B916 65 6A    ADC $6A         add FAC2 mantissa 1
.,B918 85 62    STA $62         save FAC1 mantissa 1
.,B91A 4C 36 B9 JMP $B936       test and normalise FAC1 for C=0/1
.,B91D 69 01    ADC #$01        add 1 to exponent offset
.,B91F 06 70    ASL $70         shift FAC1 rounding byte
.,B921 26 65    ROL $65         shift FAC1 mantissa 4
.,B923 26 64    ROL $64         shift FAC1 mantissa 3
.,B925 26 63    ROL $63         shift FAC1 mantissa 2
.,B927 26 62    ROL $62         shift FAC1 mantissa 1
                                normalise FAC1
.,B929 10 F2    BPL $B91D       loop if not normalised
.,B92B 38       SEC             set carry for subtract
.,B92C E5 61    SBC $61         subtract FAC1 exponent
.,B92E B0 C7    BCS $B8F7       branch if underflow (set result = $0)
.,B930 49 FF    EOR #$FF        complement exponent
.,B932 69 01    ADC #$01        +1 (twos complement)
.,B934 85 61    STA $61         save FAC1 exponent
                                test and normalise FAC1 for C=0/1
.,B936 90 0E    BCC $B946       exit if no overflow
                                normalise FAC1 for C=1
.,B938 E6 61    INC $61         increment FAC1 exponent
.,B93A F0 42    BEQ $B97E       if zero do overflow error then warm start
.,B93C 66 62    ROR $62         shift FAC1 mantissa 1
.,B93E 66 63    ROR $63         shift FAC1 mantissa 2
.,B940 66 64    ROR $64         shift FAC1 mantissa 3
.,B942 66 65    ROR $65         shift FAC1 mantissa 4
.,B944 66 70    ROR $70         shift FAC1 rounding byte
.,B946 60       RTS             

                                *** negate FAC1
.,B947 A5 66    LDA $66         get FAC1 sign (b7)
.,B949 49 FF    EOR #$FF        complement it
.,B94B 85 66    STA $66         save FAC1 sign (b7)
                                twos complement FAC1 mantissa
.,B94D A5 62    LDA $62         get FAC1 mantissa 1
.,B94F 49 FF    EOR #$FF        complement it
.,B951 85 62    STA $62         save FAC1 mantissa 1
.,B953 A5 63    LDA $63         get FAC1 mantissa 2
.,B955 49 FF    EOR #$FF        complement it
.,B957 85 63    STA $63         save FAC1 mantissa 2
.,B959 A5 64    LDA $64         get FAC1 mantissa 3
.,B95B 49 FF    EOR #$FF        complement it
.,B95D 85 64    STA $64         save FAC1 mantissa 3
.,B95F A5 65    LDA $65         get FAC1 mantissa 4
.,B961 49 FF    EOR #$FF        complement it
.,B963 85 65    STA $65         save FAC1 mantissa 4
.,B965 A5 70    LDA $70         get FAC1 rounding byte
.,B967 49 FF    EOR #$FF        complement it
.,B969 85 70    STA $70         save FAC1 rounding byte
.,B96B E6 70    INC $70         increment FAC1 rounding byte
.,B96D D0 0E    BNE $B97D       exit if no overflow
                                increment FAC1 mantissa
.,B96F E6 65    INC $65         increment FAC1 mantissa 4
.,B971 D0 0A    BNE $B97D       finished if no rollover
.,B973 E6 64    INC $64         increment FAC1 mantissa 3
.,B975 D0 06    BNE $B97D       finished if no rollover
.,B977 E6 63    INC $63         increment FAC1 mantissa 2
.,B979 D0 02    BNE $B97D       finished if no rollover
.,B97B E6 62    INC $62         increment FAC1 mantissa 1
.,B97D 60       RTS             

                                *** do overflow error then warm start
.,B97E A2 0F    LDX #$0F        error $0F, overflow error
.,B980 4C 37 A4 JMP $A437       do error #X then warm start

                                *** shift FCAtemp << A+8 times
.,B983 A2 25    LDX #$25        set the offset to FACtemp
.,B985 B4 04    LDY $04,X       get FACX mantissa 4
.,B987 84 70    STY $70         save as FAC1 rounding byte
.,B989 B4 03    LDY $03,X       get FACX mantissa 3
.,B98B 94 04    STY $04,X       save FACX mantissa 4
.,B98D B4 02    LDY $02,X       get FACX mantissa 2
.,B98F 94 03    STY $03,X       save FACX mantissa 3
.,B991 B4 01    LDY $01,X       get FACX mantissa 1
.,B993 94 02    STY $02,X       save FACX mantissa 2
.,B995 A4 68    LDY $68         get FAC1 overflow byte
.,B997 94 01    STY $01,X       save FACX mantissa 1
                                shift FACX -A times right (> 8 shifts)
.,B999 69 08    ADC #$08        add 8 to shift count
.,B99B 30 E8    BMI $B985       go do 8 shift if still -ve
.,B99D F0 E6    BEQ $B985       go do 8 shift if zero
.,B99F E9 08    SBC #$08        else subtract 8 again
.,B9A1 A8       TAY             save count to Y
.,B9A2 A5 70    LDA $70         get FAC1 rounding byte
.,B9A4 B0 14    BCS $B9BA       
.,B9A6 16 01    ASL $01,X       shift FACX mantissa 1
.,B9A8 90 02    BCC $B9AC       branch if +ve
.,B9AA F6 01    INC $01,X       this sets b7 eventually
.,B9AC 76 01    ROR $01,X       shift FACX mantissa 1 (correct for ASL)
.,B9AE 76 01    ROR $01,X       shift FACX mantissa 1 (put carry in b7)
                                shift FACX Y times right
.,B9B0 76 02    ROR $02,X       shift FACX mantissa 2
.,B9B2 76 03    ROR $03,X       shift FACX mantissa 3
.,B9B4 76 04    ROR $04,X       shift FACX mantissa 4
.,B9B6 6A       ROR             shift FACX rounding byte
.,B9B7 C8       INY             increment exponent diff
.,B9B8 D0 EC    BNE $B9A6       branch if range adjust not complete
.,B9BA 18       CLC             just clear it
.,B9BB 60       RTS             

                                *** constants and series for LOG(n)
.:B9BC 81 00 00 00 00           1
.:B9C1 03                       series counter
.:B9C2 7F 5E 56 CB 79            .434255942
.:B9C7 80 13 9B 0B 64            .576584541
.:B9CC 80 76 38 93 16            .961800759
.:B9D1 82 38 AA 3B 20           2.88539007
.:B9D5 80 35 04 F3 34            .707106781 = 1/SQR(2)
.:B9DB 81 35 04 F3 34           1.41421356 = SQR(2)
.:B9E0 80 80 00 00 00           -.5
.:B9E5 80 31 72 17 F8            .693147181  =  LOG(2)

                                *** perform LOG()
.,B9EA 20 2B BC JSR $BC2B       test sign and zero
.,B9ED F0 02    BEQ $B9F1       if zero do illegal quantity error then warm start
.,B9EF 10 03    BPL $B9F4       skip error if +ve
.,B9F1 4C 48 B2 JMP $B248       do illegal quantity error then warm start
.,B9F4 A5 61    LDA $61         get FAC1 exponent
.,B9F6 E9 7F    SBC #$7F        normalise it
.,B9F8 48       PHA             save it
.,B9F9 A9 80    LDA #$80        set exponent to zero
.,B9FB 85 61    STA $61         save FAC1 exponent
.,B9FD A9 D6    LDA #$D6        pointer to 1/root 2 low byte
.,B9FF A0 B9    LDY #$B9        pointer to 1/root 2 high byte
.,BA01 20 67 B8 JSR $B867       add (AY) to FAC1 (1/root2)
.,BA04 A9 DB    LDA #$DB        pointer to root 2 low byte
.,BA06 A0 B9    LDY #$B9        pointer to root 2 high byte
.,BA08 20 0F BB JSR $BB0F       convert AY and do (AY)/FAC1 (root2/(x+(1/root2)))
.,BA0B A9 BC    LDA #$BC        pointer to 1 low byte
.,BA0D A0 B9    LDY #$B9        pointer to 1 high byte
.,BA0F 20 50 B8 JSR $B850       subtract FAC1 ((root2/(x+(1/root2)))-1) from (AY)
.,BA12 A9 C1    LDA #$C1        pointer to series for LOG(n) low byte
.,BA14 A0 B9    LDY #$B9        pointer to series for LOG(n) high byte
.,BA16 20 43 E0 JSR $E043       ^2 then series evaluation
.,BA19 A9 E0    LDA #$E0        pointer to -0.5 low byte
.,BA1B A0 B9    LDY #$B9        pointer to -0.5 high byte
.,BA1D 20 67 B8 JSR $B867       add (AY) to FAC1
.,BA20 68       PLA             restore FAC1 exponent
.,BA21 20 7E BD JSR $BD7E       evaluate new ASCII digit
.,BA24 A9 E5    LDA #$E5        pointer to LOG(2) low byte
.,BA26 A0 B9    LDY #$B9        pointer to LOG(2) high byte

                                *** do convert AY, FCA1*(AY)
.,BA28 20 8C BA JSR $BA8C       unpack memory (AY) into FAC2
.,BA2B D0 03    BNE $BA30       multiply FAC1 by FAC2 ??
.,BA2D 4C 8B BA JMP $BA8B       exit if zero
.,BA30 20 B7 BA JSR $BAB7       test and adjust accumulators
.,BA33 A9 00    LDA #$00        clear A
.,BA35 85 26    STA $26         clear temp mantissa 1
.,BA37 85 27    STA $27         clear temp mantissa 2
.,BA39 85 28    STA $28         clear temp mantissa 3
.,BA3B 85 29    STA $29         clear temp mantissa 4
.,BA3D A5 70    LDA $70         get FAC1 rounding byte
.,BA3F 20 59 BA JSR $BA59       go do shift/add FAC2
.,BA42 A5 65    LDA $65         get FAC1 mantissa 4
.,BA44 20 59 BA JSR $BA59       go do shift/add FAC2
.,BA47 A5 64    LDA $64         get FAC1 mantissa 3
.,BA49 20 59 BA JSR $BA59       go do shift/add FAC2
.,BA4C A5 63    LDA $63         get FAC1 mantissa 2
.,BA4E 20 59 BA JSR $BA59       go do shift/add FAC2
.,BA51 A5 62    LDA $62         get FAC1 mantissa 1
.,BA53 20 5E BA JSR $BA5E       go do shift/add FAC2
.,BA56 4C 8F BB JMP $BB8F       copy temp to FAC1, normalise and return
.,BA59 D0 03    BNE $BA5E       branch if byte <> zero
.,BA5B 4C 83 B9 JMP $B983       shift FCAtemp << A+8 times
                                else do shift and add
.,BA5E 4A       LSR             shift byte
.,BA5F 09 80    ORA #$80        set top bit (mark for 8 times)
.,BA61 A8       TAY             copy result
.,BA62 90 19    BCC $BA7D       skip next if bit was zero
.,BA64 18       CLC             clear carry for add
.,BA65 A5 29    LDA $29         get temp mantissa 4
.,BA67 65 6D    ADC $6D         add FAC2 mantissa 4
.,BA69 85 29    STA $29         save temp mantissa 4
.,BA6B A5 28    LDA $28         get temp mantissa 3
.,BA6D 65 6C    ADC $6C         add FAC2 mantissa 3
.,BA6F 85 28    STA $28         save temp mantissa 3
.,BA71 A5 27    LDA $27         get temp mantissa 2
.,BA73 65 6B    ADC $6B         add FAC2 mantissa 2
.,BA75 85 27    STA $27         save temp mantissa 2
.,BA77 A5 26    LDA $26         get temp mantissa 1
.,BA79 65 6A    ADC $6A         add FAC2 mantissa 1
.,BA7B 85 26    STA $26         save temp mantissa 1
.,BA7D 66 26    ROR $26         shift temp mantissa 1
.,BA7F 66 27    ROR $27         shift temp mantissa 2
.,BA81 66 28    ROR $28         shift temp mantissa 3
.,BA83 66 29    ROR $29         shift temp mantissa 4
.,BA85 66 70    ROR $70         shift temp rounding byte
.,BA87 98       TYA             get byte back
.,BA88 4A       LSR             shift byte
.,BA89 D0 D6    BNE $BA61       loop if all bits not done
.,BA8B 60       RTS             

                                *** unpack memory (AY) into FAC2
.,BA8C 85 22    STA $22         save pointer low byte
.,BA8E 84 23    STY $23         save pointer high byte
.,BA90 A0 04    LDY #$04        5 bytes to get (0-4)
.,BA92 B1 22    LDA ($22),Y     get mantissa 4
.,BA94 85 6D    STA $6D         save FAC2 mantissa 4
.,BA96 88       DEY             decrement index
.,BA97 B1 22    LDA ($22),Y     get mantissa 3
.,BA99 85 6C    STA $6C         save FAC2 mantissa 3
.,BA9B 88       DEY             decrement index
.,BA9C B1 22    LDA ($22),Y     get mantissa 2
.,BA9E 85 6B    STA $6B         save FAC2 mantissa 2
.,BAA0 88       DEY             decrement index
.,BAA1 B1 22    LDA ($22),Y     get mantissa 1 + sign
.,BAA3 85 6E    STA $6E         save FAC2 sign (b7)
.,BAA5 45 66    EOR $66         EOR with FAC1 sign (b7)
.,BAA7 85 6F    STA $6F         save sign compare (FAC1 EOR FAC2)
.,BAA9 A5 6E    LDA $6E         recover FAC2 sign (b7)
.,BAAB 09 80    ORA #$80        set 1xxx xxx (set normal bit)
.,BAAD 85 6A    STA $6A         save FAC2 mantissa 1
.,BAAF 88       DEY             decrement index
.,BAB0 B1 22    LDA ($22),Y     get exponent byte
.,BAB2 85 69    STA $69         save FAC2 exponent
.,BAB4 A5 61    LDA $61         get FAC1 exponent
.,BAB6 60       RTS             

                                *** test and adjust accumulators
.,BAB7 A5 69    LDA $69         get FAC2 exponent
.,BAB9 F0 1F    BEQ $BADA       branch if FAC2 = $00 (handle underflow)
.,BABB 18       CLC             clear carry for add
.,BABC 65 61    ADC $61         add FAC1 exponent
.,BABE 90 04    BCC $BAC4       branch if sum of exponents < $0100
.,BAC0 30 1D    BMI $BADF       do overflow error
.,BAC2 18       CLC             clear carry for the add
.:BAC3 2C       .BYTE $2C       makes next line BIT $1410
.,BAC4 10 14    BPL $BADA       if +ve go handle underflow
.,BAC6 69 80    ADC #$80        adjust exponent
.,BAC8 85 61    STA $61         save FAC1 exponent
.,BACA D0 03    BNE $BACF       branch if not zero
.,BACC 4C FB B8 JMP $B8FB       save FAC1 sign and return
.,BACF A5 6F    LDA $6F         get sign compare (FAC1 EOR FAC2)
.,BAD1 85 66    STA $66         save FAC1 sign (b7)
.,BAD3 60       RTS             
                                handle overflow and underflow
.,BAD4 A5 66    LDA $66         get FAC1 sign (b7)
.,BAD6 49 FF    EOR #$FF        complement it
.,BAD8 30 05    BMI $BADF       do overflow error
                                handle underflow
.,BADA 68       PLA             pop return address low byte
.,BADB 68       PLA             pop return address high byte
.,BADC 4C F7 B8 JMP $B8F7       clear FAC1 exponent and sign and return
.,BADF 4C 7E B9 JMP $B97E       do overflow error then warm start

                                *** multiply FAC1 by 10
.,BAE2 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,BAE5 AA       TAX             copy exponent (set the flags)
.,BAE6 F0 10    BEQ $BAF8       exit if zero
.,BAE8 18       CLC             clear carry for add
.,BAE9 69 02    ADC #$02        add two to exponent (*4)
.,BAEB B0 F2    BCS $BADF       do overflow error if > $FF
                                FAC1 = (FAC1 + FAC2) * 2
.,BAED A2 00    LDX #$00        clear byte
.,BAEF 86 6F    STX $6F         clear sign compare (FAC1 EOR FAC2)
.,BAF1 20 77 B8 JSR $B877       add FAC2 to FAC1 (*5)
.,BAF4 E6 61    INC $61         increment FAC1 exponent (*10)
.,BAF6 F0 E7    BEQ $BADF       if exponent now zero go do overflow error
.,BAF8 60       RTS             

                                *** 10 as a floating value
.:BAF9 84 20 00 00 00           10

                                *** divide FAC1 by 10
.,BAFE 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,BB01 A9 F9    LDA #$F9        set 10 pointer low byte
.,BB03 A0 BA    LDY #$BA        set 10 pointer high byte
.,BB05 A2 00    LDX #$00        clear sign

                                *** divide by (AY) (X=sign)
.,BB07 86 6F    STX $6F         save sign compare (FAC1 EOR FAC2)
.,BB09 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1
.,BB0C 4C 12 BB JMP $BB12       do FAC2/FAC1
                                Perform divide-by

                                *** convert AY and do (AY)/FAC1
.,BB0F 20 8C BA JSR $BA8C       unpack memory (AY) into FAC2
.,BB12 F0 76    BEQ $BB8A       if zero go do /0 error
.,BB14 20 1B BC JSR $BC1B       round FAC1
.,BB17 A9 00    LDA #$00        clear A
.,BB19 38       SEC             set carry for subtract
.,BB1A E5 61    SBC $61         subtract FAC1 exponent (2s complement)
.,BB1C 85 61    STA $61         save FAC1 exponent
.,BB1E 20 B7 BA JSR $BAB7       test and adjust accumulators
.,BB21 E6 61    INC $61         increment FAC1 exponent
.,BB23 F0 BA    BEQ $BADF       if zero do overflow error
.,BB25 A2 FC    LDX #$FC        set index to FAC temp
.,BB27 A9 01    LDA #$01        set byte
.,BB29 A4 6A    LDY $6A         get FAC2 mantissa 1
.,BB2B C4 62    CPY $62         compare FAC1 mantissa 1
.,BB2D D0 10    BNE $BB3F       branch if <>
.,BB2F A4 6B    LDY $6B         get FAC2 mantissa 2
.,BB31 C4 63    CPY $63         compare FAC1 mantissa 2
.,BB33 D0 0A    BNE $BB3F       branch if <>
.,BB35 A4 6C    LDY $6C         get FAC2 mantissa 3
.,BB37 C4 64    CPY $64         compare FAC1 mantissa 3
.,BB39 D0 04    BNE $BB3F       branch if <>
.,BB3B A4 6D    LDY $6D         get FAC2 mantissa 4
.,BB3D C4 65    CPY $65         compare FAC1 mantissa 4
.,BB3F 08       PHP             save FAC2-FAC1 compare status
.,BB40 2A       ROL             shift byte
.,BB41 90 09    BCC $BB4C       skip next if no carry
.,BB43 E8       INX             increment index to FAC temp
.,BB44 95 29    STA $29,X       
.,BB46 F0 32    BEQ $BB7A       
.,BB48 10 34    BPL $BB7E       
.,BB4A A9 01    LDA #$01        
.,BB4C 28       PLP             restore FAC2-FAC1 compare status
.,BB4D B0 0E    BCS $BB5D       if FAC2 >= FAC1 then do subtract
                                FAC2 = FAC2*2
.,BB4F 06 6D    ASL $6D         shift FAC2 mantissa 4
.,BB51 26 6C    ROL $6C         shift FAC2 mantissa 3
.,BB53 26 6B    ROL $6B         shift FAC2 mantissa 2
.,BB55 26 6A    ROL $6A         shift FAC2 mantissa 1
.,BB57 B0 E6    BCS $BB3F       loop with no compare
.,BB59 30 CE    BMI $BB29       loop with compare
.,BB5B 10 E2    BPL $BB3F       loop with no compare, branch always
.,BB5D A8       TAY             save FAC2-FAC1 compare status
.,BB5E A5 6D    LDA $6D         get FAC2 mantissa 4
.,BB60 E5 65    SBC $65         subtract FAC1 mantissa 4
.,BB62 85 6D    STA $6D         save FAC2 mantissa 4
.,BB64 A5 6C    LDA $6C         get FAC2 mantissa 3
.,BB66 E5 64    SBC $64         subtract FAC1 mantissa 3
.,BB68 85 6C    STA $6C         save FAC2 mantissa 3
.,BB6A A5 6B    LDA $6B         get FAC2 mantissa 2
.,BB6C E5 63    SBC $63         subtract FAC1 mantissa 2
.,BB6E 85 6B    STA $6B         save FAC2 mantissa 2
.,BB70 A5 6A    LDA $6A         get FAC2 mantissa 1
.,BB72 E5 62    SBC $62         subtract FAC1 mantissa 1
.,BB74 85 6A    STA $6A         save FAC2 mantissa 1
.,BB76 98       TYA             restore FAC2-FAC1 compare status
.,BB77 4C 4F BB JMP $BB4F       
.,BB7A A9 40    LDA #$40        
.,BB7C D0 CE    BNE $BB4C       branch always
                                do A<<6, save as FAC1 rounding byte, normalise and return
.,BB7E 0A       ASL             
.,BB7F 0A       ASL             
.,BB80 0A       ASL             
.,BB81 0A       ASL             
.,BB82 0A       ASL             
.,BB83 0A       ASL             
.,BB84 85 70    STA $70         save FAC1 rounding byte
.,BB86 28       PLP             dump FAC2-FAC1 compare status
.,BB87 4C 8F BB JMP $BB8F       copy temp to FAC1, normalise and return
                                do "Divide by zero" error
.,BB8A A2 14    LDX #$14        error $14, divide by zero error
.,BB8C 4C 37 A4 JMP $A437       do error #X then warm start
.,BB8F A5 26    LDA $26         get temp mantissa 1
.,BB91 85 62    STA $62         save FAC1 mantissa 1
.,BB93 A5 27    LDA $27         get temp mantissa 2
.,BB95 85 63    STA $63         save FAC1 mantissa 2
.,BB97 A5 28    LDA $28         get temp mantissa 3
.,BB99 85 64    STA $64         save FAC1 mantissa 3
.,BB9B A5 29    LDA $29         get temp mantissa 4
.,BB9D 85 65    STA $65         save FAC1 mantissa 4
.,BB9F 4C D7 B8 JMP $B8D7       normalise FAC1 and return

                                *** unpack memory (AY) into FAC1
.,BBA2 85 22    STA $22         save pointer low byte
.,BBA4 84 23    STY $23         save pointer high byte
.,BBA6 A0 04    LDY #$04        5 bytes to do
.,BBA8 B1 22    LDA ($22),Y     get fifth byte
.,BBAA 85 65    STA $65         save FAC1 mantissa 4
.,BBAC 88       DEY             decrement index
.,BBAD B1 22    LDA ($22),Y     get fourth byte
.,BBAF 85 64    STA $64         save FAC1 mantissa 3
.,BBB1 88       DEY             decrement index
.,BBB2 B1 22    LDA ($22),Y     get third byte
.,BBB4 85 63    STA $63         save FAC1 mantissa 2
.,BBB6 88       DEY             decrement index
.,BBB7 B1 22    LDA ($22),Y     get second byte
.,BBB9 85 66    STA $66         save FAC1 sign (b7)
.,BBBB 09 80    ORA #$80        set 1xxx xxxx (add normal bit)
.,BBBD 85 62    STA $62         save FAC1 mantissa 1
.,BBBF 88       DEY             decrement index
.,BBC0 B1 22    LDA ($22),Y     get first byte (exponent)
.,BBC2 85 61    STA $61         save FAC1 exponent
.,BBC4 84 70    STY $70         clear FAC1 rounding byte
.,BBC6 60       RTS             

                                *** pack FAC1 into $5C
.,BBC7 A2 5C    LDX #$5C        set pointer low byte
.:BBC9 2C       .BYTE $2C       makes next line BIT $57A2

                                *** pack FAC1 into $57
.,BBCA A2 57    LDX #$57        set pointer low byte
.,BBCC A0 00    LDY #$00        set pointer high byte
.,BBCE F0 04    BEQ $BBD4       pack FAC1 into (XY) and return, branch always

                                *** pack FAC1 into variable pointer
.,BBD0 A6 49    LDX $49         get destination pointer low byte
.,BBD2 A4 4A    LDY $4A         get destination pointer high byte

                                *** pack FAC1 into (XY)
.,BBD4 20 1B BC JSR $BC1B       round FAC1
.,BBD7 86 22    STX $22         save pointer low byte
.,BBD9 84 23    STY $23         save pointer high byte
.,BBDB A0 04    LDY #$04        set index
.,BBDD A5 65    LDA $65         get FAC1 mantissa 4
.,BBDF 91 22    STA ($22),Y     store in destination
.,BBE1 88       DEY             decrement index
.,BBE2 A5 64    LDA $64         get FAC1 mantissa 3
.,BBE4 91 22    STA ($22),Y     store in destination
.,BBE6 88       DEY             decrement index
.,BBE7 A5 63    LDA $63         get FAC1 mantissa 2
.,BBE9 91 22    STA ($22),Y     store in destination
.,BBEB 88       DEY             decrement index
.,BBEC A5 66    LDA $66         get FAC1 sign (b7)
.,BBEE 09 7F    ORA #$7F        set bits x111 1111
.,BBF0 25 62    AND $62         AND in FAC1 mantissa 1
.,BBF2 91 22    STA ($22),Y     store in destination
.,BBF4 88       DEY             decrement index
.,BBF5 A5 61    LDA $61         get FAC1 exponent
.,BBF7 91 22    STA ($22),Y     store in destination
.,BBF9 84 70    STY $70         clear FAC1 rounding byte
.,BBFB 60       RTS             

                                *** copy FAC2 to FAC1
.,BBFC A5 6E    LDA $6E         get FAC2 sign (b7)
                                save FAC1 sign and copy ABS(FAC2) to FAC1
.,BBFE 85 66    STA $66         save FAC1 sign (b7)
.,BC00 A2 05    LDX #$05        5 bytes to copy
.,BC02 B5 68    LDA $68,X       get byte from FAC2,X
.,BC04 95 60    STA $60,X       save byte at FAC1,X
.,BC06 CA       DEX             decrement count
.,BC07 D0 F9    BNE $BC02       loop if not all done
.,BC09 86 70    STX $70         clear FAC1 rounding byte
.,BC0B 60       RTS             

                                *** round and copy FAC1 to FAC2
.,BC0C 20 1B BC JSR $BC1B       round FAC1
                                copy FAC1 to FAC2
.,BC0F A2 06    LDX #$06        6 bytes to copy
.,BC11 B5 60    LDA $60,X       get byte from FAC1,X
.,BC13 95 68    STA $68,X       save byte at FAC2,X
.,BC15 CA       DEX             decrement count
.,BC16 D0 F9    BNE $BC11       loop if not all done
.,BC18 86 70    STX $70         clear FAC1 rounding byte
.,BC1A 60       RTS             

                                *** round FAC1
.,BC1B A5 61    LDA $61         get FAC1 exponent
.,BC1D F0 FB    BEQ $BC1A       exit if zero
.,BC1F 06 70    ASL $70         shift FAC1 rounding byte
.,BC21 90 F7    BCC $BC1A       exit if no overflow
                                round FAC1 (no check)
.,BC23 20 6F B9 JSR $B96F       increment FAC1 mantissa
.,BC26 D0 F2    BNE $BC1A       branch if no overflow
.,BC28 4C 38 B9 JMP $B938       nornalise FAC1 for C=1 and return

                                *** get FAC1 sign
                                return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve, A = $00, Cb = ?/0
.,BC2B A5 61    LDA $61         get FAC1 exponent
.,BC2D F0 09    BEQ $BC38       exit if zero (allready correct SGN(0)=0)

                                *** return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve
                                no = 0 check
.,BC2F A5 66    LDA $66         else get FAC1 sign (b7)

                                *** return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve
                                no = 0 check, sign in A
.,BC31 2A       ROL             move sign bit to carry
.,BC32 A9 FF    LDA #$FF        set byte for -ve result
.,BC34 B0 02    BCS $BC38       return if sign was set (-ve)
.,BC36 A9 01    LDA #$01        else set byte for +ve result
.,BC38 60       RTS             

                                *** perform SGN()
.,BC39 20 2B BC JSR $BC2B       get FAC1 sign, return A = $FF -ve, A = $01 +ve

                                *** save A as integer byte
.,BC3C 85 62    STA $62         save FAC1 mantissa 1
.,BC3E A9 00    LDA #$00        clear A
.,BC40 85 63    STA $63         clear FAC1 mantissa 2
.,BC42 A2 88    LDX #$88        set exponent
                                set exponent = X, clear FAC1 3 and 4 and normalise
.,BC44 A5 62    LDA $62         get FAC1 mantissa 1
.,BC46 49 FF    EOR #$FF        complement it
.,BC48 2A       ROL             sign bit into carry
                                set exponent = X, clear mantissa 4 and 3 and normalise FAC1
.,BC49 A9 00    LDA #$00        clear A
.,BC4B 85 65    STA $65         clear FAC1 mantissa 4
.,BC4D 85 64    STA $64         clear FAC1 mantissa 3
                                set exponent = X and normalise FAC1
.,BC4F 86 61    STX $61         set FAC1 exponent
.,BC51 85 70    STA $70         clear FAC1 rounding byte
.,BC53 85 66    STA $66         clear FAC1 sign (b7)
.,BC55 4C D2 B8 JMP $B8D2       do ABS and normalise FAC1

                                *** perform ABS()
.,BC58 46 66    LSR $66         clear FAC1 sign, put zero in b7
.,BC5A 60       RTS             

                                *** compare FAC1 with (AY)
                                returns A=$00 if FAC1 = (AY)
                                returns A=$01 if FAC1 > (AY)
                                returns A=$FF if FAC1 < (AY)
.,BC5B 85 24    STA $24         save pointer low byte
.,BC5D 84 25    STY $25         save pointer high byte
.,BC5F A0 00    LDY #$00        clear index
.,BC61 B1 24    LDA ($24),Y     get exponent
.,BC63 C8       INY             increment index
.,BC64 AA       TAX             copy (AY) exponent to X
.,BC65 F0 C4    BEQ $BC2B       branch if (AY) exponent=0 and get FAC1 sign
                                A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve
.,BC67 B1 24    LDA ($24),Y     get (AY) mantissa 1, with sign
.,BC69 45 66    EOR $66         EOR FAC1 sign (b7)
.,BC6B 30 C2    BMI $BC2F       if signs <> do return A = $FF, Cb = 1/-ve
                                A = $01, Cb = 0/+ve and return
.,BC6D E4 61    CPX $61         compare (AY) exponent with FAC1 exponent
.,BC6F D0 21    BNE $BC92       branch if different
.,BC71 B1 24    LDA ($24),Y     get (AY) mantissa 1, with sign
.,BC73 09 80    ORA #$80        normalise top bit
.,BC75 C5 62    CMP $62         compare with FAC1 mantissa 1
.,BC77 D0 19    BNE $BC92       branch if different
.,BC79 C8       INY             increment index
.,BC7A B1 24    LDA ($24),Y     get mantissa 2
.,BC7C C5 63    CMP $63         compare with FAC1 mantissa 2
.,BC7E D0 12    BNE $BC92       branch if different
.,BC80 C8       INY             increment index
.,BC81 B1 24    LDA ($24),Y     get mantissa 3
.,BC83 C5 64    CMP $64         compare with FAC1 mantissa 3
.,BC85 D0 0B    BNE $BC92       branch if different
.,BC87 C8       INY             increment index
.,BC88 A9 7F    LDA #$7F        set for 1/2 value rounding byte
.,BC8A C5 70    CMP $70         compare with FAC1 rounding byte (set carry)
.,BC8C B1 24    LDA ($24),Y     get mantissa 4
.,BC8E E5 65    SBC $65         subtract FAC1 mantissa 4
.,BC90 F0 28    BEQ $BCBA       exit if mantissa 4 equal
                                gets here if number <> FAC1
.,BC92 A5 66    LDA $66         get FAC1 sign (b7)
.,BC94 90 02    BCC $BC98       branch if FAC1 > (AY)
.,BC96 49 FF    EOR #$FF        else toggle FAC1 sign
.,BC98 4C 31 BC JMP $BC31       return A = $FF, Cb = 1/-ve A = $01, Cb = 0/+ve

                                *** convert FAC1 floating to fixed
.,BC9B A5 61    LDA $61         get FAC1 exponent
.,BC9D F0 4A    BEQ $BCE9       if zero go clear FAC1 and return
.,BC9F 38       SEC             set carry for subtract
.,BCA0 E9 A0    SBC #$A0        subtract maximum integer range exponent
.,BCA2 24 66    BIT $66         test FAC1 sign (b7)
.,BCA4 10 09    BPL $BCAF       branch if FAC1 +ve
                                FAC1 was -ve
.,BCA6 AA       TAX             copy subtracted exponent
.,BCA7 A9 FF    LDA #$FF        overflow for -ve number
.,BCA9 85 68    STA $68         set FAC1 overflow byte
.,BCAB 20 4D B9 JSR $B94D       twos complement FAC1 mantissa
.,BCAE 8A       TXA             restore subtracted exponent
.,BCAF A2 61    LDX #$61        set index to FAC1
.,BCB1 C9 F9    CMP #$F9        compare exponent result
.,BCB3 10 06    BPL $BCBB       if < 8 shifts shift FAC1 A times right and return
.,BCB5 20 99 B9 JSR $B999       shift FAC1 A times right (> 8 shifts)
.,BCB8 84 68    STY $68         clear FAC1 overflow byte
.,BCBA 60       RTS             

                                *** shift FAC1 A times right
.,BCBB A8       TAY             copy shift count
.,BCBC A5 66    LDA $66         get FAC1 sign (b7)
.,BCBE 29 80    AND #$80        mask sign bit only (x000 0000)
.,BCC0 46 62    LSR $62         shift FAC1 mantissa 1
.,BCC2 05 62    ORA $62         OR sign in b7 FAC1 mantissa 1
.,BCC4 85 62    STA $62         save FAC1 mantissa 1
.,BCC6 20 B0 B9 JSR $B9B0       shift FAC1 Y times right
.,BCC9 84 68    STY $68         clear FAC1 overflow byte
.,BCCB 60       RTS             

                                *** perform INT()
.,BCCC A5 61    LDA $61         get FAC1 exponent
.,BCCE C9 A0    CMP #$A0        compare with max int
.,BCD0 B0 20    BCS $BCF2       exit if >= (allready int, too big for fractional part!)
.,BCD2 20 9B BC JSR $BC9B       convert FAC1 floating to fixed
.,BCD5 84 70    STY $70         save FAC1 rounding byte
.,BCD7 A5 66    LDA $66         get FAC1 sign (b7)
.,BCD9 84 66    STY $66         save FAC1 sign (b7)
.,BCDB 49 80    EOR #$80        toggle FAC1 sign
.,BCDD 2A       ROL             shift into carry
.,BCDE A9 A0    LDA #$A0        set new exponent
.,BCE0 85 61    STA $61         save FAC1 exponent
.,BCE2 A5 65    LDA $65         get FAC1 mantissa 4
.,BCE4 85 07    STA $07         save FAC1 mantissa 4 for power function
.,BCE6 4C D2 B8 JMP $B8D2       do ABS and normalise FAC1

                                *** clear FAC1 and return
.,BCE9 85 62    STA $62         clear FAC1 mantissa 1
.,BCEB 85 63    STA $63         clear FAC1 mantissa 2
.,BCED 85 64    STA $64         clear FAC1 mantissa 3
.,BCEF 85 65    STA $65         clear FAC1 mantissa 4
.,BCF1 A8       TAY             clear Y
.,BCF2 60       RTS             

                                *** get FAC1 from string
.,BCF3 A0 00    LDY #$00        clear Y
.,BCF5 A2 0A    LDX #$0A        set index
.,BCF7 94 5D    STY $5D,X       clear byte
.,BCF9 CA       DEX             decrement index
.,BCFA 10 FB    BPL $BCF7       loop until numexp to negnum (and FAC1) = $00
.,BCFC 90 0F    BCC $BD0D       branch if first character is numeric
.,BCFE C9 2D    CMP #$2D        else compare with "-"
.,BD00 D0 04    BNE $BD06       branch if not "-"
.,BD02 86 67    STX $67         set flag for -ve n (negnum = $FF)
.,BD04 F0 04    BEQ $BD0A       branch always
.,BD06 C9 2B    CMP #$2B        else compare with "+"
.,BD08 D0 05    BNE $BD0F       branch if not "+"
.,BD0A 20 73 00 JSR $0073       increment and scan memory
.,BD0D 90 5B    BCC $BD6A       branch if numeric character
.,BD0F C9 2E    CMP #$2E        else compare with "."
.,BD11 F0 2E    BEQ $BD41       branch if "."
.,BD13 C9 45    CMP #$45        else compare with "E"
.,BD15 D0 30    BNE $BD47       branch if not "E"
                                was "E" so evaluate exponential part
.,BD17 20 73 00 JSR $0073       increment and scan memory
.,BD1A 90 17    BCC $BD33       branch if numeric character
.,BD1C C9 AB    CMP #$AB        else compare with token for -
.,BD1E F0 0E    BEQ $BD2E       branch if token for -
.,BD20 C9 2D    CMP #$2D        else compare with "-"
.,BD22 F0 0A    BEQ $BD2E       branch if "-"
.,BD24 C9 AA    CMP #$AA        else compare with token for +
.,BD26 F0 08    BEQ $BD30       branch if token for +
.,BD28 C9 2B    CMP #$2B        else compare with "+"
.,BD2A F0 04    BEQ $BD30       branch if "+"
.,BD2C D0 07    BNE $BD35       branch always
.,BD2E 66 60    ROR $60         set exponent -ve flag (C, which=1, into b7)
.,BD30 20 73 00 JSR $0073       increment and scan memory
.,BD33 90 5C    BCC $BD91       branch if numeric character
.,BD35 24 60    BIT $60         test exponent -ve flag
.,BD37 10 0E    BPL $BD47       if +ve go evaluate exponent
                                else do exponent = -exponent
.,BD39 A9 00    LDA #$00        clear result
.,BD3B 38       SEC             set carry for subtract
.,BD3C E5 5E    SBC $5E         subtract exponent byte
.,BD3E 4C 49 BD JMP $BD49       go evaluate exponent
.,BD41 66 5F    ROR $5F         set decimal point flag
.,BD43 24 5F    BIT $5F         test decimal point flag
.,BD45 50 C3    BVC $BD0A       branch if only one decimal point so far
                                evaluate exponent
.,BD47 A5 5E    LDA $5E         get exponent count byte
.,BD49 38       SEC             set carry for subtract
.,BD4A E5 5D    SBC $5D         subtract numerator exponent
.,BD4C 85 5E    STA $5E         save exponent count byte
.,BD4E F0 12    BEQ $BD62       branch if no adjustment
.,BD50 10 09    BPL $BD5B       else if +ve go do FAC1*10^expcnt
                                else go do FAC1/10^(0-expcnt)
.,BD52 20 FE BA JSR $BAFE       divide FAC1 by 10
.,BD55 E6 5E    INC $5E         increment exponent count byte
.,BD57 D0 F9    BNE $BD52       loop until all done
.,BD59 F0 07    BEQ $BD62       branch always
.,BD5B 20 E2 BA JSR $BAE2       multiply FAC1 by 10
.,BD5E C6 5E    DEC $5E         decrement exponent count byte
.,BD60 D0 F9    BNE $BD5B       loop until all done
.,BD62 A5 67    LDA $67         get -ve flag
.,BD64 30 01    BMI $BD67       if -ve do - FAC1 and return
.,BD66 60       RTS             

                                *** do - FAC1 and return
.,BD67 4C B4 BF JMP $BFB4       do - FAC1
                                do unsigned FAC1*10+number
.,BD6A 48       PHA             save character
.,BD6B 24 5F    BIT $5F         test decimal point flag
.,BD6D 10 02    BPL $BD71       skip exponent increment if not set
.,BD6F E6 5D    INC $5D         else increment number exponent
.,BD71 20 E2 BA JSR $BAE2       multiply FAC1 by 10
.,BD74 68       PLA             restore character
.,BD75 38       SEC             set carry for subtract
.,BD76 E9 30    SBC #$30        convert to binary
.,BD78 20 7E BD JSR $BD7E       evaluate new ASCII digit
.,BD7B 4C 0A BD JMP $BD0A       go do next character
                                evaluate new ASCII digit
                                multiply FAC1 by 10 then (ABS) add in new digit
.,BD7E 48       PHA             save digit
.,BD7F 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,BD82 68       PLA             restore digit
.,BD83 20 3C BC JSR $BC3C       save A as integer byte
.,BD86 A5 6E    LDA $6E         get FAC2 sign (b7)
.,BD88 45 66    EOR $66         toggle with FAC1 sign (b7)
.,BD8A 85 6F    STA $6F         save sign compare (FAC1 EOR FAC2)
.,BD8C A6 61    LDX $61         get FAC1 exponent
.,BD8E 4C 6A B8 JMP $B86A       add FAC2 to FAC1 and return
                                evaluate next character of exponential part of number
.,BD91 A5 5E    LDA $5E         get exponent count byte
.,BD93 C9 0A    CMP #$0A        compare with 10 decimal
.,BD95 90 09    BCC $BDA0       branch if less
.,BD97 A9 64    LDA #$64        make all -ve exponents = -100 decimal (causes underflow)
.,BD99 24 60    BIT $60         test exponent -ve flag
.,BD9B 30 11    BMI $BDAE       branch if -ve
.,BD9D 4C 7E B9 JMP $B97E       else do overflow error then warm start
.,BDA0 0A       ASL             *2
.,BDA1 0A       ASL             *4
.,BDA2 18       CLC             clear carry for add
.,BDA3 65 5E    ADC $5E         *5
.,BDA5 0A       ASL             *10
.,BDA6 18       CLC             clear carry for add
.,BDA7 A0 00    LDY #$00        set index
.,BDA9 71 7A    ADC ($7A),Y     add character (will be $30 too much!)
.,BDAB 38       SEC             set carry for subtract
.,BDAC E9 30    SBC #$30        convert character to binary
.,BDAE 85 5E    STA $5E         save exponent count byte
.,BDB0 4C 30 BD JMP $BD30       go get next character

                                *** limits for scientific mode
.:BDB3 9B 3E BC 1F FD           99999999.90625, maximum value with at least one decimal
.:BDB8 9E 6E 6B 27 FD           999999999.25, maximum value before scientific notation
.:BDBD 9E 6E 6B 28 00           1000000000

                                *** do " IN " line number message
.,BDC2 A9 71    LDA #$71        set " IN " pointer low byte
.,BDC4 A0 A3    LDY #$A3        set " IN " pointer high byte
.,BDC6 20 DA BD JSR $BDDA       print null terminated string
.,BDC9 A5 3A    LDA $3A         get the current line number high byte
.,BDCB A6 39    LDX $39         get the current line number low byte

                                *** print XA as unsigned integer
.,BDCD 85 62    STA $62         save high byte as FAC1 mantissa1
.,BDCF 86 63    STX $63         save low byte as FAC1 mantissa2
.,BDD1 A2 90    LDX #$90        set exponent to 16d bits
.,BDD3 38       SEC             set integer is +ve flag
.,BDD4 20 49 BC JSR $BC49       set exponent = X, clear mantissa 4 and 3 and normalise
                                FAC1
.,BDD7 20 DF BD JSR $BDDF       convert FAC1 to string
.,BDDA 4C 1E AB JMP $AB1E       print null terminated string

                                *** convert FAC1 to ASCII string result in (AY)
.,BDDD A0 01    LDY #$01        set index = 1
.,BDDF A9 20    LDA #$20        character = " " (assume +ve)
.,BDE1 24 66    BIT $66         test FAC1 sign (b7)
.,BDE3 10 02    BPL $BDE7       branch if +ve
.,BDE5 A9 2D    LDA #$2D        else character = "-"
.,BDE7 99 FF 00 STA $00FF,Y     save leading character (" " or "-")
.,BDEA 85 66    STA $66         save FAC1 sign (b7)
.,BDEC 84 71    STY $71         save index
.,BDEE C8       INY             increment index
.,BDEF A9 30    LDA #$30        set character = "0"
.,BDF1 A6 61    LDX $61         get FAC1 exponent
.,BDF3 D0 03    BNE $BDF8       branch if FAC1<>0
                                exponent was $00 so FAC1 is 0
.,BDF5 4C 04 BF JMP $BF04       save last character, [EOT] and exit
                                FAC1 is some non zero value
.,BDF8 A9 00    LDA #$00        clear (number exponent count)
.,BDFA E0 80    CPX #$80        compare FAC1 exponent with $80 (<1.00000)
.,BDFC F0 02    BEQ $BE00       branch if 0.5 <= FAC1 < 1.0
.,BDFE B0 09    BCS $BE09       branch if FAC1=>1
.,BE00 A9 BD    LDA #$BD        set 1000000000 pointer low byte
.,BE02 A0 BD    LDY #$BD        set 1000000000 pointer high byte
.,BE04 20 28 BA JSR $BA28       do convert AY, FCA1*(AY)
.,BE07 A9 F7    LDA #$F7        set number exponent count
.,BE09 85 5D    STA $5D         save number exponent count
.,BE0B A9 B8    LDA #$B8        set 999999999.25 pointer low byte (max before sci note)
.,BE0D A0 BD    LDY #$BD        set 999999999.25 pointer high byte
.,BE0F 20 5B BC JSR $BC5B       compare FAC1 with (AY)
.,BE12 F0 1E    BEQ $BE32       exit if FAC1 = (AY)
.,BE14 10 12    BPL $BE28       go do /10 if FAC1 > (AY)
                                FAC1 < (AY)
.,BE16 A9 B3    LDA #$B3        set 99999999.90625 pointer low byte
.,BE18 A0 BD    LDY #$BD        set 99999999.90625 pointer high byte
.,BE1A 20 5B BC JSR $BC5B       compare FAC1 with (AY)
.,BE1D F0 02    BEQ $BE21       branch if FAC1 = (AY) (allow decimal places)
.,BE1F 10 0E    BPL $BE2F       branch if FAC1 > (AY) (no decimal places)
                                FAC1 <= (AY)
.,BE21 20 E2 BA JSR $BAE2       multiply FAC1 by 10
.,BE24 C6 5D    DEC $5D         decrement number exponent count
.,BE26 D0 EE    BNE $BE16       go test again, branch always
.,BE28 20 FE BA JSR $BAFE       divide FAC1 by 10
.,BE2B E6 5D    INC $5D         increment number exponent count
.,BE2D D0 DC    BNE $BE0B       go test again, branch always
                                now we have just the digits to do
.,BE2F 20 49 B8 JSR $B849       add 0.5 to FAC1 (round FAC1)
.,BE32 20 9B BC JSR $BC9B       convert FAC1 floating to fixed
.,BE35 A2 01    LDX #$01        set default digits before dp = 1
.,BE37 A5 5D    LDA $5D         get number exponent count
.,BE39 18       CLC             clear carry for add
.,BE3A 69 0A    ADC #$0A        up to 9 digits before point
.,BE3C 30 09    BMI $BE47       if -ve then 1 digit before dp
.,BE3E C9 0B    CMP #$0B        A>=$0B if n>=1E9
.,BE40 B0 06    BCS $BE48       branch if >= $0B
                                carry is clear
.,BE42 69 FF    ADC #$FF        take 1 from digit count
.,BE44 AA       TAX             copy to X
.,BE45 A9 02    LDA #$02        set exponent adjust
.,BE47 38       SEC             set carry for subtract
.,BE48 E9 02    SBC #$02        -2
.,BE4A 85 5E    STA $5E         save exponent adjust
.,BE4C 86 5D    STX $5D         save digits before dp count
.,BE4E 8A       TXA             copy to A
.,BE4F F0 02    BEQ $BE53       branch if no digits before dp
.,BE51 10 13    BPL $BE66       branch if digits before dp
.,BE53 A4 71    LDY $71         get output string index
.,BE55 A9 2E    LDA #$2E        character "."
.,BE57 C8       INY             increment index
.,BE58 99 FF 00 STA $00FF,Y     save to output string
.,BE5B 8A       TXA             
.,BE5C F0 06    BEQ $BE64       
.,BE5E A9 30    LDA #$30        character "0"
.,BE60 C8       INY             increment index
.,BE61 99 FF 00 STA $00FF,Y     save to output string
.,BE64 84 71    STY $71         save output string index
.,BE66 A0 00    LDY #$00        clear index (point to 100,000)
.,BE68 A2 80    LDX #$80        
.,BE6A A5 65    LDA $65         get FAC1 mantissa 4
.,BE6C 18       CLC             clear carry for add
.,BE6D 79 19 BF ADC $BF19,Y     add byte 4, least significant
.,BE70 85 65    STA $65         save FAC1 mantissa4
.,BE72 A5 64    LDA $64         get FAC1 mantissa 3
.,BE74 79 18 BF ADC $BF18,Y     add byte 3
.,BE77 85 64    STA $64         save FAC1 mantissa3
.,BE79 A5 63    LDA $63         get FAC1 mantissa 2
.,BE7B 79 17 BF ADC $BF17,Y     add byte 2
.,BE7E 85 63    STA $63         save FAC1 mantissa2
.,BE80 A5 62    LDA $62         get FAC1 mantissa 1
.,BE82 79 16 BF ADC $BF16,Y     add byte 1, most significant
.,BE85 85 62    STA $62         save FAC1 mantissa1
.,BE87 E8       INX             increment the digit, set the sign on the test sense bit
.,BE88 B0 04    BCS $BE8E       if the carry is set go test if the result was positive
                                else the result needs to be negative
.,BE8A 10 DE    BPL $BE6A       not -ve so try again
.,BE8C 30 02    BMI $BE90       else done so return the digit
.,BE8E 30 DA    BMI $BE6A       not +ve so try again
                                else done so return the digit
.,BE90 8A       TXA             copy the digit
.,BE91 90 04    BCC $BE97       if Cb=0 just use it
.,BE93 49 FF    EOR #$FF        else make the 2's complement ..
.,BE95 69 0A    ADC #$0A        .. and subtract it from 10
.,BE97 69 2F    ADC #$2F        add "0"-1 to result
.,BE99 C8       INY             increment ..
.,BE9A C8       INY             .. index to..
.,BE9B C8       INY             .. next less ..
.,BE9C C8       INY             .. power of ten
.,BE9D 84 47    STY $47         save current variable pointer low byte
.,BE9F A4 71    LDY $71         get output string index
.,BEA1 C8       INY             increment output string index
.,BEA2 AA       TAX             copy character to X
.,BEA3 29 7F    AND #$7F        mask out top bit
.,BEA5 99 FF 00 STA $00FF,Y     save to output string
.,BEA8 C6 5D    DEC $5D         decrement # of characters before the dp
.,BEAA D0 06    BNE $BEB2       branch if still characters to do
                                else output the point
.,BEAC A9 2E    LDA #$2E        character "."
.,BEAE C8       INY             increment output string index
.,BEAF 99 FF 00 STA $00FF,Y     save to output string
.,BEB2 84 71    STY $71         save output string index
.,BEB4 A4 47    LDY $47         get current variable pointer low byte
.,BEB6 8A       TXA             get character back
.,BEB7 49 FF    EOR #$FF        toggle the test sense bit
.,BEB9 29 80    AND #$80        clear the digit
.,BEBB AA       TAX             copy it to the new digit
.,BEBC C0 24    CPY #$24        
                                compare the table index with the max for decimal numbers
.,BEBE F0 04    BEQ $BEC4       if at the max exit the digit loop
.,BEC0 C0 3C    CPY #$3C        
                                compare the table index with the max for time
.,BEC2 D0 A6    BNE $BE6A       loop if not at the max
                                now remove trailing zeroes
.,BEC4 A4 71    LDY $71         restore the output string index
.,BEC6 B9 FF 00 LDA $00FF,Y     get character from output string
.,BEC9 88       DEY             decrement output string index
.,BECA C9 30    CMP #$30        compare with "0"
.,BECC F0 F8    BEQ $BEC6       loop until non "0" character found
.,BECE C9 2E    CMP #$2E        compare with "."
.,BED0 F0 01    BEQ $BED3       branch if was dp
                                restore last character
.,BED2 C8       INY             increment output string index
.,BED3 A9 2B    LDA #$2B        character "+"
.,BED5 A6 5E    LDX $5E         get exponent count
.,BED7 F0 2E    BEQ $BF07       if zero go set null terminator and exit
                                exponent isn't zero so write exponent
.,BED9 10 08    BPL $BEE3       branch if exponent count +ve
.,BEDB A9 00    LDA #$00        clear A
.,BEDD 38       SEC             set carry for subtract
.,BEDE E5 5E    SBC $5E         subtract exponent count adjust (convert -ve to +ve)
.,BEE0 AA       TAX             copy exponent count to X
.,BEE1 A9 2D    LDA #$2D        character "-"
.,BEE3 99 01 01 STA $0101,Y     save to output string
.,BEE6 A9 45    LDA #$45        character "E"
.,BEE8 99 00 01 STA $0100,Y     save exponent sign to output string
.,BEEB 8A       TXA             get exponent count back
.,BEEC A2 2F    LDX #$2F        one less than "0" character
.,BEEE 38       SEC             set carry for subtract
.,BEEF E8       INX             increment 10's character
.,BEF0 E9 0A    SBC #$0A        subtract 10 from exponent count
.,BEF2 B0 FB    BCS $BEEF       loop while still >= 0
.,BEF4 69 3A    ADC #$3A        add character ":" ($30+$0A, result is 10 less that value)
.,BEF6 99 03 01 STA $0103,Y     save to output string
.,BEF9 8A       TXA             copy 10's character
.,BEFA 99 02 01 STA $0102,Y     save to output string
.,BEFD A9 00    LDA #$00        set null terminator
.,BEFF 99 04 01 STA $0104,Y     save to output string
.,BF02 F0 08    BEQ $BF0C       go set string pointer (AY) and exit, branch always
                                save last character, [EOT] and exit
.,BF04 99 FF 00 STA $00FF,Y     save last character to output string
                                set null terminator and exit
.,BF07 A9 00    LDA #$00        set null terminator
.,BF09 99 00 01 STA $0100,Y     save after last character
                                set string pointer (AY) and exit
.,BF0C A9 00    LDA #$00        set result string pointer low byte
.,BF0E A0 01    LDY #$01        set result string pointer high byte
.,BF10 60       RTS             

                                *** constants
.:BF11 80 00                    0.5, first two bytes
.:BF13 00 00 00                 null return for undefined variables
.:BF16 FA 0A 1F 00              -100 000 000
.:BF1A 00 98 96 80               +10 000 000
.:BF1E FF F0 BD C0                -1 000 000
.:BF22 00 01 86 A0                  +100 000
.:BF26 FF FF D8 F0                   -10 000
.:BF2A 00 00 03 E8                    +1 000
.:BF2E FF FF FF 9C                     - 100
.:BF32 00 00 00 0A                       +10
.:BF36 FF FF FF FF                        -1

                                *** jiffy counts
.:BF3A FF DF 0A 80              -2160000    10s hours
.:BF3E 00 03 4B C0               +216000        hours
.:BF42 FF FF 73 60                -36000    10s mins
.:BF46 00 00 0E 10                 +3600        mins
.:BF4A FF FF FD A8                  -600    10s secs
.:BF4E 00 00 00 3C                   +60        secs

                                *** not referenced
.:BF52 EC                       checksum byte

                                *** spare bytes, not referenced
.:BF53 AA AA AA AA AA
.:BF58 AA AA AA AA AA AA AA AA
.:BF60 AA AA AA AA AA AA AA AA
.:BF68 AA AA AA AA AA AA AA AA
.:BF70 AA

                                *** perform SQR()
.,BF71 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,BF74 A9 11    LDA #$11        set 0.5 pointer low address
.,BF76 A0 BF    LDY #$BF        set 0.5 pointer high address
.,BF78 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1

                                *** perform power function
.,BF7B F0 70    BEQ $BFED       perform EXP()
.,BF7D A5 69    LDA $69         get FAC2 exponent
.,BF7F D0 03    BNE $BF84       branch if FAC2<>0
.,BF81 4C F9 B8 JMP $B8F9       clear FAC1 exponent and sign and return
.,BF84 A2 4E    LDX #$4E        set destination pointer low byte
.,BF86 A0 00    LDY #$00        set destination pointer high byte
.,BF88 20 D4 BB JSR $BBD4       pack FAC1 into (XY)
.,BF8B A5 6E    LDA $6E         get FAC2 sign (b7)
.,BF8D 10 0F    BPL $BF9E       branch if FAC2>0
                                else FAC2 is -ve and can only be raised to an
                                integer power which gives an x + j0 result
.,BF8F 20 CC BC JSR $BCCC       perform INT()
.,BF92 A9 4E    LDA #$4E        set source pointer low byte
.,BF94 A0 00    LDY #$00        set source pointer high byte
.,BF96 20 5B BC JSR $BC5B       compare FAC1 with (AY)
.,BF99 D0 03    BNE $BF9E       branch if FAC1 <> (AY) to allow Function Call error
                                this will leave FAC1 -ve and cause a Function Call
                                error when LOG() is called
.,BF9B 98       TYA             clear sign b7
.,BF9C A4 07    LDY $07         get FAC1 mantissa 4 from INT() function as sign in
                                Y for possible later negation, b0 only needed
.,BF9E 20 FE BB JSR $BBFE       save FAC1 sign and copy ABS(FAC2) to FAC1
.,BFA1 98       TYA             copy sign back ..
.,BFA2 48       PHA             .. and save it
.,BFA3 20 EA B9 JSR $B9EA       perform LOG()
.,BFA6 A9 4E    LDA #$4E        set pointer low byte
.,BFA8 A0 00    LDY #$00        set pointer high byte
.,BFAA 20 28 BA JSR $BA28       do convert AY, FCA1*(AY)
.,BFAD 20 ED BF JSR $BFED       perform EXP()
.,BFB0 68       PLA             pull sign from stack
.,BFB1 4A       LSR             b0 is to be tested
.,BFB2 90 0A    BCC $BFBE       if no bit then exit
                                do - FAC1
.,BFB4 A5 61    LDA $61         get FAC1 exponent
.,BFB6 F0 06    BEQ $BFBE       exit if FAC1_e = $00
.,BFB8 A5 66    LDA $66         get FAC1 sign (b7)
.,BFBA 49 FF    EOR #$FF        complement it
.,BFBC 85 66    STA $66         save FAC1 sign (b7)
.,BFBE 60       RTS             

                                *** exp(n) constant and series
.:BFBF 81 38 AA 3B 29           1.44269504 = 1/LOG(2)
.:BFC4 07                       series count
.:BFC5 71 34 58 3E 56           2.14987637E-5
.:BFCA 74 16 7E B3 1B           1.43523140E-4
.:BFCF 77 2F EE E3 85           1.34226348E-3
.:BFD4 7A 1D 84 1C 2A           9.61401701E-3
.:BFD9 7C 63 59 58 0A           5.55051269E-2
.:BFDE 7E 75 FD E7 C6           2.40226385E-1
.:BFE3 80 31 72 18 10           6.93147186E-1
.:BFE8 81 00 00 00 00           1.00000000

                                *** perform EXP()
.,BFED A9 BF    LDA #$BF        set 1.443 pointer low byte
.,BFEF A0 BF    LDY #$BF        set 1.443 pointer high byte
.,BFF1 20 28 BA JSR $BA28       do convert AY, FCA1*(AY)
.,BFF4 A5 70    LDA $70         get FAC1 rounding byte
.,BFF6 69 50    ADC #$50        +$50/$100
.,BFF8 90 03    BCC $BFFD       skip rounding if no carry
.,BFFA 20 23 BC JSR $BC23       round FAC1 (no check)
.,BFFD 4C 00 E0 JMP $E000       continue EXP()

                                *** start of the kernal ROM
                                EXP() continued
.,E000 85 56    STA $56         save FAC2 rounding byte
.,E002 20 0F BC JSR $BC0F       copy FAC1 to FAC2
.,E005 A5 61    LDA $61         get FAC1 exponent
.,E007 C9 88    CMP #$88        compare with EXP limit (256d)
.,E009 90 03    BCC $E00E       branch if less
.,E00B 20 D4 BA JSR $BAD4       handle overflow and underflow
.,E00E 20 CC BC JSR $BCCC       perform INT()
.,E011 A5 07    LDA $07         get mantissa 4 from INT()
.,E013 18       CLC             clear carry for add
.,E014 69 81    ADC #$81        normalise +1
.,E016 F0 F3    BEQ $E00B       if $00 result has overflowed so go handle it
.,E018 38       SEC             set carry for subtract
.,E019 E9 01    SBC #$01        exponent now correct
.,E01B 48       PHA             save FAC2 exponent
                                swap FAC1 and FAC2
.,E01C A2 05    LDX #$05        4 bytes to do
.,E01E B5 69    LDA $69,X       get FAC2,X
.,E020 B4 61    LDY $61,X       get FAC1,X
.,E022 95 61    STA $61,X       save FAC1,X
.,E024 94 69    STY $69,X       save FAC2,X
.,E026 CA       DEX             decrement count/index
.,E027 10 F5    BPL $E01E       loop if not all done
.,E029 A5 56    LDA $56         get FAC2 rounding byte
.,E02B 85 70    STA $70         save as FAC1 rounding byte
.,E02D 20 53 B8 JSR $B853       perform subtraction, FAC2 from FAC1
.,E030 20 B4 BF JSR $BFB4       do - FAC1
.,E033 A9 C4    LDA #$C4        set counter pointer low byte
.,E035 A0 BF    LDY #$BF        set counter pointer high byte
.,E037 20 59 E0 JSR $E059       go do series evaluation
.,E03A A9 00    LDA #$00        clear A
.,E03C 85 6F    STA $6F         clear sign compare (FAC1 EOR FAC2)
.,E03E 68       PLA             get saved FAC2 exponent
.,E03F 20 B9 BA JSR $BAB9       test and adjust accumulators
.,E042 60       RTS             
                                ^2 then series evaluation
.,E043 85 71    STA $71         save count pointer low byte
.,E045 84 72    STY $72         save count pointer high byte
.,E047 20 CA BB JSR $BBCA       pack FAC1 into $57
.,E04A A9 57    LDA #$57        set pointer low byte (Y already $00)
.,E04C 20 28 BA JSR $BA28       do convert AY, FCA1*(AY)
.,E04F 20 5D E0 JSR $E05D       go do series evaluation
.,E052 A9 57    LDA #$57        pointer to original # low byte
.,E054 A0 00    LDY #$00        pointer to original # high byte
.,E056 4C 28 BA JMP $BA28       do convert AY, FCA1*(AY)
                                do series evaluation
.,E059 85 71    STA $71         save count pointer low byte
.,E05B 84 72    STY $72         save count pointer high byte
                                do series evaluation
.,E05D 20 C7 BB JSR $BBC7       pack FAC1 into $5C
.,E060 B1 71    LDA ($71),Y     get constants count
.,E062 85 67    STA $67         save constants count
.,E064 A4 71    LDY $71         get count pointer low byte
.,E066 C8       INY             increment it (now constants pointer)
.,E067 98       TYA             copy it
.,E068 D0 02    BNE $E06C       skip next if no overflow
.,E06A E6 72    INC $72         else increment high byte
.,E06C 85 71    STA $71         save low byte
.,E06E A4 72    LDY $72         get high byte
.,E070 20 28 BA JSR $BA28       do convert AY, FCA1*(AY)
.,E073 A5 71    LDA $71         get constants pointer low byte
.,E075 A4 72    LDY $72         get constants pointer high byte
.,E077 18       CLC             clear carry for add
.,E078 69 05    ADC #$05        +5 to low pointer (5 bytes per constant)
.,E07A 90 01    BCC $E07D       skip next if no overflow
.,E07C C8       INY             increment high byte
.,E07D 85 71    STA $71         save pointer low byte
.,E07F 84 72    STY $72         save pointer high byte
.,E081 20 67 B8 JSR $B867       add (AY) to FAC1
.,E084 A9 5C    LDA #$5C        set pointer low byte to partial
.,E086 A0 00    LDY #$00        set pointer high byte to partial
.,E088 C6 67    DEC $67         decrement constants count
.,E08A D0 E4    BNE $E070       loop until all done
.,E08C 60       RTS             

                                *** RND values
.:E08D 98 35 44 7A 00           11879546            multiplier
.:E092 68 28 B1 46 00           3.927677739E-8      offset

                                *** perform RND()
.,E097 20 2B BC JSR $BC2B       get FAC1 sign
                                return A = $FF -ve, A = $01 +ve
.,E09A 30 37    BMI $E0D3       if n<0 copy byte swapped FAC1 into RND() seed
.,E09C D0 20    BNE $E0BE       if n>0 get next number in RND() sequence
                                else n=0 so get the RND() number from VIA 1 timers
.,E09E 20 F3 FF JSR $FFF3       return base address of I/O devices
.,E0A1 86 22    STX $22         save pointer low byte
.,E0A3 84 23    STY $23         save pointer high byte
.,E0A5 A0 04    LDY #$04        set index to T1 low byte
.,E0A7 B1 22    LDA ($22),Y     get T1 low byte
.,E0A9 85 62    STA $62         save FAC1 mantissa 1
.,E0AB C8       INY             increment index
.,E0AC B1 22    LDA ($22),Y     get T1 high byte
.,E0AE 85 64    STA $64         save FAC1 mantissa 3
.,E0B0 A0 08    LDY #$08        set index to T2 low byte
.,E0B2 B1 22    LDA ($22),Y     get T2 low byte
.,E0B4 85 63    STA $63         save FAC1 mantissa 2
.,E0B6 C8       INY             increment index
.,E0B7 B1 22    LDA ($22),Y     get T2 high byte
.,E0B9 85 65    STA $65         save FAC1 mantissa 4
.,E0BB 4C E3 E0 JMP $E0E3       set exponent and exit
.,E0BE A9 8B    LDA #$8B        set seed pointer low address
.,E0C0 A0 00    LDY #$00        set seed pointer high address
.,E0C2 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1
.,E0C5 A9 8D    LDA #$8D        set 11879546 pointer low byte
.,E0C7 A0 E0    LDY #$E0        set 11879546 pointer high byte
.,E0C9 20 28 BA JSR $BA28       do convert AY, FCA1*(AY)
.,E0CC A9 92    LDA #$92        set 3.927677739E-8 pointer low byte
.,E0CE A0 E0    LDY #$E0        set 3.927677739E-8 pointer high byte
.,E0D0 20 67 B8 JSR $B867       add (AY) to FAC1
.,E0D3 A6 65    LDX $65         get FAC1 mantissa 4
.,E0D5 A5 62    LDA $62         get FAC1 mantissa 1
.,E0D7 85 65    STA $65         save FAC1 mantissa 4
.,E0D9 86 62    STX $62         save FAC1 mantissa 1
.,E0DB A6 63    LDX $63         get FAC1 mantissa 2
.,E0DD A5 64    LDA $64         get FAC1 mantissa 3
.,E0DF 85 63    STA $63         save FAC1 mantissa 2
.,E0E1 86 64    STX $64         save FAC1 mantissa 3
.,E0E3 A9 00    LDA #$00        clear byte
.,E0E5 85 66    STA $66         clear FAC1 sign (always +ve)
.,E0E7 A5 61    LDA $61         get FAC1 exponent
.,E0E9 85 70    STA $70         save FAC1 rounding byte
.,E0EB A9 80    LDA #$80        set exponent = $80
.,E0ED 85 61    STA $61         save FAC1 exponent
.,E0EF 20 D7 B8 JSR $B8D7       normalise FAC1
.,E0F2 A2 8B    LDX #$8B        set seed pointer low address
.,E0F4 A0 00    LDY #$00        set seed pointer high address

                                *** pack FAC1 into (XY)
.,E0F6 4C D4 BB JMP $BBD4       pack FAC1 into (XY)

                                *** handle BASIC I/O error
.,E0F9 C9 F0    CMP #$F0        compare error with $F0
.,E0FB D0 07    BNE $E104       branch if not $F0
.,E0FD 84 38    STY $38         set end of memory high byte
.,E0FF 86 37    STX $37         set end of memory low byte
.,E101 4C 63 A6 JMP $A663       clear from start to end and return
                                error was not $F0
.,E104 AA       TAX             copy error #
.,E105 D0 02    BNE $E109       branch if not $00
.,E107 A2 1E    LDX #$1E        else error $1E, break error
.,E109 4C 37 A4 JMP $A437       do error #X then warm start

                                *** output character to channel with error check
.,E10C 20 D2 FF JSR $FFD2       output character to channel
.,E10F B0 E8    BCS $E0F9       if error go handle BASIC I/O error
.,E111 60       RTS             

                                *** input character from channel with error check
.,E112 20 CF FF JSR $FFCF       input character from channel
.,E115 B0 E2    BCS $E0F9       if error go handle BASIC I/O error
.,E117 60       RTS             

                                *** open channel for output with error check
.,E118 20 AD E4 JSR $E4AD       open channel for output
.,E11B B0 DC    BCS $E0F9       if error go handle BASIC I/O error
.,E11D 60       RTS             

                                *** open channel for input with error check
.,E11E 20 C6 FF JSR $FFC6       open channel for input
.,E121 B0 D6    BCS $E0F9       if error go handle BASIC I/O error
.,E123 60       RTS             

                                *** get character from input device with error check
.,E124 20 E4 FF JSR $FFE4       get character from input device
.,E127 B0 D0    BCS $E0F9       if error go handle BASIC I/O error
.,E129 60       RTS             

                                *** perform SYS
.,E12A 20 8A AD JSR $AD8A       evaluate expression and check is numeric, else do
                                type mismatch
.,E12D 20 F7 B7 JSR $B7F7       convert FAC_1 to integer in temporary integer
.,E130 A9 E1    LDA #$E1        get return address high byte
.,E132 48       PHA             push as return address
.,E133 A9 46    LDA #$46        get return address low byte
.,E135 48       PHA             push as return address
.,E136 AD 0F 03 LDA $030F       get saved status register
.,E139 48       PHA             put on stack
.,E13A AD 0C 03 LDA $030C       get saved A
.,E13D AE 0D 03 LDX $030D       get saved X
.,E140 AC 0E 03 LDY $030E       get saved Y
.,E143 28       PLP             pull processor status
.,E144 6C 14 00 JMP ($0014)     call SYS address
                                tail end of SYS code
.,E147 08       PHP             save status
.,E148 8D 0C 03 STA $030C       save returned A
.,E14B 8E 0D 03 STX $030D       save returned X
.,E14E 8C 0E 03 STY $030E       save returned Y
.,E151 68       PLA             restore saved status
.,E152 8D 0F 03 STA $030F       save status
.,E155 60       RTS             

                                *** perform SAVE
.,E156 20 D4 E1 JSR $E1D4       get parameters for LOAD/SAVE
.,E159 A6 2D    LDX $2D         get start of variables low byte
.,E15B A4 2E    LDY $2E         get start of variables high byte
.,E15D A9 2B    LDA #$2B        index to start of program memory
.,E15F 20 D8 FF JSR $FFD8       save RAM to device, A = index to start address, XY = end
                                address low/high
.,E162 B0 95    BCS $E0F9       if error go handle BASIC I/O error
.,E164 60       RTS             

                                *** perform VERIFY
.,E165 A9 01    LDA #$01        flag verify
.:E167 2C       .BYTE $2C       makes next line BIT $00A9

                                *** perform LOAD
.,E168 A9 00    LDA #$00        flag load
.,E16A 85 0A    STA $0A         set load/verify flag
.,E16C 20 D4 E1 JSR $E1D4       get parameters for LOAD/SAVE
.,E16F A5 0A    LDA $0A         get load/verify flag
.,E171 A6 2B    LDX $2B         get start of memory low byte
.,E173 A4 2C    LDY $2C         get start of memory high byte
.,E175 20 D5 FF JSR $FFD5       load RAM from a device
.,E178 B0 57    BCS $E1D1       if error go handle BASIC I/O error
.,E17A A5 0A    LDA $0A         get load/verify flag
.,E17C F0 17    BEQ $E195       branch if load
.,E17E A2 1C    LDX #$1C        error $1C, verify error
.,E180 20 B7 FF JSR $FFB7       read I/O status word
.,E183 29 10    AND #$10        mask for tape read error
.,E185 D0 17    BNE $E19E       branch if no read error
.,E187 A5 7A    LDA $7A         get the BASIC execute pointer low byte
                                is this correct ?? won't this mean the "OK" prompt
                                when doing a load from within a program ?
.,E189 C9 02    CMP #$02        
.,E18B F0 07    BEQ $E194       if ?? skip "OK" prompt
.,E18D A9 64    LDA #$64        set "OK" pointer low byte
.,E18F A0 A3    LDY #$A3        set "OK" pointer high byte
.,E191 4C 1E AB JMP $AB1E       print null terminated string
.,E194 60       RTS             

                                *** do READY return to BASIC
.,E195 20 B7 FF JSR $FFB7       read I/O status word
.,E198 29 BF    AND #$BF        mask x0xx xxxx, clear read error
.,E19A F0 05    BEQ $E1A1       branch if no errors
.,E19C A2 1D    LDX #$1D        error $1D, load error
.,E19E 4C 37 A4 JMP $A437       do error #X then warm start
.,E1A1 A5 7B    LDA $7B         get BASIC execute pointer high byte
.,E1A3 C9 02    CMP #$02        compare with $02xx
.,E1A5 D0 0E    BNE $E1B5       branch if not immediate mode
.,E1A7 86 2D    STX $2D         set start of variables low byte
.,E1A9 84 2E    STY $2E         set start of variables high byte
.,E1AB A9 76    LDA #$76        set "READY." pointer low byte
.,E1AD A0 A3    LDY #$A3        set "READY." pointer high byte
.,E1AF 20 1E AB JSR $AB1E       print null terminated string
.,E1B2 4C 2A A5 JMP $A52A       reset execution, clear variables, flush stack,
                                rebuild BASIC chain and do warm start
.,E1B5 20 8E A6 JSR $A68E       set BASIC execute pointer to start of memory - 1
.,E1B8 20 33 A5 JSR $A533       rebuild BASIC line chaining
.,E1BB 4C 77 A6 JMP $A677       rebuild BASIC line chaining, do RESTORE and return

                                *** perform OPEN
.,E1BE 20 19 E2 JSR $E219       get parameters for OPEN/CLOSE
.,E1C1 20 C0 FF JSR $FFC0       open a logical file
.,E1C4 B0 0B    BCS $E1D1       branch if error
.,E1C6 60       RTS             

                                *** perform CLOSE
.,E1C7 20 19 E2 JSR $E219       get parameters for OPEN/CLOSE
.,E1CA A5 49    LDA $49         get logical file number
.,E1CC 20 C3 FF JSR $FFC3       close a specified logical file
.,E1CF 90 C3    BCC $E194       exit if no error
.,E1D1 4C F9 E0 JMP $E0F9       go handle BASIC I/O error

                                *** get parameters for LOAD/SAVE
.,E1D4 A9 00    LDA #$00        clear file name length
.,E1D6 20 BD FF JSR $FFBD       clear the filename
.,E1D9 A2 01    LDX #$01        set default device number, cassette
.,E1DB A0 00    LDY #$00        set default command
.,E1DD 20 BA FF JSR $FFBA       set logical, first and second addresses
.,E1E0 20 06 E2 JSR $E206       exit function if [EOT] or ":"
.,E1E3 20 57 E2 JSR $E257       set filename
.,E1E6 20 06 E2 JSR $E206       exit function if [EOT] or ":"
.,E1E9 20 00 E2 JSR $E200       scan and get byte, else do syntax error then warm start
.,E1EC A0 00    LDY #$00        clear command
.,E1EE 86 49    STX $49         save device number
.,E1F0 20 BA FF JSR $FFBA       set logical, first and second addresses
.,E1F3 20 06 E2 JSR $E206       exit function if [EOT] or ":"
.,E1F6 20 00 E2 JSR $E200       scan and get byte, else do syntax error then warm start
.,E1F9 8A       TXA             copy command to A
.,E1FA A8       TAY             copy command to Y
.,E1FB A6 49    LDX $49         get device number back
.,E1FD 4C BA FF JMP $FFBA       set logical, first and second addresses and return

                                *** scan and get byte, else do syntax error then warm start
.,E200 20 0E E2 JSR $E20E       scan for ",byte", else do syntax error then warm start
.,E203 4C 9E B7 JMP $B79E       get byte parameter and return
                                exit function if [EOT] or ":"
.,E206 20 79 00 JSR $0079       scan memory
.,E209 D0 02    BNE $E20D       branch if not [EOL] or ":"
.,E20B 68       PLA             dump return address low byte
.,E20C 68       PLA             dump return address high byte
.,E20D 60       RTS             

                                *** scan for ",valid byte", else do syntax error then warm start
.,E20E 20 FD AE JSR $AEFD       scan for ",", else do syntax error then warm start

                                *** scan for valid byte, not [EOL] or ":", else do syntax error then warm start
.,E211 20 79 00 JSR $0079       scan memory
.,E214 D0 F7    BNE $E20D       exit if following byte
.,E216 4C 08 AF JMP $AF08       else do syntax error then warm start

                                *** get parameters for OPEN/CLOSE
.,E219 A9 00    LDA #$00        clear the filename length
.,E21B 20 BD FF JSR $FFBD       clear the filename
.,E21E 20 11 E2 JSR $E211       scan for valid byte, else do syntax error then warm start
.,E221 20 9E B7 JSR $B79E       get byte parameter, logical file number
.,E224 86 49    STX $49         save logical file number
.,E226 8A       TXA             copy logical file number to A
.,E227 A2 01    LDX #$01        set default device number, cassette
.,E229 A0 00    LDY #$00        set default command
.,E22B 20 BA FF JSR $FFBA       set logical, first and second addresses
.,E22E 20 06 E2 JSR $E206       exit function if [EOT] or ":"
.,E231 20 00 E2 JSR $E200       scan and get byte, else do syntax error then warm start
.,E234 86 4A    STX $4A         save device number
.,E236 A0 00    LDY #$00        clear command
.,E238 A5 49    LDA $49         get logical file number
.,E23A E0 03    CPX #$03        compare device number with screen
.,E23C 90 01    BCC $E23F       branch if less than screen
.,E23E 88       DEY             else decrement command
.,E23F 20 BA FF JSR $FFBA       set logical, first and second addresses
.,E242 20 06 E2 JSR $E206       exit function if [EOT] or ":"
.,E245 20 00 E2 JSR $E200       scan and get byte, else do syntax error then warm start
.,E248 8A       TXA             copy command to A
.,E249 A8       TAY             copy command to Y
.,E24A A6 4A    LDX $4A         get device number
.,E24C A5 49    LDA $49         get logical file number
.,E24E 20 BA FF JSR $FFBA       set logical, first and second addresses
.,E251 20 06 E2 JSR $E206       exit function if [EOT] or ":"
.,E254 20 0E E2 JSR $E20E       scan for ",byte", else do syntax error then warm start

                                *** set filename
.,E257 20 9E AD JSR $AD9E       evaluate expression
.,E25A 20 A3 B6 JSR $B6A3       evaluate string
.,E25D A6 22    LDX $22         get string pointer low byte
.,E25F A4 23    LDY $23         get string pointer high byte
.,E261 4C BD FF JMP $FFBD       set the filename and return

                                *** perform COS()
.,E264 A9 E0    LDA #$E0        set pi/2 pointer low byte
.,E266 A0 E2    LDY #$E2        set pi/2 pointer high byte
.,E268 20 67 B8 JSR $B867       add (AY) to FAC1

                                *** perform SIN()
.,E26B 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,E26E A9 E5    LDA #$E5        set 2*pi pointer low byte
.,E270 A0 E2    LDY #$E2        set 2*pi pointer high byte
.,E272 A6 6E    LDX $6E         get FAC2 sign (b7)
.,E274 20 07 BB JSR $BB07       divide by (AY) (X=sign)
.,E277 20 0C BC JSR $BC0C       round and copy FAC1 to FAC2
.,E27A 20 CC BC JSR $BCCC       perform INT()
.,E27D A9 00    LDA #$00        clear byte
.,E27F 85 6F    STA $6F         clear sign compare (FAC1 EOR FAC2)
.,E281 20 53 B8 JSR $B853       perform subtraction, FAC2 from FAC1
.,E284 A9 EA    LDA #$EA        set 0.25 pointer low byte
.,E286 A0 E2    LDY #$E2        set 0.25 pointer high byte
.,E288 20 50 B8 JSR $B850       perform subtraction, FAC1 from (AY)
.,E28B A5 66    LDA $66         get FAC1 sign (b7)
.,E28D 48       PHA             save FAC1 sign
.,E28E 10 0D    BPL $E29D       branch if +ve
                                FAC1 sign was -ve
.,E290 20 49 B8 JSR $B849       add 0.5 to FAC1 (round FAC1)
.,E293 A5 66    LDA $66         get FAC1 sign (b7)
.,E295 30 09    BMI $E2A0       branch if -ve
.,E297 A5 12    LDA $12         get the comparison evaluation flag
.,E299 49 FF    EOR #$FF        toggle flag
.,E29B 85 12    STA $12         save the comparison evaluation flag
.,E29D 20 B4 BF JSR $BFB4       do - FAC1
.,E2A0 A9 EA    LDA #$EA        set 0.25 pointer low byte
.,E2A2 A0 E2    LDY #$E2        set 0.25 pointer high byte
.,E2A4 20 67 B8 JSR $B867       add (AY) to FAC1
.,E2A7 68       PLA             restore FAC1 sign
.,E2A8 10 03    BPL $E2AD       branch if was +ve
                                else correct FAC1
.,E2AA 20 B4 BF JSR $BFB4       do - FAC1
.,E2AD A9 EF    LDA #$EF        set pointer low byte to counter
.,E2AF A0 E2    LDY #$E2        set pointer high byte to counter
.,E2B1 4C 43 E0 JMP $E043       ^2 then series evaluation and return

                                *** perform TAN()
.,E2B4 20 CA BB JSR $BBCA       pack FAC1 into $57
.,E2B7 A9 00    LDA #$00        clear A
.,E2B9 85 12    STA $12         clear the comparison evaluation flag
.,E2BB 20 6B E2 JSR $E26B       perform SIN()
.,E2BE A2 4E    LDX #$4E        set sin(n) pointer low byte
.,E2C0 A0 00    LDY #$00        set sin(n) pointer high byte
.,E2C2 20 F6 E0 JSR $E0F6       pack FAC1 into (XY)
.,E2C5 A9 57    LDA #$57        set n pointer low byte
.,E2C7 A0 00    LDY #$00        set n pointer high byte
.,E2C9 20 A2 BB JSR $BBA2       unpack memory (AY) into FAC1
.,E2CC A9 00    LDA #$00        clear byte
.,E2CE 85 66    STA $66         clear FAC1 sign (b7)
.,E2D0 A5 12    LDA $12         get the comparison evaluation flag
.,E2D2 20 DC E2 JSR $E2DC       save flag and go do series evaluation
.,E2D5 A9 4E    LDA #$4E        set sin(n) pointer low byte
.,E2D7 A0 00    LDY #$00        set sin(n) pointer high byte
.,E2D9 4C 0F BB JMP $BB0F       convert AY and do (AY)/FAC1

                                *** save comparison flag and do series evaluation
.,E2DC 48       PHA             save comparison flag
.,E2DD 4C 9D E2 JMP $E29D       add 0.25, ^2 then series evaluation

                                *** constants and series for SIN/COS(n)
.:E2E0 81 49 0F DA A2           1.570796371, pi/2, as floating number
.:E2E5 83 49 0F DA A2           6.28319, 2*pi, as floating number
.:E2EA 7F 00 00 00 00           0.25
.:E2EF 05                       series counter
.:E2F0 84 E6 1A 2D 1B           -14.3813907
.:E2F5 86 28 07 FB F8            42.0077971
.:E2FA 87 99 68 89 01           -76.7041703
.:E2FF 87 23 35 DF E1            81.6052237
.:E304 86 A5 5D E7 28           -41.3147021
.:E309 83 49 0F DA A2             6.28318531   2*pi

                                *** perform ATN()
.,E30E A5 66    LDA $66         get FAC1 sign (b7)
.,E310 48       PHA             save sign
.,E311 10 03    BPL $E316       branch if +ve
.,E313 20 B4 BF JSR $BFB4       else do - FAC1
.,E316 A5 61    LDA $61         get FAC1 exponent
.,E318 48       PHA             push exponent
.,E319 C9 81    CMP #$81        compare with 1
.,E31B 90 07    BCC $E324       branch if FAC1 < 1
.,E31D A9 BC    LDA #$BC        pointer to 1 low byte
.,E31F A0 B9    LDY #$B9        pointer to 1 high byte
.,E321 20 0F BB JSR $BB0F       convert AY and do (AY)/FAC1
.,E324 A9 3E    LDA #$3E        pointer to series low byte
.,E326 A0 E3    LDY #$E3        pointer to series high byte
.,E328 20 43 E0 JSR $E043       ^2 then series evaluation
.,E32B 68       PLA             restore old FAC1 exponent
.,E32C C9 81    CMP #$81        compare with 1
.,E32E 90 07    BCC $E337       branch if FAC1 < 1
.,E330 A9 E0    LDA #$E0        pointer to (pi/2) low byte
.,E332 A0 E2    LDY #$E2        pointer to (pi/2) low byte
.,E334 20 50 B8 JSR $B850       perform subtraction, FAC1 from (AY)
.,E337 68       PLA             restore FAC1 sign
.,E338 10 03    BPL $E33D       exit if was +ve
.,E33A 4C B4 BF JMP $BFB4       else do - FAC1 and return
.,E33D 60       RTS             

                                *** series for ATN(n)
.:E33E 0B                       series counter
.:E33F 76 B3 83 BD D3           -6.84793912E-04
.:E344 79 1E F4 A6 F5            4.85094216E-03
.:E349 7B 83 FC B0 10            -.0161117015
.:E34E 7C 0C 1F 67 CA             .034209638
.:E353 7C DE 53 CB C1            -.054279133
.:E358 7D 14 64 70 4C             .0724571965
.:E35D 7D B7 EA 51 7A            -.0898019185
.:E362 7D 63 30 88 7E             .110932413
.:E367 7E 92 44 99 3A            -.142839808
.:E36C 7E 4C CC 91 C7             .19999912
.:E371 7F AA AA AA 13            -.333333316
.:E376 81 00 00 00 00            1

                                *** BASIC warm start entry point
.,E37B 20 CC FF JSR $FFCC       close input and output channels
.,E37E A9 00    LDA #$00        clear A
.,E380 85 13    STA $13         set current I/O channel, flag default
.,E382 20 7A A6 JSR $A67A       flush BASIC stack and clear continue pointer
.,E385 58       CLI             enable the interrupts
.,E386 A2 80    LDX #$80        set -ve error, just do warm start
.,E388 6C 00 03 JMP ($0300)     go handle error message, normally $E38B
.,E38B 8A       TXA             copy the error number
.,E38C 30 03    BMI $E391       if -ve go do warm start
.,E38E 4C 3A A4 JMP $A43A       else do error #X then warm start
.,E391 4C 74 A4 JMP $A474       do warm start

                                *** BASIC cold start entry point
.,E394 20 53 E4 JSR $E453       initialise the BASIC vector table
.,E397 20 BF E3 JSR $E3BF       initialise the BASIC RAM locations
.,E39A 20 22 E4 JSR $E422       print the start up message and initialise the memory
                                pointers
                                not ok ??
.,E39D A2 FB    LDX #$FB        value for start stack
.,E39F 9A       TXS             set stack pointer
.,E3A0 D0 E4    BNE $E386       do "READY." warm start, branch always

                                *** character get subroutine for zero page
                                the target address for the LDA $EA60 becomes the BASIC execute pointer once the
                                block is copied to its destination, any non zero page address will do at assembly
                                time, to assemble a three byte instruction. $EA60 is RTS, NOP.
                                page 0 initialisation table from $0073
                                increment and scan memory
.,E3A2 E6 7A    INC $7A         increment BASIC execute pointer low byte
.,E3A4 D0 02    BNE $E3A8       branch if no carry
                                else
.,E3A6 E6 7B    INC $7B         increment BASIC execute pointer high byte
                                page 0 initialisation table from $0079
                                scan memory
.,E3A8 AD 60 EA LDA $EA60       get byte to scan, address set by call routine
.,E3AB C9 3A    CMP #$3A        compare with ":"
.,E3AD B0 0A    BCS $E3B9       exit if>=
                                page 0 initialisation table from $0080
                                clear Cb if numeric
.,E3AF C9 20    CMP #$20        compare with " "
.,E3B1 F0 EF    BEQ $E3A2       if " " go do next
.,E3B3 38       SEC             set carry for SBC
.,E3B4 E9 30    SBC #$30        subtract "0"
.,E3B6 38       SEC             set carry for SBC
.,E3B7 E9 D0    SBC #$D0        subtract -"0"
                                clear carry if byte = "0"-"9"
.,E3B9 60       RTS             

                                *** spare bytes, not referenced
.:E3BA 80 4F C7 52 58           0.811635157

                                *** initialise BASIC RAM locations
.,E3BF A9 4C    LDA #$4C        opcode for JMP
.,E3C1 85 54    STA $54         save for functions vector jump
.,E3C3 8D 10 03 STA $0310       save for USR() vector jump
                                set USR() vector to illegal quantity error
.,E3C6 A9 48    LDA #$48        set USR() vector low byte
.,E3C8 A0 B2    LDY #$B2        set USR() vector high byte
.,E3CA 8D 11 03 STA $0311       save USR() vector low byte
.,E3CD 8C 12 03 STY $0312       save USR() vector high byte
.,E3D0 A9 91    LDA #$91        set fixed to float vector low byte
.,E3D2 A0 B3    LDY #$B3        set fixed to float vector high byte
.,E3D4 85 05    STA $05         save fixed to float vector low byte
.,E3D6 84 06    STY $06         save fixed to float vector high byte
.,E3D8 A9 AA    LDA #$AA        set float to fixed vector low byte
.,E3DA A0 B1    LDY #$B1        set float to fixed vector high byte
.,E3DC 85 03    STA $03         save float to fixed vector low byte
.,E3DE 84 04    STY $04         save float to fixed vector high byte
                                copy the character get subroutine from $E3A2 to $0074
.,E3E0 A2 1C    LDX #$1C        set the byte count
.,E3E2 BD A2 E3 LDA $E3A2,X     get a byte from the table
.,E3E5 95 73    STA $73,X       save the byte in page zero
.,E3E7 CA       DEX             decrement the count
.,E3E8 10 F8    BPL $E3E2       loop if not all done
                                clear descriptors, strings, program area and mamory pointers
.,E3EA A9 03    LDA #$03        set the step size, collecting descriptors
.,E3EC 85 53    STA $53         save the garbage collection step size
.,E3EE A9 00    LDA #$00        clear A
.,E3F0 85 68    STA $68         clear FAC1 overflow byte
.,E3F2 85 13    STA $13         clear the current I/O channel, flag default
.,E3F4 85 18    STA $18         clear the current descriptor stack item pointer high byte
.,E3F6 A2 01    LDX #$01        set X
.,E3F8 8E FD 01 STX $01FD       set the chain link pointer low byte
.,E3FB 8E FC 01 STX $01FC       set the chain link pointer high byte
.,E3FE A2 19    LDX #$19        initial the value for descriptor stack
.,E400 86 16    STX $16         set descriptor stack pointer
.,E402 38       SEC             set Cb = 1 to read the bottom of memory
.,E403 20 9C FF JSR $FF9C       read/set the bottom of memory
.,E406 86 2B    STX $2B         save the start of memory low byte
.,E408 84 2C    STY $2C         save the start of memory high byte
.,E40A 38       SEC             set Cb = 1 to read the top of memory
.,E40B 20 99 FF JSR $FF99       read/set the top of memory
.,E40E 86 37    STX $37         save the end of memory low byte
.,E410 84 38    STY $38         save the end of memory high byte
.,E412 86 33    STX $33         set the bottom of string space low byte
.,E414 84 34    STY $34         set the bottom of string space high byte
.,E416 A0 00    LDY #$00        clear the index
.,E418 98       TYA             clear the A
.,E419 91 2B    STA ($2B),Y     clear the the first byte of memory
.,E41B E6 2B    INC $2B         increment the start of memory low byte
.,E41D D0 02    BNE $E421       if no rollover skip the high byte increment
.,E41F E6 2C    INC $2C         increment start of memory high byte
.,E421 60       RTS             

                                *** print the start up message and initialise the memory pointers
.,E422 A5 2B    LDA $2B         get the start of memory low byte
.,E424 A4 2C    LDY $2C         get the start of memory high byte
.,E426 20 08 A4 JSR $A408       check available memory, do out of memory error if no room
.,E429 A9 73    LDA #$73        set "**** COMMODORE 64 BASIC V2 ****" pointer low byte
.,E42B A0 E4    LDY #$E4        set "**** COMMODORE 64 BASIC V2 ****" pointer high byte
.,E42D 20 1E AB JSR $AB1E       print a null terminated string
.,E430 A5 37    LDA $37         get the end of memory low byte
.,E432 38       SEC             set carry for subtract
.,E433 E5 2B    SBC $2B         subtract the start of memory low byte
.,E435 AA       TAX             copy the result to X
.,E436 A5 38    LDA $38         get the end of memory high byte
.,E438 E5 2C    SBC $2C         subtract the start of memory high byte
.,E43A 20 CD BD JSR $BDCD       print XA as unsigned integer
.,E43D A9 60    LDA #$60        set " BYTES FREE" pointer low byte
.,E43F A0 E4    LDY #$E4        set " BYTES FREE" pointer high byte
.,E441 20 1E AB JSR $AB1E       print a null terminated string
.,E444 4C 44 A6 JMP $A644       do NEW, CLEAR, RESTORE and return

                                *** BASIC vectors, these are copied to RAM from $0300 onwards
.:E447 8B E3                    error message          $0300
.:E449 83 A4                    BASIC warm start       $0302
.:E44B 7C A5                    crunch BASIC tokens    $0304
.:E44D 1A A7                    uncrunch BASIC tokens  $0306
.:E44F E4 A7                    start new BASIC code   $0308
.:E451 86 AE                    get arithmetic element $030A

                                *** initialise the BASIC vectors
.,E453 A2 0B    LDX #$0B        set byte count
.,E455 BD 47 E4 LDA $E447,X     get byte from table
.,E458 9D 00 03 STA $0300,X     save byte to RAM
.,E45B CA       DEX             decrement index
.,E45C 10 F7    BPL $E455       loop if more to do
.,E45E 60       RTS             

                                *** BASIC startup messages
.:E45F 00 20 42 41 53 49 43 20  basic bytes free
.:E467 42 59 54 45 53 20 46 52
.:E46F 45 45 0D 00 93 0D 20 20
.:E473 93 0D 20 20 20 20 2A 2A  (clr) **** commodore 64 basic v2 ****
.:E47B 2A 2A 20 43 4F 4D 4D 4F  (cr) (cr) 64k ram system
.:E483 44 4F 52 45 20 36 34 20
.:E48B 42 41 53 49 43 20 56 32
.:E493 20 2A 2A 2A 2A 0D 0D 20
.:E49B 36 34 4B 20 52 41 4D 20
.:E4A3 53 59 53 54 45 4D 20 20
.:E4AB 00

                                *** unused
.:E4AC 5C

                                *** open channel for output
.,E4AD 48       PHA             save the flag byte
.,E4AE 20 C9 FF JSR $FFC9       open channel for output
.,E4B1 AA       TAX             copy the returned flag byte
.,E4B2 68       PLA             restore the alling flag byte
.,E4B3 90 01    BCC $E4B6       if there is no error skip copying the error flag
.,E4B5 8A       TXA             else copy the error flag
.,E4B6 60       RTS             

                                *** unused bytes
.:E4B7 AA AA AA AA AA AA AA AA
.:E4BF AA AA AA AA AA AA AA AA
.:E4C7 AA AA AA AA AA AA AA AA
.:E4CF AA AA AA AA AA

                                *** flag the RS232 start bit and set the parity
.,E4D3 85 A9    STA $A9         save the start bit check flag, set start bit received
.,E4D5 A9 01    LDA #$01        set the initial parity state
.,E4D7 85 AB    STA $AB         save the receiver parity bit
.,E4D9 60       RTS

                                *** save the current colour to the colour RAM
.,E4DA AD 21 D0 LDA $D021       get the current colour code
.,E4DD 91 F3    STA ($F3),Y     save it to the colour RAM
.,E4DF 60       RTS             

                                *** wait ~8.5 seconds for any key from the STOP key column
.,E4E0 69 02    ADC #$02        set the number of jiffies to wait
.,E4E2 A4 91    LDY $91         read the stop key column
.,E4E4 C8       INY             test for $FF, no keys pressed
.,E4E5 D0 04    BNE $E4EB       if any keys were pressed just exit
.,E4E7 C5 A1    CMP $A1         compare the wait time with the jiffy clock mid byte
.,E4E9 D0 F7    BNE $E4E2       if not there yet go wait some more
.,E4EB 60       RTS             

                                *** baud rate tables for PAL C64
                                baud rate word is calculated from ..
                                
                                (system clock / baud rate) / 2 - 100
                                
                                    system clock
                                    ------------
                                PAL       985248 Hz
                                NTSC     1022727 Hz
.:E4EC 19 26                      50   baud   985300
.:E4EE 44 19                      75   baud   985200
.:E4F0 1A 11                     110   baud   985160
.:E4F2 E8 0D                     134.5 baud   984540
.:E4F4 70 0C                     150   baud   985200
.:E4F6 06 06                     300   baud   985200
.:E4F8 D1 02                     600   baud   985200
.:E4FA 37 01                    1200   baud   986400
.:E4FC AE 00                    1800   baud   986400
.:E4FE 69 00                    2400   baud   984000

                                *** return the base address of the I/O devices
.,E500 A2 00    LDX #$00        get the I/O base address low byte
.,E502 A0 DC    LDY #$DC        get the I/O base address high byte
.,E504 60       RTS             

                                *** return the x,y organization of the screen
.,E505 A2 28    LDX #$28        get the x size
.,E507 A0 19    LDY #$19        get the y size
.,E509 60       RTS             

                                *** read/set the x,y cursor position
.,E50A B0 07    BCS $E513       if read cursor go do read
.,E50C 86 D6    STX $D6         save the cursor row
.,E50E 84 D3    STY $D3         save the cursor column
.,E510 20 6C E5 JSR $E56C       set the screen pointers for the cursor row, column
.,E513 A6 D6    LDX $D6         get the cursor row
.,E515 A4 D3    LDY $D3         get the cursor column
.,E517 60       RTS             

                                *** initialise the screen and keyboard
.,E518 20 A0 E5 JSR $E5A0       initialise the vic chip
.,E51B A9 00    LDA #$00        clear A
.,E51D 8D 91 02 STA $0291       clear the shift mode switch
.,E520 85 CF    STA $CF         clear the cursor blink phase
.,E522 A9 48    LDA #$48        get the keyboard decode logic pointer low byte
.,E524 8D 8F 02 STA $028F       save the keyboard decode logic pointer low byte
.,E527 A9 EB    LDA #$EB        get the keyboard decode logic pointer high byte
.,E529 8D 90 02 STA $0290       save the keyboard decode logic pointer high byte
.,E52C A9 0A    LDA #$0A        set the maximum size of the keyboard buffer
.,E52E 8D 89 02 STA $0289       save the maximum size of the keyboard buffer
.,E531 8D 8C 02 STA $028C       save the repeat delay counter
.,E534 A9 0E    LDA #$0E        set light blue
.,E536 8D 86 02 STA $0286       save the current colour code
.,E539 A9 04    LDA #$04        speed 4
.,E53B 8D 8B 02 STA $028B       save the repeat speed counter
.,E53E A9 0C    LDA #$0C        set the cursor flash timing
.,E540 85 CD    STA $CD         save the cursor timing countdown
.,E542 85 CC    STA $CC         save the cursor enable, $00 = flash cursor

                                *** clear the screen
.,E544 AD 88 02 LDA $0288       get the screen memory page
.,E547 09 80    ORA #$80        set the high bit, flag every line is a logical line start
.,E549 A8       TAY             copy to Y
.,E54A A9 00    LDA #$00        clear the line start low byte
.,E54C AA       TAX             clear the index
.,E54D 94 D9    STY $D9,X       save the start of line X pointer high byte
.,E54F 18       CLC             clear carry for add
.,E550 69 28    ADC #$28        add the line length to the low byte
.,E552 90 01    BCC $E555       if no rollover skip the high byte increment
.,E554 C8       INY             else increment the high byte
.,E555 E8       INX             increment the line index
.,E556 E0 1A    CPX #$1A        compare it with the number of lines + 1
.,E558 D0 F3    BNE $E54D       loop if not all done
.,E55A A9 FF    LDA #$FF        set the end of table marker
.,E55C 95 D9    STA $D9,X       mark the end of the table
.,E55E A2 18    LDX #$18        set the line count, 25 lines to do, 0 to 24
.,E560 20 FF E9 JSR $E9FF       clear screen line X
.,E563 CA       DEX             decrement the count
.,E564 10 FA    BPL $E560       loop if more to do

                                *** home the cursor
.,E566 A0 00    LDY #$00        clear Y
.,E568 84 D3    STY $D3         clear the cursor column
.,E56A 84 D6    STY $D6         clear the cursor row

                                *** set screen pointers for cursor row, column
.,E56C A6 D6    LDX $D6         get the cursor row
.,E56E A5 D3    LDA $D3         get the cursor column
.,E570 B4 D9    LDY $D9,X       get start of line X pointer high byte
.,E572 30 08    BMI $E57C       if it is the logical line start continue
.,E574 18       CLC             else clear carry for add
.,E575 69 28    ADC #$28        add one line length
.,E577 85 D3    STA $D3         save the cursor column
.,E579 CA       DEX             decrement the cursor row
.,E57A 10 F4    BPL $E570       loop, branch always
.,E57C 20 F0 E9 JSR $E9F0       fetch a screen address
.,E57F A9 27    LDA #$27        set the line length
.,E581 E8       INX             increment the cursor row
.,E582 B4 D9    LDY $D9,X       get the start of line X pointer high byte
.,E584 30 06    BMI $E58C       if logical line start exit
.,E586 18       CLC             else clear carry for add
.,E587 69 28    ADC #$28        add one line length to the current line length
.,E589 E8       INX             increment the cursor row
.,E58A 10 F6    BPL $E582       loop, branch always
.,E58C 85 D5    STA $D5         save current screen line length
.,E58E 4C 24 EA JMP $EA24       calculate the pointer to colour RAM and return
.,E591 E4 C9    CPX $C9         compare it with the input cursor row
.,E593 F0 03    BEQ $E598       if there just exit
.,E595 4C ED E6 JMP $E6ED       else go ??
.,E598 60       RTS             

                                *** orphan bytes ??
.,E599 EA       NOP             huh
.,E59A 20 A0 E5 JSR $E5A0       initialise the vic chip
.,E59D 4C 66 E5 JMP $E566       home the cursor and return

                                *** initialise the vic chip
.,E5A0 A9 03    LDA #$03        set the screen as the output device
.,E5A2 85 9A    STA $9A         save the output device number
.,E5A4 A9 00    LDA #$00        set the keyboard as the input device
.,E5A6 85 99    STA $99         save the input device number
.,E5A8 A2 2F    LDX #$2F        set the count/index
.,E5AA BD B8 EC LDA $ECB8,X     get a vic ii chip initialisation value
.,E5AD 9D FF CF STA $CFFF,X     save it to the vic ii chip
.,E5B0 CA       DEX             decrement the count/index
.,E5B1 D0 F7    BNE $E5AA       loop if more to do
.,E5B3 60       RTS             

                                *** input from the keyboard buffer
.,E5B4 AC 77 02 LDY $0277       get the current character from the buffer
.,E5B7 A2 00    LDX #$00        clear the index
.,E5B9 BD 78 02 LDA $0278,X     get the next character,X from the buffer
.,E5BC 9D 77 02 STA $0277,X     save it as the current character,X in the buffer
.,E5BF E8       INX             increment the index
.,E5C0 E4 C6    CPX $C6         compare it with the keyboard buffer index
.,E5C2 D0 F5    BNE $E5B9       loop if more to do
.,E5C4 C6 C6    DEC $C6         decrement keyboard buffer index
.,E5C6 98       TYA             copy the key to A
.,E5C7 58       CLI             enable the interrupts
.,E5C8 18       CLC             flag got byte
.,E5C9 60       RTS             

                                *** write character and wait for key
.,E5CA 20 16 E7 JSR $E716       output character

                                *** wait for a key from the keyboard
.,E5CD A5 C6    LDA $C6         get the keyboard buffer index
.,E5CF 85 CC    STA $CC         cursor enable, $00 = flash cursor, $xx = no flash
.,E5D1 8D 92 02 STA $0292       screen scrolling flag, $00 = scroll, $xx = no scroll
                                this disables both the cursor flash and the screen scroll
                                while there are characters in the keyboard buffer
.,E5D4 F0 F7    BEQ $E5CD       loop if the buffer is empty
.,E5D6 78       SEI             disable the interrupts
.,E5D7 A5 CF    LDA $CF         get the cursor blink phase
.,E5D9 F0 0C    BEQ $E5E7       if cursor phase skip the overwrite
                                else it is the character phase
.,E5DB A5 CE    LDA $CE         get the character under the cursor
.,E5DD AE 87 02 LDX $0287       get the colour under the cursor
.,E5E0 A0 00    LDY #$00        clear Y
.,E5E2 84 CF    STY $CF         clear the cursor blink phase
.,E5E4 20 13 EA JSR $EA13       print character A and colour X
.,E5E7 20 B4 E5 JSR $E5B4       input from the keyboard buffer
.,E5EA C9 83    CMP #$83        compare with [SHIFT][RUN]
.,E5EC D0 10    BNE $E5FE       if not [SHIFT][RUN] skip the buffer fill
                                keys are [SHIFT][RUN] so put "LOAD",$0D,"RUN",$0D into
                                the buffer
.,E5EE A2 09    LDX #$09        set the byte count
.,E5F0 78       SEI             disable the interrupts
.,E5F1 86 C6    STX $C6         set the keyboard buffer index
.,E5F3 BD E6 EC LDA $ECE6,X     get byte from the auto load/run table
.,E5F6 9D 76 02 STA $0276,X     save it to the keyboard buffer
.,E5F9 CA       DEX             decrement the count/index
.,E5FA D0 F7    BNE $E5F3       loop while more to do
.,E5FC F0 CF    BEQ $E5CD       loop for the next key, branch always
                                was not [SHIFT][RUN]
.,E5FE C9 0D    CMP #$0D        compare the key with [CR]
.,E600 D0 C8    BNE $E5CA       if not [CR] print the character and get the next key
                                else it was [CR]
.,E602 A4 D5    LDY $D5         get the current screen line length
.,E604 84 D0    STY $D0         input from keyboard or screen, $xx = screen,
                                $00 = keyboard
.,E606 B1 D1    LDA ($D1),Y     get the character from the current screen line
.,E608 C9 20    CMP #$20        compare it with [SPACE]
.,E60A D0 03    BNE $E60F       if not [SPACE] continue
.,E60C 88       DEY             else eliminate the space, decrement end of input line
.,E60D D0 F7    BNE $E606       loop, branch always
.,E60F C8       INY             increment past the last non space character on line
.,E610 84 C8    STY $C8         save the input [EOL] pointer
.,E612 A0 00    LDY #$00        clear A
.,E614 8C 92 02 STY $0292       clear the screen scrolling flag, $00 = scroll
.,E617 84 D3    STY $D3         clear the cursor column
.,E619 84 D4    STY $D4         clear the cursor quote flag, $xx = quote, $00 = no quote
.,E61B A5 C9    LDA $C9         get the input cursor row
.,E61D 30 1B    BMI $E63A       
.,E61F A6 D6    LDX $D6         get the cursor row
.,E621 20 ED E6 JSR $E6ED       find and set the pointers for the start of logical line
.,E624 E4 C9    CPX $C9         compare with input cursor row
.,E626 D0 12    BNE $E63A       
.,E628 A5 CA    LDA $CA         get the input cursor column
.,E62A 85 D3    STA $D3         save the cursor column
.,E62C C5 C8    CMP $C8         compare the cursor column with input [EOL] pointer
.,E62E 90 0A    BCC $E63A       if less, cursor is in line, go ??
.,E630 B0 2B    BCS $E65D       else the cursor is beyond the line end, branch always

                                *** input from screen or keyboard
.,E632 98       TYA             copy Y
.,E633 48       PHA             save Y
.,E634 8A       TXA             copy X
.,E635 48       PHA             save X
.,E636 A5 D0    LDA $D0         input from keyboard or screen, $xx = screen,
                                $00 = keyboard
.,E638 F0 93    BEQ $E5CD       if keyboard go wait for key
.,E63A A4 D3    LDY $D3         get the cursor column
.,E63C B1 D1    LDA ($D1),Y     get character from the current screen line
.,E63E 85 D7    STA $D7         save temporary last character
.,E640 29 3F    AND #$3F        mask key bits
.,E642 06 D7    ASL $D7         << temporary last character
.,E644 24 D7    BIT $D7         test it
.,E646 10 02    BPL $E64A       branch if not [NO KEY]
.,E648 09 80    ORA #$80        
.,E64A 90 04    BCC $E650       
.,E64C A6 D4    LDX $D4         get the cursor quote flag, $xx = quote, $00 = no quote
.,E64E D0 04    BNE $E654       if in quote mode go ??
.,E650 70 02    BVS $E654       
.,E652 09 40    ORA #$40        
.,E654 E6 D3    INC $D3         increment the cursor column
.,E656 20 84 E6 JSR $E684       if open quote toggle the cursor quote flag
.,E659 C4 C8    CPY $C8         compare ?? with input [EOL] pointer
.,E65B D0 17    BNE $E674       if not at line end go ??
.,E65D A9 00    LDA #$00        clear A
.,E65F 85 D0    STA $D0         clear input from keyboard or screen, $xx = screen,
                                $00 = keyboard
.,E661 A9 0D    LDA #$0D        set character [CR]
.,E663 A6 99    LDX $99         get the input device number
.,E665 E0 03    CPX #$03        compare the input device with the screen
.,E667 F0 06    BEQ $E66F       if screen go ??
.,E669 A6 9A    LDX $9A         get the output device number
.,E66B E0 03    CPX #$03        compare the output device with the screen
.,E66D F0 03    BEQ $E672       if screen go ??
.,E66F 20 16 E7 JSR $E716       output the character
.,E672 A9 0D    LDA #$0D        set character [CR]
.,E674 85 D7    STA $D7         save character
.,E676 68       PLA             pull X
.,E677 AA       TAX             restore X
.,E678 68       PLA             pull Y
.,E679 A8       TAY             restore Y
.,E67A A5 D7    LDA $D7         restore character
.,E67C C9 DE    CMP #$DE        
.,E67E D0 02    BNE $E682       
.,E680 A9 FF    LDA #$FF        
.,E682 18       CLC             flag ok
.,E683 60       RTS             

                                *** if open quote toggle cursor quote flag
.,E684 C9 22    CMP #$22        comapre byte with "
.,E686 D0 08    BNE $E690       exit if not "
.,E688 A5 D4    LDA $D4         get cursor quote flag, $xx = quote, $00 = no quote
.,E68A 49 01    EOR #$01        toggle it
.,E68C 85 D4    STA $D4         save cursor quote flag
.,E68E A9 22    LDA #$22        restore the "
.,E690 60       RTS             

                                *** insert uppercase/graphic character
.,E691 09 40    ORA #$40        change to uppercase/graphic
.,E693 A6 C7    LDX $C7         get the reverse flag
.,E695 F0 02    BEQ $E699       branch if not reverse
                                else ..
                                insert reversed character
.,E697 09 80    ORA #$80        reverse character
.,E699 A6 D8    LDX $D8         get the insert count
.,E69B F0 02    BEQ $E69F       branch if none
.,E69D C6 D8    DEC $D8         else decrement the insert count
.,E69F AE 86 02 LDX $0286       get the current colour code
.,E6A2 20 13 EA JSR $EA13       print character A and colour X
.,E6A5 20 B6 E6 JSR $E6B6       advance the cursor
                                restore the registers, set the quote flag and exit
.,E6A8 68       PLA             pull Y
.,E6A9 A8       TAY             restore Y
.,E6AA A5 D8    LDA $D8         get the insert count
.,E6AC F0 02    BEQ $E6B0       skip quote flag clear if inserts to do
.,E6AE 46 D4    LSR $D4         clear cursor quote flag, $xx = quote, $00 = no quote
.,E6B0 68       PLA             pull X
.,E6B1 AA       TAX             restore X
.,E6B2 68       PLA             restore A
.,E6B3 18       CLC             
.,E6B4 58       CLI             enable the interrupts
.,E6B5 60       RTS             

                                *** advance the cursor
.,E6B6 20 B3 E8 JSR $E8B3       test for line increment
.,E6B9 E6 D3    INC $D3         increment the cursor column
.,E6BB A5 D5    LDA $D5         get current screen line length
.,E6BD C5 D3    CMP $D3         compare ?? with the cursor column
.,E6BF B0 3F    BCS $E700       exit if line length >= cursor column
.,E6C1 C9 4F    CMP #$4F        compare with max length
.,E6C3 F0 32    BEQ $E6F7       if at max clear column, back cursor up and do newline
.,E6C5 AD 92 02 LDA $0292       get the autoscroll flag
.,E6C8 F0 03    BEQ $E6CD       branch if autoscroll on
.,E6CA 4C 67 E9 JMP $E967       else open space on screen
.,E6CD A6 D6    LDX $D6         get the cursor row
.,E6CF E0 19    CPX #$19        compare with max + 1
.,E6D1 90 07    BCC $E6DA       if less than max + 1 go add this row to the current
                                logical line
.,E6D3 20 EA E8 JSR $E8EA       else scroll the screen
.,E6D6 C6 D6    DEC $D6         decrement the cursor row
.,E6D8 A6 D6    LDX $D6         get the cursor row
                                add this row to the current logical line
.,E6DA 16 D9    ASL $D9,X       shift start of line X pointer high byte
.,E6DC 56 D9    LSR $D9,X       shift start of line X pointer high byte back,
                                make next screen line start of logical line, increment line length and set pointers
                                clear b7, start of logical line
.,E6DE E8       INX             increment screen row
.,E6DF B5 D9    LDA $D9,X       get start of line X pointer high byte
.,E6E1 09 80    ORA #$80        mark as start of logical line
.,E6E3 95 D9    STA $D9,X       set start of line X pointer high byte
.,E6E5 CA       DEX             restore screen row
.,E6E6 A5 D5    LDA $D5         get current screen line length
                                add one line length and set the pointers for the start of the line
.,E6E8 18       CLC             clear carry for add
.,E6E9 69 28    ADC #$28        add one line length
.,E6EB 85 D5    STA $D5         save current screen line length
.,E6ED B5 D9    LDA $D9,X       get start of line X pointer high byte
.,E6EF 30 03    BMI $E6F4       exit loop if start of logical line
.,E6F1 CA       DEX             else back up one line
.,E6F2 D0 F9    BNE $E6ED       loop if not on first line
.,E6F4 4C F0 E9 JMP $E9F0       fetch a screen address
.,E6F7 C6 D6    DEC $D6         decrement the cursor row
.,E6F9 20 7C E8 JSR $E87C       do newline
.,E6FC A9 00    LDA #$00        clear A
.,E6FE 85 D3    STA $D3         clear the cursor column
.,E700 60       RTS             

                                *** back onto the previous line if possible
.,E701 A6 D6    LDX $D6         get the cursor row
.,E703 D0 06    BNE $E70B       branch if not top row
.,E705 86 D3    STX $D3         clear cursor column
.,E707 68       PLA             dump return address low byte
.,E708 68       PLA             dump return address high byte
.,E709 D0 9D    BNE $E6A8       restore registers, set quote flag and exit, branch always
.,E70B CA       DEX             decrement the cursor row
.,E70C 86 D6    STX $D6         save the cursor row
.,E70E 20 6C E5 JSR $E56C       set the screen pointers for cursor row, column
.,E711 A4 D5    LDY $D5         get current screen line length
.,E713 84 D3    STY $D3         save the cursor column
.,E715 60       RTS             

                                *** output a character to the screen
.,E716 48       PHA             save character
.,E717 85 D7    STA $D7         save temporary last character
.,E719 8A       TXA             copy X
.,E71A 48       PHA             save X
.,E71B 98       TYA             copy Y
.,E71C 48       PHA             save Y
.,E71D A9 00    LDA #$00        clear A
.,E71F 85 D0    STA $D0         clear input from keyboard or screen, $xx = screen,
                                $00 = keyboard
.,E721 A4 D3    LDY $D3         get cursor column
.,E723 A5 D7    LDA $D7         restore last character
.,E725 10 03    BPL $E72A       branch if unshifted
.,E727 4C D4 E7 JMP $E7D4       do shifted characters and return
.,E72A C9 0D    CMP #$0D        compare with [CR]
.,E72C D0 03    BNE $E731       branch if not [CR]
.,E72E 4C 91 E8 JMP $E891       else output [CR] and return
.,E731 C9 20    CMP #$20        compare with [SPACE]
.,E733 90 10    BCC $E745       branch if < [SPACE]
.,E735 C9 60    CMP #$60        
.,E737 90 04    BCC $E73D       branch if $20 to $5F
                                character is $60 or greater
.,E739 29 DF    AND #$DF        
.,E73B D0 02    BNE $E73F       
.,E73D 29 3F    AND #$3F        
.,E73F 20 84 E6 JSR $E684       if open quote toggle cursor direct/programmed flag
.,E742 4C 93 E6 JMP $E693       
                                character was < [SPACE] so is a control character
                                of some sort
.,E745 A6 D8    LDX $D8         get the insert count
.,E747 F0 03    BEQ $E74C       if no characters to insert continue
.,E749 4C 97 E6 JMP $E697       insert reversed character
.,E74C C9 14    CMP #$14        compare the character with [INSERT]/[DELETE]
.,E74E D0 2E    BNE $E77E       if not [INSERT]/[DELETE] go ??
.,E750 98       TYA             
.,E751 D0 06    BNE $E759       
.,E753 20 01 E7 JSR $E701       back onto the previous line if possible
.,E756 4C 73 E7 JMP $E773       
.,E759 20 A1 E8 JSR $E8A1       test for line decrement
                                now close up the line
.,E75C 88       DEY             decrement index to previous character
.,E75D 84 D3    STY $D3         save the cursor column
.,E75F 20 24 EA JSR $EA24       calculate the pointer to colour RAM
.,E762 C8       INY             increment index to next character
.,E763 B1 D1    LDA ($D1),Y     get character from current screen line
.,E765 88       DEY             decrement index to previous character
.,E766 91 D1    STA ($D1),Y     save character to current screen line
.,E768 C8       INY             increment index to next character
.,E769 B1 F3    LDA ($F3),Y     get colour RAM byte
.,E76B 88       DEY             decrement index to previous character
.,E76C 91 F3    STA ($F3),Y     save colour RAM byte
.,E76E C8       INY             increment index to next character
.,E76F C4 D5    CPY $D5         compare with current screen line length
.,E771 D0 EF    BNE $E762       loop if not there yet
.,E773 A9 20    LDA #$20        set [SPACE]
.,E775 91 D1    STA ($D1),Y     clear last character on current screen line
.,E777 AD 86 02 LDA $0286       get the current colour code
.,E77A 91 F3    STA ($F3),Y     save to colour RAM
.,E77C 10 4D    BPL $E7CB       branch always
.,E77E A6 D4    LDX $D4         get cursor quote flag, $xx = quote, $00 = no quote
.,E780 F0 03    BEQ $E785       branch if not quote mode
.,E782 4C 97 E6 JMP $E697       insert reversed character
.,E785 C9 12    CMP #$12        compare with [RVS ON]
.,E787 D0 02    BNE $E78B       if not [RVS ON] skip setting the reverse flag
.,E789 85 C7    STA $C7         else set the reverse flag
.,E78B C9 13    CMP #$13        compare with [CLR HOME]
.,E78D D0 03    BNE $E792       if not [CLR HOME] continue
.,E78F 20 66 E5 JSR $E566       home the cursor
.,E792 C9 1D    CMP #$1D        compare with [CURSOR RIGHT]
.,E794 D0 17    BNE $E7AD       if not [CURSOR RIGHT] go ??
.,E796 C8       INY             increment the cursor column
.,E797 20 B3 E8 JSR $E8B3       test for line increment
.,E79A 84 D3    STY $D3         save the cursor column
.,E79C 88       DEY             decrement the cursor column
.,E79D C4 D5    CPY $D5         compare cursor column with current screen line length
.,E79F 90 09    BCC $E7AA       exit if less
                                else the cursor column is >= the current screen line
                                length so back onto the current line and do a newline
.,E7A1 C6 D6    DEC $D6         decrement the cursor row
.,E7A3 20 7C E8 JSR $E87C       do newline
.,E7A6 A0 00    LDY #$00        clear cursor column
.,E7A8 84 D3    STY $D3         save the cursor column
.,E7AA 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
.,E7AD C9 11    CMP #$11        compare with [CURSOR DOWN]
.,E7AF D0 1D    BNE $E7CE       if not [CURSOR DOWN] go ??
.,E7B1 18       CLC             clear carry for add
.,E7B2 98       TYA             copy the cursor column
.,E7B3 69 28    ADC #$28        add one line
.,E7B5 A8       TAY             copy back to Y
.,E7B6 E6 D6    INC $D6         increment the cursor row
.,E7B8 C5 D5    CMP $D5         compare cursor column with current screen line length
.,E7BA 90 EC    BCC $E7A8       if less go save cursor column and exit
.,E7BC F0 EA    BEQ $E7A8       if equal go save cursor column and exit
                                else the cursor has moved beyond the end of this line
                                so back it up until it's on the start of the logical line
.,E7BE C6 D6    DEC $D6         decrement the cursor row
.,E7C0 E9 28    SBC #$28        subtract one line
.,E7C2 90 04    BCC $E7C8       if on previous line exit the loop
.,E7C4 85 D3    STA $D3         else save the cursor column
.,E7C6 D0 F8    BNE $E7C0       loop if not at the start of the line
.,E7C8 20 7C E8 JSR $E87C       do newline
.,E7CB 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
.,E7CE 20 CB E8 JSR $E8CB       set the colour code
.,E7D1 4C 44 EC JMP $EC44       go check for special character codes
.,E7D4 29 7F    AND #$7F        mask 0xxx xxxx, clear b7
.,E7D6 C9 7F    CMP #$7F        was it $FF before the mask
.,E7D8 D0 02    BNE $E7DC       branch if not
.,E7DA A9 5E    LDA #$5E        else make it $5E
.,E7DC C9 20    CMP #$20        compare the character with [SPACE]
.,E7DE 90 03    BCC $E7E3       if < [SPACE] go ??
.,E7E0 4C 91 E6 JMP $E691       insert uppercase/graphic character and return
                                character was $80 to $9F and is now $00 to $1F
.,E7E3 C9 0D    CMP #$0D        compare with [CR]
.,E7E5 D0 03    BNE $E7EA       if not [CR] continue
.,E7E7 4C 91 E8 JMP $E891       else output [CR] and return
                                was not [CR]
.,E7EA A6 D4    LDX $D4         get the cursor quote flag, $xx = quote, $00 = no quote
.,E7EC D0 3F    BNE $E82D       branch if quote mode
.,E7EE C9 14    CMP #$14        compare with [INSERT DELETE]
.,E7F0 D0 37    BNE $E829       if not [INSERT DELETE] go ??
.,E7F2 A4 D5    LDY $D5         get current screen line length
.,E7F4 B1 D1    LDA ($D1),Y     get character from current screen line
.,E7F6 C9 20    CMP #$20        compare the character with [SPACE]
.,E7F8 D0 04    BNE $E7FE       if not [SPACE] continue
.,E7FA C4 D3    CPY $D3         compare the current column with the cursor column
.,E7FC D0 07    BNE $E805       if not cursor column go open up space on line
.,E7FE C0 4F    CPY #$4F        compare current column with max line length
.,E800 F0 24    BEQ $E826       if at line end just exit
.,E802 20 65 E9 JSR $E965       else open up a space on the screen
                                now open up space on the line to insert a character
.,E805 A4 D5    LDY $D5         get current screen line length
.,E807 20 24 EA JSR $EA24       calculate the pointer to colour RAM
.,E80A 88       DEY             decrement the index to previous character
.,E80B B1 D1    LDA ($D1),Y     get the character from the current screen line
.,E80D C8       INY             increment the index to next character
.,E80E 91 D1    STA ($D1),Y     save the character to the current screen line
.,E810 88       DEY             decrement the index to previous character
.,E811 B1 F3    LDA ($F3),Y     get the current screen line colour RAM byte
.,E813 C8       INY             increment the index to next character
.,E814 91 F3    STA ($F3),Y     save the current screen line colour RAM byte
.,E816 88       DEY             decrement the index to the previous character
.,E817 C4 D3    CPY $D3         compare the index with the cursor column
.,E819 D0 EF    BNE $E80A       loop if not there yet
.,E81B A9 20    LDA #$20        set [SPACE]
.,E81D 91 D1    STA ($D1),Y     clear character at cursor position on current screen line
.,E81F AD 86 02 LDA $0286       get current colour code
.,E822 91 F3    STA ($F3),Y     save to cursor position on current screen line colour RAM
.,E824 E6 D8    INC $D8         increment insert count
.,E826 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
.,E829 A6 D8    LDX $D8         get the insert count
.,E82B F0 05    BEQ $E832       branch if no insert space
.,E82D 09 40    ORA #$40        change to uppercase/graphic
.,E82F 4C 97 E6 JMP $E697       insert reversed character
.,E832 C9 11    CMP #$11        compare with [CURSOR UP]
.,E834 D0 16    BNE $E84C       branch if not [CURSOR UP]
.,E836 A6 D6    LDX $D6         get the cursor row
.,E838 F0 37    BEQ $E871       if on the top line go restore the registers, set the
                                quote flag and exit
.,E83A C6 D6    DEC $D6         decrement the cursor row
.,E83C A5 D3    LDA $D3         get the cursor column
.,E83E 38       SEC             set carry for subtract
.,E83F E9 28    SBC #$28        subtract one line length
.,E841 90 04    BCC $E847       branch if stepped back to previous line
.,E843 85 D3    STA $D3         else save the cursor column ..
.,E845 10 2A    BPL $E871       .. and exit, branch always
.,E847 20 6C E5 JSR $E56C       set the screen pointers for cursor row, column ..
.,E84A D0 25    BNE $E871       .. and exit, branch always
.,E84C C9 12    CMP #$12        compare with [RVS OFF]
.,E84E D0 04    BNE $E854       if not [RVS OFF] continue
.,E850 A9 00    LDA #$00        else clear A
.,E852 85 C7    STA $C7         clear the reverse flag
.,E854 C9 1D    CMP #$1D        compare with [CURSOR LEFT]
.,E856 D0 12    BNE $E86A       if not [CURSOR LEFT] go ??
.,E858 98       TYA             copy the cursor column
.,E859 F0 09    BEQ $E864       if at start of line go back onto the previous line
.,E85B 20 A1 E8 JSR $E8A1       test for line decrement
.,E85E 88       DEY             decrement the cursor column
.,E85F 84 D3    STY $D3         save the cursor column
.,E861 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
.,E864 20 01 E7 JSR $E701       back onto the previous line if possible
.,E867 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
.,E86A C9 13    CMP #$13        compare with [CLR]
.,E86C D0 06    BNE $E874       if not [CLR] continue
.,E86E 20 44 E5 JSR $E544       clear the screen
.,E871 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
.,E874 09 80    ORA #$80        restore b7, colour can only be black, cyan, magenta
                                or yellow
.,E876 20 CB E8 JSR $E8CB       set the colour code
.,E879 4C 4F EC JMP $EC4F       go check for special character codes except fro switch
                                to lower case

                                *** do newline
.,E87C 46 C9    LSR $C9         shift >> input cursor row
.,E87E A6 D6    LDX $D6         get the cursor row
.,E880 E8       INX             increment the row
.,E881 E0 19    CPX #$19        compare it with last row + 1
.,E883 D0 03    BNE $E888       if not last row + 1 skip the screen scroll
.,E885 20 EA E8 JSR $E8EA       else scroll the screen
.,E888 B5 D9    LDA $D9,X       get start of line X pointer high byte
.,E88A 10 F4    BPL $E880       loop if not start of logical line
.,E88C 86 D6    STX $D6         save the cursor row
.,E88E 4C 6C E5 JMP $E56C       set the screen pointers for cursor row, column and return

                                *** output [CR]
.,E891 A2 00    LDX #$00        clear X
.,E893 86 D8    STX $D8         clear the insert count
.,E895 86 C7    STX $C7         clear the reverse flag
.,E897 86 D4    STX $D4         clear the cursor quote flag, $xx = quote, $00 = no quote
.,E899 86 D3    STX $D3         save the cursor column
.,E89B 20 7C E8 JSR $E87C       do newline
.,E89E 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit

                                *** test for line decrement
.,E8A1 A2 02    LDX #$02        set the count
.,E8A3 A9 00    LDA #$00        set the column
.,E8A5 C5 D3    CMP $D3         compare the column with the cursor column
.,E8A7 F0 07    BEQ $E8B0       if at the start of the line go decrement the cursor row
                                and exit
.,E8A9 18       CLC             else clear carry for add
.,E8AA 69 28    ADC #$28        increment to next line
.,E8AC CA       DEX             decrement loop count
.,E8AD D0 F6    BNE $E8A5       loop if more to test
.,E8AF 60       RTS             
.,E8B0 C6 D6    DEC $D6         else decrement the cursor row
.,E8B2 60       RTS             

                                *** test for line increment
                                
                                if at end of the line, but not at end of the last line, increment the cursor row
.,E8B3 A2 02    LDX #$02        set the count
.,E8B5 A9 27    LDA #$27        set the column
.,E8B7 C5 D3    CMP $D3         compare the column with the cursor column
.,E8B9 F0 07    BEQ $E8C2       if at end of line test and possibly increment cursor row
.,E8BB 18       CLC             else clear carry for add
.,E8BC 69 28    ADC #$28        increment to the next line
.,E8BE CA       DEX             decrement the loop count
.,E8BF D0 F6    BNE $E8B7       loop if more to test
.,E8C1 60       RTS             
                                cursor is at end of line
.,E8C2 A6 D6    LDX $D6         get the cursor row
.,E8C4 E0 19    CPX #$19        compare it with the end of the screen
.,E8C6 F0 02    BEQ $E8CA       if at the end of screen just exit
.,E8C8 E6 D6    INC $D6         else increment the cursor row
.,E8CA 60       RTS             

                                *** set the colour code. enter with the colour character in A. if A does not contain a
                                colour character this routine exits without changing the colour
.,E8CB A2 0F    LDX #$0F        
                                set the colour code count
.,E8CD DD DA E8 CMP $E8DA,X     compare the character with a table code
.,E8D0 F0 04    BEQ $E8D6       if a match go save the colour and exit
.,E8D2 CA       DEX             else decrement the index
.,E8D3 10 F8    BPL $E8CD       loop if more to do
.,E8D5 60       RTS             
.,E8D6 8E 86 02 STX $0286       save the current colour code
.,E8D9 60       RTS             

                                *** ASCII colour code table
                                CHR$()  colour
                                ------  ------
.:E8DA 90                        144    black
.:E8DB 05                          5    white 
.:E8DC 1C                         28    red 
.:E8DD 9F                        159    cyan
.:E8DE 9C                        156    purple
.:E8DF 1E                         30    green
.:E8E0 1F                         31    blue
.:E8E1 9E                        158    yellow
.:E8E2 81                        129    orange
.:E8E3 95                        149    brown
.:E8E4 96                        150    light red
.:E8E5 97                        151    dark grey
.:E8E6 98                        152    medium grey
.:E8E7 99                        153    light green
.:E8E8 9A                        154    light blue
.:E8E9 9B                        155    light grey

                                *** scroll the screen
.,E8EA A5 AC    LDA $AC         copy the tape buffer start pointer
.,E8EC 48       PHA             save it
.,E8ED A5 AD    LDA $AD         copy the tape buffer start pointer
.,E8EF 48       PHA             save it
.,E8F0 A5 AE    LDA $AE         copy the tape buffer end pointer
.,E8F2 48       PHA             save it
.,E8F3 A5 AF    LDA $AF         copy the tape buffer end pointer
.,E8F5 48       PHA             save it
.,E8F6 A2 FF    LDX #$FF        set to -1 for pre increment loop
.,E8F8 C6 D6    DEC $D6         decrement the cursor row
.,E8FA C6 C9    DEC $C9         decrement the input cursor row
.,E8FC CE A5 02 DEC $02A5       decrement the screen row marker
.,E8FF E8       INX             increment the line number
.,E900 20 F0 E9 JSR $E9F0       fetch a screen address, set the start of line X
.,E903 E0 18    CPX #$18        compare with last line
.,E905 B0 0C    BCS $E913       branch if >= $16
.,E907 BD F1 EC LDA $ECF1,X     get the start of the next line pointer low byte
.,E90A 85 AC    STA $AC         save the next line pointer low byte
.,E90C B5 DA    LDA $DA,X       get the start of the next line pointer high byte
.,E90E 20 C8 E9 JSR $E9C8       shift the screen line up
.,E911 30 EC    BMI $E8FF       loop, branch always
.,E913 20 FF E9 JSR $E9FF       clear screen line X
                                now shift up the start of logical line bits
.,E916 A2 00    LDX #$00        clear index
.,E918 B5 D9    LDA $D9,X       get the start of line X pointer high byte
.,E91A 29 7F    AND #$7F        clear the line X start of logical line bit
.,E91C B4 DA    LDY $DA,X       get the start of the next line pointer high byte
.,E91E 10 02    BPL $E922       if next line is not a start of line skip the start set
.,E920 09 80    ORA #$80        set line X start of logical line bit
.,E922 95 D9    STA $D9,X       set start of line X pointer high byte
.,E924 E8       INX             increment line number
.,E925 E0 18    CPX #$18        compare with last line
.,E927 D0 EF    BNE $E918       loop if not last line
.,E929 A5 F1    LDA $F1         get start of last line pointer high byte
.,E92B 09 80    ORA #$80        mark as start of logical line
.,E92D 85 F1    STA $F1         set start of last line pointer high byte
.,E92F A5 D9    LDA $D9         get start of first line pointer high byte
.,E931 10 C3    BPL $E8F6       if not start of logical line loop back and
                                scroll the screen up another line
.,E933 E6 D6    INC $D6         increment the cursor row
.,E935 EE A5 02 INC $02A5       increment screen row marker
.,E938 A9 7F    LDA #$7F        set keyboard column c7
.,E93A 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,E93D AD 01 DC LDA $DC01       read VIA 1 DRB, keyboard row port
.,E940 C9 FB    CMP #$FB        compare with row r2 active, [CTL]
.,E942 08       PHP             save status
.,E943 A9 7F    LDA #$7F        set keyboard column c7
.,E945 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,E948 28       PLP             restore status
.,E949 D0 0B    BNE $E956       skip delay if ??
                                first time round the inner loop X will be $16
.,E94B A0 00    LDY #$00        clear delay outer loop count, do this 256 times
.,E94D EA       NOP             waste cycles
.,E94E CA       DEX             decrement inner loop count
.,E94F D0 FC    BNE $E94D       loop if not all done
.,E951 88       DEY             decrement outer loop count
.,E952 D0 F9    BNE $E94D       loop if not all done
.,E954 84 C6    STY $C6         clear the keyboard buffer index
.,E956 A6 D6    LDX $D6         get the cursor row
                                restore the tape buffer pointers and exit
.,E958 68       PLA             pull tape buffer end pointer
.,E959 85 AF    STA $AF         restore it
.,E95B 68       PLA             pull tape buffer end pointer
.,E95C 85 AE    STA $AE         restore it
.,E95E 68       PLA             pull tape buffer pointer
.,E95F 85 AD    STA $AD         restore it
.,E961 68       PLA             pull tape buffer pointer
.,E962 85 AC    STA $AC         restore it
.,E964 60       RTS             

                                *** open up a space on the screen
.,E965 A6 D6    LDX $D6         get the cursor row
.,E967 E8       INX             increment the row
.,E968 B5 D9    LDA $D9,X       get the start of line X pointer high byte
.,E96A 10 FB    BPL $E967       loop if not start of logical line
.,E96C 8E A5 02 STX $02A5       save the screen row marker
.,E96F E0 18    CPX #$18        compare it with the last line
.,E971 F0 0E    BEQ $E981       if = last line go ??
.,E973 90 0C    BCC $E981       if < last line go ??
                                else it was > last line
.,E975 20 EA E8 JSR $E8EA       scroll the screen
.,E978 AE A5 02 LDX $02A5       get the screen row marker
.,E97B CA       DEX             decrement the screen row marker
.,E97C C6 D6    DEC $D6         decrement the cursor row
.,E97E 4C DA E6 JMP $E6DA       add this row to the current logical line and return
.,E981 A5 AC    LDA $AC         copy tape buffer pointer
.,E983 48       PHA             save it
.,E984 A5 AD    LDA $AD         copy tape buffer pointer
.,E986 48       PHA             save it
.,E987 A5 AE    LDA $AE         copy tape buffer end pointer
.,E989 48       PHA             save it
.,E98A A5 AF    LDA $AF         copy tape buffer end pointer
.,E98C 48       PHA             save it
.,E98D A2 19    LDX #$19        set to end line + 1 for predecrement loop
.,E98F CA       DEX             decrement the line number
.,E990 20 F0 E9 JSR $E9F0       fetch a screen address
.,E993 EC A5 02 CPX $02A5       compare it with the screen row marker
.,E996 90 0E    BCC $E9A6       if < screen row marker go ??
.,E998 F0 0C    BEQ $E9A6       if = screen row marker go ??
.,E99A BD EF EC LDA $ECEF,X     else get the start of the previous line low byte from the
                                ROM table
.,E99D 85 AC    STA $AC         save previous line pointer low byte
.,E99F B5 D8    LDA $D8,X       get the start of the previous line pointer high byte
.,E9A1 20 C8 E9 JSR $E9C8       shift the screen line down
.,E9A4 30 E9    BMI $E98F       loop, branch always
.,E9A6 20 FF E9 JSR $E9FF       clear screen line X
.,E9A9 A2 17    LDX #$17        
.,E9AB EC A5 02 CPX $02A5       compare it with the screen row marker
.,E9AE 90 0F    BCC $E9BF       
.,E9B0 B5 DA    LDA $DA,X       
.,E9B2 29 7F    AND #$7F        
.,E9B4 B4 D9    LDY $D9,X       get start of line X pointer high byte
.,E9B6 10 02    BPL $E9BA       
.,E9B8 09 80    ORA #$80        
.,E9BA 95 DA    STA $DA,X       
.,E9BC CA       DEX             
.,E9BD D0 EC    BNE $E9AB       
.,E9BF AE A5 02 LDX $02A5       get the screen row marker
.,E9C2 20 DA E6 JSR $E6DA       add this row to the current logical line
.,E9C5 4C 58 E9 JMP $E958       restore the tape buffer pointers and exit

                                *** shift screen line up/down
.,E9C8 29 03    AND #$03        mask 0000 00xx, line memory page
.,E9CA 0D 88 02 ORA $0288       OR with screen memory page
.,E9CD 85 AD    STA $AD         save next/previous line pointer high byte
.,E9CF 20 E0 E9 JSR $E9E0       calculate pointers to screen lines colour RAM
.,E9D2 A0 27    LDY #$27        set the column count
.,E9D4 B1 AC    LDA ($AC),Y     get character from next/previous screen line
.,E9D6 91 D1    STA ($D1),Y     save character to current screen line
.,E9D8 B1 AE    LDA ($AE),Y     get colour from next/previous screen line colour RAM
.,E9DA 91 F3    STA ($F3),Y     save colour to current screen line colour RAM
.,E9DC 88       DEY             decrement column index/count
.,E9DD 10 F5    BPL $E9D4       loop if more to do
.,E9DF 60       RTS             

                                *** calculate pointers to screen lines colour RAM
.,E9E0 20 24 EA JSR $EA24       calculate the pointer to the current screen line colour
                                RAM
.,E9E3 A5 AC    LDA $AC         get the next screen line pointer low byte
.,E9E5 85 AE    STA $AE         save the next screen line colour RAM pointer low byte
.,E9E7 A5 AD    LDA $AD         get the next screen line pointer high byte
.,E9E9 29 03    AND #$03        mask 0000 00xx, line memory page
.,E9EB 09 D8    ORA #$D8        set  1101 01xx, colour memory page
.,E9ED 85 AF    STA $AF         save the next screen line colour RAM pointer high byte
.,E9EF 60       RTS             

                                *** fetch a screen address
.,E9F0 BD F0 EC LDA $ECF0,X     get the start of line low byte from the ROM table
.,E9F3 85 D1    STA $D1         set the current screen line pointer low byte
.,E9F5 B5 D9    LDA $D9,X       get the start of line high byte from the RAM table
.,E9F7 29 03    AND #$03        mask 0000 00xx, line memory page
.,E9F9 0D 88 02 ORA $0288       OR with the screen memory page
.,E9FC 85 D2    STA $D2         save the current screen line pointer high byte
.,E9FE 60       RTS             

                                *** clear screen line X
.,E9FF A0 27    LDY #$27        set number of columns to clear
.,EA01 20 F0 E9 JSR $E9F0       fetch a screen address
.,EA04 20 24 EA JSR $EA24       calculate the pointer to colour RAM
.,EA07 20 DA E4 JSR $E4DA       save the current colour to the colour RAM
.,EA0A A9 20    LDA #$20        set [SPACE]
.,EA0C 91 D1    STA ($D1),Y     clear character in current screen line
.,EA0E 88       DEY             decrement index
.,EA0F 10 F6    BPL $EA07       loop if more to do
.,EA11 60       RTS

                                *** orphan byte
.,EA12 EA       NOP             unused

                                *** print character A and colour X
.,EA13 A8       TAY             copy the character
.,EA14 A9 02    LDA #$02set the count to $02, usually $14 ??
.,EA16 85 CD    STA $CD         save the cursor countdown
.,EA18 20 24 EA JSR $EA24       calculate the pointer to colour RAM
.,EA1B 98       TYA             get the character back

                                *** save the character and colour to the screen @ the cursor
.,EA1C A4 D3    LDY $D3         get the cursor column
.,EA1E 91 D1    STA ($D1),Y     save the character from current screen line
.,EA20 8A       TXA             copy the colour to A
.,EA21 91 F3    STA ($F3),Y     save to colour RAM
.,EA23 60       RTS             

                                *** calculate the pointer to colour RAM
.,EA24 A5 D1    LDA $D1         get current screen line pointer low byte
.,EA26 85 F3    STA $F3         save pointer to colour RAM low byte
.,EA28 A5 D2    LDA $D2         get current screen line pointer high byte
.,EA2A 29 03    AND #$03        mask 0000 00xx, line memory page
.,EA2C 09 D8    ORA #$D8        set  1101 01xx, colour memory page
.,EA2E 85 F4    STA $F4         save pointer to colour RAM high byte
.,EA30 60       RTS             

                                *** IRQ vector
.,EA31 20 EA FF JSR $FFEA       increment the real time clock
.,EA34 A5 CC    LDA $CC         get the cursor enable, $00 = flash cursor
.,EA36 D0 29    BNE $EA61       if flash not enabled skip the flash
.,EA38 C6 CD    DEC $CD         decrement the cursor timing countdown
.,EA3A D0 25    BNE $EA61       if not counted out skip the flash
.,EA3C A9 14    LDA #$14        set the flash count
.,EA3E 85 CD    STA $CD         save the cursor timing countdown
.,EA40 A4 D3    LDY $D3         get the cursor column
.,EA42 46 CF    LSR $CF         shift b0 cursor blink phase into carry
.,EA44 AE 87 02 LDX $0287       get the colour under the cursor
.,EA47 B1 D1    LDA ($D1),Y     get the character from current screen line
.,EA49 B0 11    BCS $EA5C       branch if cursor phase b0 was 1
.,EA4B E6 CF    INC $CF         set the cursor blink phase to 1
.,EA4D 85 CE    STA $CE         save the character under the cursor
.,EA4F 20 24 EA JSR $EA24       calculate the pointer to colour RAM
.,EA52 B1 F3    LDA ($F3),Y     get the colour RAM byte
.,EA54 8D 87 02 STA $0287       save the colour under the cursor
.,EA57 AE 86 02 LDX $0286       get the current colour code
.,EA5A A5 CE    LDA $CE         get the character under the cursor
.,EA5C 49 80    EOR #$80        toggle b7 of character under cursor
.,EA5E 20 1C EA JSR $EA1C       save the character and colour to the screen @ the cursor
.,EA61 A5 01    LDA $01         read the 6510 I/O port
.,EA63 29 10    AND #$10        mask 000x 0000, the cassette switch sense
.,EA65 F0 0A    BEQ $EA71       if the cassette sense is low skip the motor stop
                                the cassette sense was high, the switch was open, so turn
                                off the motor and clear the interlock
.,EA67 A0 00    LDY #$00        clear Y
.,EA69 84 C0    STY $C0         clear the tape motor interlock
.,EA6B A5 01    LDA $01         read the 6510 I/O port
.,EA6D 09 20    ORA #$20        mask xxxx xx1x, turn off the motor
.,EA6F D0 08    BNE $EA79       go save the port value, branch always
                                the cassette sense was low so turn the motor on, perhaps
.,EA71 A5 C0    LDA $C0         get the tape motor interlock
.,EA73 D0 06    BNE $EA7B       if the cassette interlock <> 0 don't turn on motor
.,EA75 A5 01    LDA $01         read the 6510 I/O port
.,EA77 29 1F    AND #$1F        mask xxxx xx0x, turn on the motor
.,EA79 85 01    STA $01         save the 6510 I/O port
.,EA7B 20 87 EA JSR $EA87       scan the keyboard
.,EA7E AD 0D DC LDA $DC0D       read VIA 1 ICR, clear the timer interrupt flag
.,EA81 68       PLA             pull Y
.,EA82 A8       TAY             restore Y
.,EA83 68       PLA             pull X
.,EA84 AA       TAX             restore X
.,EA85 68       PLA             restore A
.,EA86 40       RTI

                                *** scan keyboard performs the following ..
                                
                                1) check if key pressed, if not then exit the routine
                                
                                2) init I/O ports of VIA ?? for keyboard scan and set pointers to decode table 1.
                                clear the character counter
                                
                                3) set one line of port B low and test for a closed key on port A by shifting the
                                byte read from the port. if the carry is clear then a key is closed so save the
                                count which is incremented on each shift. check for shift/stop/cbm keys and
                                flag if closed
                                
                                4) repeat step 3 for the whole matrix
                                
                                5) evaluate the SHIFT/CTRL/C= keys, this may change the decode table selected
                                
                                6) use the key count saved in step 3 as an index into the table selected in step 5
                                
                                7) check for key repeat operation
                                
                                8) save the decoded key to the buffer if first press or repeat
                                scan the keyboard
.,EA87 A9 00    LDA #$00clear A
.,EA89 8D 8D 02 STA $028D       clear the keyboard shift/control/c= flag
.,EA8C A0 40    LDY #$40        set no key
.,EA8E 84 CB    STY $CB         save which key
.,EA90 8D 00 DC STA $DC00       clear VIA 1 DRA, keyboard column drive
.,EA93 AE 01 DC LDX $DC01       read VIA 1 DRB, keyboard row port
.,EA96 E0 FF    CPX #$FF        compare with all bits set
.,EA98 F0 61    BEQ $EAFB       if no key pressed clear current key and exit (does
                                further BEQ to $EBBA)
.,EA9A A8       TAY             clear the key count
.,EA9B A9 81    LDA #$81get the decode table low byte
.,EA9D 85 F5    STA $F5         save the keyboard pointer low byte
.,EA9F A9 EB    LDA #$EB        get the decode table high byte
.,EAA1 85 F6    STA $F6save the keyboard pointer high byte
.,EAA3 A9 FE    LDA #$FE        set column 0 low
.,EAA5 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,EAA8 A2 08    LDX #$08        set the row count
.,EAAA 48       PHA             save the column
.,EAAB AD 01 DC LDA $DC01       read VIA 1 DRB, keyboard row port
.,EAAE CD 01 DC CMP $DC01       compare it with itself
.,EAB1 D0 F8    BNE $EAAB       loop if changing
.,EAB3 4A       LSR             shift row to Cb
.,EAB4 B0 16    BCS $EACC       if no key closed on this row go do next row
.,EAB6 48       PHA             save row
.,EAB7 B1 F5    LDA ($F5),Y     get character from decode table
.,EAB9 C9 05    CMP #$05        compare with $05, there is no $05 key but the control
                                keys are all less than $05
.,EABB B0 0C    BCS $EAC9       if not shift/control/c=/stop go save key count
                                else was shift/control/c=/stop key
.,EABD C9 03    CMP #$03        compare with $03, stop
.,EABF F0 08    BEQ $EAC9       if stop go save key count and continue
                                character is $01 - shift, $02 - c= or $04 - control
.,EAC1 0D 8D 02 ORA $028D       OR it with the keyboard shift/control/c= flag
.,EAC4 8D 8D 02 STA $028D       save the keyboard shift/control/c= flag
.,EAC7 10 02    BPL $EACB       skip save key, branch always
.,EAC9 84 CB    STY $CB         save key count
.,EACB 68       PLA             restore row
.,EACC C8       INY             increment key count
.,EACD C0 41    CPY #$41        compare with max+1
.,EACF B0 0B    BCS $EADC       exit loop if >= max+1
                                else still in matrix
.,EAD1 CA       DEX             decrement row count
.,EAD2 D0 DF    BNE $EAB3       loop if more rows to do
.,EAD4 38       SEC             set carry for keyboard column shift
.,EAD5 68       PLA             restore the column
.,EAD6 2A       ROL             shift the keyboard column
.,EAD7 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,EADA D0 CC    BNE $EAA8       loop for next column, branch always
.,EADC 68       PLA             dump the saved column
.,EADD 6C 8F 02 JMP ($028F)     evaluate the SHIFT/CTRL/C= keys, $EBDC
                                key decoding continues here after the SHIFT/CTRL/C= keys are evaluated
.,EAE0 A4 CB    LDY $CB         get saved key count
.,EAE2 B1 F5    LDA ($F5),Y     get character from decode table
.,EAE4 AA       TAX             copy character to X
.,EAE5 C4 C5    CPY $C5         compare key count with last key count
.,EAE7 F0 07    BEQ $EAF0       if this key = current key, key held, go test repeat
.,EAE9 A0 10    LDY #$10        set the repeat delay count
.,EAEB 8C 8C 02 STY $028C       save the repeat delay count
.,EAEE D0 36    BNE $EB26       go save key to buffer and exit, branch always
.,EAF0 29 7F    AND #$7F        clear b7
.,EAF2 2C 8A 02 BIT $028A       test key repeat
.,EAF5 30 16    BMI $EB0D       if repeat all go ??
.,EAF7 70 49    BVS $EB42       if repeat none go ??
.,EAF9 C9 7F    CMP #$7F        compare with end marker
.,EAFB F0 29    BEQ $EB26       if $00/end marker go save key to buffer and exit
.,EAFD C9 14    CMP #$14        compare with [INSERT]/[DELETE]
.,EAFF F0 0C    BEQ $EB0D       if [INSERT]/[DELETE] go test for repeat
.,EB01 C9 20    CMP #$20        compare with [SPACE]
.,EB03 F0 08    BEQ $EB0D       if [SPACE] go test for repeat
.,EB05 C9 1D    CMP #$1D        compare with [CURSOR RIGHT]
.,EB07 F0 04    BEQ $EB0D       if [CURSOR RIGHT] go test for repeat
.,EB09 C9 11    CMP #$11        compare with [CURSOR DOWN]
.,EB0B D0 35    BNE $EB42       if not [CURSOR DOWN] just exit
                                was one of the cursor movement keys, insert/delete
                                key or the space bar so always do repeat tests
.,EB0D AC 8C 02 LDY $028C       get the repeat delay counter
.,EB10 F0 05    BEQ $EB17       if delay expired go ??
.,EB12 CE 8C 02 DEC $028C       else decrement repeat delay counter
.,EB15 D0 2B    BNE $EB42       if delay not expired go ??
                                repeat delay counter has expired
.,EB17 CE 8B 02 DEC $028B       decrement the repeat speed counter
.,EB1A D0 26    BNE $EB42       branch if repeat speed count not expired
.,EB1C A0 04    LDY #$04        set for 4/60ths of a second
.,EB1E 8C 8B 02 STY $028B       save the repeat speed counter
.,EB21 A4 C6    LDY $C6         get the keyboard buffer index
.,EB23 88       DEY             decrement it
.,EB24 10 1C    BPL $EB42       if the buffer isn't empty just exit
                                else repeat the key immediately
                                possibly save the key to the keyboard buffer. if there was no key pressed or the key
                                was not found during the scan (possibly due to key bounce) then X will be $FF here
.,EB26 A4 CB    LDY $CB         get the key count
.,EB28 84 C5    STY $C5         save it as the current key count
.,EB2A AC 8D 02 LDY $028D       get the keyboard shift/control/c= flag
.,EB2D 8C 8E 02 STY $028E       save it as last keyboard shift pattern
.,EB30 E0 FF    CPX #$FF        compare the character with the table end marker or no key
.,EB32 F0 0E    BEQ $EB42       if it was the table end marker or no key just exit
.,EB34 8A       TXA             copy the character to A
.,EB35 A6 C6    LDX $C6         get the keyboard buffer index
.,EB37 EC 89 02 CPX $0289       compare it with the keyboard buffer size
.,EB3A B0 06    BCS $EB42       if the buffer is full just exit
.,EB3C 9D 77 02 STA $0277,X     save the character to the keyboard buffer
.,EB3F E8       INX             increment the index
.,EB40 86 C6    STX $C6         save the keyboard buffer index
.,EB42 A9 7F    LDA #$7F        enable column 7 for the stop key
.,EB44 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,EB47 60       RTS             

                                *** evaluate the SHIFT/CTRL/C= keys
.,EB48 AD 8D 02 LDA $028D       get the keyboard shift/control/c= flag
.,EB4B C9 03    CMP #$03        compare with [SHIFT][C=]
.,EB4D D0 15    BNE $EB64       if not [SHIFT][C=] go ??
.,EB4F CD 8E 02 CMP $028E       compare with last
.,EB52 F0 EE    BEQ $EB42       exit if still the same
.,EB54 AD 91 02 LDA $0291       get the shift mode switch $00 = enabled, $80 = locked
.,EB57 30 1D    BMI $EB76       if locked continue keyboard decode
                                toggle text mode
.,EB59 AD 18 D0 LDA $D018       get the start of character memory address
.,EB5C 49 02    EOR #$02        toggle address b1
.,EB5E 8D 18 D0 STA $D018       save the start of character memory address
.,EB61 4C 76 EB JMP $EB76       continue the keyboard decode
                                select keyboard table
.,EB64 0A       ASL             << 1
.,EB65 C9 08    CMP #$08        compare with [CTRL]
.,EB67 90 02    BCC $EB6B       if [CTRL] is not pressed skip the index change
.,EB69 A9 06    LDA #$06        else [CTRL] was pressed so make the index = $06
.,EB6B AA       TAX             copy the index to X
.,EB6C BD 79 EB LDA $EB79,X     get the decode table pointer low byte
.,EB6F 85 F5    STA $F5         save the decode table pointer low byte
.,EB71 BD 7A EB LDA $EB7A,X     get the decode table pointer high byte
.,EB74 85 F6    STA $F6         save the decode table pointer high byte
.,EB76 4C E0 EA JMP $EAE0       continue the keyboard decode

                                *** table addresses
.:EB79 81 EB                    standard
.:EB7B C2 EB                    shift
.:EB7D 03 EC                    commodore
.:EB7F 78 EC                    control

                                *** standard keyboard table
.:EB81 14 0D 1D 88 85 86 87 11
.:EB89 33 57 41 34 5A 53 45 01
.:EB91 35 52 44 36 43 46 54 58
.:EB99 37 59 47 38 42 48 55 56
.:EBA1 39 49 4A 30 4D 4B 4F 4E
.:EBA9 2B 50 4C 2D 2E 3A 40 2C
.:EBB1 5C 2A 3B 13 01 3D 5E 2F
.:EBB9 31 5F 04 32 20 02 51 03
.:EBC1 FF
                                *** shifted keyboard table
.:EBC2 94 8D 9D 8C 89 8A 8B 91
.:EBCA 23 D7 C1 24 DA D3 C5 01
.:EBD2 25 D2 C4 26 C3 C6 D4 D8
.:EBDA 27 D9 C7 28 C2 C8 D5 D6
.:EBE2 29 C9 CA 30 CD CB CF CE
.:EBEA DB D0 CC DD 3E 5B BA 3C
.:EBF2 A9 C0 5D 93 01 3D DE 3F
.:EBFA 21 5F 04 22 A0 02 D1 83
.:EC02 FF
                                *** CBM key keyboard table
.:EC03 94 8D 9D 8C 89 8A 8B 91
.:EC0B 96 B3 B0 97 AD AE B1 01
.:EC13 98 B2 AC 99 BC BB A3 BD
.:EC1B 9A B7 A5 9B BF B4 B8 BE
.:EC23 29 A2 B5 30 A7 A1 B9 AA
.:EC2B A6 AF B6 DC 3E 5B A4 3C
.:EC33 A8 DF 5D 93 01 3D DE 3F
.:EC3B 81 5F 04 95 A0 02 AB 83
.:EC43 FF

                                *** check for special character codes
.,EC44 C9 0E    CMP #$0E        compare with [SWITCH TO LOWER CASE]
.,EC46 D0 07    BNE $EC4F       if not [SWITCH TO LOWER CASE] skip the switch
.,EC48 AD 18 D0 LDA $D018       get the start of character memory address
.,EC4B 09 02    ORA #$02        mask xxxx xx1x, set lower case characters
.,EC4D D0 09    BNE $EC58       go save the new value, branch always
                                check for special character codes except fro switch to lower case
.,EC4F C9 8E    CMP #$8E        compare with [SWITCH TO UPPER CASE]
.,EC51 D0 0B    BNE $EC5E       if not [SWITCH TO UPPER CASE] go do the [SHIFT]+[C=] key
                                check
.,EC53 AD 18 D0 LDA $D018       get the start of character memory address
.,EC56 29 FD    AND #$FD        mask xxxx xx0x, set upper case characters
.,EC58 8D 18 D0 STA $D018       save the start of character memory address
.,EC5B 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit
                                do the [SHIFT]+[C=] key check
.,EC5E C9 08    CMP #$08        compare with disable [SHIFT][C=]
.,EC60 D0 07    BNE $EC69       if not disable [SHIFT][C=] skip the set
.,EC62 A9 80    LDA #$80        set to lock shift mode switch
.,EC64 0D 91 02 ORA $0291       OR it with the shift mode switch
.,EC67 30 09    BMI $EC72       go save the value, branch always
.,EC69 C9 09    CMP #$09        compare with enable [SHIFT][C=]
.,EC6B D0 EE    BNE $EC5B       exit if not enable [SHIFT][C=]
.,EC6D A9 7F    LDA #$7F        set to unlock shift mode switch
.,EC6F 2D 91 02 AND $0291       AND it with the shift mode switch
.,EC72 8D 91 02 STA $0291       save the shift mode switch $00 = enabled, $80 = locked
.,EC75 4C A8 E6 JMP $E6A8       restore the registers, set the quote flag and exit

                                *** control keyboard table
.:EC78 FF FF FF FF FF FF FF FF
.:EC80 1C 17 01 9F 1A 13 05 FF
.:EC88 9C 12 04 1E 03 06 14 18
.:EC90 1F 19 07 9E 02 08 15 16
.:EC98 12 09 0A 92 0D 0B 0F 0E
.:ECA0 FF 10 0C FF FF 1B 00 FF
.:ECA8 1C FF 1D FF FF 1F 1E FF
.:ECB0 90 06 FF 05 FF FF 11 FF
.:ECB8 FF

                                *** vic ii chip initialisation values
.:ECB9 00 00                    sprite 0 x,y
.:ECBB 00 00                    sprite 1 x,y 
.:ECBD 00 00                    sprite 2 x,y 
.:ECBF 00 00                    sprite 3 x,y
.:ECC1 00 00                    sprite 4 x,y 
.:ECC3 00 00                    sprite 5 x,y 
.:ECC5 00 00                    sprite 6 x,y 
.:ECC7 00 00                    sprite 7 x,y
.:ECC9 00                       sprites 0 to 7 x bit 8
.:ECCA 9B                       enable screen, enable 25 rows
                                vertical fine scroll and control
                                bit function
                                --- -------
                                 7  raster compare bit 8
                                 6  1 = enable extended color text mode
                                 5  1 = enable bitmap graphics mode
                                 4  1 = enable screen, 0 = blank screen
                                 3  1 = 25 row display, 0 = 24 row display
                                2-0 vertical scroll count
.:ECCB 37                       raster compare
.:ECCC 00                       light pen x
.:ECCD 00                       light pen y
.:ECCE 00                       sprite 0 to 7 enable
.:ECCF 08                       enable 40 column display
                                horizontal fine scroll and control
                                bit function
                                --- -------
                                7-6 unused
                                 5  1 = vic reset, 0 = vic on
                                 4  1 = enable multicolor mode
                                 3  1 = 40 column display, 0 = 38 column display
                                2-0 horizontal scroll count
.:ECC0 00                       sprite 0 to 7 y expand
.:ECD1 14                       memory control
                                bit function
                                --- -------
                                7-4 video matrix base address
                                3-1 character data base address
                                 0  unused
.:ECD2 0F                       clear all interrupts
                                interrupt flags
                                 7 1 = interrupt
                                6-4 unused
                                 3  1 = light pen interrupt
                                 2  1 = sprite to sprite collision interrupt
                                 1  1 = sprite to foreground collision interrupt
                                 0  1 = raster compare interrupt
.:ECD3 00                       all vic IRQs disabeld
                                IRQ enable
                                bit function
                                --- -------
                                7-4 unused
                                 3  1 = enable light pen
                                 2  1 = enable sprite to sprite collision
                                 1  1 = enable sprite to foreground collision
                                 0  1 = enable raster compare
.:ECD4 00                       sprite 0 to 7 foreground priority
.:ECD5 00                       sprite 0 to 7 multicolour
.:ECD6 00                       sprite 0 to 7 x expand
.:ECD7 00                       sprite 0 to 7 sprite collision
.:ECD8 00                       sprite 0 to 7 foreground collision
.:ECD9 0E                       border colour
.:ECDA 06                       background colour 0
.:ECDB 01                       background colour 1
.:ECDC 02                       background colour 2
.:ECDD 03                       background colour 3
.:ECDE 04                       sprite multicolour 0
.:ECDF 00                       sprite multicolour 1
.:ECD0 01                       sprite 0 colour
.:ECE1 02                       sprite 1 colour
.:ECE2 03                       sprite 2 colour
.:ECE3 04                       sprite 3 colour
.:ECE4 05                       sprite 4 colour
.:ECE5 06                       sprite 5 colour
.:ECE6 07                       sprite 6 colour
                                sprite 7 colour is actually the first character of "LOAD" ($4C)

                                *** keyboard buffer for auto load/run
.:ECE7 4C 4F 41 44 0D 52 55 4E  'load (cr) run (cr)'
.:ECEA 44 0D 52 55 4E 0D

                                *** low bytes of screen line addresses
.:ECF0 00 28 50 78 A0 C8 F0 18
.:ECF8 40 68 90 B8 E0 08 30 58
.:ED00 80 A8 D0 F8 20 48 70 98
.:ED08 C0

                                *** command serial bus device to TALK
.,ED09 09 40    ORA #$40        OR with the TALK command
.:ED0B 2C       .BYTE $2C       makes next line BIT $2009

                                *** command devices on the serial bus to LISTEN
.,ED0C 09 20    ORA #$20        OR with the LISTEN command
.,ED0E 20 A4 F0 JSR $F0A4       check RS232 bus idle

                                *** send a control character
.,ED11 48       PHA             save device address
.,ED12 24 94    BIT $94         test deferred character flag
.,ED14 10 0A    BPL $ED20       if no defered character continue
.,ED16 38       SEC             else flag EOI
.,ED17 66 A3    ROR $A3         rotate into EOI flag byte
.,ED19 20 40 ED JSR $ED40       Tx byte on serial bus
.,ED1C 46 94    LSR $94         clear deferred character flag
.,ED1E 46 A3    LSR $A3         clear EOI flag
.,ED20 68       PLA             restore the device address

                                *** defer a command
.,ED21 85 95    STA $95         save as serial defered character
.,ED23 78       SEI             disable the interrupts
.,ED24 20 97 EE JSR $EE97       set the serial data out high
.,ED27 C9 3F    CMP #$3F        compare read byte with $3F
.,ED29 D0 03    BNE $ED2E       branch if not $3F, this branch will always be taken as
                                after VIA 2's PCR is read it is ANDed with $DF, so the
                                result can never be $3F ??
.,ED2B 20 85 EE JSR $EE85       set the serial clock out high
.,ED2E AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,ED31 09 08    ORA #$08        mask xxxx 1xxx, set serial ATN low
.,ED33 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
                                if the code drops through to here the serial clock is low and the serial data has been
                                released so the following code will have no effect apart from delaying the first byte
                                by 1ms
                                set the serial clk/data, wait and Tx byte on the serial bus
.,ED36 78       SEI             disable the interrupts
.,ED37 20 8E EE JSR $EE8E       set the serial clock out low
.,ED3A 20 97 EE JSR $EE97       set the serial data out high
.,ED3D 20 B3 EE JSR $EEB3       1ms delay

                                *** Tx byte on serial bus
.,ED40 78       SEI             disable the interrupts
.,ED41 20 97 EE JSR $EE97       set the serial data out high
.,ED44 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,ED47 B0 64    BCS $EDAD       if the serial data is high go do 'device not present'
.,ED49 20 85 EE JSR $EE85       set the serial clock out high
.,ED4C 24 A3    BIT $A3         test the EOI flag
.,ED4E 10 0A    BPL $ED5A       if not EOI go ??
                                I think this is the EOI sequence so the serial clock has been released and the serial
                                data is being held low by the peripheral. first up wait for the serial data to rise
.,ED50 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,ED53 90 FB    BCC $ED50       loop if the data is low
                                now the data is high, EOI is signalled by waiting for at least 200us without pulling
                                the serial clock line low again. the listener should respond by pulling the serial
                                data line low
.,ED55 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,ED58 B0 FB    BCS $ED55       loop if the data is high
                                the serial data has gone low ending the EOI sequence, now just wait for the serial
                                data line to go high again or, if this isn't an EOI sequence, just wait for the serial
                                data to go high the first time
.,ED5A 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,ED5D 90 FB    BCC $ED5A       loop if the data is low
                                serial data is high now pull the clock low, preferably within 60us
.,ED5F 20 8E EE JSR $EE8E       set the serial clock out low
                                now the C64 has to send the eight bits, LSB first. first it sets the serial data line
                                to reflect the bit in the byte, then it sets the serial clock to high. The serial
                                clock is left high for 26 cycles, 23us on a PAL Vic, before it is again pulled low
                                and the serial data is allowed high again
.,ED62 A9 08    LDA #$08        eight bits to do
.,ED64 85 A5    STA $A5         set serial bus bit count
.,ED66 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,ED69 CD 00 DD CMP $DD00       compare it with itself
.,ED6C D0 F8    BNE $ED66       if changed go try again
.,ED6E 0A       ASL             shift the serial data into Cb
.,ED6F 90 3F    BCC $EDB0       if the serial data is low go do serial bus timeout
.,ED71 66 95    ROR $95         rotate the transmit byte
.,ED73 B0 05    BCS $ED7A       if the bit = 1 go set the serial data out high
.,ED75 20 A0 EE JSR $EEA0       else set the serial data out low
.,ED78 D0 03    BNE $ED7D       continue, branch always
.,ED7A 20 97 EE JSR $EE97       set the serial data out high
.,ED7D 20 85 EE JSR $EE85       set the serial clock out high
.,ED80 EA       NOP             waste ..
.,ED81 EA       NOP             .. a ..
.,ED82 EA       NOP             .. cycle ..
.,ED83 EA       NOP             .. or two
.,ED84 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,ED87 29 DF    AND #$DF        mask xx0x xxxx, set the serial data out high
.,ED89 09 10    ORA #$10        mask xxx1 xxxx, set the serial clock out low
.,ED8B 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,ED8E C6 A5    DEC $A5         decrement the serial bus bit count
.,ED90 D0 D4    BNE $ED66       loop if not all done
                                now all eight bits have been sent it's up to the peripheral to signal the byte was
                                received by pulling the serial data low. this should be done within one milisecond
.,ED92 A9 04    LDA #$04        wait for up to about 1ms
.,ED94 8D 07 DC STA $DC07       save VIA 1 timer B high byte
.,ED97 A9 19    LDA #$19        load timer B, timer B single shot, start timer B
.,ED99 8D 0F DC STA $DC0F       save VIA 1 CRB
.,ED9C AD 0D DC LDA $DC0D       read VIA 1 ICR
.,ED9F AD 0D DC LDA $DC0D       read VIA 1 ICR
.,EDA2 29 02    AND #$02        mask 0000 00x0, timer A interrupt
.,EDA4 D0 0A    BNE $EDB0       if timer A interrupt go do serial bus timeout
.,EDA6 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,EDA9 B0 F4    BCS $ED9F       if the serial data is high go wait some more
.,EDAB 58       CLI             enable the interrupts
.,EDAC 60       RTS             
                                device not present
.,EDAD A9 80    LDA #$80        error $80, device not present
.:EDAF 2C       .BYTE $2C       makes next line BIT $03A9
                                timeout on serial bus
.,EDB0 A9 03    LDA #$03        error $03, read timeout, write timeout
.,EDB2 20 1C FE JSR $FE1C       OR into the serial status byte
.,EDB5 58       CLI             enable the interrupts
.,EDB6 18       CLC             clear for branch
.,EDB7 90 4A    BCC $EE03       ATN high, delay, clock high then data high, branch always

                                *** send secondary address after LISTEN
.,EDB9 85 95    STA $95         save the defered Tx byte
.,EDBB 20 36 ED JSR $ED36       set the serial clk/data, wait and Tx the byte

                                *** set serial ATN high
.,EDBE AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EDC1 29 F7    AND #$F7        mask xxxx 0xxx, set serial ATN high
.,EDC3 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,EDC6 60       RTS             

                                *** send secondary address after TALK
.,EDC7 85 95    STA $95         save the defered Tx byte
.,EDC9 20 36 ED JSR $ED36       set the serial clk/data, wait and Tx the byte

                                *** wait for the serial bus end after send
                                return address from patch 6
.,EDCC 78       SEI             disable the interrupts
.,EDCD 20 A0 EE JSR $EEA0       set the serial data out low
.,EDD0 20 BE ED JSR $EDBE       set serial ATN high
.,EDD3 20 85 EE JSR $EE85       set the serial clock out high
.,EDD6 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,EDD9 30 FB    BMI $EDD6       loop if the clock is high
.,EDDB 58       CLI             enable the interrupts
.,EDDC 60       RTS             

                                *** output a byte to the serial bus
.,EDDD 24 94    BIT $94         test the deferred character flag
.,EDDF 30 05    BMI $EDE6       if there is a defered character go send it
.,EDE1 38       SEC             set carry
.,EDE2 66 94    ROR $94         shift into the deferred character flag
.,EDE4 D0 05    BNE $EDEB       save the byte and exit, branch always
.,EDE6 48       PHA             save the byte
.,EDE7 20 40 ED JSR $ED40       Tx byte on serial bus
.,EDEA 68       PLA             restore the byte
.,EDEB 85 95    STA $95         save the defered Tx byte
.,EDED 18       CLC             flag ok
.,EDEE 60       RTS             

                                *** command serial bus to UNTALK
.,EDEF 78       SEI             disable the interrupts
.,EDF0 20 8E EE JSR $EE8E       set the serial clock out low
.,EDF3 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EDF6 09 08    ORA #$08        mask xxxx 1xxx, set the serial ATN low
.,EDF8 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,EDFB A9 5F    LDA #$5F        set the UNTALK command
.:EDFD 2C       .BYTE $2C       makes next line BIT $3FA9

                                *** command serial bus to UNLISTEN
.,EDFE A9 3F    LDA #$3F        set the UNLISTEN command
.,EE00 20 11 ED JSR $ED11       send a control character
.,EE03 20 BE ED JSR $EDBE       set serial ATN high
                                1ms delay, clock high then data high
.,EE06 8A       TXA             save the device number
.,EE07 A2 0A    LDX #$0A        short delay
.,EE09 CA       DEX             decrement the count
.,EE0A D0 FD    BNE $EE09       loop if not all done
.,EE0C AA       TAX             restore the device number
.,EE0D 20 85 EE JSR $EE85       set the serial clock out high
.,EE10 4C 97 EE JMP $EE97       set the serial data out high and return

                                *** input a byte from the serial bus
.,EE13 78       SEI             disable the interrupts
.,EE14 A9 00    LDA #$00        set 0 bits to do, will flag EOI on timeour
.,EE16 85 A5    STA $A5         save the serial bus bit count
.,EE18 20 85 EE JSR $EE85       set the serial clock out high
.,EE1B 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,EE1E 10 FB    BPL $EE1B       loop if the serial clock is low
.,EE20 A9 01    LDA #$01        set the timeout count high byte
.,EE22 8D 07 DC STA $DC07       save VIA 1 timer B high byte
.,EE25 A9 19    LDA #$19        load timer B, timer B single shot, start timer B
.,EE27 8D 0F DC STA $DC0F       save VIA 1 CRB
.,EE2A 20 97 EE JSR $EE97       set the serial data out high
.,EE2D AD 0D DC LDA $DC0D       read VIA 1 ICR
.,EE30 AD 0D DC LDA $DC0D       read VIA 1 ICR
.,EE33 29 02    AND #$02        mask 0000 00x0, timer A interrupt
.,EE35 D0 07    BNE $EE3E       if timer A interrupt go ??
.,EE37 20 A9 EE JSR $EEA9       get the serial data status in Cb
.,EE3A 30 F4    BMI $EE30       loop if the serial clock is low
.,EE3C 10 18    BPL $EE56       else go set 8 bits to do, branch always
                                timer A timed out
.,EE3E A5 A5    LDA $A5         get the serial bus bit count
.,EE40 F0 05    BEQ $EE47       if not already EOI then go flag EOI
.,EE42 A9 02    LDA #$02        else error $02, read timeour
.,EE44 4C B2 ED JMP $EDB2       set the serial status and exit
.,EE47 20 A0 EE JSR $EEA0       set the serial data out low
.,EE4A 20 85 EE JSR $EE85       set the serial clock out high
.,EE4D A9 40    LDA #$40        set EOI
.,EE4F 20 1C FE JSR $FE1C       OR into the serial status byte
.,EE52 E6 A5    INC $A5         increment the serial bus bit count, do error on the next
                                timeout
.,EE54 D0 CA    BNE $EE20       go try again, branch always
.,EE56 A9 08    LDA #$08        set 8 bits to do
.,EE58 85 A5    STA $A5         save the serial bus bit count
.,EE5A AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EE5D CD 00 DD CMP $DD00       compare it with itself
.,EE60 D0 F8    BNE $EE5A       if changing go try again
.,EE62 0A       ASL             shift the serial data into the carry
.,EE63 10 F5    BPL $EE5A       loop while the serial clock is low
.,EE65 66 A4    ROR $A4         shift the data bit into the receive byte
.,EE67 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EE6A CD 00 DD CMP $DD00       compare it with itself
.,EE6D D0 F8    BNE $EE67       if changing go try again
.,EE6F 0A       ASL             shift the serial data into the carry
.,EE70 30 F5    BMI $EE67       loop while the serial clock is high
.,EE72 C6 A5    DEC $A5         decrement the serial bus bit count
.,EE74 D0 E4    BNE $EE5A       loop if not all done
.,EE76 20 A0 EE JSR $EEA0       set the serial data out low
.,EE79 24 90    BIT $90         test the serial status byte
.,EE7B 50 03    BVC $EE80       if EOI not set skip the bus end sequence
.,EE7D 20 06 EE JSR $EE06       1ms delay, clock high then data high
.,EE80 A5 A4    LDA $A4         get the receive byte
.,EE82 58       CLI             enable the interrupts
.,EE83 18       CLC             flag ok
.,EE84 60       RTS             

                                *** set the serial clock out high
.,EE85 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EE88 29 EF    AND #$EF        mask xxx0 xxxx, set serial clock out high
.,EE8A 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,EE8D 60       RTS             

                                *** set the serial clock out low
.,EE8E AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EE91 09 10    ORA #$10        mask xxx1 xxxx, set serial clock out low
.,EE93 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,EE96 60       RTS             

                                *** set the serial data out high
.,EE97 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EE9A 29 DF    AND #$DF        mask xx0x xxxx, set serial data out high
.,EE9C 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,EE9F 60       RTS             

                                *** set the serial data out low
.,EEA0 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EEA3 09 20    ORA #$20        mask xx1x xxxx, set serial data out low
.,EEA5 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,EEA8 60       RTS             

                                *** get the serial data status in Cb
.,EEA9 AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,EEAC CD 00 DD CMP $DD00       compare it with itself
.,EEAF D0 F8    BNE $EEA9       if changing got try again
.,EEB1 0A       ASL             shift the serial data into Cb
.,EEB2 60       RTS             

                                *** 1ms delay
.,EEB3 8A       TXA             save X
.,EEB4 A2 B8    LDX #$B8        set the loop count
.,EEB6 CA       DEX             decrement the loop count
.,EEB7 D0 FD    BNE $EEB6       loop if more to do
.,EEB9 AA       TAX             restore X
.,EEBA 60       RTS             

                                *** RS232 Tx NMI routine
.,EEBB A5 B4    LDA $B4         get RS232 bit count
.,EEBD F0 47    BEQ $EF06       if zero go setup next RS232 Tx byte and return
.,EEBF 30 3F    BMI $EF00       if -ve go do stop bit(s)
                                else bit count is non zero and +ve
.,EEC1 46 B6    LSR $B6         shift RS232 output byte buffer
.,EEC3 A2 00    LDX #$00        set $00 for bit = 0
.,EEC5 90 01    BCC $EEC8       branch if bit was 0
.,EEC7 CA       DEX             set $FF for bit = 1
.,EEC8 8A       TXA             copy bit to A
.,EEC9 45 BD    EOR $BD         EOR with RS232 parity byte
.,EECB 85 BD    STA $BD         save RS232 parity byte
.,EECD C6 B4    DEC $B4         decrement RS232 bit count
.,EECF F0 06    BEQ $EED7       if RS232 bit count now zero go do parity bit
                                save bit and exit
.,EED1 8A       TXA             copy bit to A
.,EED2 29 04    AND #$04        mask 0000 0x00, RS232 Tx DATA bit
.,EED4 85 B5    STA $B5         save the next RS232 data bit to send
.,EED6 60       RTS             

                                *** do RS232 parity bit, enters with RS232 bit count = 0
.,EED7 A9 20    LDA #$20        mask 00x0 0000, parity enable bit
.,EED9 2C 94 02 BIT $0294       test the pseudo 6551 command register
.,EEDC F0 14    BEQ $EEF2       if parity disabled go ??
.,EEDE 30 1C    BMI $EEFC       if fixed mark or space parity go ??
.,EEE0 70 14    BVS $EEF6       if even parity go ??
                                else odd parity
.,EEE2 A5 BD    LDA $BD         get RS232 parity byte
.,EEE4 D0 01    BNE $EEE7       if parity not zero leave parity bit = 0
.,EEE6 CA       DEX             make parity bit = 1
.,EEE7 C6 B4    DEC $B4         decrement RS232 bit count, 1 stop bit
.,EEE9 AD 93 02 LDA $0293       get pseudo 6551 control register
.,EEEC 10 E3    BPL $EED1       if 1 stop bit save parity bit and exit
                                else two stop bits ..
.,EEEE C6 B4    DEC $B4         decrement RS232 bit count, 2 stop bits
.,EEF0 D0 DF    BNE $EED1       save bit and exit, branch always
                                parity is disabled so the parity bit becomes the first,
                                and possibly only, stop bit. to do this increment the bit
                                count which effectively decrements the stop bit count.
.,EEF2 E6 B4    INC $B4         increment RS232 bit count, = -1 stop bit
.,EEF4 D0 F0    BNE $EEE6       set stop bit = 1 and exit
                                do even parity
.,EEF6 A5 BD    LDA $BD         get RS232 parity byte
.,EEF8 F0 ED    BEQ $EEE7       if parity zero leave parity bit = 0
.,EEFA D0 EA    BNE $EEE6       else make parity bit = 1, branch always
                                fixed mark or space parity
.,EEFC 70 E9    BVS $EEE7       if fixed space parity leave parity bit = 0
.,EEFE 50 E6    BVC $EEE6       else fixed mark parity make parity bit = 1, branch always
                                decrement stop bit count, set stop bit = 1 and exit. $FF is one stop bit, $FE is two
                                stop bits
.,EF00 E6 B4    INC $B4         decrement RS232 bit count
.,EF02 A2 FF    LDX #$FF        set stop bit = 1
.,EF04 D0 CB    BNE $EED1       save stop bit and exit, branch always

                                *** setup next RS232 Tx byte
.,EF06 AD 94 02 LDA $0294       read the 6551 pseudo command register
.,EF09 4A       LSR             handshake bit inot Cb
.,EF0A 90 07    BCC $EF13       if 3 line interface go ??
.,EF0C 2C 01 DD BIT $DD01       test VIA 2 DRB, RS232 port
.,EF0F 10 1D    BPL $EF2E       if DSR = 0 set DSR signal not present and exit
.,EF11 50 1E    BVC $EF31       if CTS = 0 set CTS signal not present and exit
                                was 3 line interface
.,EF13 A9 00    LDA #$00        clear A
.,EF15 85 BD    STA $BD         clear the RS232 parity byte
.,EF17 85 B5    STA $B5         clear the RS232 next bit to send
.,EF19 AE 98 02 LDX $0298       get the number of bits to be sent/received
.,EF1C 86 B4    STX $B4         set the RS232 bit count
.,EF1E AC 9D 02 LDY $029D       get the index to the Tx buffer start
.,EF21 CC 9E 02 CPY $029E       compare it with the index to the Tx buffer end
.,EF24 F0 13    BEQ $EF39       if all done go disable T?? interrupt and return
.,EF26 B1 F9    LDA ($F9),Y     else get a byte from the buffer
.,EF28 85 B6    STA $B6         save it to the RS232 output byte buffer
.,EF2A EE 9D 02 INC $029D       increment the index to the Tx buffer start
.,EF2D 60       RTS             

                                *** set DSR signal not present
.,EF2E A9 40    LDA #$40        set DSR signal not present
.:EF30 2C       .BYTE $2C       makes next line BIT $10A9

                                *** set CTS signal not present
.,EF31 A9 10    LDA #$10        set CTS signal not present
.,EF33 0D 97 02 ORA $0297       OR it with the RS232 status register
.,EF36 8D 97 02 STA $0297       save the RS232 status register

                                *** disable timer A interrupt
.,EF39 A9 01    LDA #$01        disable timer A interrupt

                                *** set VIA 2 ICR from A
.,EF3B 8D 0D DD STA $DD0D       save VIA 2 ICR
.,EF3E 4D A1 02 EOR $02A1       EOR with the RS-232 interrupt enable byte
.,EF41 09 80    ORA #$80        set the interrupts enable bit
.,EF43 8D A1 02 STA $02A1       save the RS-232 interrupt enable byte
.,EF46 8D 0D DD STA $DD0D       save VIA 2 ICR
.,EF49 60       RTS             

                                *** compute bit count
.,EF4A A2 09    LDX #$09        set bit count to 9, 8 data + 1 stop bit
.,EF4C A9 20    LDA #$20        mask for 8/7 data bits
.,EF4E 2C 93 02 BIT $0293       test pseudo 6551 control register
.,EF51 F0 01    BEQ $EF54       branch if 8 bits
.,EF53 CA       DEX             else decrement count for 7 data bits
.,EF54 50 02    BVC $EF58       branch if 7 bits
.,EF56 CA       DEX             else decrement count ..
.,EF57 CA       DEX             .. for 5 data bits
.,EF58 60       RTS             

                                *** RS232 Rx NMI
.,EF59 A6 A9    LDX $A9         get start bit check flag
.,EF5B D0 33    BNE $EF90       if no start bit received go ??
.,EF5D C6 A8    DEC $A8         decrement receiver bit count in
.,EF5F F0 36    BEQ $EF97       if the byte is complete go add it to the buffer
.,EF61 30 0D    BMI $EF70       
.,EF63 A5 A7    LDA $A7         get the RS232 received data bit
.,EF65 45 AB    EOR $AB         EOR with the receiver parity bit
.,EF67 85 AB    STA $AB         save the receiver parity bit
.,EF69 46 A7    LSR $A7         shift the RS232 received data bit
.,EF6B 66 AA    ROR $AA         
.,EF6D 60       RTS             
.,EF6E C6 A8    DEC $A8         decrement receiver bit count in
.,EF70 A5 A7    LDA $A7         get the RS232 received data bit
.,EF72 F0 67    BEQ $EFDB       
.,EF74 AD 93 02 LDA $0293       get pseudo 6551 control register
.,EF77 0A       ASL             shift the stop bit flag to Cb
.,EF78 A9 01    LDA #$01        + 1
.,EF7A 65 A8    ADC $A8         add receiver bit count in
.,EF7C D0 EF    BNE $EF6D       exit, branch always

                                *** setup to receive an RS232 bit
.,EF7E A9 90    LDA #$90        enable FLAG interrupt
.,EF80 8D 0D DD STA $DD0D       save VIA 2 ICR
.,EF83 0D A1 02 ORA $02A1       OR with the RS-232 interrupt enable byte
.,EF86 8D A1 02 STA $02A1       save the RS-232 interrupt enable byte
.,EF89 85 A9    STA $A9         set start bit check flag, set no start bit received
.,EF8B A9 02    LDA #$02        disable timer B interrupt
.,EF8D 4C 3B EF JMP $EF3B       set VIA 2 ICR from A and return

                                *** no RS232 start bit received
.,EF90 A5 A7    LDA $A7         get the RS232 received data bit
.,EF92 D0 EA    BNE $EF7E       if ?? go setup to receive an RS232 bit and return
.,EF94 4C D3 E4 JMP $E4D3       flag the RS232 start bit and set the parity

                                *** received a whole byte, add it to the buffer
.,EF97 AC 9B 02 LDY $029B       get index to Rx buffer end
.,EF9A C8       INY             increment index
.,EF9B CC 9C 02 CPY $029C       compare with index to Rx buffer start
.,EF9E F0 2A    BEQ $EFCA       if buffer full go do Rx overrun error
.,EFA0 8C 9B 02 STY $029B       save index to Rx buffer end
.,EFA3 88       DEY             decrement index
.,EFA4 A5 AA    LDA $AA         get assembled byte
.,EFA6 AE 98 02 LDX $0298       get bit count
.,EFA9 E0 09    CPX #$09        compare with byte + stop
.,EFAB F0 04    BEQ $EFB1       branch if all nine bits received
.,EFAD 4A       LSR             else shift byte
.,EFAE E8       INX             increment bit count
.,EFAF D0 F8    BNE $EFA9       loop, branch always
.,EFB1 91 F7    STA ($F7),Y     save received byte to Rx buffer
.,EFB3 A9 20    LDA #$20        mask 00x0 0000, parity enable bit
.,EFB5 2C 94 02 BIT $0294       test the pseudo 6551 command register
.,EFB8 F0 B4    BEQ $EF6E       branch if parity disabled
.,EFBA 30 B1    BMI $EF6D       branch if mark or space parity
.,EFBC A5 A7    LDA $A7         get the RS232 received data bit
.,EFBE 45 AB    EOR $AB         EOR with the receiver parity bit
.,EFC0 F0 03    BEQ $EFC5       
.,EFC2 70 A9    BVS $EF6D       if ?? just exit
.:EFC4 2C       .BYTE $2C       makes next line BIT $A650
.,EFC5 50 A6    BVC $EF6D       if ?? just exit
.,EFC7 A9 01    LDA #$01        set Rx parity error
.:EFC9 2C       .BYTE $2C       makes next line BIT $04A9
.,EFCA A9 04    LDA #$04        set Rx overrun error
.:EFCC 2C       .BYTE $2C       makes next line BIT $80A9
.,EFCD A9 80    LDA #$80        set Rx break error
.:EFCF 2C       .BYTE $2C       makes next line BIT $02A9
.,EFD0 A9 02    LDA #$02        set Rx frame error
.,EFD2 0D 97 02 ORA $0297       OR it with the RS232 status byte
.,EFD5 8D 97 02 STA $0297       save the RS232 status byte
.,EFD8 4C 7E EF JMP $EF7E       setup to receive an RS232 bit and return
.,EFDB A5 AA    LDA $AA         
.,EFDD D0 F1    BNE $EFD0       if ?? do frame error
.,EFDF F0 EC    BEQ $EFCD       else do break error, branch always

                                *** open RS232 channel for output
.,EFE1 85 9A    STA $9A         save the output device number
.,EFE3 AD 94 02 LDA $0294       read the pseudo 6551 command register
.,EFE6 4A       LSR             shift handshake bit to carry
.,EFE7 90 29    BCC $F012       if 3 line interface go ??
.,EFE9 A9 02    LDA #$02        mask 0000 00x0, RTS out
.,EFEB 2C 01 DD BIT $DD01       test VIA 2 DRB, RS232 port
.,EFEE 10 1D    BPL $F00D       if DSR = 0 set DSR not present and exit
.,EFF0 D0 20    BNE $F012       if RTS = 1 just exit
.,EFF2 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,EFF5 29 02    AND #$02        mask 0000 00x0, timer B interrupt
.,EFF7 D0 F9    BNE $EFF2       loop while the timer B interrupt is enebled
.,EFF9 2C 01 DD BIT $DD01       test VIA 2 DRB, RS232 port
.,EFFC 70 FB    BVS $EFF9       loop while CTS high
.,EFFE AD 01 DD LDA $DD01       read VIA 2 DRB, RS232 port
.,F001 09 02    ORA #$02        mask xxxx xx1x, set RTS high
.,F003 8D 01 DD STA $DD01       save VIA 2 DRB, RS232 port
.,F006 2C 01 DD BIT $DD01       test VIA 2 DRB, RS232 port
.,F009 70 07    BVS $F012       exit if CTS high
.,F00B 30 F9    BMI $F006       loop while DSR high
                                set no DSR and exit
.,F00D A9 40    LDA #$40        set DSR signal not present
.,F00F 8D 97 02 STA $0297       save the RS232 status register
.,F012 18       CLC             flag ok
.,F013 60       RTS             

                                *** send byte to the RS232 buffer
.,F014 20 28 F0 JSR $F028       setup for RS232 transmit
                                send byte to the RS232 buffer, no setup
.,F017 AC 9E 02 LDY $029E       get index to Tx buffer end
.,F01A C8       INY             + 1
.,F01B CC 9D 02 CPY $029D       compare with index to Tx buffer start
.,F01E F0 F4    BEQ $F014       loop while buffer full
.,F020 8C 9E 02 STY $029E       set index to Tx buffer end
.,F023 88       DEY             index to available buffer byte
.,F024 A5 9E    LDA $9E         read the RS232 character buffer
.,F026 91 F9    STA ($F9),Y     save the byte to the buffer

                                *** setup for RS232 transmit
.,F028 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,F02B 4A       LSR             shift the enable bit to Cb
.,F02C B0 1E    BCS $F04C       if interrupts are enabled just exit
.,F02E A9 10    LDA #$10        start timer A
.,F030 8D 0E DD STA $DD0E       save VIA 2 CRA
.,F033 AD 99 02 LDA $0299       get the baud rate bit time low byte
.,F036 8D 04 DD STA $DD04       save VIA 2 timer A low byte
.,F039 AD 9A 02 LDA $029A       get the baud rate bit time high byte
.,F03C 8D 05 DD STA $DD05       save VIA 2 timer A high byte
.,F03F A9 81    LDA #$81        enable timer A interrupt
.,F041 20 3B EF JSR $EF3B       set VIA 2 ICR from A
.,F044 20 06 EF JSR $EF06       setup next RS232 Tx byte
.,F047 A9 11    LDA #$11        load timer A, start timer A
.,F049 8D 0E DD STA $DD0E       save VIA 2 CRA
.,F04C 60       RTS             

                                *** input from RS232 buffer
.,F04D 85 99    STA $99         save the input device number
.,F04F AD 94 02 LDA $0294       get pseudo 6551 command register
.,F052 4A       LSR             shift the handshake bit to Cb
.,F053 90 28    BCC $F07D       if 3 line interface go ??
.,F055 29 08    AND #$08        mask the duplex bit, pseudo 6551 command is >> 1
.,F057 F0 24    BEQ $F07D       if full duplex go ??
.,F059 A9 02    LDA #$02        mask 0000 00x0, RTS out
.,F05B 2C 01 DD BIT $DD01       test VIA 2 DRB, RS232 port
.,F05E 10 AD    BPL $F00D       if DSR = 0 set no DSR and exit
.,F060 F0 22    BEQ $F084       if RTS = 0 just exit
.,F062 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,F065 4A       LSR             shift the timer A interrupt enable bit to Cb
.,F066 B0 FA    BCS $F062       loop while the timer A interrupt is enabled
.,F068 AD 01 DD LDA $DD01       read VIA 2 DRB, RS232 port
.,F06B 29 FD    AND #$FD        mask xxxx xx0x, clear RTS out
.,F06D 8D 01 DD STA $DD01       save VIA 2 DRB, RS232 port
.,F070 AD 01 DD LDA $DD01       read VIA 2 DRB, RS232 port
.,F073 29 04    AND #$04        mask xxxx x1xx, DTR in
.,F075 F0 F9    BEQ $F070       loop while DTR low
.,F077 A9 90    LDA #$90        enable the FLAG interrupt
.,F079 18       CLC             flag ok
.,F07A 4C 3B EF JMP $EF3B       set VIA 2 ICR from A and return
.,F07D AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,F080 29 12    AND #$12        mask 000x 00x0
.,F082 F0 F3    BEQ $F077       if FLAG or timer B bits set go enable the FLAG inetrrupt
.,F084 18       CLC             flag ok
.,F085 60       RTS             

                                *** get byte from RS232 buffer
.,F086 AD 97 02 LDA $0297       get the RS232 status register
.,F089 AC 9C 02 LDY $029C       get index to Rx buffer start
.,F08C CC 9B 02 CPY $029B       compare with index to Rx buffer end
.,F08F F0 0B    BEQ $F09C       return null if buffer empty
.,F091 29 F7    AND #$F7        clear the Rx buffer empty bit
.,F093 8D 97 02 STA $0297       save the RS232 status register
.,F096 B1 F7    LDA ($F7),Y     get byte from Rx buffer
.,F098 EE 9C 02 INC $029C       increment index to Rx buffer start
.,F09B 60       RTS             
.,F09C 09 08    ORA #$08        set the Rx buffer empty bit
.,F09E 8D 97 02 STA $0297       save the RS232 status register
.,F0A1 A9 00    LDA #$00        return null
.,F0A3 60       RTS             

                                *** check RS232 bus idle
.,F0A4 48       PHA             save A
.,F0A5 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,F0A8 F0 11    BEQ $F0BB       if no interrupts enabled just exit
.,F0AA AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,F0AD 29 03    AND #$03        mask 0000 00xx, the error bits
.,F0AF D0 F9    BNE $F0AA       if there are errors loop
.,F0B1 A9 10    LDA #$10        disable FLAG interrupt
.,F0B3 8D 0D DD STA $DD0D       save VIA 2 ICR
.,F0B6 A9 00    LDA #$00        clear A
.,F0B8 8D A1 02 STA $02A1       clear the RS-232 interrupt enable byte
.,F0BB 68       PLA             restore A
.,F0BC 60       RTS             

                                *** kernel I/O messages
.:F0BD 0D 49 2F 4F 20 45 52 52  I/O ERROR #
.:F0C6 52 20 A3 0D 53 45 41 52
.:F0C9 0D 53 45 41 52 43 48 49  SEARCHING
.:F0D1 4E 47 A0 46 4F 52 A0 0D
.:F0D4 46 4F 52 A0 0D 50 52 45  FOR
.:F0D8 0D 50 52 45 53 53 20 50  PRESS PLAY ON TAPE
.:F0E0 4C 41 59 20 4F 4E 20 54
.:F0E8 41 50 C5 50 52 45 53 53
.:F0EB 50 52 45 53 53 20 52 45  PRESS RECORD & PLAY ON TAPE
.:F0F3 43 4F 52 44 20 26 20 50
.:F0FB 4C 41 59 20 4F 4E 20 54
.:F103 41 50 C5 0D 4C 4F 41 44
.:F106 0D 4C 4F 41 44 49 4E C7  LOADING
.:F10E 0D 53 41 56 49 4E 47 A0  SAVING
.:F116 0D 56 45 52 49 46 59 49  VERIFYING
.:F11E 4E C7 0D 46 4F 55 4E 44
.:F120 0D 46 4F 55 4E 44 A0 0D  FOUND
.:F127 0D 4F 4B 8D              OK

                                *** display control I/O message if in direct mode
.,F12B 24 9D    BIT $9D         test message mode flag
.,F12D 10 0D    BPL $F13C       exit if control messages off
                                display kernel I/O message
.,F12F B9 BD F0 LDA $F0BD,Y     get byte from message table
.,F132 08       PHP             save status
.,F133 29 7F    AND #$7F        clear b7
.,F135 20 D2 FF JSR $FFD2       output character to channel
.,F138 C8       INY             increment index
.,F139 28       PLP             restore status
.,F13A 10 F3    BPL $F12F       loop if not end of message
.,F13C 18       CLC             
.,F13D 60       RTS             

                                *** get character from the input device
.,F13E A5 99    LDA $99         get the input device number
.,F140 D0 08    BNE $F14A       if not the keyboard go handle other devices
                                the input device was the keyboard
.,F142 A5 C6    LDA $C6         get the keyboard buffer index
.,F144 F0 0F    BEQ $F155       if the buffer is empty go flag no byte and return
.,F146 78       SEI             disable the interrupts
.,F147 4C B4 E5 JMP $E5B4       get input from the keyboard buffer and return
                                the input device was not the keyboard
.,F14A C9 02    CMP #$02        compare the device with the RS232 device
.,F14C D0 18    BNE $F166       if not the RS232 device go ??
                                the input device is the RS232 device
.,F14E 84 97    STY $97         save Y
.,F150 20 86 F0 JSR $F086       get a byte from RS232 buffer
.,F153 A4 97    LDY $97         restore Y
.,F155 18       CLC             flag no error
.,F156 60       RTS             

                                *** input a character from channel
.,F157 A5 99    LDA $99         get the input device number
.,F159 D0 0B    BNE $F166       if not the keyboard continue
                                the input device was the keyboard
.,F15B A5 D3    LDA $D3         get the cursor column
.,F15D 85 CA    STA $CA         set the input cursor column
.,F15F A5 D6    LDA $D6         get the cursor row
.,F161 85 C9    STA $C9         set the input cursor row
.,F163 4C 32 E6 JMP $E632       input from screen or keyboard
                                the input device was not the keyboard
.,F166 C9 03    CMP #$03        compare device number with screen
.,F168 D0 09    BNE $F173       if not screen continue
                                the input device was the screen
.,F16A 85 D0    STA $D0         input from keyboard or screen, $xx = screen,
                                $00 = keyboard
.,F16C A5 D5    LDA $D5         get current screen line length
.,F16E 85 C8    STA $C8         save input [EOL] pointer
.,F170 4C 32 E6 JMP $E632       input from screen or keyboard
                                the input device was not the screen
.,F173 B0 38    BCS $F1AD       if input device > screen go do IEC devices
                                the input device was < screen
.,F175 C9 02    CMP #$02        compare the device with the RS232 device
.,F177 F0 3F    BEQ $F1B8       if RS232 device go get a byte from the RS232 device
                                only the tape device left ..
.,F179 86 97    STX $97         save X
.,F17B 20 99 F1 JSR $F199       get a byte from tape
.,F17E B0 16    BCS $F196       if error just exit
.,F180 48       PHA             save the byte
.,F181 20 99 F1 JSR $F199       get the next byte from tape
.,F184 B0 0D    BCS $F193       if error just exit
.,F186 D0 05    BNE $F18D       if end reached ??
.,F188 A9 40    LDA #$40        set EOI
.,F18A 20 1C FE JSR $FE1C       OR into the serial status byte
.,F18D C6 A6    DEC $A6         decrement tape buffer index
.,F18F A6 97    LDX $97         restore X
.,F191 68       PLA             restore the saved byte
.,F192 60       RTS             
.,F193 AA       TAX             copy the error byte
.,F194 68       PLA             dump the saved byte
.,F195 8A       TXA             restore error byte
.,F196 A6 97    LDX $97         restore X
.,F198 60       RTS             

                                *** get byte from tape
.,F199 20 0D F8 JSR $F80D       bump tape pointer
.,F19C D0 0B    BNE $F1A9       if not end get next byte and exit
.,F19E 20 41 F8 JSR $F841       initiate tape read
.,F1A1 B0 11    BCS $F1B4       exit if error flagged
.,F1A3 A9 00    LDA #$00        clear A
.,F1A5 85 A6    STA $A6         clear tape buffer index
.,F1A7 F0 F0    BEQ $F199       loop, branch always
.,F1A9 B1 B2    LDA ($B2),Y     get next byte from buffer
.,F1AB 18       CLC             flag no error
.,F1AC 60       RTS             
                                input device was serial bus
.,F1AD A5 90    LDA $90         get the serial status byte
.,F1AF F0 04    BEQ $F1B5       if no errors flagged go input byte and return
.,F1B1 A9 0D    LDA #$0D        else return [EOL]
.,F1B3 18       CLC             flag no error
.,F1B4 60       RTS             
.,F1B5 4C 13 EE JMP $EE13       input byte from serial bus and return
                                input device was RS232 device
.,F1B8 20 4E F1 JSR $F14E       get byte from RS232 device
.,F1BB B0 F7    BCS $F1B4       branch if error, this doesn't get taken as the last
                                instruction in the get byte from RS232 device routine
                                is CLC ??
.,F1BD C9 00    CMP #$00        compare with null
.,F1BF D0 F2    BNE $F1B3       exit if not null
.,F1C1 AD 97 02 LDA $0297       get the RS232 status register
.,F1C4 29 60    AND #$60        mask 0xx0 0000, DSR detected and ??
.,F1C6 D0 E9    BNE $F1B1       if ?? return null
.,F1C8 F0 EE    BEQ $F1B8       else loop, branch always

                                *** output character to channel
.,F1CA 48       PHA             save the character to output
.,F1CB A5 9A    LDA $9A         get the output device number
.,F1CD C9 03    CMP #$03        compare the output device with the screen
.,F1CF D0 04    BNE $F1D5       if not the screen go ??
.,F1D1 68       PLA             else restore the output character
.,F1D2 4C 16 E7 JMP $E716       go output the character to the screen
.,F1D5 90 04    BCC $F1DB       if < screen go ??
.,F1D7 68       PLA             else restore the output character
.,F1D8 4C DD ED JMP $EDDD       go output the character to the serial bus
.,F1DB 4A       LSR             shift b0 of the device into Cb
.,F1DC 68       PLA             restore the output character

                                *** output the character to the cassette or RS232 device
.,F1DD 85 9E    STA $9E         save the character to the character buffer
.,F1DF 8A       TXA             copy X
.,F1E0 48       PHA             save X
.,F1E1 98       TYA             copy Y
.,F1E2 48       PHA             save Y
.,F1E3 90 23    BCC $F208       if Cb is clear it must be the RS232 device
                                output the character to the cassette
.,F1E5 20 0D F8 JSR $F80D       bump the tape pointer
.,F1E8 D0 0E    BNE $F1F8       if not end save next byte and exit
.,F1EA 20 64 F8 JSR $F864       initiate tape write
.,F1ED B0 0E    BCS $F1FD       exit if error
.,F1EF A9 02    LDA #$02        set data block type ??
.,F1F1 A0 00    LDY #$00        clear index
.,F1F3 91 B2    STA ($B2),Y     save type to buffer ??
.,F1F5 C8       INY             increment index
.,F1F6 84 A6    STY $A6         save tape buffer index
.,F1F8 A5 9E    LDA $9E         restore character from character buffer
.,F1FA 91 B2    STA ($B2),Y     save to buffer
.,F1FC 18       CLC             flag no error
.,F1FD 68       PLA             pull Y
.,F1FE A8       TAY             restore Y
.,F1FF 68       PLA             pull X
.,F200 AA       TAX             restore X
.,F201 A5 9E    LDA $9E         get the character from the character buffer
.,F203 90 02    BCC $F207       exit if no error
.,F205 A9 00    LDA #$00        else clear A
.,F207 60       RTS             
                                output the character to the RS232 device
.,F208 20 17 F0 JSR $F017       send byte to the RS232 buffer, no setup
.,F20B 4C FC F1 JMP $F1FC       do no error exit

                                *** open channel for input
.,F20E 20 0F F3 JSR $F30F       find a file
.,F211 F0 03    BEQ $F216       if the file is open continue
.,F213 4C 01 F7 JMP $F701       else do 'file not open' error and return
.,F216 20 1F F3 JSR $F31F       set file details from table,X
.,F219 A5 BA    LDA $BA         get the device number
.,F21B F0 16    BEQ $F233       if the device was the keyboard save the device #, flag
                                ok and exit
.,F21D C9 03    CMP #$03        compare the device number with the screen
.,F21F F0 12    BEQ $F233       if the device was the screen save the device #, flag ok
                                and exit
.,F221 B0 14    BCS $F237       if the device was a serial bus device go ??
.,F223 C9 02    CMP #$02        else compare the device with the RS232 device
.,F225 D0 03    BNE $F22A       if not the RS232 device continue
.,F227 4C 4D F0 JMP $F04D       else go get input from the RS232 buffer and return
.,F22A A6 B9    LDX $B9         get the secondary address
.,F22C E0 60    CPX #$60        
.,F22E F0 03    BEQ $F233       
.,F230 4C 0A F7 JMP $F70A       go do 'not input file' error and return
.,F233 85 99    STA $99         save the input device number
.,F235 18       CLC             flag ok
.,F236 60       RTS             
                                the device was a serial bus device
.,F237 AA       TAX             copy device number to X
.,F238 20 09 ED JSR $ED09       command serial bus device to TALK
.,F23B A5 B9    LDA $B9         get the secondary address
.,F23D 10 06    BPL $F245       
.,F23F 20 CC ED JSR $EDCC       wait for the serial bus end after send
.,F242 4C 48 F2 JMP $F248       
.,F245 20 C7 ED JSR $EDC7       send secondary address after TALK
.,F248 8A       TXA             copy device back to A
.,F249 24 90    BIT $90         test the serial status byte
.,F24B 10 E6    BPL $F233       if device present save device number and exit
.,F24D 4C 07 F7 JMP $F707       do 'device not present' error and return

                                *** open channel for output
.,F250 20 0F F3 JSR $F30F       find a file
.,F253 F0 03    BEQ $F258       if file found continue
.,F255 4C 01 F7 JMP $F701       else do 'file not open' error and return
.,F258 20 1F F3 JSR $F31F       set file details from table,X
.,F25B A5 BA    LDA $BA         get the device number
.,F25D D0 03    BNE $F262       if the device is not the keyboard go ??
.,F25F 4C 0D F7 JMP $F70D       go do 'not output file' error and return
.,F262 C9 03    CMP #$03        compare the device with the screen
.,F264 F0 0F    BEQ $F275       if the device is the screen go save output the output
                                device number and exit
.,F266 B0 11    BCS $F279       if > screen then go handle a serial bus device
.,F268 C9 02    CMP #$02        compare the device with the RS232 device
.,F26A D0 03    BNE $F26F       if not the RS232 device then it must be the tape device
.,F26C 4C E1 EF JMP $EFE1       else go open RS232 channel for output
                                open a tape channel for output
.,F26F A6 B9    LDX $B9         get the secondary address
.,F271 E0 60    CPX #$60        
.,F273 F0 EA    BEQ $F25F       if ?? do not output file error and return
.,F275 85 9A    STA $9A         save the output device number
.,F277 18       CLC             flag ok
.,F278 60       RTS             
.,F279 AA       TAX             copy the device number
.,F27A 20 0C ED JSR $ED0C       command devices on the serial bus to LISTEN
.,F27D A5 B9    LDA $B9         get the secondary address
.,F27F 10 05    BPL $F286       if address to send go ??
.,F281 20 BE ED JSR $EDBE       else set serial ATN high
.,F284 D0 03    BNE $F289       go ??, branch always
.,F286 20 B9 ED JSR $EDB9       send secondary address after LISTEN
.,F289 8A       TXA             copy device number back to A
.,F28A 24 90    BIT $90         test the serial status byte
.,F28C 10 E7    BPL $F275       if the device is present go save the output device number
                                and exit
.,F28E 4C 07 F7 JMP $F707       else do 'device not present error' and return

                                *** close a specified logical file
.,F291 20 14 F3 JSR $F314       find file A
.,F294 F0 02    BEQ $F298       if file found go close it
.,F296 18       CLC             else the file was closed so just flag ok
.,F297 60       RTS             
                                file found so close it
.,F298 20 1F F3 JSR $F31F       set file details from table,X
.,F29B 8A       TXA             copy file index to A
.,F29C 48       PHA             save file index
.,F29D A5 BA    LDA $BA         get the device number
.,F29F F0 50    BEQ $F2F1       if it is the keyboard go restore the index and close the
                                file
.,F2A1 C9 03    CMP #$03        compare the device number with the screen
.,F2A3 F0 4C    BEQ $F2F1       if it is the screen go restore the index and close the
                                file
.,F2A5 B0 47    BCS $F2EE       if > screen go do serial bus device close
.,F2A7 C9 02    CMP #$02        compare the device with the RS232 device
.,F2A9 D0 1D    BNE $F2C8       if not the RS232 device go ??
                                else close RS232 device
.,F2AB 68       PLA             restore file index
.,F2AC 20 F2 F2 JSR $F2F2       close file index X
.,F2AF 20 83 F4 JSR $F483       initialise RS232 output
.,F2B2 20 27 FE JSR $FE27       read the top of memory
.,F2B5 A5 F8    LDA $F8         get the RS232 input buffer pointer high byte
.,F2B7 F0 01    BEQ $F2BA       if no RS232 input buffer go ??
.,F2B9 C8       INY             else reclaim RS232 input buffer memory
.,F2BA A5 FA    LDA $FA         get the RS232 output buffer pointer high byte
.,F2BC F0 01    BEQ $F2BF       if no RS232 output buffer skip the reclaim
.,F2BE C8       INY             else reclaim the RS232 output buffer memory
.,F2BF A9 00    LDA #$00        clear A
.,F2C1 85 F8    STA $F8         clear the RS232 input buffer pointer high byte
.,F2C3 85 FA    STA $FA         clear the RS232 output buffer pointer high byte
.,F2C5 4C 7D F4 JMP $F47D       go set the top of memory to F0xx
                                is not the RS232 device
.,F2C8 A5 B9    LDA $B9         get the secondary address
.,F2CA 29 0F    AND #$0F        mask the device #
.,F2CC F0 23    BEQ $F2F1       if ?? restore index and close file
.,F2CE 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F2D1 A9 00    LDA #$00        character $00
.,F2D3 38       SEC             flag the tape device
.,F2D4 20 DD F1 JSR $F1DD       output the character to the cassette or RS232 device
.,F2D7 20 64 F8 JSR $F864       initiate tape write
.,F2DA 90 04    BCC $F2E0       
.,F2DC 68       PLA             
.,F2DD A9 00    LDA #$00        
.,F2DF 60       RTS             
.,F2E0 A5 B9    LDA $B9         get the secondary address
.,F2E2 C9 62    CMP #$62        
.,F2E4 D0 0B    BNE $F2F1       if not ?? restore index and close file
.,F2E6 A9 05    LDA #$05        set logical end of the tape
.,F2E8 20 6A F7 JSR $F76A       write tape header
.,F2EB 4C F1 F2 JMP $F2F1       restore index and close file

                                *** serial bus device close
.,F2EE 20 42 F6 JSR $F642       close serial bus device
.,F2F1 68       PLA             restore file index

                                *** close file index X
.,F2F2 AA       TAX             copy index to file to close
.,F2F3 C6 98    DEC $98         decrement the open file count
.,F2F5 E4 98    CPX $98         compare the index with the open file count
.,F2F7 F0 14    BEQ $F30D       exit if equal, last entry was closing file
                                else entry was not last in list so copy last table entry
                                file details over the details of the closing one
.,F2F9 A4 98    LDY $98         get the open file count as index
.,F2FB B9 59 02 LDA $0259,Y     get last+1 logical file number from logical file table
.,F2FE 9D 59 02 STA $0259,X     save logical file number over closed file
.,F301 B9 63 02 LDA $0263,Y     get last+1 device number from device number table
.,F304 9D 63 02 STA $0263,X     save device number over closed file
.,F307 B9 6D 02 LDA $026D,Y     get last+1 secondary address from secondary address table
.,F30A 9D 6D 02 STA $026D,X     save secondary address over closed file
.,F30D 18       CLC             flag ok
.,F30E 60       RTS             

                                *** find a file
.,F30F A9 00    LDA #$00        clear A
.,F311 85 90    STA $90         clear the serial status byte
.,F313 8A       TXA             copy the logical file number to A

                                *** find file A
.,F314 A6 98    LDX $98         get the open file count
.,F316 CA       DEX             decrememnt the count to give the index
.,F317 30 15    BMI $F32E       if no files just exit
.,F319 DD 59 02 CMP $0259,X     compare the logical file number with the table logical
                                file number
.,F31C D0 F8    BNE $F316       if no match go try again
.,F31E 60       RTS             

                                *** set file details from table,X
.,F31F BD 59 02 LDA $0259,X     get logical file from logical file table
.,F322 85 B8    STA $B8         save the logical file
.,F324 BD 63 02 LDA $0263,X     get device number from device number table
.,F327 85 BA    STA $BA         save the device number
.,F329 BD 6D 02 LDA $026D,X     get secondary address from secondary address table
.,F32C 85 B9    STA $B9         save the secondary address
.,F32E 60       RTS             

                                *** close all channels and files
.,F32F A9 00    LDA #$00        clear A
.,F331 85 98    STA $98         clear the open file count

                                *** close input and output channels
.,F333 A2 03    LDX #$03        set the screen device
.,F335 E4 9A    CPX $9A         compare the screen with the output device number
.,F337 B0 03    BCS $F33C       if <= screen skip the serial bus unlisten
.,F339 20 FE ED JSR $EDFE       else command the serial bus to UNLISTEN
.,F33C E4 99    CPX $99         compare the screen with the input device number
.,F33E B0 03    BCS $F343       if <= screen skip the serial bus untalk
.,F340 20 EF ED JSR $EDEF       else command the serial bus to UNTALK
.,F343 86 9A    STX $9A         save the screen as the output device number
.,F345 A9 00    LDA #$00        set the keyboard as the input device
.,F347 85 99    STA $99         save the input device number
.,F349 60       RTS             

                                *** open a logical file
.,F34A A6 B8    LDX $B8         get the logical file
.,F34C D0 03    BNE $F351       if there is a file continue
.,F34E 4C 0A F7 JMP $F70A       else do 'not input file error' and return
.,F351 20 0F F3 JSR $F30F       find a file
.,F354 D0 03    BNE $F359       if file not found continue
.,F356 4C FE F6 JMP $F6FE       else do 'file already open' error and return
.,F359 A6 98    LDX $98         get the open file count
.,F35B E0 0A    CPX #$0A        compare it with the maximum + 1
.,F35D 90 03    BCC $F362       if less than maximum + 1 go open the file
.,F35F 4C FB F6 JMP $F6FB       else do 'too many files error' and return
.,F362 E6 98    INC $98         increment the open file count
.,F364 A5 B8    LDA $B8         get the logical file
.,F366 9D 59 02 STA $0259,X     save it to the logical file table
.,F369 A5 B9    LDA $B9         get the secondary address
.,F36B 09 60    ORA #$60        OR with the OPEN CHANNEL command
.,F36D 85 B9    STA $B9         save the secondary address
.,F36F 9D 6D 02 STA $026D,X     save it to the secondary address table
.,F372 A5 BA    LDA $BA         get the device number
.,F374 9D 63 02 STA $0263,X     save it to the device number table
.,F377 F0 5A    BEQ $F3D3       if it is the keyboard go do the ok exit
.,F379 C9 03    CMP #$03        compare the device number with the screen
.,F37B F0 56    BEQ $F3D3       if it is the screen go do the ok exit
.,F37D 90 05    BCC $F384       if tape or RS232 device go ??
                                else it is a serial bus device
.,F37F 20 D5 F3 JSR $F3D5       send the secondary address and filename
.,F382 90 4F    BCC $F3D3       go do ok exit, branch always
.,F384 C9 02    CMP #$02        
.,F386 D0 03    BNE $F38B       
.,F388 4C 09 F4 JMP $F409       go open RS232 device and return
.,F38B 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F38E B0 03    BCS $F393       if >= $0200 go ??
.,F390 4C 13 F7 JMP $F713       else do 'illegal device number' and return
.,F393 A5 B9    LDA $B9         get the secondary address
.,F395 29 0F    AND #$0F        
.,F397 D0 1F    BNE $F3B8       
.,F399 20 17 F8 JSR $F817       wait for PLAY
.,F39C B0 36    BCS $F3D4       exit if STOP was pressed
.,F39E 20 AF F5 JSR $F5AF       print "Searching..."
.,F3A1 A5 B7    LDA $B7         get file name length
.,F3A3 F0 0A    BEQ $F3AF       if null file name just go find header
.,F3A5 20 EA F7 JSR $F7EA       find specific tape header
.,F3A8 90 18    BCC $F3C2       branch if no error
.,F3AA F0 28    BEQ $F3D4       exit if ??
.,F3AC 4C 04 F7 JMP $F704       do file not found error and return
.,F3AF 20 2C F7 JSR $F72C       find tape header, exit with header in buffer
.,F3B2 F0 20    BEQ $F3D4       exit if end of tape found
.,F3B4 90 0C    BCC $F3C2       
.,F3B6 B0 F4    BCS $F3AC       
.,F3B8 20 38 F8 JSR $F838       wait for PLAY/RECORD
.,F3BB B0 17    BCS $F3D4       exit if STOP was pressed
.,F3BD A9 04    LDA #$04        set data file header
.,F3BF 20 6A F7 JSR $F76A       write tape header
.,F3C2 A9 BF    LDA #$BF        
.,F3C4 A4 B9    LDY $B9         get the secondary address
.,F3C6 C0 60    CPY #$60        
.,F3C8 F0 07    BEQ $F3D1       
.,F3CA A0 00    LDY #$00        clear index
.,F3CC A9 02    LDA #$02        
.,F3CE 91 B2    STA ($B2),Y     save to tape buffer
.,F3D0 98       TYA             clear A
.,F3D1 85 A6    STA $A6         save tape buffer index
.,F3D3 18       CLC             flag ok
.,F3D4 60       RTS             

                                *** send secondary address and filename
.,F3D5 A5 B9    LDA $B9         get the secondary address
.,F3D7 30 FA    BMI $F3D3       ok exit if -ve
.,F3D9 A4 B7    LDY $B7         get file name length
.,F3DB F0 F6    BEQ $F3D3       ok exit if null
.,F3DD A9 00    LDA #$00        clear A
.,F3DF 85 90    STA $90         clear the serial status byte
.,F3E1 A5 BA    LDA $BA         get the device number
.,F3E3 20 0C ED JSR $ED0C       command devices on the serial bus to LISTEN
.,F3E6 A5 B9    LDA $B9         get the secondary address
.,F3E8 09 F0    ORA #$F0        OR with the OPEN command
.,F3EA 20 B9 ED JSR $EDB9       send secondary address after LISTEN
.,F3ED A5 90    LDA $90         get the serial status byte
.,F3EF 10 05    BPL $F3F6       if device present skip the 'device not present' error
.,F3F1 68       PLA             else dump calling address low byte
.,F3F2 68       PLA             dump calling address high byte
.,F3F3 4C 07 F7 JMP $F707       do 'device not present' error and return
.,F3F6 A5 B7    LDA $B7         get file name length
.,F3F8 F0 0C    BEQ $F406       branch if null name
.,F3FA A0 00    LDY #$00        clear index
.,F3FC B1 BB    LDA ($BB),Y     get file name byte
.,F3FE 20 DD ED JSR $EDDD       output byte to serial bus
.,F401 C8       INY             increment index
.,F402 C4 B7    CPY $B7         compare with file name length
.,F404 D0 F6    BNE $F3FC       loop if not all done
.,F406 4C 54 F6 JMP $F654       command serial bus to UNLISTEN and return

                                *** open RS232 device
.,F409 20 83 F4 JSR $F483       initialise RS232 output
.,F40C 8C 97 02 STY $0297       save the RS232 status register
.,F40F C4 B7    CPY $B7         compare with file name length
.,F411 F0 0A    BEQ $F41D       exit loop if done
.,F413 B1 BB    LDA ($BB),Y     get file name byte
.,F415 99 93 02 STA $0293,Y     copy to 6551 register set
.,F418 C8       INY             increment index
.,F419 C0 04    CPY #$04        compare with $04
.,F41B D0 F2    BNE $F40F       loop if not to 4 yet
.,F41D 20 4A EF JSR $EF4A       compute bit count
.,F420 8E 98 02 STX $0298       save bit count
.,F423 AD 93 02 LDA $0293       get pseudo 6551 control register
.,F426 29 0F    AND #$0F        mask 0000 xxxx, baud rate
.,F428 F0 1C    BEQ $F446       if zero skip the baud rate setup
.,F42A 0A       ASL             * 2 bytes per entry
.,F42B AA       TAX             copy to the index
.,F42C AD A6 02 LDA $02A6       get the PAL/NTSC flag
.,F42F D0 09    BNE $F43A       if PAL go set PAL timing
.,F431 BC C1 FE LDY $FEC1,X     get the NTSC baud rate value high byte
.,F434 BD C0 FE LDA $FEC0,X     get the NTSC baud rate value low byte
.,F437 4C 40 F4 JMP $F440       go save the baud rate values
.,F43A BC EB E4 LDY $E4EB,X     get the PAL baud rate value high byte
.,F43D BD EA E4 LDA $E4EA,X     get the PAL baud rate value low byte
.,F440 8C 96 02 STY $0296       save the nonstandard bit timing high byte
.,F443 8D 95 02 STA $0295       save the nonstandard bit timing low byte
.,F446 AD 95 02 LDA $0295       get the nonstandard bit timing low byte
.,F449 0A       ASL             * 2
.,F44A 20 2E FF JSR $FF2E       
.,F44D AD 94 02 LDA $0294       read the pseudo 6551 command register
.,F450 4A       LSR             shift the X line/3 line bit into Cb
.,F451 90 09    BCC $F45C       if 3 line skip the DRS test
.,F453 AD 01 DD LDA $DD01       read VIA 2 DRB, RS232 port
.,F456 0A       ASL             shift DSR in into Cb
.,F457 B0 03    BCS $F45C       if DSR present skip the error set
.,F459 20 0D F0 JSR $F00D       set no DSR
.,F45C AD 9B 02 LDA $029B       get index to Rx buffer end
.,F45F 8D 9C 02 STA $029C       set index to Rx buffer start, clear Rx buffer
.,F462 AD 9E 02 LDA $029E       get index to Tx buffer end
.,F465 8D 9D 02 STA $029D       set index to Tx buffer start, clear Tx buffer
.,F468 20 27 FE JSR $FE27       read the top of memory
.,F46B A5 F8    LDA $F8         get the RS232 input buffer pointer high byte
.,F46D D0 05    BNE $F474       if buffer already set skip the save
.,F46F 88       DEY             decrement top of memory high byte, 256 byte buffer
.,F470 84 F8    STY $F8         save the RS232 input buffer pointer high byte
.,F472 86 F7    STX $F7         save the RS232 input buffer pointer low byte
.,F474 A5 FA    LDA $FA         get the RS232 output buffer pointer high byte
.,F476 D0 05    BNE $F47D       if ?? go set the top of memory to F0xx
.,F478 88       DEY             
.,F479 84 FA    STY $FA         save the RS232 output buffer pointer high byte
.,F47B 86 F9    STX $F9         save the RS232 output buffer pointer low byte

                                *** set the top of memory to F0xx
.,F47D 38       SEC             read the top of memory
.,F47E A9 F0    LDA #$F0        set $F000
.,F480 4C 2D FE JMP $FE2D       set the top of memory and return

                                *** initialise RS232 output
.,F483 A9 7F    LDA #$7F        disable all interrupts
.,F485 8D 0D DD STA $DD0D       save VIA 2 ICR
.,F488 A9 06    LDA #$06        set RS232 DTR output, RS232 RTS output
.,F48A 8D 03 DD STA $DD03       save VIA 2 DDRB, RS232 port
.,F48D 8D 01 DD STA $DD01       save VIA 2 DRB, RS232 port
.,F490 A9 04    LDA #$04        mask xxxx x1xx, set RS232 Tx DATA high
.,F492 0D 00 DD ORA $DD00       OR it with VIA 2 DRA, serial port and video address
.,F495 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,F498 A0 00    LDY #$00        clear Y
.,F49A 8C A1 02 STY $02A1       clear the RS-232 interrupt enable byte
.,F49D 60       RTS             

                                *** load RAM from a device
.,F49E 86 C3    STX $C3         set kernal setup pointer low byte
.,F4A0 84 C4    STY $C4         set kernal setup pointer high byte
.,F4A2 6C 30 03 JMP ($0330)     do LOAD vector, usually points to $F4A5

                                *** load
.,F4A5 85 93    STA $93         save load/verify flag
.,F4A7 A9 00    LDA #$00        clear A
.,F4A9 85 90    STA $90         clear the serial status byte
.,F4AB A5 BA    LDA $BA         get the device number
.,F4AD D0 03    BNE $F4B2       if not the keyboard continue
                                do 'illegal device number'
.,F4AF 4C 13 F7 JMP $F713       else do 'illegal device number' and return
.,F4B2 C9 03    CMP #$03        
.,F4B4 F0 F9    BEQ $F4AF       
.,F4B6 90 7B    BCC $F533       
.,F4B8 A4 B7    LDY $B7         get file name length
.,F4BA D0 03    BNE $F4BF       if not null name go ??
.,F4BC 4C 10 F7 JMP $F710       else do 'missing file name' error and return
.,F4BF A6 B9    LDX $B9         get the secondary address
.,F4C1 20 AF F5 JSR $F5AF       print "Searching..."
.,F4C4 A9 60    LDA #$60        
.,F4C6 85 B9    STA $B9         save the secondary address
.,F4C8 20 D5 F3 JSR $F3D5       send secondary address and filename
.,F4CB A5 BA    LDA $BA         get the device number
.,F4CD 20 09 ED JSR $ED09       command serial bus device to TALK
.,F4D0 A5 B9    LDA $B9         get the secondary address
.,F4D2 20 C7 ED JSR $EDC7       send secondary address after TALK
.,F4D5 20 13 EE JSR $EE13       input byte from serial bus
.,F4D8 85 AE    STA $AE         save program start address low byte
.,F4DA A5 90    LDA $90         get the serial status byte
.,F4DC 4A       LSR             shift time out read ..
.,F4DD 4A       LSR             .. into carry bit
.,F4DE B0 50    BCS $F530       if timed out go do file not found error and return
.,F4E0 20 13 EE JSR $EE13       input byte from serial bus
.,F4E3 85 AF    STA $AF         save program start address high byte
.,F4E5 8A       TXA             copy secondary address
.,F4E6 D0 08    BNE $F4F0       load location not set in LOAD call, so continue with the
                                load
.,F4E8 A5 C3    LDA $C3         get the load address low byte
.,F4EA 85 AE    STA $AE         save the program start address low byte
.,F4EC A5 C4    LDA $C4         get the load address high byte
.,F4EE 85 AF    STA $AF         save the program start address high byte
.,F4F0 20 D2 F5 JSR $F5D2       
.,F4F3 A9 FD    LDA #$FD        mask xxxx xx0x, clear time out read bit
.,F4F5 25 90    AND $90         mask the serial status byte
.,F4F7 85 90    STA $90         set the serial status byte
.,F4F9 20 E1 FF JSR $FFE1       scan stop key, return Zb = 1 = [STOP]
.,F4FC D0 03    BNE $F501       if not [STOP] go ??
.,F4FE 4C 33 F6 JMP $F633       else close the serial bus device and flag stop
.,F501 20 13 EE JSR $EE13       input byte from serial bus
.,F504 AA       TAX             copy byte
.,F505 A5 90    LDA $90         get the serial status byte
.,F507 4A       LSR             shift time out read ..
.,F508 4A       LSR             .. into carry bit
.,F509 B0 E8    BCS $F4F3       if timed out go try again
.,F50B 8A       TXA             copy received byte back
.,F50C A4 93    LDY $93         get load/verify flag
.,F50E F0 0C    BEQ $F51C       if load go load
                                else is verify
.,F510 A0 00    LDY #$00        clear index
.,F512 D1 AE    CMP ($AE),Y     compare byte with previously loaded byte
.,F514 F0 08    BEQ $F51E       if match go ??
.,F516 A9 10    LDA #$10        flag read error
.,F518 20 1C FE JSR $FE1C       OR into the serial status byte
.:F51B 2C       .BYTE $2C       makes next line BIT $AE91
.,F51C 91 AE    STA ($AE),Y     save byte to memory
.,F51E E6 AE    INC $AE         increment save pointer low byte
.,F520 D0 02    BNE $F524       if no rollover go ??
.,F522 E6 AF    INC $AF         else increment save pointer high byte
.,F524 24 90    BIT $90         test the serial status byte
.,F526 50 CB    BVC $F4F3       loop if not end of file
                                close file and exit
.,F528 20 EF ED JSR $EDEF       command serial bus to UNTALK
.,F52B 20 42 F6 JSR $F642       close serial bus device
.,F52E 90 79    BCC $F5A9       if ?? go flag ok and exit
.,F530 4C 04 F7 JMP $F704       do file not found error and return

                                *** ??
.,F533 4A       LSR             
.,F534 B0 03    BCS $F539       
.,F536 4C 13 F7 JMP $F713       else do 'illegal device number' and return
.,F539 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F53C B0 03    BCS $F541       if ??
.,F53E 4C 13 F7 JMP $F713       else do 'illegal device number' and return
.,F541 20 17 F8 JSR $F817       wait for PLAY
.,F544 B0 68    BCS $F5AE       exit if STOP was pressed
.,F546 20 AF F5 JSR $F5AF       print "Searching..."
.,F549 A5 B7    LDA $B7         get file name length
.,F54B F0 09    BEQ $F556       
.,F54D 20 EA F7 JSR $F7EA       find specific tape header
.,F550 90 0B    BCC $F55D       if no error continue
.,F552 F0 5A    BEQ $F5AE       exit if ??
.,F554 B0 DA    BCS $F530       , branch always
.,F556 20 2C F7 JSR $F72C       find tape header, exit with header in buffer
.,F559 F0 53    BEQ $F5AE       exit if ??
.,F55B B0 D3    BCS $F530       
.,F55D A5 90    LDA $90         get the serial status byte
.,F55F 29 10    AND #$10        mask 000x 0000, read error
.,F561 38       SEC             flag fail
.,F562 D0 4A    BNE $F5AE       if read error just exit
.,F564 E0 01    CPX #$01        
.,F566 F0 11    BEQ $F579       
.,F568 E0 03    CPX #$03        
.,F56A D0 DD    BNE $F549       
.,F56C A0 01    LDY #$01        
.,F56E B1 B2    LDA ($B2),Y     
.,F570 85 C3    STA $C3         
.,F572 C8       INY             
.,F573 B1 B2    LDA ($B2),Y     
.,F575 85 C4    STA $C4         
.,F577 B0 04    BCS $F57D       
.,F579 A5 B9    LDA $B9         get the secondary address
.,F57B D0 EF    BNE $F56C       
.,F57D A0 03    LDY #$03        
.,F57F B1 B2    LDA ($B2),Y     
.,F581 A0 01    LDY #$01        
.,F583 F1 B2    SBC ($B2),Y     
.,F585 AA       TAX             
.,F586 A0 04    LDY #$04        
.,F588 B1 B2    LDA ($B2),Y     
.,F58A A0 02    LDY #$02        
.,F58C F1 B2    SBC ($B2),Y     
.,F58E A8       TAY             
.,F58F 18       CLC             
.,F590 8A       TXA             
.,F591 65 C3    ADC $C3         
.,F593 85 AE    STA $AE         
.,F595 98       TYA             
.,F596 65 C4    ADC $C4         
.,F598 85 AF    STA $AF         
.,F59A A5 C3    LDA $C3         
.,F59C 85 C1    STA $C1         set I/O start addresses low byte
.,F59E A5 C4    LDA $C4         
.,F5A0 85 C2    STA $C2         set I/O start addresses high byte
.,F5A2 20 D2 F5 JSR $F5D2       display "LOADING" or "VERIFYING"
.,F5A5 20 4A F8 JSR $F84A       do the tape read
.:F5A8 24       .BYTE $24       makes next line BIT $18, keep the error flag in Cb
.,F5A9 18       CLC             flag ok
.,F5AA A6 AE    LDX $AE         get the LOAD end pointer low byte
.,F5AC A4 AF    LDY $AF         get the LOAD end pointer high byte
.,F5AE 60       RTS             

                                *** print "Searching..."
.,F5AF A5 9D    LDA $9D         get message mode flag
.,F5B1 10 1E    BPL $F5D1       exit if control messages off
.,F5B3 A0 0C    LDY #$0C        
                                index to "SEARCHING "
.,F5B5 20 2F F1 JSR $F12F       display kernel I/O message
.,F5B8 A5 B7    LDA $B7         get file name length
.,F5BA F0 15    BEQ $F5D1       exit if null name
.,F5BC A0 17    LDY #$17        
                                else index to "FOR "
.,F5BE 20 2F F1 JSR $F12F       display kernel I/O message

                                *** print file name
.,F5C1 A4 B7    LDY $B7         get file name length
.,F5C3 F0 0C    BEQ $F5D1       exit if null file name
.,F5C5 A0 00    LDY #$00        clear index
.,F5C7 B1 BB    LDA ($BB),Y     get file name byte
.,F5C9 20 D2 FF JSR $FFD2       output character to channel
.,F5CC C8       INY             increment index
.,F5CD C4 B7    CPY $B7         compare with file name length
.,F5CF D0 F6    BNE $F5C7       loop if more to do
.,F5D1 60       RTS             

                                *** display "LOADING" or "VERIFYING"
.,F5D2 A0 49    LDY #$49        
                                point to "LOADING"
.,F5D4 A5 93    LDA $93         get load/verify flag
.,F5D6 F0 02    BEQ $F5DA       branch if load
.,F5D8 A0 59    LDY #$59        
                                point to "VERIFYING"
.,F5DA 4C 2B F1 JMP $F12B       display kernel I/O message if in direct mode and return

                                *** save RAM to device, A = index to start address, XY = end address low/high
.,F5DD 86 AE    STX $AE         save end address low byte
.,F5DF 84 AF    STY $AF         save end address high byte
.,F5E1 AA       TAX             copy index to start pointer
.,F5E2 B5 00    LDA $00,X       get start address low byte
.,F5E4 85 C1    STA $C1         set I/O start addresses low byte
.,F5E6 B5 01    LDA $01,X       get start address high byte
.,F5E8 85 C2    STA $C2         set I/O start addresses high byte
.,F5EA 6C 32 03 JMP ($0332)     go save, usually points to $F685

                                *** save
.,F5ED A5 BA    LDA $BA         get the device number
.,F5EF D0 03    BNE $F5F4       if not keyboard go ??
                                else ..
.,F5F1 4C 13 F7 JMP $F713       else do 'illegal device number' and return
.,F5F4 C9 03    CMP #$03        compare device number with screen
.,F5F6 F0 F9    BEQ $F5F1       if screen do illegal device number and return
.,F5F8 90 5F    BCC $F659       branch if < screen
                                is greater than screen so is serial bus
.,F5FA A9 61    LDA #$61        set secondary address to $01
                                when a secondary address is to be sent to a device on
                                the serial bus the address must first be ORed with $60
.,F5FC 85 B9    STA $B9         save the secondary address
.,F5FE A4 B7    LDY $B7         get the file name length
.,F600 D0 03    BNE $F605       if filename not null continue
.,F602 4C 10 F7 JMP $F710       else do 'missing file name' error and return
.,F605 20 D5 F3 JSR $F3D5       send secondary address and filename
.,F608 20 8F F6 JSR $F68F       print saving <file name>
.,F60B A5 BA    LDA $BA         get the device number
.,F60D 20 0C ED JSR $ED0C       command devices on the serial bus to LISTEN
.,F610 A5 B9    LDA $B9         get the secondary address
.,F612 20 B9 ED JSR $EDB9       send secondary address after LISTEN
.,F615 A0 00    LDY #$00        clear index
.,F617 20 8E FB JSR $FB8E       copy I/O start address to buffer address
.,F61A A5 AC    LDA $AC         get buffer address low byte
.,F61C 20 DD ED JSR $EDDD       output byte to serial bus
.,F61F A5 AD    LDA $AD         get buffer address high byte
.,F621 20 DD ED JSR $EDDD       output byte to serial bus
.,F624 20 D1 FC JSR $FCD1       check read/write pointer, return Cb = 1 if pointer >= end
.,F627 B0 16    BCS $F63F       go do UNLISTEN if at end
.,F629 B1 AC    LDA ($AC),Y     get byte from buffer
.,F62B 20 DD ED JSR $EDDD       output byte to serial bus
.,F62E 20 E1 FF JSR $FFE1       scan stop key
.,F631 D0 07    BNE $F63A       if stop not pressed go increment pointer and loop for next
                                else ..
                                close the serial bus device and flag stop
.,F633 20 42 F6 JSR $F642       close serial bus device
.,F636 A9 00    LDA #$00        
.,F638 38       SEC             flag stop
.,F639 60       RTS             
.,F63A 20 DB FC JSR $FCDB       increment read/write pointer
.,F63D D0 E5    BNE $F624       loop, branch always
.,F63F 20 FE ED JSR $EDFE       command serial bus to UNLISTEN
                                close serial bus device
.,F642 24 B9    BIT $B9         test the secondary address
.,F644 30 11    BMI $F657       if already closed just exit
.,F646 A5 BA    LDA $BA         get the device number
.,F648 20 0C ED JSR $ED0C       command devices on the serial bus to LISTEN
.,F64B A5 B9    LDA $B9         get the secondary address
.,F64D 29 EF    AND #$EF        mask the channel number
.,F64F 09 E0    ORA #$E0        OR with the CLOSE command
.,F651 20 B9 ED JSR $EDB9       send secondary address after LISTEN
.,F654 20 FE ED JSR $EDFE       command serial bus to UNLISTEN
.,F657 18       CLC             flag ok
.,F658 60       RTS             
.,F659 4A       LSR             
.,F65A B0 03    BCS $F65F       if not RS232 device ??
.,F65C 4C 13 F7 JMP $F713       else do 'illegal device number' and return
.,F65F 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F662 90 8D    BCC $F5F1       if < $0200 do illegal device number and return
.,F664 20 38 F8 JSR $F838       wait for PLAY/RECORD
.,F667 B0 25    BCS $F68E       exit if STOP was pressed
.,F669 20 8F F6 JSR $F68F       print saving <file name>
.,F66C A2 03    LDX #$03        set header for a non relocatable program file
.,F66E A5 B9    LDA $B9         get the secondary address
.,F670 29 01    AND #$01        mask non relocatable bit
.,F672 D0 02    BNE $F676       if non relocatable program go ??
.,F674 A2 01    LDX #$01        else set header for a relocatable program file
.,F676 8A       TXA             copy header type to A
.,F677 20 6A F7 JSR $F76A       write tape header
.,F67A B0 12    BCS $F68E       exit if error
.,F67C 20 67 F8 JSR $F867       do tape write, 20 cycle count
.,F67F B0 0D    BCS $F68E       exit if error
.,F681 A5 B9    LDA $B9         get the secondary address
.,F683 29 02    AND #$02        mask end of tape flag
.,F685 F0 06    BEQ $F68D       if not end of tape go ??
.,F687 A9 05    LDA #$05        else set logical end of the tape
.,F689 20 6A F7 JSR $F76A       write tape header
.:F68C 24       .BYTE $24       makes next line BIT $18 so Cb is not changed
.,F68D 18       CLC             flag ok
.,F68E 60       RTS             

                                *** print saving <file name>
.,F68F A5 9D    LDA $9D         get message mode flag
.,F691 10 FB    BPL $F68E       exit if control messages off
.,F693 A0 51    LDY #$51        
                                index to "SAVING "
.,F695 20 2F F1 JSR $F12F       display kernel I/O message
.,F698 4C C1 F5 JMP $F5C1       print file name and return

                                *** increment the real time clock
.,F69B A2 00    LDX #$00        clear X
.,F69D E6 A2    INC $A2         increment the jiffy clock low byte
.,F69F D0 06    BNE $F6A7       if no rollover ??
.,F6A1 E6 A1    INC $A1         increment the jiffy clock mid byte
.,F6A3 D0 02    BNE $F6A7       branch if no rollover
.,F6A5 E6 A0    INC $A0         increment the jiffy clock high byte
                                now subtract a days worth of jiffies from current count
                                and remember only the Cb result
.,F6A7 38       SEC             set carry for subtract
.,F6A8 A5 A2    LDA $A2         get the jiffy clock low byte
.,F6AA E9 01    SBC #$01        subtract $4F1A01 low byte
.,F6AC A5 A1    LDA $A1         get the jiffy clock mid byte
.,F6AE E9 1A    SBC #$1A        subtract $4F1A01 mid byte
.,F6B0 A5 A0    LDA $A0         get the jiffy clock high byte
.,F6B2 E9 4F    SBC #$4F        subtract $4F1A01 high byte
.,F6B4 90 06    BCC $F6BC       if less than $4F1A01 jiffies skip the clock reset
                                else ..
.,F6B6 86 A0    STX $A0         clear the jiffy clock high byte
.,F6B8 86 A1    STX $A1         clear the jiffy clock mid byte
.,F6BA 86 A2    STX $A2         clear the jiffy clock low byte
                                this is wrong, there are $4F1A00 jiffies in a day so
                                the reset to zero should occur when the value reaches
                                $4F1A00 and not $4F1A01. this would give an extra jiffy
                                every day and a possible TI value of 24:00:00
.,F6BC AD 01 DC LDA $DC01       read VIA 1 DRB, keyboard row port
.,F6BF CD 01 DC CMP $DC01       compare it with itself
.,F6C2 D0 F8    BNE $F6BC       loop if changing
.,F6C4 AA       TAX             
.,F6C5 30 13    BMI $F6DA       
.,F6C7 A2 BD    LDX #$BD        set c6
.,F6C9 8E 00 DC STX $DC00       save VIA 1 DRA, keyboard column drive
.,F6CC AE 01 DC LDX $DC01       read VIA 1 DRB, keyboard row port
.,F6CF EC 01 DC CPX $DC01       compare it with itself
.,F6D2 D0 F8    BNE $F6CC       loop if changing
.,F6D4 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,F6D7 E8       INX             
.,F6D8 D0 02    BNE $F6DC       
.,F6DA 85 91    STA $91         save the stop key column
.,F6DC 60       RTS             

                                *** read the real time clock
.,F6DD 78       SEI             disable the interrupts
.,F6DE A5 A2    LDA $A2         get the jiffy clock low byte
.,F6E0 A6 A1    LDX $A1         get the jiffy clock mid byte
.,F6E2 A4 A0    LDY $A0         get the jiffy clock high byte

                                *** set the real time clock
.,F6E4 78       SEI             disable the interrupts
.,F6E5 85 A2    STA $A2         save the jiffy clock low byte
.,F6E7 86 A1    STX $A1         save the jiffy clock mid byte
.,F6E9 84 A0    STY $A0         save the jiffy clock high byte
.,F6EB 58       CLI             enable the interrupts
.,F6EC 60       RTS             

                                *** scan the stop key, return Zb = 1 = [STOP]
.,F6ED A5 91    LDA $91         read the stop key column
.,F6EF C9 7F    CMP #$7F        compare with [STP] down
.,F6F1 D0 07    BNE $F6FA       if not [STP] or not just [STP] exit
                                just [STP] was pressed
.,F6F3 08       PHP             save status
.,F6F4 20 CC FF JSR $FFCC       close input and output channels
.,F6F7 85 C6    STA $C6         save the keyboard buffer index
.,F6F9 28       PLP             restore status
.,F6FA 60       RTS             

                                *** file error messages
.,F6FB A9 01    LDA #$01        'too many files' error
.:F6FD 2C       .BYTE $2C       makes next line BIT $02A9
.,F6FE A9 02    LDA #$02        'file already open' error
.:F700 2C       .BYTE $2C       makes next line BIT $03A9
.,F701 A9 03    LDA #$03        'file not open' error
.:F703 2C       .BYTE $2C       makes next line BIT $04A9
.,F704 A9 04    LDA #$04        'file not found' error
.:F706 2C       .BYTE $2C       makes next line BIT $05A9
.,F707 A9 05    LDA #$05        'device not present' error
.:F709 2C       .BYTE $2C       makes next line BIT $06A9
.,F70A A9 06    LDA #$06        'not input file' error
.:F70C 2C       .BYTE $2C       makes next line BIT $07A9
.,F70D A9 07    LDA #$07        'not output file' error
.:F70F 2C       .BYTE $2C       makes next line BIT $08A9
.,F710 A9 08    LDA #$08        'missing file name' error
.:F712 2C       .BYTE $2C       makes next line BIT $09A9
.,F713 A9 09    LDA #$09        do 'illegal device number'
.,F715 48       PHA             save the error #
.,F716 20 CC FF JSR $FFCC       close input and output channels
.,F719 A0 00    LDY #$00
                                index to "I/O ERROR #"
.,F71B 24 9D    BIT $9D         test message mode flag
.,F71D 50 0A    BVC $F729       exit if kernal messages off
.,F71F 20 2F F1 JSR $F12F       display kernel I/O message
.,F722 68       PLA             restore error #
.,F723 48       PHA             copy error #
.,F724 09 30    ORA #$30        convert to ASCII
.,F726 20 D2 FF JSR $FFD2       output character to channel
.,F729 68       PLA             pull error number
.,F72A 38       SEC             flag error
.,F72B 60       RTS             

                                *** find the tape header, exit with header in buffer
.,F72C A5 93    LDA $93         get load/verify flag
.,F72E 48       PHA             save load/verify flag
.,F72F 20 41 F8 JSR $F841       initiate tape read
.,F732 68       PLA             restore load/verify flag
.,F733 85 93    STA $93         save load/verify flag
.,F735 B0 32    BCS $F769       exit if error
.,F737 A0 00    LDY #$00        clear the index
.,F739 B1 B2    LDA ($B2),Y     read first byte from tape buffer
.,F73B C9 05    CMP #$05        compare with logical end of the tape
.,F73D F0 2A    BEQ $F769       if end of the tape exit
.,F73F C9 01    CMP #$01        compare with header for a relocatable program file
.,F741 F0 08    BEQ $F74B       if program file header go ??
.,F743 C9 03    CMP #$03        compare with header for a non relocatable program file
.,F745 F0 04    BEQ $F74B       if program file header go  ??
.,F747 C9 04    CMP #$04        compare with data file header
.,F749 D0 E1    BNE $F72C       if data file loop to find the tape header
                                was a program file header
.,F74B AA       TAX             copy header type
.,F74C 24 9D    BIT $9D         get message mode flag
.,F74E 10 17    BPL $F767       exit if control messages off
.,F750 A0 63    LDY #$63        
                                index to "FOUND "
.,F752 20 2F F1 JSR $F12F       display kernel I/O message
.,F755 A0 05    LDY #$05        index to the tape filename
.,F757 B1 B2    LDA ($B2),Y     get byte from tape buffer
.,F759 20 D2 FF JSR $FFD2       output character to channel
.,F75C C8       INY             increment the index
.,F75D C0 15    CPY #$15        compare it with end+1
.,F75F D0 F6    BNE $F757       loop if more to do
.,F761 A5 A1    LDA $A1         get the jiffy clock mid byte
.,F763 20 E0 E4 JSR $E4E0       wait ~8.5 seconds for any key from the STOP key column
.,F766 EA       NOP             waste cycles
.,F767 18       CLC             flag no error
.,F768 88       DEY             decrement the index
.,F769 60       RTS             

                                *** write the tape header
.,F76A 85 9E    STA $9E         save header type
.,F76C 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F76F 90 5E    BCC $F7CF       if < $0200 just exit ??
.,F771 A5 C2    LDA $C2         get I/O start address high byte
.,F773 48       PHA             save it
.,F774 A5 C1    LDA $C1         get I/O start address low byte
.,F776 48       PHA             save it
.,F777 A5 AF    LDA $AF         get tape end address high byte
.,F779 48       PHA             save it
.,F77A A5 AE    LDA $AE         get tape end address low byte
.,F77C 48       PHA             save it
.,F77D A0 BF    LDY #$BF        index to header end
.,F77F A9 20    LDA #$20        clear byte, [SPACE]
.,F781 91 B2    STA ($B2),Y     clear header byte
.,F783 88       DEY             decrement index
.,F784 D0 FB    BNE $F781       loop if more to do
.,F786 A5 9E    LDA $9E         get the header type back
.,F788 91 B2    STA ($B2),Y     write it to header
.,F78A C8       INY             increment the index
.,F78B A5 C1    LDA $C1         get the I/O start address low byte
.,F78D 91 B2    STA ($B2),Y     write it to header
.,F78F C8       INY             increment the index
.,F790 A5 C2    LDA $C2         get the I/O start address high byte
.,F792 91 B2    STA ($B2),Y     write it to header
.,F794 C8       INY             increment the index
.,F795 A5 AE    LDA $AE         get the tape end address low byte
.,F797 91 B2    STA ($B2),Y     write it to header
.,F799 C8       INY             increment the index
.,F79A A5 AF    LDA $AF         get the tape end address high byte
.,F79C 91 B2    STA ($B2),Y     write it to header
.,F79E C8       INY             increment the index
.,F79F 84 9F    STY $9F         save the index
.,F7A1 A0 00    LDY #$00        clear Y
.,F7A3 84 9E    STY $9E         clear the name index
.,F7A5 A4 9E    LDY $9E         get name index
.,F7A7 C4 B7    CPY $B7         compare with file name length
.,F7A9 F0 0C    BEQ $F7B7       if all done exit the loop
.,F7AB B1 BB    LDA ($BB),Y     get file name byte
.,F7AD A4 9F    LDY $9F         get buffer index
.,F7AF 91 B2    STA ($B2),Y     save file name byte to buffer
.,F7B1 E6 9E    INC $9E         increment file name index
.,F7B3 E6 9F    INC $9F         increment tape buffer index
.,F7B5 D0 EE    BNE $F7A5       loop, branch always
.,F7B7 20 D7 F7 JSR $F7D7       set tape buffer start and end pointers
.,F7BA A9 69    LDA #$69set write lead cycle count
.,F7BC 85 AB    STA $AB         save write lead cycle count
.,F7BE 20 6B F8 JSR $F86B       do tape write, no cycle count set
.,F7C1 A8       TAY             
.,F7C2 68       PLA             pull tape end address low byte
.,F7C3 85 AE    STA $AE         restore it
.,F7C5 68       PLA             pull tape end address high byte
.,F7C6 85 AF    STA $AF         restore it
.,F7C8 68       PLA             pull I/O start addresses low byte
.,F7C9 85 C1    STA $C1         restore it
.,F7CB 68       PLA             pull I/O start addresses high byte
.,F7CC 85 C2    STA $C2         restore it
.,F7CE 98       TYA             
.,F7CF 60       RTS             

                                *** get the tape buffer start pointer
.,F7D0 A6 B2    LDX $B2         get tape buffer start pointer low byte
.,F7D2 A4 B3    LDY $B3         get tape buffer start pointer high byte
.,F7D4 C0 02    CPY #$02        compare high byte with $02xx
.,F7D6 60       RTS             

                                *** set the tape buffer start and end pointers
.,F7D7 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F7DA 8A       TXA             copy tape buffer start pointer low byte
.,F7DB 85 C1    STA $C1         save as I/O address pointer low byte
.,F7DD 18       CLC             clear carry for add
.,F7DE 69 C0    ADC #$C0        add buffer length low byte
.,F7E0 85 AE    STA $AE         save tape buffer end pointer low byte
.,F7E2 98       TYA             copy tape buffer start pointer high byte
.,F7E3 85 C2    STA $C2         save as I/O address pointer high byte
.,F7E5 69 00    ADC #$00        add buffer length high byte
.,F7E7 85 AF    STA $AF         save tape buffer end pointer high byte
.,F7E9 60       RTS             

                                *** find specific tape header
.,F7EA 20 2C F7 JSR $F72C       find tape header, exit with header in buffer
.,F7ED B0 1D    BCS $F80C       just exit if error
.,F7EF A0 05    LDY #$05        index to name
.,F7F1 84 9F    STY $9F         save as tape buffer index
.,F7F3 A0 00    LDY #$00        clear Y
.,F7F5 84 9E    STY $9E         save as name buffer index
.,F7F7 C4 B7    CPY $B7         compare with file name length
.,F7F9 F0 10    BEQ $F80B       ok exit if match
.,F7FB B1 BB    LDA ($BB),Y     get file name byte
.,F7FD A4 9F    LDY $9F         get index to tape buffer
.,F7FF D1 B2    CMP ($B2),Y     compare with tape header name byte
.,F801 D0 E7    BNE $F7EA       if no match go get next header
.,F803 E6 9E    INC $9E         else increment name buffer index
.,F805 E6 9F    INC $9F         increment tape buffer index
.,F807 A4 9E    LDY $9E         get name buffer index
.,F809 D0 EC    BNE $F7F7       loop, branch always
.,F80B 18       CLC             flag ok
.,F80C 60       RTS             

                                *** bump tape pointer
.,F80D 20 D0 F7 JSR $F7D0       get tape buffer start pointer in XY
.,F810 E6 A6    INC $A6         increment tape buffer index
.,F812 A4 A6    LDY $A6         get tape buffer index
.,F814 C0 C0    CPY #$C0        compare with buffer length
.,F816 60       RTS             

                                *** wait for PLAY
.,F817 20 2E F8 JSR $F82E       return cassette sense in Zb
.,F81A F0 1A    BEQ $F836       if switch closed just exit
                                cassette switch was open
.,F81C A0 1B    LDY #$1B        
                                index to "PRESS PLAY ON TAPE"
.,F81E 20 2F F1 JSR $F12F       display kernel I/O message
.,F821 20 D0 F8 JSR $F8D0       scan stop key and flag abort if pressed
                                note if STOP was pressed the return is to the
                                routine that called this one and not here
.,F824 20 2E F8 JSR $F82E       return cassette sense in Zb
.,F827 D0 F8    BNE $F821       loop if the cassette switch is open
.,F829 A0 6A    LDY #$6A        
                                index to "OK"
.,F82B 4C 2F F1 JMP $F12F       display kernel I/O message and return

                                *** return cassette sense in Zb
.,F82E A9 10    LDA #$10        set the mask for the cassette switch
.,F830 24 01    BIT $01         test the 6510 I/O port
.,F832 D0 02    BNE $F836       branch if cassette sense high
.,F834 24 01    BIT $01         test the 6510 I/O port
.,F836 18       CLC             
.,F837 60       RTS             

                                *** wait for PLAY/RECORD
.,F838 20 2E F8 JSR $F82E       return the cassette sense in Zb
.,F83B F0 F9    BEQ $F836       exit if switch closed
                                cassette switch was open
.,F83D A0 2E    LDY #$2E        
                                index to "PRESS RECORD & PLAY ON TAPE"
.,F83F D0 DD    BNE $F81E       display message and wait for switch, branch always

                                *** initiate a tape read
.,F841 A9 00    LDA #$00        clear A
.,F843 85 90    STA $90         clear serial status byte
.,F845 85 93    STA $93         clear the load/verify flag
.,F847 20 D7 F7 JSR $F7D7       set the tape buffer start and end pointers
.,F84A 20 17 F8 JSR $F817       wait for PLAY
.,F84D B0 1F    BCS $F86E       exit if STOP was pressed, uses a further BCS at the
                                target address to reach final target at $F8DC
.,F84F 78       SEI             disable interrupts
.,F850 A9 00    LDA #$00        clear A
.,F852 85 AA    STA $AA         
.,F854 85 B4    STA $B4         
.,F856 85 B0    STA $B0         clear tape timing constant min byte
.,F858 85 9E    STA $9E         clear tape pass 1 error log/char buffer
.,F85A 85 9F    STA $9F         clear tape pass 2 error log corrected
.,F85C 85 9C    STA $9C         clear byte received flag
.,F85E A9 90    LDA #$90        enable CA1 interrupt ??
.,F860 A2 0E    LDX #$0E        set index for tape read vector
.,F862 D0 11    BNE $F875       go do tape read/write, branch always

                                *** initiate a tape write
.,F864 20 D7 F7 JSR $F7D7       set tape buffer start and end pointers
                                do tape write, 20 cycle count
.,F867 A9 14    LDA #$14        set write lead cycle count
.,F869 85 AB    STA $AB         save write lead cycle count
                                do tape write, no cycle count set
.,F86B 20 38 F8 JSR $F838       wait for PLAY/RECORD
.,F86E B0 6C    BCS $F8DC       if STOPped clear save IRQ address and exit
.,F870 78       SEI             disable interrupts
.,F871 A9 82    LDA #$82        enable ?? interrupt
.,F873 A2 08    LDX #$08        set index for tape write tape leader vector

                                *** tape read/write
.,F875 A0 7F    LDY #$7F        disable all interrupts
.,F877 8C 0D DC STY $DC0D       save VIA 1 ICR, disable all interrupts
.,F87A 8D 0D DC STA $DC0D       save VIA 1 ICR, enable interrupts according to A
                                check RS232 bus idle
.,F87D AD 0E DC LDA $DC0E       read VIA 1 CRA
.,F880 09 19    ORA #$19        load timer B, timer B single shot, start timer B
.,F882 8D 0F DC STA $DC0F       save VIA 1 CRB
.,F885 29 91    AND #$91        mask x00x 000x, TOD clock, load timer A, start timer A
.,F887 8D A2 02 STA $02A2       save VIA 1 CRB shadow copy
.,F88A 20 A4 F0 JSR $F0A4       
.,F88D AD 11 D0 LDA $D011       read the vertical fine scroll and control register
.,F890 29 EF    AND #$EF        mask xxx0 xxxx, blank the screen
.,F892 8D 11 D0 STA $D011       save the vertical fine scroll and control register
.,F895 AD 14 03 LDA $0314       get IRQ vector low byte
.,F898 8D 9F 02 STA $029F       save IRQ vector low byte
.,F89B AD 15 03 LDA $0315       get IRQ vector high byte
.,F89E 8D A0 02 STA $02A0       save IRQ vector high byte
.,F8A1 20 BD FC JSR $FCBD       set the tape vector
.,F8A4 A9 02    LDA #$02        set copies count. the first copy is the load copy, the
                                second copy is the verify copy
.,F8A6 85 BE    STA $BE         save copies count
.,F8A8 20 97 FB JSR $FB97       new tape byte setup
.,F8AB A5 01    LDA $01         read the 6510 I/O port
.,F8AD 29 1F    AND #$1F        mask 000x xxxx, cassette motor on ??
.,F8AF 85 01    STA $01         save the 6510 I/O port
.,F8B1 85 C0    STA $C0         set the tape motor interlock
                                326656 cycle delay, allow tape motor speed to stabilise
.,F8B3 A2 FF    LDX #$FF        outer loop count
.,F8B5 A0 FF    LDY #$FF        inner loop count
.,F8B7 88       DEY             decrement inner loop count
.,F8B8 D0 FD    BNE $F8B7       loop if more to do
.,F8BA CA       DEX             decrement outer loop count
.,F8BB D0 F8    BNE $F8B5       loop if more to do
.,F8BD 58       CLI             enable tape interrupts
.,F8BE AD A0 02 LDA $02A0       get saved IRQ high byte
.,F8C1 CD 15 03 CMP $0315       compare with the current IRQ high byte
.,F8C4 18       CLC             flag ok
.,F8C5 F0 15    BEQ $F8DC       if tape write done go clear saved IRQ address and exit
.,F8C7 20 D0 F8 JSR $F8D0       scan stop key and flag abort if pressed
                                note if STOP was pressed the return is to the
                                routine that called this one and not here
.,F8CA 20 BC F6 JSR $F6BC       increment real time clock
.,F8CD 4C BE F8 JMP $F8BE       loop

                                *** scan stop key and flag abort if pressed
.,F8D0 20 E1 FF JSR $FFE1       scan stop key
.,F8D3 18       CLC             flag no stop
.,F8D4 D0 0B    BNE $F8E1       exit if no stop
.,F8D6 20 93 FC JSR $FC93       restore everything for STOP
.,F8D9 38       SEC             flag stopped
.,F8DA 68       PLA             dump return address low byte
.,F8DB 68       PLA             dump return address high byte

                                *** clear saved IRQ address
.,F8DC A9 00    LDA #$00        clear A
.,F8DE 8D A0 02 STA $02A0       clear saved IRQ address high byte
.,F8E1 60       RTS             

                                *** # set timing
.,F8E2 86 B1    STX $B1         save tape timing constant max byte
.,F8E4 A5 B0    LDA $B0         get tape timing constant min byte
.,F8E6 0A       ASL             *2
.,F8E7 0A       ASL             *4
.,F8E8 18       CLC             clear carry for add
.,F8E9 65 B0    ADC $B0         add tape timing constant min byte *5
.,F8EB 18       CLC             clear carry for add
.,F8EC 65 B1    ADC $B1         add tape timing constant max byte
.,F8EE 85 B1    STA $B1         save tape timing constant max byte
.,F8F0 A9 00    LDA #$00        
.,F8F2 24 B0    BIT $B0         test tape timing constant min byte
.,F8F4 30 01    BMI $F8F7       branch if b7 set
.,F8F6 2A       ROL             else shift carry into ??
.,F8F7 06 B1    ASL $B1         shift tape timing constant max byte
.,F8F9 2A       ROL             
.,F8FA 06 B1    ASL $B1         shift tape timing constant max byte
.,F8FC 2A       ROL             
.,F8FD AA       TAX             
.,F8FE AD 06 DC LDA $DC06       get VIA 1 timer B low byte
.,F901 C9 16    CMP #$16        compare with ??
.,F903 90 F9    BCC $F8FE       loop if less
.,F905 65 B1    ADC $B1         add tape timing constant max byte
.,F907 8D 04 DC STA $DC04       save VIA 1 timer A low byte
.,F90A 8A       TXA             
.,F90B 6D 07 DC ADC $DC07       add VIA 1 timer B high byte
.,F90E 8D 05 DC STA $DC05       save VIA 1 timer A high byte
.,F911 AD A2 02 LDA $02A2       read VIA 1 CRB shadow copy
.,F914 8D 0E DC STA $DC0E       save VIA 1 CRA
.,F917 8D A4 02 STA $02A4       save VIA 1 CRA shadow copy
.,F91A AD 0D DC LDA $DC0D       read VIA 1 ICR
.,F91D 29 10    AND #$10        mask 000x 0000, FLAG interrupt
.,F91F F0 09    BEQ $F92A       if no FLAG interrupt just exit
                                else first call the IRQ routine
.,F921 A9 F9    LDA #$F9        set the return address high byte
.,F923 48       PHA             push the return address high byte
.,F924 A9 2A    LDA #$2A        set the return address low byte
.,F926 48       PHA             push the return address low byte
.,F927 4C 43 FF JMP $FF43       save the status and do the IRQ routine
.,F92A 58       CLI             enable interrupts
.,F92B 60       RTS             

                                *** On Commodore computers, the streams consist of four kinds of symbols
                                that denote different kinds of low-to-high-to-low transitions on the
                                read or write signals of the Commodore cassette interface.
                                
                                A A break in the communications, or a pulse with very long cycle
                                  time.
                                
                                B A short pulse, whose cycle time typically ranges from 296 to 424
                                  microseconds, depending on the computer model.
                                
                                C A medium-length pulse, whose cycle time typically ranges from
                                  440 to 576 microseconds, depending on the computer model.
                                
                                D A long pulse, whose cycle time typically ranges from 600 to 744
                                  microseconds, depending on the computer model.
                                
                                 The actual interpretation of the serial data takes a little more work to explain.
                                The typical ROM tape loader (and the turbo loaders) will initialize a timer with a
                                specified value and start it counting down. If either the tape data changes or the
                                timer runs out, an IRQ will occur. The loader will determine which condition caused
                                the IRQ. If the tape data changed before the timer ran out, we have a short pulse,
                                or a "0" bit. If the timer ran out first, we have a long pulse, or a "1" bit. Doing
                                this continuously and we decode the entire file.
                                read tape bits, IRQ routine
                                read T2C which has been counting down from $FFFF. subtract this from $FFFF
.,F92C AE 07 DC LDX $DC07       read VIA 1 timer B high byte
.,F92F A0 FF    LDY #$FF        set $FF
.,F931 98       TYA             A = $FF
.,F932 ED 06 DC SBC $DC06       subtract VIA 1 timer B low byte
.,F935 EC 07 DC CPX $DC07       compare it with VIA 1 timer B high byte
.,F938 D0 F2    BNE $F92C       if timer low byte rolled over loop
.,F93A 86 B1    STX $B1         save tape timing constant max byte
.,F93C AA       TAX             copy $FF - T2C_l
.,F93D 8C 06 DC STY $DC06       save VIA 1 timer B low byte
.,F940 8C 07 DC STY $DC07       save VIA 1 timer B high byte
.,F943 A9 19    LDA #$19        load timer B, timer B single shot, start timer B
.,F945 8D 0F DC STA $DC0F       save VIA 1 CRB
.,F948 AD 0D DC LDA $DC0D       read VIA 1 ICR
.,F94B 8D A3 02 STA $02A3       save VIA 1 ICR shadow copy
.,F94E 98       TYA             y = $FF
.,F94F E5 B1    SBC $B1         subtract tape timing constant max byte
                                A = $FF - T2C_h
.,F951 86 B1    STX $B1         save tape timing constant max byte
                                $B1 = $FF - T2C_l
.,F953 4A       LSR             A = $FF - T2C_h >> 1
.,F954 66 B1    ROR $B1         shift tape timing constant max byte
                                $B1 = $FF - T2C_l >> 1
.,F956 4A       LSR             A = $FF - T2C_h >> 1
.,F957 66 B1    ROR $B1         shift tape timing constant max byte
                                $B1 = $FF - T2C_l >> 1
.,F959 A5 B0    LDA $B0         get tape timing constant min byte
.,F95B 18       CLC             clear carry for add
.,F95C 69 3C    ADC #$3C        
.,F95E C5 B1    CMP $B1         compare with tape timing constant max byte
                                compare with ($FFFF - T2C) >> 2
.,F960 B0 4A    BCS $F9AC       branch if min + $3C >= ($FFFF - T2C) >> 2
                                min + $3C < ($FFFF - T2C) >> 2
.,F962 A6 9C    LDX $9C         get byte received flag
.,F964 F0 03    BEQ $F969        if not byte received ??
.,F966 4C 60 FA JMP $FA60       store the tape character
.,F969 A6 A3    LDX $A3         get EOI flag byte
.,F96B 30 1B    BMI $F988       
.,F96D A2 00    LDX #$00        
.,F96F 69 30    ADC #$30        
.,F971 65 B0    ADC $B0         add tape timing constant min byte
.,F973 C5 B1    CMP $B1         compare with tape timing constant max byte
.,F975 B0 1C    BCS $F993       
.,F977 E8       INX             
.,F978 69 26    ADC #$26        
.,F97A 65 B0    ADC $B0         add tape timing constant min byte
.,F97C C5 B1    CMP $B1         compare with tape timing constant max byte
.,F97E B0 17    BCS $F997       
.,F980 69 2C    ADC #$2C        
.,F982 65 B0    ADC $B0         add tape timing constant min byte
.,F984 C5 B1    CMP $B1         compare with tape timing constant max byte
.,F986 90 03    BCC $F98B       
.,F988 4C 10 FA JMP $FA10       
.,F98B A5 B4    LDA $B4         get the bit count
.,F98D F0 1D    BEQ $F9AC       if all done go ??
.,F98F 85 A8    STA $A8         save receiver bit count in
.,F991 D0 19    BNE $F9AC       branch always
.,F993 E6 A9    INC $A9         increment ?? start bit check flag
.,F995 B0 02    BCS $F999       
.,F997 C6 A9    DEC $A9         decrement ?? start bit check flag
.,F999 38       SEC             
.,F99A E9 13    SBC #$13        
.,F99C E5 B1    SBC $B1         subtract tape timing constant max byte
.,F99E 65 92    ADC $92         add timing constant for tape
.,F9A0 85 92    STA $92         save timing constant for tape
.,F9A2 A5 A4    LDA $A4         get tape bit cycle phase
.,F9A4 49 01    EOR #$01        
.,F9A6 85 A4    STA $A4         save tape bit cycle phase
.,F9A8 F0 2B    BEQ $F9D5       
.,F9AA 86 D7    STX $D7         
.,F9AC A5 B4    LDA $B4         get the bit count
.,F9AE F0 22    BEQ $F9D2       if all done go ??
.,F9B0 AD A3 02 LDA $02A3       read VIA 1 ICR shadow copy
.,F9B3 29 01    AND #$01        mask 0000 000x, timer A interrupt enabled
.,F9B5 D0 05    BNE $F9BC       if timer A is enabled go ??
.,F9B7 AD A4 02 LDA $02A4       read VIA 1 CRA shadow copy
.,F9BA D0 16    BNE $F9D2       if ?? just exit
.,F9BC A9 00    LDA #$00        clear A
.,F9BE 85 A4    STA $A4         clear the tape bit cycle phase
.,F9C0 8D A4 02 STA $02A4       save VIA 1 CRA shadow copy
.,F9C3 A5 A3    LDA $A3         get EOI flag byte
.,F9C5 10 30    BPL $F9F7       
.,F9C7 30 BF    BMI $F988       
.,F9C9 A2 A6    LDX #$A6        set timimg max byte
.,F9CB 20 E2 F8 JSR $F8E2       set timing
.,F9CE A5 9B    LDA $9B         
.,F9D0 D0 B9    BNE $F98B       
.,F9D2 4C BC FE JMP $FEBC       restore registers and exit interrupt
.,F9D5 A5 92    LDA $92         get timing constant for tape
.,F9D7 F0 07    BEQ $F9E0       
.,F9D9 30 03    BMI $F9DE       
.,F9DB C6 B0    DEC $B0         decrement tape timing constant min byte
.:F9DD 2C       .BYTE $2C       makes next line BIT $B0E6
.,F9DE E6 B0    INC $B0         increment tape timing constant min byte
.,F9E0 A9 00    LDA #$00        
.,F9E2 85 92    STA $92         clear timing constant for tape
.,F9E4 E4 D7    CPX $D7         
.,F9E6 D0 0F    BNE $F9F7       
.,F9E8 8A       TXA             
.,F9E9 D0 A0    BNE $F98B       
.,F9EB A5 A9    LDA $A9         get start bit check flag
.,F9ED 30 BD    BMI $F9AC       
.,F9EF C9 10    CMP #$10        
.,F9F1 90 B9    BCC $F9AC       
.,F9F3 85 96    STA $96         save cassette block synchronization number
.,F9F5 B0 B5    BCS $F9AC       
.,F9F7 8A       TXA             
.,F9F8 45 9B    EOR $9B         
.,F9FA 85 9B    STA $9B         
.,F9FC A5 B4    LDA $B4         
.,F9FE F0 D2    BEQ $F9D2       
.,FA00 C6 A3    DEC $A3         decrement EOI flag byte
.,FA02 30 C5    BMI $F9C9       
.,FA04 46 D7    LSR $D7         
.,FA06 66 BF    ROR $BF         parity count
.,FA08 A2 DA    LDX #$DA        set timimg max byte
.,FA0A 20 E2 F8 JSR $F8E2       set timing
.,FA0D 4C BC FE JMP $FEBC       restore registers and exit interrupt
.,FA10 A5 96    LDA $96         get cassette block synchronization number
.,FA12 F0 04    BEQ $FA18       
.,FA14 A5 B4    LDA $B4         
.,FA16 F0 07    BEQ $FA1F       
.,FA18 A5 A3    LDA $A3         get EOI flag byte
.,FA1A 30 03    BMI $FA1F       
.,FA1C 4C 97 F9 JMP $F997       
.,FA1F 46 B1    LSR $B1         shift tape timing constant max byte
.,FA21 A9 93    LDA #$93        
.,FA23 38       SEC             
.,FA24 E5 B1    SBC $B1         subtract tape timing constant max byte
.,FA26 65 B0    ADC $B0         add tape timing constant min byte
.,FA28 0A       ASL             
.,FA29 AA       TAX             copy timimg high byte
.,FA2A 20 E2 F8 JSR $F8E2       set timing
.,FA2D E6 9C    INC $9C         
.,FA2F A5 B4    LDA $B4         
.,FA31 D0 11    BNE $FA44       
.,FA33 A5 96    LDA $96         get cassette block synchronization number
.,FA35 F0 26    BEQ $FA5D       
.,FA37 85 A8    STA $A8         save receiver bit count in
.,FA39 A9 00    LDA #$00        clear A
.,FA3B 85 96    STA $96         clear cassette block synchronization number
.,FA3D A9 81    LDA #$81        enable timer A interrupt
.,FA3F 8D 0D DC STA $DC0D       save VIA 1 ICR
.,FA42 85 B4    STA $B4         
.,FA44 A5 96    LDA $96         get cassette block synchronization number
.,FA46 85 B5    STA $B5         
.,FA48 F0 09    BEQ $FA53       
.,FA4A A9 00    LDA #$00        
.,FA4C 85 B4    STA $B4         
.,FA4E A9 01    LDA #$01        disable timer A interrupt
.,FA50 8D 0D DC STA $DC0D       save VIA 1 ICR
.,FA53 A5 BF    LDA $BF         parity count
.,FA55 85 BD    STA $BD         save RS232 parity byte
.,FA57 A5 A8    LDA $A8         get receiver bit count in
.,FA59 05 A9    ORA $A9         OR with start bit check flag
.,FA5B 85 B6    STA $B6         
.,FA5D 4C BC FE JMP $FEBC       restore registers and exit interrupt

                                *** # store character
.,FA60 20 97 FB JSR $FB97       new tape byte setup
.,FA63 85 9C    STA $9C         clear byte received flag
.,FA65 A2 DA    LDX #$DA        set timimg max byte
.,FA67 20 E2 F8 JSR $F8E2       set timing
.,FA6A A5 BE    LDA $BE         get copies count
.,FA6C F0 02    BEQ $FA70       
.,FA6E 85 A7    STA $A7         save receiver input bit temporary storage
.,FA70 A9 0F    LDA #$0F        
.,FA72 24 AA    BIT $AA         
.,FA74 10 17    BPL $FA8D       
.,FA76 A5 B5    LDA $B5         
.,FA78 D0 0C    BNE $FA86       
.,FA7A A6 BE    LDX $BE         get copies count
.,FA7C CA       DEX             
.,FA7D D0 0B    BNE $FA8A       if ?? restore registers and exit interrupt
.,FA7F A9 08    LDA #$08        set short block
.,FA81 20 1C FE JSR $FE1C       OR into serial status byte
.,FA84 D0 04    BNE $FA8A       restore registers and exit interrupt, branch always
.,FA86 A9 00    LDA #$00        
.,FA88 85 AA    STA $AA         
.,FA8A 4C BC FE JMP $FEBC       restore registers and exit interrupt
.,FA8D 70 31    BVS $FAC0       
.,FA8F D0 18    BNE $FAA9       
.,FA91 A5 B5    LDA $B5         
.,FA93 D0 F5    BNE $FA8A       
.,FA95 A5 B6    LDA $B6         
.,FA97 D0 F1    BNE $FA8A       
.,FA99 A5 A7    LDA $A7         get receiver input bit temporary storage
.,FA9B 4A       LSR             
.,FA9C A5 BD    LDA $BD         get RS232 parity byte
.,FA9E 30 03    BMI $FAA3       
.,FAA0 90 18    BCC $FABA       
.,FAA2 18       CLC             
.,FAA3 B0 15    BCS $FABA       
.,FAA5 29 0F    AND #$0F        
.,FAA7 85 AA    STA $AA         
.,FAA9 C6 AA    DEC $AA         
.,FAAB D0 DD    BNE $FA8A       
.,FAAD A9 40    LDA #$40        
.,FAAF 85 AA    STA $AA         
.,FAB1 20 8E FB JSR $FB8E       copy I/O start address to buffer address
.,FAB4 A9 00    LDA #$00        
.,FAB6 85 AB    STA $AB         
.,FAB8 F0 D0    BEQ $FA8A       
.,FABA A9 80    LDA #$80        
.,FABC 85 AA    STA $AA         
.,FABE D0 CA    BNE $FA8A       restore registers and exit interrupt, branch always
.,FAC0 A5 B5    LDA $B5         
.,FAC2 F0 0A    BEQ $FACE       
.,FAC4 A9 04    LDA #$04        
.,FAC6 20 1C FE JSR $FE1C       OR into serial status byte
.,FAC9 A9 00    LDA #$00        
.,FACB 4C 4A FB JMP $FB4A       
.,FACE 20 D1 FC JSR $FCD1       check read/write pointer, return Cb = 1 if pointer >= end
.,FAD1 90 03    BCC $FAD6       
.,FAD3 4C 48 FB JMP $FB48       
.,FAD6 A6 A7    LDX $A7         get receiver input bit temporary storage
.,FAD8 CA       DEX             
.,FAD9 F0 2D    BEQ $FB08       
.,FADB A5 93    LDA $93         get load/verify flag
.,FADD F0 0C    BEQ $FAEB       if load go ??
.,FADF A0 00    LDY #$00        clear index
.,FAE1 A5 BD    LDA $BD         get RS232 parity byte
.,FAE3 D1 AC    CMP ($AC),Y     
.,FAE5 F0 04    BEQ $FAEB       
.,FAE7 A9 01    LDA #$01        
.,FAE9 85 B6    STA $B6         
.,FAEB A5 B6    LDA $B6         
.,FAED F0 4B    BEQ $FB3A       
.,FAEF A2 3D    LDX #$3D        
.,FAF1 E4 9E    CPX $9E         
.,FAF3 90 3E    BCC $FB33       
.,FAF5 A6 9E    LDX $9E         
.,FAF7 A5 AD    LDA $AD         
.,FAF9 9D 01 01 STA $0101,X     
.,FAFC A5 AC    LDA $AC         
.,FAFE 9D 00 01 STA $0100,X     
.,FB01 E8       INX             
.,FB02 E8       INX             
.,FB03 86 9E    STX $9E         
.,FB05 4C 3A FB JMP $FB3A       
.,FB08 A6 9F    LDX $9F         
.,FB0A E4 9E    CPX $9E         
.,FB0C F0 35    BEQ $FB43       
.,FB0E A5 AC    LDA $AC         
.,FB10 DD 00 01 CMP $0100,X     
.,FB13 D0 2E    BNE $FB43       
.,FB15 A5 AD    LDA $AD         
.,FB17 DD 01 01 CMP $0101,X     
.,FB1A D0 27    BNE $FB43       
.,FB1C E6 9F    INC $9F         
.,FB1E E6 9F    INC $9F         
.,FB20 A5 93    LDA $93         get load/verify flag
.,FB22 F0 0B    BEQ $FB2F       if load ??
.,FB24 A5 BD    LDA $BD         get RS232 parity byte
.,FB26 A0 00    LDY #$00        
.,FB28 D1 AC    CMP ($AC),Y     
.,FB2A F0 17    BEQ $FB43       
.,FB2C C8       INY             
.,FB2D 84 B6    STY $B6         
.,FB2F A5 B6    LDA $B6         
.,FB31 F0 07    BEQ $FB3A       
.,FB33 A9 10    LDA #$10        
.,FB35 20 1C FE JSR $FE1C       OR into serial status byte
.,FB38 D0 09    BNE $FB43       
.,FB3A A5 93    LDA $93         get load/verify flag
.,FB3C D0 05    BNE $FB43       if verify go ??
.,FB3E A8       TAY             
.,FB3F A5 BD    LDA $BD         get RS232 parity byte
.,FB41 91 AC    STA ($AC),Y     
.,FB43 20 DB FC JSR $FCDB       increment read/write pointer
.,FB46 D0 43    BNE $FB8B       restore registers and exit interrupt, branch always
.,FB48 A9 80    LDA #$80        
.,FB4A 85 AA    STA $AA         
.,FB4C 78       SEI             
.,FB4D A2 01    LDX #$01        disable timer A interrupt
.,FB4F 8E 0D DC STX $DC0D       save VIA 1 ICR
.,FB52 AE 0D DC LDX $DC0D       read VIA 1 ICR
.,FB55 A6 BE    LDX $BE         get copies count
.,FB57 CA       DEX             
.,FB58 30 02    BMI $FB5C       
.,FB5A 86 BE    STX $BE         save copies count
.,FB5C C6 A7    DEC $A7         decrement receiver input bit temporary storage
.,FB5E F0 08    BEQ $FB68       
.,FB60 A5 9E    LDA $9E         
.,FB62 D0 27    BNE $FB8B       if ?? restore registers and exit interrupt
.,FB64 85 BE    STA $BE         save copies count
.,FB66 F0 23    BEQ $FB8B       restore registers and exit interrupt, branch always
.,FB68 20 93 FC JSR $FC93       restore everything for STOP
.,FB6B 20 8E FB JSR $FB8E       copy I/O start address to buffer address
.,FB6E A0 00    LDY #$00        clear index
.,FB70 84 AB    STY $AB         clear checksum
.,FB72 B1 AC    LDA ($AC),Y     get byte from buffer
.,FB74 45 AB    EOR $AB         XOR with checksum
.,FB76 85 AB    STA $AB         save new checksum
.,FB78 20 DB FC JSR $FCDB       increment read/write pointer
.,FB7B 20 D1 FC JSR $FCD1       check read/write pointer, return Cb = 1 if pointer >= end
.,FB7E 90 F2    BCC $FB72       loop if not at end
.,FB80 A5 AB    LDA $AB         get computed checksum
.,FB82 45 BD    EOR $BD         compare with stored checksum ??
.,FB84 F0 05    BEQ $FB8B       if checksum ok restore registers and exit interrupt
.,FB86 A9 20    LDA #$20        else set checksum error
.,FB88 20 1C FE JSR $FE1C       OR into the serial status byte
.,FB8B 4C BC FE JMP $FEBC       restore registers and exit interrupt

                                *** copy I/O start address to buffer address
.,FB8E A5 C2    LDA $C2         get I/O start address high byte
.,FB90 85 AD    STA $AD         set buffer address high byte
.,FB92 A5 C1    LDA $C1         get I/O start address low byte
.,FB94 85 AC    STA $AC         set buffer address low byte
.,FB96 60       RTS             

                                *** new tape byte setup
.,FB97 A9 08    LDA #$08        eight bits to do
.,FB99 85 A3    STA $A3         set bit count
.,FB9B A9 00    LDA #$00        clear A
.,FB9D 85 A4    STA $A4         clear tape bit cycle phase
.,FB9F 85 A8    STA $A8         clear start bit first cycle done flag
.,FBA1 85 9B    STA $9B         clear byte parity
.,FBA3 85 A9    STA $A9         clear start bit check flag, set no start bit yet
.,FBA5 60       RTS             

                                *** send lsb from tape write byte to tape
                                this routine tests the least significant bit in the tape write byte and sets VIA 2 T2
                                depending on the state of the bit. if the bit is a 1 a time of $00B0 cycles is set, if
                                the bot is a 0 a time of $0060 cycles is set. note that this routine does not shift the
                                bits of the tape write byte but uses a copy of that byte, the byte itself is shifted
                                elsewhere
.,FBA6 A5 BD    LDA $BD         get tape write byte
.,FBA8 4A       LSR             shift lsb into Cb
.,FBA9 A9 60    LDA #$60        set time constant low byte for bit = 0
.,FBAB 90 02    BCC $FBAF       branch if bit was 0
                                set time constant for bit = 1 and toggle tape
.,FBAD A9 B0    LDA #$B0        set time constant low byte for bit = 1
                                write time constant and toggle tape
.,FBAF A2 00    LDX #$00        set time constant high byte
                                write time constant and toggle tape
.,FBB1 8D 06 DC STA $DC06       save VIA 1 timer B low byte
.,FBB4 8E 07 DC STX $DC07       save VIA 1 timer B high byte
.,FBB7 AD 0D DC LDA $DC0D       read VIA 1 ICR
.,FBBA A9 19    LDA #$19        load timer B, timer B single shot, start timer B
.,FBBC 8D 0F DC STA $DC0F       save VIA 1 CRB
.,FBBF A5 01    LDA $01         read the 6510 I/O port
.,FBC1 49 08    EOR #$08        toggle tape out bit
.,FBC3 85 01    STA $01         save the 6510 I/O port
.,FBC5 29 08    AND #$08        mask tape out bit
.,FBC7 60       RTS

                                *** flag block done and exit interrupt
.,FBC8 38       SEC             set carry flag
.,FBC9 66 B6    ROR $B6         set buffer address high byte negative, flag all sync,
                                data and checksum bytes written
.,FBCB 30 3C    BMI $FC09       restore registers and exit interrupt, branch always

                                *** tape write IRQ routine
                                this is the routine that writes the bits to the tape. it is called each time VIA 2 T2
                                times out and checks if the start bit is done, if so checks if the data bits are done,
                                if so it checks if the byte is done, if so it checks if the synchronisation bytes are
                                done, if so it checks if the data bytes are done, if so it checks if the checksum byte
                                is done, if so it checks if both the load and verify copies have been done, if so it
                                stops the tape
.,FBCD A5 A8    LDA $A8         get start bit first cycle done flag
.,FBCF D0 12    BNE $FBE3       if first cycle done go do rest of byte
                                each byte sent starts with two half cycles of $0110 ststem clocks and the whole block
                                ends with two more such half cycles
.,FBD1 A9 10    LDA #$10        set first start cycle time constant low byte
.,FBD3 A2 01    LDX #$01        set first start cycle time constant high byte
.,FBD5 20 B1 FB JSR $FBB1       write time constant and toggle tape
.,FBD8 D0 2F    BNE $FC09       if first half cycle go restore registers and exit
                                interrupt
.,FBDA E6 A8    INC $A8         set start bit first start cycle done flag
.,FBDC A5 B6    LDA $B6         get buffer address high byte
.,FBDE 10 29    BPL $FC09       if block not complete go restore registers and exit
                                interrupt. the end of a block is indicated by the tape
                                buffer high byte b7 being set to 1
.,FBE0 4C 57 FC JMP $FC57       else do tape routine, block complete exit
                                continue tape byte write. the first start cycle, both half cycles of it, is complete
                                so the routine drops straight through to here
.,FBE3 A5 A9    LDA $A9         get start bit check flag
.,FBE5 D0 09    BNE $FBF0       if the start bit is complete go send the byte bits
                                after the two half cycles of $0110 ststem clocks the start bit is completed with two
                                half cycles of $00B0 system clocks. this is the same as the first part of a 1 bit
.,FBE7 20 AD FB JSR $FBAD       set time constant for bit = 1 and toggle tape
.,FBEA D0 1D    BNE $FC09       if first half cycle go restore registers and exit
                                interrupt
.,FBEC E6 A9    INC $A9         set start bit check flag
.,FBEE D0 19    BNE $FC09       restore registers and exit interrupt, branch always
                                continue tape byte write. the start bit, both cycles of it, is complete so the routine
                                drops straight through to here. now the cycle pairs for each bit, and the parity bit,
                                are sent
.,FBF0 20 A6 FB JSR $FBA6       send lsb from tape write byte to tape
.,FBF3 D0 14    BNE $FC09       if first half cycle go restore registers and exit
                                interrupt
                                else two half cycles have been done
.,FBF5 A5 A4    LDA $A4         get tape bit cycle phase
.,FBF7 49 01    EOR #$01        toggle b0
.,FBF9 85 A4    STA $A4         save tape bit cycle phase
.,FBFB F0 0F    BEQ $FC0C       if bit cycle phase complete go setup for next bit
                                each bit is written as two full cycles. a 1 is sent as a full cycle of $0160 system
                                clocks then a full cycle of $00C0 system clocks. a 0 is sent as a full cycle of $00C0
                                system clocks then a full cycle of $0160 system clocks. to do this each bit from the
                                write byte is inverted during the second bit cycle phase. as the bit is inverted it
                                is also added to the, one bit, parity count for this byte
.,FBFD A5 BD    LDA $BD         get tape write byte
.,FBFF 49 01    EOR #$01        invert bit being sent
.,FC01 85 BD    STA $BD         save tape write byte
.,FC03 29 01    AND #$01        mask b0
.,FC05 45 9B    EOR $9B         EOR with tape write byte parity bit
.,FC07 85 9B    STA $9B         save tape write byte parity bit
.,FC09 4C BC FE JMP $FEBC       restore registers and exit interrupt
                                the bit cycle phase is complete so shift out the just written bit and test for byte
                                end
.,FC0C 46 BD    LSR $BD         shift bit out of tape write byte
.,FC0E C6 A3    DEC $A3         decrement tape write bit count
.,FC10 A5 A3    LDA $A3         get tape write bit count
.,FC12 F0 3A    BEQ $FC4E       if all the data bits have been written go setup for
                                sending the parity bit next and exit the interrupt
.,FC14 10 F3    BPL $FC09       if all the data bits are not yet sent just restore the
                                registers and exit the interrupt
                                do next tape byte
                                the byte is complete. the start bit, data bits and parity bit have been written to
                                the tape so setup for the next byte
.,FC16 20 97 FB JSR $FB97       new tape byte setup
.,FC19 58       CLI             enable the interrupts
.,FC1A A5 A5    LDA $A5         get cassette synchronization character count
.,FC1C F0 12    BEQ $FC30       if synchronisation characters done go do block data
                                at the start of each block sent to tape there are a number of synchronisation bytes
                                that count down to the actual data. the commodore tape system saves two copies of all
                                the tape data, the first is loaded and is indicated by the synchronisation bytes
                                having b7 set, and the second copy is indicated by the synchronisation bytes having b7
                                clear. the sequence goes $09, $08, ..... $02, $01, data bytes
.,FC1E A2 00    LDX #$00        clear X
.,FC20 86 D7    STX $D7         clear checksum byte
.,FC22 C6 A5    DEC $A5         decrement cassette synchronization byte count
.,FC24 A6 BE    LDX $BE         get cassette copies count
.,FC26 E0 02    CPX #$02        compare with load block indicator
.,FC28 D0 02    BNE $FC2C       branch if not the load block
.,FC2A 09 80    ORA #$80        this is the load block so make the synchronisation count
                                go $89, $88, ..... $82, $81
.,FC2C 85 BD    STA $BD         save the synchronisation byte as the tape write byte
.,FC2E D0 D9    BNE $FC09       restore registers and exit interrupt, branch always
                                the synchronization bytes have been done so now check and do the actual block data
.,FC30 20 D1 FC JSR $FCD1       check read/write pointer, return Cb = 1 if pointer >= end
.,FC33 90 0A    BCC $FC3F       if not all done yet go get the byte to send
.,FC35 D0 91    BNE $FBC8       if pointer > end go flag block done and exit interrupt
                                else the block is complete, it only remains to write the
                                checksum byte to the tape so setup for that
.,FC37 E6 AD    INC $AD         increment buffer pointer high byte, this means the block
                                done branch will always be taken next time without having
                                to worry about the low byte wrapping to zero
.,FC39 A5 D7    LDA $D7         get checksum byte
.,FC3B 85 BD    STA $BD         save checksum as tape write byte
.,FC3D B0 CA    BCS $FC09       restore registers and exit interrupt, branch always
                                the block isn't finished so get the next byte to write to tape
.,FC3F A0 00    LDY #$00        clear index
.,FC41 B1 AC    LDA ($AC),Y     get byte from buffer
.,FC43 85 BD    STA $BD         save as tape write byte
.,FC45 45 D7    EOR $D7         XOR with checksum byte
.,FC47 85 D7    STA $D7         save new checksum byte
.,FC49 20 DB FC JSR $FCDB       increment read/write pointer
.,FC4C D0 BB    BNE $FC09       restore registers and exit interrupt, branch always
                                set parity as next bit and exit interrupt
.,FC4E A5 9B    LDA $9B         get parity bit
.,FC50 49 01    EOR #$01        toggle it
.,FC52 85 BD    STA $BD         save as tape write byte
.,FC54 4C BC FE JMP $FEBC       restore registers and exit interrupt
                                tape routine, block complete exit
.,FC57 C6 BE    DEC $BE         decrement copies remaining to read/write
.,FC59 D0 03    BNE $FC5E       branch if more to do
.,FC5B 20 CA FC JSR $FCCA       stop the cassette motor
.,FC5E A9 50    LDA #$50        set tape write leader count
.,FC60 85 A7    STA $A7         save tape write leader count
.,FC62 A2 08    LDX #$08        set index for write tape leader vector
.,FC64 78       SEI             disable the interrupts
.,FC65 20 BD FC JSR $FCBD       set the tape vector
.,FC68 D0 EA    BNE $FC54       restore registers and exit interrupt, branch always

                                *** write tape leader IRQ routine
.,FC6A A9 78    LDA #$78        set time constant low byte for bit = leader
.,FC6C 20 AF FB JSR $FBAF       write time constant and toggle tape
.,FC6F D0 E3    BNE $FC54       if tape bit high restore registers and exit interrupt
.,FC71 C6 A7    DEC $A7         decrement cycle count
.,FC73 D0 DF    BNE $FC54       if not all done restore registers and exit interrupt
.,FC75 20 97 FB JSR $FB97       new tape byte setup
.,FC78 C6 AB    DEC $AB         decrement cassette leader count
.,FC7A 10 D8    BPL $FC54       if not all done restore registers and exit interrupt
.,FC7C A2 0A    LDX #$0A        set index for tape write vector
.,FC7E 20 BD FC JSR $FCBD       set the tape vector
.,FC81 58       CLI             enable the interrupts
.,FC82 E6 AB    INC $AB         clear cassette leader counter, was $FF
.,FC84 A5 BE    LDA $BE         get cassette block count
.,FC86 F0 30    BEQ $FCB8       if all done restore everything for STOP and exit the
                                interrupt
.,FC88 20 8E FB JSR $FB8E       copy I/O start address to buffer address
.,FC8B A2 09    LDX #$09        set nine synchronisation bytes
.,FC8D 86 A5    STX $A5         save cassette synchronization byte count
.,FC8F 86 B6    STX $B6         
.,FC91 D0 83    BNE $FC16       go do the next tape byte, branch always

                                *** restore everything for STOP
.,FC93 08       PHP             save status
.,FC94 78       SEI             disable the interrupts
.,FC95 AD 11 D0 LDA $D011       read the vertical fine scroll and control register
.,FC98 09 10    ORA #$10        mask xxx1 xxxx, unblank the screen
.,FC9A 8D 11 D0 STA $D011       save the vertical fine scroll and control register
.,FC9D 20 CA FC JSR $FCCA       stop the cassette motor
.,FCA0 A9 7F    LDA #$7F        disable all interrupts
.,FCA2 8D 0D DC STA $DC0D       save VIA 1 ICR
.,FCA5 20 DD FD JSR $FDDD       
.,FCA8 AD A0 02 LDA $02A0       get saved IRQ vector high byte
.,FCAB F0 09    BEQ $FCB6       branch if null
.,FCAD 8D 15 03 STA $0315       restore IRQ vector high byte
.,FCB0 AD 9F 02 LDA $029F       get saved IRQ vector low byte
.,FCB3 8D 14 03 STA $0314       restore IRQ vector low byte
.,FCB6 28       PLP             restore status
.,FCB7 60       RTS             

                                *** reset vector
.,FCB8 20 93 FC JSR $FC93       restore everything for STOP
.,FCBB F0 97    BEQ $FC54       restore registers and exit interrupt, branch always

                                *** set tape vector
.,FCBD BD 93 FD LDA $FD93,X     get tape IRQ vector low byte
.,FCC0 8D 14 03 STA $0314       set IRQ vector low byte
.,FCC3 BD 94 FD LDA $FD94,X     get tape IRQ vector high byte
.,FCC6 8D 15 03 STA $0315       set IRQ vector high byte
.,FCC9 60       RTS             

                                *** stop the cassette motor
.,FCCA A5 01    LDA $01         read the 6510 I/O port
.,FCCC 09 20    ORA #$20        mask xxxx xx1x, turn the cassette motor off
.,FCCE 85 01    STA $01         save the 6510 I/O port
.,FCD0 60       RTS             

                                *** check read/write pointer
                                return Cb = 1 if pointer >= end
.,FCD1 38       SEC             set carry for subtract
.,FCD2 A5 AC    LDA $AC         get buffer address low byte
.,FCD4 E5 AE    SBC $AE         subtract buffer end low byte
.,FCD6 A5 AD    LDA $AD         get buffer address high byte
.,FCD8 E5 AF    SBC $AF         subtract buffer end high byte
.,FCDA 60       RTS             

                                *** increment read/write pointer
.,FCDB E6 AC    INC $AC         increment buffer address low byte
.,FCDD D0 02    BNE $FCE1       branch if no overflow
.,FCDF E6 AD    INC $AD         increment buffer address low byte
.,FCE1 60       RTS             

                                *** RESET, hardware reset starts here
.,FCE2 A2 FF    LDX #$FF        set X for stack
.,FCE4 78       SEI             disable the interrupts
.,FCE5 9A       TXS             clear stack
.,FCE6 D8       CLD             clear decimal mode
.,FCE7 20 02 FD JSR $FD02       scan for autostart ROM at $8000
.,FCEA D0 03    BNE $FCEF       if not there continue startup
.,FCEC 6C 00 80 JMP ($8000)     else call ROM start code
.,FCEF 8E 16 D0 STX $D016       read the horizontal fine scroll and control register
.,FCF2 20 A3 FD JSR $FDA3       initialise SID, CIA and IRQ
.,FCF5 20 50 FD JSR $FD50       RAM test and find RAM end
.,FCF8 20 15 FD JSR $FD15       restore default I/O vectors
.,FCFB 20 5B FF JSR $FF5B       initialise VIC and screen editor
.,FCFE 58       CLIenable the interrupts
.,FCFF 6C 00 A0 JMP ($A000)     execute BASIC

                                *** scan for autostart ROM at $8000, returns Zb=1 if ROM found
.,FD02 A2 05    LDX #$05        five characters to test
.,FD04 BD 0F FD LDA $FD0F,X     get test character
.,FD07 DD 03 80 CMP $8003,X     compare wiith byte in ROM space
.,FD0A D0 03    BNE $FD0F       exit if no match
.,FD0C CA       DEX             decrement index
.,FD0D D0 F5    BNE $FD04       loop if not all done
.,FD0F 60       RTS             
                                *** autostart ROM signature
.:FD10 C3 C2 CD 38 30           'CBM80’

                                *** restore default I/O vectors
.,FD15 A2 30    LDX #$30        pointer to vector table low byte
.,FD17 A0 FD    LDY #$FD        pointer to vector table high byte
.,FD19 18       CLC             flag set vectors

                                *** set/read vectored I/O from (XY), Cb = 1 to read, Cb = 0 to set
.,FD1A 86 C3    STX $C3         save pointer low byte
.,FD1C 84 C4    STY $C4         save pointer high byte
.,FD1E A0 1F    LDY #$1F        set byte count
.,FD20 B9 14 03 LDA $0314,Y     read vector byte from vectors
.,FD23 B0 02    BCS $FD27       branch if read vectors
.,FD25 B1 C3    LDA ($C3),Y     read vector byte from (XY)
.,FD27 91 C3    STA ($C3),Y     save byte to (XY)
.,FD29 99 14 03 STA $0314,Y     save byte to vector
.,FD2C 88       DEY             decrement index
.,FD2D 10 F1    BPL $FD20       loop if more to do
.,FD2F 60       RTS             
                                 The above code works but it tries to write to the ROM. while this is usually harmless
                                 systems that use flash ROM may suffer. Here is a version that makes the extra write
                                 to RAM instead but is otherwise identical in function. ##
                                
                                 set/read vectored I/O from (XY), Cb = 1 to read, Cb = 0 to set
                                
                                STX $C3         ; save pointer low byte
                                STY $C4         ; save pointer high byte
                                LDY #$1F        ; set byte count
                                LDA ($C3),Y     ; read vector byte from (XY)
                                BCC $FD29       ; branch if set vectors
                                
                                LDA $0314,Y     ; else read vector byte from vectors
                                STA ($C3),Y     ; save byte to (XY)
                                STA $0314,Y     ; save byte to vector
                                DEY             ; decrement index
                                BPL $FD20       ; loop if more to do
                                
                                RTS

                                *** kernal vectors
.:FD30 31 EA                    $0314 IRQ vector
.:FD32 66 FE                    $0316 BRK vector
.:FD34 47 FE                    $0318 NMI vector
.:FD36 4A F3                    $031A open a logical file
.:FD38 91 F2                    $031C close a specified logical file
.:FD3A 0E F2                    $031E open channel for input
.:FD3C 50 F2                    $0320 open channel for output
.:FD3E 33 F3                    $0322 close input and output channels
.:FD40 57 F1                    $0324 input character from channel
.:FD42 CA F1                    $0326 output character to channel
.:FD44 ED F6                    $0328 scan stop key
.:FD46 3E F1                    $032A get character from the input device
.:FD48 2F F3                    $032C close all channels and files
.:FD4A 66 FE                    $032E user function
                                Vector to user defined command, currently points to BRK.
                                This appears to be a holdover from PET days, when the built-in machine language monitor
                                would jump through the $032E vector when it encountered a command that it did not
                                understand, allowing the user to add new commands to the monitor.
                                Although this vector is initialized to point to the routine called by STOP/RESTORE and
                                the BRK interrupt, and is updated by the kernal vector routine at $FD57, it no longer
                                has any function.
.:FD4C A5 F4                    $0330 load
.:FD4E ED F5                    $0332 save

                                *** test RAM and find RAM end
.,FD50 A9 00    LDA #$00        clear A
.,FD52 A8       TAY             clear index
.,FD53 99 02 00 STA $0002,Y     clear page 0, don't do $0000 or $0001
.,FD56 99 00 02 STA $0200,Y     clear page 2
.,FD59 99 00 03 STA $0300,Y     clear page 3
.,FD5C C8       INY             increment index
.,FD5D D0 F4    BNE $FD53       loop if more to do
.,FD5F A2 3C    LDX #$3C        set cassette buffer pointer low byte
.,FD61 A0 03    LDY #$03        set cassette buffer pointer high byte
.,FD63 86 B2    STX $B2         save tape buffer start pointer low byte
.,FD65 84 B3    STY $B3         save tape buffer start pointer high byte
.,FD67 A8       TAY             clear Y
.,FD68 A9 03    LDA #$03        set RAM test pointer high byte
.,FD6A 85 C2    STA $C2         save RAM test pointer high byte
.,FD6C E6 C2    INC $C2         increment RAM test pointer high byte
.,FD6E B1 C1    LDA ($C1),Y     
.,FD70 AA       TAX             
.,FD71 A9 55    LDA #$55        
.,FD73 91 C1    STA ($C1),Y     
.,FD75 D1 C1    CMP ($C1),Y     
.,FD77 D0 0F    BNE $FD88       
.,FD79 2A       ROL             
.,FD7A 91 C1    STA ($C1),Y     
.,FD7C D1 C1    CMP ($C1),Y     
.,FD7E D0 08    BNE $FD88       
.,FD80 8A       TXA             
.,FD81 91 C1    STA ($C1),Y     
.,FD83 C8       INY             
.,FD84 D0 E8    BNE $FD6E       
.,FD86 F0 E4    BEQ $FD6C       
.,FD88 98       TYA             
.,FD89 AA       TAX             
.,FD8A A4 C2    LDY $C2         
.,FD8C 18       CLC             
.,FD8D 20 2D FE JSR $FE2D       set the top of memory
.,FD90 A9 08    LDA #$08        
.,FD92 8D 82 02 STA $0282       save the OS start of memory high byte
.,FD95 A9 04    LDA #$04        
.,FD97 8D 88 02 STA $0288       save the screen memory page
.,FD9A 60       RTS             

                                *** tape IRQ vectors
.:FD9B 6A FC                    $08 write tape leader IRQ routine
.:FD9D CD FB                    $0A tape write IRQ routine
.:FD9F 31 EA                    $0C normal IRQ vector
.:FDA1 2C F9                    $0E read tape bits IRQ routine

                                *** initialise SID, CIA and IRQ
.,FDA3 A9 7F    LDA #$7F        disable all interrupts
.,FDA5 8D 0D DC STA $DC0D       save VIA 1 ICR
.,FDA8 8D 0D DD STA $DD0D       save VIA 2 ICR
.,FDAB 8D 00 DC STA $DC00       save VIA 1 DRA, keyboard column drive
.,FDAE A9 08    LDA #$08        set timer single shot
.,FDB0 8D 0E DC STA $DC0E       save VIA 1 CRA
.,FDB3 8D 0E DD STA $DD0E       save VIA 2 CRA
.,FDB6 8D 0F DC STA $DC0F       save VIA 1 CRB
.,FDB9 8D 0F DD STA $DD0F       save VIA 2 CRB
.,FDBC A2 00    LDX #$00        set all inputs
.,FDBE 8E 03 DC STX $DC03       save VIA 1 DDRB, keyboard row
.,FDC1 8E 03 DD STX $DD03       save VIA 2 DDRB, RS232 port
.,FDC4 8E 18 D4 STX $D418       clear the volume and filter select register
.,FDC7 CA       DEX             set X = $FF
.,FDC8 8E 02 DC STX $DC02       save VIA 1 DDRA, keyboard column
.,FDCB A9 07    LDA #$07        DATA out high, CLK out high, ATN out high, RE232 Tx DATA
                                high, video address 15 = 1, video address 14 = 1
.,FDCD 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,FDD0 A9 3F    LDA #$3F        set serial DATA input, serial CLK input
.,FDD2 8D 02 DD STA $DD02       save VIA 2 DDRA, serial port and video address
.,FDD5 A9 E7    LDA #$E7        set 1110 0111, motor off, enable I/O, enable KERNAL,
                                enable BASIC
.,FDD7 85 01    STA $01         save the 6510 I/O port
.,FDD9 A9 2F    LDA #$2F        set 0010 1111, 0 = input, 1 = output
.,FDDB 85 00    STA $00         save the 6510 I/O port direction register
.,FDDD AD A6 02 LDA $02A6       get the PAL/NTSC flag
.,FDE0 F0 0A    BEQ $FDEC       if NTSC go set NTSC timing
                                else set PAL timing
.,FDE2 A9 25    LDA #$25        
.,FDE4 8D 04 DC STA $DC04       save VIA 1 timer A low byte
.,FDE7 A9 40    LDA #$40        
.,FDE9 4C F3 FD JMP $FDF3       
.,FDEC A9 95    LDA #$95        
.,FDEE 8D 04 DC STA $DC04       save VIA 1 timer A low byte
.,FDF1 A9 42    LDA #$42        
.,FDF3 8D 05 DC STA $DC05       save VIA 1 timer A high byte
.,FDF6 4C 6E FF JMP $FF6E       

                                *** set filename
.,FDF9 85 B7    STA $B7         set file name length
.,FDFB 86 BB    STX $BB         set file name pointer low byte
.,FDFD 84 BC    STY $BC         set file name pointer high byte
.,FDFF 60       RTS             

                                *** set logical, first and second addresses
.,FE00 85 B8    STA $B8         save the logical file
.,FE02 86 BA    STX $BA         save the device number
.,FE04 84 B9    STY $B9         save the secondary address
.,FE06 60       RTS             

                                *** read I/O status word
.,FE07 A5 BA    LDA $BA         get the device number
.,FE09 C9 02    CMP #$02        compare device with RS232 device
.,FE0B D0 0D    BNE $FE1A       if not RS232 device go ??
                                get RS232 device status
.,FE0D AD 97 02 LDA $0297       get the RS232 status register
.,FE10 48       PHA             save the RS232 status value
.,FE11 A9 00    LDA #$00        clear A
.,FE13 8D 97 02 STA $0297       clear the RS232 status register
.,FE16 68       PLA             restore the RS232 status value
.,FE17 60       RTS             

                                *** control kernal messages
.,FE18 85 9D    STA $9D         set message mode flag
.,FE1A A5 90    LDA $90         read the serial status byte

                                *** OR into the serial status byte
.,FE1C 05 90    ORA $90         OR with the serial status byte
.,FE1E 85 90    STA $90         save the serial status byte
.,FE20 60       RTS             

                                *** set timeout on serial bus
.,FE21 8D 85 02 STA $0285       save serial bus timeout flag
.,FE24 60       RTS             

                                *** read/set the top of memory, Cb = 1 to read, Cb = 0 to set
.,FE25 90 06    BCC $FE2D       if Cb clear go set the top of memory

                                *** read the top of memory
.,FE27 AE 83 02 LDX $0283       get memory top low byte
.,FE2A AC 84 02 LDY $0284       get memory top high byte

                                *** set the top of memory
.,FE2D 8E 83 02 STX $0283       set memory top low byte
.,FE30 8C 84 02 STY $0284       set memory top high byte
.,FE33 60       RTS             

                                *** read/set the bottom of memory, Cb = 1 to read, Cb = 0 to set
.,FE34 90 06    BCC $FE3C       if Cb clear go set the bottom of memory
.,FE36 AE 81 02 LDX $0281       get the OS start of memory low byte
.,FE39 AC 82 02 LDY $0282       get the OS start of memory high byte
.,FE3C 8E 81 02 STX $0281       save the OS start of memory low byte
.,FE3F 8C 82 02 STY $0282       save the OS start of memory high byte
.,FE42 60       RTS             

                                *** NMI vector
.,FE43 78       SEI             disable the interrupts
.,FE44 6C 18 03 JMP ($0318)     do NMI vector

                                *** NMI handler
.,FE47 48       PHA             save A
.,FE48 8A       TXA             copy X
.,FE49 48       PHA             save X
.,FE4A 98       TYA             copy Y
.,FE4B 48       PHA             save Y
.,FE4C A9 7F    LDA #$7F        disable all interrupts
.,FE4E 8D 0D DD STA $DD0D       save VIA 2 ICR
.,FE51 AC 0D DD LDY $DD0D       save VIA 2 ICR
.,FE54 30 1C    BMI $FE72       
.,FE56 20 02 FD JSR $FD02       scan for autostart ROM at $8000
.,FE59 D0 03    BNE $FE5E       branch if no autostart ROM
.,FE5B 6C 02 80 JMP ($8002)     else do autostart ROM break entry
.,FE5E 20 BC F6 JSR $F6BC       increment real time clock
.,FE61 20 E1 FF JSR $FFE1       scan stop key
.,FE64 D0 0C    BNE $FE72       if not [STOP] restore registers and exit interrupt

                                *** user function default vector
                                BRK handler
.,FE66 20 15 FD JSR $FD15       restore default I/O vectors
.,FE69 20 A3 FD JSR $FDA3       initialise SID, CIA and IRQ
.,FE6C 20 18 E5 JSR $E518       initialise the screen and keyboard
.,FE6F 6C 02 A0 JMP ($A002)     do BASIC break entry

                                *** RS232 NMI routine
.,FE72 98       TYA             
.,FE73 2D A1 02 AND $02A1       AND with the RS-232 interrupt enable byte
.,FE76 AA       TAX             
.,FE77 29 01    AND #$01        
.,FE79 F0 28    BEQ $FEA3       
.,FE7B AD 00 DD LDA $DD00       read VIA 2 DRA, serial port and video address
.,FE7E 29 FB    AND #$FB        mask xxxx x0xx, clear RS232 Tx DATA
.,FE80 05 B5    ORA $B5         OR in the RS232 transmit data bit
.,FE82 8D 00 DD STA $DD00       save VIA 2 DRA, serial port and video address
.,FE85 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,FE88 8D 0D DD STA $DD0D       save VIA 2 ICR
.,FE8B 8A       TXA             
.,FE8C 29 12    AND #$12        
.,FE8E F0 0D    BEQ $FE9D       
.,FE90 29 02    AND #$02        
.,FE92 F0 06    BEQ $FE9A       
.,FE94 20 D6 FE JSR $FED6       
.,FE97 4C 9D FE JMP $FE9D       
.,FE9A 20 07 FF JSR $FF07       
.,FE9D 20 BB EE JSR $EEBB       
.,FEA0 4C B6 FE JMP $FEB6       
.,FEA3 8A       TXA             get active interrupts back
.,FEA4 29 02    AND #$02        mask ?? interrupt
.,FEA6 F0 06    BEQ $FEAE       branch if not ?? interrupt
                                was ?? interrupt
.,FEA8 20 D6 FE JSR $FED6       
.,FEAB 4C B6 FE JMP $FEB6       
.,FEAE 8A       TXA             get active interrupts back
.,FEAF 29 10    AND #$10        mask CB1 interrupt, Rx data bit transition
.,FEB1 F0 03    BEQ $FEB6       if no bit restore registers and exit interrupt
.,FEB3 20 07 FF JSR $FF07       
.,FEB6 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,FEB9 8D 0D DD STA $DD0D       save VIA 2 ICR
.,FEBC 68       PLA             pull Y
.,FEBD A8       TAY             restore Y
.,FEBE 68       PLA             pull X
.,FEBF AA       TAX             restore X
.,FEC0 68       PLA             restore A
.,FEC1 40       RTI             

                                *** baud rate word is calculated from ..
                                
                                (system clock / baud rate) / 2 - 100
                                
                                    system clock
                                    ------------
                                PAL        985248 Hz
                                NTSC     1022727 Hz
                                baud rate tables for NTSC C64
.:FEC2 C1 27                      50   baud   1027700
.:FEC4 3E 1A                      75   baud   1022700
.:FEC6 C5 11                     110   baud   1022780
.:FEC8 74 0E                     134.5 baud   1022200
.:FECA ED 0C                     150   baud   1022700
.:FECC 45 06                     300   baud   1023000
.:FECE F0 02                     600   baud   1022400
.:FED0 46 01                    1200   baud   1022400
.:FED2 B8 00                    1800   baud   1022400
.:FED4 71 00                    2400   baud   1022400

                                *** ??
.,FED6 AD 01 DD LDA $DD01       read VIA 2 DRB, RS232 port
.,FED9 29 01    AND #$01        mask 0000 000x, RS232 Rx DATA
.,FEDB 85 A7    STA $A7         save the RS232 received data bit
.,FEDD AD 06 DD LDA $DD06       get VIA 2 timer B low byte
.,FEE0 E9 1C    SBC #$1C        
.,FEE2 6D 99 02 ADC $0299       
.,FEE5 8D 06 DD STA $DD06       save VIA 2 timer B low byte
.,FEE8 AD 07 DD LDA $DD07       get VIA 2 timer B high byte
.,FEEB 6D 9A 02 ADC $029A       
.,FEEE 8D 07 DD STA $DD07       save VIA 2 timer B high byte
.,FEF1 A9 11    LDA #$11        set timer B single shot, start timer B
.,FEF3 8D 0F DD STA $DD0F       save VIA 2 CRB
.,FEF6 AD A1 02 LDA $02A1       get the RS-232 interrupt enable byte
.,FEF9 8D 0D DD STA $DD0D       save VIA 2 ICR
.,FEFC A9 FF    LDA #$FF        
.,FEFE 8D 06 DD STA $DD06       save VIA 2 timer B low byte
.,FF01 8D 07 DD STA $DD07       save VIA 2 timer B high byte
.,FF04 4C 59 EF JMP $EF59       
.,FF07 AD 95 02 LDA $0295       nonstandard bit timing low byte
.,FF0A 8D 06 DD STA $DD06       save VIA 2 timer B low byte
.,FF0D AD 96 02 LDA $0296       nonstandard bit timing high byte
.,FF10 8D 07 DD STA $DD07       save VIA 2 timer B high byte
.,FF13 A9 11    LDA #$11        set timer B single shot, start timer B
.,FF15 8D 0F DD STA $DD0F       save VIA 2 CRB
.,FF18 A9 12    LDA #$12        
.,FF1A 4D A1 02 EOR $02A1       EOR with the RS-232 interrupt enable byte
.,FF1D 8D A1 02 STA $02A1       save the RS-232 interrupt enable byte
.,FF20 A9 FF    LDA #$FF        
.,FF22 8D 06 DD STA $DD06       save VIA 2 timer B low byte
.,FF25 8D 07 DD STA $DD07       save VIA 2 timer B high byte
.,FF28 AE 98 02 LDX $0298       
.,FF2B 86 A8    STX $A8         
.,FF2D 60       RTS             

                                *** ??
.,FF2E AA       TAX             
.,FF2F AD 96 02 LDA $0296       nonstandard bit timing high byte
.,FF32 2A       ROL             
.,FF33 A8       TAY             
.,FF34 8A       TXA             
.,FF35 69 C8    ADC #$C8        
.,FF37 8D 99 02 STA $0299       
.,FF3A 98       TYA             
.,FF3B 69 00    ADC #$00        add any carry
.,FF3D 8D 9A 02 STA $029A       
.,FF40 60       RTS             

                                *** unused bytes
.,FF41 EA       NOP             waste cycles
.,FF42 EA       NOP             waste cycles

                                *** save the status and do the IRQ routine
.,FF43 08       PHP             save the processor status
.,FF44 68       PLA             pull the processor status
.,FF45 29 EF    AND #$EF        mask xxx0 xxxx, clear the break bit
.,FF47 48       PHA             save the modified processor status

                                *** IRQ vector
.,FF48 48       PHA             save A
.,FF49 8A       TXA             copy X
.,FF4A 48       PHA             save X
.,FF4B 98       TYA             copy Y
.,FF4C 48       PHA             save Y
.,FF4D BA       TSX             copy stack pointer
.,FF4E BD 04 01 LDA $0104,X     get stacked status register
.,FF51 29 10    AND #$10        mask BRK flag
.,FF53 F0 03    BEQ $FF58       branch if not BRK
.,FF55 6C 16 03 JMP ($0316)     else do BRK vector (iBRK)
.,FF58 6C 14 03 JMP ($0314)     do IRQ vector (iIRQ)

                                *** initialise VIC and screen editor
.,FF5B 20 18 E5 JSR $E518       initialise the screen and keyboard
.,FF5E AD 12 D0 LDA $D012       read the raster compare register
.,FF61 D0 FB    BNE $FF5E       loop if not raster line $00
.,FF63 AD 19 D0 LDA $D019       read the vic interrupt flag register
.,FF66 29 01    AND #$01        mask the raster compare flag
.,FF68 8D A6 02 STA $02A6       save the PAL/NTSC flag
.,FF6B 4C DD FD JMP $FDDD       

                                *** ??
.,FF6E A9 81    LDA #$81        enable timer A interrupt
.,FF70 8D 0D DC STA $DC0D       save VIA 1 ICR
.,FF73 AD 0E DC LDA $DC0E       read VIA 1 CRA
.,FF76 29 80    AND #$80        mask x000 0000, TOD clock
.,FF78 09 11    ORA #$11        mask xxx1 xxx1, load timer A, start timer A
.,FF7A 8D 0E DC STA $DC0E       save VIA 1 CRA
.,FF7D 4C 8E EE JMP $EE8E       set the serial clock out low and return

                                *** unused
.:FF80 03

                                *** initialise VIC and screen editor
.,FF81 4C 5B FF JMP $FF5B       initialise VIC and screen editor

                                *** initialise SID, CIA and IRQ, unused
.,FF84 4C A3 FD JMP $FDA3       initialise SID, CIA and IRQ

                                *** RAM test and find RAM end
.,FF87 4C 50 FD JMP $FD50       RAM test and find RAM end

                                *** restore default I/O vectors
                                this routine restores the default values of all system vectors used in KERNAL and
                                BASIC routines and interrupts.
.,FF8A 4C 15 FD JMP $FD15       restore default I/O vectors

                                *** read/set vectored I/O
                                this routine manages all system vector jump addresses stored in RAM. Calling this
                                routine with the carry bit set will store the current contents of the RAM vectors
                                in a list pointed to by the X and Y registers. When this routine is called with
                                the carry bit clear, the user list pointed to by the X and Y registers is copied
                                to the system RAM vectors.
                                NOTE: This routine requires caution in its use. The best way to use it is to first
                                read the entire vector contents into the user area, alter the desired vectors and
                                then copy the contents back to the system vectors.
.,FF8D 4C 1A FD JMP $FD1A       read/set vectored I/O

                                *** control kernal messages
                                this routine controls the printing of error and control messages by the KERNAL.
                                Either print error messages or print control messages can be selected by setting
                                the accumulator when the routine is called.
                                FILE NOT FOUND is an example of an error message. PRESS PLAY ON CASSETTE is an
                                example of a control message.
                                bits 6 and 7 of this value determine where the message will come from. If bit 7
                                is set one of the error messages from the KERNAL will be printed. If bit 6 is set
                                a control message will be printed.
.,FF90 4C 18 FE JMP $FE18       control kernal messages

                                *** send secondary address after LISTEN
                                this routine is used to send a secondary address to an I/O device after a call to
                                the LISTEN routine is made and the device commanded to LISTEN. The routine cannot
                                be used to send a secondary address after a call to the TALK routine.
                                A secondary address is usually used to give set-up information to a device before
                                I/O operations begin.
                                When a secondary address is to be sent to a device on the serial bus the address
                                must first be ORed with $60.
.,FF93 4C B9 ED JMP $EDB9       send secondary address after LISTEN

                                *** send secondary address after TALK
                                this routine transmits a secondary address on the serial bus for a TALK device.
                                This routine must be called with a number between 4 and 31 in the accumulator.
                                The routine will send this number as a secondary address command over the serial
                                bus. This routine can only be called after a call to the TALK routine. It will
                                not work after a LISTEN.
.,FF96 4C C7 ED JMP $EDC7       send secondary address after TALK

                                *** read/set the top of memory
                                this routine is used to read and set the top of RAM. When this routine is called
                                with the carry bit set the pointer to the top of RAM will be loaded into XY. When
                                this routine is called with the carry bit clear XY will be saved as the top of
                                memory pointer changing the top of memory.
.,FF99 4C 25 FE JMP $FE25       read/set the top of memory

                                *** read/set the bottom of memory
                                this routine is used to read and set the bottom of RAM. When this routine is
                                called with the carry bit set the pointer to the bottom of RAM will be loaded
                                into XY. When this routine is called with the carry bit clear XY will be saved as
                                the bottom of memory pointer changing the bottom of memory.
.,FF9C 4C 34 FE JMP $FE34       read/set the bottom of memory

                                *** scan the keyboard
                                this routine will scan the keyboard and check for pressed keys. It is the same
                                routine called by the interrupt handler. If a key is down, its ASCII value is
                                placed in the keyboard queue.
.,FF9F 4C 87 EA JMP $EA87       scan keyboard

                                *** set timeout on serial bus
                                this routine sets the timeout flag for the serial bus. When the timeout flag is
                                set, the computer will wait for a device on the serial port for 64 milliseconds.
                                If the device does not respond to the computer's DAV signal within that time the
                                computer will recognize an error condition and leave the handshake sequence. When
                                this routine is called and the accumulator contains a 0 in bit 7, timeouts are
                                enabled. A 1 in bit 7 will disable the timeouts.
                                NOTE: The the timeout feature is used to communicate that a disk file is not found
                                on an attempt to OPEN a file.
.,FFA2 4C 21 FE JMP $FE21       set timeout on serial bus

                                *** input byte from serial bus
                                
                                this routine reads a byte of data from the serial bus using full handshaking. the
                                data is returned in the accumulator. before using this routine the TALK routine,
                                $FFB4, must have been called first to command the device on the serial bus to
                                send data on the bus. if the input device needs a secondary command it must be sent
                                by using the TKSA routine, $FF96, before calling this routine.
                                
                                errors are returned in the status word which can be read by calling the READST
                                routine, $FFB7.
.,FFA5 4C 13 EE JMP $EE13       input byte from serial bus

                                *** output a byte to serial bus
                                this routine is used to send information to devices on the serial bus. A call to
                                this routine will put a data byte onto the serial bus using full handshaking.
                                Before this routine is called the LISTEN routine, $FFB1, must be used to
                                command a device on the serial bus to get ready to receive data.
                                the accumulator is loaded with a byte to output as data on the serial bus. A
                                device must be listening or the status word will return a timeout. This routine
                                always buffers one character. So when a call to the UNLISTEN routine, $FFAE,
                                is made to end the data transmission, the buffered character is sent with EOI
                                set. Then the UNLISTEN command is sent to the device.
.,FFA8 4C DD ED JMP $EDDD       output byte to serial bus

                                *** command serial bus to UNTALK
                                this routine will transmit an UNTALK command on the serial bus. All devices
                                previously set to TALK will stop sending data when this command is received.
.,FFAB 4C EF ED JMP $EDEF       command serial bus to UNTALK

                                *** command serial bus to UNLISTEN
                                this routine commands all devices on the serial bus to stop receiving data from
                                the computer. Calling this routine results in an UNLISTEN command being transmitted
                                on the serial bus. Only devices previously commanded to listen will be affected.
                                This routine is normally used after the computer is finished sending data to
                                external devices. Sending the UNLISTEN will command the listening devices to get
                                off the serial bus so it can be used for other purposes.
.,FFAE 4C FE ED JMP $EDFE       command serial bus to UNLISTEN

                                *** command devices on the serial bus to LISTEN
                                this routine will command a device on the serial bus to receive data. The
                                accumulator must be loaded with a device number between 4 and 31 before calling
                                this routine. LISTEN convert this to a listen address then transmit this data as
                                a command on the serial bus. The specified device will then go into listen mode
                                and be ready to accept information.
.,FFB1 4C 0C ED JMP $ED0C       command devices on the serial bus to LISTEN

                                *** command serial bus device to TALK
                                to use this routine the accumulator must first be loaded with a device number
                                between 4 and 30. When called this routine converts this device number to a talk
                                address. Then this data is transmitted as a command on the Serial bus.
.,FFB4 4C 09 ED JMP $ED09       command serial bus device to TALK

                                *** read I/O status word
                                this routine returns the current status of the I/O device in the accumulator. The
                                routine is usually called after new communication to an I/O device. The routine
                                will give information about device status, or errors that have occurred during the
                                I/O operation.
.,FFB7 4C 07 FE JMP $FE07       read I/O status word

                                *** set logical, first and second addresses
                                this routine will set the logical file number, device address, and secondary
                                address, command number, for other KERNAL routines.
                                the logical file number is used by the system as a key to the file table created
                                by the OPEN file routine. Device addresses can range from 0 to 30. The following
                                codes are used by the computer to stand for the following CBM devices:
                                ADDRESS DEVICE
                                ======= ======
                                 0      Keyboard
                                 1      Cassette #1
                                 2      RS-232C device
                                 3      CRT display
                                 4      Serial bus printer
                                 8      CBM Serial bus disk drive
                                device numbers of four or greater automatically refer to devices on the serial
                                bus.
                                a command to the device is sent as a secondary address on the serial bus after
                                the device number is sent during the serial attention handshaking sequence. If
                                no secondary address is to be sent Y should be set to $FF.
.,FFBA 4C 00 FE JMP $FE00       set logical, first and second addresses

                                *** set the filename
                                this routine is used to set up the file name for the OPEN, SAVE, or LOAD routines.
                                The accumulator must be loaded with the length of the file and XY with the pointer
                                to file name, X being th low byte. The address can be any valid memory address in
                                the system where a string of characters for the file name is stored. If no file
                                name desired the accumulator must be set to 0, representing a zero file length,
                                in that case  XY may be set to any memory address.
.,FFBD 4C F9 FD JMP $FDF9       set the filename

                                *** open a logical file
                                this routine is used to open a logical file. Once the logical file is set up it
                                can be used for input/output operations. Most of the I/O KERNAL routines call on
                                this routine to create the logical files to operate on. No arguments need to be
                                set up to use this routine, but both the SETLFS, $FFBA, and SETNAM, $FFBD,
                                KERNAL routines must be called before using this routine.
.,FFC0 6C 1A 03 JMP ($031A)     do open a logical file

                                *** close a specified logical file
                                this routine is used to close a logical file after all I/O operations have been
                                completed on that file. This routine is called after the accumulator is loaded
                                with the logical file number to be closed, the same number used when the file was
                                opened using the OPEN routine.
.,FFC3 6C 1C 03 JMP ($031C)     do close a specified logical file

                                *** open channel for input
                                any logical file that has already been opened by the OPEN routine, $FFC0, can be
                                defined as an input channel by this routine. the device on the channel must be an
                                input device or an error will occur and the routine will abort.
                                
                                if you are getting data from anywhere other than the keyboard, this routine must be
                                called before using either the CHRIN routine, $FFCF, or the GETIN routine,
                                $FFE4. if you are getting data from the keyboard and no other input channels are
                                open then the calls to this routine and to the OPEN routine, $FFC0, are not needed.
                                
                                when used with a device on the serial bus this routine will automatically send the
                                listen address specified by the OPEN routine, $FFC0, and any secondary address.
                                
                                possible errors are:
                                
                                3 : file not open
                                5 : device not present
                                6 : file is not an input file
.,FFC6 6C 1E 03 JMP ($031E)     do open channel for input

                                *** open channel for output
                                any logical file that has already been opened by the OPEN routine, $FFC0, can be
                                defined as an output channel by this routine the device on the channel must be an
                                output device or an error will occur and the routine will abort.
                                
                                if you are sending data to anywhere other than the screen this routine must be
                                called before using the CHROUT routine, $FFD2. if you are sending data to the
                                screen and no other output channels are open then the calls to this routine and to
                                the OPEN routine, $FFC0, are not needed.
                                
                                when used with a device on the serial bus this routine will automatically send the
                                listen address specified by the OPEN routine, $FFC0, and any secondary address.
                                
                                possible errors are:
                                
                                3 : file not open
                                5 : device not present
                                7 : file is not an output file
.,FFC9 6C 20 03 JMP ($0320)     do open channel for output

                                *** close input and output channels
                                this routine is called to clear all open channels and restore the I/O channels to
                                their original default values. It is usually called after opening other I/O
                                channels and using them for input/output operations. The default input device is
                                0, the keyboard. The default output device is 3, the screen.
                                If one of the channels to be closed is to the serial port, an UNTALK signal is sent
                                first to clear the input channel or an UNLISTEN is sent to clear the output channel.
                                By not calling this routine and leaving listener(s) active on the serial bus,
                                several devices can receive the same data from the VIC at the same time. One way to
                                take advantage of this would be to command the printer to TALK and the disk to
                                LISTEN. This would allow direct printing of a disk file.
.,FFCC 6C 22 03 JMP ($0322)     do close input and output channels

                                *** input character from channel
                                this routine will get a byte of data from the channel already set up as the input
                                channel by the CHKIN routine, $FFC6.
                                
                                If CHKIN, $FFC6, has not been used to define another input channel the data is
                                expected to be from the keyboard. the data byte is returned in the accumulator. the
                                channel remains open after the call.
                                
                                input from the keyboard is handled in a special way. first, the cursor is turned on
                                and it will blink until a carriage return is typed on the keyboard. all characters
                                on the logical line, up to 80 characters, will be stored in the BASIC input buffer.
                                then the characters can be returned one at a time by calling this routine once for
                                each character. when the carriage return is returned the entire line has been
                                processed. the next time this routine is called the whole process begins again.
.,FFCF 6C 24 03 JMP ($0324)     do input character from channel

                                *** output character to channel
                                this routine will output a character to an already opened channel. Use the OPEN
                                routine, $FFC0, and the CHKOUT routine, $FFC9, to set up the output channel
                                before calling this routine. If these calls are omitted, data will be sent to the
                                default output device, device 3, the screen. The data byte to be output is loaded
                                into the accumulator, and this routine is called. The data is then sent to the
                                specified output device. The channel is left open after the call.
                                NOTE: Care must be taken when using routine to send data to a serial device since
                                data will be sent to all open output channels on the bus. Unless this is desired,
                                all open output channels on the serial bus other than the actually intended
                                destination channel must be closed by a call to the KERNAL close channel routine.
.,FFD2 6C 26 03 JMP ($0326)     do output character to channel

                                *** load RAM from a device
                                this routine will load data bytes from any input device directly into the memory
                                of the computer. It can also be used for a verify operation comparing data from a
                                device with the data already in memory, leaving the data stored in RAM unchanged.
                                The accumulator must be set to 0 for a load operation or 1 for a verify. If the
                                input device was OPENed with a secondary address of 0 the header information from
                                device will be ignored. In this case XY must contain the starting address for the
                                load. If the device was addressed with a secondary address of 1 or 2 the data will
                                load into memory starting at the location specified by the header. This routine
                                returns the address of the highest RAM location which was loaded.
                                Before this routine can be called, the SETLFS, $FFBA, and SETNAM, $FFBD,
                                routines must be called.
.,FFD5 4C 9E F4 JMP $F49E       load RAM from a device

                                *** save RAM to a device
                                this routine saves a section of memory. Memory is saved from an indirect address
                                on page 0 specified by A, to the address stored in XY, to a logical file. The
                                SETLFS, $FFBA, and SETNAM, $FFBD, routines must be used before calling this
                                routine. However, a file name is not required to SAVE to device 1, the cassette.
                                Any attempt to save to other devices without using a file name results in an error.
                                NOTE: device 0, the keyboard, and device 3, the screen, cannot be SAVEd to. If
                                the attempt is made, an error will occur, and the SAVE stopped.
.,FFD8 4C DD F5 JMP $F5DD       save RAM to device

                                *** set the real time clock
                                the system clock is maintained by an interrupt routine that updates the clock
                                every 1/60th of a second. The clock is three bytes long which gives the capability
                                to count from zero up to 5,184,000 jiffies - 24 hours plus one jiffy. At that point
                                the clock resets to zero. Before calling this routine to set the clock the new time,
                                in jiffies, should be in YXA, the accumulator containing the most significant byte.
.,FFDB 4C E4 F6 JMP $F6E4       set real time clock

                                *** read the real time clock
                                this routine returns the time, in jiffies, in AXY. The accumulator contains the
                                most significant byte.
.,FFDE 4C DD F6 JMP $F6DD       read real time clock

                                *** scan the stop key
                                if the STOP key on the keyboard is pressed when this routine is called the Z flag
                                will be set. All other flags remain unchanged. If the STOP key is not pressed then
                                the accumulator will contain a byte representing the last row of the keyboard scan.
                                The user can also check for certain other keys this way.
.,FFE1 6C 28 03 JMP ($0328)     do scan stop key

                                *** get character from input device
                                in practice this routine operates identically to the CHRIN routine, $FFCF,
                                for all devices except for the keyboard. If the keyboard is the current input
                                device this routine will get one character from the keyboard buffer. It depends
                                on the IRQ routine to read the keyboard and put characters into the buffer.
                                If the keyboard buffer is empty the value returned in the accumulator will be zero.
.,FFE4 6C 2A 03 JMP ($032A)     do get character from input device

                                *** close all channels and files
                                this routine closes all open files. When this routine is called, the pointers into
                                the open file table are reset, closing all files. Also the routine automatically
                                resets the I/O channels.
.,FFE7 6C 2C 03 JMP ($032C)     do close all channels and files

                                *** increment real time clock
                                this routine updates the system clock. Normally this routine is called by the
                                normal KERNAL interrupt routine every 1/60th of a second. If the user program
                                processes its own interrupts this routine must be called to update the time. Also,
                                the STOP key routine must be called if the stop key is to remain functional.
.,FFEA 4C 9B F6 JMP $F69B       increment real time clock

                                *** return X,Y organization of screen
                                this routine returns the x,y organisation of the screen in X,Y
.,FFED 4C 05 E5 JMP $E505       return X,Y organization of screen

                                *** read/set X,Y cursor position
                                this routine, when called with the carry flag set, loads the current position of
                                the cursor on the screen into the X and Y registers. X is the column number of
                                the cursor location and Y is the row number of the cursor. A call with the carry
                                bit clear moves the cursor to the position determined by the X and Y registers.
.,FFF0 4C 0A E5 JMP $E50A       read/set X,Y cursor position

                                *** return the base address of the I/O devices
                                this routine will set XY to the address of the memory section where the memory
                                mapped I/O devices are located. This address can then be used with an offset to
                                access the memory mapped I/O devices in the computer.
.,FFF3 4C 00 E5 JMP $E500       return the base address of the I/O devices

                                ***
.:FFF6 52 52 42 59              RRBY

                                *** hardware vectors
.:FFFA 43 FE                    NMI Vektor
.:FFFC E2 FC                    RESET Vektor
.:FFFE 48 FF                    IRQ Vektor