; Synertek SYM BASIC V 1.1 assembly listing LAB_0000 = $00 ; JMP instruction LAB_0001 = $01 ; warm start vector low byte LAB_0002 = $02 ; warm start vector high byte LAB_0003 = $03 ; JMP instruction LAB_0004 = $04 ; print string vector low byte LAB_0005 = $05 ; print string vector high byte LAB_0006 = $06 ; float to fixed vector low byte LAB_0007 = $07 ; float to fixed vector low byte LAB_0008 = $08 ; fixed to float vector low byte LAB_0009 = $09 ; fixed to float vector low byte LAB_000A = $0A ; JMP instruction LAB_000B = $0B ; USR() vector low byte LAB_000C = $0C ; USR() vector low byte LAB_000D = $0D ; search character LAB_000E = $0E ; scan between quotes flag LAB_000F = $0F ; input buffer pointer; # of subscripts LAB_0010 = $10 ; default DIM flag LAB_0011 = $11 ; datatype flag type: FF=string, 00=numeric LAB_0012 = $12 ; datatype flag type: 80=integer, 00=float LAB_0013 = $13 ; flag: DATA scan; LIST quote; memory LAB_0014 = $14 ; subscript flag; FNX flag; misc LAB_0015 = $15 ; 00=INPUT; $40=GET; $98=READ LAB_0016 = $16 ; comparison evaluation flag LAB_0017 = $17 ; input flag, b7 = 1 will supress output LAB_0018 = $18 ; NULL count LAB_0019 = $19 ; POS byte LAB_001A = $1A ; width LAB_001B = $1B ; input column limit LAB_001C = $1C ; temp integer low byte LAB_001D = $1D ; temp integer high byte LAB_001E = $1E ; start of input buffer LAB_0065 = $65 ; end of input buffer LAB_0066 = $66 ; pointers for descriptor stack LAB_0067 = $67 ; LAB_0068 = $68 ; LAB_0069 = $69 ; descriptor stack (temp strings) LAB_0071 = $71 ; end of descriptor stack LAB_0072 = $72 ; utility pointer area LAB_0073 = $73 ; LAB_0074 = $74 ; LAB_0075 = $75 ; LAB_0076 = $76 ; product area for multiplication LAB_0077 = $77 ; LAB_0078 = $78 ; LAB_0079 = $79 ; LAB_007B = $7B ; start of mem low byte LAB_007C = $7C ; start of mem high byte LAB_007D = $7D ; start of vars low byte LAB_007E = $7E ; start of vars high byte LAB_007F = $7F ; start of arrays low byte LAB_0080 = $80 ; start of arrays high byte LAB_0081 = $81 ; end of arrays low byte LAB_0082 = $82 ; end of arrays high byte LAB_0083 = $83 ; start of strings low byte (moving down) LAB_0084 = $84 ; start of strings high byte LAB_0085 = $85 ; utility string pointer low byte LAB_0086 = $86 ; utility string pointer high byte LAB_0087 = $87 ; end of memory low byte LAB_0088 = $88 ; end of memory high byte LAB_0089 = $89 ; current Basic line number low byte LAB_008A = $8A ; current Basic line number high byte LAB_008B = $8B ; previous Basic line number low byte LAB_008C = $8C ; previous Basic line number high byte LAB_008D = $8D ; continue pointer low byte LAB_008E = $8E ; continue pointer high byte LAB_008F = $8F ; current DATA line number low byte LAB_0090 = $90 ; current DATA line number high byte LAB_0091 = $91 ; current DATA pointer low byte LAB_0092 = $92 ; current DATA pointer high byte LAB_0093 = $93 ; input vector low byte LAB_0094 = $94 ; input vector high byte LAB_0095 = $95 ; current variable name low byte LAB_0096 = $96 ; current variable name high byte LAB_0097 = $97 ; current variable address low byte LAB_0098 = $98 ; current variable address high byte LAB_0099 = $99 ; FOR/NEXT variable pointer low byte LAB_009A = $9A ; FOR/NEXT variable pointer high byte LAB_009B = $9B ; start of work area, pointers, etc LAB_009C = $9C ; LAB_009D = $9D ; LAB_009E = $9E ; LAB_009F = $9F ; LAB_00A0 = $A0 ; LAB_00A1 = $A1 ; LAB_00A3 = $A3 ; step size for garbage collect LAB_00A4 = $A4 ; JMP instruction LAB_00A5 = $A5 ; functions vector low byte LAB_00A6 = $A6 ; functions vector high byte LAB_00A7 = $A7 ; misc. numeric work area LAB_00A8 = $A8 ; LAB_00A9 = $A9 ; LAB_00AA = $AA ; LAB_00AB = $AB ; LAB_00AC = $AC ; LAB_00AD = $AD ; LAB_00AE = $AE ; LAB_00AF = $AF ; LAB_00B0 = $B0 ; LAB_00B1 = $B1 ; FAC1_e exponent LAB_00B2 = $B2 ; FAC1_1 mantissa LAB_00B3 = $B3 ; FAC1_2 mantissa LAB_00B4 = $B4 ; FAC1_3 mantissa LAB_00B5 = $B5 ; FAC1_4 mantissa LAB_00B6 = $B6 ; FACl_s sign LAB_00B7 = $B7 ; series evaluation constant pointer LAB_00B8 = $B8 ; FAC1_o hi-order (overflow) LAB_00B9 = $B9 ; FAC2_e exponent LAB_00BA = $BA ; FAC2_1 mantissa LAB_00BB = $BB ; FAC2_2 mantissa LAB_00BC = $BC ; FAC2_3 mantissa LAB_00BD = $BD ; FAC2_4 mantissa LAB_00BE = $BE ; FAC2_s mantissa LAB_00BF = $BF ; FAC_sc sign comparison LAB_00C0 = $C0 ; FAC_1 lo-order (rounding) LAB_00C1 = $C1 ; misc LAB_00C2 = $C2 ; misc LAB_00C3 = $C3 ; JMP instruction LAB_00C4 = $C4 ; SIN/COS/TAN/ATN vector low byte LAB_00C5 = $C5 ; SIN/COS/TAN/ATN vector high byte LAB_00C6 = $C6 ; JMP instruction LAB_00C7 = $C7 ; SAVE vector low byte LAB_00C8 = $C8 ; SAVE vector high byte LAB_00C9 = $C9 ; JMP instruction LAB_00CA = $CA ; LOAD vector low byte LAB_00CB = $CB ; LOAD vector high byte LAB_00CC = $CC ; get next BASIC byte subroutine LAB_00D2 = $D2 ; get current BASIC byte subroutine LAB_00D3 = $D3 ; BASIC execute pointer low byte LAB_00D4 = $D4 ; BASIC execute pointer high byte LAB_00E4 = $E4 ; random number seed LAB_00FF = $00FF ; FAC1 to string start LAB_0100 = $0100 ; offset for stack access LAB_0101 = $0101 ; offset for stack access LAB_0102 = $0102 ; offset for stack access LAB_0103 = $0103 ; offset for stack access LAB_0104 = $0104 ; offset for stack access LAB_0109 = $0109 ; offset for stack access LAB_010F = $010F ; offset for stack access LAB_0110 = $0110 ; offset for stack access LAB_0111 = $0111 ; offset for stack access LAB_0112 = $0112 ; offset for stack access LAB_0200 = $0200 ; start of user memory ; synmon routines LAB_8275 = $8275 ; ASCNIB convert chr to binary, Cb=0 if valid hex chr LAB_8386 = $8386 ; INSTAT - see if key down, result in carry ; waits for release LAB_8A1B = $8A1B ; INCHR - scan input device LAB_8A47 = $8A47 ; OUTCHR - byte to output device LAB_8B86 = $8B86 ; ACCESS - un write protect system RAM LAB_8C78 = $8C78 ; LOAD routine ; LOADT ENTER W/ID IN PARM 2, MODE IN [Y] LAB_8E87 = $8E87 ; SAVE routine ; synmon tape load/save parameters LAB_A64A = $A64A ; P3L - end address+1 low byte LAB_A64B = $A64B ; P3H - end address+1 high byte LAB_A64C = $A64C ; P2L - start address low byte LAB_A64D = $A64D ; P2H - start address high byte LAB_A64E = $A64E ; P1L - ID byte *= $C000 LAB_C000 JMP LAB_DE6D ; go do cold start LAB_C003 .word LAB_C624-1 ; END .word LAB_C535-1 ; FOR .word LAB_CAD8-1 ; NEXT .word LAB_C782-1 ; DATA .word LAB_C9B9-1 ; INPUT .word LAB_CE55-1 ; DIM .word LAB_C9E5-1 ; READ .word LAB_C82F-1 ; LET .word LAB_C72F-1 ; GOTO .word LAB_C707-1 ; RUN .word LAB_C7B2-1 ; IF .word LAB_C60A-1 ; RESTORE .word LAB_C712-1 ; GOSUB .word LAB_C75C-1 ; RETURN .word LAB_C7C5-1 ; REM .word LAB_C622-1 ; STOP .word LAB_C7D5-1 ; ON .word LAB_C665-1 ; NULL .word LAB_D5E3-1 ; WAIT .word LAB_C6B7-1 ; LOAD .word LAB_C676-1 ; SAVE .word LAB_D16C-1 ; DEF .word LAB_D5DA-1 ; POKE .word LAB_C8BE-1 ; PRINT .word LAB_C64B-1 ; CONT .word LAB_C4AD-1 ; LIST .word LAB_C472-1 ; CLEAR .word LAB_D002-1 ; GET - do "FC" error .word LAB_C456-1 ; NEW LAB_C03D LAB_BFE1 = LAB_C03D-$5C ; offset for table start *-(TK_SGN-$80)*2 LAB_BFE2 = LAB_BFE1+$01 .word LAB_D9EF ; SGN .word LAB_DA82 ; INT .word LAB_DA0E ; ABS .word LAB_000A ; USR .word LAB_D138 ; FRE .word LAB_D159 ; POS .word LAB_DCF3 ; SQR .word LAB_DE14 ; RND .word LAB_D7A0 ; LOG .word LAB_DD6F ; EXP .word LAB_00C3 ; COS .word LAB_00C3 ; SIN .word LAB_00C3 ; TAN .word LAB_00C3 ; ATN .word LAB_D5C3 ; PEEK .word LAB_D531 ; LEN .word LAB_D21E ; STR$ .word LAB_D562 ; VAL .word LAB_D540 ; ASC .word LAB_D4A1 ; CHR$ .word LAB_D4B5 ; LEFT$ .word LAB_D4E1 ; RIGHT$ .word LAB_D4EC ; MID$ LAB_C06B LAB_C06C = LAB_C06B+1 LAB_C06D = LAB_C06B+2 .byte $79 .word $D61F ; + .byte $79 .word $D608 ; - .byte $7B .word $D7E0 ; * .byte $7B .word $D8C7 ; / .byte $7F .word $DCFC ; ^ .byte $50 .word $CD27 ; AND .byte $46 .word $CD24 ; OR .byte $7D .word $DD35 ; > .byte $5A .word $CC73 ; = .byte $64 .word $CD54 ; < LAB_C089 LAB_C088 = LAB_C089-1 .byte "EN",("D"+$80) ; $80 .byte "FO",("R"+$80) ; $81 .byte "NEX",("T"+$80) ; $82 .byte "DAT",("A"+$80) ; $83 .byte "INPU",("T"+$80) ; $84 .byte "DI",("M"+$80) ; $85 .byte "REA",("D"+$80) ; $86 .byte "LE",("T"+$80) ; $87 .byte "GOT",("O"+$80) ; $88 .byte "RU",("N"+$80) ; $89 .byte "I",("F"+$80) ; $8A .byte "RESTOR",("E"+$80); $8B .byte "GOSU",("B"+$80) ; $8C .byte "RETUR",("N"+$80) ; $8D .byte "RE",("M"+$80) ; $8E .byte "STO",("P"+$80) ; $8F .byte "O",("N"+$80) ; $90 .byte "NUL",("L"+$80) ; $91 .byte "WAI",("T"+$80) ; $92 .byte "LOA",("D"+$80) ; $93 .byte "SAV",("E"+$80) ; $94 .byte "DE",("F"+$80) ; $95 .byte "POK",("E"+$80) ; $96 .byte "PRIN",("T"+$80) ; $97 .byte "CON",("T"+$80) ; $98 .byte "LIS",("T"+$80) ; $99 .byte "CLEA",("R"+$80) ; $9A .byte "GE",("T"+$80) ; $9B .byte "NE",("W"+$80) ; $9C .byte "TAB",("("+$80) ; $9D .byte "T",("O"+$80) ; $9E .byte "F",("N"+$80) ; $9F .byte "SPC",("("+$80) ; $A0 .byte "THE",("N"+$80) ; $A1 .byte "NO",("T"+$80) ; $A2 .byte "STE",("P"+$80) ; $A3 .byte ("+"+$80) ; $A4 .byte ("-"+$80) ; $A5 .byte ("*"+$80) ; $A6 .byte ("/"+$80) ; $A7 .byte ("^"+$80) ; $A8 .byte "AN",("D"+$80) ; $A9 .byte "O",("R"+$80) ; $AA .byte (">"+$80) ; $AB .byte ("="+$80) ; $AC .byte ("<"+$80) ; $AD .byte "SG",("N"+$80) ; $AE .byte "IN",("T"+$80) ; $AF .byte "AB",("S"+$80) ; $B0 .byte "US",("R"+$80) ; $B1 .byte "FR",("E"+$80) ; $B2 .byte "PO",("S"+$80) ; $B3 .byte "SQ",("R"+$80) ; $B4 .byte "RN",("D"+$80) ; $B5 .byte "LO",("G"+$80) ; $B6 .byte "EX",("P"+$80) ; $B7 .byte "CO",("S"+$80) ; $B8 .byte "SI",("N"+$80) ; $B9 .byte "TA",("N"+$80) ; $BA .byte "AT",("N"+$80) ; $BB .byte "PEE",("K"+$80) ; $BC .byte "LE",("N"+$80) ; $BD .byte "STR",("$"+$80) ; $BE .byte "VA",("L"+$80) ; $BF .byte "AS",("C"+$80) ; $C0 .byte "CHR",("$"+$80) ; $C1 .byte "LEFT",("$"+$80) ; $C2 .byte "RIGHT",("$"+$80) ; $C3 .byte "MID",("$"+$80) ; $C4 .byte "G",("O"+$80) ; $C5 .byte $00 LAB_C16E LAB_C16F = LAB_C16E+1 .byte "N",("F"+$80) ; Next without For .byte "S",("N"+$80) ; SyNtax .byte "R",("G"+$80) ; Return without Gosub .byte "O",("D"+$80) ; Out of Data .byte "F",("C"+$80) ; Function Call .byte "O",("V"+$80) ; OVerflow .byte "O",("M"+$80) ; Out of Memory .byte "U",("S"+$80) ; Undefined Statement .byte "B",("S"+$80) ; array BoundS .byte "D",("D"+$80) ; Double Dimension .byte "/",("0"+$80) ; / 0 .byte "I",("D"+$80) ; Illegal Direct .byte "T",("M"+$80) ; Type Mismatch .byte "L",("S"+$80) ; Long String .byte "S",("T"+$80) ; String To complex .byte "C",("N"+$80) ; CaN't continue .byte "U",("F"+$80) ; Undefined Function LAB_C190 .byte " ERROR",$00 LAB_C197 .byte " IN ",$00 LAB_C19C .byte $0D,$0A,"OK",$0D,$0A,$00 LAB_C1A3 .byte $0D,$0A,"BREAK",$00 ; search the stack for FOR or GOSUB activity ; exit with z=1 if FOR else exit with z=0 LAB_C1AB TSX ; copy stack pointer INX ; +1 pass return address INX ; +2 pass return address INX ; +3 pass calling routine return address INX ; +4 pass calling routine return address LAB_C1B0 LDA LAB_0101,X ; get token byte from stack CMP #$81 ; is it FOR token BNE LAB_C1D8 ; exit if not FOR token ; was FOR token LDA LAB_009A ; get var pointer for FOR/NEXT high byte BNE LAB_C1C5 ; branch if not null LDA LAB_0102,X ; get FOR variable pointer low byte STA LAB_0099 ; save var pointer for FOR/NEXT low byte LDA LAB_0103,X ; get FOR variable pointer high byte STA LAB_009A ; save var pointer for FOR/NEXT high byte LAB_C1C5 CMP LAB_0103,X ; compare var pointer with stacked var pointer(high byte) BNE LAB_C1D1 ; branch if no match LDA LAB_0099 ; get var pointer for FOR/NEXT low byte CMP LAB_0102,X ; compare var pointer with stacked var pointer (low byte) BEQ LAB_C1D8 ; exit if match found LAB_C1D1 TXA ; copy index CLC ; clear carry for add ADC #$12 ; add FOR stack use size TAX ; copy back to index BNE LAB_C1B0 ; loop if not at start of stack LAB_C1D8 RTS ; open up space in memory LAB_C1D9 JSR LAB_C229 ; check available memory, "OM" error if no room ; addr to check is in AY (low/high) STA LAB_0081 ; save new array mem end low byte STY LAB_0082 ; save new array mem end high byte ; open up space in memory ; don't set array end LAB_C1E0 SEC ; set carry for subtract LDA LAB_00AA ; get block end low byte SBC LAB_00AF ; subtract block start low byte STA LAB_0072 ; save MOD(block length/$100) byte TAY ; copy MOD(block length/$100) byte to Y LDA LAB_00AB ; get block end high byte SBC LAB_00B0 ; subtract block start high byte TAX ; copy block length high byte to X INX ; +1 to allow for count=0 exit TYA ; copy block length low byte to A BEQ LAB_C214 ; branch if length low byte=0 ; block is (X-1)*256+Y bytes, do the Y bytes first LDA LAB_00AA ; get block end low byte SEC ; set carry for subtract SBC LAB_0072 ; subtract MOD(block length/$100) byte STA LAB_00AA ; save corrected old block end low byte BCS LAB_C1FD ; branch if no underflow DEC LAB_00AB ; else decrement block end high byte SEC ; set carry for subtract LAB_C1FD LDA LAB_00A8 ; get destination end low byte SBC LAB_0072 ; subtract MOD(block length/$100) byte STA LAB_00A8 ; save modified new block end low byte BCS LAB_C20D ; branch if no underflow DEC LAB_00A9 ; else decrement block end high byte BCC LAB_C20D ; branch always LAB_C209 LDA (LAB_00AA),Y ; get byte from source STA (LAB_00A8),Y ; copy byte to destination LAB_C20D DEY ; decrement index BNE LAB_C209 ; loop until Y=0 ; now do Y=0 indexed byte LDA (LAB_00AA),Y ; get byte from source STA (LAB_00A8),Y ; save byte to destination LAB_C214 DEC LAB_00AB ; decrement source pointer high byte DEC LAB_00A9 ; decrement destination pointer high byte DEX ; decrement block count BNE LAB_C20D ; loop until count = $0 RTS ; check room on stack for 2*A bytes ; stack too deep? do OM error LAB_C21C ASL ; *2 ADC #$3E ; + offset BCS LAB_C256 ; if stack < limit do "OM" error, then warm start STA LAB_0072 ; save result in temp byte TSX ; copy stack CPX LAB_0072 ; compare new "limit" with stack BCC LAB_C256 ; if stack < limit do "OM" error, then warm start RTS ; check available memory, "OM" error if no room ; addr to check is in AY (low/high) LAB_C229 CPY LAB_0084 ; compare bottom of string mem high byte BCC LAB_C255 ; if less then exit (is ok) BNE LAB_C233 ; skip next test if greater (tested <) ; high byte was =, now do low byte CMP LAB_0083 ; compare with bottom of string mem low byte BCC LAB_C255 ; if less then exit (is ok) ; addr is > string storage ptr (oops!) LAB_C233 PHA ; push addr low byte LDX #$09 ; set index to save Adatal to expneg inclusive TYA ; copy addr high byte (to push on stack) ; save misc numeric work area LAB_C237 PHA ; push byte LDA LAB_00A7,X ; get byte from Adatal to expneg ( ,$00 not pushed) DEX ; decrement index BPL LAB_C237 ; loop until all done JSR LAB_D2DB ; garbage collection routine ; restore misc numeric work area LDX #$F7 ; set index to restore bytes LAB_C242 PLA ; pop byte STA LAB_00B1,X ; save byte to Adatal to expneg ( ,$00 not pulled) INX ; increment index BMI LAB_C242 ; loop while -ve PLA ; pop addr high byte TAY ; copy back to Y PLA ; pop addr low byte CPY LAB_0084 ; compare bottom of string mem high byte BCC LAB_C255 ; if less then exit (is ok) BNE LAB_C256 ; if greater do "OM" error, then warm start ; high byte was =, now do low byte CMP LAB_0083 ; compare with bottom of string mem low byte BCS LAB_C256 ; if >= do "OM" error, then warm start ; ok exit, carry clear LAB_C255 RTS ; do "OM" error, then warm start LAB_C256 LDX #$0C ; error code $0C ("OM" error) ; do error #X, then warm start LAB_C258 LSR LAB_0017 ; clear input flag (allow output) JSR LAB_C8FE ; print CR/LF and # nulls JSR LAB_C974 ; print "?" character LDA LAB_C16E,X ; get error character from table JSR LAB_C976 ; go print the character LDA LAB_C16F,X ; get error character from table JSR LAB_C976 ; go print the character JSR LAB_C48B ; flush stack and clear continue flag LDA #LAB_C190 ; pointer to " ERROR" low byte LAB_C273 JSR LAB_C954 ; print null terminated string from (AY) LDY LAB_008A ; get current line high byte INY ; increment it BEQ LAB_C27E ; if $00 go do warm start (was immediate mode) ; else print line number JSR LAB_DB7F ; print " in line [LINE #]" ; BASIC warm start entry point ; wait for Basic command LAB_C27E LSR LAB_0017 ; clear input flag (allow output) LDA #LAB_C19C ; pointer to [CR][LF]OK high byte JSR LAB_0003 ; go do print string (via print vector) ; BASIC warm start entry point, no "OK" LAB_C287 JSR LAB_C35F ; call for BASIC input STX LAB_00D3 ; set BASIC execute pointer low byte STY LAB_00D4 ; set BASIC execute pointer high byte JSR LAB_00CC ; increment and scan memory TAX ; copy byte BEQ LAB_C287 ; loop while null ; got to interpret input line now .... LDX #$FF ; current line to null value STX LAB_008A ; set current line high byte BCC LAB_C2A0 ; branch if numeric character (handle new BASIC line) ; no line number .. immediate mode JSR LAB_C39F ; crunch keywords into Basic tokens JMP LAB_C5D1 ; go scan and interpret code ; handle new BASIC line LAB_C2A0 JSR LAB_C7F5 ; get fixed-point number into temp integer JSR LAB_C39F ; crunch keywords into Basic tokens STY LAB_000F ; save index pointer to end of crunched line JSR LAB_C427 ; search BASIC for temp integer line number BCC LAB_C2F1 ; branch if not found ; aroooogah! line # already exists! delete it LDY #$01 ; set index to next line pointer high byte LDA (LAB_00AF),Y ; get next line pointer high byte STA LAB_0073 ; save it LDA LAB_007D ; get start of vars low byte STA LAB_0072 ; save it LDA LAB_00B0 ; get found line pointer high byte STA LAB_0075 ; save it LDA LAB_00AF ; get found line pointer low byte DEY ; decrement index SBC (LAB_00AF),Y ; subtract next line pointer low byte CLC ; clear carry for add ADC LAB_007D ; add start of vars low byte STA LAB_007D ; save new start of vars low byte STA LAB_0074 ; save destination pointer low byte LDA LAB_007E ; get start of vars high byte ADC #$FF ; -1 + carry STA LAB_007E ; save start of vars high byte SBC LAB_00B0 ; subtract found line pointer high byte TAX ; copy to block count SEC ; set carry for subtract LDA LAB_00AF ; get found line pointer low byte SBC LAB_007D ; subtract start of vars low byte TAY ; copy to bytes in first block count BCS LAB_C2DB ; branch if overflow INX ; increment block count (correct for =0 loop exit) DEC LAB_0075 ; decrement destination high byte LAB_C2DB CLC ; clear carry for add ADC LAB_0072 ; add source pointer low byte BCC LAB_C2E3 ; branch if no overflow DEC LAB_0073 ; else decrement source pointer high byte CLC ; clear carry ; close up memory to delete old line LAB_C2E3 LDA (LAB_0072),Y ; get byte from source STA (LAB_0074),Y ; copy to destination INY ; increment index BNE LAB_C2E3 ; while <> 0 do this block INC LAB_0073 ; increment source pointer high byte INC LAB_0075 ; increment destination pointer high byte DEX ; decrement block count BNE LAB_C2E3 ; loop until all done ; got new line in buffer and no existing same # LAB_C2F1 JSR LAB_C46D ; reset execution to start, clear vars and flush stack JSR LAB_C32C ; rebuild chaining of BASIC lines LDA LAB_001E ; get byte from start if input buffer BEQ LAB_C287 ; if null line just go do warm start ; got new line and it isn't empty line CLC ; clear carry for add LDA LAB_007D ; get start of vars low byte (end of BASIC) STA LAB_00AA ; save old block end low byte ADC LAB_000F ; add input buffer pointer (also buffer length) STA LAB_00A8 ; save new block end low byte (move to, low byte) LDY LAB_007E ; get start of vars high byte (end of BASIC) STY LAB_00AB ; save old block end high byte BCC LAB_C30B ; branch if no overflow from add INY ; else increment block end high byte LAB_C30B STY LAB_00A9 ; save new block end high byte JSR LAB_C1D9 ; open up space in memory LDA LAB_0081 ; get array mem end low byte LDY LAB_0082 ; get array mem end high byte STA LAB_007D ; save start of vars low byte STY LAB_007E ; save start of vars high byte LDY LAB_000F ; get input buffer pointer (also buffer length) DEY ; adjust for loop type LAB_C31B LDA LAB_001A,Y ; get byte from crunched line STA (LAB_00AF),Y ; save it to program memory DEY ; decrement count BPL LAB_C31B ; continue while count +ve LAB_C323 JSR LAB_C46D ; reset execution to start, clear vars and flush stack JSR LAB_C32C ; rebuild chaining of BASIC lines JMP LAB_C287 ; BASIC warm start entry point, no "OK" ; rebuild chaining of BASIC lines LAB_C32C LDA LAB_007B ; get start of mem low byte LDY LAB_007C ; get start of mem high byte STA LAB_0072 ; set line start pointer low byte STY LAB_0073 ; set line start pointer high byte CLC ; clear carry for possible later add LAB_C335 LDY #$01 ; index to high byte of next line pointer LDA (LAB_0072),Y ; get it BEQ LAB_C358 ; branch if no following line LDY #$04 ; point to first code byte of line, there is ; always 1 byte + [EOL] as null entries are deleted LAB_C33D INY ; next code byte LDA (LAB_0072),Y ; get byte BNE LAB_C33D ; loop if not [EOL] INY ; point to byte past [EOL] (start of next line) TYA ; copy it ADC LAB_0072 ; add to line start pointer low byte TAX ; copy to X LDY #$00 ; clear index (point to this line's next line pointer) STA (LAB_0072),Y ; set next line pointer low byte LDA LAB_0073 ; get line start pointer high byte ADC #$00 ; add any overflow INY ; increment index to high byte STA (LAB_0072),Y ; set next line pointer low byte STX LAB_0072 ; set line start pointer low byte STA LAB_0073 ; set line start pointer high byte BCC LAB_C335 ; go do next line (carry always clear) LAB_C358 RTS ; "_" = delete character from buffer LAB_C359 DEX ; decrement the buffer counter (delete) BPL LAB_C361 ; go get next character ; "@" = delete line from buffer LAB_C35C JSR LAB_C8FE ; print CR/LF ; call for BASIC input (main entry point) LAB_C35F LDX #$00 ; clear BASIC line buffer pointer LAB_C361 JSR LAB_C38F ; call scan input device CMP #$07 ; compare with [BELL] BEQ LAB_C37C ; branch if [BELL] CMP #$0D ; compare with [CR] BEQ LAB_C38C ; do CR/LF exit if [CR] CMP #$20 ; compare with [SP] BCC LAB_C361 ; if < ignore character CMP #$7D ; compare with "z"+1 BCS LAB_C361 ; if >= ignore character CMP #$40 ; compare with "@" BEQ LAB_C35C ; if "@" go dump line CMP #$5F ; compare with "_" BEQ LAB_C359 ; if "_" go delete character LAB_C37C CPX #$47 ; compare character count with max (end-start) BCS LAB_C385 ; skip store and do [BELL] if buffer full STA LAB_001E,X ; else store in buffer INX ; increment pointer BNE LAB_C361 ; go get next ; announce buffer full LAB_C385 LDA #$07 ; [BELL] character into A JSR LAB_C976 ; go print the [BELL] BNE LAB_C361 ; go get next LAB_C38C JMP LAB_C8F6 ; do CR/LF exit to BASIC ; scan input device LAB_C38F JSR LAB_8A1B ; INCHR - scan input device CMP #$14 ; compare with CTRL-T BNE LAB_C39E ; exit if not CTRL-T PHA ; save character LDA LAB_0017 ; get input flag EOR #$FF ; toggle it STA LAB_0017 ; save it back PLA ; restore character LAB_C39E RTS ; crunch keywords into Basic tokens ; returns pointer pointing to buffer-1 LAB_C39F LDX LAB_00D3 ; BASIC execute pointer low byte (index to buffer) LDY #$04 ; set buffer save index STY LAB_0013 ; clear open quote flag LAB_C3A5 LDA LAB_0000,X ; get byte from buffer CMP #$20 ; compare with [SPACE] BEQ LAB_C3E1 ; if so save byte then continue crunching STA LAB_000E ; save buffer byte as search character CMP #$22 ; is it quote character? BEQ LAB_C405 ; branch if so (copy quoted string) BIT LAB_0013 ; get open quote/DATA token flag BVS LAB_C3E1 ; branch if b6 of Oquote set (was DATA) ; go save byte then continue crunching CMP #$3F ; compare with "?" character (PRINT) BNE LAB_C3BD ; branch if not "?" LDA #$97 ; else keyword token is TK_PRINT BNE LAB_C3E1 ; always branch, save byte then continue crunching ; wasn't [SPACE], " or ? LAB_C3BD CMP #$30 ; compare with "0" BCC LAB_C3C5 ; branch if < (continue crunching) CMP #$3C ; compare with "<" BCC LAB_C3E1 ; branch if < (was 0123456789:;) ; go save byte then continue crunching ; gets here with next character not numeric or ; or : LAB_C3C5 STY LAB_00C1 ; copy buffer save index LDY #$00 ; set keyword table pointer STY LAB_000F ;. DEY ; adjust for loop STX LAB_00D3 ; save buffer pointer DEX ; adjust for loop LAB_C3CF INY ; increment table index INX ; increment buffer index LAB_C3D1 LDA LAB_0000,X ; get byte from input buffer SEC ; set carry for subtract SBC LAB_C089,Y ; subtract table byte BEQ LAB_C3CF ; go compare next if match CMP #$80 ; was it end marker match ? BNE LAB_C40C ; branch if not (not found keyword) ; else found keyword ORA LAB_000F ; OR with word index (+$80 in A makes token) LAB_C3DF LDY LAB_00C1 ; restore save index LAB_C3E1 INX ; increment buffer index INY ; increment save index STA LAB_0019,Y ; save byte to output LDA LAB_0019,Y ; set the flags BEQ LAB_C41F ; branch if was null [EOL] ; A holds token or byte here SEC ; set carry for subtract SBC #$3A ; subtract ":" BEQ LAB_C3F4 ; branch if it was ":" (is now $00) ; A now holds token-$3A CMP #$49 ; compare with DATA token - $3A BNE LAB_C3F6 ; branch if not DATA ; token was : or DATA LAB_C3F4 STA LAB_0013 ; save token-$3A (clear for ":", TK_DATA-$3A for DATA) LAB_C3F6 SEC ; set carry for subtract SBC #$54 ; subtract REM token offset BNE LAB_C3A5 ; If wasn't REM then go crunch rest of line STA LAB_000E ; else was REM so set search for [EOL] ; loop for REM, "..." etc. LAB_C3FD LDA LAB_0000,X ; get byte from input buffer BEQ LAB_C3E1 ; branch if null [EOL] CMP LAB_000E ; compare with stored character BEQ LAB_C3E1 ; branch if match (end quote) ; entry for copy string in quotes, don't crunch LAB_C405 INY ; increment buffer save index STA LAB_0019,Y ; save byte to output INX ; increment buffer read index BNE LAB_C3FD ; loop while <> 0 (should never be 0!) ; not found keyword this go LAB_C40C LDX LAB_00D3 ; compare has failed, restore buffer index INC LAB_000F ; increment keyword index (next keyword) ; now find the end of this word in the table LAB_C410 INY ; increment table index LDA LAB_C088,Y ; get table byte BPL LAB_C410 ; if not end of keyword go do next LDA LAB_C089,Y ; get byte from keyword table BNE LAB_C3D1 ; go test next word if not zero byte (end of table) ; reached end of table with no match LDA LAB_0000,X ; restore byte from input buffer BPL LAB_C3DF ; branch always (all bytes in buffer are $00-$7F) ; go save byte in output and continue crunching ; reached [EOL] LAB_C41F STA LAB_001B,Y ; save [EOL] (marks [EOT] in immediate mode) LDA #$1D ; set pointer to start STA LAB_00D3 ; save BASIC execute pointer low byte RTS ; search BASIC for temp integer line number LAB_C427 LDA LAB_007B ; get start of mem low byte LDX LAB_007C ; get start of mem high byte ; search Basic for temp integer line number from AX ; returns carry set if found ; returns pointer to found or next higher (not found) line LAB_C42B LDY #$01 ; set index STA LAB_00AF ; save low byte as current STX LAB_00B0 ; save high byte as current LDA (LAB_00AF),Y ; get pointer high byte from addr BEQ LAB_C454 ; pointer was zero so we're done, do 'not found' exit INY ; increment index ... INY ; ... to line # high byte LDA LAB_001D ; get temp integer high byte CMP (LAB_00AF),Y ; compare with line # high byte BCC LAB_C455 ; if temp < this line, exit (passed line#) BEQ LAB_C442 ; else if = go check low byte DEY ; decrement index (point to low byte) BNE LAB_C44B LAB_C442 LDA LAB_001C ; get temp integer low byte DEY ; decrement index CMP (LAB_00AF),Y ; compare with line # low byte BCC LAB_C455 ; if temp < this line, exit (passed line#) BEQ LAB_C455 ; else if = exit (found line) LAB_C44B DEY ; decrement index (point to next line high byte) LDA (LAB_00AF),Y ; get next line high byte TAX ; copy to X DEY ; decrement index (point to next line low byte) LDA (LAB_00AF),Y ; get next line low byte BCS LAB_C42B ; loop (carry always set) LAB_C454 CLC ; flag not found LAB_C455 RTS ; perform NEW LAB_C456 BNE LAB_C455 ; exit if not end of statement (to do syntax error) LAB_C458 LDA #$00 ; clear A TAY ; clear Y STA (LAB_007B),Y ; clear first line, next line pointer, low byte INY ; increment index STA (LAB_007B),Y ; clear first line, next line pointer, high byte LDA LAB_007B ; get start of mem low byte CLC ; clear carry ADC #$02 ; calculate end of BASIC low byte STA LAB_007D ; save start of vars low byte LDA LAB_007C ; get start of mem high byte ADC #$00 ; add any carry STA LAB_007E ; save start of vars high byte ; reset execution to start, clear vars and flush stack LAB_C46D JSR LAB_C49F ; reset execution to start, clear vars and flush stack LDA #$00 ; clear flags ; CLEAR LAB_C472 BNE LAB_C49E ; branch if following token (to do SN error) LAB_C474 LDA LAB_0087 ; get end of mem low byte LDY LAB_0088 ; get end of mem high byte STA LAB_0083 ; set bottom of string space low byte STY LAB_0084 ; set bottom of string space high byte LDA LAB_007D ; get start of vars low byte LDY LAB_007E ; get start of vars high byte STA LAB_007F ; save var mem end low byte STY LAB_0080 ; save var mem end high byte STA LAB_0081 ; save array mem end low byte STY LAB_0082 ; save array mem end high byte JSR LAB_C60A ; perform RESTORE command ; flush stack and clear continue flag LAB_C48B LDX #$69 ; set descriptor stack pointer STX LAB_0066 ; save descriptor stack pointer PLA ; pull return address low byte TAY ; copy return address low byte PLA ; pull return address high byte LDX #$FE ; new stack pointer TXS ; reset stack PHA ; save return address high byte to cleared stack TYA ; get return address low byte back PHA ; save to cleared stack LDA #$00 ; clear byte STA LAB_008E ; clear continue pointer high byte STA LAB_0014 ; clear subscript/FNX flag LAB_C49E RTS ; reset execution to start, clear vars and flush stack LAB_C49F CLC ; clear carry LDA LAB_007B ; get start of mem low byte ADC #$FF ; -1 STA LAB_00D3 ; save BASIC execute pointer low byte LDA LAB_007C ; get start of mem high byte ADC #$FF ; -1+carry STA LAB_00D4 ; save BASIC execute pointer high byte RTS ; LIST LAB_C4AD PHP ; save flags JSR LAB_C7F5 ; get fixed-point number into temp integer JSR LAB_C427 ; search BASIC for temp integer line number PLP ; restore flags BEQ LAB_C4CB ; branch if no following JSR LAB_00D2 ; scan memory BEQ LAB_C4D1 ; branch if next character [NULL] (LIST) CMP #$A5 ; compare with token for - BNE LAB_C455 ; exit if not - (LIST -m) JSR LAB_00CC ; increment and scan memory BEQ LAB_C4CB ; no end so go set 65525 JSR LAB_C7F5 ; get fixed-point number into temp integer BEQ LAB_C4D1 ; branch if no following ; else return to do SN error RTS LAB_C4CB LDA #$FF ; set end line to 65535 STA LAB_001C ; temp integer low byte STA LAB_001D ; temp integer high byte LAB_C4D1 PLA ; pull return address (exit via warm start) PLA ; pull return address (exit via warm start) LAB_C4D3 LDY #$01 ; set index for line LDA (LAB_00AF),Y ; get next line pointer high byte BEQ LAB_C512 ; if null all done so exit JSR LAB_C619 ; do CRTL-C check vector JSR LAB_C8FE ; print CR/LF INY ; increment index for line LDA (LAB_00AF),Y ; get line # low byte TAX ; copy to X INY ; increment index LDA (LAB_00AF),Y ; get line # high byte CMP LAB_001D ; compare with temporary integer high byte BNE LAB_C4EE ; branch if no high byte match CPX LAB_001C ; compare with temporary integer low byte BEQ LAB_C4F0 ; branch if = last line to do (< will pass next branch) LAB_C4EE ; else ... BCS LAB_C512 ; if greater all done so exit LAB_C4F0 STY LAB_0099 ; save index for line JSR LAB_DB8A ; print XA as unsigned integer LDA #$20 ; space is the next character LAB_C4F7 LDY LAB_0099 ; get index for line AND #$7F ; mask top out bit of character LAB_C4FB JSR LAB_C976 ; go print the character INY ; increment index BEQ LAB_C512 ; oops! run off top so warm start LDA (LAB_00AF),Y ; get next byte BNE LAB_C515 ; branch if not [EOL] (go print character) ; was [EOL] TAY ; else clear index LDA (LAB_00AF),Y ; get next line pointer low byte TAX ; copy to X INY ; increment index LDA (LAB_00AF),Y ; get next line pointer high byte STX LAB_00AF ; set pointer to line low byte STA LAB_00B0 ; set pointer to line high byte BNE LAB_C4D3 ; go do next line if not [EOT] ; else ... LAB_C512 JMP LAB_C27E ; go do warm start LAB_C515 BPL LAB_C4FB ; just go print it if not token byte ; else was token byte so uncrunch it (maybe) SEC ; else set carry for subtract SBC #$7F ; reduce token range to 1 to whatever TAX ; copy token # to X STY LAB_0099 ; save index for line LDY #$FF ; set index byte LAB_C51F DEX ; decrement token # BEQ LAB_C52A ; if now found go do printing LAB_C522 INY ; increment table index LDA LAB_C089,Y ; get byte from keyword table BPL LAB_C522 ; loop until keyword end marker BMI LAB_C51F ; go test if this is required keyword ; found keyword (it's the next one) LAB_C52A INY ; increment table index LDA LAB_C089,Y ; get byte from table BMI LAB_C4F7 ; go restore index, mask byte and print if ; byte was end marker JSR LAB_C976 ; go print the character BNE LAB_C52A ; go get next character (branch always) ; perform FOR LAB_C535 LDA #$80 ; set FNX STA LAB_0014 ; set subscript/FNX flag JSR LAB_C82F ; go do LET JSR LAB_C1AB ; search the stack for FOR or GOSUB activity BNE LAB_C546 ; branch if FOR (this var) not found ; FOR (this var) was found so first we dump the old one TXA ; copy index ADC #$0F ; add FOR structure size TAX ; add to index TXS ; set stack (dump FOR structure) LAB_C546 PLA ; pull return address PLA ; pull return address LDA #$09 ; we need 9*2 bytes ! JSR LAB_C21C ; check room on stack for 2*A bytes JSR LAB_C790 ; scan for next BASIC statement ([:] or [EOL]) CLC ; clear carry for add TYA ; copy index to A ADC LAB_00D3 ; add BASIC execute pointer low byte PHA ; push onto stack LDA LAB_00D4 ; get BASIC execute pointer high byte ADC #$00 ; add carry PHA ; push onto stack LDA LAB_008A ; get current line high byte PHA ; push onto stack LDA LAB_0089 ; get current line low byte PHA ; push onto stack LDA #$9E ; get "TO" token JSR LAB_CCAD ; scan for CHR$(A) , else do SN error, then warm start JSR LAB_CB46 ; check if source is numeric, else do type mismatch JSR LAB_CB43 ; evaluate expression and check is numeric, ; else do type mismatch LDA LAB_00B6 ; get FAC1 sign (b7) ORA #$7F ; set all non sign bits AND LAB_00B2 ; and FAC1 mantissa1 STA LAB_00B2 ; save FAC1 mantissa1 LDA #LAB_C57E ; set return address high byte STA LAB_0072 ; save return address low byte STY LAB_0073 ; save return address high byte JMP LAB_CBFC ; round FAC1 and put on stack ; (returns to next instruction) LAB_C57E LDA #LAB_D772 ; set 1 pointer high addr JSR LAB_D958 ; unpack memory (AY) into FAC1 JSR LAB_00D2 ; scan memory CMP #$A3 ; compare with STEP token BNE LAB_C592 ; jump if not "STEP" ; was step so .... JSR LAB_00CC ; increment and scan memory JSR LAB_CB43 ; evaluate expression and check is numeric, ; else do type mismatch LAB_C592 JSR LAB_D9E1 ; return A=FF,C=1/-ve A=01,C=0/+ve JSR LAB_CBF1 ; push sign, round FAC1 and put on stack LDA LAB_009A ; get var pointer for FOR/NEXT high byte PHA ; push on stack LDA LAB_0099 ; get var pointer for FOR/NEXT low byte PHA ; push on stack LDA #$81 ; get FOR token PHA ; push on stack ; interpreter inner loop LAB_C5A1 JSR LAB_C619 ; do CRTL-C check vector LDA LAB_00D3 ; get BASIC execute pointer low byte LDY LAB_00D4 ; get BASIC execute pointer high byte BEQ LAB_C5B0 ; branch if null (immediate mode) STA LAB_008D ; save continue pointer low byte STY LAB_008E ; save continue pointer high byte LDY #$00 ; clear index LAB_C5B0 LDA (LAB_00D3),Y ; get next byte BNE LAB_C5F4 ; branch if null [EOL] LDY #$02 ; set index LDA (LAB_00D3),Y ; get next line pointer high byte CLC ; clear carry for no "BREAK" message BNE LAB_C5BE ; if not null continue JMP LAB_C63B ; else go to immediate mode LAB_C5BE INY ; increment index LDA (LAB_00D3),Y ; get line # low byte STA LAB_0089 ; save current line low byte INY ; increment index LDA (LAB_00D3),Y ; get line # high byte STA LAB_008A ; save current line high byte TYA ; A now = 4 ADC LAB_00D3 ; add BASIC execute pointer low byte STA LAB_00D3 ; save BASIC execute pointer low byte BCC LAB_C5D1 ; branch if no overflow INC LAB_00D4 ; else increment BASIC execute pointer high byte LAB_C5D1 JSR LAB_00CC ; increment and scan memory JSR LAB_C5DA ; go interpret BASIC code from execute pointer JMP LAB_C5A1 ; loop ; interpret BASIC code from execute pointer LAB_C5DA BEQ LAB_C618 ; exit if zero [EOL] LAB_C5DC SBC #$80 ; normalise token BCC LAB_C5F1 ; if wasn't $80 - $FF go do implied LET CMP #$1D ; compare normalised token with TAB BCS LAB_C5FB ; branch if A>=TAB ASL ; *2 (2 bytes per vector) TAY ; copy to index LDA LAB_C003+1,Y ; get vector high byte PHA ; onto stack LDA LAB_C003,Y ; get vector low byte PHA ; onto stack JMP LAB_00CC ; increment and scan memory and return ; then "return" to vector LAB_C5F1 JMP LAB_C82F ; go do LET LAB_C5F4 CMP #$3A ; compare with ":" BEQ LAB_C5D1 ; branch if = (statement separator) LAB_C5F8 JMP LAB_CCB6 ; else syntax error, then warm start LAB_C5FB CMP #$45 ; compare with GO tokem BNE LAB_C5F8 ; branch if not GO token (do syntax error, then warm start) ; only tokens before TAB and GO can start a line JSR LAB_00CC ; increment and scan memory LDA #$9E ; set TO token JSR LAB_CCAD ; scan for CHR$(A) , else do syntax error, then warm start JMP LAB_C72F ; perform GOTO n ; perform RESTORE LAB_C60A SEC ; set carry for subtract LDA LAB_007B ; get start of mem low byte SBC #$01 ; -1 LDY LAB_007C ; get start of mem high byte BCS LAB_C614 ; branch if no underflow DEY ; else decrement high byte LAB_C614 STA LAB_0091 ; save DATA pointer low byte STY LAB_0092 ; save DATA pointer high byte LAB_C618 RTS ; CRTL-C check LAB_C619 JSR LAB_8386 ; INSTAT - see if key down BCC LAB_C664 ; exit if no key ?? LDA #$03 ; force CTRL-C CMP #$03 ; compare with CTRL-C ; perform STOP LAB_C622 BCS LAB_C625 ; branch if token follows STOP or was CTRL-C ; else just END ; perform END LAB_C624 CLC ; clear carry for no "break" message LAB_C625 BNE LAB_C664 ; return if wasn't CTRL-C LDA LAB_00D3 ; get BASIC execute pointer high byte LDY LAB_00D4 ; get BASIC execute pointer low byte BEQ LAB_C639 ; branch if BASIC pointer is in buffer ; (can't continue in immediate mode) ; else... STA LAB_008D ; save continue pointer low byte STY LAB_008E ; save continue pointer high byte LAB_C631 LDA LAB_0089 ; get current line low byte LDY LAB_008A ; get current line high byte STA LAB_008B ; save break line low byte STY LAB_008C ; save break line high byte LAB_C639 PLA ; pull return address low PLA ; pull return address high LAB_C63B LDA #LAB_C1A3 ; point to "Break" high byte LDX #$00 ; clear byte STX LAB_0017 ; clear input flag - allow output BCC LAB_C648 ; branch if was END ; else do BREAK JMP LAB_C273 ; print "Break" and do warm start LAB_C648 JMP LAB_C27E ; go do warm start ; perform CONT LAB_C64B BNE LAB_C664 ; if following byte exit to do syntax error LDX #$1E ; set for CN error LDY LAB_008E ; get continue pointer high byte BNE LAB_C656 ; branch if can continue JMP LAB_C258 ; do error #X, then warm start LAB_C656 LDA LAB_008D ; get continue pointer low byte STA LAB_00D3 ; save BASIC execute pointer low byte STY LAB_00D4 ; save BASIC execute pointer high byte LDA LAB_008B ; get break line low byte LDY LAB_008C ; get break line high byte STA LAB_0089 ; set current line low byte STY LAB_008A ; set current line high byte LAB_C664 RTS ; perform NULL LAB_C665 JSR LAB_D553 ; get byte parameter BNE LAB_C664 ; branch if following byte - allow SN error INX ; +1 CPX #$F0 ; compare with max BCS LAB_C673 ; branch if >= DEX ; -1 STX LAB_0018 ; save new NULL count LAB_C672 RTS ; do "FC" error LAB_C673 JMP LAB_D002 ; do "FC" error ; perform SAVE LAB_C676 BEQ LAB_C673 ; if no following do "FC" error STA LAB_A64E ; save ID byte JSR LAB_00CC ; increment and scan memory BNE LAB_C664 ; return if following byte - allow SN error LDA LAB_007B ; get start of mem low byte LDY LAB_007C ; get start of mem high byte STA LAB_A64C ; save start address low byte STY LAB_A64D ; save start address high byte LDA LAB_007D ; get start of vars low byte LDY LAB_007E ; get start of vars high byte STA LAB_A64A ; save end address+1 low byte STY LAB_A64B ; save end address+1 high byte LDY #$80 ; set tape mode, b7 = 1 is high speed mode ; b7 = 0 is KIM mode ; b6 - b1 unused JSR LAB_00C6 ; go do SAVE vector BCS LAB_C6DD ; if error do bad save message LDA #LAB_C6AF ; pointer to "SAVED" message high byte JMP LAB_C954 ; print null terminated string from (AY) and return LAB_C6A2 .byte "LOADED",$0D,$0A LAB_C6AA .byte "OK",$0D,$0A,$00 LAB_C6AF .byte "SAVED",$0D,$0A,$00 ; perform LOAD LAB_C6B7 BEQ LAB_C673 ; if no following do "FC" error STA LAB_A64E ; save ID byte JSR LAB_00CC ; increment and scan memory BNE LAB_C672 ; exit if not null, allow syntax error LDY #$80 ; set tape mode, b7 = 1 is high speed mode ; b7 = 0 is KIM mode ; b6 - b1 unused JSR LAB_00C9 ; do LOAD vector BCS LAB_C6EF ; if error do BAD LOAD message LDA #LAB_C6A2 ; pointer to "LOADED" message high byte JSR LAB_C954 ; print null terminated string from (AY) LDX LAB_A64A ; get end address+1 low byte LDY LAB_A64B ; get end address+1 high byte TXA ; copy low byte to A STX LAB_007D ; set start of vars low byte STY LAB_007E ; set start of vars high byte JMP LAB_C323 ; reset execution to start, clear vars and flush stack ; rebuild chaining of BASIC lines and do warm start ; do bad save message LAB_C6DD LDA #LAB_C6E4 ; pointer to "BAD SAVE" message high byte JMP LAB_C954 ; print null terminated string from (AY) and return LAB_C6E4 .byte "BAD SAVE",$0D,$0A,$00 LAB_C6EF LDA #LAB_C6FC ; pointer to "BAD LOAD" message high byte JSR LAB_C954 ; print null terminated string from (AY) JSR LAB_C458 ; do NEW JMP LAB_C27E ; go do warm start LAB_C6FC .byte "BAD LOAD",$0D,$0A,$00 ; perform RUN LAB_C707 BNE LAB_C70C ; branch if RUN n JMP LAB_C46D ; reset execution to start, clear vars, flush stack ; and RET ; does RUN n LAB_C70C JSR LAB_C474 ; go do "CLEAR" JMP LAB_C726 ; get n and do GOTO n ; perform GOSUB LAB_C712 LDA #$03 ; need 2*3 bytes for GOSUB JSR LAB_C21C ; check room on stack for 2*A bytes LDA LAB_00D4 ; get BASIC execute pointer high byte PHA ; push on stack LDA LAB_00D3 ; get BASIC execute pointer low byte PHA ; push on stack LDA LAB_008A ; get current line high byte PHA ; push on stack LDA LAB_0089 ; get current line low byte PHA ; push on stack LDA #$8C ; token for GOSUB PHA ; push on stack LAB_C726 JSR LAB_00D2 ; scan memory JSR LAB_C72F ; perform GOTO n JMP LAB_C5A1 ; go do interpreter inner loop ; (can't RTS, we used the stack!) ; perform GOTO LAB_C72F JSR LAB_C7F5 ; get fixed-point number into temp integer JSR LAB_C793 ; scan for next BASIC line LDA LAB_008A ; get current line high byte CMP LAB_001D ; compare with temporary integer high byte BCS LAB_C746 ; branch if >= (start search from beginning) TYA ; else copy line index to A SEC ; set carry (+1) ADC LAB_00D3 ; add BASIC execute pointer low byte LDX LAB_00D4 ; get BASIC execute pointer high byte BCC LAB_C74A ; branch if no overflow to high byte INX ; increment high byte BCS LAB_C74A ; branch always (can never be carry) ; search for line # in temp from start of mem pointer LAB_C746 LDA LAB_007B ; get start of mem low byte LDX LAB_007C ; get start of mem high byte ; search for line # in temp from (AX) LAB_C74A JSR LAB_C42B ; search Basic for temp integer line number from AX BCC LAB_C76D ; if carry clear go do "US" error ; carry already set for subtract LDA LAB_00AF ; get pointer low byte SBC #$01 ; -1 STA LAB_00D3 ; save BASIC execute pointer low byte LDA LAB_00B0 ; get pointer high byte SBC #$00 ; subtract carry STA LAB_00D4 ; save BASIC execute pointer high byte LAB_C75B RTS ; perform RETURN LAB_C75C BNE LAB_C75B ; exit if following token - to allow syntax error LDA #$FF ; set byte so no match possible STA LAB_009A ; save var pointer for FOR/NEXT low byte JSR LAB_C1AB ; search the stack for FOR or GOSUB activity ; (get token off stack) TXS ; correct stack CMP #$8C ; compare with GOSUB token BEQ LAB_C775 ; branch if matching GOSUB LDX #$04 ; else set RG error .byte $2C ; makes next BIT LAB_0EA2 LAB_C76D LDX #$0E ; set US error JMP LAB_C258 ; do error #X, then warm start LAB_C772 JMP LAB_CCB6 ; do syntax error, then warm start LAB_C775 PLA ; pull GOSUB token PLA ; pull current line low byte STA LAB_0089 ; save current line low byte PLA ; pull current line high byte STA LAB_008A ; save current line high byte PLA ; pull BASIC execute pointer low byte STA LAB_00D3 ; save BASIC execute pointer low byte PLA ; pull BASIC execute pointer high byte STA LAB_00D4 ; save BASIC execute pointer high byte ; now do the DATA statement as we could be returning into ; the middle of an ON GOSUB n,m,p,q line ; (the return address used by the DATA statement is the one ; pushed before the GOSUB was executed!) ; perform DATA LAB_C782 JSR LAB_C790 ; scan for next BASIC statement ([:] or [EOL]) ; set BASIC execute pointer LAB_C785 TYA ; copy index to A CLC ; clear carry for add ADC LAB_00D3 ; add BASIC execute pointer low byte STA LAB_00D3 ; save BASIC execute pointer low byte BCC LAB_C78F ; skip next if no carry INC LAB_00D4 ; else increment BASIC execute pointer high byte LAB_C78F RTS ; scan for next BASIC statement ([:] or [EOL]) ; returns Y as index to [:] or [EOL] LAB_C790 LDX #$3A ; set look for character = ":" .byte $2C ; makes next line BIT $00A2 ; scan for next BASIC line ; returns Y as index to [EOL] LAB_C793 LDX #$00 ; set alt search character = [EOL] STX LAB_000D ; store alt search character LDY #$00 ; set search character = [EOL] STY LAB_000E ; store search character LAB_C79B LDA LAB_000E ; get search character LDX LAB_000D ; get alt search character STA LAB_000D ; make search character = alt search character STX LAB_000E ; make alt search character = search character LAB_C7A3 LDA (LAB_00D3),Y ; get next byte BEQ LAB_C78F ; exit if null [EOL] CMP LAB_000E ; compare with search character BEQ LAB_C78F ; exit if found INY ; increment index CMP #$22 ; compare current character with open quote BNE LAB_C7A3 ; if found go swap search character for alt search character BEQ LAB_C79B ; go get next character ; perform IF LAB_C7B2 JSR LAB_CB57 ; evaluate expression JSR LAB_00D2 ; scan memory CMP #$88 ; compare with "GOTO" token BEQ LAB_C7C1 ; jump if was "GOTO" ; wasn't IF ... GOTO so must be IF ... THEN LDA #$A1 ; get THEN token JSR LAB_CCAD ; scan for CHR$(A) , else do syntax error, then warm start LAB_C7C1 LDA LAB_00B1 ; get FAC1 exponent BNE LAB_C7CA ; branch if result was non zero ; else .... ; perform REM, skip (rest of) line LAB_C7C5 JSR LAB_C793 ; scan for next BASIC line BEQ LAB_C785 ; go set BASIC execute pointer and RET (always) ; result was non zero so do rest of line LAB_C7CA JSR LAB_00D2 ; scan memory BCS LAB_C7D2 ; branch if not numeric character (is var or keyword) JMP LAB_C72F ; else do GOTO n (was numeric) ; is var or keyword LAB_C7D2 JMP LAB_C5DA ; interpret BASIC code from execute pointer ; perform ON LAB_C7D5 JSR LAB_D553 ; get byte parameter PHA ; push GOTO/GOSUB token CMP #$8C ; compare with GOSUB token BEQ LAB_C7E1 ; branch if GOSUB LAB_C7DD CMP #$88 ; compare with GOTO token BNE LAB_C772 ; if not GOTO do syntax error, then warm start ; next character was GOTO or GOSUB LAB_C7E1 DEC LAB_00B5 ; decrement index BNE LAB_C7E9 ; branch if not zero PLA ; pull GOTO/GOSUB token JMP LAB_C5DC ; go execute it LAB_C7E9 JSR LAB_00CC ; increment and scan memory JSR LAB_C7F5 ; get fixed-point number into temp integer (skip this n) CMP #$2C ; compare next character with "," BEQ LAB_C7E1 ; loop if "," PLA ; else pull keyword token (run out of options) LAB_C7F4 RTS ; get fixed-point number into temp integer LAB_C7F5 LDX #$00 ; clear byte STX LAB_001C ; clear temp integer low byte STX LAB_001D ; clear temp integer high byte LAB_C7FB BCS LAB_C7F4 ; exit if non numeric SBC #$2F ; subtract $30 ($2F+carry) from byte STA LAB_000D ; store # LDA LAB_001D ; get temp integer high byte STA LAB_0072 ; save it for now CMP #$19 ; compare with $19 BCS LAB_C7DD ; branch if >= (makes max line # 63999 because next ; bit does *$0A (= 64000) compare at target will fail ; and do Syntax error) LDA LAB_001C ; get temporary integer low byte ASL ; *2 low byte ROL LAB_0072 ; *2 high byte ASL ; *2 low byte ROL LAB_0072 ; *2 high byte (*4) ADC LAB_001C ; + low byte (*5) STA LAB_001C ; save it LDA LAB_0072 ; get high byte temp ADC LAB_001D ; + high byte (*5) STA LAB_001D ; save it ASL LAB_001C ; *2 low byte (*10d) ROL LAB_001D ; *2 high byte (*10d) LDA LAB_001C ; get low byte ADC LAB_000D ; add # STA LAB_001C ; save low byte BCC LAB_C829 ; branch if no overflow to high byte INC LAB_001D ; else increment high byte LAB_C829 JSR LAB_00CC ; increment and scan memory JMP LAB_C7FB ; loop for next character ; perform LET LAB_C82F JSR LAB_CE5F ; get var address STA LAB_0099 ; save var address low byte STY LAB_009A ; save var address high byte (Lvarph) LDA #$AC ; get = token JSR LAB_CCAD ; scan for CHR$(A), else do syntax error, then warm start LDA LAB_0012 ; get data type flag, $80=integer, $00=float PHA ; push data type flag LDA LAB_0011 ; get data type flag, $FF=string, $00=numeric PHA ; push data type flag JSR LAB_CB57 ; evaluate expression PLA ; pop data type flag ROL ; set carry if type = string JSR LAB_CB49 ; type match check, set C for string BNE LAB_C863 ; branch if string PLA ; pop data type flag LAB_C84C BPL LAB_C860 ; branch if float JSR LAB_D9D1 ; round FAC1 JSR LAB_CF79 ; evaluate integer expression (no sign check) LDY #$00 ; clear index LDA LAB_00B4 ; get integer low byte STA (LAB_0099),Y ; save integer low byte INY ; increment index LDA LAB_00B5 ; get integer high byte STA (LAB_0099),Y ; save integer high byte RTS LAB_C860 JMP LAB_D986 ; pack FAC1 into variable and RET LAB_C863 PLA ; pop data type flag LAB_C864 LDY #$02 ; set index to pointer high byte LDA (LAB_00B4),Y ; get string pointer high byte CMP LAB_0084 ; compare bottom of string space high byte BCC LAB_C883 ; if less assign value and exit (was in program memory) BNE LAB_C875 ; branch if > ; else was equal so compare low bytes DEY ; decrement index LDA (LAB_00B4),Y ; get pointer low byte CMP LAB_0083 ; compare bottom of string space low byte BCC LAB_C883 ; if less assign value and exit (was in program memory) ; pointer was >= to bottom of string space pointer LAB_C875 LDY LAB_00B5 ; get descriptor pointer high byte CPY LAB_007E ; compare start of vars high byte BCC LAB_C883 ; branch if less (descriptor is on stack) BNE LAB_C88A ; branch if greater (descriptor is not on stack) ; else high bytes were equal so ... LDA LAB_00B4 ; get descriptor pointer low byte CMP LAB_007D ; compare start of vars low byte BCS LAB_C88A ; branch if >= (descriptor is not on stack) LAB_C883 LDA LAB_00B4 ; get descriptor pointer low byte LDY LAB_00B5 ; get descriptor pointer high byte JMP LAB_C8A0 ; clean stack, copy descriptor to variable and return ; make space and copy string LAB_C88A LDY #$00 ; index to length LDA (LAB_00B4),Y ; get string length JSR LAB_D22E ; copy string LDA LAB_00A0 ; get descriptor pointer low byte LDY LAB_00A1 ; get descriptor pointer high byte STA LAB_00BF ; save descriptor pointer low byte STY LAB_00C0 ; save descriptor pointer high byte JSR LAB_D42F ; copy string from descriptor to utility LDA #$B1 ; set descriptor pointer low byte LDY #$00 ; get descriptor pointer high byte ; clean stack and assign value to string variable LAB_C8A0 STA LAB_00A0 ; save descriptor_2 pointer low byte STY LAB_00A1 ; save descriptor_2 pointer high byte JSR LAB_D490 ; clean descriptor stack, YA = pointer LDY #$00 ; index to length LDA (LAB_00A0),Y ; get string length STA (LAB_0099),Y ; copy to let string variable INY ; index to string pointer low byte LDA (LAB_00A0),Y ; get string pointer low byte STA (LAB_0099),Y ; copy to let string variable INY ; index to string pointer high byte LDA (LAB_00A0),Y ; get string pointer high byte STA (LAB_0099),Y ; copy to let string variable RTS ; PRINT LAB_C8B8 JSR LAB_C957 ; print string from LAB_C8BB JSR LAB_00D2 ; scan memory ; perform PRINT LAB_C8BE BEQ LAB_C8FE ; if nothing following just print CR/LF LAB_C8C0 BEQ LAB_C91C ; exit if nothing more to print CMP #$9D ; compare with TAB( token BEQ LAB_C934 ; go do TAB/SPC CMP #$A0 ; compare with SPC( token CLC ; flag SPC( BEQ LAB_C934 ; go do TAB/SPC CMP #$2C ; compare with "," BEQ LAB_C91D ; go do move to next TAB mark CMP #$3B ; compare with ";" BEQ LAB_C949 ; if ";" continue with PRINT processing JSR LAB_CB57 ; evaluate expression BIT LAB_0011 ; test data type flag, $FF=string, $00=numeric BMI LAB_C8B8 ; branch if string JSR LAB_DB9A ; convert FAC1 to string JSR LAB_D240 ; print " terminated string to utility LDY #$00 ; clear index LDA (LAB_00B4),Y ; get string length CLC ; clear carry for add ADC LAB_0019 ; add POS byte CMP LAB_001A ; compare with width BCC LAB_C8EE ; branch if less than terminal width JSR LAB_C8FE ; else print CR/LF LAB_C8EE JSR LAB_C957 ; print string from JSR LAB_C971 ; print [SPACE] BNE LAB_C8BB ; always go continue processing line ; CR/LF return to BASIC from BASIC input handler LAB_C8F6 LDY #$00 ; clear byte STY LAB_001E,X ; null terminate input LDX #$1D ; set null count BNE LAB_C905 ; go print [LF] ; print CR/LF LAB_C8FE LDA #$0D ; load [CR] STA LAB_0019 ; set POS byte for no rollover JSR LAB_C976 ; go print the character LAB_C905 LDA #$0A ; load [LF] JSR LAB_C976 ; go print the character LAB_C90A TXA ; get null count PHA ; save A LDX LAB_0018 ; get NULL count BEQ LAB_C918 ; branch if null LDA #$FF ; null byte is $FF LAB_C912 JSR LAB_C976 ; go print the character DEX ; decrement count BNE LAB_C912 ; loop until done LAB_C918 STX LAB_0019 ; clear POS count PLA ; pull null count TAX ; copy back to X LAB_C91C RTS LAB_C91D LDA LAB_0019 ; get terminal position CMP LAB_001B ; compare with input column limit BCC LAB_C929 ; branch if less JSR LAB_C8FE ; else print CR/LF (next line) JMP LAB_C949 ; continue with PRINT processing LAB_C929 SEC ; set carry for subtract LAB_C92A SBC #$0E ; subtract TAB size BCS LAB_C92A ; loop if result was +ve EOR #$FF ; complement it ADC #$01 ; +1 (twos complement) BNE LAB_C944 ; always print A spaces (result is never $00) ; do TAB/SPC LAB_C934 PHP ; save flags JSR LAB_D550 ; scan and get byte parameter CMP #$29 ; is next character ) BNE LAB_C99D ; if not do syntax error, then warm start PLP ; get flags back BCC LAB_C945 ; branch if was SPC ; calculate TAB offset TXA ; copy integer value to A SBC LAB_0019 ; subtract terminal position BCC LAB_C949 ; branch if result was < 0 (can't TAB backwards) ; print A spaces LAB_C944 TAX ; copy result to X ; print X spaces LAB_C945 INX ; adjust for loop type LAB_C946 DEX ; decrement count BNE LAB_C94F ; branch if not all done LAB_C949 JSR LAB_00CC ; increment and scan memory JMP LAB_C8C0 ; continue executing PRINT LAB_C94F JSR LAB_C971 ; print " " BNE LAB_C946 ; loop (branch always) ; print null terminated string from memory (AY) LAB_C954 JSR LAB_D240 ; print " terminated string to utility ; print string from LAB_C957 JSR LAB_D45B ; 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 TAX ; copy length to X LDY #$00 ; reset index INX ; adjust for loop type LAB_C95E DEX ; decrement count BEQ LAB_C91C ; exit (RTS) if done LDA (LAB_0072),Y ; get next byte JSR LAB_C976 ; go print the character INY ; increment index CMP #$0D ; was it [CR] BNE LAB_C95E ; branch if not JSR LAB_C90A JMP LAB_C95E ; loop ; print [SPACE] LAB_C971 LDA #$20 ; load " " .byte $2C ; change next line to BIT LAB_3FA9 ; print "?" character LAB_C974 LDA #$3F ; load "?" character ; print character in A LAB_C976 BIT LAB_0017 ; test input flag BMI LAB_C98E ; branch if set (supress output) PHA ; save the character CMP #$20 ; compare with " " BCC LAB_C98A ; branch if less (non printing) ; else printable character LDA LAB_0019 ; get POS byte CMP LAB_001A ; compare with width BNE LAB_C988 ; branch if not at end of line JSR LAB_C8FE ; else print CR/LF LAB_C988 INC LAB_0019 ; increment terminal position LAB_C98A PLA ; get character back JSR LAB_8A47 ; byte to output device LAB_C98E AND #$FF ; set the flags RTS ; handle bad input data LAB_C991 LDA LAB_0015 ; get input mode flag, $00=INPUT, $98=READ BEQ LAB_C9A0 ; branch if INPUT (go do redo) LDA LAB_008F ; get current DATA line low byte LDY LAB_0090 ; get current DATA line high byte STA LAB_0089 ; save current line low byte STY LAB_008A ; save current line high byte LAB_C99D JMP LAB_CCB6 ; do syntax error, then warm start ; mode was INPUT LAB_C9A0 LDA #LAB_CAC5 ; pointer to redo message high byte JSR LAB_C954 ; print null terminated string from (AY) LDA LAB_008D ; get continue pointer low byte LDY LAB_008E ; get continue pointer high byte STA LAB_00D3 ; save BASIC execute pointer low byte STY LAB_00D4 ; save BASIC execute pointer high byte RTS LAB_C9B0 JSR LAB_C974 ; print "?" character JSR LAB_C971 ; print [SPACE] JMP LAB_C9CA ; go get INPUT ; perform INPUT LAB_C9B9 LSR LAB_0017 ; clear input flag (allow output) CMP #$22 ; compare next byte with open quote BNE LAB_C9B0 ; branch if no prompt string JSR LAB_CC5D ; print "..." string LDA #$3B ; load A with ";" JSR LAB_CCAD ; scan for CHR$(A), else do syntax error, then warm start JSR LAB_C957 ; print string from ; done with prompt, now get data LAB_C9CA JSR LAB_D15F ; check not Direct (back here if ok) LDA #$2C STA LAB_001D ; temp integer high byte JSR LAB_C35F ; call for BASIC input LDA LAB_001E ; get first byte from buffer BNE LAB_C9E9+1 ; branch if not null input (this is a strange branch, it ; goes to the data byte of the LDA #$98 at LAB_1953 which ; is TYA. Is Y always 0 here, or will any value except $98 ; do?) CLC ; was null input so clear carry to exit prog JMP LAB_C631 ; go do BREAK exit ; print ? and call for basic input LAB_C9DC JSR LAB_C974 ; print "?" character JSR LAB_C971 ; print [SPACE] JMP LAB_C35F ; call for BASIC input and return ; perform READ LAB_C9E5 LDX LAB_0091 ; get DATA pointer low byte LDY LAB_0092 ; get DATA pointer high byte LAB_C9E9 LDA #$98 ; set mode = READ STA LAB_0015 ; set input mode flag, <=$7F=INPUT, $98=READ STX LAB_0093 ; save READ pointer low byte STY LAB_0094 ; save READ pointer high byte ; READ or INPUT next variable from list LAB_C9F1 JSR LAB_CE5F ; get variable address STA LAB_0099 ; save address low byte STY LAB_009A ; save address high byte LDA LAB_00D3 ; get BASIC execute pointer low byte LDY LAB_00D4 ; get BASIC execute pointer high byte STA LAB_009B ; save as temporary integer low byte STY LAB_009C ; save as temporary integer high byte LDX LAB_0093 ; get READ pointer low byte LDY LAB_0094 ; get READ pointer high byte STX LAB_00D3 ; set BASIC execute pointer low byte STY LAB_00D4 ; set BASIC execute pointer high byte JSR LAB_00D2 ; scan memory BNE LAB_CA1B ; branch if not null ; pointer was to null entry BIT LAB_0015 ; test input mode flag, $00=INPUT, $98=READ BMI LAB_CA75 ; branch if READ ; mode was INPUT JSR LAB_C974 ; print "?" character (double ? for extended input) JSR LAB_C9DC ; print "?" and get BASIC input STX LAB_00D3 ; set BASIC execute pointer low byte STY LAB_00D4 ; set BASIC execute pointer high byte LAB_CA1B JSR LAB_00CC ; increment and scan memory BIT LAB_0011 ; test data type flag, $FF=string, $00=numeric BPL LAB_CA46 ; branch if numeric ; else get string STA LAB_000D ; save search character CMP #$22 ; was it " ? BEQ LAB_CA2F ; branch if so LDA #$3A ; else search character is ":" STA LAB_000D ; set new search character LDA #$2C ; other search character is "," CLC ; clear carry for add LAB_CA2F STA LAB_000E ; set second search character LDA LAB_00D3 ; get BASIC execute pointer low byte LDY LAB_00D4 ; get BASIC execute pointer high byte ADC #$00 ; c is =1 if we came via the BEQ LAB_1999, else =0 BCC LAB_CA3A ; branch if no execute pointer low byte rollover INY ; else increment high byte LAB_CA3A JSR LAB_D246 ; print alt search or search terminated string to utility JSR LAB_D598 ; restore BASIC execute pointer from temp JSR LAB_C864 ; go do string LET JMP LAB_CA4E ; go check string terminator ; get numeric INPUT LAB_CA46 JSR LAB_DAA9 ; get FAC1 from string LDA LAB_0012 ; get numeric type, $80=integer, $00=float JSR LAB_C84C ; pack FAC1 into LAB_CA4E JSR LAB_00D2 ; scan memory BEQ LAB_CA5A ; branch if null (last entry) CMP #$2C ; else compare with "," BEQ LAB_CA5A ; branch if "," JMP LAB_C991 ; else go handle bad input data ; got good input data LAB_CA5A LDA LAB_00D3 ; get BASIC execute pointer low byte (temp READ/INPUT ptr) LDY LAB_00D4 ; get BASIC execute pointer high byte (temp READ/INPUT ptr) STA LAB_0093 ; save for now STY LAB_0094 ; save for now LDA LAB_009B ; get ?? low byte (temp BASIC execute ptr) LDY LAB_009C ; get ?? high byte (temp BASIC execute ptr) STA LAB_00D3 ; set BASIC execute pointer low byte STY LAB_00D4 ; set BASIC execute pointer high byte JSR LAB_00D2 ; scan memory BEQ LAB_CA9B ; if null go do extra ignored message JSR LAB_CCAB ; else scan for "," , else do syntax error, then warm start JMP LAB_C9F1 ; go INPUT next variable from list ; find next DATA statement or do "OD" error LAB_CA75 JSR LAB_C790 ; scan for next BASIC statement ([:] or [EOL]) INY ; increment index TAX ; copy character ([:] or [EOL]) BNE LAB_CA8E ; branch if [:] LDX #$06 ; set for "OD" error INY ; increment index (points to next line pointer high byte) LDA (LAB_00D3),Y ; get next line pointer high byte BEQ LAB_CAEC ; branch if end (eventually does error X) INY ; increment index LDA (LAB_00D3),Y ; get next line # low byte STA LAB_008F ; save current DATA line low byte INY ; increment index LDA (LAB_00D3),Y ; get next line # high byte INY ; increment index STA LAB_0090 ; save current DATA line high byte LAB_CA8E LDA (LAB_00D3),Y ; get byte TAX ; copy to X JSR LAB_C785 ; set BASIC execute pointer CPX #$83 ; compare with "DATA" token BNE LAB_CA75 ; was "DATA" so go do next READ JMP LAB_CA1B ; go find next statement if not "DATA" ; end of INPUT/READ routine LAB_CA9B LDA LAB_0093 ; get temp READ pointer low byte LDY LAB_0094 ; get temp READ pointer high byte LDX LAB_0015 ; get input mode flag, $00=INPUT, $98=READ BPL LAB_CAA6 ; branch if INPUT JMP LAB_C614 ; save AY as DATA pointer and RET ; we were getting INPUT LAB_CAA6 LDY #$00 ; clear index LDA (LAB_0093),Y ; get next byte BEQ LAB_CAB3 ; exit if null ; else user typed too much LDA #LAB_CAB4 ; pointer to extra ignored message high byte JMP LAB_C954 ; print null terminated string from (AY) and return LAB_CAB3 RTS LAB_CAB4 .byte "?EXTRA IGNORED",$0D,$0A,$00 LAB_CAC5 .byte "?REDO FROM START",$0D,$0A,$00 ; perform NEXT LAB_CAD8 BNE LAB_CADE ; branch if NEXT var LDY #$00 ; else clear Y BEQ LAB_CAE1 ; branch always (no variable to search for) ; NEXT var LAB_CADE JSR LAB_CE5F ; get variable address LAB_CAE1 STA LAB_0099 ; store variable pointer low byte STY LAB_009A ; store variable pointer high byte ; (both cleared if no variable defined) JSR LAB_C1AB ; search the stack for FOR or GOSUB activity BEQ LAB_CAEE ; branch if found LDX #$00 ; else set error $00 ("NF" error) LAB_CAEC BEQ LAB_CB54 ; do error #X, then warm start LAB_CAEE TXS ; set stack pointer (X set by search, dumps return address) TXA ; copy to A CLC ; clear carry for add ADC #$04 ; +4 (point to STEP var) PHA ; save it ADC #$06 ; +6 (point to TO var) STA LAB_0074 ; save stack pointer to TO var for compare PLA ; pull index to STEP var LDY #$01 ; point to stack page JSR LAB_D958 ; unpack memory (STEP value) into FAC1 TSX ; get stack pointer back LDA LAB_0109,X ; get step sign STA LAB_00B6 ; save FAC1 sign (b7) LDA LAB_0099 ; get FOR variable pointer low byte LDY LAB_009A ; get FOR variable pointer high byte JSR LAB_D61D ; add (FOR variable) to FAC1 JSR LAB_D986 ; pack FAC1 into (FOR variable) LDY #$01 ; point to stack page JSR LAB_DA13 ; compare FAC1 with TO value TSX ; get stack pointer back SEC ; set carry for subtract SBC LAB_0109,X ; subtract step sign BEQ LAB_CB31 ; branch if = (loop complete) ; loop back and do it all again LDA LAB_010F,X ; get FOR line low byte STA LAB_0089 ; save current line low byte LDA LAB_0110,X ; get FOR line high byte STA LAB_008A ; save current line high byte LDA LAB_0112,X ; get BASIC execute pointer low byte STA LAB_00D3 ; save BASIC execute pointer low byte LDA LAB_0111,X ; get BASIC execute pointer high byte STA LAB_00D4 ; save BASIC execute pointer high byte LAB_CB2E JMP LAB_C5A1 ; go do interpreter inner loop ; loop complete so carry on LAB_CB31 TXA ; stack copy to A ADC #$11 ; add $11 ($11+carry) to dump FOR structure TAX ; copy back to index TXS ; copy to stack pointer JSR LAB_00D2 ; scan memory CMP #$2C ; compare with "," BNE LAB_CB2E ; branch if not "," (go do interpreter inner loop) ; was "," so another NEXT variable to do JSR LAB_00CC ; increment and scan memory JSR LAB_CADE ; do NEXT (var) ; evaluate expression and check is numeric, else do type mismatch LAB_CB43 JSR LAB_CB57 ; evaluate expression ; check if source is numeric, else do type mismatch LAB_CB46 CLC ; destination is numeric .byte $24 ; makes next line BIT $38 ; check if source is string, else do type mismatch LAB_CB48 SEC ; required type is string ; type match check, set C for string, clear C for numeric LAB_CB49 BIT LAB_0011 ; test data type flag, $FF=string, $00=numeric BMI LAB_CB50 ; branch if data type is string ; else data type was numeric BCS LAB_CB52 ; if required type is string do type mismatch error LAB_CB4F RTS ; data type was string, now check required type LAB_CB50 BCS LAB_CB4F ; exit if required type is string ; else do type mismatch error LAB_CB52 LDX #$18 ; error code $18 ("TM" error) LAB_CB54 JMP LAB_C258 ; do error #X, then warm start ; evaluate expression LAB_CB57 LDX LAB_00D3 ; get BASIC execute pointer low byte BNE LAB_CB5D ; skip next if not zero DEC LAB_00D4 ; else decrement BASIC execute pointer high byte LAB_CB5D DEC LAB_00D3 ; decrement BASIC execute pointer low byte LDX #$00 ; .byte $24 ; makes next line BIT $48 LAB_CB62 PHA ; push compare evaluation byte if branch to here TXA ; copy precedence byte PHA ; push precedence byte LDA #$01 ; 2*1 bytes JSR LAB_C21C ; check room on stack for A bytes JSR LAB_CC3C ; get value from line LDA #$00 ; clear A STA LAB_009D ; clear compare function flag LAB_CB71 JSR LAB_00D2 ; scan memory LAB_CB74 SEC ; set carry for subtract SBC #$AB ; subtract token for > (lowest comparison function) BCC LAB_CB90 ; branch if < TK_GT CMP #$03 ; compare with ">" to "<" tokens BCS LAB_CB90 ; branch if >= TK_SGN (highest evaluation function +1) ; was token for > = or < (A = 0, 1 or 2) CMP #$01 ; compare with token for = ROL ; *2, b0 = carry (=1 if token was = or <) ; (A = 0, 3 or 5) EOR #$01 ; toggle b0 ; (A = 1, 2 or 4. 1 if >, 2 if =, 4 if <) EOR LAB_009D ; EOR with compare function flag bits CMP LAB_009D ; compare with compare function flag BCC LAB_CBE9 ; if <(comp_f) do syntax error, then warm start ; was more than one <, = or >) STA LAB_009D ; save new compare function flag JSR LAB_00CC ; increment and scan memory JMP LAB_CB74 ; go do next character ; token is < ">" or > "<" tokens LAB_CB90 LDX LAB_009D ; get compare function flag BNE LAB_CBC0 ; branch if compare function BCS LAB_CC11 ; go do functions ; else was < TK_GT so is operator or lower ADC #$07 ; add # of operators (+, -, *, /, ^, AND or OR) BCC LAB_CC11 ; branch if < + operator ; carry was set so token was +, -, *, /, ^, AND or OR ADC LAB_0011 ; add data type flag, $FF=string, $00=numeric BNE LAB_CBA1 ; branch if not string or not + token ; will only be $00 if type is string and token was + JMP LAB_D3F2 ; add strings, string 1 is in descriptor - string 2 ; is in line, and return LAB_CBA1 ADC #$FF ; -1 (corrects for carry add) STA LAB_0072 ; save it ASL ; *2 ADC LAB_0072 ; *3 TAY ; copy to index LAB_CBA9 PLA ; pull previous precedence CMP LAB_C06B,Y ; compare with precedence byte BCS LAB_CC16 ; branch if A >= JSR LAB_CB46 ; check if source is numeric, else do type mismatch LAB_CBB2 PHA ; save precedence LAB_CBB3 JSR LAB_CBD9 ; get vector, execute function then continue evaluation PLA ; restore precedence LDY LAB_009B ; get precedence stacked flag BPL LAB_CBD2 ; branch if stacked values TAX ; copy precedence (set flags) BEQ LAB_CC14 ; exit if done BNE LAB_CC1F ; else pop FAC2 and return (branch always) LAB_CBC0 LSR LAB_0011 ; clear data type flag, $FF=string, $00=numeric TXA ; compare function flag to A ROL ; shift bits LDX LAB_00D3 ; get BASIC execute pointer low byte BNE LAB_CBCA ; branch if no underflow DEC LAB_00D4 ; else decrement BASIC execute pointer high byte LAB_CBCA DEC LAB_00D3 ; decrement BASIC execute pointer low byte LDY #$1B ; set offset to last operator entry STA LAB_009D ; save new compare function flag BNE LAB_CBA9 ; branch always LAB_CBD2 CMP LAB_C06B,Y ; compare with stacked function precedence BCS LAB_CC1F ; branch if A >=, pop FAC2 and return BCC LAB_CBB2 ; branch always ; get vector, execute function then continue evaluation LAB_CBD9 LDA LAB_C06D,Y ; get function vector high byte PHA ; onto stack LDA LAB_C06C,Y ; get function vector low byte PHA ; onto stack JSR LAB_CBEC ; function will return here, then the next RTS will call ; the function LDA LAB_009D ; get compare function flag JMP LAB_CB62 ; continue evaluating expression LAB_CBE9 JMP LAB_CCB6 ; do syntax error, then warm start LAB_CBEC LDA LAB_00B6 ; get FAC1 sign (b7) LDX LAB_C06B,Y ; get precedence byte ; push sign, round FAC1 and put on stack LAB_CBF1 TAY ; copy sign PLA ; get return addr low byte STA LAB_0072 ; save it INC LAB_0072 ; increment it (was ret-1 pushed? yes!) ; note! no check is made on the high byte! if the calling ; routine assembles to a page edge then this all goes ; horribly wrong !!! PLA ; get return addr high byte STA LAB_0073 ; save it TYA ; restore sign PHA ; push sign ; round FAC1 and put on stack LAB_CBFC JSR LAB_D9D1 ; round FAC1 LDA LAB_00B5 ; get FAC1 mantissa4 PHA ; push on stack LDA LAB_00B4 ; get FAC1 mantissa3 PHA ; push on stack LDA LAB_00B3 ; get FAC1 mantissa2 PHA ; push on stack LDA LAB_00B2 ; get FAC1 mantissa1 PHA ; push on stack LDA LAB_00B1 ; get FAC1 exponent PHA ; push on stack JMP (LAB_0072) ; return, sort of ; do functions LAB_CC11 LDY #$FF ; flag function PLA ; pull precedence byte LAB_CC14 BEQ LAB_CC39 ; exit if done LAB_CC16 CMP #$64 ; compare previous precedence with $64 BEQ LAB_CC1D ; branch if was $64 (< function) JSR LAB_CB46 ; check if source is numeric, else do type mismatch LAB_CC1D STY LAB_009B ; save precedence stacked flag ; pop FAC2 and return LAB_CC1F PLA ; pop byte LSR ; shift out comparison evaluation lowest bit STA LAB_0016 ; save comparison evaluation flag PLA ; pop exponent STA LAB_00B9 ; save FAC2 exponent PLA ; pop mantissa1 STA LAB_00BA ; save FAC2 mantissa1 PLA ; pop mantissa2 STA LAB_00BB ; save FAC2 mantissa2 PLA ; pop mantissa3 STA LAB_00BC ; save FAC2 mantissa3 PLA ; pop mantissa4 STA LAB_00BD ; save FAC2 mantissa4 PLA ; pop sign STA LAB_00BE ; save FAC2 sign (b7) EOR LAB_00B6 ; EOR FAC1 sign (b7) STA LAB_00BF ; save sign compare (FAC1 EOR FAC2) LAB_CC39 LDA LAB_00B1 ; get FAC1 exponent RTS ; get value from line LAB_CC3C LDA #$00 ; clear byte STA LAB_0011 ; clear data type flag, $FF=string, $00=numeric LAB_CC40 JSR LAB_00CC ; increment and scan memory BCS LAB_CC48 ; branch if not numeric character ; else numeric string found (e.g. 123) LAB_CC45 JMP LAB_DAA9 ; get FAC1 from string and return ; get value from line .. continued ; wasn't a number so ... LAB_CC48 JSR LAB_CEE9 ; check byte, return C=0 if<"A" or >"Z" BCS LAB_CCC2 ; get (var), return value in FAC1 and $ flag ; wasn't variable name so ... CMP #$2E ; compare with "." BEQ LAB_CC45 ; if so get FAC1 from string and return (e.g. was .123) ; wasn't .123 so ... CMP #$A5 ; compare with token for - BEQ LAB_CCBB ;.branch if - token (do set-up for functions) ; wasn't -123 so ... CMP #$A4 ; compare with token for + BEQ LAB_CC40 ; branch if + token (+1 = 1 so ignore leading +) ; it wasn't any sort of number so ... CMP #$22 ; compare with " BNE LAB_CC6C ; branch if not open quote ; was open quote so get the enclosed string ; print "..." string to string util area LAB_CC5D LDA LAB_00D3 ; get BASIC execute pointer low byte LDY LAB_00D4 ; get BASIC execute pointer high byte ADC #$00 ; add carry to low byte BCC LAB_CC66 ; branch if no overflow INY ; increment high byte LAB_CC66 JSR LAB_D240 ; print " terminated string to utility JMP LAB_D598 ; restore BASIC execute pointer from temp and return ; get value from line .. continued ; wasn't a string so ... LAB_CC6C CMP #$A2 ; compare with token for NOT BNE LAB_CC83 ; branch if not token for NOT ; was NOT token LDY #$18 ; offset to NOT function BNE LAB_CCBD ; do set-up for function then execute (branch always) ; do = compare LAB_CC74 JSR LAB_CF79 ; evaluate integer expression (no sign check) LDA LAB_00B5 ; get FAC1 mantissa EOR #$FF ; invert it TAY ; copy it LDA LAB_00B4 ; get FAC1 mantissa EOR #$FF ; invert it JMP LAB_D14C ; save and convert integer AY to FAC1 and RET ; get value from line .. continued ; wasn't a string or NOT so ... LAB_CC83 CMP #$B1 ; compare with token for USR() BNE LAB_CC8A ; branch if not USR() JMP LAB_CDBD ; go do USR() function ; get value from line .. continued ; wasn't a string, NOT or FN so ... LAB_CC8A CMP #$26 ; comapre with "&" BNE LAB_CC91 ; branch if not "&" JMP LAB_CDFE ; evaluate integer LAB_CC91 CMP #$9F ; compare with token for FN BNE LAB_CC98 ; branch if not token for FN JMP LAB_D1AD ; go evaluate FNx LAB_CC98 CMP #$AE ; compare with token for SGN BCC LAB_CC9F ; branch if less than SGN token ; else was a function token JMP LAB_CCE6 ; 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 LAB_CC9F JSR LAB_CCA8 ; scan for "(" , else do syntax error, then warm start JSR LAB_CB57 ; evaluate expression ; all the 'scan for' routines return the character after the sought character ; scan for ")" , else do syntax error, then warm start LAB_CCA5 LDA #$29 ; load A with ")" .byte $2C ; makes next line BIT $28A9 ; scan for "(" , else do syntax error, then warm start LAB_CCA8 LDA #$28 ; load A with "(" .byte $2C ; makes next line BIT $2CA9 ; scan for "," , else do syntax error, then warm start LAB_CCAB LDA #$2C ; load A with "," ; scan for CHR$(A) , else do syntax error, then warm start LAB_CCAD LDY #$00 ; clear index CMP (LAB_00D3),Y ; check next byte is = A BNE LAB_CCB6 ; if not do syntax error, then warm start JMP LAB_00CC ; increment and scan memory then return ; syntax error, then warm start LAB_CCB6 LDX #$02 ; error code $02 ("SN" error) JMP LAB_C258 ; do error #X, then warm start ; set-up for functions LAB_CCBB LDY #$15 ; set offset from base to > operator LAB_CCBD PLA ; dump return address low byte PLA ; dump return address high byte JMP LAB_CBB3 ; execute function then continue evaluation ; variable name set-up ; get (var), return value in FAC_1 and $ flag LAB_CCC2 JSR LAB_CE5F ; get (var) address STA LAB_00B4 ; save address low byte in FAC1 mantissa STY LAB_00B5 ; save address high byte in FAC1 mantissa LDX LAB_0011 ; get data type flag, $FF=string, $00=numeric BEQ LAB_CCD2 ; branch if not string LDX #$00 ; clear X STX LAB_00C0 ; clear FAC1 rounding byte RTS LAB_CCD2 LDX LAB_0012 ; get data type flag, $FF=integer, $00=float BPL LAB_CCE3 ; branch if float (pack FAC1) LDY #$00 ; clear index LDA (LAB_00B4),Y ; get low byte TAX ; copy to X INY ; increment index LDA (LAB_00B4),Y ; get high byte TAY ; copy to Y TXA ; copy low byte to A JMP LAB_D14C ; save and convert integer AY to FAC1 and RET LAB_CCE3 JMP LAB_D958 ; unpack memory (AY) into FAC1 and return ; get value from line .. continued ; only functions left so ... ; set up function references LAB_CCE6 ASL ; *2 (2 bytes per function address) PHA ; save function offset TAX ; copy function offset JSR LAB_00CC ; increment and scan memory CPX #$83 ; compare function offset to CHR$ token offset+1 BCC LAB_CD10 ; branch if LAB_00B9 ; set pointer high byte to FAC2 JSR LAB_DA11 ; compare FAC1 with FAC2 (AY) TAX ; copy result JMP LAB_CDA0 ; go evaluate result ; do string < compare LAB_CD6D LDA #$00 ; clear byte STA LAB_0011 ; clear data type flag, $FF=string, $00=numeric DEC LAB_009D ; clear < bit in compare function flag JSR LAB_D45B ; pop string off descriptor stack, or from top of string ; space returns with A = length, X=pointer low byte, ; Y=pointer high byte STA LAB_00B1 ; save length STX LAB_00B2 ; save string pointer low byte STY LAB_00B3 ; save string pointer high byte LDA LAB_00BC ; get descriptor pointer low byte LDY LAB_00BD ; get descriptor pointer high byte JSR LAB_D45F ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=pointer low byte, ; Y=pointer high byte STX LAB_00BC ; save string pointer low byte STY LAB_00BD ; save string pointer high byte TAX ; copy length SEC ; set carry for subtract SBC LAB_00B1 ; subtract string 1 length BEQ LAB_CD95 ; branch if strings = length LDA #$01 ; set str 1 length > string 2 length BCC LAB_CD95 ; branch if so LDX LAB_00B1 ; get string 1 length LDA #$FF ; set str 1 length < string 2 length LAB_CD95 STA LAB_00B6 ; save length compare LDY #$FF ; set index INX ; adjust for loop LAB_CD9A INY ; increment index DEX ; decrement count BNE LAB_CDA5 ; branch if not all done LDX LAB_00B6 ; get length compare back LAB_CDA0 BMI LAB_CDB1 ; branch if str 1 length > string 2 length CLC ; flag str 1 <= str 2 BCC LAB_CDB1 ; go evaluate result LAB_CDA5 LDA (LAB_00BC),Y ; get string 2 byte CMP (LAB_00B2),Y ; compare with string 1 byte BEQ LAB_CD9A ; loop if bytes = LDX #$FF ; set str 1 < string 2 BCS LAB_CDB1 ; branch if so LDX #$01 ; set str 1 > string 2 LAB_CDB1 INX ; x = 0, 1 or 2 TXA ; copy to A ROL ; *2 (1, 2 or 4) AND LAB_0016 ; and with comparison evaluation flag BEQ LAB_CDBA ; branch if 0 (compare is false) LDA #$FF ; else set result true LAB_CDBA JMP LAB_D9F2 ; save A as integer byte and return ; do USR([addr,][[val,]...]AY) function LAB_CDBD JSR LAB_00CC ; increment and scan memory JSR LAB_CCA8 ; scan for "(" , else do syntax error, then warm start JSR LAB_CB57 ; evaluate expression JSR LAB_00D2 ; scan memory CMP #$29 ; compare with ")" BEQ LAB_CDF1 ; branch if ")" JSR LAB_CF79 ; evaluate integer expression (no sign check) LDA LAB_00B5 ; get low byte LDY LAB_00B4 ; get high byte STA LAB_000B ; save USR vector low byte STY LAB_000C ; save USR vector high byte LAB_CDD8 JSR LAB_CCAB ; scan for "," , else do syntax error, then warm start JSR LAB_CB57 ; evaluate expression JSR LAB_00D2 ; scan memory CMP #$29 ; compare with ")" BEQ LAB_CDF1 ; branch if ")" JSR LAB_CF79 ; evaluate integer expression (no sign check) LDA LAB_00B4 ; get high byte PHA ; stack it LDA LAB_00B5 ; get low byte PHA ; stack it JMP LAB_CDD8 ; loop LAB_CDF1 JSR LAB_00CC ; increment and scan memory JSR LAB_CF79 ; evaluate integer expression (no sign check) LDA LAB_00B5 ; get low byte LDY LAB_00B4 ; get high byte JMP LAB_000A ; do USR jump ; evaluate integer LAB_CDFE LDA LAB_00D4 ; get BASIC execute pointer high byte PHA ; on stack LDA LAB_00D3 ; get BASIC execute pointer low byte PHA ; on stack JSR LAB_00CC ; increment and scan memory CMP #$22 ; compare with " BNE LAB_CE49 ; branch if not " (clear FAC1 and return) JSR LAB_00CC ; increment and scan memory JSR LAB_CE2B ; get hex byte TAX ; copy byte to X JSR LAB_00D2 ; scan memory JSR LAB_CE2B ; get hex byte PHA ; push second byte JSR LAB_00D2 ; scan memory CMP #$22 ; compare with " BNE LAB_CE48 ; branch if not closing double quote JSR LAB_00CC ; increment and scan memory PLA ; pull second byte TAY ; copy to Y PLA ; dump BASIC execute pointer low byte PLA ; dump BASIC execute pointer high byte TXA ; copy low byte to X JMP LAB_D14C ; save and convert integer AY to FAC1 and RET ; get hex byte LAB_CE2B JSR LAB_8275 ; convert chr to binary, Cb=0 if valid hex chr BCS LAB_CE47 ; branch if not hex character PHA ; save hex value JSR LAB_00CC ; increment and scan memory JSR LAB_8275 ; convert chr to binary, Cb=0 if valid hex chr STA LAB_00B5 ; save hex value BCS LAB_CE46 ; branch if not valid hex character JSR LAB_00CC ; increment and scan memory PLA ; pull first hex value ASL ; *2 ASL ; *4 ASL ; *8 ASL ; *16 ORA LAB_00B5 ; or in second hex value LAB_CE45 RTS ; dump hex value, return address from get hex subroutine and restore ; BASIC execute pointer LAB_CE46 PLA ; dump hex value ; dump return address from get hex subroutine and restore BASIC ; execute pointer LAB_CE47 PLA ; dump return address low byte ; dump second hex byte and restore BASIC execute pointer LAB_CE48 PLA ; dump return address low byte/second hex byte LAB_CE49 PLA ; pop byte STA LAB_00D3 ; set BASIC execute pointer low byte PLA ; pop byte STA LAB_00D4 ; set BASIC execute pointer high byte JMP LAB_D6AD ; clear FAC1 and return LAB_CE52 JSR LAB_CCAB ; scan for "," , else do syntax error, then warm start ; perform DIM LAB_CE55 TAX ; copy "DIM" flag to X JSR LAB_CE64 ; search for DIM variable JSR LAB_00D2 ; scan memory BNE LAB_CE52 ; loop if not null RTS ; search for variable LAB_CE5F LDX #$00 ; set DIM flag = $00 JSR LAB_00D2 ; scan memory (1st character) LAB_CE64 STX LAB_0010 ; save DIM flag LAB_CE66 STA LAB_0095 ; save 1st character JSR LAB_00D2 ; scan memory JSR LAB_CEE9 ; check byte, return C=0 if<"A" or >"Z" BCS LAB_CE73 ; branch if ok LAB_CE70 JMP LAB_CCB6 ; else syntax error, then warm start ; was variable name so ... LAB_CE73 LDX #$00 ; clear 2nd character temp STX LAB_0011 ; clear data type flag, $FF=string, $00=numeric STX LAB_0012 ; clear data type flag, $80=integer, $00=float JSR LAB_00CC ; increment and scan memory BCC LAB_CE83 ; branch if character = "0"-"9" (ok) ; 2nd character wasn't "0" to "9" so ... JSR LAB_CEE9 ; check byte, return C=0 if<"A" or >"Z" BCC LAB_CE8E ; branch if <"A" or >"Z" (go check if string) LAB_CE83 TAX ; copy 2nd character ; ignore further (valid) characters in the variable name LAB_CE84 JSR LAB_00CC ; increment and scan memory BCC LAB_CE84 ; loop if character = "0"-"9" (ignore) JSR LAB_CEE9 ; check byte, return C=0 if<"A" or >"Z" BCS LAB_CE84 ; loop if character = "A"-"Z" (ignore) ; check if string variable LAB_CE8E CMP #$24 ; compare with "$" BNE LAB_CE98 ; branch if not string ; type is string LDA #$FF ; set data type = string STA LAB_0011 ; set data type flag, $FF=string, $00=numeric BNE LAB_CEA8 ; branch if string LAB_CE98 CMP #$25 ; compare with "%" BNE LAB_CEAF ; branch if not integer LDA LAB_0014 ;. BNE LAB_CE70 ;.if ?? do SN error then warm start LDA #$80 ; set bit for integer flag STA LAB_0012 ; set data type flag for integer ORA LAB_0095 ; OR with variable name first character STA LAB_0095 ; save variable name first character LAB_CEA8 TXA ; get 2nd character back ORA #$80 ; set top bit (indicate string var) TAX ; copy back to 2nd character temp JSR LAB_00CC ; increment and scan memory LAB_CEAF STX LAB_0096 ; save 2nd character (Varnm2) SEC ; set carry for subtract ORA LAB_0014 ; or with subscript/FNX flag (or FN name) (Sufnxf) SBC #$28 ; subtract "(" BNE LAB_CEBB ; branch if not "(" JMP LAB_CF8B ; go find, or make, array ; either find or create var ; variable name wasn't var(.... so look for plain var LAB_CEBB LDA #$00 ; clear A STA LAB_0014 ; clear subscript/FNX flag LDA LAB_007D ; get start of vars low byte LDX LAB_007E ; get start of vars high byte LDY #$00 ; clear index LAB_CEC5 STX LAB_00B0 ; save search address high byte LAB_CEC7 STA LAB_00AF ; save search address low byte (Vrschl) CPX LAB_0080 ; compare high address with var space end BNE LAB_CED1 ; skip next compare if <> ; high addresses were = so compare low addresses CMP LAB_007F ; compare low address with var space end BEQ LAB_CEF3 ; if not found go make new var LAB_CED1 LDA LAB_0095 ; get 1st character of var to find CMP (LAB_00AF),Y ; compare with variable name 1st character BNE LAB_CEDF ; branch if no match ; 1st characters match so compare 2nd characters LDA LAB_0096 ; get 2nd character of var to find (Varnm2) INY ; index to point to variable name 2nd character CMP (LAB_00AF),Y ; compare with variable name 2nd character BEQ LAB_CF48 ; branch if match (found var) DEY ; else decrement index (now = $00) LAB_CEDF CLC ; clear carry for add LDA LAB_00AF ; get search address low byte ADC #$07 ; +7 (offset to next var name) BCC LAB_CEC7 ; loop if no overflow to high byte INX ; else increment high byte BNE LAB_CEC5 ; loop always (RAM doesn't extend to $FFFF !) ; check byte, return C=0 if<"A" or >"Z" LAB_CEE9 CMP #$41 ; compare with "A" BCC LAB_CEF2 ; branch if less (not "A" to "Z") ; carry is set SBC #$5B ; subtract "Z"+1 SEC ; set carry SBC #$A5 ; subtract $A5 (restore byte) ; carry clear if byte>$5A LAB_CEF2 RTS LAB_CEF3 PLA ; pop return address low byte PHA ; push return address low byte CMP #$C4 ; compare with expected calling routine return low byte BNE LAB_CF06 ; if not get (var) go create new var TSX ; copy stack pointer LDA LAB_0102,X ; get stack -1 CMP #$CC ; check is $CC BNE LAB_CF06 ; branch if not ; These will only drop through if the call was from LAB_CCC2 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. ; else return dummy null value LDA #LAB_DCCC ; high byte point to $00,$00 RTS ; create new numeric variable LAB_CF06 LDA LAB_007F ; get var mem end low byte LDY LAB_0080 ; get var mem end high byte STA LAB_00AF ; save old block start low byte STY LAB_00B0 ; save old block start high byte LDA LAB_0081 ; get array mem end low byte LDY LAB_0082 ; get array mem end high byte STA LAB_00AA ; save old block end low byte STY LAB_00AB ; save old block end high byte CLC ; clear carry for add ADC #$07 ; +7 (space for one var) BCC LAB_CF1C ; branch if no overflow to high byte INY ; else increment high byte LAB_CF1C STA LAB_00A8 ; set new block end low byte STY LAB_00A9 ; set new block end high byte JSR LAB_C1D9 ; open up space in memory LDA LAB_00A8 ; get new start low byte LDY LAB_00A9 ; get new start high byte (-$100) INY ; correct high byte STA LAB_007F ; save new var mem end low byte STY LAB_0080 ; save new var mem end high byte LDY #$00 ; clear index LDA LAB_0095 ; get var name 1st character STA (LAB_00AF),Y ; save var name 1st character INY ; increment index LDA LAB_0096 ; get var name 2nd character STA (LAB_00AF),Y ; save var name 2nd character LDA #$00 ; clear A INY ; increment index STA (LAB_00AF),Y ; initialise var byte INY ; increment index STA (LAB_00AF),Y ; initialise var byte INY ; increment index STA (LAB_00AF),Y ; initialise var byte INY ; increment index STA (LAB_00AF),Y ; initialise var byte INY ; increment index STA (LAB_00AF),Y ; initialise var byte ; found a match for var ((Vrschl) = ptr) LAB_CF48 LDA LAB_00AF ; get var address low byte CLC ; clear carry for add ADC #$02 ; +2 (offset past var name bytes) LDY LAB_00B0 ; get var address high byte BCC LAB_CF52 ; branch if no overflow from add INY ; else increment high byte LAB_CF52 STA LAB_0097 ; save current var address low byte STY LAB_0098 ; save current var address high byte RTS ; set-up array pointer to first element in array LAB_CF57 LDA LAB_000F ; get # of dimensions (1, 2 or 3) ASL ; *2 (also clears the carry !) ADC #$05 ; +5 (result is 7, 9 or 11 here) ADC LAB_00AF ; add array start pointer low byte LDY LAB_00B0 ; get array pointer high byte BCC LAB_CF63 ; branch if no overflow INY ; else increment high byte LAB_CF63 STA LAB_00A8 ; save array data pointer low byte STY LAB_00A9 ; save array data pointer high byte RTS LAB_CF68 .byte $90,$80,$00,$00 ; -32768 ; evaluate integer expression (+ve only) LAB_CF6C JSR LAB_00CC ; increment and scan memory JSR LAB_CB57 ; evaluate expression LAB_CF72 JSR LAB_CB46 ; check if source is numeric, else do type mismatch LDA LAB_00B6 ; get FAC1 sign byte BMI LAB_CF86 ; branch if -ve (go do FC error) ; evaluate integer expression (no sign check) LAB_CF79 LDA LAB_00B1 ; get FAC1 exponent CMP #$90 ; compare with exponent = 2^16 (n>2^15) BCC LAB_CF88 ; branch if n<2^16 (is ok) LDA #LAB_CF68 ; set pointer high byte to -32768 JSR LAB_DA11 ; compare FAC1 with (AY) LAB_CF86 BNE LAB_D002 ; if not -ve max do "FC" error LAB_CF88 JMP LAB_DA51 ; convert FAC1 floating-to-fixed and RET LAB_CF8B LDA LAB_0010 ; get DIM flag ORA LAB_0012 ; OR data type flag, $80=integer, $00=float PHA ; push it LDA LAB_0011 ; get data type flag, $FF=string, $00=numeric PHA ; push it LDY #$00 ; clear dimensions count ; now get the array dimension(s) and stack it (them) before the data type and DIM flag LAB_CF95 TYA ; copy dimensions count PHA ; save it LDA LAB_0096 ; get array name 2nd byte PHA ; save it LDA LAB_0095 ; get array name 1st byte PHA ; save it JSR LAB_CF6C ; evaluate integer expression PLA ; pull array name 1st byte STA LAB_0095 ; restore array name 1st byte PLA ; pull array name 2nd byte STA LAB_0096 ; restore array name 2nd byte PLA ; pull dimensions count TAY ; restore it TSX ; copy stack pointer LDA LAB_0102,X ; get DIM flag PHA ; push it LDA LAB_0101,X ; get data type flag PHA ; push it LDA LAB_00B4 ; get this dimension size high byte STA LAB_0102,X ; stack before flag bytes LDA LAB_00B5 ; get this dimension size low byte STA LAB_0101,X ; stack before flag bytes INY ; increment dimensions count JSR LAB_00D2 ; scan memory CMP #$2C ; compare with "," BEQ LAB_CF95 ; if found go do next dimension STY LAB_000F ; store dimensions count JSR LAB_CCA5 ; scan for ")" , else do syntax error, then warm start PLA ; pull data type flag STA LAB_0011 ; restore data type flag, $FF=string, $00=numeric PLA ; pull DIM flag STA LAB_0012 ; restore data type flag, $FF=string, $00=numeric AND #$7F ; mask string bit STA LAB_0010 ; restore DIM flag LDX LAB_007F ; get array mem start low byte LDA LAB_0080 ; get array mem start high byte ; now check to see if we are at the end of array memory (we would be if there were ; no arrays). LAB_CFD6 STX LAB_00AF ; save as array start pointer low byte STA LAB_00B0 ; save as array start pointer high byte CMP LAB_0082 ; compare with array mem end high byte BNE LAB_CFE2 ; branch if not reached array mem end CPX LAB_0081 ; else compare with array mem end low byte BEQ LAB_D01B ; go build array if not found ; search for array LAB_CFE2 LDY #$00 ; clear index LDA (LAB_00AF),Y ; get array name first byte INY ; increment index to second name byte CMP LAB_0095 ; compare with this array name first byte BNE LAB_CFF1 ; branch if no match LDA LAB_0096 ; else get this array name second byte CMP (LAB_00AF),Y ; compare with array name second byte BEQ LAB_D007 ; array found so branch ; no match LAB_CFF1 INY ; increment index LDA (LAB_00AF),Y ; get array size low byte CLC ; clear carry for add ADC LAB_00AF ; add array start pointer low byte TAX ; copy low byte to X INY ; increment index LDA (LAB_00AF),Y ; get array size high byte ADC LAB_00B0 ; add array mem pointer high byte BCC LAB_CFD6 ; if no overflow go check next array ; do array bounds error LAB_CFFF LDX #$10 ; error code $10 ("BS" error) .byte $2C ; makes next bit BIT LAB_08A2 ; perform GET LAB_D002 LDX #$08 ; do "FC" error LAB_D004 JMP LAB_C258 ; do error #X, then warm start ; found array, are we trying to dimension it? LAB_D007 LDX #$12 ; set error $12 - "DD" error LDA LAB_0010 ; get DIM flag BNE LAB_D004 ; 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 JSR LAB_CF57 ; set-up array pointer to first element in array LDA LAB_000F ; get dimensions count LDY #$04 ; set index to array's # of dimensions CMP (LAB_00AF),Y ; compare with no of dimensions BNE LAB_CFFF ; if wrong do array bounds error JMP LAB_D0A5 ; found array so go get element ; array not found, so build it LAB_D01B JSR LAB_CF57 ; set-up array pointer to first element in array JSR LAB_C229 ; check available memory, "OM" error if no room ; addr to check is in AY (low/high) LDA #$00 ; clear A TAY ; clear Y STA LAB_00C2 ; clear array data size high byte LDX #$05 ; set array element size LDA LAB_0095 ; get var name 1st byte STA (LAB_00AF),Y ; set array name 1st byte BPL LAB_D02F ; branch if float DEX ; else decrement element size (=4) LAB_D02F INY ; increment index LDA LAB_0096 ; get var name 2nd byte STA (LAB_00AF),Y ; set array name 2nd byte BPL LAB_D038 ; branch if not string DEX ; else decrement element size (=4) DEX ; else decrement element size (=3) LAB_D038 STX LAB_00C1 ; save array element size LDA LAB_000F ; get dimensions count INY ; past size low byte INY ; past size high byte INY ; to dimensions count STA (LAB_00AF),Y ; save dimensions count LAB_D041 LDX #$0B ; set default dimension value low byte LDA #$00 ; set default dimension value high byte BIT LAB_0010 ; test default DIM flag BVC LAB_D051 ; branch if b6 of Defdim is clear PLA ; else pull dimension value low byte CLC ; clear carry for add ADC #$01 ; +1 (allow for zeroeth element) TAX ; copy low byte to X PLA ; pull dimension value high byte ADC #$00 ; add carry from low byte LAB_D051 INY ; index to dimension value high byte STA (LAB_00AF),Y ; save dimension value high byte INY ; index to dimension value high byte TXA ; get dimension value low byte STA (LAB_00AF),Y ; save dimension value low byte JSR LAB_D107 ; does XY = (LAB_00AF),Y * (LAB_00C2) STX LAB_00C1 ; save array data size low byte STA LAB_00C2 ; save array data size high byte LDY LAB_0072 ; restore index (saved by subroutine) DEC LAB_000F ; decrement dimensions count BNE LAB_D041 ; loop while not = 0 ADC LAB_00A9 ; add size high byte to first element high byte ; (carry is always clear here) BCS LAB_D0C6 ; if overflow go do "OM" error STA LAB_00A9 ; save end of array high byte TAY ; copy end high byte to Y TXA ; get array size low byte ADC LAB_00A8 ; add array start low byte BCC LAB_D074 ; branch if no carry INY ; else increment end of array high byte BEQ LAB_D0C6 ; if overflow go do "OM" error ; set-up mostly complete, now zero the array LAB_D074 JSR LAB_C229 ; check available memory, "OM" error if no room ; addr to check is in AY (low/high) STA LAB_0081 ; save array mem end low byte STY LAB_0082 ; save array mem end high byte LDA #$00 ; clear byte for array clear INC LAB_00C2 ; increment array size high byte (now block count) LDY LAB_00C1 ; get array size low byte (now index to block) BEQ LAB_D088 ; branch if low byte = $00 LAB_D083 DEY ; decrement index (do 0 to n-1) STA (LAB_00A8),Y ; zero byte BNE LAB_D083 ; loop until this block done LAB_D088 DEC LAB_00A9 ; decrement array pointer high byte DEC LAB_00C2 ; decrement block count high byte BNE LAB_D083 ; loop until all blocks done INC LAB_00A9 ; correct for last loop SEC ; set carry for subtract LDA LAB_0081 ; get array mem end low byte SBC LAB_00AF ; subtract array start low byte LDY #$02 ; index to array size low byte STA (LAB_00AF),Y ; save array size low byte LDA LAB_0082 ; get array mem end high byte INY ; index to array size high byte SBC LAB_00B0 ; subtract array start high byte STA (LAB_00AF),Y ; save array size high byte LDA LAB_0010 ; get default DIM flag BNE LAB_D106 ; exit (RET) if this was a DIM command ; else, find element INY ; index to # of dimensions LAB_D0A5 LDA (LAB_00AF),Y ; get array's dimension count STA LAB_000F ; save it LDA #$00 ; clear byte STA LAB_00C1 ; clear array data pointer low byte LAB_D0AD STA LAB_00C2 ; save array data pointer high byte INY ; increment index (point to array bound high byte) PLA ; pull array index low byte TAX ; copy to X STA LAB_00B4 ; save index low byte to FAC1 mantissa PLA ; pull array index high byte STA LAB_00B5 ; save index high byte to FAC1 mantissa CMP (LAB_00AF),Y ; compare with array bound high byte BCC LAB_D0C9 ; branch if within bounds BNE LAB_D0C3 ; if outside bounds do array bounds error ; else high byte was = so test low bytes INY ; index to array bound low byte TXA ; get array index low byte CMP (LAB_00AF),Y ; compare with array bound low byte BCC LAB_D0CA ; branch if within bounds LAB_D0C3 JMP LAB_CFFF ; else do array bounds error LAB_D0C6 JMP LAB_C256 ; do "OM" error, then warm start LAB_D0C9 INY ; index to array bound low byte LAB_D0CA LDA LAB_00C2 ; get array data pointer high byte ORA LAB_00C1 ; OR with array data pointer low byte CLC ; clear carry for either add BEQ LAB_D0DB ; branch if array data pointer = null (skip multiply) JSR LAB_D107 ; does XY = (LAB_00AF),Y * (LAB_00C2) TXA ; get result low byte ADC LAB_00B4 ; add index low byte from FAC1 mantissa TAX ; copy result low byte TYA ; get result high byte LDY LAB_0072 ; restore index LAB_D0DB ADC LAB_00B5 ; add index high byte from FAC1 mantissa STX LAB_00C1 ; save result low byte DEC LAB_000F ; decrement array's dimension count BNE LAB_D0AD ; loop if not all done STA LAB_00C2 ; save result high byte LDX #$05 ; set array element size LDA LAB_0095 ; get var name 1st character BPL LAB_D0EC ; branch if float DEX ; else decrement element size (=4) LAB_D0EC LDA LAB_0096 ; get var name 2nd character BPL LAB_D0F2 ; branch if not string DEX ; else decrement element size (=4) DEX ; else decrement element size (=3) LAB_D0F2 STX LAB_0078 ; save element size byte LDA #$00 ; clear high byte JSR LAB_D110 ; does XY = LAB_0078 * (LAB_00C2) TXA ; copy high byte ADC LAB_00A8 ; add array data start pointer low byte STA LAB_0097 ; save as current var address low byte TYA ; get high byte back ADC LAB_00A9 ; add array data start pointer high byte STA LAB_0098 ; save as current var address high byte TAY ; copy high byte to Y LDA LAB_0097 ; get current var address low byte LAB_D106 RTS ; does XY = (LAB_00AF),Y * (LAB_00C2) LAB_D107 STY LAB_0072 ; save index LDA (LAB_00AF),Y ; get dimension size low byte STA LAB_0078 ; save dimension size low byte DEY ; decrement index LDA (LAB_00AF),Y ; get dimension size high byte ; does XY = LAB_0078 * (LAB_00C2) LAB_D110 STA LAB_0079 ; save dimension size high byte LDA #$10 ; count = $10 (16 bit multiply) STA LAB_00AD ; save bit count LDX #$00 ; clear result low byte LDY #$00 ; clear result high byte LAB_D11A TXA ; get result low byte ASL ; *2 TAX ; save result low byte TYA ; get result high byte ROL ; *2 TAY ; save result high byte BCS LAB_D0C6 ; if overflow go do "OM" error ASL LAB_00C1 ; shift multiplier low byte ROL LAB_00C2 ; shift multiplier high byte BCC LAB_D133 ; skip add if no carry CLC ; else clear carry for add TXA ; get result low byte ADC LAB_0078 ; add dimension size low byte TAX ; save result low byte TYA ; get result high byte ADC LAB_0079 ; add dimension size high byte TAY ; save result high byte BCS LAB_D0C6 ; if overflow go do "OM" error LAB_D133 DEC LAB_00AD ; decrement bit count BNE LAB_D11A ; loop until all done RTS ; perform FRE LAB_D138 LDA LAB_0011 ; get data type flag, $FF=string, $00=numeric BEQ LAB_D13F ; branch if numeric JSR LAB_D45B ; pop string off descriptor stack, or from top of string ; space returns with A = length, X=pointer low byte, ; Y=pointer high byte ; FRE(n) was numeric so do this LAB_D13F JSR LAB_D2DB ; go do garbage collection SEC ; set carry for subtract LDA LAB_0083 ; get bottom of string space low byte SBC LAB_0081 ; subtract array mem end low byte TAY ; copy result to Y LDA LAB_0084 ; get bottom of string space high byte SBC LAB_0082 ; subtract array mem end high byte ; save and convert integer AY to FAC1 LAB_D14C LDX #$00 ; set type = numeric STX LAB_0011 ; clear data type flag, $FF=string, $00=numeric STA LAB_00B2 ; save FAC1 mantissa STY LAB_00B3 ; save FAC1 mantissa LDX #$90 ; set exponent=2^16 (integer) JMP LAB_D9FA ; set exp=X, clearFAC1_3, normalise and RET ; perform POS LAB_D159 LDY LAB_0019 ; get terminal position ; convert Y to byte in FAC1 LAB_D15B LDA #$00 ; clear high byte BEQ LAB_D14C ; always save and convert integer AY to FAC1 and RET ; check not Direct (used by DEF and INPUT) LAB_D15F LDX LAB_008A ; get current line high byte INX ; increment it BNE LAB_D106 ; return if can continue not direct mode ; else do illegal direct error LDX #$16 ; error code $16 - "ID" error .byte $2C ; makes next bit BIT LAB_20A2 LAB_D167 LDX #$20 JMP LAB_C258 ; do error #X, then warm start ; perform DEF LAB_D16C JSR LAB_D19A ; check FNx syntax JSR LAB_D15F ; check not Direct, back here if ok JSR LAB_CCA8 ; scan for "(" , else do syntax error, then warm start LDA #$80 ; set flag for FNx STA LAB_0014 ; save subscript/FNx flag JSR LAB_CE5F ; get variable address JSR LAB_CB46 ; check if source is numeric, else do type mismatch JSR LAB_CCA5 ; scan for ")" , else do syntax error, then warm start LDA #$AC ; get = token JSR LAB_CCAD ; scan for CHR$(A), else do syntax error, then warm start PHA ; push it LDA LAB_0098 ; get current var address high byte PHA ; push it LDA LAB_0097 ; get current var address low byte PHA ; push it LDA LAB_00D4 ; get BASIC execute pointer high byte PHA ; push it LDA LAB_00D3 ; get BASIC execute pointer low byte PHA ; push it JSR LAB_C782 ; go do DATA - find end of line JMP LAB_D208 ; put execute pointer and variable pointer into function ; and return ; check FNx syntax LAB_D19A LDA #$9F ; get FN token JSR LAB_CCAD ; scan for CHR$(A) , else do syntax error, then warm start ; return character after A ORA #$80 ; set FN flag bit STA LAB_0014 ; save FN name JSR LAB_CE66 ; search for FN variable STA LAB_009E ; save function pointer low byte STY LAB_009F ; save function pointer high byte JMP LAB_CB46 ; check if source is numeric and return, else do type mismatch ; Evaluate FNx LAB_D1AD JSR LAB_D19A ; check FNx syntax LDA LAB_009F ; get function pointer high byte PHA ; push it LDA LAB_009E ; get function pointer low byte PHA ; push it JSR LAB_CC9F ; evaluate expression within parentheses JSR LAB_CB46 ; check if source is numeric, else do type mismatch PLA ; pop function pointer low byte STA LAB_009E ; restore it PLA ; pop function pointer high byte STA LAB_009F ; restore it LDY #$02 ; index to variable pointer low byte LDA (LAB_009E),Y ; get variable pointer low byte STA LAB_0097 ; save variable address low byte TAX ; copy it INY ; index to variable address high byte LDA (LAB_009E),Y ; get variable pointer high byte BEQ LAB_D167 ; if zero go do undefined function error STA LAB_0098 ; save variable address high byte ; now stack the function variable value before use INY ; index to last byte LAB_D1D1 LDA (LAB_0097),Y ; get byte from variable PHA ; stack it DEY ; decrement index BPL LAB_D1D1 ; loop until variable stacked LDY LAB_0098 ; get variable address high byte JSR LAB_D98A ; pack FAC1 (function expression value) into (XY) ; (function variable), return Y=0, always LDA LAB_00D4 ; get BASIC execute pointer high byte PHA ; push it LDA LAB_00D3 ; get BASIC execute pointer low byte PHA ; push it LDA (LAB_009E),Y ; get function execute pointer low byte STA LAB_00D3 ; save as BASIC execute pointer low byte INY ; index to high byte LDA (LAB_009E),Y ; get function execute pointer high byte STA LAB_00D4 ; save as BASIC execute pointer high byte LDA LAB_0098 ; get variable address high byte PHA ; push it LDA LAB_0097 ; get variable address low byte PHA ; push it JSR LAB_CB43 ; evaluate expression and check is numeric, ; else do type mismatch PLA ; pull variable address low byte STA LAB_009E ; save variable address low byte PLA ; pull variable address high byte STA LAB_009F ; save variable address high byte JSR LAB_00D2 ; scan memory BEQ LAB_D202 ; branch if null (should be [EOL] marker) JMP LAB_CCB6 ; else syntax error, then warm start ; restore BASIC execute pointer and function variable from stack LAB_D202 PLA ; pull BASIC execute pointer low byte STA LAB_00D3 ; restore BASIC execute pointer low byte PLA ; pull BASIC execute pointer high byte STA LAB_00D4 ; restore BASIC execute pointer high byte ; put execute pointer and variable pointer into function LAB_D208 LDY #$00 ; clear index PLA ;.pull ?? STA (LAB_009E),Y ; save to function PLA ;.pull ?? INY ; increment index STA (LAB_009E),Y ; save to function PLA ;.pull ?? INY ; increment index STA (LAB_009E),Y ; save to function PLA ;.pull ?? INY ; increment index STA (LAB_009E),Y ; save to function PLA ;.pull ?? INY ; increment index STA (LAB_009E),Y ; save to function RTS ; perform STR$() LAB_D21E JSR LAB_CB46 ; check if source is numeric, else do type mismatch LDY #$00 ; set string index JSR LAB_DB9C ; convert FAC1 to string PLA ; dump return address (return via get value from line) PLA ; dump return address LDA #LAB_00FF ; set result string high pointer BEQ LAB_D240 ; print null terminated string to utility ; Do string vector ; copy descriptor pointer and make string space A bytes long LAB_D22E LDX LAB_00B4 ; get descriptor pointer low byte LDY LAB_00B5 ; get descriptor pointer high byte STX LAB_00A0 ; save descriptor pointer low byte STY LAB_00A1 ; save descriptor pointer high byte ; make string space A bytes long ; A=length, X=ptr low byte, Y=ptr high byte LAB_D236 JSR LAB_D2A9 ; make space in string memory for string A long ; return X=ptr low byte, Y=ptr high byte STX LAB_00B2 ; save string pointer low byte STY LAB_00B3 ; save string pointer high byte STA LAB_00B1 ; save length RTS ; Scan, set up string ; print " terminated string to utility LAB_D240 LDX #$22 ; set terminator to " STX LAB_000D ; set search character (terminator 1) STX LAB_000E ; set terminator 2 ; print alt search or search terminated string to utility ; source is AY LAB_D246 STA LAB_00BF ; store string start low byte STY LAB_00C0 ; store string start high byte STA LAB_00B2 ; save string pointer low byte STY LAB_00B3 ; save string pointer high byte LDY #$FF ; set length to -1 LAB_D250 INY ; increment length LDA (LAB_00BF),Y ; get byte from string BEQ LAB_D261 ; exit loop if null byte [EOS] CMP LAB_000D ; compare with search character (terminator 1) BEQ LAB_D25D ; branch if terminator CMP LAB_000E ; compare with terminator 2 BNE LAB_D250 ; loop if not terminator 2 LAB_D25D CMP #$22 ; compare with " BEQ LAB_D262 ; branch if " (carry set if = !) LAB_D261 CLC ; clear carry for add (only if [EOL] terminated string) LAB_D262 STY LAB_00B1 ; save length in FAC1 exponent TYA ; copy length to A ADC LAB_00BF ; add string start low byte STA LAB_00C1 ; save string end low byte LDX LAB_00C0 ; get string start high byte BCC LAB_D26E ; branch if no low byte overflow INX ; else increment high byte LAB_D26E STX LAB_00C2 ; save string end high byte LDA LAB_00C0 ; get string start high byte BNE LAB_D27F ; branch if not in utility area ; string in utility area, move to string memory TYA ; copy length to A JSR LAB_D22E ; copy descriptor ptr and make string space A bytes long LDX LAB_00BF ; get string start low byte LDY LAB_00C0 ; get string start high byte JSR LAB_D43D ; store string A bytes long from XY to utility ; check for space on descriptor stack then ... ; put string address and length on descriptor stack and update stack pointers LAB_D27F LDX LAB_0066 ; get string stack pointer CPX #$72 ; compare with max+1 BNE LAB_D28A ; branch if space on string stack ; else do string too complex error LDX #$1C ; error code $1C ("ST" error) LAB_D287 JMP LAB_C258 ; do error #X, then warm start ; put string address and length on descriptor stack and update stack pointers LAB_D28A LDA LAB_00B1 ; get string length STA LAB_0000,X ; put on string stack LDA LAB_00B2 ; get string pointer low byte STA LAB_0001,X ; put on string stack LDA LAB_00B3 ; get string pointer high byte STA LAB_0002,X ; put on string stack LDY #$00 ; clear Y STX LAB_00B4 ; save string descriptor pointer low byte STY LAB_00B5 ; save string descriptor pointer high byte (always $00) STY LAB_00C0 ; clear rounding byte DEY ; Y = $FF STY LAB_0011 ; save data type flag, $FF=string STX LAB_0067 ; save old stack pointer (current top item) INX ; update stack pointer INX ; update stack pointer INX ; update stack pointer STX LAB_0066 ; save new top item value RTS ; Build descriptor ; make space in string memory for string A long ; return X=ptr low byte, Y=ptr high byte LAB_D2A9 LSR LAB_0013 ; clear garbage collected flag (b7) ; make space for string A long LAB_D2AB PHA ; save string length EOR #$FF ; complement it SEC ; set carry for subtract (twos comp add) ADC LAB_0083 ; add bottom of string space low byte (subtract length) LDY LAB_0084 ; get bottom of string space high byte BCS LAB_D2B6 ; skip decrement if no underflow DEY ; decrement bottom of string space high byte LAB_D2B6 CPY LAB_0082 ; compare with array mem end high byte BCC LAB_D2CB ; do out of memory error if less BNE LAB_D2C0 ; if not = skip next test CMP LAB_0081 ; compare with array mem end low byte BCC LAB_D2CB ; do out of memory error if less LAB_D2C0 STA LAB_0083 ; save bottom of string space low byte STY LAB_0084 ; save bottom of string space high byte STA LAB_0085 ; save string utility ptr low byte STY LAB_0086 ; save string utility ptr high byte TAX ; copy low byte to X PLA ; get string length back RTS ; LAB_D2CB LDX #$0C ; error code $0C ("OM" error) LDA LAB_0013 ; get garbage collected flag BMI LAB_D287 ; if set then do error code X JSR LAB_D2DB ; else go do garbage collection LDA #$80 ; flag for garbage collected STA LAB_0013 ; set garbage collected flag PLA ; pull length BNE LAB_D2AB ; go try again (loop always, length should never be = $00) ; garbage collection routine LAB_D2DB LDX LAB_0087 ; get end of mem low byte LDA LAB_0088 ; get end of mem high byte ; re-run routine from last ending LAB_D2DF STX LAB_0083 ; set string storage low byte STA LAB_0084 ; set string storage high byte LDY #$00 ; clear index STY LAB_009F ; clear working pointer high byte (flag no strings to move) STY LAB_009E ; clear working pointer low byte LDA LAB_0081 ; get array mem end low byte LDX LAB_0082 ; get array mem end high byte STA LAB_00AF ; save as highest string low byte STX LAB_00B0 ; save as highest string high byte LDA #LAB_0069 ; set descriptor stack pointer high byte STA LAB_0072 ; save descriptor stack pointer low byte STX LAB_0073 ; save descriptor stack pointer high byte LAB_D2F9 CMP LAB_0066 ; compare with descriptor stack pointer BEQ LAB_D302 ; branch if = JSR LAB_D37C ; go garbage collect descriptor stack BEQ LAB_D2F9 ; loop always ; done stacked strings, now do string vars LAB_D302 LDA #$07 ; set step size = $07 STA LAB_00A3 ; save step size LDA LAB_007D ; get start of vars low byte LDX LAB_007E ; get start of vars high byte STA LAB_0072 ; save as pointer low byte STX LAB_0073 ; save as pointer high byte LAB_D30E CPX LAB_0080 ; compare start of arrays high byte BNE LAB_D316 ; branch if no high byte match CMP LAB_007F ; else compare start of arrays low byte BEQ LAB_D31B ; branch if = var mem end LAB_D316 JSR LAB_D372 ; go garbage collect strings BEQ LAB_D30E ; loop always ; done string vars, now do string arrays LAB_D31B STA LAB_00A8 ; save start of arrays low byte as working pointer STX LAB_00A9 ; save start of arrays high byte as working pointer LDA #$03 ; set step size (is this correct ??) STA LAB_00A3 ; save step size LAB_D323 LDA LAB_00A8 ; get pointer low byte LDX LAB_00A9 ; get pointer high byte LAB_D327 CPX LAB_0082 ; compare with array mem end high byte BNE LAB_D332 ; branch if not at end CMP LAB_0081 ; else compare with array mem end low byte BNE LAB_D332 ; branch if not at end JMP LAB_D3BB ; else tidy up and exit if at end LAB_D332 STA LAB_0072 ; save pointer low byte STX LAB_0073 ; save pointer high byte LDY #$00 ; set index LDA (LAB_0072),Y ; get name first byte TAX ; copy it INY ; increment index LDA (LAB_0072),Y ; get name second byte PHP ; push the flags INY ; increment index LDA (LAB_0072),Y ; get array size low byte ADC LAB_00A8 ; add start of this array low byte STA LAB_00A8 ; save start of next array low byte INY ; increment index LDA (LAB_0072),Y ; get array size high byte ADC LAB_00A9 ; add start of this array high byte STA LAB_00A9 ; save start of next array high byte PLP ; restore the flags BPL LAB_D323 ; skip if not string array ; was string array so ... TXA ; get name first byte back BMI LAB_D323 ;.loop if ?? INY ; increment index LDA (LAB_0072),Y ; get # of dimensions LDY #$00 ; clear index ASL ; *2 ADC #$05 ; +5 (array header size) ADC LAB_0072 ; add array start low byte STA LAB_0072 ; save data start low byte BCC LAB_D363 ; branch if no overflow INC LAB_0073 ; else increment data start high byte LAB_D363 LDX LAB_0073 ; get element pointer high byte LAB_D365 CPX LAB_00A9 ; compare with start of next array high byte BNE LAB_D36D ; branch if <> (go do this array) CMP LAB_00A8 ; else compare element pointer low byte with next array ; low byte BEQ LAB_D327 ; if equal then go do next array LAB_D36D JSR LAB_D37C ; go defrag array strings BEQ LAB_D365 ; go do next array string (loop always) ; defrag string variables ; enter with XA = variable pointer ; return with XA = next variable pointer LAB_D372 LDA (LAB_0072),Y ; get var name byte 1 BMI LAB_D3AB ; branch if ?? INY ; increment index LDA (LAB_0072),Y ; get var name byte 2 BPL LAB_D3AB ; if not string, step pointer to next var and RET INY ; else increment index LAB_D37C LDA (LAB_0072),Y ; get string length BEQ LAB_D3AB ; if null, step pointer to next string and RET INY ; else increment index LDA (LAB_0072),Y ; get string pointer low byte TAX ; copy to X INY ; increment index LDA (LAB_0072),Y ; get string pointer high byte CMP LAB_0084 ; compare bottom of string space high byte BCC LAB_D391 ; branch if less BNE LAB_D3AB ; if greater, step pointer to next string and RET ; high bytes were = so compare low bytes CPX LAB_0083 ; compare bottom of string space low byte BCS LAB_D3AB ; if >=, step pointer to next string and RET ; string pointer is < string storage pointer (pos in mem) LAB_D391 CMP LAB_00B0 ; compare to highest string high byte BCC LAB_D3AB ; if <, step pointer to next string and RET BNE LAB_D39B ; if > update pointers, step to next and return ; high bytes were = so compare low bytes CPX LAB_00AF ; compare to highest string low byte BCC LAB_D3AB ; if <, step pointer to next string and RET ; string is in string memory space LAB_D39B STX LAB_00AF ; save as new highest string low byte STA LAB_00B0 ; save as new highest string high byte LDA LAB_0072 ; get start of vars(descriptors) low byte LDX LAB_0073 ; get start of vars(descriptors) high byte STA LAB_009E ; save as working pointer low byte STX LAB_009F ; save as working pointer high byte LDA LAB_00A3 ; get step size STA LAB_00A5 ;. ; step pointer to next string LAB_D3AB LDA LAB_00A3 ; get step size CLC ; clear carry for add ADC LAB_0072 ; add pointer low byte STA LAB_0072 ; save pointer low byte BCC LAB_D3B6 ; branch if no overflow INC LAB_0073 ; else increment high byte LAB_D3B6 LDX LAB_0073 ; get pointer high byte LDY #$00 ; clear Y RTS ; search complete, now either exit or set-up and move string LAB_D3BB LDA LAB_009F ; get string to move low byte ORA LAB_009E ; OR string to move high byte BEQ LAB_D3B6 ; exit if nothing to move LDA LAB_00A5 ; get index byte back (points to descriptor) AND #$04 ;. LSR ;.>>1 TAY ;. STA LAB_00A5 ;.save index byte ?? LDA (LAB_009E),Y ; get string length ADC LAB_00AF ; add highest string low byte STA LAB_00AA ; save old block end low pointer LDA LAB_00B0 ; get highest string high byte ADC #$00 ; add any carry STA LAB_00AB ; save old block end high byte LDA LAB_0083 ; get bottom of string space low byte LDX LAB_0084 ; get bottom of string space high byte STA LAB_00A8 ; save new block end low byte STX LAB_00A9 ; save new block end high byte JSR LAB_C1E0 ; open up space in memory, don't set array end LDY LAB_00A5 ; get index byte INY ; point to descriptor low byte LDA LAB_00A8 ; get string pointer low byte STA (LAB_009E),Y ; save new string pointer low byte TAX ; copy string pointer low byte INC LAB_00A9 ; correct high byte (move sets high byte -1) LDA LAB_00A9 ; get new string pointer high byte INY ; point to descriptor high byte STA (LAB_009E),Y ; save new string pointer high byte JMP LAB_D2DF ; re-run routine from last ending ; (but don't collect this string) ; concatenate - add strings, string 1 is in descriptor, string 2 is in line LAB_D3F2 LDA LAB_00B5 ; get descriptor pointer high byte PHA ; put on stack LDA LAB_00B4 ; get descriptor pointer low byte PHA ; put on stack JSR LAB_CC3C ; get value from line JSR LAB_CB48 ; check if source is string, else do type mismatch PLA ; get descriptor pointer low byte back STA LAB_00BF ; set pointer low byte PLA ; get descriptor pointer high byte back STA LAB_00C0 ; set pointer high byte LDY #$00 ; clear index LDA (LAB_00BF),Y ; get length_1 from descriptor CLC ; clear carry for add ADC (LAB_00B4),Y ; add length_2 BCC LAB_D412 ; branch if no overflow LDX #$1A ; else set error code $1A ("LS" error) JMP LAB_C258 ; do error #X, then warm start LAB_D412 JSR LAB_D22E ; copy descriptor prt and make string space A bytes long JSR LAB_D42F ; copy string from descriptor to utility LDA LAB_00A0 ; get descriptor pointer low byte LDY LAB_00A1 ; get descriptor pointer high byte JSR LAB_D45F ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, ut1_pl = pointer low byte, ; ut1_ph = pointer high byte JSR LAB_D441 ; store string A bytes long from pointer to utility LDA LAB_00BF ; set descriptor pointer low byte LDY LAB_00C0 ; set descriptor pointer high byte JSR LAB_D45F ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=pointer low byte, ; Y=pointer high byte JSR LAB_D27F ; check for space on descriptor stack, put string address ; and length on stack and update stack pointers JMP LAB_CB71 ; continue evaluation ; copy string from descriptor to utility LAB_D42F LDY #$00 ; clear index LDA (LAB_00BF),Y ; get string length PHA ; save on stack INY ; increment index LDA (LAB_00BF),Y ; get source string pointer low byte TAX ; copy to X INY ; increment index LDA (LAB_00BF),Y ; get source string pointer high byte TAY ; copy to Y PLA ; get length back ; store string A bytes long from YX to utility LAB_D43D STX LAB_0072 ; save source string pointer low byte STY LAB_0073 ; save source string pointer high byte ; store string A bytes long from pointer to utility LAB_D441 TAY ; copy length to index BEQ LAB_D44E ; branch if = $0 (null string) no need to add zero length PHA ; save length LAB_D445 DEY ; decrement count LDA (LAB_0072),Y ; get source byte STA (LAB_0085),Y ; save destination byte TYA ; coy index BNE LAB_D445 ; branch if not done PLA ; restore length from Y LAB_D44E CLC ; clear carry for add ADC LAB_0085 ; add string utility ptr low byte STA LAB_0085 ; save string utility ptr low byte BCC LAB_D457 ; branch if no carry INC LAB_0086 ; else increment string utility ptr high byte LAB_D457 RTS ; evaluate string LAB_D458 JSR LAB_CB48 ; 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 LAB_D45B LDA LAB_00B4 ; get descriptor pointer low byte LDY LAB_00B5 ; 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 LAB_D45F STA LAB_0072 ; save string pointer low byte STY LAB_0073 ; save string pointer high byte JSR LAB_D490 ; clean descriptor stack, YA = pointer PHP ; save status flags LDY #$00 ; clear index LDA (LAB_0072),Y ; get length from string descriptor PHA ; put on stack INY ; increment index LDA (LAB_0072),Y ; get string pointer low byte from descriptor TAX ; copy to X INY ; increment index LDA (LAB_0072),Y ; get string pointer high byte from descriptor TAY ; copy to Y PLA ; get string length back PLP ; restore status BNE LAB_D48B ; branch if pointer <> last_sl,last_sh CPY LAB_0084 ; compare bottom of string space high byte BNE LAB_D48B ; branch if <> CPX LAB_0083 ; else compare bottom of string space low byte BNE LAB_D48B ; branch if <> PHA ; save string length CLC ; clear carry for add ADC LAB_0083 ; add bottom of string space low byte STA LAB_0083 ; save bottom of string space low byte BCC LAB_D48A ; skip increment if no overflow INC LAB_0084 ; increment bottom of string space high byte LAB_D48A PLA ; restore string length LAB_D48B STX LAB_0072 ; save string pointer low byte STY LAB_0073 ; save string pointer high byte RTS ; clean descriptor stack, YA = pointer ; checks if AY is on the descriptor stack, if so does a stack discard LAB_D490 CPY LAB_0068 ; compare pointer high byte BNE LAB_D4A0 ; exit if <> CMP LAB_0067 ; compare pointer low byte BNE LAB_D4A0 ; exit if <> STA LAB_0066 ; save descriptor stack pointer SBC #$03 ; -3 STA LAB_0067 ; save low byte -3 LDY #$00 ; clear high byte LAB_D4A0 RTS ; perform CHR$() LAB_D4A1 JSR LAB_D556 ; evaluate byte expression, result in X TXA ; copy to A PHA ; save character LDA #$01 ; string is single byte JSR LAB_D236 ; make string space A bytes long A=$AC=length, ; X=ptr low byte, Y=ptr high byte PLA ; get character back LDY #$00 ; clear index STA (LAB_00B2),Y ; save byte in string (byte IS string!) PLA ; dump return address (return via get value from line) PLA ; dump return address JMP LAB_D27F ; check for space on descriptor stack, put string address ; and length on stack and update stack pointers ; perform LEFT$() LAB_D4B5 JSR LAB_D516 ; pull string data and byte parameter from stack ; return pointer in descriptor, byte in A (and X), Y=0 CMP (LAB_00A0),Y ; compare byte parameter with string length TYA ; clear A LAB_D4BB BCC LAB_D4C1 ; branch if string length > byte parameter LDA (LAB_00A0),Y ; else make parameter = length TAX ; copy to byte parameter copy TYA ; clear string start offset LAB_D4C1 PHA ; save string start offset LAB_D4C2 TXA ; copy byte parameter (or string length if <) LAB_D4C3 PHA ; save string length JSR LAB_D236 ; make string space A bytes long A=$AC=length, ; X=ptr low byte, Y=ptr high byte LDA LAB_00A0 ; get descriptor pointer low byte LDY LAB_00A1 ; get descriptor pointer high byte JSR LAB_D45F ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=pointer low byte, ; Y=pointer high byte PLA ; get string length back TAY ; copy length to Y PLA ; get string start offset back CLC ; clear carry for add ADC LAB_0072 ; add start offset to string start pointer low byte STA LAB_0072 ; save string start pointer low byte BCC LAB_D4DA ; branch if no overflow INC LAB_0073 ; else increment string start pointer high byte LAB_D4DA TYA ; copy length to A JSR LAB_D441 ; store string A bytes long from pointer to utility JMP LAB_D27F ; check for space on descriptor stack, put string address ; and length on stack and update stack pointers ; perform RIGHT$ LAB_D4E1 JSR LAB_D516 ; pull string data and byte parameter from stack ; return pointer in descriptor, byte in A (and X), Y=0 CLC ; clear carry for add-1 SBC (LAB_00A0),Y ; subtract string length EOR #$FF ; invert it (A=LEN(expression$)-l) JMP LAB_D4BB ; go do string copy ; perform MID$ LAB_D4EC LDA #$FF ; set default length = 255 STA LAB_00B5 ; save default length JSR LAB_00D2 ; scan memory CMP #$29 ; compare with ")" BEQ LAB_D4FD ; branch if = ")" (skip second byte get) JSR LAB_CCAB ; scan for "," , else do syntax error, then warm start JSR LAB_D553 ; get byte parameter LAB_D4FD JSR LAB_D516 ; pull string data and byte parameter from stack ; return pointer in descriptor, byte in A (and X), Y=0 BEQ LAB_D54D ; if byte = 0 do function call error, then warm start DEX ; decrement start index TXA ; copy to A PHA ; save string start offset CLC ; clear carry for sub-1 LDX #$00 ; clear output string length SBC (LAB_00A0),Y ; subtract string length BCS LAB_D4C2 ; if start>string length go do null string EOR #$FF ; complement -length CMP LAB_00B5 ; compare byte parameter BCC LAB_D4C3 ; if length>remaining string go do RIGHT$ LDA LAB_00B5 ; get length byte BCS LAB_D4C3 ; 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 LAB_D516 JSR LAB_CCA5 ; scan for ")" , else do syntax error, then warm start PLA ; pull return address low byte (return address) TAY ; copy it PLA ; pull return address high byte (return address) STA LAB_00A5 ; save it PLA ; dump call to function vector low byte PLA ; dump call to function vector high byte PLA ; pull byte parameter TAX ; copy byte parameter to X PLA ; pull string pointer low byte STA LAB_00A0 ; save it PLA ; pull string pointer high byte STA LAB_00A1 ; save it LDA LAB_00A5 ; get return address high byte back PHA ; push it TYA ; get return address low byte back PHA ; push it LDY #$00 ; clear index TXA ; copy byte parameter RTS ; perform LEN LAB_D531 JSR LAB_D537 ; evaluate string, get length in A (and Y) JMP LAB_D15B ; convert Y to byte in FAC1 and return ; evaluate string, get length in Y LAB_D537 JSR LAB_D458 ; evaluate string LDX #$00 ; set data type = numeric STX LAB_0011 ; clear data type flag, $FF=string, $00=numeric TAY ; copy length to Y RTS ; perform ASC() LAB_D540 JSR LAB_D537 ; evaluate string, get length in A (and Y) BEQ LAB_D54D ; if null do function call error, then warm start LDY #$00 ; set index to first character LDA (LAB_0072),Y ; get byte TAY ; copy to Y JMP LAB_D15B ; convert Y to byte in FAC1 and return ; do function call error, then warm start LAB_D54D JMP LAB_D002 ; do "FC" error ; scan and get byte parameter LAB_D550 JSR LAB_00CC ; increment and scan memory ; get byte parameter LAB_D553 JSR LAB_CB43 ; evaluate expression and check is numeric, ; else do type mismatch ; evaluate byte expression, result in X LAB_D556 JSR LAB_CF72 ; evaluate integer expression (no check) LDX LAB_00B4 ; get FAC1 mantissa BNE LAB_D54D ; if top byte <> 0 do function call error, then warm start LDX LAB_00B5 ; get FAC1 mantissa JMP LAB_00D2 ; scan memory and return ; perform VAL() LAB_D562 JSR LAB_D537 ; evaluate string, get length in A (and Y) BNE LAB_D56A ; branch if not null string ; string was null so set result = $00 JMP LAB_D6AD ; clear FAC1 exponent and sign, and return LAB_D56A LDX LAB_00D3 ; get BASIC execute pointer low byte LDY LAB_00D4 ; get BASIC execute pointer high byte STX LAB_00C1 ; save BASIC execute pointer low byte STY LAB_00C2 ; save BASIC execute pointer high byte LDX LAB_0072 ; get string pointer low byte STX LAB_00D3 ; save as BASIC execute pointer low byte CLC ; clear carry ADC LAB_0072 ; add string length STA LAB_0074 ; save string end low byte LDX LAB_0073 ; get string pointer high byte STX LAB_00D4 ; save as BASIC execute pointer high byte BCC LAB_D582 ; branch if no high byte increment INX ; increment string end high byte LAB_D582 STX LAB_0075 ; save string end high byte LDY #$00 ; set index to $00 LDA (LAB_0074),Y ; get string end byte PHA ; push it LDA #$00 ; clear A STA (LAB_0074),Y ; terminate string with $00 JSR LAB_00D2 ; scan memory JSR LAB_DAA9 ; get FAC1 from string PLA ; restore string end byte LDY #$00 ; set index to zero STA (LAB_0074),Y ; put string end byte back ; restore BASIC execute pointer from temp LAB_D598 LDX LAB_00C1 ; get BASIC execute pointer low byte back LDY LAB_00C2 ; get BASIC execute pointer high byte back STX LAB_00D3 ; save BASIC execute pointer low byte STY LAB_00D4 ; save BASIC execute pointer high byte RTS ; get two parameters for POKE or WAIT LAB_D5A1 JSR LAB_CB43 ; evaluate expression and check type mismatch JSR LAB_D5AD ; save integer part of FAC1 in temporary integer ; scan for "," and get byte, else SN error then warm start LAB_D5A7 JSR LAB_CCAB ; scan for "," , else do syntax error, then warm start JMP LAB_D553 ; get byte parameter and RET ; convert floating-to-fixed ; save integer part of FAC1 in temporary integer LAB_D5AD LDA LAB_00B6 ; get FAC1 sign (b7) BMI LAB_D54D ; if -ve do function call error, then warm start LDA LAB_00B1 ; get FAC1 exponent CMP #$91 ; check with max range+1 BCS LAB_D54D ; if >= do function call error, then warm start JSR LAB_DA51 ; convert FAC1 floating-to-fixed LDA LAB_00B4 ; get FAC1 mantissa LDY LAB_00B5 ; get FAC1 mantissa STY LAB_001C ; save temp integer low byte STA LAB_001D ; save temp integer high byte RTS ; perform PEEK LAB_D5C3 LDA LAB_001D ; get temp integer high byte PHA ; on stack LDA LAB_001C ; get temp integer low byte PHA ; on stack JSR LAB_D5AD ; convert floating-to-fixed LDY #$00 ; clear index LDA (LAB_001C),Y ; get byte via temporary integer (a) TAY ; copy byte to Y PLA ; pop byte STA LAB_001C ; restore temp integer low byte PLA ; pop byte STA LAB_001D ; restore temp integer high byte JMP LAB_D15B ; convert Y to byte in FAC1 and return ; perform POKE LAB_D5DA JSR LAB_D5A1 ; get two parameters for POKE or WAIT TXA ; copy argument b to A LDY #$00 ; clear index STA (LAB_001C),Y ; save byte via temporary integer (a) RTS ; perform WAIT LAB_D5E3 JSR LAB_D5A1 ; get two parameters for POKE or WAIT STX LAB_0099 ; save b LDX #$00 ; clear c JSR LAB_00D2 ; scan memory BEQ LAB_D5F2 ; skip if no second argument JSR LAB_D5A7 ; scan for "," and get byte, else SN error then warm start LAB_D5F2 STX LAB_009A ; save EOR argument LDY #$00 ; clear index LAB_D5F6 LDA (LAB_001C),Y ; get byte via temporary integer (a) EOR LAB_009A ; EOR with second argument (c) AND LAB_0099 ; AND with first argument (b) BEQ LAB_D5F6 ; loop if result is zero LAB_D5FE RTS ; add 0.5 to FAC1 LAB_D5FF LDA #LAB_DCCA ; set 0.5 pointer high byte JMP LAB_D61D ; add (AY) to FAC1 and RET ; perform subtraction, (AY) from FAC1 LAB_D606 JSR LAB_D842 ; unpack memory (AY) into FAC2 ; perform subtraction, FAC1 from FAC2 LAB_D609 LDA LAB_00B6 ; get FAC1 sign (b7) EOR #$FF ; complement it STA LAB_00B6 ; save FAC1 sign (b7) EOR LAB_00BE ; EOR with FAC2 sign (b7) STA LAB_00BF ; save sign compare (FAC1 EOR FAC2) LDA LAB_00B1 ; get FAC1 exponent JMP LAB_D620 ; go add FAC2 to FAC1 ; perform addition LAB_D618 JSR LAB_D74F ; shift FACX A times right (>8 shifts) BCC LAB_D659 ;.go subtract mantissas ; add (AY) to FAC1 LAB_D61D JSR LAB_D842 ; unpack memory (AY) into FAC2 ; add FAC2 to FAC1 LAB_D620 BNE LAB_D625 ; branch if FAC1 was not zero JMP LAB_D9B2 ; FAC1 was zero so copy FAC2 to FAC1 and return ; FAC1 is non zero LAB_D625 LDX LAB_00C0 ; get FAC1 rounding byte STX LAB_00A6 ; save as FAC2 rounding byte LDX #$B9 ; set index to FAC2 exponent addr LDA LAB_00B9 ; get FAC2 exponent LAB_D62D TAY ; copy exponent BEQ LAB_D5FE ; exit if zero SEC ; set carry for subtract SBC LAB_00B1 ; subtract FAC1 exponent BEQ LAB_D659 ; branch if = (go add mantissa) BCC LAB_D649 ; branch if < ; FAC2>FAC1 STY LAB_00B1 ; save FAC1 exponent LDY LAB_00BE ; get FAC2 sign (b7) STY LAB_00B6 ; save FAC1 sign (b7) EOR #$FF ; complement A ADC #$00 ; +1 (twos complement, carry is set) LDY #$00 ; clear Y STY LAB_00A6 ; clear FAC2 rounding byte LDX #$B1 ; set index to FAC1 exponent addr BNE LAB_D64D ; branch always LAB_D649 LDY #$00 ; clear Y STY LAB_00C0 ; clear FAC1 rounding byte LAB_D64D CMP #$F9 ; compare exponent diff with $F9 BMI LAB_D618 ; branch if range $79-$F8 TAY ; copy exponent difference to Y LDA LAB_00C0 ; get FAC1 rounding byte LSR LAB_0001,X ; shift FAC? mantissa1 JSR LAB_D766 ; shift FACX Y times right ; exponents are equal now do mantissa subtract LAB_D659 BIT LAB_00BF ; test sign compare (FAC1 EOR FAC2) BPL LAB_D6B4 ; if = add FAC2 mantissa to FAC1 mantissa and return LDY #$B1 ; set index to FAC1 exponent addr CPX #$B9 ; compare X to FAC2 exponent addr BEQ LAB_D665 ; branch if = LDY #$B9 ; else set index to FAC2 exponent addr ; subtract smaller from bigger (take sign of bigger) LAB_D665 SEC ; set carry for subtract EOR #$FF ; ones complement A ADC LAB_00A6 ; add FAC2 rounding byte STA LAB_00C0 ; save FAC1 rounding byte LDA LAB_0004,Y ; get FACY mantissa SBC LAB_0004,X ; subtract FACX mantissa STA LAB_00B5 ; save FAC1 mantissa LDA LAB_0003,Y ; get FACY mantissa SBC LAB_0003,X ; subtract FACX mantissa STA LAB_00B4 ; save FAC1 mantissa LDA LAB_0002,Y ; get FACY mantissa SBC LAB_0002,X ; subtract FACX mantissa STA LAB_00B3 ; save FAC1 mantissa LDA LAB_0001,Y ; get FACY mantissa SBC LAB_0001,X ; subtract FACX mantissa STA LAB_00B2 ; save FAC1 mantissa ; do ABS and normalise FAC1 LAB_D688 BCS LAB_D68D ; branch if number is +ve JSR LAB_D6FD ; negate FAC1 ; normalise FAC1 LAB_D68D LDY #$00 ; clear Y TYA ; clear A CLC ; clear carry for add LAB_D691 LDX LAB_00B2 ; get FAC1 mantissa BNE LAB_D6DF ; if not zero normalise FAC1 LDX LAB_00B3 ; get FAC1 mantissa STX LAB_00B2 ; save FAC1 mantissa LDX LAB_00B4 ; get FAC1 mantissa STX LAB_00B3 ; save FAC1 mantissa LDX LAB_00B5 ; get FAC1 mantissa STX LAB_00B4 ; save FAC1 mantissa LDX LAB_00C0 ; get FAC1 rounding byte STX LAB_00B5 ; save FAC1 mantissa STY LAB_00C0 ; clear FAC1 rounding byte ADC #$08 ; add x to exponent offset CMP #$20 ; compare with $20 (max offset, all bits would be =0) BNE LAB_D691 ; loop if not max ; clear FAC1 exponent and sign LAB_D6AD LDA #$00 ; clear A LAB_D6AF STA LAB_00B1 ; clear FAC1_e ; save FAC1 sign LAB_D6B1 STA LAB_00B6 ; clear FAC1_s RTS ; add FAC2 mantissa to FAC1 mantissa LAB_D6B4 ADC LAB_00A6 ; add FAC2 rounding byte STA LAB_00C0 ; save FAC1 rounding byte LDA LAB_00B5 ; get FAC1 mantissa ADC LAB_00BD ; add FAC2 mantissa STA LAB_00B5 ; save FAC1 mantissa LDA LAB_00B4 ; get FAC1 mantissa ADC LAB_00BC ; add FAC2 mantissa STA LAB_00B4 ; save FAC1 mantissa LDA LAB_00B3 ; get FAC1 mantissa ADC LAB_00BB ; add FAC2 mantissa STA LAB_00B3 ; save FAC1 mantissa LDA LAB_00B2 ; get FAC1 mantissa ADC LAB_00BA ; add FAC2 mantissa STA LAB_00B2 ; save FAC1 mantissa JMP LAB_D6EC ; test and normalise FAC1 for C=0/1 LAB_D6D3 ADC #$01 ; add 1 to exponent offset ASL LAB_00C0 ; shift FAC1 rounding byte ROL LAB_00B5 ; shift FAC1 mantissa ROL LAB_00B4 ; shift FAC1 mantissa ROL LAB_00B3 ; shift FAC1 mantissa ROL LAB_00B2 ; shift FAC1 mantissa ; normalise FAC1 LAB_D6DF BPL LAB_D6D3 ; loop if not normalised SEC ; set carry for subtract SBC LAB_00B1 ; subtract FAC1 exponent BCS LAB_D6AD ;.if ?? go clear FAC1 and return EOR #$FF ; complement exponent ADC #$01 ; +1 (twos complement) STA LAB_00B1 ; save FAC1 exponent ; test and normalise FAC1 for C=0/1 LAB_D6EC BCC LAB_D6FC ; exit if no overflow ; normalise FAC1 for C=1 LAB_D6EE INC LAB_00B1 ; increment FAC1 exponent BEQ LAB_D734 ; if zero do overflow error and warm start ROR LAB_00B2 ; shift FAC1 mantissa ROR LAB_00B3 ; shift FAC1 mantissa ROR LAB_00B4 ; shift FAC1 mantissa ROR LAB_00B5 ; shift FAC1 mantissa ROR LAB_00C0 ; shift FAC1 rounding byte LAB_D6FC RTS ; negate FAC1 LAB_D6FD LDA LAB_00B6 ; get FAC1 sign (b7) EOR #$FF ; complement it STA LAB_00B6 ; save FAC1 sign (b7) ; twos complement FAC1 mantissa LAB_D703 LDA LAB_00B2 ; get FAC1 mantissa1 EOR #$FF ; complement it STA LAB_00B2 ; save FAC1 mantissa1 LDA LAB_00B3 ; get FAC1 mantissa2 EOR #$FF ; complement it STA LAB_00B3 ; save FAC1 mantissa2 LDA LAB_00B4 ; get FAC1 mantissa3 EOR #$FF ; complement it STA LAB_00B4 ; save FAC1 mantissa3 LDA LAB_00B5 ; get FAC1 mantissa4 EOR #$FF ; complement it STA LAB_00B5 ; save FAC1 mantissa4 LDA LAB_00C0 ; get FAC1 mantissa rounding EOR #$FF ; complement it STA LAB_00C0 ; save FAC1 mantissa rounding INC LAB_00C0 ; increment FAC1 rounding byte BNE LAB_D733 ; exit if no overflow ; increment FAC1 mantissa LAB_D725 INC LAB_00B5 ; increment FAC1 mantissa4 BNE LAB_D733 ; finished if no rollover INC LAB_00B4 ; increment FAC1 mantissa3 BNE LAB_D733 ; finished if no rollover INC LAB_00B3 ; increment FAC1 mantissa2 BNE LAB_D733 ; finished if no rollover INC LAB_00B2 ; increment FAC1 mantissa1 LAB_D733 RTS ; do overflow error (overflow exit) LAB_D734 LDX #$0A ; error code $0A ("OV" error) JMP LAB_C258 ; do error #X, then warm start ; shift FCAtemp << A+8 times LAB_D739 LDX #$75 ; set offset to FACtemp LAB_D73B LDY LAB_0004,X ; get FACX mantissa4 STY LAB_00C0 ; save as FAC1 rounding byte LDY LAB_0003,X ; get FACX mantissa3 STY LAB_0004,X ; save FACX mantissa4 LDY LAB_0002,X ; get FACX mantissa2 STY LAB_0003,X ; save FACX mantissa3 LDY LAB_0001,X ; get FACX mantissa1 STY LAB_0002,X ; save FACX mantissa2 LDY LAB_00B8 ; get FAC1 overflow byte STY LAB_0001,X ; save FACX mantissa1 ; shift FACX -A times right (> 8 shifts) LAB_D74F ADC #$08 ; add 8 to shift count BMI LAB_D73B ; go do 8 shift if still -ve BEQ LAB_D73B ; go do 8 shift if zero SBC #$08 ; else subtract 8 again TAY ; save count to Y LDA LAB_00C0 ; get FAC1 rounding byte BCS LAB_D770 ;. clear carry and exit LAB_D75C ASL LAB_0001,X ; shift FACX mantissa BCC LAB_D762 ; branch if +ve INC LAB_0001,X ; this sets b7 eventually LAB_D762 ROR LAB_0001,X ; shift FACX mantissa1 (correct for ASL) ROR LAB_0001,X ; shift FACX mantissa1 (put carry in b7) ; shift FACX Y times right LAB_D766 ROR LAB_0002,X ; shift FACX mantissa ROR LAB_0003,X ; shift FACX mantissa ROR LAB_0004,X ; shift FACX mantissa ROR ; shift FACX rounding byte INY ; increment exponent diff BNE LAB_D75C ; branch if range adjust not complete LAB_D770 CLC ; just clear it RTS ; LAB_D772 .byte $81,$00,$00,$00,$00 ; 1 LAB_D777 .byte $03 ; LOG series .byte $7F,$5E,$56,$CB,$79 ; 0.43425594188739 .byte $80,$13,$9B,$0B,$64 ; 0.57658454123884 .byte $80,$76,$38,$93,$16 ; 0.96180075919256 .byte $82,$38,$AA,$3B,$20 ; 2.88539007306099 LAB_D78C .byte $80,$35,$04,$F3,$34 ; 1/SQR(2) LAB_D791 .byte $81,$35,$04,$F3,$34 ; SQR(2) LAB_D796 .byte $80,$80,$00,$00,$00 ; -0.5 LAB_D79B .byte $80,$31,$72,$17,$F8 ; LOG(2) ; perform LOG LAB_D7A0 JSR LAB_D9E1 ; test sign and zero BEQ LAB_D7A7 ; if zero do function call error, then warm start BPL LAB_D7AA ; skip error if +ve LAB_D7A7 JMP LAB_D002 ; do "FC" error LAB_D7AA LDA LAB_00B1 ; get FAC1 exponent SBC #$7F ; normalise it PHA ; save it LDA #$80 ; set exponent to zero STA LAB_00B1 ; save FAC1 exponent LDA #LAB_D78C ; set 1/root2 pointer high byte JSR LAB_D61D ; add (AY) to FAC1 (1/root2) LDA #LAB_D791 ; set root2 pointer high byte JSR LAB_D8C5 ; convert AY and do (AY)/FAC1 LDA #LAB_D772 ; set 1 pointer high byte JSR LAB_D606 ; subtract (AY) from FAC1 LDA #LAB_D777 ; set pointer high byte to counter JSR LAB_DDC2 ; ^2 then series evaluation LDA #LAB_D796 ; set -0.5 pointer high byte JSR LAB_D61D ; add (AY) to FAC1 PLA ; restore FAC1 exponent JSR LAB_DB3B ; evaluate new ASCII digit LDA #LAB_D79B ; set LOG(2) pointer high byte ; do convert AY, FCA1*(AY) LAB_D7DE JSR LAB_D842 ; unpack memory (AY) into FAC2 BNE LAB_D7E6 ; branch if not zero JMP LAB_D841 ; else exit LAB_D7E6 JSR LAB_D86D ; test and adjust accumulators LDA #$00 ; clear A STA LAB_0076 ; clear temp mantissa STA LAB_0077 ; clear temp mantissa STA LAB_0078 ; clear temp mantissa STA LAB_0079 ; clear temp mantissa LDA LAB_00C0 ; get FAC1 rounding byte JSR LAB_D80F ; go do shift/add FAC2 LDA LAB_00B5 ; get FAC1 mantissa JSR LAB_D80F ; go do shift/add FAC2 LDA LAB_00B4 ; get FAC1 mantissa JSR LAB_D80F ; go do shift/add FAC2 LDA LAB_00B3 ; get FAC1 mantissa JSR LAB_D80F ; go do shift/add FAC2 LDA LAB_00B2 ; get FAC1 mantissa JSR LAB_D814 ; go do shift/add FAC2 JMP LAB_D945 ; copy temp to FAC1, normalise and return LAB_D80F BNE LAB_D814 ; branch if byte <> zero JMP LAB_D739 ; shift FCAtemp << A+8 times ; else do shift and add LAB_D814 LSR A ; shift byte ORA #$80 ; set top bit (mark for 8 times) LAB_D817 TAY ; copy result BCC LAB_D833 ; skip next if bit was zero CLC ; clear carry for add LDA LAB_0079 ; get temp mantissa ADC LAB_00BD ; add FAC2 mantissa STA LAB_0079 ; save temp mantissa LDA LAB_0078 ; get temp mantissa ADC LAB_00BC ; add FAC2 mantissa STA LAB_0078 ; save temp mantissa LDA LAB_0077 ; get temp mantissa ADC LAB_00BB ; add FAC2 mantissa STA LAB_0077 ; save temp mantissa LDA LAB_0076 ; get temp mantissa ADC LAB_00BA ; add FAC2 mantissa STA LAB_0076 ; save temp mantissa LAB_D833 ROR LAB_0076 ; shift temp mantissa ROR LAB_0077 ; shift temp mantissa ROR LAB_0078 ; shift temp mantissa ROR LAB_0079 ; shift temp mantissa ROR LAB_00C0 ; shift temp rounding byte TYA ; get byte back LSR ; shift byte BNE LAB_D817 ; loop if all bits not done LAB_D841 RTS ; unpack memory (AY) into FAC2 LAB_D842 STA LAB_0072 ; save pointer low byte STY LAB_0073 ; save pointer high byte LDY #$04 ; 5 bytes to get (0-4) LDA (LAB_0072),Y ; get mantissa STA LAB_00BD ; save FAC2 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get mantissa STA LAB_00BC ; save FAC2 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get mantissa STA LAB_00BB ; save FAC2 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get mantissa1+sign STA LAB_00BE ; save FAC2 sign (b7) EOR LAB_00B6 ; EOR with FAC1 sign (b7) STA LAB_00BF ; save sign compare (FAC1 EOR FAC2) LDA LAB_00BE ; recover FAC2 sign (b7) ORA #$80 ; set 1xxx xxx (set normal bit) STA LAB_00BA ; save FAC2 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get exponent byte STA LAB_00B9 ; save FAC2 exponent LDA LAB_00B1 ; get FAC1 exponent RTS ; test and adjust accumulators LAB_D86D LDA LAB_00B9 ; get FAC2 exponent LAB_D86F BEQ LAB_D890 ; branch if FAC2 = $00 (handle underflow) CLC ; clear carry for add ADC LAB_00B1 ; add FAC1 exponent BCC LAB_D87A ; branch if sum of exponents <$0100 BMI LAB_D895 ; do overflow error CLC ; clear carry for the add .byte $2C ; makes next line BIT $1410 LAB_D87A BPL LAB_D890 ; if +ve go handle underflow ADC #$80 ; correct exponent STA LAB_00B1 ; save FAC1 exponent BNE LAB_D885 ; branch if not 0 JMP LAB_D6B1 ; save FAC1 sign and return LAB_D885 LDA LAB_00BF ; get sign compare (FAC1 EOR FAC2) STA LAB_00B6 ; save FAC1 sign (b7) RTS ; handle overflow and underflow LAB_D88A LDA LAB_00B6 ; get FAC1 sign (b7) EOR #$FF ; complement it BMI LAB_D895 ; do overflow error ; handle underflow LAB_D890 PLA ; pop return address low byte PLA ; pop return address high byte JMP LAB_D6AD ; clear FAC1 ; do OF error LAB_D895 JMP LAB_D734 ; multiply by 10 LAB_D898 JSR LAB_D9C2 ; round and copy FAC1 to FAC2 TAX ; copy exponent (set the flags) BEQ LAB_D8AE ; exit if zero CLC ; clear carry for add ADC #$02 ; add two to exponent (*4) BCS LAB_D895 ; do overflow error if > $FF LDX #$00 ; clear byte STX LAB_00BF ; clear sign compare (FAC1 EOR FAC2) JSR LAB_D62D ; add FAC2 to FAC1 (*5) INC LAB_00B1 ; increment FAC1 exponent (*10) BEQ LAB_D895 ; if zero do OF error LAB_D8AE RTS LAB_D8AF .byte $84,$20,$00,$00,$00 ; 10 ; divide by 10 LAB_D8B4 JSR LAB_D9C2 ; round and copy FAC1 to FAC2 LDA #LAB_D8AF ; set pointer to 10d high addr LDX #$00 ; clear sign ; divide by (AY) (X=sign) LAB_D8BD STX LAB_00BF ; save sign compare (FAC1 EOR FAC2) JSR LAB_D958 ; unpack memory (AY) into FAC1 JMP LAB_D8C8 ; do FAC2/FAC1 ; Perform divide-by ; convert AY and do (AY)/FAC1 LAB_D8C5 JSR LAB_D842 ; unpack memory (AY) into FAC2 ; Perform divide-into LAB_D8C8 BEQ LAB_D940 ; if zero go do /0 error JSR LAB_D9D1 ; round FAC1 LDA #$00 ; clear A SEC ; set carry for subtract SBC LAB_00B1 ; subtract FAC1 exponent (2s complement) STA LAB_00B1 ; save FAC1 exponent JSR LAB_D86D ; test and adjust accumulators INC LAB_00B1 ; increment FAC1 exponent BEQ LAB_D895 ; if zero do overflow error LDX #$FC ; set index to FACt LDA #$01 ; set byte LAB_D8DF LDY LAB_00BA ; get FAC2 mantissa1 CPY LAB_00B2 ; compare FAC1 mantissa1 BNE LAB_D8F5 ; branch if <> LDY LAB_00BB ; get FAC2 mantissa2 CPY LAB_00B3 ; compare FAC1 mantissa2 BNE LAB_D8F5 ; branch if <> LDY LAB_00BC ; get FAC2 mantissa3 CPY LAB_00B4 ; compare FAC1 mantissa3 BNE LAB_D8F5 ; branch if <> LDY LAB_00BD ; get FAC2 mantissa4 CPY LAB_00B5 ; compare FAC1 mantissa4 LAB_D8F5 PHP ; save FAC2-FAC1 compare status ROL ; shift byte BCC LAB_D902 ; skip next if no carry INX ; increment index to FACt STA LAB_0079,X ;. BEQ LAB_D930 ;. BPL LAB_D934 ;. LDY #$01 ;. LAB_D902 PLP ; restore FAC2-FAC1 compare status BCS LAB_D913 ; if FAC2 >= FAC1 then go do subtract ; FAC2 = FAC2*2 LAB_D905 ASL LAB_00BD ; shift FAC2 mantissa ROL LAB_00BC ; shift FAC2 mantissa ROL LAB_00BB ; shift FAC2 mantissa ROL LAB_00BA ; shift FAC2 mantissa BCS LAB_D8F5 ; loop with no compare BMI LAB_D8DF ; loop with compare BPL LAB_D8F5 ; loop always with no compare LAB_D913 TAY ; save FAC2-FAC1 compare status LDA LAB_00BD ; get FAC2 mantissa SBC LAB_00B5 ; subtract FAC1 mantissa STA LAB_00BD ; save FAC2 mantissa LDA LAB_00BC ; get FAC2 mantissa SBC LAB_00B4 ; subtract FAC1 mantissa STA LAB_00BC ; save FAC2 mantissa LDA LAB_00BB ; get FAC2 mantissa SBC LAB_00B3 ; subtract FAC1 mantissa STA LAB_00BB ; save FAC2 mantissa LDA LAB_00BA ; get FAC2 mantissa SBC LAB_00B2 ; subtract FAC1 mantissa STA LAB_00BA ; save FAC2 mantissa TYA ; restore FAC2-FAC1 compare status JMP LAB_D905 LAB_D930 LDA #$40 ;. BNE LAB_D902 ; branch always ; do A<<6, save as FAC1 rounding byte, normalise and return LAB_D934 ASL ;. ASL ;. ASL ;. ASL ;. ASL ;. ASL ;. STA LAB_00C0 ; save FAC1 rounding byte PLP ; dump FAC2-FAC1 compare status JMP LAB_D945 ; copy temp to FAC1, normalise and return ; do "/0" error LAB_D940 LDX #$14 ; error code $14 ("/0" error) JMP LAB_C258 ; do error #X, then warm start ; copy temp to FAC1 and normalise LAB_D945 LDA LAB_0076 ; get temp mantissa STA LAB_00B2 ; save FAC1 mantissa LDA LAB_0077 ; get temp mantissa STA LAB_00B3 ; save FAC1 mantissa LDA LAB_0078 ; get temp mantissa STA LAB_00B4 ; save FAC1 mantissa LDA LAB_0079 ; get temp mantissa STA LAB_00B5 ; save FAC1 mantissa JMP LAB_D68D ; normalise FAC1 and return ; unpack memory (AY) into FAC1 LAB_D958 STA LAB_0072 ; save pointer low byte STY LAB_0073 ; save pointer high byte LDY #$04 ; 5 bytes to do LDA (LAB_0072),Y ; get byte STA LAB_00B5 ; save FAC1 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get byte STA LAB_00B4 ; save FAC1 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get byte STA LAB_00B3 ; save FAC1 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get byte STA LAB_00B6 ; save FAC1 sign (b7) ORA #$80 ; set 1xxx xxxx (add normal bit) STA LAB_00B2 ; save FAC1 mantissa DEY ; decrement index LDA (LAB_0072),Y ; get byte (exponent) STA LAB_00B1 ; save FAC1 exponent STY LAB_00C0 ; clear FAC1 rounding byte RTS ; pack FAC1 into numexp LAB_D97D LDX #$AC ; set pointer low byte .byte $2C ; makes next line BIT LAB_A7A2 ; pack FAC1 into Adatal LAB_D980 LDX #$A7 ; set pointer low byte LDY #$00 ; set pointer high byte BEQ LAB_D98A ; pack FAC1 into (XY) and RET ; pack FAC1 into LAB_D986 LDX LAB_0099 ; get destination pointer low byte LDY LAB_009A ; get destination pointer high byte ; pack FAC1 into (XY) LAB_D98A JSR LAB_D9D1 ; round FAC1 STX LAB_0072 ; save pointer low byte STY LAB_0073 ; save pointer high byte LDY #$04 ; set index LDA LAB_00B5 ; get FAC1 mantissa STA (LAB_0072),Y ; store in destination DEY ; decrement index LDA LAB_00B4 ; get FAC1 mantissa STA (LAB_0072),Y ; store in destination DEY ; decrement index LDA LAB_00B3 ; get FAC1 mantissa STA (LAB_0072),Y ; store in destination DEY ; decrement index LDA LAB_00B6 ; get FAC1 sign (b7) ORA #$7F ; set bits x111 1111 AND LAB_00B2 ; AND in FAC1 mantissa STA (LAB_0072),Y ; store in destination DEY ; decrement index LDA LAB_00B1 ; get FAC1 exponent STA (LAB_0072),Y ; store in destination STY LAB_00C0 ; clear FAC1 rounding byte RTS ; copy FAC2 to FAC1 LAB_D9B2 LDA LAB_00BE ; get FAC2 sign (b7) ; save FAC1 sign and copy ABS(FAC2) to FAC1 LAB_D9B4 STA LAB_00B6 ; save FAC1 sign (b7) LDX #$05 ; 5 bytes to copy LAB_D9B8 LDA LAB_00B8,X ; get byte from FAC2,X STA LAB_00B0,X ; save byte at FAC1,X DEX ; decrement count BNE LAB_D9B8 ; loop if not all done STX LAB_00C0 ; clear FAC1 rounding byte RTS ; round and copy FAC1 to FAC2 LAB_D9C2 JSR LAB_D9D1 ; round FAC1 LAB_D9C5 LDX #$06 ; 6 bytes to copy LAB_D9C7 LDA LAB_00B0,X ; get byte from FAC1,X STA LAB_00B8,X ; save byte at FAC2,X DEX ; decrement count BNE LAB_D9C7 ; loop if not all done STX LAB_00C0 ; clear FAC1 rounding byte LAB_D9D0 RTS ; round FAC1 LAB_D9D1 LDA LAB_00B1 ; get FAC1 exponent BEQ LAB_D9D0 ; exit if zero ASL LAB_00C0 ; shift FAC1 rounding byte BCC LAB_D9D0 ; exit if no overflow ; round FAC1 (no check) LAB_D9D9 JSR LAB_D725 ; increment FAC1 mantissa BNE LAB_D9D0 ; branch if no overflow JMP LAB_D6EE ; normalise FAC1 for C=1 and return ; get FAC1 sign ; return A=FF,C=1/-ve A=01,C=0/+ve LAB_D9E1 LDA LAB_00B1 ; get FAC1 exponent BEQ LAB_D9EE ; exit if zero (already correct SGN(0)=0) ; return A=FF,C=1/-ve A=01,C=0/+ve ; no = 0 check LAB_D9E5 LDA LAB_00B6 ; else get FAC1 sign (b7) ; return A=FF,C=1/-ve A=01,C=0/+ve ; no = 0 check, sign in A LAB_D9E7 ROL ; move sign bit to carry LDA #$FF ; set byte for -ve result BCS LAB_D9EE ; return if sign was set (-ve) LDA #$01 ; else set byte for +ve LAB_D9EE RTS ; perform SGN LAB_D9EF JSR LAB_D9E1 ; get FAC1 sign ; return A=$FF/-ve A=$01/+ve ; save A as integer byte LAB_D9F2 STA LAB_00B2 ; save FAC1 mantissa LDA #$00 ; clear A STA LAB_00B3 ; clear FAC1 mantissa LDX #$88 ; set exponent ; set exp=X, clearFAC1 mantissa and normalise LAB_D9FA LDA LAB_00B2 ; get FAC1 mantissa EOR #$FF ; complement it ROL ; sign bit into carry ; set exp=X, clearFAC1 mantissa and normalise LAB_D9FF LDA #$00 ; clear A STA LAB_00B5 ; clear FAC1 mantissa STA LAB_00B4 ; clear FAC1 mantissa STX LAB_00B1 ; set FAC1 exponent STA LAB_00C0 ; clear FAC1 rounding byte STA LAB_00B6 ; clear FAC1 sign (b7) JMP LAB_D688 ; do ABS and normalise FAC1 ; perform ABS() LAB_DA0E LSR LAB_00B6 ; clear FAC1 sign (put zero in b7) RTS ; compare FAC1 with (AY) ; returns A=$00 if FAC1 = (AY) ; returns A=$01 if FAC1 > (AY) ; returns A=$FF if FAC1 < (AY) LAB_DA11 STA LAB_0074 ; save pointer low byte LAB_DA13 STY LAB_0075 ; save pointer high byte LDY #$00 ; clear index LDA (LAB_0074),Y ; get exponent INY ; increment index TAX ; copy (AY) exponent to X BEQ LAB_D9E1 ; branch if (AY) exponent=0 and get FAC1 sign ; A=FF,C=1/-ve A=01,C=0/+ve LDA (LAB_0074),Y ; get (AY) mantissa (with sign) EOR LAB_00B6 ; EOR FAC1 sign (b7) BMI LAB_D9E5 ; if signs <> do return A=FF,C=1/-ve ; A=01,C=0/+ve and return CPX LAB_00B1 ; compare (AY) exponent with FAC1 exponent BNE LAB_DA48 ; branch if different LDA (LAB_0074),Y ; get (AY) mantissa (with sign) ORA #$80 ; normalise top bit CMP LAB_00B2 ; compare with FAC1 mantissa BNE LAB_DA48 ; branch if different INY ; increment index LDA (LAB_0074),Y ; get mantissa CMP LAB_00B3 ; compare with FAC1 mantissa BNE LAB_DA48 ; branch if different INY ; increment index LDA (LAB_0074),Y ; get mantissa CMP LAB_00B4 ; compare with FAC1 mantissa BNE LAB_DA48 ; branch if different INY ; increment index LDA #$7F ; set for 1/2 value rounding byte CMP LAB_00C0 ; compare with FAC1 rounding byte (set carry) LDA (LAB_0074),Y ; get mantissa SBC LAB_00B5 ; subtract FAC1 mantissa BEQ LAB_DA70 ; exit if mantissa3 equal ; gets here if number <> FAC1 LAB_DA48 LDA LAB_00B6 ; get FAC1 sign (b7) BCC LAB_DA4E ; branch if FAC1 > (AY) EOR #$FF ; else toggle FAC1 sign LAB_DA4E JMP LAB_D9E7 ; return A=FF,C=1/-ve A=01,C=0/+ve ; convert FAC1 floating-to-fixed LAB_DA51 LDA LAB_00B1 ; get FAC1 exponent BEQ LAB_DA9F ; if zero go clear FAC1 and return SEC ; set carry for subtract SBC #$A0 ; subtract maximum integer range exponent BIT LAB_00B6 ; test FAC1 sign (b7) BPL LAB_DA65 ; branch if FAC1 +ve ; FAC1 was -ve TAX ; copy subtracted exponent LDA #$FF ; overflow for -ve number STA LAB_00B8 ; set FAC1 overflow byte JSR LAB_D703 ; twos complement FAC1 mantissa TXA ; restore subtracted exponent LAB_DA65 LDX #$B1 ; set index to FAC1 CMP #$F9 ; compare exponent result BPL LAB_DA71 ; if < 8 shifts shift FAC1 A times right and ret JSR LAB_D74F ; shift FAC1 A times right (> 8 shifts) STY LAB_00B8 ; clear FAC1 overflow byte LAB_DA70 RTS ; shift FAC1 A times right LAB_DA71 TAY ; copy shift count LDA LAB_00B6 ; get FAC1 sign (b7) AND #$80 ; mask sign bit only (x000 0000) LSR LAB_00B2 ; shift FAC1 mantissa ORA LAB_00B2 ; OR sign in b7 FAC1 mantissa STA LAB_00B2 ; save FAC1 mantissa JSR LAB_D766 ; shift FAC1 Y times right STY LAB_00B8 ; clear FAC1 overflow byte RTS ; perform INT() LAB_DA82 LDA LAB_00B1 ; get FAC1 exponent CMP #$A0 ; compare with max int BCS LAB_DAA8 ; exit if >= (already int, too big for fractional part!) JSR LAB_DA51 ; convert FAC1 floating-to-fixed STY LAB_00C0 ; save FAC1 rounding byte LDA LAB_00B6 ; get FAC1 sign (b7) STY LAB_00B6 ; save FAC1 sign (b7) EOR #$80 ; toggle FAC1 sign ROL ; shift into carry LDA #$A0 ; set new exponent STA LAB_00B1 ; save FAC1 exponent LDA LAB_00B5 ; get FAC1 mantissa4 STA LAB_000D ;. JMP LAB_D688 ; do ABS and normalise FAC1 ; clear FAC1 and return LAB_DA9F STA LAB_00B2 ; clear FAC1 mantissa1 STA LAB_00B3 ; clear FAC1 mantissa2 STA LAB_00B4 ; clear FAC1 mantissa3 STA LAB_00B5 ; clear FAC1 mantissa4 TAY ; clear Y LAB_DAA8 RTS ; get FAC1 from string LAB_DAA9 LDY #$00 ; clear Y LDX #$0A ; set index LAB_DAAD STY LAB_00AD,X ; clear byte DEX ; decrement index BPL LAB_DAAD ; loop until numexp to negnum (and FAC1) = $00 BCC LAB_DACA ; branch if 1st character numeric ; get FAC1 from string .. first character wasn't numeric CMP #$26 ; else compare with "&" BNE LAB_DABB ; branch if not "&" JMP LAB_CDFE ; else go evaluate integer ; get FAC1 from string .. first character wasn't numeric or & LAB_DABB CMP #$2D ; else compare with "-" BNE LAB_DAC3 ; branch if not "-" STX LAB_00B7 ; set flag for -ve number (X = $FF) BEQ LAB_DAC7 ; branch always ; get FAC1 from string .. first character wasn't numeric & or - LAB_DAC3 CMP #$2B ; else compare with "+" BNE LAB_DACC ; branch if not "+" (go check for hex/bin) ; was "+" or "-" to start, so get next character LAB_DAC7 JSR LAB_00CC ; increment and scan memory LAB_DACA BCC LAB_DB27 ; branch if numeric character LAB_DACC CMP #$2E ; else compare with "." BEQ LAB_DAFE ; branch if "." ; get FAC1 from string .. character wasn't numeric, -, + or . CMP #$45 ; else compare with "E" BNE LAB_DB04 ; branch if not "E" ; was "E" so evaluate exponential part JSR LAB_00CC ; increment and scan memory BCC LAB_DAF0 ; branch if numeric character CMP #$A5 ; else compare with token for - BEQ LAB_DAEB ; branch if token for - CMP #$2D ; else compare with "-" BEQ LAB_DAEB ; branch if "-" CMP #$A4 ; else compare with token for + BEQ LAB_DAED ; branch if token for + CMP #$2B ; else compare with "+" BEQ LAB_DAED ; branch if "+" BNE LAB_DAF2 ; branch always LAB_DAEB ROR LAB_00B0 ; set exponent -ve flag (C, which=1, into b7) LAB_DAED JSR LAB_00CC ; increment and scan memory LAB_DAF0 BCC LAB_DB4E ; branch if numeric character LAB_DAF2 BIT LAB_00B0 ; test exponent -ve flag BPL LAB_DB04 ; if +ve go evaluate exponent ; else do exponent = -exponent LDA #$00 ; clear result SEC ; set carry for subtract SBC LAB_00AE ; subtract exponent byte JMP LAB_DB06 ; go evaluate exponent LAB_DAFE ROR LAB_00AF ; set decimal point flag BIT LAB_00AF ; test decimal point flag BVC LAB_DAC7 ; branch if only one decimal point so far ; evaluate exponent LAB_DB04 LDA LAB_00AE ; get exponent count byte LAB_DB06 SEC ; set carry for subtract SBC LAB_00AD ; subtract numerator exponent STA LAB_00AE ; save exponent count byte BEQ LAB_DB1F ; branch if no adjustment BPL LAB_DB18 ; else if +ve go do FAC1*10^expcnt ; else go do FAC1/10^(0-expcnt) LAB_DB0F JSR LAB_D8B4 ; divide by 10 INC LAB_00AE ; increment exponent count byte BNE LAB_DB0F ; loop until all done BEQ LAB_DB1F ; branch always LAB_DB18 JSR LAB_D898 ; multiply by 10 DEC LAB_00AE ; decrement exponent count byte BNE LAB_DB18 ; loop until all done LAB_DB1F LDA LAB_00B7 ; get -ve flag BMI LAB_DB24 ; if -ve do - FAC1 and return RTS ; do - FAC1 and return LAB_DB24 JMP LAB_DD36 ; do - FAC1 and return ; do unsigned FAC1*10+number LAB_DB27 PHA ; save character BIT LAB_00AF ; test decimal point flag BPL LAB_DB2E ; skip exponent increment if not set INC LAB_00AD ; else increment number exponent LAB_DB2E JSR LAB_D898 ; multiply FAC1 by 10 PLA ; restore character SEC ; set carry for subtract SBC #$30 ; convert to binary JSR LAB_DB3B ; evaluate new ASCII digit JMP LAB_DAC7 ; go do next character ; evaluate new ASCII digit LAB_DB3B PHA ; save digit JSR LAB_D9C2 ; round and copy FAC1 to FAC2 PLA ; restore digit JSR LAB_D9F2 ; save A as integer byte LDA LAB_00BE ; get FAC2 sign (b7) EOR LAB_00B6 ; toggle with FAC1 sign (b7) STA LAB_00BF ; save sign compare (FAC1 EOR FAC2) LDX LAB_00B1 ; get FAC1 exponent JMP LAB_D620 ; add FAC2 to FAC1 and return ; evaluate next character of exponential part of number LAB_DB4E LDA LAB_00AE ; get exponent count byte CMP #$0A ; compare with 10 decimal BCC LAB_DB5D ; branch if less LDA #$64 ; make all -ve exponents = -100 decimal (causes underflow) BIT LAB_00B0 ; test exponent -ve flag BMI LAB_DB6B ; branch if -ve JMP LAB_D734 ; else do overflow error LAB_DB5D ASL ; *2 ASL ; *4 CLC ; clear carry for add ADC LAB_00AE ; *5 ASL A ; *10 CLC ; clear carry for add LDY #$00 ; set index ADC (LAB_00D3),Y ; add character (will be $30 too much!) SEC ; set carry for subtract SBC #$30 ; convert character to binary LAB_DB6B STA LAB_00AE ; save exponent count byte JMP LAB_DAED ; go get next character LAB_DB70 .byte $9B,$3E,$BC,$1F,$FD ; 99999999.90625 LAB_DB75 .byte $9E,$6E,$6B,$27,$FD ; 999999999.25 LAB_DB7A .byte $9E,$6E,$6B,$28,$00 ; 1000000000 ; print " in line [LINE #]" LAB_DB7F LDA #LAB_C197 ; pointer to IN message high byte JSR LAB_DB97 ; print null terminated string from (AY) ; Print Basic line # LDA LAB_008A ; get current line high byte LDX LAB_0089 ; get current line low byte ; print XA as unsigned integer LAB_DB8A STA LAB_00B2 ; save low byte as FAC1 mantissa STX LAB_00B3 ; save high byte as FAC1 mantissa LDX #$90 ; set exponent to 16d bits SEC ; set integer is +ve flag JSR LAB_D9FF ; set exp=X, clearFAC1 mantissa3/4 and normalise JSR LAB_DB9A ; convert FAC1 to string LAB_DB97 JMP LAB_C954 ; print null terminated string from (AY) and return ; convert FAC1 to ASCII string result in (AY) LAB_DB9A LDY #$01 ; set index = 1 LAB_DB9C LDA #$20 ; character = " " (assume +ve) BIT LAB_00B6 ; test FAC1 sign (b7) BPL LAB_DBA4 ; branch if +ve LDA #$2D ; else character = "-" LAB_DBA4 STA LAB_00FF,Y ; save leading character (" " or "-") STA LAB_00B6 ; save FAC1 sign (b7) STY LAB_00C1 ; save index INY ; increment index LDA #$30 ; set character = "0" LDX LAB_00B1 ; get FAC1 exponent BNE LAB_DBB5 ; branch if FAC1<>0 ; exponent was $00 so FAC1 is 0 JMP LAB_DCBD ; save last character, [EOT] and exit ; FAC1 is some non zero value LAB_DBB5 LDA #$00 ; clear (number exponent count) CPX #$80 ; compare FAC1 exponent with $81 (>1.00000) BEQ LAB_DBBD ; branch if FAC1=1 BCS LAB_DBC6 ; branch if FAC1>1 ; FAC1<1 LAB_DBBD LDA #LAB_DB7A ; set pointer high byte to 1000000000 JSR LAB_D7DE ; do convert AY, FCA1*(AY) LDA #$F7 ; set number exponent count LAB_DBC6 STA LAB_00AD ; save number exponent count LAB_DBC8 LDA #LAB_DB75 ; set pointer high byte to 999999999.25 JSR LAB_DA11 ; compare FAC1 with (AY) BEQ LAB_DBEF ; exit if FAC1 = (AY) BPL LAB_DBE5 ; go do /10 if FAC1 > (AY) ; FAC1 < (AY) LAB_DBD3 LDA #LAB_DB70 ; set pointer high byte to 99999999.90625 JSR LAB_DA11 ; compare FAC1 with (AY) BEQ LAB_DBDE ; branch if FAC1 = (AY) (allow decimal places) BPL LAB_DBEC ; branch if FAC1 > (AY) (no decimal places) ; FAC1 <= (AY) LAB_DBDE JSR LAB_D898 ; multiply by 10 DEC LAB_00AD ; decrement number exponent count BNE LAB_DBD3 ; go test again (branch always) LAB_DBE5 JSR LAB_D8B4 ; divide by 10 INC LAB_00AD ; increment number exponent count BNE LAB_DBC8 ; go test again (branch always) ; now we have just the digits to do LAB_DBEC JSR LAB_D5FF ; add 0.5 to FAC1 LAB_DBEF JSR LAB_DA51 ; convert FAC1 floating-to-fixed LDX #$01 ; set default digits before dp = 1 LDA LAB_00AD ; get number exponent count CLC ; clear carry for add ADC #$0A ; up to 9 digits before point BMI LAB_DC04 ; if -ve then 1 digit before dp CMP #$0B ; A>=B if n>=1E9 BCS LAB_DC05 ; branch if >= $0B ; carry is clear ADC #$FF ; take 1 from digit count TAX ; copy to A LDA #$02 ; set exponent adjust LAB_DC04 SEC ; set carry for subtract LAB_DC05 SBC #$02 ; -2 STA LAB_00AE ; save exponent adjust STX LAB_00AD ; save digits before dp count TXA ; copy to A BEQ LAB_DC10 ; branch if no digits before dp BPL LAB_DC23 ; branch if digits before dp LAB_DC10 LDY LAB_00C1 ; get output string index LDA #$2E ; character "." INY ; increment index STA LAB_00FF,Y ; save to output string TXA ;. BEQ LAB_DC21 ;. LDA #$30 ; character "0" INY ; increment index STA LAB_00FF,Y ; save to output string LAB_DC21 STY LAB_00C1 ; save output string index LAB_DC23 LDY #$00 ; clear index (point to ????) LDX #$80 ;. LAB_DC27 LDA LAB_00B5 ; get FAC1 mantissa CLC ; clear carry for add ADC LAB_DCD2,Y ; add -ve STA LAB_00B5 ; save FAC1 mantissa LDA LAB_00B4 ; get FAC1 mantissa ADC LAB_DCD1,Y ; add -ve STA LAB_00B4 ; save FAC1 mantissa LDA LAB_00B3 ; get FAC1 mantissa ADC LAB_DCD0,Y ; add -ve STA LAB_00B3 ; save FAC1 mantissa LDA LAB_00B2 ; get FAC1 mantissa ADC LAB_DCCF,Y ; add -ve STA LAB_00B2 ; save FAC1 mantissa INX ;. BCS LAB_DC4B ;. BPL LAB_DC27 ; not -ve so try again BMI LAB_DC4D ;. LAB_DC4B BMI LAB_DC27 ;. LAB_DC4D TXA ;. BCC LAB_DC54 ;. EOR #$FF ;. ADC #$0A ;. LAB_DC54 ADC #$2F ; add "0"-1 to result INY ; increment .. INY ; .. index to .. INY ; .. next less .. INY ; .. power of ten STY LAB_0097 ; save as current var address low byte LDY LAB_00C1 ; get output string index INY ; increment output string index TAX ; copy character to X AND #$7F ; mask out top bit STA LAB_00FF,Y ; save to output string DEC LAB_00AD ; decrement # of characters before the dp BNE LAB_DC6F ; branch if still characters to do ; else output the point LDA #$2E ; character "." INY ; increment output string index STA LAB_00FF,Y ; save to output string LAB_DC6F STY LAB_00C1 ; save output string index LDY LAB_0097 ; get current var address low byte TXA ; get character back EOR #$FF ; AND #$80 ; TAX ; CPY #$24 ; compare index with max BNE LAB_DC27 ; loop if not max ; now remove trailing zeroes LDY LAB_00C1 ; get output string index LAB_DC7F LDA LAB_00FF,Y ; get character from output string DEY ; decrement output string index CMP #$30 ; compare with "0" BEQ LAB_DC7F ; loop until non "0" character found CMP #$2E ; compare with "." BEQ LAB_DC8C ; branch if was dp ; restore last character INY ; increment output string index LAB_DC8C LDA #$2B ; character "+" LDX LAB_00AE ; get exponent count BEQ LAB_DCC0 ; if zero go set null terminator and exit ; exponent isn't zero so write exponent BPL LAB_DC9C ; branch if exponent count +ve LDA #$00 ; clear A SEC ; set carry for subtract SBC LAB_00AE ; subtract exponent count adjust (convert -ve to +ve) TAX ; copy exponent count to X LDA #$2D ; character "-" LAB_DC9C STA LAB_0101,Y ; save to output string LDA #$45 ; character "E" STA LAB_0100,Y ; save exponent sign to output string TXA ; get exponent count back LDX #$2F ; one less than "0" character SEC ; set carry for subtract LAB_DCA8 INX ; increment 10's character SBC #$0A ;.subtract 10 from exponent count BCS LAB_DCA8 ; loop while still >= 0 ADC #$3A ; add character ":" ($30+$0A, result is 10 less that value) STA LAB_0103,Y ; save to output string TXA ; copy 10's character STA LAB_0102,Y ; save to output string LDA #$00 ; set null terminator STA LAB_0104,Y ; save to output string BEQ LAB_DCC5 ; go set string pointer (AY) and exit (branch always) ; save last character, [EOT] and exit LAB_DCBD STA LAB_00FF,Y ; save last character to output string ; set null terminator and exit LAB_DCC0 LDA #$00 ; set null terminator STA LAB_0100,Y ; save after last character ; set string pointer (AY) and exit LAB_DCC5 LDA #$00 ; set result string low pointer LDY #$01 ; set result string high pointer RTS LAB_DCCA ; 0.5 LAB_DCCC = LAB_DCCA+2 ; $00,$00 for new variables .byte $80,$00,$00,$00,$00 ; constants for binary to decimal conversion LAB_DCCF LAB_DCD0 = LAB_DCCF+1 LAB_DCD1 = LAB_DCCF+2 LAB_DCD2 = LAB_DCCF+3 .byte $FA,$0A,$1F,$00 ; -100000000 .byte $00,$98,$96,$80 ; 10000000 .byte $FF,$F0,$BD,$C0 ; -1000000 .byte $00,$01,$86,$A0 ; 100000 .byte $FF,$FF,$D8,$F0 ; -10000 .byte $00,$00,$03,$E8 ; 1000 .byte $FF,$FF,$FF,$9C ; -100 .byte $00,$00,$00,$0A ; 10 .byte $FF,$FF,$FF,$FF ; -1 ; perform SQR LAB_DCF3 JSR LAB_D9C2 ; round and copy FAC1 to FAC2 LDA #LAB_DCCA ; set 0.5 pointer high addr JSR LAB_D958 ; unpack memory (AY) into FAC1 ; perform power function LAB_DCFD BEQ LAB_DD6F ; go do EXP() LAB_DCFF LDA LAB_00B9 ; get FAC2 exponent BNE LAB_DD06 ; branch if FAC2<>0 JMP LAB_D6AF ; clear FAC1 exponent and sign, and return LAB_DD06 LDX #LAB_009E ; set destination pointer high byte JSR LAB_D98A ; pack FAC1 into (XY) LDA LAB_00BE ; get FAC2 sign (b7) BPL LAB_DD20 ; branch if FAC2>0 JSR LAB_DA82 ; perform INT LDA #LAB_009E ; set source pointer high byte JSR LAB_DA11 ; compare FAC1 with (AY) BNE LAB_DD20 ; branch if FAC1 <> (AY) TYA ; copy sign to A LDY LAB_000D ;. LAB_DD20 JSR LAB_D9B4 ; save FAC1 sign and copy ABS(FAC2) to FAC1 TYA ;. PHA ;. JSR LAB_D7A0 ; do LOG(n) LDA #LAB_009E ; set pointer high byte JSR LAB_D7DE ; do convert AY, FCA1*(AY) (square the value) JSR LAB_DD6F ; go do EXP(n) PLA ;. LSR A ;. BCC LAB_DD40 ; if no bit then exit ; Perform negation ; do - FAC1 LAB_DD36 LDA LAB_00B1 ; get FAC1 exponent BEQ LAB_DD40 ; exit if FAC1_e = $00 LDA LAB_00B6 ; get FAC1 sign (b7) EOR #$FF ; complement it STA LAB_00B6 ; save FAC1 sign (b7) LAB_DD40 RTS LAB_DD41 .byte $81,$38,$AA,$3B,$29 ; 1.443 LAB_DD46 .byte $07 ; EXP() series count .byte $71,$34,$58,$3E,$56 ; 0.00002149876370 .byte $74,$16,$7E,$B3,$1B ; 0.00014352314037 .byte $77,$2F,$EE,$E3,$85 ; 0.00134226348246 .byte $7A,$1D,$84,$1C,$2A ; 0.00961401701352 .byte $7C,$63,$59,$58,$0A ; 0.05550512686023 .byte $7E,$75,$FD,$E7,$C6 ; 0.24022638460156 .byte $80,$31,$72,$18,$10 ; 0.69314718618989 .byte $81,$00,$00,$00,$00 ; 1.00000000000000 ; perform EXP LAB_DD6F LDA #LAB_DD41 ; set 1.443 pointer high byte JSR LAB_D7DE ; do convert AY, FCA1*(AY) LDA LAB_00C0 ; get FAC1 rounding byte ADC #$50 ; +$50/$100 BCC LAB_DD7F ; skip rounding if no carry JSR LAB_D9D9 ; round FAC1 (no check) LAB_DD7F STA LAB_00A6 ; save FAC2 rounding byte JSR LAB_D9C5 ; copy FAC1 to FAC2 LDA LAB_00B1 ; get FAC1 exponent CMP #$88 ; compare with EXP limit (256d) BCC LAB_DD8D ; branch if less LAB_DD8A JSR LAB_D88A ; handle overflow and underflow LAB_DD8D JSR LAB_DA82 ; perform INT LDA LAB_000D ;. CLC ; clear carry for add ADC #$81 ;. BEQ LAB_DD8A ;. SEC ;. SBC #$01 ;. PHA ;.save FAC2 exponent ; swap FAC1 and FAC2 LDX #$05 ; 5 bytes to do LAB_DD9D LDA LAB_00B9,X ; get FAC2,X LDY LAB_00B1,X ; get FAC1,X STA LAB_00B1,X ; save FAC1,X STY LAB_00B9,X ; save FAC2,X DEX ; decrement count/index BPL LAB_DD9D ; loop if not all done LDA LAB_00A6 ; get FAC2 rounding byte STA LAB_00C0 ; save as FAC1 rounding byte JSR LAB_D609 ; perform subtraction, FAC2 from FAC1 JSR LAB_DD36 ; do - FAC1 LDA #LAB_DD46 ; set counter pointer high byte JSR LAB_DDD8 ; go do series evaluation LDA #$00 ; clear A STA LAB_00BF ; clear sign compare (FAC1 EOR FAC2) PLA ; get saved FAC2 exponent JSR LAB_D86F ; test and adjust accumulators RTS ; ^2 then series evaluation LAB_DDC2 STA LAB_00C1 ; save count pointer low byte STY LAB_00C2 ; save count pointer high byte JSR LAB_D980 ; pack FAC1 into Adatal LDA #LAB_00A7 ; pointer to original # high byte JMP LAB_D7DE ; do convert AY, FCA1*(AY) and return ; series evaluation LAB_DDD8 STA LAB_00C1 ; save count pointer low byte STY LAB_00C2 ; save count pointer high byte LAB_DDDC JSR LAB_D97D ; pack FAC1 into numexp LDA (LAB_00C1),Y ; get constants count STA LAB_00B7 ; save constants count LDY LAB_00C1 ; get count pointer low byte INY ; increment it (now constants pointer) TYA ; copy it BNE LAB_DDEB ; skip next if no overflow INC LAB_00C2 ; else increment high byte LAB_DDEB STA LAB_00C1 ; save low byte LDY LAB_00C2 ; get high byte LAB_DDEF JSR LAB_D7DE ; do convert AY, FCA1*(AY) LDA LAB_00C1 ; get constants pointer low byte LDY LAB_00C2 ; get constants pointer high byte CLC ; clear carry for add ADC #$05 ; +5 to low pointer (5 bytes per constant) BCC LAB_DDFC ; skip next if no overflow INY ; increment high byte LAB_DDFC STA LAB_00C1 ; save pointer low byte STY LAB_00C2 ; save pointer high byte JSR LAB_D61D ; add (AY) to FAC1 LDA #LAB_00AC ; set pointer high byte to partial @ numexp DEC LAB_00B7 ; decrement constants count BNE LAB_DDEF ; loop until all done LAB_DE0B RTS LAB_DE0C .byte $98,$35,$44,$7A ; value for RND() multiplier LAB_DE10 .byte $68,$28,$B1,$46 ; value for RND() offset ; perform RND LAB_DE14 JSR LAB_D9E1 ; return A=FF,C=1/-ve A=01,C=0/+ve TAX ; copy result BMI LAB_DE32 ; branch if -ve LDA #LAB_00E4 ; pointer to seed high byte JSR LAB_D958 ; unpack memory (AY) into FAC1 TXA ; get sign flag back BEQ LAB_DE0B ; branch of was zero LDA #LAB_DE0C ; pointer to multiplier high byte JSR LAB_D7DE ; do convert AY, FCA1*(AY) LDA #LAB_DE10 ; pointer to offset high byte JSR LAB_D61D ; add (AY) to FAC1 LAB_DE32 LDX LAB_00B5 ; get FAC1 mantissa LDA LAB_00B2 ; get FAC1 mantissa STA LAB_00B5 ; save FAC1 mantissa STX LAB_00B2 ; save FAC1 mantissa LDA #$00 ; clear A STA LAB_00B6 ; clear sign LDA LAB_00B1 ; get FAC1 exponent STA LAB_00C0 ; save FAC1 rounding byte LDA #$80 ; set exponent for <1 STA LAB_00B1 ; save FAC1 exponent JSR LAB_D68D ; normalise FAC1 LDA #LAB_00E4 ; pointer to seed high byte JMP LAB_D98A ; pack FAC1 into (XY) and RET ; character get subroutine for zero page ; page 0 initialisation table from $CC ; increment and scan memory LAB_DE50 INC LAB_00D3 ; increment BASIC execute pointer low byte BNE LAB_DE56 ; branch if no carry INC LAB_00D4 ; else increment BASIC execute pointer high byte ; page 0 initialisation table from $D2 ; scan memory LAB_DE56 LDA $EA60 ; get byte to scan (addr set by call routine) CMP #$3A ; compare with ":" BCS LAB_DE67 ; exit if>= (not numeric, carry set) CMP #$20 ; compare with " " BEQ LAB_DE50 ; if " " go do next SEC ; set carry for SBC SBC #$30 ; subtract "0" SEC ; set carry for SBC SBC #$D0 ; subtract -"0" ; clear carry if byte = "0"-"9" LAB_DE67 RTS ; page 0 initialisation table from $E4 (RND seed) .byte $80,$4F,$C7,$52 ; LAB_DE6C CLI ; cold start entry LAB_DE6D JSR LAB_8B86 ;. LDX #$FF ; set value for stack STX LAB_008A ; set current line number high byte (immediate mode) TXS ; set stack LDA #LAB_DE6D ; cold start high byte STA LAB_0001 ; save as warm start low byte STY LAB_0002 ; save as warm start high byte STA LAB_0004 ; save as print string vector low byte STY LAB_0005 ; save as print string vector high byte LDA #LAB_CF79 ; evaluate integer expression high byte STA LAB_0006 ; save float to fixed vector low byte STY LAB_0007 ; save float to fixed vector high byte LDA #LAB_D14C ; fixed to float subroutine high byte STA LAB_0008 ; save fixed to float vector low byte STY LAB_0009 ; save fixed to float vector high byte LDA #$4C ; JMP opcode STA LAB_0000 ; save JMP for warm start vector STA LAB_0003 ; save JMP for print string vector STA LAB_00A4 ; save JMP for functions vector STA LAB_00C3 ; save JMP for SIN/COS/TAN/ATN vector STA LAB_00C9 ; save JMP for LOAD vector STA LAB_00C6 ; save JMP for SAVE vector STA LAB_000A ; save JMP for USR jmp vector LDA #LAB_D002 ; FC error routine high byte STA LAB_000B ; save as USR jmp vector low byte STY LAB_000C ; save as USR jmp vector high byte STA LAB_00C4 ; save as SIN/COS/TAN/ATN vector low byte STY LAB_00C5 ; save as SIN/COS/TAN/ATN vector high byte LDA #LAB_8E87 ; get SAVE routine high byte STA LAB_00C7 ; save as SAVE vector low byte STY LAB_00C8 ; save as SAVE vector high byte LDA #LAB_8C78 ; get LOAD routine high byte STA LAB_00CA ; save as LOAD vector low byte STY LAB_00CB ; save as LOAD vector high byte LDA #$48 ; width = 72 STA LAB_001A ; set width LDA #$38 ; ICL = 56 STA LAB_001B ; set input column limit LDX #$1C ; set byte count/index LAB_DEC7 LDA LAB_DE50-1,X ; get byte STA LAB_00CC-1,X ; save as page 0 routine DEX ; decrement count BNE LAB_DEC7 ; loop if not done LDA #$03 ; set size STA LAB_00A3 ; save step size for garbage collect TXA ; clear A STA LAB_00B8 ; clear FAC1 overflow byte STA LAB_0068 ;.clear discriptor stack byte STA LAB_0018 ; clear NULL count PHA ;. STA LAB_0017 ; clear input flag (allow output) JSR LAB_C8FE ; print CR/LF LDX #$69 ; pointer to descriptor stack STX LAB_0066 ; set descriptor stack pointer LDA #LAB_DFA8 ; pointer to "MEMORY SIZE" high byte JSR LAB_C954 ; print null terminated string from (AY) JSR LAB_C9DC ; print "?" and get BASIC input STX LAB_00D3 ; set execute pointer low byte to buffer STY LAB_00D4 ; set execute pointer high byte to buffer JSR LAB_00CC ; increment and scan memory TAY ; copy byte to Y BNE LAB_DF1D ; branch if user entered something ; no user input so get size the hard way LDA #LAB_0200 ; set pointer high byte to mem start high byte STA LAB_007B ; set start of mem low byte to mem start STY LAB_007C ; set start of mem high byte to mem start STA LAB_001C ; temp integer low byte STY LAB_001D ; temp integer high byte LDY #$00 ; clear index LAB_DF06 INC LAB_001C ; increment temp integer low byte BNE LAB_DF0C ; branch if no rollover INC LAB_001D ; increment temp integer high byte LAB_DF0C LDA #$55 ; set test byte STA (LAB_001C),Y ; save to memory CMP (LAB_001C),Y ; compare with memory BNE LAB_DF29 ; branch if <> (failed) ASL ; make $AA STA (LAB_001C),Y ; save to memory CMP (LAB_001C),Y ; compare with memory BNE LAB_DF29 ; brabch if <> (failed) BEQ LAB_DF06 ; loop (branch always) ; user entered mem size LAB_DF1D JSR LAB_00D2 ; scan memory JSR LAB_C7F5 ; get temp integer from string TAY ; copy last character BEQ LAB_DF29 ; branch if null (was string end) JMP LAB_CCB6 ; do syntax error, then warm start ; temp integer now holds mem top LAB_DF29 LDA LAB_001C ; get temp integer low byte LDY LAB_001D ; get temp integer high byte STA LAB_0087 ; save top of mem low byte STY LAB_0088 ; save top of mem high byte LAB_DF31 LDA #LAB_DFB4 ; pointer to "WIDTH" high byte JSR LAB_C954 ; print null terminated string from (AY) JSR LAB_C9DC ; print "?" and get BASIC input STX LAB_00D3 ; set execute pointer low byte to buffer STY LAB_00D4 ; set execute pointer high byte to buffer JSR LAB_00CC ; increment and scan memory TAY ; copy byte BEQ LAB_DF61 ; branch if no user input JSR LAB_C7F5 ; get fixed-point number into temp integer LDA LAB_001D ; get temp integer high byte BNE LAB_DF31 ; go again if integer >255 LDA LAB_001C ; temp integer low byte CMP #$10 ; compare with 16d BCC LAB_DF31 ; go again if < 16 STA LAB_001A ; save as width LAB_DF54 SBC #$0E ; subtract TAB size BCS LAB_DF54 ; loop if no underflow EOR #$FF ; do - result SBC #$0C ; - $0B CLC ; clear carry for add ADC LAB_001A ; add width STA LAB_001B ; save input column limit LAB_DF61 LDA #LAB_0200 ; set pointer high byte to mem start high byte STA LAB_007B ; set start of mem low byte to mem start STY LAB_007C ; set start of mem high byte to mem start LDY #$00 ; clear Y TYA ; clear A STA (LAB_007B),Y ; clear BASIC mem first byte INC LAB_007B ; increment start of mem low byte BNE LAB_DF74 ; branch if no rollover INC LAB_007C ; increment start of mem high byte LAB_DF74 JSR LAB_C458 ; do NEW LDA LAB_007B ; get start of mem low byte LDY LAB_007C ; get start of mem high byte JSR LAB_C229 ; check available memory, "OM" error if no room ; addr to check is in AY (low/high) JSR LAB_C8FE ; print CR/LF LDA LAB_0087 ; get top of mem low byte SEC ; set carry for subtract SBC LAB_007B ; subtract start of mem low byte TAX ; copy result LDA LAB_0088 ; get top of mem high byte SBC LAB_007C ; subtract start of high low byte JSR LAB_DB8A ; print XA as unsigned integer LDA #LAB_DFBA ; pointer to signon message high byte JSR LAB_C954 ; print null terminated string from (AY) LDA #LAB_C954 ; print string address high byte STA LAB_0004 ; save print string vector low byte STY LAB_0005 ; save print string vector high byte LDA #LAB_C27E ; warm start address high byte STA LAB_0001 ; save warm start vector low byte STY LAB_0002 ; save warm start vector high byte JMP (LAB_0001) ; do warm start LAB_DFA8 .byte "MEMORY SIZE",$00 LAB_DFB4 .byte "WIDTH",$00 LAB_DFBA .byte " BYTES FREE",$0D,$0A .byte $0D,$0A .byte "BASIC V1.1",$0D,$0A .byte "COPYRIGHT 1978 SYNERTEK SYSTEMS CORP.",$0D,$0A,$00 .byte $00,$00,$00