jepler/c64ref
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
c64ref/c64disasm/c64disasm_en.txt

9615 lines
532 KiB
Text
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

- 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/c64disasm
-
------------------------------------------------------------
-
# 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 step
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
.:A19D 00 end marker
*** BASIC error messages
.:A19E 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 DEY adjust 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 INX increment 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 $A827 branch 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 $2C get 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 TXS correct 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 #$01 compare 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 PLA restore 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 TAX copy 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 #$FF else 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 PLA pop 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 INY else 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 $72 increment 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 $59 decrement array pointer high byte
.,B2CF C6 72 DEC $72 decrement block count high byte
.,B2D1 D0 F5 BNE $B2C8 loop until all blocks done
.,B2D3 E6 59 INC $59 correct 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 $64 add index low byte from FAC1 mantissa 3
.,B31C AA TAX save result low byte
.,B31D 98 TYA get result high byte
.,B31E A4 22 LDY $22 restore index
.,B320 65 65 ADC $65 add index high byte from FAC1 mantissa 4
.,B322 86 71 STX $71 save 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 $72 save 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 $48 get 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 $B487 print 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
.:B9D6 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], not a printable character
.,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 conversion of PETSCII character to screen code
.,E73B D0 02 BNE $E73F branch always
character is $20 to $5F
.,E73D 29 3F AND #$3F conversion of PETSCII character to screen code
.,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 #$00 clear 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 #$81 get 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 $F6 save 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
.:ECD0 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
.:ECE0 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 #$69 set 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 CLI enable 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
Reference in a new issue View git blame Copy permalink