; Enhanced BASIC to assemble under Tass, $ver 1.05 ; zero page use ... LAB_WARM = $00 ; BASIC warm start entry point Wrmjpl = LAB_WARM+1; BASIC warm start vector jump low byte Wrmjph = LAB_WARM+2; BASIC warm start vector jump high byte Usrjmp = $DE ; USR function JMP address Usrjpl = Usrjmp+1 ; USR function JMP vector low byte Usrjph = Usrjmp+2 ; USR function JMP vector high byte Nullct = $0D ; nulls output after each line TPos = $0E ; BASIC terminal position byte TWidth = $E1 ; BASIC terminal width byte Iclim = $E2 ; input column limit Itempl = $E3 ; temporary integer low byte (for GOTO etc) Itemph = Itempl+1 ; temporary integer high byte (for GOTO etc) nums_1 = Itempl ; number to bin/hex string convert MSB nums_2 = nums_1+1 ; number to bin/hex string convert nums_3 = nums_1+2 ; number to bin/hex string convert LSB ; Ibuffs can now be anywhere in RAM just make sure the byte before it is <> $00 ; also ensure that the max length is <$80 Ibuffs = $0401 ; start of input buffer Ibuffe = Ibuffs+$47; end of input buffer Srchc = $5B ; search character Temp3 = Srchc ; temp byte used in number routines Scnquo = $5C ; scan-between-quotes flag Asrch = Scnquo ; alt search character XOAw_l = Srchc ; eXclusive OR, OR and AND word low byte XOAw_h = Scnquo ; eXclusive OR, OR and AND word high byte Ibptr = $5D ; input buffer pointer Dimcnt = Ibptr ; # of dimensions Tindx = Ibptr ; token index Defdim = $5E ; default DIM flag Dtypef = $5F ; data type flag, $FF=string, $00=numeric Oquote = $60 ; open quote flag (b7) (Flag: DATA scan; LIST quote; memory) Gclctd = $60 ; garbage collected flag Sufnxf = $61 ; subscript/FNX flag, 1xxx xxx = FN(0xxx xxx) Imode = $62 ; input mode flag, $00=INPUT, $98=READ Cflag = $63 ; comparison evaluation flag TabSiz = $64 ; TAB step size (was input flag) next_s = $65 ; next descriptor stack address ; these two bytes form a word pointer to the item ; currently on top of the descriptor stack last_sl = $66 ; last descriptor stack address low byte last_sh = $67 ; last descriptor stack address high byte (always $00) des_sk = $68 ; descriptor stack start address (temp strings) ; = $70 ; End of descriptor stack ut1_pl = $71 ; utility pointer 1 low byte ut1_ph = ut1_pl+1 ; utility pointer 1 high byte ut2_pl = $73 ; utility pointer 2 low byte ut2_ph = ut2_pl+1 ; utility pointer 2 high byte Temp_2 = ut1_pl ; temp byte for block move FACt_1 = $75 ; FAC temp mantissa1 FACt_2 = FACt_1+1 ; FAC temp mantissa2 FACt_3 = FACt_2+1 ; FAC temp mantissa3 dims_l = FACt_2 ; array dimension size low byte dims_h = FACt_3 ; array dimension size high byte TempB = $78 ; temp page 0 byte Smeml = $79 ; start of mem low byte (Start-of-Basic) Smemh = Smeml+1 ; start of mem high byte (Start-of-Basic) Svarl = $7B ; start of vars low byte (Start-of-Variables) Svarh = Svarl+1 ; start of vars high byte (Start-of-Variables) Sarryl = $7D ; var mem end low byte (Start-of-Arrays) Sarryh = Sarryl+1 ; var mem end high byte (Start-of-Arrays) Earryl = $7F ; array mem end low byte (End-of-Arrays) Earryh = Earryl+1 ; array mem end high byte (End-of-Arrays) Sstorl = $81 ; string storage low byte (String storage (moving down)) Sstorh = Sstorl+1 ; string storage high byte (String storage (moving down)) Sutill = $83 ; string utility ptr low byte Sutilh = Sutill+1 ; string utility ptr high byte Ememl = $85 ; end of mem low byte (Limit-of-memory) Ememh = Ememl+1 ; end of mem high byte (Limit-of-memory) Clinel = $87 ; current line low byte (Basic line number) Clineh = Clinel+1 ; current line high byte (Basic line number) Blinel = $89 ; break line low byte (Previous Basic line number) Blineh = Blinel+1 ; break line high byte (Previous Basic line number) Cpntrl = $8B ; continue pointer low byte Cpntrh = Cpntrl+1 ; continue pointer high byte Dlinel = $8D ; current DATA line low byte Dlineh = Dlinel+1 ; current DATA line high byte Dptrl = $8F ; DATA pointer low byte Dptrh = Dptrl+1 ; DATA pointer high byte Rdptrl = $91 ; read pointer low byte Rdptrh = Rdptrl+1 ; read pointer high byte Varnm1 = $93 ; current var name 1st byte Varnm2 = Varnm1+1 ; current var name 2nd byte Cvaral = $95 ; current var address low byte Cvarah = Cvaral+1 ; current var address high byte Frnxtl = $97 ; var pointer for FOR/NEXT low byte Frnxth = Frnxtl+1 ; var pointer for FOR/NEXT high byte Tidx1 = Frnxtl ; temp line index Lvarpl = Frnxtl ; let var pointer low byte Lvarph = Frnxth ; let var pointer high byte prstk = $99 ; precedence stacked flag comp_f = $9B ; compare function flag, bits 0,1 and 2 used ; bit 2 set if > ; bit 1 set if = ; bit 0 set if < func_l = $9C ; function pointer low byte func_h = func_l+1 ; function pointer high byte garb_l = func_l ; garbage collection working pointer low byte garb_h = func_h ; garbage collection working pointer high byte des_2l = $9E ; string descriptor_2 pointer low byte des_2h = des_2l+1 ; string descriptor_2 pointer high byte g_step = $A0 ; garbage collect step size Fnxjmp = $A1 ; jump vector for functions Fnxjpl = Fnxjmp+1 ; functions jump vector low byte Fnxjph = Fnxjmp+2 ; functions jump vector high byte g_indx = Fnxjpl ; garbage collect temp index FAC2_r = $A3 ; FAC2 rounding byte Adatal = $A4 ; array data pointer low byte Adatah = Adatal+1 ; array data pointer high byte Nbendl = Adatal ; new block end pointer low byte Nbendh = Adatah ; new block end pointer high byte Obendl = $A6 ; old block end pointer low byte Obendh = Obendl+1 ; old block end pointer high byte numexp = $A8 ; string to float number exponent count expcnt = $A9 ; string to float exponent count numbit = numexp ; bit count for array element calculations numdpf = $AA ; string to float decimal point flag expneg = $AB ; string to float eval exponent -ve flag Astrtl = numdpf ; array start pointer low byte Astrth = expneg ; array start pointer high byte Histrl = numdpf ; highest string low byte Histrh = expneg ; highest string high byte Baslnl = numdpf ; BASIC search line pointer low byte Baslnh = expneg ; BASIC search line pointer high byte Fvar_l = numdpf ; find/found variable pointer low byte Fvar_h = expneg ; find/found variable pointer high byte Ostrtl = numdpf ; old block start pointer low byte Ostrth = expneg ; old block start pointer high byte Vrschl = numdpf ; variable search pointer low byte Vrschh = expneg ; variable search pointer high byte FAC1_e = $AC ; FAC1 exponent FAC1_1 = FAC1_e+1 ; FAC1 mantissa1 FAC1_2 = FAC1_e+2 ; FAC1 mantissa2 FAC1_3 = FAC1_e+3 ; FAC1 mantissa3 FAC1_s = FAC1_e+4 ; FAC1 sign (b7) str_ln = FAC1_e ; string length str_pl = FAC1_1 ; string pointer low byte str_ph = FAC1_2 ; string pointer high byte des_pl = FAC1_2 ; string descriptor pointer low byte des_ph = FAC1_3 ; string descriptor pointer high byte mids_l = FAC1_3 ; MID$ string temp length byte negnum = $B1 ; string to float eval -ve flag numcon = $B1 ; series evaluation constant count FAC1_o = $B2 ; FAC1 overflow byte FAC2_e = $B3 ; FAC2 exponent FAC2_1 = FAC2_e+1 ; FAC2 mantissa1 FAC2_2 = FAC2_e+2 ; FAC2 mantissa2 FAC2_3 = FAC2_e+3 ; FAC2 mantissa3 FAC2_s = FAC2_e+4 ; FAC2 sign (b7) FAC_sc = $B8 ; FAC sign comparison, Acc#1 vs #2 FAC1_r = $B9 ; FAC1 rounding byte ssptr_l = FAC_sc ; string start pointer low byte ssptr_h = FAC1_r ; string start pointer high byte sdescr = FAC_sc ; string descriptor pointer csidx = $BA ; line crunch save index Asptl = csidx ; array size/pointer low byte Aspth = $BB ; array size/pointer high byte Btmpl = Asptl ; BASIC pointer temp low byte Btmph = Aspth ; BASIC pointer temp low byte Cptrl = Asptl ; BASIC pointer temp low byte Cptrh = Aspth ; BASIC pointer temp low byte Sendl = Asptl ; BASIC pointer temp low byte Sendh = Aspth ; BASIC pointer temp low byte LAB_IGBY = $BC ; get next BASIC byte subroutine LAB_GBYT = $C2 ; get current BASIC byte subroutine Bpntrl = $C3 ; BASIC execute (get byte) pointer low byte Bpntrh = Bpntrl+1 ; BASIC execute (get byte) pointer high byte ; = $D3 ; end of get BASIC char subroutine Rbyte4 = $D4 ; extra PRNG byte Rbyte1 = Rbyte4+1 ; most significant PRNG byte Rbyte2 = Rbyte4+2 ; middle PRNG byte Rbyte3 = Rbyte4+3 ; least significant PRNG byte NmiBase = $D8 ; NMI handler enabled/setup/triggered flags ; bit function ; === ======== ; 7 interrupt enabled ; 6 interrupt setup ; 5 interrupt happened ; = $D9 ; NMI handler addr low byte ; = $DA ; NMI handler addr high byte IrqBase = $DB ; IRQ handler enabled/setup/triggered flags ; = $DC ; IRQ handler addr low byte ; = $DD ; IRQ handler addr high byte ; = $DE ; unused ; = $DF ; unused ; = $E0 ; unused ; = $E1 ; unused ; = $E2 ; unused ; = $E3 ; unused ; = $E4 ; unused ; = $E5 ; unused ; = $E6 ; unused ; = $E7 ; unused ; = $E8 ; unused ; = $E9 ; unused ; = $EA ; unused ; = $EB ; unused ; = $EC ; unused ; = $ED ; unused ; = $EE ; unused Decss = $EF ; number to decimal string start ; = $FF ; decimal string end ; token values needed for BASIC TK_FOR = $81 ; FOR token TK_DATA = $83 ; DATA token TK_GOTO = $89 ; GOTO token TK_GOSUB = $8D ; GOSUB token TK_REM = $91 ; REM token TK_ON = $93 ; ON token TK_DO = $9D ; DO token TK_PRINT = $9F ; PRINT token TK_CLEAR = $A2 ; CLEAR token TK_IRQ = $A9 ; IRQ token TK_NMI = $AA ; NMI token TK_TAB = $AB ; TAB token TK_TO = $AC ; TO token TK_FN = $AD ; FN token TK_SPC = $AE ; SPC token TK_THEN = $AF ; THEN token TK_NOT = $B0 ; NOT token TK_STEP = $B1 ; STEP token TK_UNTIL = $B2 ; UNTIL token TK_OFF = $B4 ; OFF token TK_PLUS = $B5 ; + token TK_MINUS = $B6 ; - token TK_GT = $BF ; > token TK_EQUAL = $C0 ; = token TK_LT = $C1 ; < token TK_SGN = $C2 ; SGN token TK_CHRS = $D9 ; CHR$ token TK_BINS = $DB ; BIN$ token TK_VPTR = $E1 ; VARPTR token ; offsets from a base of X or Y PLUS_0 = $00 ; X or Y plus 0 PLUS_1 = $01 ; X or Y plus 1 PLUS_2 = $02 ; X or Y plus 2 PLUS_3 = $03 ; X or Y plus 3 LAB_STAK = $0100 ; stack bottom, no offset LAB_01FE = $01FE ; flushed stack address LAB_01FF = $01FF ; flushed stack address ccflag = $0600 ; BASIC CTRL-C flag, 00 = enabled, 01 = dis ccbyte = ccflag+1 ; BASIC CTRL-C byte ccnull = ccbyte+1 ; BASIC CTRL-C byte timeout VEC_CC = ccnull+1 ; ctrl c check vector VEC_IN = VEC_CC+2 ; input vector VEC_OUT = VEC_IN+2 ; output vector VEC_LD = VEC_OUT+2 ; load vector VEC_SV = VEC_LD+2 ; save vector CR_CHAR = $9B LF_CHAR = $9B Ram_base = $2000 ; start of user RAM (set as needed, should be page aligned) Ram_top = $6000 ; end of user RAM+1 (set as needed, should be page aligned)) *= $7800 ; BASIC cold start entry point LAB_COLD ; new page 2 initialisation, copy block to ccflag on LDY #PG2_TABE-PG2_TABS-1 ; byte count-1 LAB_2D13 LDA PG2_TABS,Y ; get byte STA ccflag,Y ; store in page 2 DEY ; decrement count BPL LAB_2D13 ; loop if not done LDX #$FF ; set byte STX Clineh ; set current line high byte (set immediate mode) TXS ; reset stack pointer LDA #$4C ; code for JMP STA Fnxjmp ; save for jump vector for functions ; copy block from LAB_2CEE to $00BC - $00D3 LDX #StrTab-LAB_2CEE ; set byte count LAB_2D4E LDA LAB_2CEE-1,X ; get byte from table STA LAB_IGBY-1,X ; save byte in page zero DEX ; decrement count BNE LAB_2D4E ; loop if not all done ; copy block from StrTab to $0000 - $0012 LAB_GMEM LDX #EndTab-StrTab-1 ; set byte count-1 TabLoop LDA StrTab,X ; get byte from table STA PLUS_0,X ; save byte in page zero DEX ; decrement count BPL TabLoop ; loop if not all done ; set-up start values LDA #$00 ; clear A STA NmiBase ; clear NMI handler enabled flag STA IrqBase ; clear IRQ handler enabled flag STA FAC1_o ; clear FAC1 overflow byte STA last_sh ; clear descriptor stack top item pointer high byte LDA #$0E ; set default tab size STA TabSiz ; save it LDA #$03 ; set garbage collect step size for descriptor stack STA g_step ; save it LDX #des_sk ; descriptor stack start STX next_s ; set descriptor stack pointer JSR LAB_CRLF ; print CR/LF LDA #LAB_MSZM ; point to memory size message (high addr) JSR LAB_18C3 ; print null terminated string from memory JSR LAB_INLN ; print "? " and get BASIC input STX Bpntrl ; set BASIC execute pointer low byte STY Bpntrh ; set BASIC execute pointer high byte ; ; JSR LAB_IGBY ; increment & scan memory .BYTE $20, LAB_IGBY, $00 BNE LAB_2DAA ; branch if not null (user typed something) LDY #$00 ; else clear Y ; character was null so get memory size the hard way ; we get here with Y=0 and Itempl/h = Ram_base LAB_2D93 INC Itempl ; increment temporary integer low byte BNE LAB_2D99 ; branch if no overflow INC Itemph ; increment temporary integer high byte LDA Itemph ; get high byte CMP #>Ram_top ; compare with top of RAM+1 BEQ LAB_2DB6 ; branch if match (end of user RAM) LAB_2D99 LDA #$55 ; set test byte STA (Itempl),Y ; save via temporary integer CMP (Itempl),Y ; compare via temporary integer BNE LAB_2DB6 ; branch if fail ASL A ; shift test byte left (now $AA) STA (Itempl),Y ; save via temporary integer CMP (Itempl),Y ; compare via temporary integer BEQ LAB_2D93 ; if ok go do next byte BNE LAB_2DB6 ; branch if fail LAB_2DAA JSR LAB_2887 ; get FAC1 from string LDA FAC1_e ; get FAC1 exponent CMP #$98 ; compare with exponent = 2^24 BCS LAB_GMEM ; if too large go try again JSR LAB_F2FU ; save integer part of FAC1 in temporary integer ; (no range check) LAB_2DB6 LDA Itempl ; get temporary integer low byte LDY Itemph ; get temporary integer high byte CPY #(>Ram_base)+1 ; compare with start of RAM+$100 high byte BCC LAB_GMEM ; if too small go try again ; uncomment these lines if you want to check on the high limit of memory. Note if ; Ram_top is set too low then this will fail. default is ignore it and assume the ; users know what they're doing! ; CPY #>Ram_top ; compare with top of RAM high byte ; BCC MEM_OK ; branch if < RAM top ; BNE LAB_GMEM ; if too large go try again ; else was = so compare low bytes ; CMP #Ram_base ; set start addr high byte STY Smeml ; save start of mem low byte STX Smemh ; save start of mem high byte ; this line is only needed if Ram_base is not $xx00 ; LDY #$00 ; clear Y TYA ; clear A STA (Smeml),Y ; clear first byte INC Smeml ; increment start of mem low byte ; these two lines are only needed if Ram_base is $xxFF ; BNE LAB_2E05 ; branch if no rollover ; INC Smemh ; increment start of mem high byte LAB_2E05 JSR LAB_CRLF ; print CR/LF JSR LAB_1463 ; do "NEW" and "CLEAR" LDA Ememl ; get end of mem low byte SEC ; set carry for subtract SBC Smeml ; subtract start of mem low byte TAX ; copy to X LDA Ememh ; get end of mem high byte SBC Smemh ; subtract start of mem high byte JSR LAB_295E ; print XA as unsigned integer (bytes free) LDA #LAB_SMSG ; point to sign-on message (high addr) JSR LAB_18C3 ; print null terminated string from memory LDA #LAB_1274 ; warm start vector high byte STA Wrmjpl ; save warm start vector low byte STY Wrmjph ; save warm start vector high byte JMP (Wrmjpl) ; go do warm start ; search the stack for FOR, GOSUB or DO activity ; exit with z=1 if FOR else exit with z=0 LAB_11A1 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_11A6 LDA LAB_STAK+1,X ; get token byte from stack CMP #TK_FOR ; is it FOR token BNE LAB_11CE ; exit if not FOR token ; was FOR token LDA Frnxth ; get var pointer for FOR/NEXT high byte BNE LAB_11BB ; branch if not null LDA LAB_STAK+2,X ; get FOR variable pointer low byte STA Frnxtl ; save var pointer for FOR/NEXT low byte LDA LAB_STAK+3,X ; get FOR variable pointer high byte STA Frnxth ; save var pointer for FOR/NEXT high byte LAB_11BB CMP LAB_STAK+3,X ; compare var pointer with stacked var pointer (high byte) BNE LAB_11C7 ; branch if no match LDA Frnxtl ; get var pointer for FOR/NEXT low byte CMP LAB_STAK+2,X ; compare var pointer with stacked var pointer (low byte) BEQ LAB_11CE ; exit if match found LAB_11C7 TXA ; copy index CLC ; clear carry for add ADC #$10 ; add FOR stack use size TAX ; copy back to index BNE LAB_11A6 ; loop if not at start of stack LAB_11CE RTS ; ; open up space in memory ; move (Ostrtl)-(Obendl) to new block ending at (Nbendl) ; Nbendl,Nbendh - new block end address (A/Y) ; Obendl,Obendh - old block end address ; Ostrtl,Ostrth - old block start address ; returns with ... ; Nbendl,Nbendh - new block start address (high byte - $100) ; Obendl,Obendh - old block start address (high byte - $100) ; Ostrtl,Ostrth - old block start address (unchanged) LAB_11CF JSR LAB_121F ; check available memory, "Out of memory" error if no room ; addr to check is in AY (low/high) STA Earryl ; save new array mem end low byte STY Earryh ; save new array mem end high byte ; open up space in memory ; move (Ostrtl)-(Obendl) to new block ending at (Nbendl) ; don't set array end LAB_11D6 SEC ; set carry for subtract LDA Obendl ; get block end low byte SBC Ostrtl ; subtract block start low byte STA Temp_2 ; save MOD(block length/$100) byte TAY ; copy MOD(block length/$100) byte to Y LDA Obendh ; get block end high byte SBC Ostrth ; 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_120A ; branch if length low byte=0 ; block is (X-1)*256+Y bytes, do the Y bytes first LDA Obendl ; get block end low byte SEC ; set carry for subtract SBC Temp_2 ; subtract MOD(block length/$100) byte STA Obendl ; save corrected old block end low byte BCS LAB_11F3 ; branch if no underflow DEC Obendh ; else decrement block end high byte SEC ; set carry for subtract LAB_11F3 LDA Nbendl ; get destination end low byte SBC Temp_2 ; subtract MOD(block length/$100) byte STA Nbendl ; save modified new block end low byte BCS LAB_1203 ; branch if no underflow DEC Nbendh ; else decrement block end high byte BCC LAB_1203 ; branch always LAB_11FF LDA (Obendl),Y ; get byte from source STA (Nbendl),Y ; copy byte to destination LAB_1203 DEY ; decrement index BNE LAB_11FF ; loop until Y=0 ; now do Y=0 indexed byte LDA (Obendl),Y ; get byte from source STA (Nbendl),Y ; save byte to destination LAB_120A DEC Obendh ; decrement source pointer high byte DEC Nbendh ; decrement destination pointer high byte DEX ; decrement block count BNE LAB_1203 ; loop until count = $0 RTS ; ; check room on stack for A bytes ; stack too deep? do OM error LAB_1212 STA TempB ; save result in temp byte TSX ; copy stack CPX TempB ; compare new "limit" with stack BCC LAB_OMER ; if stack < limit do "Out of memory" error, then warm start RTS ; ; check available memory, "Out of memory" error if no room ; addr to check is in AY (low/high) LAB_121F CPY Sstorh ; compare bottom of string mem high byte BCC LAB_124B ; if less then exit (is ok) BNE LAB_1229 ; skip next test if greater (tested <) ; high byte was =, now do low byte CMP Sstorl ; compare with bottom of string mem low byte BCC LAB_124B ; if less then exit (is ok) ; addr is > string storage ptr (oops!) LAB_1229 PHA ; push addr low byte LDX #$08 ; set index to save Adatal to expneg inclusive TYA ; copy addr high byte (to push on stack) ; save misc numeric work area LAB_122D PHA ; push byte LDA Adatal-1,X ; get byte from Adatal to expneg ( ,$00 not pushed) DEX ; decrement index BPL LAB_122D ; loop until all done JSR LAB_GARB ; garbage collection routine ; restore misc numeric work area LDX #$F8 ; set index to restore bytes LAB_1238 PLA ; pop byte STA expneg+1,X ; save byte to Adatal to expneg ( ,$00 not pulled) INX ; increment index BMI LAB_1238 ; loop while -ve PLA ; pop addr high byte TAY ; copy back to Y PLA ; pop addr low byte CPY Sstorh ; compare bottom of string mem high byte BCC LAB_124B ; if less then exit (is ok) BNE LAB_OMER ; if greater do "Out of memory" error, then warm start ; high byte was =, now do low byte CMP Sstorl ; compare with bottom of string mem low byte BCS LAB_OMER ; if >= do "Out of memory" error, then warm start ; ok exit, carry clear LAB_124B RTS ; ; do "Out of memory" error, then warm start LAB_OMER LDX #$0C ; error code $0C ("Out of memory" error) ; do error #X, then warm start LAB_XERR JSR LAB_CRLF ; print CR/LF LDA LAB_BAER,X ; get error message pointer low byte LDY LAB_BAER+1,X ; get error message pointer high byte JSR LAB_18C3 ; print null terminated string from memory JSR LAB_1491 ; flush stack & clear continue flag LDA #LAB_EMSG ; point to " Error" high addr LAB_1269 JSR LAB_18C3 ; print null terminated string from memory LDY Clineh ; get current line high byte INY ; increment it BEQ LAB_1274 ; go do warm start (was immediate mode) ; else print line number JSR LAB_2953 ; print " in line [LINE #]" ; BASIC warm start entry point ; wait for Basic command LAB_1274 ; clear ON IRQ/NMI bytes LDA #$00 ; clear A STA IrqBase ; clear enabled byte STA NmiBase ; clear enabled byte LDA #LAB_RMSG ; point to "Ready" message high byte JSR LAB_18C3 ; go do print string ; wait for Basic command (no "Ready") LAB_127D JSR LAB_1357 ; call for BASIC input LAB_1280 STX Bpntrl ; set BASIC execute pointer low byte STY Bpntrh ; set BASIC execute pointer high byte .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BEQ LAB_127D ; loop while null ; got to interpret input line now .... LDX #$FF ; current line to null value STX Clineh ; set current line high byte BCC LAB_1295 ; branch if numeric character (handle new BASIC line) ; no line number .. immediate mode JSR LAB_13A6 ; crunch keywords into Basic tokens JMP LAB_15F6 ; go scan & interpret code ; handle new BASIC line LAB_1295 JSR LAB_GFPN ; get fixed-point number into temp integer JSR LAB_13A6 ; crunch keywords into Basic tokens STY Ibptr ; save index pointer to end of crunched line JSR LAB_SSLN ; search BASIC for temp integer line number BCC LAB_12E6 ; branch if not found ; aroooogah! line # already exists! delete it LDY #$01 ; set index to next line pointer high byte LDA (Baslnl),Y ; get next line pointer high byte STA ut1_ph ; save it LDA Svarl ; get start of vars low byte STA ut1_pl ; save it LDA Baslnh ; get found line pointer high byte STA ut2_ph ; save it LDA Baslnl ; get found line pointer low byte DEY ; decrement index SBC (Baslnl),Y ; subtract next line pointer low byte CLC ; clear carry for add ADC Svarl ; add start of vars low byte STA Svarl ; save new start of vars low byte STA ut2_pl ; save destination pointer low byte LDA Svarh ; get start of vars high byte ADC #$FF ; -1 + carry STA Svarh ; save start of vars high byte SBC Baslnh ; subtract found line pointer high byte TAX ; copy to block count SEC ; set carry for subtract LDA Baslnl ; get found line pointer low byte SBC Svarl ; subtract start of vars low byte TAY ; copy to bytes in first block count BCS LAB_12D0 ; branch if overflow INX ; increment block count (correct for =0 loop exit) DEC ut2_ph ; decrement destination high byte LAB_12D0 CLC ; clear carry for add ADC ut1_pl ; add source pointer low byte BCC LAB_12D8 ; branch if no overflow DEC ut1_ph ; else decrement source pointer high byte CLC ; clear carry ; close up memory to delete old line LAB_12D8 LDA (ut1_pl),Y ; get byte from source STA (ut2_pl),Y ; copy to destination INY ; increment index BNE LAB_12D8 ; while <> 0 do this block INC ut1_ph ; increment source pointer high byte INC ut2_ph ; increment destination pointer high byte DEX ; decrement block count BNE LAB_12D8 ; loop until all done ; got new line in buffer and no existing same # LAB_12E6 LDA Ibuffs ; get byte from start if input buffer BEQ LAB_1319 ; if null line just go flush stack/vars & exit ; got new line and it isn't empty line LDA Ememl ; get end of mem low byte LDY Ememh ; get end of mem high byte STA Sstorl ; set bottom of string space low byte STY Sstorh ; set bottom of string space high byte LDA Svarl ; get start of vars low byte (end of BASIC) STA Obendl ; save old block end low byte LDY Svarh ; get start of vars high byte (end of BASIC) STY Obendh ; save old block end high byte ADC Ibptr ; add input buffer pointer (also buffer length) BCC LAB_1301 ; branch if no overflow from add INY ; else increment high byte LAB_1301 STA Nbendl ; save new block end low byte (move to, low byte) STY Nbendh ; save new block end high byte JSR LAB_11CF ; open up space in memory ; (old start pointer Ostrtl,Ostrth set by the find line call) LDA Earryl ; get array mem end low byte LDY Earryh ; get array mem end high byte STA Svarl ; save start of vars low byte STY Svarh ; save start of vars high byte LDY Ibptr ; get input buffer pointer (also buffer length) DEY ; adjust for loop type LAB_1311 LDA Ibuffs-4,Y ; get byte from crunched line STA (Baslnl),Y ; save it to program memory DEY ; decrement count CPY #$03 ; compare with first byte-1 BNE LAB_1311 ; continue while count <> 3 LDA Itemph ; get line # high byte STA (Baslnl),Y ; save it to program memory DEY ; decrement count LDA Itempl ; get line # low byte STA (Baslnl),Y ; save it to program memory DEY ; decrement count LDA #$FF ; set byte to allow chain rebuild. if you didn't set this ; byte then a zero already here would stop the chain rebuild ; as it would think it was the [EOT] marker. STA (Baslnl),Y ; save it to program memory LAB_1319 JSR LAB_1477 ; reset execution to start, clear vars & flush stack LDA Smeml ; get start of mem low byte LDY Smemh ; get start of mem high byte STA ut1_pl ; set line start pointer low byte STY ut1_ph ; set line start pointer high byte CLC ; clear carry for possible later add LAB_1325 LDY #$01 ; index to high byte of next line pointer LDA (ut1_pl),Y ; get it BNE LAB_132E ; there is a program (or not reached end yet) so we must ; go and fix the pointers ; else we just JMP LAB_127D ; wait for Basic command (no "Ready") ; rebuild chaining of Basic lines LAB_132E LDY #$04 ; point to first code byte of line ; there is always 1 byte + [EOL] as null entries are deleted LAB_1330 INY ; next code byte LDA (ut1_pl),Y ; get byte BNE LAB_1330 ; loop if not [EOL] INY ; point to byte past [EOL] (start of next line) TYA ; copy it ADC ut1_pl ; add to line start pointer low byte TAX ; copy to X LDY #$00 ; clear index (point to this line's next line pointer) STA (ut1_pl),Y ; set next line pointer low byte LDA ut1_ph ; get line start pointer high byte ADC #$00 ; add any overflow INY ; increment index to high byte STA (ut1_pl),Y ; set next line pointer low byte STX ut1_pl ; set line start pointer low byte STA ut1_ph ; set line start pointer high byte BCC LAB_1325 ; go do next line (carry always clear) ; print "? " and get BASIC input LAB_INLN JSR LAB_18E3 ; print "?" character JSR LAB_18E0 ; print " " BNE LAB_1357 ; call for BASIC input & return ; receive line from keyboard ; $08 as delete key (BACKSPACE on standard keyboard) LAB_134B JSR LAB_PRNA ; go print the character DEX ; decrement the buffer counter (delete) .byte $2C ; make LDX into BIT abs ; call for BASIC input (main entry point) LAB_1357 LDX #$00 ; clear BASIC line buffer pointer LAB_1359 JSR V_INPT ; call scan input device ; BCC LAB_1359 ; loop if no byte ; BEQ LAB_1359 ; loop until valid input (ignore NULLs) CMP #$07 ; compare with [BELL] BEQ LAB_1378 ; branch if [BELL] CMP #CR_CHAR ; compare with [CR] BEQ LAB_1384 ; do CR/LF exit if [CR] CPX #$00 ; compare pointer with $00 BNE LAB_1374 ; branch if not empty ; next two lines ignore any non print character & [SPACE] if input buffer empty CMP #$21 ; compare with [SP]+1 BCC LAB_1359 ; if < ignore character LAB_1374 CMP #$08 ; compare with [BACKSPACE] (delete last character) BEQ LAB_134B ; go delete last character LAB_1378 CPX #Ibuffe-Ibuffs ; compare character count with max BCS LAB_138E ; skip store & do [BELL] if buffer full STA Ibuffs,X ; else store in buffer INX ; increment pointer LAB_137F JSR LAB_PRNA ; go print the character BNE LAB_1359 ; always loop for next character LAB_1384 JMP LAB_1866 ; do CR/LF exit to BASIC ; announce buffer full LAB_138E LDA #$07 ; [BELL] character into A BNE LAB_137F ; go print the [BELL] but ignore input character ; branch always ; crunch keywords into Basic tokens ; extended table version .... ; position independent buffer version ; returns Bpntrl pointing to buffer-1 LAB_13A6 LDY #$FF ; set save index (makes for easy math later) SEC ; set carry for subtract LDA Bpntrl ; get basic execute pointer low byte SBC #4000 cycles/line) CMP $20 ; is it a space ? BEQ LAB_13EC ; if so save byte then continue crunching STA Scnquo ; save buffer byte as search character CMP #$22 ; is it quote character? BEQ LAB_1410 ; branch if so (copy quoted string) BIT Oquote ; get open quote/DATA token flag BVS LAB_13EC ; branch if b6 of Oquote set (was DATA) ; go save byte then continue crunching CMP #'? ; compare with "?" character (PRINT) BNE LAB_13C4 ; branch if not "?" LDA #TK_PRINT ; else keyword token is TK_PRINT BNE LAB_13EC ; always branch, save byte then continue crunching ; wasn't [SPACE], " or ? LAB_13C4 CMP #$30 ; compare with "0" BCC LAB_13CC ; branch if < (continue crunching) CMP #$3C ; compare with "<" BCC LAB_13EC ; branch if < (was 0123456789:;) ; go save byte then continue crunching ; gets here with next character not numeric or ; or : LAB_13CC STY csidx ; copy buffer save index LDY #LAB_KEYT ; get keyword table high address STY ut2_ph ; save pointer high byte LDY #$00 ; clear table pointer STY Tindx ; clear word index STX TempB ; save buffer read index BEQ LAB_13D8 ; jump into loop (branch always) LAB_13D6 INY ; next table byte BNE LAB_13D7 ; skip high byte INC if no rollover INC ut2_ph ; increment table pointer high byte LAB_13D7 INX ; next buffer byte LAB_13D8 LDA Ibuffs,X ; get byte from input buffer EOR (ut2_pl),Y ; Exclusive OR table byte (was SEC, SBC) BEQ LAB_13D6 ; go compare next if match CMP #$80 ; was it end marker match ? BNE LAB_1417 ; branch if not (not found keyword) ; else found keyword ORA Tindx ; OR with word index (+$80 in A makes token) LAB_13EA LDY csidx ; restore save index LAB_13EC INX ; increment buffer index INY ; increment save index STA Ibuffs,Y ; save byte to output ORA #$00 ; set the flags BEQ LAB_142A ; branch if was null [EOL] ; A holds token or byte here SEC ; set carry for subtract SBC #$3A ; subtract ":" BEQ LAB_13FF ; branch if it was ":" (is now $00) ; A now holds token-$3A CMP #(TK_DATA-$3A) ; compare with DATA token - $3A BNE LAB_1401 ; branch if not DATA ; token was : or DATA LAB_13FF STA Oquote ; save token-$3A (clear for ":", TK_DATA-$3A for DATA) LAB_1401 SEC ; set carry for subtract SBC #(TK_REM-$3A) ; subtract REM token offset BNE LAB_13AC ; If wasn't REM then go crunch rest of line STA Asrch ; else was REM so set search for [EOL] ; loop for REM, "..." etc. LAB_1408 LDA Ibuffs,X ; get byte from input buffer BEQ LAB_13EC ; branch if null [EOL] CMP Asrch ; compare with stored character BEQ LAB_13EC ; branch if match (end quote) ; entry for copy string in quotes, don't crunch LAB_1410 INY ; increment buffer save index STA Ibuffs,Y ; save byte to output INX ; increment buffer read index BNE LAB_1408 ; loop while <> 0 (should never be 0!) ; not found keyword this go LAB_1417 LDX TempB ; compare has failed, restore buffer index INC Tindx ; increment keyword index (next keyword) ; now find the end of this word in the table LAB_141B LDA (ut2_pl),Y ; get table byte PHP ; save status INY ; increment table index BNE LAB_141E ; skip inc if no overflow INC ut2_ph ; increment table pointer high byte LAB_141E PLP ; restore byte status BPL LAB_141B ; if not end of keyword go do next LDA (ut2_pl),Y ; get byte from keyword table BNE LAB_13D8 ; go test next word if not zero byte (end of table) ; reached end of table with no match LDA Ibuffs,X ; restore byte from input buffer BPL LAB_13EA ; branch always (all bytes in buffer are $00-$7F) ; go save byte in output and continue crunching ; reached [EOL] LAB_142A INY ; increment pointer INY ; increment pointer (makes it next line pointer high byte) STA Ibuffs,Y ; save [EOL] (marks [EOT] in immediate mode) INY ; adjust for line copy INY ; adjust for line copy INY ; adjust for line copy DEC Bpntrl ; allow for increment (change if buffer starts at $xxFF) RTS ; ; search Basic for temp integer line number from start of mem LAB_SSLN LDA Smeml ; get start of mem low byte LDX Smemh ; get start of mem high byte ; search Basic for temp integer line number from AX ; returns carry set if found ; returns Baslnl/Baslnh pointer to found or next higher (not found) line LAB_SHLN LDY #$01 ; set index STA Baslnl ; save low byte as current STX Baslnh ; save high byte as current LDA (Baslnl),Y ; get pointer high byte from addr BEQ LAB_145F ; pointer was zero so we're done, do 'not found' exit INY ; increment index ... INY ; ... to line # high byte LDA (Baslnl),Y ; get line # high byte DEY ; decrement index (point to low byte) CMP Itemph ; compare with temporary integer high byte BEQ LAB_144D ; if = go check low byte BCS LAB_145F ; else if temp < this line, exit (passed line#) LAB_1456 DEY ; decrement index to next line ptr high byte LDA (Baslnl),Y ; get next line pointer high byte TAX ; copy to X DEY ; decrement index to next line ptr low byte LDA (Baslnl),Y ; get next line pointer low byte BCC LAB_SHLN ; go search for line # in temp (Itempl/Itemph) from AX ; (carry always clear) ; high bytes were = so check low bytes LAB_144D LDA (Baslnl),Y ; get line # low byte CMP Itempl ; compare with temporary integer low byte BCC LAB_1456 ; loop if temp > this line (not reached line #) BEQ LAB_1460 ; exit if temp = (found line #, carry is set) ; else carry was set so we passed line # LAB_145F CLC ; clear found flag LAB_1460 RTS ; ; perform NEW LAB_NEW BNE LAB_1460 ; exit if not end of statement (to do syntax error) LAB_1463 LDA #$00 ; clear A TAY ; clear Y STA (Smeml),Y ; clear first line, next line pointer, low byte INY ; increment index STA (Smeml),Y ; clear first line, next line pointer, high byte CLC ; clear carry LDA Smeml ; get start of mem low byte ADC #$02 ; calculate end of BASIC low byte STA Svarl ; save start of vars low byte LDA Smemh ; get start of mem high byte ADC #$00 ; add any carry STA Svarh ; save start of vars high byte ; reset execution to start, clear vars & flush stack LAB_1477 CLC ; clear carry LDA Smeml ; get start of mem low byte ADC #$FF ; -1 STA Bpntrl ; save BASIC execute pointer low byte LDA Smemh ; get start of mem high byte ADC #$FF ; -1+carry STA Bpntrh ; save BASIC execute pointer high byte ; "CLEAR" command gets here LAB_147A LDA Ememl ; get end of mem low byte LDY Ememh ; get end of mem high byte STA Sstorl ; set bottom of string space low byte STY Sstorh ; set bottom of string space high byte LDA Svarl ; get start of vars low byte LDY Svarh ; get start of vars high byte STA Sarryl ; save var mem end low byte STY Sarryh ; save var mem end high byte STA Earryl ; save array mem end low byte STY Earryh ; save array mem end high byte JSR LAB_161A ; perform RESTORE command ; flush stack & clear continue flag LAB_1491 LDX #des_sk ; set descriptor stack pointer STX next_s ; save descriptor stack pointer PLA ; pull return address low byte TAX ; copy return address low byte PLA ; pull return address high byte STX LAB_01FE ; save to cleared stack STA LAB_01FF ; save to cleared stack LDX #$FD ; new stack pointer TXS ; reset stack LDA #$00 ; clear byte STA Cpntrh ; clear continue pointer high byte STA Sufnxf ; clear subscript/FNX flag LAB_14A6 RTS ; ; perform CLEAR LAB_CLEAR BEQ LAB_147A ; if no following token go do "CLEAR" RTS ; was following token (go do syntax error) ; perform LIST [n][-m] ; extended table version .... LAB_LIST BCC LAB_14BD ; branch if next character numeric (LIST n...) BEQ LAB_14BD ; branch if next character [NULL] (LIST) CMP #TK_MINUS ; compare with token for - BNE LAB_14A6 ; exit if not - (LIST -m) ; LIST [[n][-m]] ; this bit sets the n , if present, as the start & end LAB_14BD JSR LAB_GFPN ; get fixed-point number into temp integer JSR LAB_SSLN ; search BASIC for temp integer line number ; (pointer in Baslnl/Baslnh) .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BEQ LAB_14D4 ; branch if no more characters ; this bit checks the - is present CMP #TK_MINUS ; compare with token for - BNE LAB_1460 ; return if not "-" (will be Syntax error) ; LIST [n]-m ; the - was there so set m as the end value .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JSR LAB_GFPN ; get fixed-point number into temp integer BNE LAB_1460 ; exit if not ok LAB_14D4 ; to make LIST in line executable we need to remove the next two lines #### ; PLA ; pull return address (exit via warm start) ; PLA ; pull return address (exit via warm start) LDA Itempl ; get temporary integer low byte ORA Itemph ; OR temporary integer high byte BNE LAB_14E2 ; branch if start set LDA #$FF ; set for -1 STA Itempl ; set temporary integer low byte STA Itemph ; set temporary integer high byte LAB_14E2 LDY #$01 ; set index for line STY Oquote ; clear open quote flag JSR LAB_CRLF ; print CR/LF #### LDA (Baslnl),Y ; get next line pointer high byte ; pointer initially set by search at LAB_14BD BEQ LAB_152B ; if null all done so exit JSR LAB_1629 ; do CRTL-C check vector ; also, to make it look prettier, we need this moved before the LDA (Baslnl),Y #### ; JSR LAB_CRLF ; print CR/LF INY ; increment index for line LDA (Baslnl),Y ; get line # low byte TAX ; copy to X INY ; increment index LDA (Baslnl),Y ; get line # high byte CMP Itemph ; compare with temporary integer high byte BNE LAB_14FF ; branch if no high byte match CPX Itempl ; compare with temporary integer low byte BEQ LAB_1501 ; branch if = last line to do (< will pass next branch) LAB_14FF ; else ... BCS LAB_152B ; if greater all done so exit LAB_1501 STY Tidx1 ; save index for line JSR LAB_295E ; print XA as unsigned integer LDA #$20 ; space is the next character LAB_1508 LDY Tidx1 ; get index for line AND #$7F ; mask top out bit of character LAB_150C JSR LAB_PRNA ; go print the character CMP #$22 ; was it " character BNE LAB_1519 ; branch if not ; we are either entering or leaving a pair of quotes LDA Oquote ; get open quote flag EOR #$FF ; toggle it STA Oquote ; save it back LAB_1519 INY ; increment index LDA (Baslnl),Y ; get next byte BNE LAB_152E ; branch if not [EOL] (go print character) ; was [EOL] TAY ; else clear index LDA (Baslnl),Y ; get next line pointer low byte TAX ; copy to X INY ; increment index LDA (Baslnl),Y ; get next line pointer high byte STX Baslnl ; set pointer to line low byte STA Baslnh ; set pointer to line high byte BNE LAB_14E2 ; go do next line if not [EOT] ; else ... LAB_152B ; to finish off making LIST in line executable we need to change the exit to .. #### RTS ; JMP LAB_GBYT ; get BASIC byte and return ; .. and not #### ; JMP LAB_1274 ; go do warm start #### LAB_152E BPL LAB_150C ; just go print it if not token byte ; else was token byte so uncrunch it (maybe) BIT Oquote ; test the open quote flag BMI LAB_150C ; just go print character if open quote set SEC ; else set carry for subtract SBC #$7F ; reduce token range to 1 to whatever TAX ; copy token # to X STY Tidx1 ; save index for line LDY #LAB_KEYT ; get keyword table high address STY ut2_ph ; save pointer high byte LDY #$00 ; clear index byte LAB_1540 DEX ; decrement token # BEQ LAB_154B ; if now found go do printing LAB_1543 LDA (ut2_pl),Y ; get byte from keyword table PHP ; save status INY ; increment table index BNE LAB_1544 ; skip INC if no overflow INC ut2_ph ; increment table pointer high byte LAB_1544 PLP ; restore status BPL LAB_1543 ; loop until keyword end marker BMI LAB_1540 ; go test if this is required keyword ; found keyword (it's the next one) LAB_154B LDA (ut2_pl),Y ; get byte from table BMI LAB_1508 ; go restore index, mask byte & print if ; byte was end marker JSR LAB_PRNA ; else go print the character INY ; increment table index BNE LAB_154B ; do next if no overflow INC ut2_ph ; increment table pointer high byte BNE LAB_154B ; go get next character (branch always) ; perform FOR LAB_FOR LDA #$80 ; set FNX STA Sufnxf ; set subscript/FNX flag JSR LAB_LET ; go do LET JSR LAB_11A1 ; search the stack for FOR or GOSUB activity BNE LAB_1567 ;.branch if FOR (this var) not found ;.FOR (this var) was found so first we dump the old one TXA ; copy index ADC #CR_CHAR ; add FOR structure size-2 TAX ; add to index TXS ; set stack (dump FOR structure (-2 bytes)) LAB_1567 PLA ; pull return address PLA ; pull return address LDA #$10 ; we need 16d bytes ! JSR LAB_1212 ; check room on stack for A bytes JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL]) CLC ; clear carry for add TYA ; copy index to A ADC Bpntrl ; add BASIC execute pointer low byte PHA ; push onto stack LDA Bpntrh ; get BASIC execute pointer high byte ADC #$00 ; add carry PHA ; push onto stack LDA Clineh ; get current line high byte PHA ; push onto stack LDA Clinel ; get current line low byte PHA ; push onto stack LDA #TK_TO ; get "TO" token JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error, then warm start JSR LAB_CTNM ; check if source is numeric, else do type mismatch JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch LDA FAC1_s ; get FAC1 sign (b7) ORA #$7F ; set all non sign bits AND FAC1_1 ; and FAC1 mantissa1 STA FAC1_1 ; save FAC1 mantissa1 LDA #LAB_159F ; set return address high byte STA ut1_pl ; save return address low byte STY ut1_ph ; save return address high byte JMP LAB_1B66 ; round FAC1 & put on stack (returns to next instruction) LAB_159F LDA #LAB_259C ; set 1 pointer high addr JSR LAB_UFAC ; unpack memory (AY) into FAC1 .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory CMP #TK_STEP ; compare with STEP token BNE LAB_15B3 ; jump if not "STEP" ;.was step so .... .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch LAB_15B3 JSR LAB_27CA ; return A=FF,C=1/-ve A=01,C=0/+ve JSR LAB_1B5B ; push sign, round FAC1 & put on stack LDA Frnxth ; get var pointer for FOR/NEXT high byte PHA ; push on stack LDA Frnxtl ; get var pointer for FOR/NEXT low byte PHA ; push on stack LDA #TK_FOR ; get FOR token PHA ; push on stack ; interpreter inner loop LAB_15C2 JSR LAB_1629 ; do CRTL-C check vector LDA Bpntrl ; get BASIC execute pointer low byte LDY Bpntrh ; get BASIC execute pointer high byte LDX Clineh ; continue line is $FFxx for immediate mode ; ($00xx for RUN from immediate mode) INX ; increment it (now $00 if immediate mode) BEQ LAB_15D1 ; branch if null (immediate mode) STA Cpntrl ; save continue pointer low byte STY Cpntrh ; save continue pointer high byte LAB_15D1 LDY #$00 ; clear index LDA (Bpntrl),Y ; get next byte BEQ LAB_15DC ; branch if null [EOL] CMP #$3A ; compare with ":" BEQ LAB_15F6 ; branch if = (statement separator) LAB_15D9 JMP LAB_SNER ; else syntax error, then warm start ; have reached [EOL] LAB_15DC LDY #$02 ; set index LDA (Bpntrl),Y ; get next line pointer high byte CLC ; clear carry for no "BREAK" message BEQ LAB_1651 ; if null go to immediate mode (was immediate or [EOT] ; marker) INY ; increment index LDA (Bpntrl),Y ; get line # low byte STA Clinel ; save current line low byte INY ; increment index LDA (Bpntrl),Y ; get line # high byte STA Clineh ; save current line high byte TYA ; A now = 4 ADC Bpntrl ; add BASIC execute pointer low byte STA Bpntrl ; save BASIC execute pointer low byte BCC LAB_15F6 ; branch if no overflow INC Bpntrh ; else increment BASIC execute pointer high byte LAB_15F6 .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory LAB_15F9 JSR LAB_15FF ; go interpret BASIC code from (Bpntrl) LAB_15FC JMP LAB_15C2 ; loop ; interpret BASIC code from (Bpntrl) LAB_15FF BEQ LAB_1628 ; exit if zero [EOL] LAB_1602 EOR #$80 ; normalise token (was SEC, SBC) BPL LAB_1609 ; branch if token JMP LAB_LET ; else go do implied LET LAB_1609 CMP #(TK_TAB-$80) ; compare normalised token with TAB BCS LAB_15D9 ; branch if A>=TAB (do syntax error, then warm start) ; only tokens before TAB can start a line ASL A ; *2 (2 bytes per vector) TAY ; copy to index LDA LAB_CTBL+1,Y ; get vector high byte PHA ; onto stack LDA LAB_CTBL,Y ; get vector low byte PHA ; onto stack JMP LAB_IGBY ; jump to increment & scan memory ; then "return" to vector ; CTRL-C check jump. this is called as a subroutine but exits back via a jump if a ; key press is detected. LAB_1629 JMP (VEC_CC) ; ctrl c check vector ; if there was a key press it gets back here ..... LAB_1636 CMP #$03 ; compare with CTRL-C ; perform STOP LAB_STOP BCS LAB_163B ; branch if token follows STOP ; else just END ; END LAB_END CLC ; clear carry (indicate program end) LAB_163B BNE LAB_167A ; return if wasn't CTRL-C LDA Bpntrh ; get BASIC execute pointer high byte EOR #>Ibuffs ; compare with buffer address high byte (Cb unchanged) BEQ LAB_164F ; branch if BASIC pointer is in buffer ; (can't continue in immediate mode) ; else... EOR #>Ibuffs ; correct the bits LDY Bpntrl ; get BASIC execute pointer low byte STY Cpntrl ; save continue pointer low byte STA Cpntrh ; save continue pointer high byte LAB_1647 LDA Clinel ; get current line low byte LDY Clineh ; get current line high byte STA Blinel ; save break line low byte STY Blineh ; save break line high byte LAB_164F PLA ; pull return address low PLA ; pull return address high LAB_1651 BCC LAB_165E ; jump if was program end LDA #LAB_BMSG ; point to "Break" (high byte) JMP LAB_1269 ; print "Break" and do warm start LAB_165E JMP LAB_1274 ; go do warm start ; perform RESTORE LAB_RESTORE BNE LAB_RESTOREn ; branch if next character not null (RESTORE n) LAB_161A SEC ; set carry for subtract LDA Smeml ; get start of mem low byte SBC #$01 ; -1 LDY Smemh ; get start of mem high byte BCS LAB_1624 ; branch if no underflow LAB_uflow DEY ; else decrement high byte LAB_1624 STA Dptrl ; save DATA pointer low byte STY Dptrh ; save DATA pointer high byte LAB_1628 RTS ; ; is RESTORE n LAB_RESTOREn JSR LAB_GFPN ; get fixed-point number into temp integer JSR LAB_SNBL ; scan for next BASIC line LDA Clineh ; get current line high byte CMP Itemph ; compare with temporary integer high byte BCS LAB_reset_search ; branch if >= (start search from beginning) TYA ; else copy line index to A SEC ; set carry (+1) ADC Bpntrl ; add BASIC execute pointer low byte LDX Bpntrh ; get BASIC execute pointer high byte BCC LAB_go_search ; branch if no overflow to high byte INX ; increment high byte BCS LAB_go_search ; branch always (can never be carry clear) ; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml) LAB_reset_search LDA Smeml ; get start of mem low byte LDX Smemh ; get start of mem high byte ; search for line # in temp (Itempl/Itemph) from (AX) LAB_go_search JSR LAB_SHLN ; search Basic for temp integer line number from AX BCS LAB_line_found ; if carry set go set pointer JMP LAB_16F7 ; else go do "Undefined statement" error LAB_line_found ; carry already set for subtract LDA Baslnl ; get pointer low byte SBC #$01 ; -1 LDY Baslnh ; get pointer high byte BCS LAB_1624 ; branch if no underflow (save DATA pointer & return) BCC LAB_uflow ; else decrement high byte then save DATA pointer & ; return (branch always) ; perform NULL LAB_NULL JSR LAB_GTBY ; get byte parameter STX Nullct ; save new NULL count LAB_167A RTS ; ; perform CONT LAB_CONT BNE LAB_167A ; if following byte exit to do syntax error LDY Cpntrh ; get continue pointer high byte BNE LAB_166C ; go do continue if we can LDX #$1E ; error code $1E ("Can't continue" error) JMP LAB_XERR ; do error #X, then warm start ; we can continue so ... LAB_166C LDA #TK_ON ; set token for ON JSR LAB_IRQ ; set IRQ flags LDA #TK_ON ; set token for ON JSR LAB_NMI ; set NMI flags STY Bpntrh ; save BASIC execute pointer high byte LDA Cpntrl ; get continue pointer low byte STA Bpntrl ; save BASIC execute pointer low byte LDA Blinel ; get break line low byte LDY Blineh ; get break line high byte STA Clinel ; set current line low byte STY Clineh ; set current line high byte RTS ; ; perform RUN LAB_RUN BNE LAB_1696 ; branch if RUN n JMP LAB_1477 ; reset execution to start, clear vars, flush stack & RET ; does RUN n LAB_1696 JSR LAB_147A ; go do "CLEAR" BEQ LAB_16B0 ; get n and do GOTO n (branch always as CLEAR sets Z=1) ; perform DO LAB_DO LDA #$05 ; need 5 bytes for DO JSR LAB_1212 ; check room on stack for A bytes DoAgain LDA Bpntrh ; get BASIC execute pointer high byte PHA ; push on stack LDA Bpntrl ; get BASIC execute pointer low byte PHA ; push on stack LDA Clineh ; get current line high byte PHA ; push on stack LDA Clinel ; get current line low byte PHA ; push on stack LDA #TK_DO ; token for DO PHA ; push on stack .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory JMP LAB_15C2 ; go do interpreter inner loop ; perform GOSUB LAB_GOSUB LDA #$05 ; need 5 bytes for GOSUB JSR LAB_1212 ; check room on stack for A bytes LDA Bpntrh ; get BASIC execute pointer high byte PHA ; push on stack LDA Bpntrl ; get BASIC execute pointer low byte PHA ; push on stack LDA Clineh ; get current line high byte PHA ; push on stack LDA Clinel ; get current line low byte PHA ; push on stack LDA #TK_GOSUB ; token for GOSUB PHA ; push on stack LAB_16B0 .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory JSR LAB_GOTO ; perform GOTO n JMP LAB_15C2 ; go do interpreter inner loop ; (can't RTS, we used the stack!) ; perform GOTO LAB_GOTO JSR LAB_GFPN ; get fixed-point number into temp integer JSR LAB_SNBL ; scan for next BASIC line LDA Clineh ; get current line high byte CMP Itemph ; compare with temporary integer high byte BCS LAB_16D0 ; branch if >= (start search from beginning) TYA ; else copy line index to A SEC ; set carry (+1) ADC Bpntrl ; add BASIC execute pointer low byte LDX Bpntrh ; get BASIC execute pointer high byte BCC LAB_16D4 ; branch if no overflow to high byte INX ; increment high byte BCS LAB_16D4 ; branch always (can never be carry) ; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml) LAB_16D0 LDA Smeml ; get start of mem low byte LDX Smemh ; get start of mem high byte ; search for line # in temp (Itempl/Itemph) from (AX) LAB_16D4 JSR LAB_SHLN ; search Basic for temp integer line number from AX BCC LAB_16F7 ; if carry clear go do "Undefined statement" error ; (unspecified statement) ; carry already set for subtract LDA Baslnl ; get pointer low byte SBC #$01 ; -1 STA Bpntrl ; save BASIC execute pointer low byte LDA Baslnh ; get pointer high byte SBC #$00 ; subtract carry STA Bpntrh ; save BASIC execute pointer high byte LAB_16E5 RTS ; LAB_DONOK LDX #$22 ; error code $22 ("LOOP without DO" error) JMP LAB_XERR ; do error #X, then warm start ; perform LOOP LAB_LOOP STA Frnxth ; save following token LDA #$FF ; set byte so no match possible STA Frnxtl ; save var pointer for FOR/NEXT low byte JSR LAB_11A1 ; search the stack for FOR or GOSUB activity ; (get token off stack) INX ; ignore token TXS ; correct stack CMP #TK_DO ; compare with DO token BNE LAB_DONOK ; branch if no matching DO LDA Frnxth ; get saved following token back BEQ LoopAlways ; if no following token loop forever ; (stack pointer in X) SBC #TK_UNTIL ; subtract token for UNTIL, we know carry is set here TAX ; copy to X (if it was UNTIL then X will be correct) BEQ DoRest ; branch if was UNTIL DEX ; decrement result BNE LAB_16FC ; if not WHILE go do syntax error & warm start ; only if the token was WHILE will this fail DEX ; set invert result byte DoRest STX Frnxth ; save invert result byte .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JSR LAB_EVEX ; evaluate expression LDA FAC1_e ; get FAC1 exponent BEQ DoCmp ; if =0 go do straight compare LDA #$FF ; else set all bits DoCmp EOR Frnxth ; EOR with invert byte BNE LoopDone ; if <> 0 clear stack & back to interpreter loop ; loop condition wasn't met so do it again LoopAlways PLA ; pull current line low byte STA Clinel ; save current line low byte PLA ; pull current line high byte STA Clineh ; save current line high byte PLA ; pull BASIC execute pointer low byte STA Bpntrl ; save BASIC execute pointer low byte PLA ; pull BASIC execute pointer high byte STA Bpntrh ; save BASIC execute pointer high byte JMP DoAgain ; go do DO again ; clear stack & back to interpreter loop LoopDone PLA ; dump current line low byte PLA ; dump current line high byte PLA ; dump BASIC execute pointer low byte PLA ; dump BASIC execute pointer high byte JMP LAB_DATA ; go perform DATA (find : or [EOL]) ; do the return without gosub error LAB_16F4 LDX #$04 ; error code $04 ("RETURN without GOSUB" error) .byte $2C ; makes next line BIT LAB_0EA2 LAB_16F7 ; do undefined statement error LDX #$0E ; error code $0E ("Undefined statement" error) JMP LAB_XERR ; do error #X, then warm start ; perform RETURN LAB_RETURN BNE LAB_16E5 ; exit if following token (to allow syntax error) LAB_16E8 LDA #$FF ; set byte so no match possible STA Frnxtl ; save var pointer for FOR/NEXT low byte JSR LAB_11A1 ; search the stack for FOR or GOSUB activity ; (get token off stack) INX ; ignore token TXS ; correct stack CMP #TK_GOSUB ; compare with GOSUB token BNE LAB_16F4 ; branch if no matching GOSUB LAB_16FF PLA ; pull current line low byte STA Clinel ; save current line low byte PLA ; pull current line high byte STA Clineh ; save current line high byte PLA ; pull BASIC execute pointer low byte STA Bpntrl ; save BASIC execute pointer low byte PLA ; pull BASIC execute pointer high byte STA Bpntrh ; 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_DATA JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL]) ; set BASIC execute pointer LAB_170F TYA ; copy index to A CLC ; clear carry for add ADC Bpntrl ; add BASIC execute pointer low byte STA Bpntrl ; save BASIC execute pointer low byte BCC LAB_1719 ; skip next if no carry INC Bpntrh ; else increment BASIC execute pointer high byte LAB_1719 RTS ; LAB_16FC JMP LAB_SNER ; do syntax error, then warm start ; scan for next BASIC statement ([:] or [EOL]) ; returns Y as index to [:] or [EOL] LAB_SNBS 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_SNBL LDX #$00 ; set alt search character = [EOL] STX Srchc ; store alt search character LDY #$00 ; set search character = [EOL] STY Asrch ; store search character LAB_1725 LDA Asrch ; get search character LDX Srchc ; get alt search character STA Srchc ; make search character = alt search character STX Asrch ; make alt search character = search character LAB_172D LDA (Bpntrl),Y ; get next byte BEQ LAB_1719 ; exit if null [EOL] CMP Asrch ; compare with search character BEQ LAB_1719 ; exit if found INY ; increment index CMP #$22 ; compare current character with open quote BEQ LAB_1725 ; if found go swap search character for alt search character BNE LAB_172D ; go get next character ; perform IF LAB_IF JSR LAB_EVEX ; evaluate expression .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory CMP #TK_GOTO ; compare with "GOTO" token BEQ LAB_174B ; jump if was "GOTO" ; wasn't IF ... GOTO so must be IF ... THEN LDA #TK_THEN ; get THEN token JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error, then warm start LAB_174B LDA FAC1_e ; get FAC1 exponent BNE LAB_1754 ; branch if result was non zero ; else .... ; perform REM, skip (rest of) line LAB_REM JSR LAB_SNBL ; scan for next BASIC line BEQ LAB_170F ; go set BASIC execute pointer & RET (always) ; result was non zero so do rest of line LAB_1754 .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BCS LAB_175C ; branch if not numeric character (is var or keyword) JMP LAB_GOTO ; else do GOTO n (was numeric) ; is var or keyword LAB_175C JMP LAB_15FF ; interpret BASIC code from (Bpntrl) ; perform ON LAB_ON CMP #TK_IRQ ; was it IRQ token ? BNE LAB_NOIN ; if not go check NMI JMP LAB_SIRQ ; else go set-up IRQ LAB_NOIN CMP #TK_NMI ; was it NMI token ? BNE LAB_NONM ; if not go do normal ON command JMP LAB_SNMI ; else go set-up NMI LAB_NONM JSR LAB_GTBY ; get byte parameter PHA ; push GOTO/GOSUB token CMP #TK_GOSUB ; compare with GOSUB token BEQ LAB_176B ; branch if GOSUB LAB_1767 CMP #TK_GOTO ; compare with GOTO token BNE LAB_16FC ; if not GOTO do syntax error, then warm start ; next character was GOTO or GOSUB LAB_176B DEC FAC1_3 ; decrement index (byte value) BNE LAB_1773 ; branch if not zero PLA ; pull GOTO/GOSUB token JMP LAB_1602 ; go execute it LAB_1773 .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JSR LAB_GFPN ; get fixed-point number into temp integer (skip this n) ; (we could LDX #"," and JSR LAB_SNBL+2, then we ; just BNE LAB_176B for the loop. should be quicker ... ; no we can't, what if we meet a colon or [EOL]?) CMP #$2C ; compare next character with "," BEQ LAB_176B ; loop if "," PLA ; else pull keyword token (run out of options) LAB_177E RTS ; and exit ; get fixed-point number into temp integer LAB_GFPN LDX #$00 ; clear reg STX Itempl ; clear temporary integer low byte STX Itemph ; clear temporary integer high byte LAB_1785 BCS LAB_177E ; return if carry set (end of scan, character was not 0-9) SBC #$2F ; subtract $30 ($2F+carry) from byte STA Temp3 ; store # LDA Itemph ; get temporary integer high byte STA ut1_pl ; save it for now CMP #$19 ; compare with $19 BCS LAB_1767 ; branch if >= (makes max line # 63999 because next ; bit does *$0A (= 64000) compare at target will fail ; and do Syntax error) LDA Itempl ; get temporary integer low byte ASL A ; *2 low byte ROL ut1_pl ; *2 high byte ASL A ; *2 low byte ROL ut1_pl ; *2 high byte (*4) ADC Itempl ; + low byte (*5) STA Itempl ; save it LDA ut1_pl ; get high byte temp ADC Itemph ; + high byte (*5) STA Itemph ; save it ASL Itempl ; *2 low byte (*10d) ROL Itemph ; *2 high byte (*10d) LDA Itempl ; get low byte ADC Temp3 ; add # STA Itempl ; save low byte BCC LAB_17B3 ; branch if no overflow to high byte INC Itemph ; else increment high byte LAB_17B3 .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JMP LAB_1785 ; loop for next character ; perform DEC LAB_DEC LDA #LAB_259C ; set +/-1 pointer high byte (both the same) JSR LAB_246C ; add (AY) to FAC1 JSR LAB_PFAC ; pack FAC1 into variable (Lvarpl) .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory CMP #$2C ; compare with "," BNE LAB_177E ; exit if not "," (either end or error) ; was "," so another INCR variable to do .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment and scan memory JMP LAB_17B7 ; go do next var IncrErr JMP LAB_1ABC ; do "Type mismatch" error then warm start ; perform LET LAB_LET JSR LAB_GVAR ; get var address STA Lvarpl ; save var address low byte STY Lvarph ; save var address high byte LDA #TK_EQUAL ; get = token JSR LAB_SCCA ; scan for CHR$(A), else do syntax error, then warm start LDA Dtypef ; get data type flag, $FF=string, $00=numeric PHA ; push data type flag JSR LAB_EVEX ; evaluate expression PLA ; pop data type flag ROL A ; set carry if type = string JSR LAB_CKTM ; type match check, set C for string BNE LAB_17D5 ; branch if string JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) & RET ; string LET LAB_17D5 LDY #$02 ; set index to pointer high byte LDA (des_pl),Y ; get string pointer high byte CMP Sstorh ; compare bottom of string space high byte BCC LAB_17F4 ; if less assign value & exit (was in program memory) BNE LAB_17E6 ; branch if > ; else was equal so compare low bytes DEY ; decrement index LDA (des_pl),Y ; get pointer low byte CMP Sstorl ; compare bottom of string space low byte BCC LAB_17F4 ; if less assign value & exit (was in program memory) ; pointer was >= to bottom of string space pointer LAB_17E6 LDY des_ph ; get descriptor pointer high byte CPY Svarh ; compare start of vars high byte BCC LAB_17F4 ; branch if less (descriptor is on stack) BNE LAB_17FB ; branch if greater (descriptor is not on stack) ; else high bytes were equal so ... LDA des_pl ; get descriptor pointer low byte CMP Svarl ; compare start of vars low byte BCS LAB_17FB ; branch if >= (descriptor is not on stack) LAB_17F4 LDA des_pl ; get descriptor pointer low byte LDY des_ph ; get descriptor pointer high byte JMP LAB_1811 ; clean stack, copy descriptor to variable & return ; make space and copy string LAB_17FB LDY #$00 ; index to length LDA (des_pl),Y ; get string length JSR LAB_20C9 ; copy string LDA des_2l ; get descriptor pointer low byte LDY des_2h ; get descriptor pointer high byte STA ssptr_l ; save descriptor pointer low byte STY ssptr_h ; save descriptor pointer high byte JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill) LDA #$AC ; set descriptor pointer low byte LDY #$00 ; get descriptor pointer high byte ; clean stack & assign value to string variable LAB_1811 STA des_2l ; save descriptor_2 pointer low byte STY des_2h ; save descriptor_2 pointer high byte JSR LAB_22EB ; clean descriptor stack, YA = pointer LDY #$00 ; index to length LDA (des_2l),Y ; get string length STA (Lvarpl),Y ; copy to let string variable INY ; index to string pointer low byte LDA (des_2l),Y ; get string pointer low byte STA (Lvarpl),Y ; copy to let string variable INY ; index to string pointer high byte LDA (des_2l),Y ; get string pointer high byte STA (Lvarpl),Y ; copy to let string variable LAB_1828 RTS ; ; perform GET LAB_GET JSR LAB_GVAR ; get var address STA Lvarpl ; save var address low byte STY Lvarph ; save var address high byte JSR INGET ; get input byte LDX Dtypef ; get data type flag, $FF=string, $00=numeric BMI LAB_GETS ; go get string character ; was numeric get TAY ; copy character to Y JSR LAB_1FD0 ; convert Y to byte in FAC1 JMP LAB_PFAC ; pack FAC1 into variable (Lvarpl) & return LAB_GETS PHA ; save character LDA #$01 ; string is single byte BCS LAB_IsByte ; branch if byte received PLA ; string is null LAB_IsByte JSR LAB_MSSP ; make string space A bytes long A=$AC=length, ; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte BEQ LAB_NoSt ; skip store if null string PLA ; get character back LDY #$00 ; clear index STA (str_pl),Y ; save byte in string (byte IS string!) LAB_NoSt JSR LAB_RTST ; check for space on descriptor stack then put string address ; and length on descriptor stack & update stack pointers JMP LAB_17D5 ; do string LET & return ; perform PRINT LAB_1829 JSR LAB_18C6 ; print string from Sutill/Sutilh LAB_182C .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory ; PRINT LAB_PRINT BEQ LAB_CRLF ; if nothing following just print CR/LF LAB_1831 BEQ LAB_1828 ;.exit if nothing more to print CMP #TK_TAB ; compare with TAB( token BEQ LAB_18A2 ; go do TAB/SPC CMP #TK_SPC ; compare with SPC( token BEQ LAB_18A2 ; go do TAB/SPC CMP #$44 ; compare with "," BEQ LAB_188B ; go do move to next TAB mark CMP #'; ; compare with ";" BEQ LAB_18BD ; if ";" continue with PRINT processing JSR LAB_EVEX ; evaluate expression BIT Dtypef ; test data type flag, $FF=string, $00=numeric BMI LAB_1829 ; branch if string JSR LAB_296E ; convert FAC1 to string JSR LAB_20AE ; print " terminated string to Sutill/Sutilh LDY #$00 ; clear index ; don't check fit if terminal width byte is zero LDA TWidth ; get terminal width byte BEQ LAB_185E ; skip check if zero SEC ; set carry for subtract SBC TPos ; subtract terminal position SBC (des_pl),Y ; subtract string length BCS LAB_185E ; branch if less than terminal width JSR LAB_CRLF ; else print CR/LF LAB_185E JSR LAB_18C6 ; print string from Sutill/Sutilh BEQ LAB_182C ; always go continue processing line ; CR/LF return to BASIC from BASIC input handler LAB_1866 LDA #$00 ; clear byte STA Ibuffs,X ; null terminate input LDX #<(Ibuffs-1) ; set X to buffer start-1 low byte LDY #>(Ibuffs-1) ; set Y to buffer start-1 high byte ; print CR/LF LAB_CRLF LDA #CR_CHAR ; load [CR] JSR LAB_PRNA ; go print the character LDA #LF_CHAR ; load [LF] BNE LAB_PRNA ; go print the character & return (always branch) LAB_188B LDA TPos ; get terminal position CMP Iclim ; compare with input column limit BCC LAB_1897 ; branch if less JSR LAB_CRLF ; else print CR/LF (next line) BNE LAB_18BD ; continue with PRINT processing (branch always) LAB_1897 SEC ; set carry for subtract LAB_1898 SBC TabSiz ; subtract TAB size BCS LAB_1898 ; loop if result was +ve EOR #$FF ; complement it ADC #$01 ; +1 (twos complement) BNE LAB_18B6 ; always print A spaces (result is never $00) ; do TAB/SPC LAB_18A2 PHA ; save token JSR LAB_SGBY ; scan and get byte parameter CMP #$29 ; is next character ) BNE LAB_1910 ; if not do syntax error, then warm start PLA ; get token back CMP #TK_TAB ; was it TAB ? BNE LAB_18B7 ; branch if not (was SPC) ; calculate TAB offset TXA ; copy integer value to A SBC TPos ; subtract terminal position BCC LAB_18BD ; branch if result was < 0 (can't TAB backwards) BEQ LAB_18BD ; branch if result was = $0 (already here) ; print A spaces LAB_18B6 TAX ; copy result to X ; print X spaces LAB_18B7 JSR LAB_18E0 ; print " " DEX ; decrement count BNE LAB_18B7 ; loop if not all done ; continue with PRINT processing LAB_18BD .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JMP LAB_1831 ; continue executing PRINT ; print null terminated string from memory LAB_18C3 JSR LAB_20AE ; print " terminated string to Sutill/Sutilh ; print string from Sutill/Sutilh LAB_18C6 JSR LAB_22B6 ; 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 LDY #$00 ; reset index TAX ; copy length to X BEQ LAB_188C ; exit (RTS) if null string LAB_18CD LDA (ut1_pl),Y ; get next byte JSR LAB_PRNA ; go print the character INY ; increment index DEX ; decrement count BNE LAB_18CD ; loop if not done yet RTS ; ; Print single format character ; print " " LAB_18E0 LDA #$20 ; load " " .byte $2C ; change next line to BIT LAB_3FA9 ; print "?" character LAB_18E3 LDA #$3F ; load "?" character ; print character in A ; now includes the null handler ; also includes infinite line length code ; note! some routines expect this one to exit with Zb=0 LAB_PRNA CMP #$20 ; compare with " " BCC LAB_18F9 ; branch if less (non printing) ; else printable character PHA ; save the character ; don't check fit if terminal width byte is zero LDA TWidth ; get terminal width BNE LAB_18F0 ; branch if not zero (not infinite length) ; is "infinite line" so check TAB position SEC ; set carry for subtract LDA TPos ; get position SBC TabSiz ; subtract TAB size BNE LAB_18F7 ; skip reset if different STA TPos ; else reset position BEQ LAB_18F7 ; go print character LAB_18F0 CMP TPos ; compare with terminal character position BNE LAB_18F7 ; branch if not at end of line JSR LAB_CRLF ; else print CR/LF LAB_18F7 INC TPos ; increment terminal position PLA ; get character back LAB_18F9 JSR V_OUTP ; output byte via output vector CMP #CR_CHAR ; compare with [CR] BNE LAB_188A ; branch if not [CR] ; else print nullct nulls after the [CR] LAB_1878 STX TempB ; save buffer index LDX Nullct ; get null count BEQ LAB_1886 ; branch if no nulls LDA #$00 ; load [NULL] LAB_1880 JSR LAB_PRNA ; go print the character DEX ; decrement count BNE LAB_1880 ; loop if not all done LDA #CR_CHAR ; restore the character (and set the flags) LAB_1886 STX TPos ; clear terminal position (X always = zero when we get here) LDX TempB ; restore buffer index LAB_188A AND #$FF ; set the flags LAB_188C RTS ; ; handle bad input data LAB_1904 LDA Imode ; get input mode flag, $00=INPUT, $98=READ BPL LAB_1913 ; branch if INPUT (go do redo) LDA Dlinel ; get current DATA line low byte LDY Dlineh ; get current DATA line high byte STA Clinel ; save current line low byte STY Clineh ; save current line high byte LAB_1910 JMP LAB_SNER ; do syntax error, then warm start ; mode was INPUT LAB_1913 LDA #LAB_REDO ; point to redo message (high addr) JSR LAB_18C3 ; print null terminated string from memory LDA Cpntrl ; get continue pointer low byte LDY Cpntrh ; get continue pointer high byte STA Bpntrl ; save BASIC execute pointer low byte STY Bpntrh ; save BASIC execute pointer high byte RTS ; ; perform INPUT LAB_INPUT CMP #$22 ; compare next byte with open quote BNE LAB_1934 ; branch if no prompt string JSR LAB_1BC1 ;.print "..." string LDA #$3B ; load A with ";" JSR LAB_SCCA ; scan for CHR$(A), else do syntax error, then warm start JSR LAB_18C6 ; print string from Sutill/Sutilh ; done with prompt, now get data LAB_1934 JSR LAB_CKRN ; check not Direct (back here if ok) JSR LAB_INLN ; print "? " and get BASIC input LDA Ibuffs ; get first byte from buffer BNE LAB_1953+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_1647 ; go do BREAK exit ; perform READ LAB_READ LDX Dptrl ; get DATA pointer low byte LDY Dptrh ; get DATA pointer high byte LAB_1953 LDA #$98 ; set mode = READ STA Imode ; set input mode flag, <=$7F=INPUT, $98=READ STX Rdptrl ; save READ pointer low byte STY Rdptrh ; save READ pointer high byte ; READ or INPUT next variable from list LAB_195B JSR LAB_GVAR ; get (var) address STA Lvarpl ; save address low byte STY Lvarph ; save address high byte LDA Bpntrl ; get BASIC execute pointer low byte LDY Bpntrh ; get BASIC execute pointer high byte STA Itempl ; save as temporary integer low byte STY Itemph ; save as temporary integer high byte LDX Rdptrl ; get READ pointer low byte LDY Rdptrh ; get READ pointer high byte STX Bpntrl ; set BASIC execute pointer low byte STY Bpntrh ; set BASIC execute pointer high byte .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BNE LAB_1985 ; branch if not null ; pointer was to null entry BIT Imode ; test input mode flag, $00=INPUT, $98=READ BMI LAB_19DD ; branch if READ ; mode was INPUT JSR LAB_18E3 ; print "?" character (double ? for extended input) JSR LAB_INLN ; print "? " and get BASIC input STX Bpntrl ; set BASIC execute pointer low byte STY Bpntrh ; set BASIC execute pointer high byte LAB_1985 .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BIT Dtypef ; test data type flag, $FF=string, $00=numeric BPL LAB_19B0 ; branch if numeric ; else get string STA Srchc ; save search character CMP #$22 ; was it " ? BEQ LAB_1999 ; branch if so LDA #': ; else search character is ":" STA Srchc ; set new search character LDA #$44 ; other search character is "," CLC ; clear carry for add LAB_1999 STA Asrch ; set second search character LDA Bpntrl ; get BASIC execute pointer low byte LDY Bpntrh ; get BASIC execute pointer high byte ADC #$00 ; c is =1 if we came via the BEQ LAB_1999, else =0 BCC LAB_19A4 ; branch if no execute pointer low byte rollover INY ; else increment high byte LAB_19A4 JSR LAB_20B4 ; print [Srchc] or [Asrch] terminated string to Sutill/Sutilh JSR LAB_23F3 ; restore BASIC execute pointer from temp (Btmpl/Btmph) JSR LAB_17D5 ; go do string LET JMP LAB_19B6 ; go check string terminator ; get numeric INPUT LAB_19B0 JSR LAB_2887 ; get FAC1 from string JSR LAB_PFAC ; pack FAC1 into (Lvarpl) LAB_19B6 .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BEQ LAB_19C2 ; branch if null (last entry) CMP #$44 ; else compare with "," BEQ LAB_19C2 ; branch if "," JMP LAB_1904 ; else go handle bad input data ; got good input data LAB_19C2 LDA Bpntrl ; get BASIC execute pointer low byte (temp READ/INPUT ptr) LDY Bpntrh ; get BASIC execute pointer high byte (temp READ/INPUT ptr) STA Rdptrl ; save for now STY Rdptrh ; save for now LDA Itempl ; get temporary integer low byte (temp BASIC execute ptr) LDY Itemph ; get temporary integer high byte (temp BASIC execute ptr) STA Bpntrl ; set BASIC execute pointer low byte STY Bpntrh ; set BASIC execute pointer high byte .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BEQ LAB_1A03 ; if null go do extra ignored message JSR LAB_1C01 ; else scan for "," , else do syntax error, then warm start JMP LAB_195B ; go INPUT next variable from list ; find next DATA statement or do "Out of DATA" error LAB_19DD JSR LAB_SNBS ; scan for next BASIC statement ([:] or [EOL]) INY ; increment index TAX ; copy character ([:] or [EOL]) BNE LAB_19F6 ; branch if [:] LDX #$06 ; set for "Out of DATA" error INY ; increment index (now points to next line pointer high byte) LDA (Bpntrl),Y ; get next line pointer high byte BEQ LAB_1A54 ; branch if end (eventually does error X) INY ; increment index LDA (Bpntrl),Y ; get next line # low byte STA Dlinel ; save current DATA line low byte INY ; increment index LDA (Bpntrl),Y ; get next line # high byte INY ; increment index STA Dlineh ; save current DATA line high byte LAB_19F6 LDA (Bpntrl),Y ; get byte TAX ; copy to X JSR LAB_170F ; set BASIC execute pointer CPX #TK_DATA ; compare with "DATA" token BEQ LAB_1985 ; was "DATA" so go do next READ BNE LAB_19DD ; go find next statement if not "DATA" ; end of INPUT/READ routine LAB_1A03 LDA Rdptrl ; get temp READ pointer low byte LDY Rdptrh ; get temp READ pointer high byte LDX Imode ; get input mode flag, $00=INPUT, $98=READ BPL LAB_1A0E ; branch if INPUT JMP LAB_1624 ; save AY as DATA pointer & RET ; we were getting INPUT LAB_1A0E LDY #$00 ; clear index LDA (Rdptrl),Y ; get next byte BNE LAB_1A1B ; error if not end of INPUT RTS ; ; user typed too much LAB_1A1B LDA #LAB_IMSG ; point to extra ignored message (high addr) JMP LAB_18C3 ; print null terminated string from memory & return ; perform NEXT LAB_NEXT BNE LAB_1A46 ; branch if NEXT var LDY #$00 ; else clear Y BEQ LAB_1A49 ; branch always (no variable to search for) ; NEXT var LAB_1A46 JSR LAB_GVAR ; get variable address LAB_1A49 STA Frnxtl ; store variable pointer low byte STY Frnxth ; store variable pointer high byte ; (both cleared if no variable defined) JSR LAB_11A1 ; search the stack for FOR or GOSUB activity BEQ LAB_1A56 ; branch if found LDX #$00 ; else set error $00 ("NEXT without FOR" error) LAB_1A54 BEQ LAB_1ABE ; do error #X, then warm start LAB_1A56 TXS ; set stack pointer (X set by search, dumps return addresses) INX ; +1 INX ; +2 INX ; +3 INX ; +4 (point to STEP var) TXA ; copy to A INX ; +1 INX ; +2 INX ; +3 INX ; +4 INX ; +5 (point to TO var) STX ut2_pl ; save stack pointer to TO var for compare LDY #$01 ; point to stack page JSR LAB_UFAC ; unpack memory (STEP value) into FAC1 TSX ; get stack pointer back LDA LAB_STAK+8,X ; get step sign STA FAC1_s ; save FAC1 sign (b7) LDA Frnxtl ; get FOR variable pointer low byte LDY Frnxth ; get FOR variable pointer high byte JSR LAB_246C ; add (FOR variable) to FAC1 JSR LAB_PFAC ; pack FAC1 into (FOR variable) LDY #$01 ; point to stack page JSR LAB_27FA ; compare FAC1 with (Y,ut2_pl) (TO value) TSX ; get stack pointer back SEC ; set carry for subtract SBC LAB_STAK+8,X ; subtract step sign BEQ LAB_1A9B ; branch if = (loop complete) ; loop back and do it all again LDA LAB_STAK+$0D,X ; get FOR line low byte STA Clinel ; save current line low byte LDA LAB_STAK+$0E,X ; get FOR line high byte STA Clineh ; save current line high byte LDA LAB_STAK+$10,X ; get BASIC execute pointer low byte STA Bpntrl ; save BASIC execute pointer low byte LDA LAB_STAK+$0F,X ; get BASIC execute pointer high byte STA Bpntrh ; save BASIC execute pointer high byte LAB_1A98 JMP LAB_15C2 ; go do interpreter inner loop ; loop complete so carry on LAB_1A9B TXA ; stack copy to A ADC #$0F ; add $10 ($0F+carry) to dump FOR structure TAX ; copy back to index TXS ; copy to stack pointer .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory CMP #$2C ; compare with "," BNE LAB_1A98 ; branch if not "," (go do interpreter inner loop) ; was "," so another NEXT variable to do .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; else increment & scan memory JSR LAB_1A46 ; do NEXT (var) ; evaluate expression & check is numeric, else do type mismatch LAB_EVNM JSR LAB_EVEX ; evaluate expression ; check if source is numeric, else do type mismatch LAB_CTNM CLC ; destination is numeric .byte $24 ; makes next line BIT $38 ; check if source is string, else do type mismatch LAB_CTST SEC ; required type is string ; type match check, set C for string, clear C for numeric LAB_CKTM BIT Dtypef ; test data type flag, $FF=string, $00=numeric BMI LAB_1ABA ; branch if data type is string ; else data type was numeric BCS LAB_1ABC ; if required type is string do type mismatch error LAB_1AB9 RTS ; ; data type was string, now check required type LAB_1ABA BCS LAB_1AB9 ; exit if required type is string ; else do type mismatch error LAB_1ABC LDX #$18 ; error code $18 ("Type mismatch" error) LAB_1ABE JMP LAB_XERR ; do error #X, then warm start ; evaluate expression LAB_EVEX LDX Bpntrl ; get BASIC execute pointer low byte BNE LAB_1AC7 ; skip next if not zero DEC Bpntrh ; else decrement BASIC execute pointer high byte LAB_1AC7 DEC Bpntrl ; decrement BASIC execute pointer low byte LDX #$00 ; .byte $24 ; makes next line BIT $48 LAB_1ACC PHA ; push compare evaluation byte if branch to here TXA ; copy precedence byte PHA ; push precedence byte LDA #$02 ; 2 bytes JSR LAB_1212 ; check room on stack for A bytes JSR LAB_GVAL ; get value from line LDA #$00 ; clear A STA comp_f ; clear compare function flag LAB_1ADB .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory LAB_1ADE SEC ; set carry for subtract SBC #TK_GT ; subtract token for > (lowest comparison function) BCC LAB_1AFA ; branch if < TK_GT CMP #$03 ; compare with ">" to "<" tokens BCS LAB_1AFA ; branch if >= TK_SGN (highest evaluation function +1) ; was token for > = or < (A = 0, 1 or 2) CMP #$01 ; compare with token for = ROL A ; *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 comp_f ; EOR with compare function flag bits CMP comp_f ; compare with compare function flag BCC LAB_1B53 ; if <(comp_f) do syntax error, then warm start ; was more than one <, = or >) STA comp_f ; save new compare function flag .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JMP LAB_1ADE ; go do next character ; token is < ">" or > "<" tokens LAB_1AFA LDX comp_f ; get compare function flag BNE LAB_1B2A ; branch if compare function BCS LAB_1B78 ; go do functions ; else was < TK_GT so is operator or lower ADC #(TK_GT-TK_PLUS) ; add # of operators (+, -, *, /, ^, AND, OR or EOR) BCC LAB_1B78 ; branch if < + operator ; carry was set so token was +, -, *, /, ^, AND, OR or EOR ADC Dtypef ; add data type flag, $FF=string, $00=numeric BNE LAB_1B0B ; branch if not string or not + token ; will only be $00 if type is string & token was + JMP LAB_224D ; add strings, string 1 is in descriptor des_pl, string 2 ; is in line, & return LAB_1B0B ADC #$FF ; -1 (corrects for carry add) STA ut1_pl ; save it ASL A ; *2 ADC ut1_pl ; *3 TAY ; copy to index LAB_1B13 PLA ; pull previous precedence CMP LAB_OPPT,Y ; compare with precedence byte BCS LAB_1B7D ; branch if A >= JSR LAB_CTNM ; check if source is numeric, else do type mismatch LAB_1B1C PHA ; save precedence LAB_1B1D JSR LAB_1B43 ;.get vector, execute function then continue evaluation PLA ; restore precedence LDY prstk ; get precedence stacked flag BPL LAB_1B3C ; branch if stacked values TAX ; copy precedence (set flags) BEQ LAB_1B7B ; exit if done BNE LAB_1B86 ; else pop FAC2 & return (branch always) LAB_1B2A LSR Dtypef ; clear data type flag, $FF=string, $00=numeric TXA ;. ROL A ;. LDX Bpntrl ; get BASIC execute pointer low byte BNE LAB_1B34 ; branch if no underflow DEC Bpntrh ; else decrement BASIC execute pointer high byte LAB_1B34 DEC Bpntrl ; decrement BASIC execute pointer low byte LDY #(TK_LT-TK_PLUS)*3; set offset to last operator entry STA comp_f ; save new compare function flag BNE LAB_1B13 ; branch always LAB_1B3C CMP LAB_OPPT,Y ;.compare with stacked function precedence BCS LAB_1B86 ; branch if A >=, pop FAC2 & return BCC LAB_1B1C ; branch always ;.get vector, execute function then continue evaluation LAB_1B43 LDA LAB_OPPT+2,Y ; get function vector high byte PHA ; onto stack LDA LAB_OPPT+1,Y ; get function vector low byte PHA ; onto stack JSR LAB_1B56 ; function will return here, then the next RTS will call ; the function LDA comp_f ; get compare function flag JMP LAB_1ACC ; continue evaluating expression LAB_1B53 JMP LAB_SNER ; do syntax error, then warm start LAB_1B56 LDA FAC1_s ; get FAC1 sign (b7) LDX LAB_OPPT,Y ; get precedence byte ; push sign, round FAC1 & put on stack LAB_1B5B TAY ; copy sign PLA ; get return addr low byte STA ut1_pl ; save it INC ut1_pl ; 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 ut1_ph ; save it TYA ; restore sign PHA ; push sign ; round FAC1 & put on stack LAB_1B66 JSR LAB_27BA ; round FAC1 LDA FAC1_3 ; get FAC1 mantissa3 PHA ; push on stack LDA FAC1_2 ; get FAC1 mantissa2 PHA ; push on stack LDA FAC1_1 ; get FAC1 mantissa1 PHA ; push on stack LDA FAC1_e ; get FAC1 exponent PHA ; push on stack JMP (ut1_pl) ; return, sort of ; do functions LAB_1B78 LDY #$FF ; PLA ; pull precedence byte LAB_1B7B BEQ LAB_1B9D ; exit if done LAB_1B7D CMP #$64 ; compare previous precedence with $64 BEQ LAB_1B84 ; branch if was $64 (< function) JSR LAB_CTNM ; check if source is numeric, else do type mismatch LAB_1B84 STY prstk ; save precedence stacked flag ; pop FAC2 & return LAB_1B86 PLA ; pop byte LSR A ; shift out comparison evaluation lowest bit STA Cflag ; save comparison evaluation flag PLA ; pop exponent STA FAC2_e ; save FAC2 exponent PLA ; pop mantissa1 STA FAC2_1 ; save FAC2 mantissa1 PLA ; pop mantissa2 STA FAC2_2 ; save FAC2 mantissa2 PLA ; pop mantissa3 STA FAC2_3 ; save FAC2 mantissa3 PLA ; pop sign STA FAC2_s ; save FAC2 sign (b7) EOR FAC1_s ; EOR FAC1 sign (b7) STA FAC_sc ; save sign compare (FAC1 EOR FAC2) LAB_1B9D LDA FAC1_e ; get FAC1 exponent RTS ; ; get value from line LAB_GVAL LDA #$00 ; clear byte STA Dtypef ; clear data type flag, $FF=string, $00=numeric LAB_1BA4 .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BCS LAB_1BAC ; branch if not numeric character ; else numeric string found (e.g. 123) LAB_1BA9 JMP LAB_2887 ; get FAC1 from string & return ; get value from line .. continued ; wasn't a number so ... LAB_1BAC ; this is the hook for get value from line, it catches the number check to include ; numbers starting with "$" and "%" CMP #'$ ; compare with "$" BEQ LAB_1BA9 ; branch if "$", hex number CMP #'% ; else compare with "%" BEQ LAB_1BA9 ; branch if "%", binary number JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" BCS LAB_1C18 ; get (var), return value in FAC1 & $ flag ; wasn't variable name so ... CMP #$2E ; compare with "." BEQ LAB_1BA9 ; if so get FAC1 from string & return (e.g. was .123) ; wasn't .123 so ... CMP #TK_MINUS ; compare with token for - BEQ LAB_1C11 ;.branch if - token (do set-up for functions) ; wasn't -123 so ... CMP #TK_PLUS ; compare with token for + BEQ LAB_1BA4 ; branch if + token (+1 = 1 so ignore leading +) ; it wasn't any sort of number so ... CMP #$22 ; compare with " BNE LAB_1BD0 ; branch if not open quote ; was open quote so get the enclosed string ; print "..." string to string util area LAB_1BC1 LDA Bpntrl ; get BASIC execute pointer low byte LDY Bpntrh ; get BASIC execute pointer high byte ADC #$00 ; add carry to low byte BCC LAB_1BCA ; branch if no overflow INY ; increment high byte LAB_1BCA JSR LAB_20AE ; print " terminated string to Sutill/Sutilh JMP LAB_23F3 ; restore BASIC execute pointer from temp & return ; get value from line .. continued ; wasn't a string so ... LAB_1BD0 CMP #TK_NOT ; compare with token for NOT BNE LAB_1BE7 ; branch if not token for NOT ; was NOT token LDY #(TK_EQUAL-TK_PLUS)*3 ; offset to NOT function BNE LAB_1C13 ; do set-up for function then execute (branch always) ; do = compare LAB_EQUAL JSR LAB_EVIR ; evaluate integer expression (no sign check) LDA FAC1_3 ; get FAC1 mantissa3 EOR #$FF ; invert it TAY ; copy it LDA FAC1_2 ; get FAC1 mantissa2 EOR #$FF ; invert it JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET ; get value from line .. continued ; wasn't a string or NOT so ... LAB_1BE7 CMP #TK_FN ; compare with token for FN BNE LAB_1BEE ; branch if not token for FN JMP LAB_201E ; go evaluate FNx ; get value from line .. continued ; wasn't a string, NOT or FN so ... LAB_1BEE CMP #TK_SGN ; compare with token for SGN BCC LAB_1BF5 ; branch if less than SGN token ; else was a function token BCS LAB_1C27 ; 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_1BF5 JSR LAB_1BFE ; scan for "(" , else do syntax error, then warm start JSR LAB_EVEX ; evaluate expression ; all the 'scan for' routines return the character after the sought character ; scan for ")" , else do syntax error, then warm start LAB_1BFB LDA #$29 ; load A with ")" .byte $2C ; makes next line BIT $28A9 ; scan for "(" , else do syntax error, then warm start LAB_1BFE LDA #$28 ; load A with "(" .byte $2C ; makes next line BIT $2CA9 ; scan for "," , else do syntax error, then warm start LAB_1C01 LDA #$2C ; load A with "," ; scan for CHR$(A) , else do syntax error, then warm start LAB_SCCA LDY #$00 ; clear index CMP (Bpntrl),Y ; check next byte is = A BNE LAB_SNER ; if not do syntax error, then warm start JMP LAB_IGBY ; increment & scan memory then return ; syntax error, then warm start LAB_SNER LDX #$02 ; error code $02 ("Syntax" error) JMP LAB_XERR ; do error #X, then warm start ; set-up for functions LAB_1C11 LDY #(TK_GT-TK_PLUS)*3; set offset from base to > operator LAB_1C13 PLA ;. PLA ;. JMP LAB_1B1D ;. ; variable name set-up ; get (var), return value in FAC_1 & $ flag LAB_1C18 JSR LAB_GVAR ; get (var) address STA FAC1_2 ; save address low byte in FAC1 mantissa2 STY FAC1_3 ; save address high5^ byte in FAC1 mantissa3 LDX Dtypef ; get data type flag, $FF=string, $00=numeric BNE LAB_1C25 ; if string then return (does RTS) LAB_1C24 JMP LAB_UFAC ; unpack memory (AY) into FAC1 LAB_1C25 RTS ; get value from line .. continued ; only functions left so ... ; set up function references LAB_1C27 ASL A ; *2 (2 bytes per function address) PHA ; save function offset TAX ; copy function offset .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory CPX #(TK_CHRS-$80)*2+1; compare function offset to CHR$ token offset+1 BCC LAB_1C51 ; branch if =2^24 (is too big) JSR LAB_2831 ; convert FAC1 floating-to-fixed LDX #$02 ; 3 bytes to do LAB_CFAC LDA FAC1_1,X ; get byte from FAC1 STA nums_1,X ; save byte to temp DEX ; decrement index BPL LAB_CFAC ; copy FAC1 mantissa to temp .BYTE $20, LAB_GBYT, $00 ;JSR LAB_GBYT ; get next BASIC byte LDX #$00 ; set default to no leading "0"s CMP #') ; compare with close bracket BEQ LAB_1C54 ; if ")" go do rest of function JSR LAB_SCGB ; scan for "," and get byte CMP #') ; is next character ) BEQ LAB_1C54 ; if ")" go do rest of function LAB_BHER JMP LAB_FCER ; do function call error, then warm start ; get value from line .. continued ; was SGN() to CHR$() so.. LAB_1C51 JSR LAB_1BF5 ; evaluate expression within parentheses ; enter here if VARPTR(), MAX() or MIN() LAB_1C54 PLA ; restore function offset TAY ; copy to index LAB_1C56 LDA LAB_FTBL,Y ; get function jump vector low byte STA Fnxjpl ; save functions jump vector low byte LDA LAB_FTBM,Y ; get function jump vector high byte STA Fnxjph ; save functions jump vector high byte .BYTE $20, Fnxjmp, $00 ;JSR Fnxjmp ; do function call JMP LAB_CTNM ; check if source is numeric & RTS, else do type mismatch ; perform EOR ; added operator format is the same as AND or OR, precedence is the same as OR ; this bit worked first time but it took a while to sort out the operator table ; pointers & offsets afterwards! LAB_EOR JSR GetFirst ; get first integer expression (no sign check) EOR XOAw_l ; EOR with expression 1 low byte TAY ; save in Y LDA FAC1_2 ; get FAC1 mantissa2 EOR XOAw_h ; EOR with expression 1 high byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET ; perform OR LAB_OR JSR GetFirst ; get first integer expression (no sign check) ORA XOAw_l ; OR with expression 1 low byte TAY ; save in Y LDA FAC1_2 ; get FAC1 mantissa2 ORA XOAw_h ; OR with expression 1 high byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET ; perform AND LAB_AND JSR GetFirst ; get first integer expression (no sign check) AND XOAw_l ; AND with expression 1 low byte TAY ; save in Y LDA FAC1_2 ; get FAC1 mantissa2 AND XOAw_h ; AND with expression 1 high byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET ; get first value for OR, AND or EOR GetFirst JSR LAB_EVIR ; evaluate integer expression (no sign check) LDA FAC1_2 ; get FAC1 mantissa2 STA XOAw_h ; save it LDA FAC1_3 ; get FAC1 mantissa3 STA XOAw_l ; save it JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression) JSR LAB_EVIR ; evaluate integer expression (no sign check) LDA FAC1_3 ; get FAC1 mantissa3 LAB_1C95 RTS ; ; perform comparisons ; do < compare LAB_LTHAN JSR LAB_CKTM ; type match check, set C for string BCS LAB_1CAE ; branch if string ; do numeric < compare LDA FAC2_s ; get FAC2 sign (b7) ORA #$7F ; set all non sign bits AND FAC2_1 ; and FAC2 mantissa1 (AND in sign bit) STA FAC2_1 ; save FAC2 mantissa1 LDA #FAC2_e ; set pointer high byte to FAC2 JSR LAB_27F8 ; compare FAC1 with FAC2 (AY) TAX ; copy result JMP LAB_1CE1 ;. ; do string < compare LAB_1CAE LDA #$00 ; clear byte STA Dtypef ; clear data type flag, $FF=string, $00=numeric DEC comp_f ; clear < bit in compare function flag JSR LAB_22B6 ; 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 STA str_ln ; save length STX str_pl ; save string pointer low byte STY str_ph ; save string pointer high byte LDA FAC2_2 ;.get descriptor pointer low byte LDY FAC2_3 ;.get descriptor pointer high byte JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=ut1_pl=pointer low byte, ; Y=ut1_ph=pointer high byte STX FAC2_2 ; save string pointer low byte STY FAC2_3 ; save string pointer high byte TAX ; copy length SEC ; set carry for subtract SBC str_ln ;.subtract string 1 length BEQ LAB_1CD6 ; branch if strings = length LDA #$01 ;. BCC LAB_1CD6 ;. LDX str_ln ;.get string 1 length LDA #$FF ;. LAB_1CD6 STA FAC1_s ; save FAC1 sign (b7) LDY #$FF ;. INX ;. LAB_1CDB INY ;. DEX ;. BNE LAB_1CE6 ;. LDX FAC1_s ; get FAC1 sign (b7) LAB_1CE1 BMI LAB_1CF2 ;. CLC ;. BCC LAB_1CF2 ;. LAB_1CE6 LDA (FAC2_2),Y ;. CMP (FAC1_1),Y ;. BEQ LAB_1CDB ;. LDX #$FF ;. BCS LAB_1CF2 ;. LDX #$01 ;. LAB_1CF2 INX ;. TXA ;. ROL A ;. AND Cflag ; AND with comparison evaluation flag BEQ LAB_1CFB ;. LDA #$FF ;. LAB_1CFB JMP LAB_27DB ; save A as integer byte & return LAB_1CFE JSR LAB_1C01 ; scan for "," , else do syntax error, then warm start ; perform DIM LAB_DIM TAX ; copy "DIM" flag to X JSR LAB_1D10 ; search for variable .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BNE LAB_1CFE ; scan for "," and loop if not null RTS ; ; perform << (left shift) LAB_LSHIFT JSR GetPair ; get integer expression & byte (no sign check) LDA FAC1_2 ; get expression high byte LDX TempB ; get shift count BEQ NoShift ; branch if zero CPX #$10 ; compare bit count with 16d BCS TooBig ; branch if >= Ls_loop ASL FAC1_3 ; shift low byte ROL ; shift high byte DEX ; decrement bit count BNE Ls_loop ; loop if shift not complete LDY FAC1_3 ; get expression low byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET ; perform >> (right shift) LAB_RSHIFT JSR GetPair ; get integer expression & byte (no sign check) LDA FAC1_2 ; get expression high byte LDX TempB ; get shift count BEQ NoShift ; branch if zero CPX #$10 ; compare bit count with 16d BCS TooBig ; branch if >= Rs_loop LSR ; shift high byte ROR FAC1_3 ; shift low byte DEX ; decrement bit count BNE Rs_loop ; loop if shift not complete NoShift LDY FAC1_3 ; get expression low byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET TooBig LDA #$00 ; clear high byte TAY ; copy to low byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & RET GetPair JSR LAB_EVBY ; evaluate byte expression, result in X STX TempB ; save it JSR LAB_279B ; copy FAC2 to FAC1 (get 2nd value in expression) JSR LAB_EVIR ; evaluate integer expression (no sign check) RTS ; ; search for variable ; return pointer to variable in Cvaral/Cvarah LAB_GVAR LDX #$00 ; set DIM flag = $00 .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory (1st character) LAB_1D10 STX Defdim ; save DIM flag LAB_1D12 STA Varnm1 ; save 1st character JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" BCS LAB_1D1F ; branch if ok JMP LAB_SNER ; else syntax error, then warm start ; was variable name so ... LAB_1D1F LDX #$00 ; clear 2nd character temp STX Dtypef ; clear data type flag, $FF=string, $00=numeric .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory (2nd character) BCC LAB_1D2D ; branch if character = "0"-"9" (ok) ; 2nd character wasn't "0" to "9" so ... JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" BCC LAB_1D38 ; branch if <"A" or >"Z" (go check if string) LAB_1D2D TAX ; copy 2nd character ; ignore further (valid) characters in the variable name LAB_1D2E .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory (3rd character) BCC LAB_1D2E ; loop if character = "0"-"9" (ignore) JSR LAB_CASC ; check byte, return C=0 if<"A" or >"Z" BCS LAB_1D2E ; loop if character = "A"-"Z" (ignore) ; check if string variable LAB_1D38 CMP #$24 ; compare with "$" BNE LAB_1D47 ; branch if not string ; to introduce a new variable type (% suffix for integers say) then this branch ; will need to go to that check and then that branch, if it fails, go to LAB_1D47 ; type is string LDA #$FF ; set data type = string STA Dtypef ; set data type flag, $FF=string, $00=numeric TXA ; get 2nd character back ORA #$80 ; set top bit (indicate string var) TAX ; copy back to 2nd character temp .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory ; after we have determined the variable type we need to come back here to determine ; if it's an array of type. this would plug in a%(b[,c[,d]])) integer arrays nicely LAB_1D47 ; gets here with character after var name in A STX Varnm2 ; save 2nd character SEC ; set carry for subtract ORA Sufnxf ; or with subscript/FNX flag (or FN name) SBC #$28 ; subtract "(" BNE LAB_1D53 ; branch if not "(" JMP LAB_1E17 ; go find, or make, array ; either find or create var ; var name (1st two characters only!) is in Varnm1,Varnm2 ; variable name wasn't var(.... so look for plain var LAB_1D53 LDA #$00 ; clear A STA Sufnxf ; clear subscript/FNX flag LDA Svarl ; get start of vars low byte LDX Svarh ; get start of vars high byte LDY #$00 ; clear index LAB_1D5D STX Vrschh ; save search address high byte LAB_1D5F STA Vrschl ; save search address low byte CPX Sarryh ; compare high address with var space end BNE LAB_1D69 ; skip next compare if <> ; high addresses were = so compare low addresses CMP Sarryl ; compare low address with var space end BEQ LAB_1D8B ; if not found go make new var LAB_1D69 LDA Varnm1 ; get 1st character of var to find CMP (Vrschl),Y ; compare with variable name 1st character BNE LAB_1D77 ; branch if no match ; 1st characters match so compare 2nd characters LDA Varnm2 ; get 2nd character of var to find INY ; index to point to variable name 2nd character CMP (Vrschl),Y ; compare with variable name 2nd character BEQ LAB_1DD7 ; branch if match (found var) DEY ; else decrement index (now = $00) LAB_1D77 CLC ; clear carry for add LDA Vrschl ; get search address low byte ADC #$06 ; +6 (offset to next var name) BCC LAB_1D5F ; loop if no overflow to high byte INX ; else increment high byte BNE LAB_1D5D ; loop always (RAM doesn't extend to $FFFF !) ; check byte, return C=0 if<"A" or >"Z" or "a" to "z" LAB_CASC CMP #$61 ; compare with "a" BCS LAB_1D83 ; go check <"z"+1 ; check byte, return C=0 if<"A" or >"Z" LAB_1D82 CMP #$41 ; compare with "A" BCC LAB_1D8A ; exit if less ; carry is set SBC #$5B ; subtract "Z"+1 SEC ; set carry SBC #$A5 ; subtract $A5 (restore byte) ; carry clear if byte>$5A LAB_1D8A RTS ; LAB_1D83 SBC #$7B ; subtract "z"+1 SEC ; set carry SBC #$85 ; subtract $A5 (restore byte) ; carry clear if byte>$7A RTS ; ; reached end of variable mem without match ; ... so create new variable LAB_1D8B PLA ; pop return address low byte PHA ; push return address low byte CMP #LAB_1D96 ; high byte point to $00,$00 RTS ; ; create new numeric variable LAB_1D98 LDA Sarryl ; get var mem end low byte LDY Sarryh ; get var mem end high byte STA Ostrtl ; save old block start low byte STY Ostrth ; save old block start high byte LDA Earryl ; get array mem end low byte LDY Earryh ; get array mem end high byte STA Obendl ; save old block end low byte STY Obendh ; save old block end high byte CLC ; clear carry for add ADC #$06 ; +6 (space for one var) BCC LAB_1DAE ; branch if no overflow to high byte INY ; else increment high byte LAB_1DAE STA Nbendl ; set new block end low byte STY Nbendh ; set new block end high byte JSR LAB_11CF ; open up space in memory LDA Nbendl ; get new start low byte LDY Nbendh ; get new start high byte (-$100) INY ; correct high byte STA Sarryl ; save new var mem end low byte STY Sarryh ; save new var mem end high byte LDY #$00 ; clear index LDA Varnm1 ; get var name 1st character STA (Vrschl),Y ; save var name 1st character INY ; increment index LDA Varnm2 ; get var name 2nd character STA (Vrschl),Y ; save var name 2nd character LDA #$00 ; clear A INY ; increment index STA (Vrschl),Y ; initialise var byte INY ; increment index STA (Vrschl),Y ; initialise var byte INY ; increment index STA (Vrschl),Y ; initialise var byte INY ; increment index STA (Vrschl),Y ; initialise var byte ; found a match for var ((Vrschl) = ptr) LAB_1DD7 LDA Vrschl ; get var address low byte CLC ; clear carry for add ADC #$02 ; +2 (offset past var name bytes) LDY Vrschh ; get var address high byte BCC LAB_1DE1 ; branch if no overflow from add INY ; else increment high byte LAB_1DE1 STA Cvaral ; save current var address low byte STY Cvarah ; save current var address high byte RTS ; ; set-up array pointer (Adatal/h) to first element in array ; set Adatal,Adatah to Astrtl,Astrth+2*Dimcnt+#$05 LAB_1DE6 LDA Dimcnt ; get # of dimensions (1, 2 or 3) ASL A ; *2 (also clears the carry !) ADC #$05 ; +5 (result is 7, 9 or 11 here) ADC Astrtl ; add array start pointer low byte LDY Astrth ; get array pointer high byte BCC LAB_1DF2 ; branch if no overflow INY ; else increment high byte LAB_1DF2 STA Adatal ; save array data pointer low byte STY Adatah ; save array data pointer high byte RTS ; ; evaluate integer expression LAB_EVIN .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch ; evaluate integer expression (no check) LAB_EVPI LDA FAC1_s ; get FAC1 sign (b7) BMI LAB_1E12 ; do function call error if -ve ; evaluate integer expression (no sign check) LAB_EVIR LDA FAC1_e ; get FAC1 exponent CMP #$90 ; compare with exponent = 2^16 (n>2^15) BCC LAB_1E14 ; branch if n<2^16 (is ok) LDA #LAB_1DF7 ; set pointer high byte to -32768 JSR LAB_27F8 ; compare FAC1 with (AY) LAB_1E12 BNE LAB_FCER ; if <> do function call error, then warm start LAB_1E14 JMP LAB_2831 ; convert FAC1 floating-to-fixed & RET ; find or make array LAB_1E17 LDA Defdim ; get DIM flag PHA ; push it LDA Dtypef ; 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_1E1F TYA ; copy dimensions count PHA ; save it LDA Varnm2 ; get array name 2nd byte PHA ; save it LDA Varnm1 ; get array name 1st byte PHA ; save it JSR LAB_EVIN ; evaluate integer expression PLA ; pull array name 1st byte STA Varnm1 ; restore array name 1st byte PLA ; pull array name 2nd byte STA Varnm2 ; restore array name 2nd byte PLA ; pull dimensions count TAY ; restore it TSX ; copy stack pointer LDA LAB_STAK+2,X ; get DIM flag PHA ; push it LDA LAB_STAK+1,X ; get data type flag PHA ; push it LDA FAC1_2 ; get this dimension size high byte STA LAB_STAK+2,X ; stack before flag bytes LDA FAC1_3 ; get this dimension size low byte STA LAB_STAK+1,X ; stack before flag bytes INY ; increment dimensions count .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory CMP #$2C ; compare with "," BEQ LAB_1E1F ; if found go do next dimension STY Dimcnt ; store dimensions count JSR LAB_1BFB ; scan for ")" , else do syntax error, then warm start PLA ; pull data type flag STA Dtypef ; restore data type flag, $FF=string, $00=numeric PLA ; pull DIM flag STA Defdim ; restore DIM flag LDX Sarryl ; get array mem start low byte LDA Sarryh ; 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_1E5C STX Astrtl ; save as array start pointer low byte STA Astrth ; save as array start pointer high byte CMP Earryh ; compare with array mem end high byte BNE LAB_1E68 ; branch if not reached array mem end CPX Earryl ; else compare with array mem end low byte BEQ LAB_1EA1 ; go build array if not found ; search for array LAB_1E68 LDY #$00 ; clear index LDA (Astrtl),Y ; get array name first byte INY ; increment index to second name byte CMP Varnm1 ; compare with this array name first byte BNE LAB_1E77 ; branch if no match LDA Varnm2 ; else get this array name second byte CMP (Astrtl),Y ; compare with array name second byte BEQ LAB_1E8D ; array found so branch ; no match LAB_1E77 INY ; increment index LDA (Astrtl),Y ; get array size low byte CLC ; clear carry for add ADC Astrtl ; add array start pointer low byte TAX ; copy low byte to X INY ; increment index LDA (Astrtl),Y ; get array size high byte ADC Astrth ; add array mem pointer high byte BCC LAB_1E5C ; if no overflow go check next array ; do array bounds error LAB_1E85 LDX #$10 ; error code $10 ("Array bounds" error) .byte $2C ; makes next bit BIT LAB_08A2 ; do function call error LAB_FCER LDX #$08 ; error code $08 ("Function call" error) LAB_1E8A JMP LAB_XERR ; do error #X, then warm start ; found array, are we trying to dimension it? LAB_1E8D LDX #$12 ; set error $12 ("Double dimension" error) LDA Defdim ; get DIM flag BNE LAB_1E8A ; 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_1DE6 ; set-up array pointer (Adatal/h) to first element in array ; (Astrtl,Astrth points to start of array) LDA Dimcnt ; get dimensions count LDY #$04 ; set index to array's # of dimensions CMP (Astrtl),Y ; compare with no of dimensions BNE LAB_1E85 ; if wrong do array bounds error (could do "Wrong dimensions" ; error here .. if we want another, different, error message) JMP LAB_1F28 ; found array so go get element ; (could jump to LAB_1F28 as all LAB_1F24 does is take Dimcnt ; and save it at (Astrtl),Y which is already the same or we ; would have taken the BNE) ; array not found, so build it LAB_1EA1 JSR LAB_1DE6 ; set-up array pointer (Adatal/h) to first element in array ; (Astrtl,Astrth points to start of array) JSR LAB_121F ; check available memory, "Out of memory" error if no room ; addr to check is in AY (low/high) LDY #$00 ; clear Y (don't need to clear A) STY Aspth ; clear array data size high byte LDA Varnm1 ; get variable name 1st byte STA (Astrtl),Y ; save array name 1st byte INY ; increment index LDA Varnm2 ; get variable name 2nd byte STA (Astrtl),Y ; save array name 2nd byte LDA Dimcnt ; get dimensions count LDY #$04 ; index to dimension count STY Asptl ; set array data size low byte (four bytes per element) STA (Astrtl),Y ; set array's dimensions count ; now calculate the size of the data space for the array CLC ; clear carry for add (clear on subsequent loops) LAB_1EC0 LDX #$0B ; set default dimension value low byte LDA #$00 ; set default dimension value high byte BIT Defdim ; test default DIM flag BVC LAB_1ED0 ; branch if b6 of Defdim is clear PLA ; else pull dimension value low byte 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_1ED0 INY ; index to dimension value high byte STA (Astrtl),Y ; save dimension value high byte INY ; index to dimension value high byte TXA ; get dimension value low byte STA (Astrtl),Y ; save dimension value low byte JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl) STX Asptl ; save array data size low byte STA Aspth ; save array data size high byte LDY ut1_pl ; restore index (saved by subroutine) DEC Dimcnt ; decrement dimensions count BNE LAB_1EC0 ; loop while not = 0 ADC Adatah ; add size high byte to first element high byte ; (carry is always clear here) BCS LAB_1F45 ; if overflow go do "Out of memory" error STA Adatah ; save end of array high byte TAY ; copy end high byte to Y TXA ; get array size low byte ADC Adatal ; add array start low byte BCC LAB_1EF3 ; branch if no carry INY ; else increment end of array high byte BEQ LAB_1F45 ; if overflow go do "Out of memory" error ; set-up mostly complete, now zero the array LAB_1EF3 JSR LAB_121F ; check available memory, "Out of memory" error if no room ; addr to check is in AY (low/high) STA Earryl ; save array mem end low byte STY Earryh ; save array mem end high byte LDA #$00 ; clear byte for array clear INC Aspth ; increment array size high byte (now block count) LDY Asptl ; get array size low byte (now index to block) BEQ LAB_1F07 ; branch if low byte = $00 LAB_1F02 DEY ; decrement index (do 0 to n-1) STA (Adatal),Y ; zero byte BNE LAB_1F02 ; loop until this block done LAB_1F07 DEC Adatah ; decrement array pointer high byte DEC Aspth ; decrement block count high byte BNE LAB_1F02 ; loop until all blocks done INC Adatah ; correct for last loop SEC ; set carry for subtract LDY #$02 ; index to array size low byte LDA Earryl ; get array mem end low byte SBC Astrtl ; subtract array start low byte STA (Astrtl),Y ; save array size low byte INY ; index to array size high byte LDA Earryh ; get array mem end high byte SBC Astrth ; subtract array start high byte STA (Astrtl),Y ; save array size high byte LDA Defdim ; get default DIM flag BNE LAB_1F7B ; exit (RET) if this was a DIM command ; else, find element INY ; index to # of dimensions LAB_1F24 LDA (Astrtl),Y ; get array's dimension count STA Dimcnt ; save it ; we have found, or built, the array. now we need to find the element LAB_1F28 LDA #$00 ; clear byte STA Asptl ; clear array data pointer low byte LAB_1F2C STA Aspth ; 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 FAC1_2 ; save index low byte to FAC1 mantissa2 PLA ; pull array index high byte STA FAC1_3 ; save index high byte to FAC1 mantissa3 CMP (Astrtl),Y ; compare with array bound high byte BCC LAB_1F48 ; branch if within bounds BNE LAB_1F42 ; 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 (Astrtl),Y ; compare with array bound low byte BCC LAB_1F49 ; branch if within bounds LAB_1F42 JMP LAB_1E85 ; else do array bounds error LAB_1F45 JMP LAB_OMER ; do "Out of memory" error, then warm start LAB_1F48 INY ; index to array bound low byte LAB_1F49 LDA Aspth ; get array data pointer high byte ORA Asptl ; OR with array data pointer low byte CLC ; clear carry for either add BEQ LAB_1F5A ; branch if array data pointer = null (skip multiply) JSR LAB_1F7C ; does XY = (Astrtl),Y * (Asptl) TXA ; get result low byte ADC FAC1_2 ; add index low byte from FAC1 mantissa2 TAX ; save result low byte TYA ; get result high byte LDY ut1_pl ; restore index LAB_1F5A ADC FAC1_3 ; add index high byte from FAC1 mantissa3 STX Asptl ; save array data pointer low byte DEC Dimcnt ; decrement dimensions count BNE LAB_1F2C ; loop if dimensions still to do ASL Asptl ; array data pointer low byte * 2 ROL A ; array data pointer high byte * 2 ASL Asptl ; array data pointer low byte * 4 ROL A ; array data pointer high byte * 4 TAY ; copy high byte LDA Asptl ; get low byte ADC Adatal ; add array data start pointer low byte STA Cvaral ; save as current var address low byte TYA ; get high byte back ADC Adatah ; add array data start pointer high byte STA Cvarah ; save as current var address high byte TAY ; copy high byte to Y LDA Cvaral ; get current var address low byte LAB_1F7B RTS ; ; does XY = (Astrtl),Y * (Asptl) LAB_1F7C STY ut1_pl ; save index LDA (Astrtl),Y ; get dimension size low byte STA dims_l ; save dimension size low byte DEY ; decrement index LDA (Astrtl),Y ; get dimension size high byte STA dims_h ; save dimension size high byte LDA #$10 ; count = $10 (16 bit multiply) STA numbit ; save bit count LDX #$00 ; clear result low byte LDY #$00 ; clear result high byte LAB_1F8F TXA ; get result low byte ASL A ; *2 TAX ; save result low byte TYA ; get result high byte ROL A ; *2 TAY ; save result high byte BCS LAB_1F45 ; if overflow go do "Out of memory" error ASL Asptl ; shift multiplier low byte ROL Aspth ; shift multiplier high byte BCC LAB_1FA8 ; skip add if no carry CLC ; else clear carry for add TXA ; get result low byte ADC dims_l ; add dimension size low byte TAX ; save result low byte TYA ; get result high byte ADC dims_h ; add dimension size high byte TAY ; save result high byte BCS LAB_1F45 ; if overflow go do "Out of memory" error LAB_1FA8 DEC numbit ; decrement bit count BNE LAB_1F8F ; loop until all done RTS ; ; perform FRE() LAB_FRE LDA Dtypef ; get data type flag, $FF=string, $00=numeric BEQ LAB_1FB4 ; branch if numeric JSR LAB_22B6 ; pop string off descriptor stack, or from top of string ; space returns with A = length, X=$71=pointer low byte, ; Y=$72=pointer high byte ; FRE(n) was numeric so do this LAB_1FB4 JSR LAB_GARB ; go do garbage collection SEC ; set carry for subtract LDA Sstorl ; get bottom of string space low byte SBC Earryl ; subtract array mem end low byte TAY ; copy result to Y LDA Sstorh ; get bottom of string space high byte SBC Earryh ; subtract array mem end high byte ; save & convert integer AY to FAC1 LAB_AYFC LDX #$00 ; set type = numeric STX Dtypef ; clear data type flag, $FF=string, $00=numeric STA FAC1_1 ; save FAC1 mantissa1 STY FAC1_2 ; save FAC1 mantissa2 LDX #$90 ; set exponent=2^16 (integer) JMP LAB_27E3 ; set exp=X, clearFAC1_3, normalise & RET ; perform POS() LAB_POS LDY TPos ; get terminal position ; convert Y to byte in FAC1 LAB_1FD0 LDA #$00 ; clear high byte BEQ LAB_AYFC ; always save & convert integer AY to FAC1 & RET ; check not Direct (used by DEF and INPUT) LAB_CKRN LDX Clineh ; get current line high byte INX ; increment it BNE LAB_1F7B ; return if can continue not direct mode ; else do illegal direct error LAB_1FD9 LDX #$16 ; error code $16 ("Illegal direct" error) LAB_1FDB JMP LAB_XERR ; go do error #X, then warm start ; perform DEF LAB_DEF JSR LAB_200B ; check FNx syntax JSR LAB_CKRN ; check not Direct (back here if ok) JSR LAB_1BFE ; scan for "(" , else do syntax error, then warm start LDA #$80 ; set flag for FNx STA Sufnxf ; save subscript/FNx flag JSR LAB_GVAR ; get (var) address JSR LAB_CTNM ; check if source is numeric, else do type mismatch JSR LAB_1BFB ; scan for ")" , else do syntax error, then warm start LDA #TK_EQUAL ; get = token JSR LAB_SCCA ; scan for CHR$(A), else do syntax error, then warm start LDA Cvarah ; get current var address high byte PHA ; push it LDA Cvaral ; get current var address low byte PHA ; push it LDA Bpntrh ; get BASIC execute pointer high byte PHA ; push it LDA Bpntrl ; get BASIC execute pointer low byte PHA ; push it JSR LAB_DATA ; go perform DATA JMP LAB_207A ; put execute pointer and variable pointer into function ; & return ; check FNx syntax LAB_200B LDA #TK_FN ; get FN" token JSR LAB_SCCA ; scan for CHR$(A) , else do syntax error, then warm start ; return character after A ORA #$80 ; set FN flag bit STA Sufnxf ; save FN name AND #$7F ; clear FN flag bit JSR LAB_1D12 ; search for FN variable STA func_l ; save function pointer low byte STY func_h ; save function pointer high byte JMP LAB_CTNM ; check if source is numeric & return, else do type mismatch ; Evaluate FNx LAB_201E JSR LAB_200B ; check FNx syntax LDA func_h ; get function pointer high byte PHA ; push it LDA func_l ; get function pointer low byte PHA ; push it JSR LAB_1BF5 ; evaluate expression within parentheses JSR LAB_CTNM ; check if source is numeric, else do type mismatch PLA ; pop function pointer low byte STA func_l ; restore it PLA ; pop function pointer high byte STA func_h ; restore it LDX #$20 ; error code $20 ("Undefined function" error) LDY #$03 ; index to variable pointer high byte LDA (func_l),Y ; get variable pointer high byte BEQ LAB_1FDB ; if zero go do undefined function error STA Cvarah ; save variable address high byte DEY ; index to variable address low byte LDA (func_l),Y ; get variable address low byte STA Cvaral ; save variable address low byte TAX ; copy address low byte ; now stack the function variable value before use INY ; index to mantissa_3 LAB_2043 LDA (Cvaral),Y ; get byte from variable PHA ; stack it DEY ; decrement index BPL LAB_2043 ; loop until variable stacked LDY Cvarah ; get variable address high byte JSR LAB_2778 ; pack FAC1 (function expression value) into (XY) ; (function variable), return Y=0, always LDA Bpntrh ; get BASIC execute pointer high byte PHA ; push it LDA Bpntrl ; get BASIC execute pointer low byte PHA ; push it LDA (func_l),Y ; get function execute pointer low byte STA Bpntrl ; save as BASIC execute pointer low byte INY ; index to high byte LDA (func_l),Y ; get function execute pointer high byte STA Bpntrh ; save as BASIC execute pointer high byte LDA Cvarah ; get variable address high byte PHA ; push it LDA Cvaral ; get variable address low byte PHA ; push it JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch PLA ; pull variable address low byte STA func_l ; save variable address low byte PLA ; pull variable address high byte STA func_h ; save variable address high byte .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory BEQ LAB_2074 ; branch if null (should be [EOL] marker) JMP LAB_SNER ; else syntax error, then warm start ; restore Bpntrl,Bpntrh & function variable from stack LAB_2074 PLA ; pull BASIC execute pointer low byte STA Bpntrl ; restore BASIC execute pointer low byte PLA ; pull BASIC execute pointer high byte STA Bpntrh ; restore BASIC execute pointer high byte ; put execute pointer and variable pointer into function LAB_207A LDY #$00 ; clear index PLA ; pull BASIC execute pointer low byte STA (func_l),Y ; save to function INY ; increment index PLA ; pull BASIC execute pointer high byte STA (func_l),Y ; save to function INY ; increment index PLA ; pull current var address low byte STA (func_l),Y ; save to function INY ; increment index PLA ; pull current var address high byte STA (func_l),Y ; save to function RTS ; ; perform STR$() LAB_STRS JSR LAB_CTNM ; check if source is numeric, else do type mismatch LDY #$00 ; set string index JSR LAB_2970 ; convert FAC1 to string PLA ; dump return address (return via get value from line) PLA ; dump return address LDA #<(Decss+1) ; set result string low pointer LDY #>(Decss+1) ; set result string high pointer BEQ LAB_20AE ; print null terminated string to Sutill/Sutilh ; Do string vector ; copy des_pl/h to des_2l/h & make string space A bytes long LAB_209C LDX des_pl ; get descriptor pointer low byte LDY des_ph ; get descriptor pointer high byte STX des_2l ; save descriptor pointer low byte STY des_2h ; save descriptor pointer high byte ; make string space A bytes long ; A=length, X=Sutill=ptr low byte, Y=Sutilh=ptr high byte LAB_MSSP JSR LAB_2115 ; make space in string memory for string A long ; return X=Sutill=ptr low byte, Y=Sutilh=ptr high byte STX str_pl ; save string pointer low byte STY str_ph ; save string pointer high byte STA str_ln ; save length RTS ; ; Scan, set up string ; print " terminated string to Sutill/Sutilh LAB_20AE LDX #$22 ; set terminator to " STX Srchc ; set search character (terminator 1) STX Asrch ; set terminator 2 ; print [Srchc] or [Asrch] terminated string to Sutill/Sutilh ; source is AY LAB_20B4 STA ssptr_l ; store string start low byte STY ssptr_h ; store string start high byte STA str_pl ; save string pointer low byte STY str_ph ; save string pointer high byte LDY #$FF ; set length to -1 LAB_20BE INY ; increment length LDA (ssptr_l),Y ; get byte from string BEQ LAB_20CF ; exit loop if null byte [EOS] CMP Srchc ; compare with search character (terminator 1) BEQ LAB_20CB ; branch if terminator CMP Asrch ; compare with terminator 2 LAB_20C9 BNE LAB_20BE ; loop if not terminator 2 LAB_20CB CMP #$22 ; compare with " BEQ LAB_20D0 ; branch if " (carry set if = !) LAB_20CF CLC ; clear carry for add (only if [EOL] terminated string) LAB_20D0 STY str_ln ; save length in FAC1 exponent TYA ; copy length to A ADC ssptr_l ; add string start low byte STA Sendl ; save string end low byte LDX ssptr_h ; get string start high byte BCC LAB_20DC ; branch if no low byte overflow INX ; else increment high byte LAB_20DC STX Sendh ; save string end high byte LDA ssptr_h ; get string start high byte CMP #>Ram_base ; compare with start of program memory BCS LAB_RTST ; branch if not in utility area ; string in utility area, move to string memory TYA ; copy length to A JSR LAB_209C ; copy des_pl/h to des_2l/h & make string space A bytes long LDX ssptr_l ; get string start low byte LDY ssptr_h ; get string start high byte JSR LAB_2298 ; store string A bytes long from XY to (Sutill) ; check for space on descriptor stack then ... ; put string address and length on descriptor stack & update stack pointers LAB_RTST LDX next_s ; get string stack pointer CPX #$71 ; compare with max+1 BNE LAB_20F8 ; branch if space on string stack ; else do string too complex error LDX #$1C ; error code $1C ("String too complex" error) LAB_20F5 JMP LAB_XERR ; do error #X, then warm start ; put string address and length on descriptor stack & update stack pointers LAB_20F8 LDA str_ln ; get string length STA PLUS_0,X ; put on string stack LDA str_pl ; get string pointer low byte STA PLUS_1,X ; put on string stack LDA str_ph ; get string pointer high byte STA PLUS_2,X ; put on string stack LDY #$00 ; clear Y STX des_pl ; save string descriptor pointer low byte STY des_ph ; save string descriptor pointer high byte (always $00) DEY ; Y = $FF STY Dtypef ; save data type flag, $FF=string STX last_sl ; save old stack pointer (current top item) INX ; update stack pointer INX ; update stack pointer INX ; update stack pointer STX next_s ; save new top item value RTS ; ; Build descriptor ; make space in string memory for string A long ; return X=Sutill=ptr low byte, Y=Sutill=ptr high byte LAB_2115 LSR Gclctd ; clear garbage collected flag (b7) ; make space for string A long LAB_2117 PHA ; save string length EOR #$FF ; complement it SEC ; set carry for subtract (twos comp add) ADC Sstorl ; add bottom of string space low byte (subtract length) LDY Sstorh ; get bottom of string space high byte BCS LAB_2122 ; skip decrement if no underflow DEY ; decrement bottom of string space high byte LAB_2122 CPY Earryh ; compare with array mem end high byte BCC LAB_2137 ; do out of memory error if less BNE LAB_212C ; if not = skip next test CMP Earryl ; compare with array mem end low byte BCC LAB_2137 ; do out of memory error if less LAB_212C STA Sstorl ; save bottom of string space low byte STY Sstorh ; save bottom of string space high byte STA Sutill ; save string utility ptr low byte STY Sutilh ; save string utility ptr high byte TAX ; copy low byte to X PLA ; get string length back RTS ; LAB_2137 LDX #$0C ; error code $0C ("Out of memory" error) LDA Gclctd ; get garbage collected flag BMI LAB_20F5 ; if set then do error code X JSR LAB_GARB ; else go do garbage collection LDA #$80 ; flag for garbage collected STA Gclctd ; set garbage collected flag PLA ; pull length BNE LAB_2117 ; go try again (loop always, length should never be = $00) ; garbage collection routine LAB_GARB LDX Ememl ; get end of mem low byte LDA Ememh ; get end of mem high byte ; re-run routine from last ending LAB_214B STX Sstorl ; set string storage low byte STA Sstorh ; set string storage high byte LDY #$00 ; clear index STY garb_h ; clear working pointer high byte (flag no strings to move) LDA Earryl ; get array mem end low byte LDX Earryh ; get array mem end high byte STA Histrl ; save as highest string low byte STX Histrh ; save as highest string high byte LDA #des_sk ; set descriptor stack pointer STA ut1_pl ; save descriptor stack pointer low byte STY ut1_ph ; save descriptor stack pointer high byte ($00) LAB_2161 CMP next_s ; compare with descriptor stack pointer BEQ LAB_216A ; branch if = JSR LAB_21D7 ; go garbage collect descriptor stack BEQ LAB_2161 ; loop always ; done stacked strings, now do string vars LAB_216A ASL g_step ; set step size = $06 LDA Svarl ; get start of vars low byte LDX Svarh ; get start of vars high byte STA ut1_pl ; save as pointer low byte STX ut1_ph ; save as pointer high byte LAB_2176 CPX Sarryh ; compare start of arrays high byte BNE LAB_217E ; branch if no high byte match CMP Sarryl ; else compare start of arrays low byte BEQ LAB_2183 ; branch if = var mem end LAB_217E JSR LAB_21D1 ; go garbage collect strings BEQ LAB_2176 ; loop always ; done string vars, now do string arrays LAB_2183 STA Nbendl ; save start of arrays low byte as working pointer STX Nbendh ; save start of arrays high byte as working pointer LDA #$04 ; set step size STA g_step ; save step size LAB_218B LDA Nbendl ; get pointer low byte LDX Nbendh ; get pointer high byte LAB_218F CPX Earryh ; compare with array mem end high byte BNE LAB_219A ; branch if not at end CMP Earryl ; else compare with array mem end low byte BEQ LAB_2216 ; tidy up and exit if at end LAB_219A STA ut1_pl ; save pointer low byte STX ut1_ph ; save pointer high byte LDY #$01 ; set index LDA (ut1_pl),Y ; get name second byte PHP ; push the flags INY ; increment index LDA (ut1_pl),Y ; get array size low byte ADC Nbendl ; add start of this array low byte STA Nbendl ; save start of next array low byte INY ; increment index LDA (ut1_pl),Y ; get array size high byte ADC Nbendh ; add start of this array high byte STA Nbendh ; save start of next array high byte PLP ; restore the flags BPL LAB_218B ; skip if not string array ; was string array so ... INY ; increment index LDA (ut1_pl),Y ; get # of dimensions ASL A ; *2 ADC #$05 ; +5 (array header size) ADC ut1_pl ; add array start low byte STA ut1_pl ; save data start low byte BCC LAB_21C2 ; branch if no overflow INC ut1_ph ; else increment data start high byte LAB_21C2 LDX ut1_ph ; get element pointer high byte LAB_21C4 CPX Nbendh ; compare with start of next array high byte BNE LAB_21CC ; branch if <> (go do this array) CMP Nbendl ; else compare element pointer low byte with next array ; low byte BEQ LAB_218F ; if equal then go do next array LAB_21CC JSR LAB_21D7 ; go defrag array strings BEQ LAB_21C4 ; go do next array string (loop always) ; defrag string variables ; enter with XA = variable pointer ; return with XA = next variable pointer LAB_21D1 INY ; increment index (Y was $00) LDA (ut1_pl),Y ; get var name byte 2 BPL LAB_2206 ; if not string, step pointer to next var & RET INY ; else increment index LAB_21D7 LDA (ut1_pl),Y ; get string length BEQ LAB_2206 ; if null, step pointer to next string & RET INY ; else increment index LDA (ut1_pl),Y ; get string pointer low byte TAX ; copy to X INY ; increment index LDA (ut1_pl),Y ; get string pointer high byte CMP Sstorh ; compare bottom of string space high byte BCC LAB_21EC ; branch if less BNE LAB_2206 ; if greater, step pointer to next string & RET ; high bytes were = so compare low bytes CPX Sstorl ; compare bottom of string space low byte BCS LAB_2206 ; if >=, step pointer to next string & RET ; string pointer is < string storage pointer (pos in mem) LAB_21EC CMP Histrh ; compare to highest string high byte BCC LAB_2206 ; if <, step pointer to next string & RET BNE LAB_21F6 ; if > update pointers, step to next & return ; high bytes were = so compare low bytes CPX Histrl ; compare to highest string low byte BCC LAB_2206 ; if <, step pointer to next string & RET ; string is in string memory space LAB_21F6 STX Histrl ; save as new highest string low byte STA Histrh ; save as new highest string high byte LDA ut1_pl ; get start of vars(descriptors) low byte LDX ut1_ph ; get start of vars(descriptors) high byte STA garb_l ; save as working pointer low byte STX garb_h ; save as working pointer high byte DEY ; decrement index DIFFERS DEY ; decrement index (should point to descriptor start) STY g_indx ; save index pointer ; step pointer to next string LAB_2206 LDA g_step ; get step size CLC ; clear carry for add ADC ut1_pl ; add pointer low byte STA ut1_pl ; save pointer low byte BCC LAB_2211 ; branch if no overflow INC ut1_ph ; else increment high byte LAB_2211 LDX ut1_ph ; get pointer high byte LDY #$00 ; clear Y RTS ; ; search complete, now either exit or set-up and move string LAB_2216 DEC g_step ; decrement step size (now $03 for descriptor stack) LDX garb_h ; get string to move high byte BEQ LAB_2211 ; exit if nothing to move LDY g_indx ; get index byte back (points to descriptor) CLC ; clear carry for add LDA (garb_l),Y ; get string length ADC Histrl ; add highest string low byte STA Obendl ; save old block end low pointer LDA Histrh ; get highest string high byte ADC #$00 ; add any carry STA Obendh ; save old block end high byte LDA Sstorl ; get bottom of string space low byte LDX Sstorh ; get bottom of string space high byte STA Nbendl ; save new block end low byte STX Nbendh ; save new block end high byte JSR LAB_11D6 ; open up space in memory, don't set array end LDY g_indx ; get index byte INY ; point to descriptor low byte LDA Nbendl ; get string pointer low byte STA (garb_l),Y ; save new string pointer low byte TAX ; copy string pointer low byte INC Nbendh ; correct high byte (move sets high byte -1) LDA Nbendh ; get new string pointer high byte INY ; point to descriptor high byte STA (garb_l),Y ; save new string pointer high byte JMP LAB_214B ; re-run routine from last ending ; (but don't collect this string) ; concatenate ; add strings, string 1 is in descriptor des_pl, string 2 is in line LAB_224D LDA des_ph ; get descriptor pointer high byte PHA ; put on stack LDA des_pl ; get descriptor pointer low byte PHA ; put on stack JSR LAB_GVAL ; get value from line JSR LAB_CTST ; check if source is string, else do type mismatch PLA ; get descriptor pointer low byte back STA ssptr_l ; set pointer low byte PLA ; get descriptor pointer high byte back STA ssptr_h ; set pointer high byte LDY #$00 ; clear index LDA (ssptr_l),Y ; get length_1 from descriptor CLC ; clear carry for add ADC (des_pl),Y ; add length_2 BCC LAB_226D ; branch if no overflow LDX #$1A ; else set error code $1A ("String too long" error) JMP LAB_XERR ; do error #X, then warm start LAB_226D JSR LAB_209C ; copy des_pl/h to des_2l/h & make string space A bytes long JSR LAB_228A ; copy string from descriptor (sdescr) to (Sutill) LDA des_2l ; get descriptor pointer low byte LDY des_2h ; get descriptor pointer high byte JSR LAB_22BA ; 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_229C ; store string A bytes long from (ut1_pl) to (Sutill) LDA ssptr_l ;.set descriptor pointer low byte LDY ssptr_h ;.set descriptor pointer high byte JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=ut1_pl=pointer low byte, ; Y=ut1_ph=pointer high byte JSR LAB_RTST ; check for space on descriptor stack then put string address ; and length on descriptor stack & update stack pointers JMP LAB_1ADB ;.continue evaluation ; copy string from descriptor (sdescr) to (Sutill) LAB_228A LDY #$00 ; clear index LDA (sdescr),Y ; get string length PHA ; save on stack INY ; increment index LDA (sdescr),Y ; get source string pointer low byte TAX ; copy to X INY ; increment index LDA (sdescr),Y ; get source string pointer high byte TAY ; copy to Y PLA ; get length back ; store string A bytes long from YX to (Sutill) LAB_2298 STX ut1_pl ; save source string pointer low byte STY ut1_ph ; save source string pointer high byte ; store string A bytes long from (ut1_pl) to (Sutill) LAB_229C TAX ; copy length to index (don't count with Y) BEQ LAB_22B2 ; branch if = $0 (null string) no need to add zero length LDY #$00 ; zero pointer (copy forward) LAB_22A0 LDA (ut1_pl),Y ; get source byte STA (Sutill),Y ; save destination byte INY ; increment index DEX ; decrement counter BNE LAB_22A0 ; loop while <> 0 TYA ; restore length from Y LAB_22A9 CLC ; clear carry for add ADC Sutill ; add string utility ptr low byte STA Sutill ; save string utility ptr low byte BCC LAB_22B2 ; branch if no carry INC Sutilh ; else increment string utility ptr high byte LAB_22B2 RTS ; ; evaluate string LAB_EVST JSR LAB_CTST ; 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_22B6 LDA des_pl ; get descriptor pointer low byte LDY des_ph ; get descriptor pointer high byte ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=ut1_pl=pointer low byte, Y=ut1_ph=pointer high byte LAB_22BA STA ut1_pl ; save string pointer low byte STY ut1_ph ; save string pointer high byte JSR LAB_22EB ; clean descriptor stack, YA = pointer PHP ; save status flags LDY #$00 ; clear index LDA (ut1_pl),Y ; get length from string descriptor PHA ; put on stack INY ; increment index LDA (ut1_pl),Y ; get string pointer low byte from descriptor TAX ; copy to X INY ; increment index LDA (ut1_pl),Y ; get string pointer high byte from descriptor TAY ; copy to Y PLA ; get string length back PLP ; restore status BNE LAB_22E6 ; branch if pointer <> last_sl,last_sh CPY Sstorh ; compare bottom of string space high byte BNE LAB_22E6 ; branch if <> CPX Sstorl ; else compare bottom of string space low byte BNE LAB_22E6 ; branch if <> PHA ; save string length CLC ; clear carry for add ADC Sstorl ; add bottom of string space low byte STA Sstorl ; save bottom of string space low byte BCC LAB_22E5 ; skip increment if no overflow INC Sstorh ; increment bottom of string space high byte LAB_22E5 PLA ; restore string length LAB_22E6 STX ut1_pl ; save string pointer low byte STY ut1_ph ; 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_22EB CPY last_sh ; compare pointer high byte BNE LAB_22FB ; exit if <> CMP last_sl ; compare pointer low byte BNE LAB_22FB ; exit if <> STA next_s ; save descriptor stack pointer SBC #$03 ; -3 STA last_sl ; save low byte -3 LDY #$00 ; clear high byte LAB_22FB RTS ; ; perform CHR$() LAB_CHRS JSR LAB_EVBY ; evaluate byte expression, result in X TXA ; copy to A PHA ; save character LDA #$01 ; string is single byte JSR LAB_MSSP ; make string space A bytes long A=$AC=length, ; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte PLA ; get character back LDY #$00 ; clear index STA (str_pl),Y ; save byte in string (byte IS string!) PLA ; dump return address (return via get value from line) PLA ; dump return address (return via get value from line) JMP LAB_RTST ; check for space on descriptor stack then put string address ; and length on descriptor stack & update stack pointers ; perform LEFT$() LAB_LEFT JSR LAB_236F ; pull string data & byte parameter from stack ; return pointer in des_2l/h, byte in A (and X), Y=0 CMP (des_2l),Y ; compare byte parameter with string length TYA ; clear A BEQ LAB_2316 ; go do string copy (branch always) ; perform RIGHT$() LAB_RIGHT JSR LAB_236F ; pull string data & byte parameter from stack ; return pointer in des_2l/h, byte in A (and X), Y=0 CLC ; clear carry for add-1 SBC (des_2l),Y ; subtract string length EOR #$FF ; invert it (A=LEN(expression$)-l) LAB_2316 BCC LAB_231C ; branch if string length > byte parameter LDA (des_2l),Y ; else make parameter = length TAX ; copy to byte parameter copy TYA ; clear string start offset LAB_231C PHA ; save string start offset LAB_231D TXA ; copy byte parameter (or string length if <) LAB_231E PHA ; save string length JSR LAB_MSSP ; make string space A bytes long A=$AC=length, ; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte LDA des_2l ; get descriptor pointer low byte LDY des_2h ; get descriptor pointer high byte JSR LAB_22BA ; pop (YA) descriptor off stack or from top of string space ; returns with A = length, X=ut1_pl=pointer low byte, ; Y=ut1_ph=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 ut1_pl ; add start offset to string start pointer low byte STA ut1_pl ; save string start pointer low byte BCC LAB_2335 ; branch if no overflow INC ut1_ph ; else increment string start pointer high byte LAB_2335 TYA ; copy length to A JSR LAB_229C ; store string A bytes long from (ut1_pl) to (Sutill) JMP LAB_RTST ; check for space on descriptor stack then put string address ; and length on descriptor stack & update stack pointers ; perform MID$() LAB_MIDS LDA #$FF ; set default length = 255 STA mids_l ; save default length .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory CMP #$29 ; compare with ")" BEQ LAB_2358 ; branch if = ")" (skip second byte get) JSR LAB_1C01 ; scan for "," , else do syntax error, then warm start JSR LAB_GTBY ; get byte parameter (use copy in mids_l) LAB_2358 JSR LAB_236F ; pull string data & byte parameter from stack ; return pointer in des_2l/h, byte in A (and X), Y=0 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 (des_2l),Y ; subtract string length BCS LAB_231D ; if start>string length go do null string EOR #$FF ; complement -length CMP mids_l ; compare byte parameter BCC LAB_231E ; if length>remaining string go do RIGHT$ LDA mids_l ; get length byte BCS LAB_231E ; go do string copy (branch always) ; pull string data & byte parameter from stack ; return pointer in des_2l/h, byte in A (and X), Y=0 LAB_236F JSR LAB_1BFB ; scan for ")" , else do syntax error, then warm start PLA ; pull return address low byte (return address) STA Fnxjpl ; save functions jump vector low byte PLA ; pull return address high byte (return address) STA Fnxjph ; save functions jump vector high byte 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 des_2l ; save it PLA ; pull string pointer high byte STA des_2h ; save it LDY #$00 ; clear index TXA ; copy byte parameter BEQ LAB_23A8 ; if null do function call error, then warm start INC Fnxjpl ; increment function jump vector low byte ; (JSR pushes return addr-1. this is all very nice ; but will go tits up if either call is on a page ; boundary!) JMP (Fnxjpl) ; in effect, RTS ; perform LCASE$() LAB_LCASE JSR LAB_EVST ; evaluate string STA str_ln ; set string length STX str_pl ; set string pointer low byte STY str_ph ; set string pointer high byte TAX ; copy length to X BEQ NoString ; branch if null string LDY #$00 ; clear index LC_loop LDA (ut1_pl),Y ; get byte from string JSR LAB_1D82 ; is character "A" to "Z" BCC NoUcase ; branch if not upper case alpha ORA #$20 ; convert upper to lower case STA (ut1_pl),Y ; save byte back to string NoUcase INY ; increment index DEX ; decrement count BNE LC_loop ; loop if not all done BEQ NoString ; tidy up & exit (branch always) ; perform UCASE$() LAB_UCASE JSR LAB_EVST ; evaluate string STA str_ln ; set string length STX str_pl ; set string pointer low byte STY str_ph ; set string pointer high byte TAX ; copy length to X BEQ NoString ; branch if null string LDY #$00 ; clear index UC_loop LDA (ut1_pl),Y ; get byte from string JSR LAB_CASC ; is character "a" to "z" (or "A" to "Z") BCC NoLcase ; branch if not alpha AND #$DF ; convert lower to upper case STA (ut1_pl),Y ; save byte back to string NoLcase INY ; increment index DEX ; decrement count BNE UC_loop ; loop if not all done NoString PLA ; dump return address (return via get value from line call) PLA ; dump return address JMP LAB_RTST ; check for space on descriptor stack then put string address ; and length on descriptor stack & update stack pointers ; perform SADD() LAB_SADD JSR LAB_EVST ; evaluate string TYA ; string address high byte to A LDY ut1_pl ; string address low byte to Y JMP LAB_AYFC ; save & convert integer AY to FAC1 & return ; perform LEN() LAB_LENS JSR LAB_ESGL ; evaluate string, get length in A (& Y) JMP LAB_1FD0 ; convert Y to byte in FAC1 & return ; evaluate string, get length in Y LAB_ESGL JSR LAB_EVST ; evaluate string LDX #$00 ; set data type = numeric STX Dtypef ; clear data type flag, $FF=string, $00=numeric TAY ; copy length to Y RTS ; ; perform ASC() LAB_ASC JSR LAB_ESGL ; evaluate string, get length in A (& Y) BEQ LAB_23A8 ; if null do function call error, then warm start LDY #$00 ; set index to first character LDA (ut1_pl),Y ; get byte TAY ; copy to Y JMP LAB_1FD0 ; convert Y to byte in FAC1 & return ; do function call error, then warm start LAB_23A8 JMP LAB_FCER ; do function call error, then warm start ; scan and get byte parameter LAB_SGBY .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory ; get byte parameter LAB_GTBY JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch ; evaluate byte expression, result in X LAB_EVBY JSR LAB_EVPI ; evaluate integer expression (no check) LDY FAC1_2 ; get FAC1 mantissa2 BNE LAB_23A8 ; if top byte <> 0 do function call error, then warm start LDX FAC1_3 ; get FAC1 mantissa3 JMP LAB_GBYT ; scan memory & return ; perform VAL() LAB_VAL JSR LAB_ESGL ; evaluate string, get length in A (& Y) BNE LAB_23C5 ; branch if not null string ; string was null so set result = $00 JMP LAB_24F1 ; clear FAC1 exponent & sign & return LAB_23C5 LDX Bpntrl ; get BASIC execute pointer low byte LDY Bpntrh ; get BASIC execute pointer high byte STX Btmpl ; save BASIC execute pointer low byte STY Btmph ; save BASIC execute pointer high byte LDX ut1_pl ; get string pointer low byte STX Bpntrl ; save as BASIC execute pointer low byte CLC ; clear carry ADC ut1_pl ; add string length STA ut2_pl ; save string end low byte LDX ut1_ph ; get string pointer high byte STX Bpntrh ; save as BASIC execute pointer high byte BCC LAB_23DD ; branch if no high byte increment INX ; increment string end high byte LAB_23DD STX ut2_ph ; save string end high byte LDY #$00 ; set index to $00 LDA (ut2_pl),Y ; get string end byte PHA ; push it LDA #$00 ; clear A STA (ut2_pl),Y ; terminate string with $00 .BYTE $20, LAB_GBYT, $00 ; JSR LAB_GBYT ; scan memory JSR LAB_2887 ; get FAC1 from string PLA ; restore string end byte LDY #$00 ; set index to zero STA (ut2_pl),Y ; put string end byte back ; restore BASIC execute pointer from temp (Btmpl/Btmph) LAB_23F3 LDX Btmpl ; get BASIC execute pointer low byte back LDY Btmph ; get BASIC execute pointer high byte back STX Bpntrl ; save BASIC execute pointer low byte STY Bpntrh ; save BASIC execute pointer high byte RTS ; ; get two parameters for POKE or WAIT LAB_GADB JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch JSR LAB_F2FX ; save integer part of FAC1 in temporary integer ; scan for "," and get byte, else do Syntax error then warm start LAB_SCGB JSR LAB_1C01 ; scan for "," , else do syntax error, then warm start LDA Itemph ; save temporary integer high byte PHA ; on stack LDA Itempl ; save temporary integer low byte PHA ; on stack JSR LAB_GTBY ; get byte parameter PLA ; pull low byte STA Itempl ; restore temporary integer low byte PLA ; pull high byte STA Itemph ; restore temporary integer high byte RTS ; ; convert float to fixed routine. accepts any value that fits in 24 bits, +ve or ; -ve and converts it into a right truncated integer in Itempl & Itemph ; save unsigned 16 bit integer part of FAC1 in temporary integer LAB_F2FX LDA FAC1_e ; get FAC1 exponent CMP #$98 ; compare with exponent = 2^24 BCS LAB_23A8 ; if >= do function call error, then warm start LAB_F2FU JSR LAB_2831 ; convert FAC1 floating-to-fixed LDA FAC1_2 ; get FAC1 mantissa2 LDY FAC1_3 ; get FAC1 mantissa3 STY Itempl ; save temporary integer low byte STA Itemph ; save temporary integer high byte RTS ; ; perform PEEK() LAB_PEEK JSR LAB_F2FX ; save integer part of FAC1 in temporary integer LDX #$00 ; clear index LDA (Itempl,X) ; get byte via temporary integer (addr) TAY ; copy byte to Y JMP LAB_1FD0 ; convert Y to byte in FAC1 & return ; perform POKE LAB_POKE JSR LAB_GADB ; get two parameters for POKE or WAIT TXA ; copy byte argument to A LDX #$00 ; clear index STA (Itempl,X) ; save byte via temporary integer (addr) RTS ; ; perform DEEK() LAB_DEEK JSR LAB_F2FX ; save integer part of FAC1 in temporary integer LDX #$00 ; clear index LDA (Itempl,X) ; PEEK low byte TAY ; copy to Y INC Itempl ; increment pointer low byte BNE Deekh ; skip high increment if no rollover INC Itemph ; increment pointer high byte Deekh LDA (Itempl,X) ; PEEK high byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & return ; perform DOKE LAB_DOKE JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch JSR LAB_F2FX ; convert floating-to-fixed STY Frnxtl ; save pointer low byte (float to fixed returns word in AY) STA Frnxth ; save pointer high byte JSR LAB_1C01 ; scan for "," , else do syntax error, then warm start JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch JSR LAB_F2FX ; convert floating-to-fixed TYA ; copy value low byte (float to fixed returns word in AY) LDX #$00 ; clear index STA (Frnxtl,X) ; POKE low byte INC Frnxtl ; increment pointer low byte BNE Dokeh ; skip high increment if no rollover INC Frnxth ; increment pointer high byte Dokeh LDA Itemph ; get value high byte STA (Frnxtl,X) ; POKE high byte JMP LAB_GBYT ; scan memory & return ; perform SWAP LAB_SWAP JSR LAB_GVAR ; get var1 address STA Lvarpl ; save var1 address low byte STY Lvarph ; save var1 address high byte LDA Dtypef ; get data type flag, $FF=string, $00=numeric PHA ; save data type flag JSR LAB_1C01 ; scan for "," , else do syntax error, then warm start JSR LAB_GVAR ; get var2 address (pointer in Cvaral/h) PLA ; pull var1 data type flag CMP Dtypef ; compare with var2 data type BNE SwapErr ; exit if not both the same type LDY #$03 ; four bytes to swap (either value or descriptor+1) SwapLp LDA (Lvarpl),Y ; get byte from var1 PHA ; save var1 byte LDA (Cvaral),Y ; get byte from var2 STA (Lvarpl),Y ; save byte to var1 PLA ; restore var1 byte STA (Cvaral),Y ; save byte to var2 DEY ; decrement index BPL SwapLp ; loop until done RTS SwapErr JMP LAB_1ABC ; do "Type mismatch" error then warm start ; perform CALL LAB_CALL JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch JSR LAB_F2FX ; convert floating-to-fixed LDA #>CallExit ; set return address high byte PHA ; put on stack LDA #8 shifts) BCC LAB_24A8 ;.go subtract mantissas ; add 0.5 to FAC1 LAB_244E LDA #LAB_2A96 ; set 0.5 pointer high byte ; add (AY) to FAC1 LAB_246C JSR LAB_264D ; unpack memory (AY) into FAC2 ; add FAC2 to FAC1 LAB_ADD BNE LAB_2474 ; branch if FAC1 was not zero JMP LAB_279B ; FAC1 was zero so copy FAC2 to FAC1 & return ; FAC1 is non zero LAB_2474 LDX FAC1_r ; get FAC1 rounding byte STX FAC2_r ; save as FAC2 rounding byte LDX #FAC2_e ; set index to FAC2 exponent addr LDA FAC2_e ; get FAC2 exponent LAB_247C TAY ; copy exponent BEQ LAB_244D ; exit if zero SEC ; set carry for subtract SBC FAC1_e ; subtract FAC1 exponent BEQ LAB_24A8 ; branch if = (go add mantissa) BCC LAB_2498 ; branch if < ; FAC2>FAC1 STY FAC1_e ; save FAC1 exponent LDY FAC2_s ; get FAC2 sign (b7) STY FAC1_s ; save FAC1 sign (b7) EOR #$FF ; complement A ADC #$00 ; +1 (twos complement, carry is set) LDY #$00 ; clear Y STY FAC2_r ; clear FAC2 rounding byte LDX #FAC1_e ; set index to FAC1 exponent addr BNE LAB_249C ; branch always LAB_2498 LDY #$00 ; clear Y STY FAC1_r ; clear FAC1 rounding byte LAB_249C CMP #$F9 ; compare exponent diff with $F9 BMI LAB_2467 ; branch if range $79-$F8 TAY ; copy exponent difference to Y LDA FAC1_r ; get FAC1 rounding byte LSR PLUS_1,X ; shift FAC? mantissa1 JSR LAB_2592 ; shift FACX Y times right ; exponents are equal now do mantissa subtract LAB_24A8 BIT FAC_sc ; test sign compare (FAC1 EOR FAC2) BPL LAB_24F8 ; if = add FAC2 mantissa to FAC1 mantissa & ret'n LDY #FAC1_e ; set index to FAC1 exponent addr CPX #FAC2_e ; compare X to FAC2 exponent addr BEQ LAB_24B4 ; branch if = LDY #FAC2_e ; else set index to FAC2 exponent addr ; subtract smaller from bigger (take sign of bigger) LAB_24B4 SEC ; set carry for subtract EOR #$FF ; ones complement A ADC FAC2_r ; add FAC2 rounding byte STA FAC1_r ; save FAC1 rounding byte LDA PLUS_3,Y ; get FACY mantissa3 SBC PLUS_3,X ; subtract FACX mantissa3 STA FAC1_3 ; save FAC1 mantissa3 LDA PLUS_2,Y ; get FACY mantissa2 SBC PLUS_2,X ; subtract FACX mantissa2 STA FAC1_2 ; save FAC1 mantissa2 LDA PLUS_1,Y ; get FACY mantissa1 SBC PLUS_1,X ; subtract FACX mantissa1 STA FAC1_1 ; save FAC1 mantissa1 ; do ABS & normalise FAC1 LAB_24D0 BCS LAB_24D5 ; branch if number is +ve JSR LAB_2537 ; negate FAC1 ; normalise FAC1 LAB_24D5 LDY #$00 ; clear Y TYA ; clear A CLC ; clear carry for add LAB_24D9 LDX FAC1_1 ; get FAC1 mantissa1 BNE LAB_251B ; if not zero normalise FAC1 LDX FAC1_2 ; get FAC1 mantissa2 STX FAC1_1 ; save FAC1 mantissa1 LDX FAC1_3 ; get FAC1 mantissa3 STX FAC1_2 ; save FAC1 mantissa2 LDX FAC1_r ; get FAC1 rounding byte STX FAC1_3 ; save FAC1 mantissa3 STY FAC1_r ; clear FAC1 rounding byte ADC #$08 ; add x to exponent offset CMP #$18 ; compare with $18 (max offset, all bits would be =0) BNE LAB_24D9 ; loop if not max ; clear FAC1 exponent & sign LAB_24F1 LDA #$00 ; clear A LAB_24F3 STA FAC1_e ; set FAC1 exponent ; save FAC1 exponent LAB_24F5 STA FAC1_s ; save FAC1 sign (b7) RTS ; ; add FAC2 mantissa to FAC1 mantissa LAB_24F8 ADC FAC2_r ; add FAC2 rounding byte STA FAC1_r ; save FAC1 rounding byte LDA FAC1_3 ; get FAC1 mantissa3 ADC FAC2_3 ; add FAC2 mantissa3 STA FAC1_3 ; save FAC1 mantissa3 LDA FAC1_2 ; get FAC1 mantissa2 ADC FAC2_2 ; add FAC2 mantissa2 STA FAC1_2 ; save FAC1 mantissa2 LDA FAC1_1 ; get FAC1 mantissa1 ADC FAC2_1 ; add FAC2 mantissa1 STA FAC1_1 ; save FAC1 mantissa1 JMP LAB_2528 ; test & normalise FAC1 for C=0/1 LAB_2511 ADC #$01 ; add 1 to exponent offset ASL FAC1_r ; shift FAC1 rounding byte ROL FAC1_3 ; shift FAC1 mantissa3 ROL FAC1_2 ; shift FAC1 mantissa2 ROL FAC1_1 ; shift FAC1 mantissa1 ; normalise FAC1 LAB_251B BPL LAB_2511 ; loop if not normalised SEC ; set carry for subtract SBC FAC1_e ; subtract FAC1 exponent BCS LAB_24F1 ; branch if underflow (set result = $0) EOR #$FF ; complement exponent ADC #$01 ; +1 (twos complement) STA FAC1_e ; save FAC1 exponent ; test & normalise FAC1 for C=0/1 LAB_2528 BCC LAB_2536 ; exit if no overflow ; normalise FAC1 for C=1 LAB_252A INC FAC1_e ; increment FAC1 exponent BEQ LAB_2564 ; if zero do overflow error & warm start ROR FAC1_1 ; shift FAC1 mantissa1 ROR FAC1_2 ; shift FAC1 mantissa2 ROR FAC1_3 ; shift FAC1 mantissa3 ROR FAC1_r ; shift FAC1 rounding byte LAB_2536 RTS ; ; negate FAC1 LAB_2537 LDA FAC1_s ; get FAC1 sign (b7) EOR #$FF ; complement it STA FAC1_s ; save FAC1 sign (b7) ; twos complement FAC1 mantissa LAB_253D LDA FAC1_1 ; get FAC1 mantissa1 EOR #$FF ; complement it STA FAC1_1 ; save FAC1 mantissa1 LDA FAC1_2 ; get FAC1 mantissa2 EOR #$FF ; complement it STA FAC1_2 ; save FAC1 mantissa2 LDA FAC1_3 ; get FAC1 mantissa3 EOR #$FF ; complement it STA FAC1_3 ; save FAC1 mantissa3 LDA FAC1_r ; get FAC1 rounding byte EOR #$FF ; complement it STA FAC1_r ; save FAC1 rounding byte INC FAC1_r ; increment FAC1 rounding byte BNE LAB_2563 ; exit if no overflow ; increment FAC1 mantissa LAB_2559 INC FAC1_3 ; increment FAC1 mantissa3 BNE LAB_2563 ; finished if no rollover INC FAC1_2 ; increment FAC1 mantissa2 BNE LAB_2563 ; finished if no rollover INC FAC1_1 ; increment FAC1 mantissa1 LAB_2563 RTS ; ; do overflow error (overflow exit) LAB_2564 LDX #$0A ; error code $0A ("Overflow" error) JMP LAB_XERR ; do error #X, then warm start ; shift FCAtemp << A+8 times LAB_2569 LDX #$74 ; set offset to FACtemp LAB_256B LDY PLUS_3,X ; get FACX mantissa3 STY FAC1_r ; save as FAC1 rounding byte LDY PLUS_2,X ; get FACX mantissa2 STY PLUS_3,X ; save FACX mantissa3 LDY PLUS_1,X ; get FACX mantissa1 STY PLUS_2,X ; save FACX mantissa2 LDY FAC1_o ; get FAC1 overflow byte STY PLUS_1,X ; save FACX mantissa1 ; shift FACX -A times right (> 8 shifts) LAB_257B ADC #$08 ; add 8 to shift count BMI LAB_256B ; go do 8 shift if still -ve BEQ LAB_256B ; go do 8 shift if zero SBC #$08 ; else subtract 8 again LAB_2583 TAY ; save count to Y LDA FAC1_r ; get FAC1 rounding byte BCS LAB_259A ;. LAB_2588 ASL PLUS_1,X ; shift FACX mantissa1 BCC LAB_258E ; branch if +ve INC PLUS_1,X ; this sets b7 eventually LAB_258E ROR PLUS_1,X ; shift FACX mantissa1 (correct for ASL) ROR PLUS_1,X ; shift FACX mantissa1 (put carry in b7) ; shift FACX Y times right LAB_2592 ROR PLUS_2,X ; shift FACX mantissa2 ROR PLUS_3,X ; shift FACX mantissa3 ROR A ; shift FACX rounding byte INY ; increment exponent diff BNE LAB_2588 ; branch if range adjust not complete LAB_259A CLC ; just clear it RTS ; ; perform LOG() LAB_LOG JSR LAB_27CA ; test sign and zero BEQ LAB_25C4 ; if zero do function call error, then warm start BPL LAB_25C7 ; skip error if +ve LAB_25C4 JMP LAB_FCER ; do function call error, then warm start (-ve) LAB_25C7 LDA FAC1_e ; get FAC1 exponent SBC #$7F ; normalise it PHA ; save it LDA #$80 ; set exponent to zero STA FAC1_e ; save FAC1 exponent LDA #LAB_25AD ; set 1/root2 pointer high byte JSR LAB_246C ; add (AY) to FAC1 (1/root2) LDA #LAB_25B1 ; set root2 pointer high byte JSR LAB_26CA ; convert AY and do (AY)/FAC1 (root2/(x+(1/root2))) LDA #LAB_259C ; set 1 pointer high byte JSR LAB_2455 ; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1) LDA #LAB_25A0 ; set pointer high byte to counter JSR LAB_2B6E ; ^2 then series evaluation LDA #LAB_25B5 ; set -0.5 pointer high byte JSR LAB_246C ; add (AY) to FAC1 PLA ; restore FAC1 exponent JSR LAB_2912 ; evaluate new ASCII digit LDA #LAB_25B9 ; set LOG(2) pointer high byte ; do convert AY, FCA1*(AY) LAB_25FB JSR LAB_264D ; unpack memory (AY) into FAC2 LAB_MULTIPLY BEQ LAB_264C ; exit if zero LAB_2600 JSR LAB_2673 ; test & adjust accumulators LDA #$00 ; clear A STA FACt_1 ; clear temp mantissa1 STA FACt_2 ; clear temp mantissa2 STA FACt_3 ; clear temp mantissa3 LDA FAC1_r ; get FAC1 rounding byte JSR LAB_2622 ; go do shift/add FAC2 LDA FAC1_3 ; get FAC1 mantissa3 JSR LAB_2622 ; go do shift/add FAC2 LDA FAC1_2 ; get FAC1 mantissa2 JSR LAB_2622 ; go do shift/add FAC2 LDA FAC1_1 ; get FAC1 mantissa1 JSR LAB_2627 ; go do shift/add FAC2 JMP LAB_273C ; copy temp to FAC1, normalise & return LAB_2622 BNE LAB_2627 ; branch if byte <> zero JMP LAB_2569 ; shift FCAtemp << A+8 times ; else do shift & add LAB_2627 LSR A ; shift byte ORA #$80 ; set top bit (mark for 8 times) LAB_262A TAY ; copy result BCC LAB_2640 ; skip next if bit was zero CLC ; clear carry for add LDA FACt_3 ; get temp mantissa3 ADC FAC2_3 ; add FAC2 mantissa3 STA FACt_3 ; save temp mantissa3 LDA FACt_2 ; get temp mantissa2 ADC FAC2_2 ; add FAC2 mantissa2 STA FACt_2 ; save temp mantissa2 LDA FACt_1 ; get temp mantissa1 ADC FAC2_1 ; add FAC2 mantissa1 STA FACt_1 ; save temp mantissa1 LAB_2640 ROR FACt_1 ; shift temp mantissa1 ROR FACt_2 ; shift temp mantissa2 ROR FACt_3 ; shift temp mantissa3 ROR FAC1_r ; shift temp rounding byte TYA ; get byte back LSR A ; shift byte BNE LAB_262A ; loop if all bits not done LAB_264C RTS ; ; unpack memory (AY) into FAC2 LAB_264D STA ut1_pl ; save pointer low byte STY ut1_ph ; save pointer high byte LDY #$03 ; 4 bytes to get (0-3) LDA (ut1_pl),Y ; get mantissa3 STA FAC2_3 ; save FAC2 mantissa3 DEY ; decrement index LDA (ut1_pl),Y ; get mantissa2 STA FAC2_2 ; save FAC2 mantissa2 DEY ; decrement index LDA (ut1_pl),Y ; get mantissa1+sign STA FAC2_s ; save FAC2 sign (b7) EOR FAC1_s ; EOR with FAC1 sign (b7) STA FAC_sc ; save sign compare (FAC1 EOR FAC2) LDA FAC2_s ; recover FAC2 sign (b7) ORA #$80 ; set 1xxx xxx (set normal bit) STA FAC2_1 ; save FAC2 mantissa1 DEY ; decrement index LDA (ut1_pl),Y ; get exponent byte STA FAC2_e ; save FAC2 exponent LDA FAC1_e ; get FAC1 exponent RTS ; ; test & adjust accumulators LAB_2673 LDA FAC2_e ; get FAC2 exponent LAB_2675 BEQ LAB_2696 ; branch if FAC2 = $00 (handle underflow) CLC ; clear carry for add ADC FAC1_e ; add FAC1 exponent BCC LAB_2680 ; branch if sum of exponents <$0100 BMI LAB_269B ; do overflow error CLC ; clear carry for the add .byte $2C ; makes next line BIT $1410 LAB_2680 BPL LAB_2696 ; if +ve go handle underflow ADC #$80 ; STA FAC1_e ; save FAC1 exponent BNE LAB_268B ; JMP LAB_24F5 ; save FAC1 exponent & return LAB_268B LDA FAC_sc ; get sign compare (FAC1 EOR FAC2) STA FAC1_s ; save FAC1 sign (b7) LAB_268F RTS ; ; handle overflow and underflow LAB_2690 LDA FAC1_s ; get FAC1 sign (b7) EOR #$FF ; complement it BMI LAB_269B ; do overflow error ; handle underflow LAB_2696 PLA ; pop return address low byte PLA ; pop return address high byte JMP LAB_24F1 ; clear FAC1 exponent & sign & return ; multiply by 10 LAB_269E JSR LAB_27AB ; round & copy FAC1 to FAC2 TAX ; copy exponent (set the flags) BEQ LAB_268F ; exit if zero CLC ; clear carry for add ADC #$02 ; add two to exponent (*4) BCS LAB_269B ; do overflow error if > $FF LDX #$00 ; clear byte STX FAC_sc ; clear sign compare (FAC1 EOR FAC2) JSR LAB_247C ; add FAC2 to FAC1 (*5) INC FAC1_e ; increment FAC1 exponent (*10) BNE LAB_268F ; if non zero just do RTS LAB_269B JMP LAB_2564 ; do overflow error & warm start ; divide by 10 LAB_26B9 JSR LAB_27AB ; round & copy FAC1 to FAC2 LDA #LAB_26B5 ; set pointer to 10d high addr LDX #$00 ; clear sign ; divide by (AY) (X=sign) LAB_26C2 STX FAC_sc ; save sign compare (FAC1 EOR FAC2) JSR LAB_UFAC ; unpack memory (AY) into FAC1 JMP LAB_DIVIDE ; do FAC2/FAC1 ; Perform divide-by ; convert AY and do (AY)/FAC1 LAB_26CA JSR LAB_264D ; unpack memory (AY) into FAC2 ; Perform divide-into LAB_DIVIDE BEQ LAB_2737 ; if zero go do /0 error JSR LAB_27BA ; round FAC1 LDA #$00 ; clear A SEC ; set carry for subtract SBC FAC1_e ; subtract FAC1 exponent (2s complement) STA FAC1_e ; save FAC1 exponent JSR LAB_2673 ; test & adjust accumulators INC FAC1_e ; increment FAC1 exponent BEQ LAB_269B ; if zero do overflow error LDX #$FD ; set index to FACt LDA #$01 ;.set byte LAB_26E4 LDY FAC2_1 ; get FAC2 mantissa1 CPY FAC1_1 ; compare FAC1 mantissa1 BNE LAB_26F4 ; branch if <> LDY FAC2_2 ; get FAC2 mantissa2 CPY FAC1_2 ; compare FAC1 mantissa2 BNE LAB_26F4 ; branch if <> LDY FAC2_3 ; get FAC2 mantissa3 CPY FAC1_3 ; compare FAC1 mantissa3 LAB_26F4 PHP ; save FAC2-FAC1 compare status ROL A ;.shift byte BCC LAB_2702 ; skip next if no carry INX ; increment index to FACt BEQ LAB_2727 ;. BPL LAB_272B ;. LDY #$01 ;. LAB_2701 STA FACt_3,X ; write result byte to FACt_3+X (-2, -1, 0) TYA LAB_2702 PLP ; restore FAC2-FAC1 compare status BCC LAB_2704 ; if FAC2 < FAC1 then skip subtract TAY ;.save byte LDA FAC2_3 ; get FAC2 mantissa3 SBC FAC1_3 ; subtract FAC1 mantissa3 STA FAC2_3 ; save FAC2 mantissa3 LDA FAC2_2 ; get FAC2 mantissa2 SBC FAC1_2 ; subtract FAC1 mantissa2 STA FAC2_2 ; save FAC2 mantissa2 LDA FAC2_1 ; get FAC2 mantissa1 SBC FAC1_1 ; subtract FAC1 mantissa1 STA FAC2_1 ; save FAC2 mantissa1 TYA ;.restore byte ; FAC2 = FAC2*2 LAB_2704 ASL FAC2_3 ; shift FAC2 mantissa3 ROL FAC2_2 ; shift FAC2 mantissa2 ROL FAC2_1 ; shift FAC2 mantissa1 BCS LAB_26F4 ; loop with no compare BMI LAB_26E4 ; loop with compare BPL LAB_26F4 ; loop always with no compare LAB_2727 LDY #$40 ; BNE LAB_2701 ; branch always ; do A<<6, save as FAC1 rounding byte, normalise & return LAB_272B ASL A ; ASL A ; ASL A ; ASL A ; ASL A ; ASL A ; STA FAC1_r ; save FAC1 rounding byte PLP ; dump FAC2-FAC1 compare status JMP LAB_273C ; copy temp to FAC1, normalise & return ; do "Divide by zero" error LAB_2737 LDX #$14 ; error code $14 ("Divide by zero" error) JMP LAB_XERR ; do error #X, then warm start ; copy temp to FAC1 & normalise LAB_273C LDA FACt_1 ; get temp mantissa1 STA FAC1_1 ; save FAC1 mantissa1 LDA FACt_2 ; get temp mantissa2 STA FAC1_2 ; save FAC1 mantissa2 LDA FACt_3 ; get temp mantissa3 STA FAC1_3 ; save FAC1 mantissa3 JMP LAB_24D5 ; normalise FAC1 & return ; unpack memory (AY) into FAC1 LAB_UFAC STA ut1_pl ; save pointer low byte STY ut1_ph ; save pointer high byte LDY #$03 ; 4 bytes to do LDA (ut1_pl),Y ; get last byte STA FAC1_3 ; save FAC1 mantissa3 DEY ; decrement index LDA (ut1_pl),Y ; get last-1 byte STA FAC1_2 ; save FAC1 mantissa2 DEY ; decrement index LDA (ut1_pl),Y ; get second byte STA FAC1_s ; save FAC1 sign (b7) ORA #$80 ; set 1xxx xxxx (add normal bit) STA FAC1_1 ; save FAC1 mantissa1 DEY ; decrement index LDA (ut1_pl),Y ; get first byte (exponent) STA FAC1_e ; save FAC1 exponent STY FAC1_r ; clear FAC1 rounding byte RTS ; ; pack FAC1 into numexp LAB_276B LDX #Adatal ; set pointer high byte BEQ LAB_2778 ; pack FAC1 into (XY) & RET ; pack FAC1 into (Lvarpl) LAB_PFAC LDX Lvarpl ; get destination pointer low byte LDY Lvarph ; get destination pointer high byte ; pack FAC1 into (XY) LAB_2778 JSR LAB_27BA ; round FAC1 STX ut1_pl ; save pointer low byte STY ut1_ph ; save pointer high byte LDY #$03 ; set index LDA FAC1_3 ; get FAC1 mantissa3 STA (ut1_pl),Y ; store in destination DEY ; decrement index LDA FAC1_2 ; get FAC1 mantissa2 STA (ut1_pl),Y ; store in destination DEY ; decrement index LDA FAC1_s ; get FAC1 sign (b7) ORA #$7F ; set bits x111 1111 AND FAC1_1 ; AND in FAC1 mantissa1 STA (ut1_pl),Y ; store in destination DEY ; decrement index LDA FAC1_e ; get FAC1 exponent STA (ut1_pl),Y ; store in destination STY FAC1_r ; clear FAC1 rounding byte RTS ; ; copy FAC2 to FAC1 LAB_279B LDA FAC2_s ; get FAC2 sign (b7) ; save FAC1 sign & copy ABS(FAC2) to FAC1 LAB_279D STA FAC1_s ; save FAC1 sign (b7) LDX #$04 ; 4 bytes to copy LAB_27A1 LDA FAC1_o,X ; get byte from FAC2,X STA FAC1_e-1,X ; save byte at FAC1,X DEX ; decrement count BNE LAB_27A1 ; loop if not all done STX FAC1_r ; clear FAC1 rounding byte RTS ; ; round & copy FAC1 to FAC2 LAB_27AB JSR LAB_27BA ; round FAC1 ; copy FAC1 to FAC2 LAB_27AE LDX #$05 ; 5 bytes to copy LAB_27B0 LDA FAC1_e-1,X ; get byte from FAC1,X STA FAC1_o,X ; save byte at FAC2,X DEX ; decrement count BNE LAB_27B0 ; loop if not all done STX FAC1_r ; clear FAC1 rounding byte LAB_27B9 RTS ; ; round FAC1 LAB_27BA LDA FAC1_e ; get FAC1 exponent BEQ LAB_27B9 ; exit if zero ASL FAC1_r ; shift FAC1 rounding byte BCC LAB_27B9 ; exit if no overflow ; round FAC1 (no check) LAB_27C2 JSR LAB_2559 ; increment FAC1 mantissa BNE LAB_27B9 ; branch if no overflow JMP LAB_252A ; normalise FAC1 for C=1 & return ; get FAC1 sign ; return A=FF,C=1/-ve A=01,C=0/+ve LAB_27CA LDA FAC1_e ; get FAC1 exponent BEQ LAB_27D7 ; exit if zero (already correct SGN(0)=0) ; return A=FF,C=1/-ve A=01,C=0/+ve ; no = 0 check LAB_27CE LDA FAC1_s ; else get FAC1 sign (b7) ; return A=FF,C=1/-ve A=01,C=0/+ve ; no = 0 check, sign in A LAB_27D0 ROL A ; move sign bit to carry LDA #$FF ; set byte for -ve result BCS LAB_27D7 ; return if sign was set (-ve) LDA #$01 ; else set byte for +ve result LAB_27D7 RTS ; ; perform SGN() LAB_SGN JSR LAB_27CA ; get FAC1 sign ; return A=$FF/-ve A=$01/+ve ; save A as integer byte LAB_27DB STA FAC1_1 ; save FAC1 mantissa1 LDA #$00 ; clear A STA FAC1_2 ; clear FAC1 mantissa2 LDX #$88 ; set exponent ; set exp=X, clearFAC1 mantissa3 & normalise LAB_27E3 LDA FAC1_1 ; get FAC1 mantissa1 EOR #$FF ; complement it ROL A ; sign bit into carry ; set exp=X, clearFAC1 mantissa3 & normalise LAB_STFA LDA #$00 ; clear A STA FAC1_3 ; clear FAC1 mantissa3 STX FAC1_e ; set FAC1 exponent STA FAC1_r ; clear FAC1 rounding byte STA FAC1_s ; clear FAC1 sign (b7) JMP LAB_24D0 ; do ABS & normalise FAC1 ; perform ABS() LAB_ABS LSR FAC1_s ; 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_27F8 STA ut2_pl ; save pointer low byte LAB_27FA STY ut2_ph ; save pointer high byte LDY #$00 ; clear index LDA (ut2_pl),Y ; get exponent INY ; increment index TAX ; copy (AY) exponent to X BEQ LAB_27CA ; branch if (AY) exponent=0 & get FAC1 sign ; A=FF,C=1/-ve A=01,C=0/+ve LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign) EOR FAC1_s ; EOR FAC1 sign (b7) BMI LAB_27CE ; if signs <> do return A=FF,C=1/-ve ; A=01,C=0/+ve & return CPX FAC1_e ; compare (AY) exponent with FAC1 exponent BNE LAB_2828 ; branch if different LDA (ut2_pl),Y ; get (AY) mantissa1 (with sign) ORA #$80 ; normalise top bit CMP FAC1_1 ; compare with FAC1 mantissa1 BNE LAB_2828 ; branch if different INY ; increment index LDA (ut2_pl),Y ; get mantissa2 CMP FAC1_2 ; compare with FAC1 mantissa2 BNE LAB_2828 ; branch if different INY ; increment index LDA #$7F ; set for 1/2 value rounding byte CMP FAC1_r ; compare with FAC1 rounding byte (set carry) LDA (ut2_pl),Y ; get mantissa3 SBC FAC1_3 ; subtract FAC1 mantissa3 BEQ LAB_2850 ; exit if mantissa3 equal ; gets here if number <> FAC1 LAB_2828 LDA FAC1_s ; get FAC1 sign (b7) BCC LAB_282E ; branch if FAC1 > (AY) EOR #$FF ; else toggle FAC1 sign LAB_282E JMP LAB_27D0 ; return A=FF,C=1/-ve A=01,C=0/+ve ; convert FAC1 floating-to-fixed LAB_2831 LDA FAC1_e ; get FAC1 exponent BEQ LAB_287F ; if zero go clear FAC1 & return SEC ; set carry for subtract SBC #$98 ; subtract maximum integer range exponent BIT FAC1_s ; test FAC1 sign (b7) BPL LAB_2845 ; branch if FAC1 +ve ; FAC1 was -ve TAX ; copy subtracted exponent LDA #$FF ; overflow for -ve number STA FAC1_o ; set FAC1 overflow byte JSR LAB_253D ; twos complement FAC1 mantissa TXA ; restore subtracted exponent LAB_2845 LDX #FAC1_e ; set index to FAC1 CMP #$F9 ; compare exponent result BPL LAB_2851 ; if < 8 shifts shift FAC1 A times right & ret JSR LAB_257B ; shift FAC1 A times right (> 8 shifts) STY FAC1_o ; clear FAC1 overflow byte LAB_2850 RTS ; ; shift FAC1 A times right LAB_2851 TAY ; copy shift count LDA FAC1_s ; get FAC1 sign (b7) AND #$80 ; mask sign bit only (x000 0000) LSR FAC1_1 ; shift FAC1 mantissa1 ORA FAC1_1 ; OR sign in b7 FAC1 mantissa1 STA FAC1_1 ; save FAC1 mantissa1 JSR LAB_2592 ; shift FAC1 Y times right STY FAC1_o ; clear FAC1 overflow byte RTS ; ; perform INT() LAB_INT LDA FAC1_e ; get FAC1 exponent CMP #$98 ; compare with max int BCS LAB_2886 ; exit if >= (already int, too big for fractional part!) JSR LAB_2831 ; convert FAC1 floating-to-fixed STY FAC1_r ; save FAC1 rounding byte LDA FAC1_s ; get FAC1 sign (b7) STY FAC1_s ; save FAC1 sign (b7) EOR #$80 ; toggle FAC1 sign ROL A ; shift into carry LDA #$98 ; set new exponent STA FAC1_e ; save FAC1 exponent LDA FAC1_3 ; get FAC1 mantissa3 STA Temp3 ; JMP LAB_24D0 ; do ABS & normalise FAC1 ; clear FAC1 & return LAB_287F STA FAC1_1 ; clear FAC1 mantissa1 STA FAC1_2 ; clear FAC1 mantissa2 STA FAC1_3 ; clear FAC1 mantissa3 TAY ; clear Y LAB_2886 RTS ; ; get FAC1 from string ; this routine now handles hex and binary values from strings ; starting with "$" and "%" respectively LAB_2887 LDY #$00 ; clear Y LDX #$09 ; set index LAB_288B STY numexp,X ; clear byte DEX ; decrement index BPL LAB_288B ; loop until numexp to negnum (and FAC1) = $00 BCC LAB_28FE ; branch if 1st character numeric ; get FAC1 from string .. first character wasn't numeric CMP #'- ; else compare with "-" BNE LAB_289A ; branch if not "-" STX negnum ; set flag for -ve number (X = $FF) BEQ LAB_289C ; branch always (go scan & check for hex/bin) ; get FAC1 from string .. first character wasn't numeric or - LAB_289A CMP #'+ ; else compare with "+" BNE LAB_289D ; branch if not "+" (go check for hex/bin) ; was "+" or "-" to start, so get next character LAB_289C .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BCC LAB_28FE ; branch if numeric character ; code here for hex and binary numbers LAB_289D CMP #'$ ; else compare with "$" BNE LAB_NHEX ; branch if not "$" JMP LAB_CHEX ; branch if "$" LAB_NHEX CMP #'% ; else compare with "%" BNE LAB_28A3 ; branch if not "%" (continue original code) JMP LAB_CBIN ; branch if "%" LAB_289E .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory (ignore + or get next number) LAB_28A1 BCC LAB_28FE ; branch if numeric character ; get FAC1 from string .. character wasn't numeric, -, +, hex or binary LAB_28A3 CMP #'. ; else compare with "." BEQ LAB_28D5 ; branch if "." ; get FAC1 from string .. character wasn't numeric, -, + or . CMP #'E ; else compare with "E" BNE LAB_28DB ; branch if not "E" ; was "E" so evaluate exponential part .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BCC LAB_28C7 ; branch if numeric character CMP #TK_MINUS ; else compare with token for - BEQ LAB_28C2 ; branch if token for - CMP #'- ; else compare with "-" BEQ LAB_28C2 ; branch if "-" CMP #TK_PLUS ; else compare with token for + BEQ LAB_28C4 ; branch if token for + CMP #'+ ; else compare with "+" BEQ LAB_28C4 ; branch if "+" BNE LAB_28C9 ; branch always LAB_28C2 ROR expneg ; set exponent -ve flag (C, which=1, into b7) LAB_28C4 .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory LAB_28C7 BCC LAB_2925 ; branch if numeric character LAB_28C9 BIT expneg ; test exponent -ve flag BPL LAB_28DB ; if +ve go evaluate exponent ; else do exponent = -exponent LDA #$00 ; clear result SEC ; set carry for subtract SBC expcnt ; subtract exponent byte JMP LAB_28DD ; go evaluate exponent LAB_28D5 ROR numdpf ; set decimal point flag BIT numdpf ; test decimal point flag BVC LAB_289E ; branch if only one decimal point so far ; evaluate exponent LAB_28DB LDA expcnt ; get exponent count byte LAB_28DD SEC ; set carry for subtract SBC numexp ; subtract numerator exponent STA expcnt ; save exponent count byte BEQ LAB_28F6 ; branch if no adjustment BPL LAB_28EF ; else if +ve go do FAC1*10^expcnt ; else go do FAC1/10^(0-expcnt) LAB_28E6 JSR LAB_26B9 ; divide by 10 INC expcnt ; increment exponent count byte BNE LAB_28E6 ; loop until all done BEQ LAB_28F6 ; branch always LAB_28EF JSR LAB_269E ; multiply by 10 DEC expcnt ; decrement exponent count byte BNE LAB_28EF ; loop until all done LAB_28F6 LDA negnum ; get -ve flag BMI LAB_28FB ; if -ve do - FAC1 & return RTS ; ; do - FAC1 & return LAB_28FB JMP LAB_GTHAN ; do - FAC1 & return ; do unsigned FAC1*10+number LAB_28FE PHA ; save character BIT numdpf ; test decimal point flag BPL LAB_2905 ; skip exponent increment if not set INC numexp ; else increment number exponent LAB_2905 JSR LAB_269E ; multiply FAC1 by 10 PLA ; restore character SEC ; set carry for subtract SBC #$30 ; convert to binary JSR LAB_2912 ; evaluate new ASCII digit JMP LAB_289E ; go do next character ; evaluate new ASCII digit LAB_2912 PHA ; save digit JSR LAB_27AB ; round & copy FAC1 to FAC2 PLA ; restore digit JSR LAB_27DB ; save A as integer byte LDA FAC2_s ; get FAC2 sign (b7) EOR FAC1_s ; toggle with FAC1 sign (b7) STA FAC_sc ; save sign compare (FAC1 EOR FAC2) LDX FAC1_e ; get FAC1 exponent JMP LAB_ADD ; add FAC2 to FAC1 & return ; evaluate next character of exponential part of number LAB_2925 LDA expcnt ; get exponent count byte CMP #$0A ; compare with 10 decimal BCC LAB_2934 ; branch if less LDA #$64 ; make all -ve exponents = -100 decimal (causes underflow) BIT expneg ; test exponent -ve flag BMI LAB_2942 ; branch if -ve JMP LAB_2564 ; else do overflow error LAB_2934 ASL A ; *2 ASL A ; *4 CLC ; clear carry for add ADC expcnt ; *5 ASL A ; *10 CLC ; clear carry for add LDY #$00 ; set index ADC (Bpntrl),Y ; add character (will be $30 too much!) SEC ; set carry for subtract SBC #$30 ; convert character to binary LAB_2942 STA expcnt ; save exponent count byte JMP LAB_28C4 ; go get next character ; print " in line [LINE #]" LAB_2953 LDA #LAB_LMSG ; point to " in line" message high byte JSR LAB_296B ; print null terminated string ; Print Basic line # LDA Clineh ; get current line high byte LDX Clinel ; get current line low byte ; print XA as unsigned integer LAB_295E STA FAC1_1 ; save low byte as FAC1 mantissa1 STX FAC1_2 ; save high byte as FAC1 mantissa2 LDX #$90 ; set exponent to 16d bits SEC ; set integer is +ve flag JSR LAB_STFA ; set exp=X, clearFAC1 mantissa3 & normalise JSR LAB_296E ; convert FAC1 to string LAB_296B JMP LAB_18C3 ; print null terminated string from memory & RET ; convert FAC1 to ASCII string result in (AY) ; not any more, moved scratchpad to page 0 LAB_296E LDY #$01 ; set index = 1 LAB_2970 ; STR$() function enters here LDA #$20 ; character = " " (assume +ve) BIT FAC1_s ; test FAC1 sign (b7) BPL LAB_2978 ; branch if +ve LDA #$2D ; else character = "-" LAB_2978 STA Decss,Y ; save leading character (" " or "-") STA FAC1_s ; save FAC1 sign (b7) STY Sendl ; save index INY ; increment index LDX FAC1_e ; get FAC1 exponent BNE LAB_2989 ; branch if FAC1<>0 ; exponent was $00 so FAC1 is 0 LDA #$30 ; set character = "0" JMP LAB_2A89 ; save last character, [EOT] & exit ; FAC1 is some non zero value LAB_2989 LDA #$00 ; clear (number exponent count) CPX #$81 ; compare FAC1 exponent with $81 (>1.00000) BCS LAB_299A ; branch if FAC1=>1 ; FAC1<1 LDA #LAB_294F ; set pointer high byte to 1,000,000 JSR LAB_25FB ; do convert AY, FCA1*(AY) LDA #$FA ; set number exponent count (-6) LAB_299A STA numexp ; save number exponent count LAB_299C LDA #LAB_294B ; set pointer high byte to 999999.4375 JSR LAB_27F8 ; compare FAC1 with (AY) BEQ LAB_29C3 ; exit if FAC1 = (AY) BPL LAB_29B9 ; go do /10 if FAC1 > (AY) ; FAC1 < (AY) LAB_29A7 LDA #LAB_2947 ; set pointer high byte to 99999.9375 JSR LAB_27F8 ; compare FAC1 with (AY) BEQ LAB_29B2 ; branch if FAC1 = (AY) (allow decimal places) BPL LAB_29C0 ; branch if FAC1 > (AY) (no decimal places) ; FAC1 <= (AY) LAB_29B2 JSR LAB_269E ; multiply by 10 DEC numexp ; decrement number exponent count BNE LAB_29A7 ; go test again (branch always) LAB_29B9 JSR LAB_26B9 ; divide by 10 INC numexp ; increment number exponent count BNE LAB_299C ; go test again (branch always) ; now we have just the digits to do LAB_29C0 JSR LAB_244E ; add 0.5 to FAC1 (round FAC1) LAB_29C3 JSR LAB_2831 ; convert FAC1 floating-to-fixed LDX #$01 ; set default digits before dp = 1 LDA numexp ; get number exponent count CLC ; clear carry for add ADC #$07 ; up to 6 digits before point BMI LAB_29D8 ; if -ve then 1 digit before dp CMP #$08 ; A>=8 if n>=1E6 BCS LAB_29D9 ; branch if >= $08 ; carry is clear ADC #$FF ; take 1 from digit count TAX ; copy to A LDA #$02 ;.set exponent adjust LAB_29D8 SEC ; set carry for subtract LAB_29D9 SBC #$02 ; -2 STA expcnt ;.save exponent adjust STX numexp ; save digits before dp count TXA ; copy to A BEQ LAB_29E4 ; branch if no digits before dp BPL LAB_29F7 ; branch if digits before dp LAB_29E4 LDY Sendl ; get output string index LDA #$2E ; character "." INY ; increment index STA Decss,Y ; save to output string TXA ; BEQ LAB_29F5 ; LDA #$30 ; character "0" INY ; increment index STA Decss,Y ; save to output string LAB_29F5 STY Sendl ; save output string index LAB_29F7 LDY #$00 ; clear index (point to 100,000) LDX #$80 ; LAB_29FB LDA FAC1_3 ; get FAC1 mantissa3 CLC ; clear carry for add ADC LAB_2A9C,Y ; add -ve LSB STA FAC1_3 ; save FAC1 mantissa3 LDA FAC1_2 ; get FAC1 mantissa2 ADC LAB_2A9B,Y ; add -ve NMSB STA FAC1_2 ; save FAC1 mantissa2 LDA FAC1_1 ; get FAC1 mantissa1 ADC LAB_2A9A,Y ; add -ve MSB STA FAC1_1 ; save FAC1 mantissa1 INX ; BCS LAB_2A18 ; BPL LAB_29FB ; not -ve so try again BMI LAB_2A1A ; LAB_2A18 BMI LAB_29FB ; LAB_2A1A TXA ; BCC LAB_2A21 ; EOR #$FF ; ADC #$0A ; LAB_2A21 ADC #$2F ; add "0"-1 to result INY ; increment index .. INY ; .. to next less .. INY ; .. power of ten STY Cvaral ; save as current var address low byte LDY Sendl ; get output string index INY ; increment output string index TAX ; copy character to X AND #$7F ; mask out top bit STA Decss,Y ; save to output string DEC numexp ; decrement # of characters before the dp BNE LAB_2A3B ; branch if still characters to do ; else output the point LDA #$2E ; character "." INY ; increment output string index STA Decss,Y ; save to output string LAB_2A3B STY Sendl ; save output string index LDY Cvaral ; get current var address low byte TXA ; get character back EOR #$FF ; AND #$80 ; TAX ; CPY #$12 ; compare index with max BNE LAB_29FB ; loop if not max ; now remove trailing zeroes LDY Sendl ; get output string index LAB_2A4B LDA Decss,Y ; get character from output string DEY ; decrement output string index CMP #$30 ; compare with "0" BEQ LAB_2A4B ; loop until non "0" character found CMP #$2E ; compare with "." BEQ LAB_2A58 ; branch if was dp ; restore last character INY ; increment output string index LAB_2A58 LDA #$2B ; character "+" LDX expcnt ; get exponent count BEQ LAB_2A8C ; if zero go set null terminator & exit ; exponent isn't zero so write exponent BPL LAB_2A68 ; branch if exponent count +ve LDA #$00 ; clear A SEC ; set carry for subtract SBC expcnt ; subtract exponent count adjust (convert -ve to +ve) TAX ; copy exponent count to X LDA #$2D ; character "-" LAB_2A68 STA Decss+2,Y ; save to output string LDA #$45 ; character "E" STA Decss+1,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_2A74 INX ; increment 10's character SBC #$0A ;.subtract 10 from exponent count BCS LAB_2A74 ; loop while still >= 0 ADC #$3A ; add character ":" ($30+$0A, result is 10 less that value) STA Decss+4,Y ; save to output string TXA ; copy 10's character STA Decss+3,Y ; save to output string LDA #$00 ; set null terminator STA Decss+5,Y ; save to output string BEQ LAB_2A91 ; go set string pointer (AY) and exit (branch always) ; save last character, [EOT] & exit LAB_2A89 STA Decss,Y ; save last character to output string ; set null terminator & exit LAB_2A8C LDA #$00 ; set null terminator STA Decss+1,Y ; save after last character ; set string pointer (AY) and exit LAB_2A91 LDA #<(Decss+1) ; set result string low pointer LDY #>(Decss+1) ; set result string high pointer RTS ; ; Perform power function LAB_POWER BEQ LAB_EXP ; go do EXP() LAB_2AB8 LDA FAC2_e ; get FAC2 exponent BNE LAB_2ABF ; branch if FAC2<>0 JMP LAB_24F3 ; clear FAC1 exponent & sign & return LAB_2ABF LDX #func_l ; set destination pointer high byte JSR LAB_2778 ; pack FAC1 into (XY) LDA FAC2_s ; get FAC2 sign (b7) BPL LAB_2AD9 ; branch if FAC2>0 JSR LAB_INT ; perform INT LDA #func_l ; set source pointer high byte JSR LAB_27F8 ; compare FAC1 with (AY) BNE LAB_2AD9 ; branch if FAC1 <> (AY) TYA ; copy sign to A LDY Temp3 ; LAB_2AD9 JSR LAB_279D ; save FAC1 sign & copy ABS(FAC2) to FAC1 TYA ; PHA ; JSR LAB_LOG ; do LOG(n) LDA #garb_l ; set pointer high byte JSR LAB_25FB ; do convert AY, FCA1*(AY) (square the value) JSR LAB_EXP ; go do EXP(n) PLA ; LSR A ; BCC LAB_2AF9 ; if no bit then exit ; Perform negation ; do - FAC1 LAB_GTHAN LDA FAC1_e ; get FAC1 exponent BEQ LAB_2AF9 ; exit if FAC1_e = $00 LDA FAC1_s ; get FAC1 sign (b7) EOR #$FF ; complement it STA FAC1_s ; save FAC1 sign (b7) LAB_2AF9 RTS ; ; perform EXP() (x^e) LAB_EXP LDA #LAB_2AFA ; set 1.443 pointer high byte JSR LAB_25FB ; do convert AY, FCA1*(AY) LDA FAC1_r ; get FAC1 rounding byte ADC #$50 ; +$50/$100 BCC LAB_2B2B ; skip rounding if no carry JSR LAB_27C2 ; round FAC1 (no check) LAB_2B2B STA FAC2_r ; save FAC2 rounding byte JSR LAB_27AE ; copy FAC1 to FAC2 LDA FAC1_e ; get FAC1 exponent CMP #$88 ; compare with EXP limit (256d) BCC LAB_2B39 ; branch if less LAB_2B36 JSR LAB_2690 ; handle overflow and underflow LAB_2B39 JSR LAB_INT ; perform INT LDA Temp3 ;. CLC ; clear carry for add ADC #$81 ;. BEQ LAB_2B36 ;. SEC ;. SBC #$01 ;. PHA ;.save FAC2 exponent ; swap FAC1 & FAC2 LDX #$04 ; 4 bytes to do LAB_2B49 LDA FAC2_e,X ; get FAC2,X LDY FAC1_e,X ; get FAC1,X STA FAC1_e,X ; save FAC1,X STY FAC2_e,X ; save FAC2,X DEX ; decrement count/index BPL LAB_2B49 ; loop if not all done LDA FAC2_r ; get FAC2 rounding byte STA FAC1_r ; save as FAC1 rounding byte JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1 JSR LAB_GTHAN ; do - FAC1 LDA #LAB_2AFE ; set counter pointer high byte JSR LAB_2B84 ; go do series evaluation LDA #$00 ; clear A STA FAC_sc ; clear sign compare (FAC1 EOR FAC2) PLA ;.get saved FAC2 exponent JMP LAB_2675 ; test & adjust accumulators & return ; ^2 then series evaluation LAB_2B6E STA Cptrl ; save count pointer low byte STY Cptrh ; save count pointer high byte JSR LAB_276E ; pack FAC1 into Adatal LDA #Adatal ; pointer to original # high byte JMP LAB_25FB ; do convert AY, FCA1*(AY) & return ; series evaluation LAB_2B84 STA Cptrl ; save count pointer low byte STY Cptrh ; save count pointer high byte LAB_2B88 JSR LAB_276B ; pack FAC1 into numexp LDA (Cptrl),Y ; get constants count STA numcon ; save constants count LDY Cptrl ; get count pointer low byte INY ; increment it (now constants pointer) TYA ; copy it BNE LAB_2B97 ; skip next if no overflow INC Cptrh ; else increment high byte LAB_2B97 STA Cptrl ; save low byte LDY Cptrh ; get high byte LAB_2B9B JSR LAB_25FB ; do convert AY, FCA1*(AY) LDA Cptrl ; get constants pointer low byte LDY Cptrh ; get constants pointer high byte CLC ; clear carry for add ADC #$04 ; +4 to low pointer (4 bytes per constant) BCC LAB_2BA8 ; skip next if no overflow INY ; increment high byte LAB_2BA8 STA Cptrl ; save pointer low byte STY Cptrh ; save pointer high byte JSR LAB_246C ; add (AY) to FAC1 LDA #numexp ; set pointer high byte to partial @ numexp DEC numcon ; decrement constants count BNE LAB_2B9B ; loop until all done RTS ; ; RND(n), 31 bit version. make n=0 for next number in sequence or n<>0 to get next ; number in sequence after seed n LAB_RND JSR LAB_27CA ; test sign and zero BEQ NextPRN ; do next random # if zero ; else get seed into random number store LDX #Rbyte4 ; set PRNG pointer low byte LDY #$00 ; set PRNG pointer high byte JSR LAB_2778 ; pack FAC1 into (XY) NextPRN LDX #$00 ; clear bit count LDA Rbyte4 ; get PRNG extra byte ROR A ; bit 32 -> carry ROR A ; bit 31 -> carry BCC Ninc1 ; skip increment if =0 INX ; else increment bit count Ninc1 AND #$08 ; mask bit 30 (bit 28 before shifts) BEQ Ninc2 ; skip increment if =0 INX ; else increment bit count Ninc2 TXA ; copy bit count to A LSR A ; shift b0 to carry ROR Rbyte1 ; shift PRNG most significant byte ROR Rbyte3 ; shift PRNG middle byte ROR Rbyte2 ; shift PRNG least significant byte ROR Rbyte4 ; shift PRNG extra byte LDX #$02 ; three bytes to copy CopyPRNG LDA Rbyte1,X ; get PRNG byte STA FAC1_1,X ; save FAC1 byte DEX BPL CopyPRNG ; loop if not complete LDA #$80 ; set the exponent STA FAC1_e ; save FAC1 exponent ASL ; clear A STA FAC1_s ; save FAC1 sign JMP LAB_24D5 ; normalise FAC1 & return ; perform COS() LAB_COS LDA #LAB_2C78 ; set (pi/2) pointer high byte JSR LAB_246C ; add (AY) to FAC1 ; perform SIN() LAB_SIN JSR LAB_27AB ; round & copy FAC1 to FAC2 LDA #LAB_2C7C ; set (2*pi) pointer high byte LDX FAC2_s ; get FAC2 sign (b7) JSR LAB_26C2 ; divide by (AY) (X=sign) JSR LAB_27AB ; round & copy FAC1 to FAC2 JSR LAB_INT ; perform INT LDA #$00 ; clear byte STA FAC_sc ; clear sign compare (FAC1 EOR FAC2) JSR LAB_SUBTRACT ; perform subtraction, FAC2 from FAC1 LDA #LAB_2C80 ; set 0.25 pointer high byte JSR LAB_2455 ; perform subtraction, (AY) from FAC1 LDA FAC1_s ; get FAC1 sign (b7) PHA ; save FAC1 sign BPL LAB_2C35 ; branch if +ve ; FAC1 sign was -ve JSR LAB_244E ; add 0.5 to FAC1 LDA FAC1_s ; get FAC1 sign (b7) BMI LAB_2C38 ; branch if -ve LDA Cflag ; get comparison evaluation flag EOR #$FF ; toggle flag STA Cflag ; save comparison evaluation flag LAB_2C35 JSR LAB_GTHAN ; do - FAC1 LAB_2C38 LDA #LAB_2C80 ; set 0.25 pointer high byte JSR LAB_246C ; add (AY) to FAC1 PLA ; restore FAC1 sign BPL LAB_2C45 ; branch if was +ve ; else correct FAC1 JSR LAB_GTHAN ; do - FAC1 LAB_2C45 LDA #LAB_2C84 ; set pointer high byte to counter JMP LAB_2B6E ; ^2 then series evaluation & RET ; perform TAN() LAB_TAN JSR LAB_276E ; pack FAC1 into Adatal LDA #$00 ; clear byte STA Cflag ; clear comparison evaluation flag JSR LAB_SIN ; go do SIN(n) LDX #func_l ; set sin(n) pointer high byte JSR LAB_2778 ; pack FAC1 into (XY) LDA #Adatal ; set n pointer high addr JSR LAB_UFAC ; unpack memory (AY) into FAC1 LDA #$00 ; clear byte STA FAC1_s ; clear FAC1 sign (b7) LDA Cflag ; get comparison evaluation flag JSR LAB_2C74 ; save flag and go do series evaluation LDA #func_l ; set sin(n) pointer high byte JMP LAB_26CA ; convert AY and do (AY)/FAC1 LAB_2C74 PHA ; save comparison evaluation flag JMP LAB_2C35 ; go do series evaluation ; perform ATN() LAB_ATN LDA FAC1_s ; get FAC1 sign (b7) PHA ; save sign BPL LAB_2CA1 ; branch if +ve JSR LAB_GTHAN ; else do - FAC1 LAB_2CA1 LDA FAC1_e ; get FAC1 exponent PHA ; push exponent CMP #$81 ; compare with 1 BCC LAB_2CAF ; branch if FAC1<1 LDA #LAB_259C ; set 1 pointer high byte JSR LAB_26CA ; convert AY and do (AY)/FAC1 LAB_2CAF LDA #LAB_2CC9 ; set pointer high byte to counter JSR LAB_2B6E ; ^2 then series evaluation PLA ; restore old FAC1 exponent CMP #$81 ; compare with 1 BCC LAB_2CC2 ; branch if FAC1<1 LDA #LAB_2C78 ; set (pi/2) pointer high byte JSR LAB_2455 ; perform subtraction, (AY) from FAC1 LAB_2CC2 PLA ; restore FAC1 sign BPL LAB_2D04 ; exit if was +ve JMP LAB_GTHAN ; else do - FAC1 & return ; perform BITSET LAB_BITSET JSR LAB_GADB ; get two parameters for POKE or WAIT CPX #$08 ; only 0 to 7 are allowed BCS FCError ; branch if > 7 LDA #$00 ; clear A SEC ; set the carry S_Bits ROL A ; shift bit DEX ; decrement bit number BPL S_Bits ; loop if still +ve INX ; make X = $00 ORA (Itempl,X) ; or with byte via temporary integer (addr) STA (Itempl,X) ; save byte via temporary integer (addr) LAB_2D04 RTS ; ; perform BITCLR LAB_BITCLR JSR LAB_GADB ; get two parameters for POKE or WAIT CPX #$08 ; only 0 to 7 are allowed BCS FCError ; branch if > 7 LDA #$FF ; set A S_Bitc ROL A ; shift bit DEX ; decrement bit number BPL S_Bitc ; loop if still +ve INX ; make X = $00 AND (Itempl,X) ; and with byte via temporary integer (addr) STA (Itempl,X) ; save byte via temporary integer (addr) RTS ; FCError JMP LAB_FCER ; do function call error, then warm start ; perform BITTST() LAB_BTST JSR LAB_1BFE ; scan for "(" , else do syntax error, then warm start JSR LAB_GADB ; get two parameters for POKE or WAIT CPX #$08 ; only 0 to 7 are allowed BCS FCError ; branch if > 7 .BYTE $20, LAB_GBYT, $00 ;JSR LAB_GBYT ; get next BASIC byte CMP #') ; is next character ")" BEQ TST_OK ; if ")" go do rest of function JMP LAB_SNER ; do syntax error, then warm start TST_OK .BYTE $20, LAB_IGBY, $00 ;JSR LAB_IGBY ; update BASIC execute pointer (to character past ")") LDA #$00 ; clear A SEC ; set the carry T_Bits ROL A ; shift bit DEX ; decrement bit number BPL T_Bits ; loop if still +ve INX ; make X = $00 AND (Itempl,X) ; AND with byte via temporary integer (addr) BEQ LAB_NOTT ; branch if zero (already correct) LDA #$FF ; set for -1 result LAB_NOTT JMP LAB_27DB ; go do SGN tail ; perform BIN$() LAB_BINS CPX #$19 ; max + 1 BCS BinFErr ; exit if too big ( > or = ) STX TempB ; save # of characters ($00 = leading zero remove) LDA #$18 ; need A byte long space JSR LAB_MSSP ; make string space A bytes long LDY #$17 ; set index NextB1 LSR nums_1 ; shift highest byte ROR nums_2 ; shift middle byte ROR nums_3 ; shift lowest byte bit 0 to carry LDA #'0 ; set for zero ADC #$00 ; add carry bit STA (str_pl),Y ; save to temp string + index DEY ; decrement index BPL NextB1 ; loop if not done LDX #$18 ; character count LDA TempB ; get # of characters BEQ EndBHS ; branch if truncate TAX ; copy length to X SEC ; set carry for add ! EOR #$FF ; 1's complement ADC #$18 ; add 24d BEQ GoPr2 ; if zero print whole string BNE GoPr1 ; else go make output string ; this is the exit code and is also used by HEX$() ; truncate string to remove leading "0"s EndBHS TAY ; clear index (A=0, X=length here) NextB2 LDA (str_pl),Y ; get character from string CMP #'0 ; compare with "0" BNE GoPr ; if not "0" then go print string from here DEX ; decrement character count BEQ GoPr3 ; if zero then end of string so go print it INY ; else increment index BPL NextB2 ; loop always ; make fixed length output string - ignore overflows! GoPr3 INX ; need at least 1 character GoPr TYA ; copy result GoPr1 CLC ; clear carry for add ADC str_pl ; add low address STA str_pl ; save low address LDA #$00 ; do high byte ADC str_ph ; add high address STA str_ph ; save high address GoPr2 PLA ; dump return address (return via get value from line) PLA ; dump return address STX str_ln ; X holds string length .BYTE $20, LAB_IGBY, $00 ;JSR LAB_IGBY ; update BASIC execute pointer (to character past ")") JMP LAB_RTST ; check for space on descriptor stack then put address ; and length on descriptor stack & update stack pointers BinFErr JMP LAB_FCER ; do function call error, then warm start ; perform HEX$() LAB_HEXS CPX #$07 ; max + 1 BCS BinFErr ; exit if too big ( > or = ) STX TempB ; save # of characters LDA #$06 ; need 6 bytes for string JSR LAB_MSSP ; make string space A bytes long LDY #$05 ; set string index SED ; need decimal mode for nibble convert LDA nums_3 ; get lowest byte JSR LAB_A2HX ; convert A to ASCII hex byte & output LDA nums_2 ; get middle byte JSR LAB_A2HX ; convert A to ASCII hex byte & output LDA nums_1 ; get highest byte JSR LAB_A2HX ; convert A to ASCII hex byte & output CLD ; back to binary LDX #$06 ; character count LDA TempB ; get # of characters BEQ EndBHS ; branch if truncate TAX ; copy length to X SEC ; set carry for add ! EOR #$FF ; 1's complement ADC #$06 ; add 6d BEQ GoPr2 ; if zero print whole string BNE GoPr1 ; else go make output string (branch always) ; convert A to ASCII hex byte & output .. note set decimal mode before calling LAB_A2HX TAX ; save byte JSR LAB_AL2X ; convert low nibble to ASCII & output TXA ; get byte back LSR A ; /2 shift high nibble to low nibble LSR A ; /4 LSR A ; /8 LSR A ; /16 LAB_AL2X AND #$0F ; mask off top bits CMP #$0A ; set carry for +1 if >9 ADC #'0 ; add ASCII "0" STA (str_pl),Y ; save to temp string DEY ; decrement counter RTS ; gets here if the first character was "$" for hex ; get hex number LAB_CHEX .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BCC LAB_ISHN ; branch if numeric character ORA #$20 ; case convert, allow "A" to "F" and "a" to "f" SEC ; set carry for subtract SBC #'a ; subtract "a" BCC LAB_EXCH ; exit if <"a" CMP #$06 ; compare normalised with $06 (max+1) BCS LAB_EXCH ; exit if >"f" ADC #$3A ; convert to nibble+"0" LAB_ISHN SBC #$2F ; convert from ASCII (carry is clear) TAX ; save nibble LDA FAC1_e ; get FAC1 exponent BEQ LAB_MLTE ; skip multiply if zero CLC ; clear carry for add ADC #$04 ; add four to exponent (*16) BCS LAB_MLTO ; do overflow error if > $FF STA FAC1_e ; save FAC1 exponent LDA #$00 ; clear sign compare LAB_MLTE STA FAC_sc ; save sign compare (FAC1 EOR FAC2) TXA ; restore character JSR LAB_2912 ; evaluate new ASCII digit JMP LAB_CHEX ; go do next character LAB_MLTO JMP LAB_2564 ; do overflow error & warm start LAB_EXCH JMP LAB_28F6 ; evaluate -ve flag & return ; gets here if the first character was "%" for binary ; get binary number LAB_CBIN .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory BCS LAB_EXCH ; branch if not numeric character CMP #'2 ; compare with "2" (max+1) BCS LAB_EXCH ; exit if >="2" SBC #$2F ; convert from ASCII (carry is clear) TAX ; save bit LDA FAC1_e ; get FAC1 exponent BEQ LAB_MLBT ; skip multiply if zero INC FAC1_e ; increment FAC1 exponent (*2) BEQ LAB_MLTO ; do overflow error if = $00 LDA #$00 ; clear sign compare LAB_MLBT STA FAC_sc ; save sign compare (FAC1 EOR FAC2) TXA ; restore bit JSR LAB_2912 ; evaluate new ASCII digit JMP LAB_CBIN ; go do next character ; ctrl-c check routine. includes limited "life" byte save for INGET routine ; now also the code that checks to see if an interrupt has occurred CTRLC LDA ccflag ; get [CTRL-C] check flag BNE LAB_FBA2 ; exit if inhibited JSR V_INPT ; scan input device BCC LAB_FBA0 ; exit if buffer empty STA ccbyte ; save received byte LDX #$20 ; "life" timer for bytes STX ccnull ; set countdown JMP LAB_1636 ; return to BASIC LAB_FBA0 LDX ccnull ; get countdown byte BEQ LAB_FBA2 ; exit if finished DEC ccnull ; else decrement countdown LAB_FBA2 LDX #NmiBase ; set pointer to NMI values JSR LAB_CKIN ; go check interrupt LDX #IrqBase ; set pointer to IRQ values JSR LAB_CKIN ; go check interrupt LAB_CRTS RTS ; ; check whichever interrupt is indexed by X LAB_CKIN LDA PLUS_0,X ; get interrupt flag byte BPL LAB_CRTS ; branch if interrupt not enabled ; we disable the interrupt here and make two new commands RETIRQ and RETNMI to ; automatically enable the interrupt when we exit ASL A ; move happened bit to setup bit AND #$40 ; mask happened bits BEQ LAB_CRTS ; if no interrupt then exit STA PLUS_0,X ; save interrupt flag byte TXA ; copy index .. TAY ; .. to Y PLA ; dump return address low byte (call from CTRL-C) PLA ; dump return address high byte LDA #$05 ; need 5 bytes for GOSUB JSR LAB_1212 ; check room on stack for A bytes LDA Bpntrh ; get BASIC execute pointer high byte PHA ; push on stack LDA Bpntrl ; get BASIC execute pointer low byte PHA ; push on stack LDA Clineh ; get current line high byte PHA ; push on stack LDA Clinel ; get current line low byte PHA ; push on stack LDA #TK_GOSUB ; token for GOSUB PHA ; push on stack LDA PLUS_1,Y ; get interrupt code pointer low byte STA Bpntrl ; save as BASIC execute pointer low byte LDA PLUS_2,Y ; get interrupt code pointer high byte STA Bpntrh ; save as BASIC execute pointer high byte JMP LAB_15C2 ; go do interpreter inner loop ; (can't RTS, we used the stack! the RTS from the ctrl-c ; check will be taken when the RETIRQ/RETNMI/RETURN is ; executed at the end of the subroutine) ; get byte from input device, no waiting ; returns with carry set if byte in A INGET JSR V_INPT ; call scan input device BCS LAB_FB95 ; if byte go reset timer LDA ccnull ; get countdown BEQ LAB_FB96 ; exit if empty LDA ccbyte ; get last received byte SEC ; flag we got a byte LAB_FB95 LDX #$00 ; clear X STX ccnull ; clear timer because we got a byte LAB_FB96 RTS ; ; these routines only enable the interrupts if the set-up flag is set ; if not they have no effect ; perform IRQ {ON|OFF|CLEAR} LAB_IRQ LDX #IrqBase ; set pointer to IRQ values .byte $2C ; make next line BIT abs. ; perform NMI {ON|OFF|CLEAR} LAB_NMI LDX #NmiBase ; set pointer to NMI values CMP #TK_ON ; compare with token for ON BEQ LAB_INON ; go turn on interrupt CMP #TK_OFF ; compare with token for OFF BEQ LAB_IOFF ; go turn off interrupt SEC ; set carry for subtract SBC #TK_CLEAR ; compare with token for CLEAR (A = $00 if = TK_CLEAR) BEQ LAB_INEX ; go clear interrupt flags & return JMP LAB_SNER ; do syntax error, then warm start LAB_IOFF LDA #$7F ; clear A AND PLUS_0,X ; AND with interrupt setup flag BPL LAB_INEX ; go clear interrupt enabled flag & return LAB_INON LDA PLUS_0,X ; get interrupt setup flag ASL A ; Shift bit to enabled flag ORA PLUS_0,X ; OR with flag byte LAB_INEX STA PLUS_0,X ; save interrupt flag byte JMP LAB_IGBY ; update BASIC execute pointer & return ; these routines set up the pointers and flags for the interrupt routines ; note that the interrupts are also enabled by these commands ; perform ON IRQ LAB_SIRQ CLI ; enable interrupts LDX #IrqBase ; set pointer to IRQ values .byte $2C ; make next line BIT abs. ; perform ON NMI LAB_SNMI LDX #NmiBase ; set pointer to NMI values STX TempB ; save interrupt pointer .BYTE $20, LAB_IGBY, $00 ; JSR LAB_IGBY ; increment & scan memory (past token) JSR LAB_GFPN ; get fixed-point number into temp integer LDA Smeml ; get start of mem low byte LDX Smemh ; get start of mem high byte JSR LAB_SHLN ; search Basic for temp integer line number from AX BCS LAB_LFND ; if carry set go set-up interrupt JMP LAB_16F7 ; else go do "Undefined statement" error & warm start LAB_LFND LDX TempB ; get interrupt pointer LDA Baslnl ; get pointer low byte SBC #$01 ; -1 (carry already set for subtract) STA PLUS_1,X ; save as interrupt pointer low byte LDA Baslnh ; get pointer high byte SBC #$00 ; subtract carry STA PLUS_2,X ; save as interrupt pointer high byte LDA #$C0 ; set interrupt enabled/setup bits STA PLUS_0,X ; set interrupt flags LAB_IRTS RTS ; ; return from IRQ service, restores the enabled flag. ; perform RETIRQ LAB_RETIRQ BNE LAB_IRTS ; exit if following token (to allow syntax error) LDA IrqBase ; get interrupt flags ASL A ; copy setup to enabled (b7) ORA IrqBase ; OR in setup flag STA IrqBase ; save enabled flag JMP LAB_16E8 ; go do rest of RETURN ; return from NMI service, restores the enabled flag. ; perform RETNMI LAB_RETNMI BNE LAB_IRTS ; exit if following token (to allow syntax error) LDA NmiBase ; get set-up flag ASL A ; copy setup to enabled (b7) ORA NmiBase ; OR in setup flag STA NmiBase ; save enabled flag JMP LAB_16E8 ; go do rest of RETURN ; perform MAX() LAB_MAX JSR LAB_1BFE ; scan for "(" , else do syntax error, then warm start JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch LAB_MAXN JSR LAB_PHFA ; push FAC1, evaluate expression, ; pull FAC2 & compare with FAC1 BPL LAB_MAXN ; branch if no swap to do LDA FAC2_1 ; get FAC2 mantissa1 ORA #$80 ; set top bit (clear sign from compare) STA FAC2_1 ; save FAC2 mantissa1 JSR LAB_279B ; copy FAC2 to FAC1 BEQ LAB_MAXN ; go do next (branch always) ; perform MIN() LAB_MIN JSR LAB_1BFE ; scan for "(" , else do syntax error, then warm start JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch LAB_MINN JSR LAB_PHFA ; push FAC1, evaluate expression, ; pull FAC2 & compare with FAC1 BMI LAB_MINN ; branch if no swap to do BEQ LAB_MINN ; branch if no swap to do LDA FAC2_1 ; get FAC2 mantissa1 ORA #$80 ; set top bit (clear sign from compare) STA FAC2_1 ; save FAC2 mantissa1 JSR LAB_279B ; copy FAC2 to FAC1 BEQ LAB_MINN ; go do next (branch always) ; exit routine. don't bother returning to the loop code ; check for correct exit, else so syntax error LAB_MMEC CMP #') ; is it end of function? BNE LAB_MMSE ; if not do MAX MIN syntax error PLA ; dump return address low byte PLA ; dump return address high byte .BYTE $20, LAB_IGBY, $00 ;JSR LAB_IGBY ; update BASIC execute pointer (to chr past ")") RTS ; LAB_MMSE JMP LAB_SNER ; do syntax error, then warm start ; check for next, evaluate & return or exit ; this is the routine that does most of the work LAB_PHFA .BYTE $20, LAB_GBYT, $00 ;JSR LAB_GBYT ; get next BASIC byte CMP #$44 ; is there more ? BNE LAB_MMEC ; if not go do end check ; push FAC1 JSR LAB_27BA ; round FAC1 LDA FAC1_s ; get FAC1 sign ORA #$7F ; set all non sign bits AND FAC1_1 ; AND FAC1 mantissa1 (AND in sign bit) PHA ; push on stack LDA FAC1_2 ; get FAC1 mantissa2 PHA ; push on stack LDA FAC1_3 ; get FAC1 mantissa3 PHA ; push on stack LDA FAC1_e ; get FAC1 exponent PHA ; push on stack .BYTE $20, LAB_IGBY, $00 ;JSR LAB_IGBY ; scan & get next BASIC byte (after ",") JSR LAB_EVNM ; evaluate expression & check is numeric, ; else do type mismatch ; pop FAC2 (MAX/MIN expression so far) PLA ; pop exponent STA FAC2_e ; save FAC2 exponent PLA ; pop mantissa3 STA FAC2_3 ; save FAC2 mantissa3 PLA ; pop mantissa1 STA FAC2_2 ; save FAC2 mantissa2 PLA ; pop sign/mantissa1 STA FAC2_1 ; save FAC2 sign/mantissa1 STA FAC2_s ; save FAC2 sign ; compare FAC1 with (packed) FAC2 LDA #FAC2_e ; set pointer high byte to FAC2 JMP LAB_27F8 ; compare FAC1 with FAC2 (AY) & return ; returns A=$00 if FAC1 = (AY) ; returns A=$01 if FAC1 > (AY) ; returns A=$FF if FAC1 < (AY) ; perform WIDTH LAB_WDTH CMP #$44 ; is next byte "," BEQ LAB_TBSZ ; if so do tab size JSR LAB_GTBY ; get byte parameter TXA ; copy width to A BEQ LAB_NSTT ; branch if set for infinite line CPX #$10 ; else make min width = 16d BCC TabErr ; if less do function call error & exit ; this next compare ensures that we can't exit WIDTH via an error leaving the ; tab size greater than the line length. CPX TabSiz ; compare with tab size BCS LAB_NSTT ; branch if >= tab size STX TabSiz ; else make tab size = terminal width LAB_NSTT STX TWidth ; set the terminal width .BYTE $20, LAB_GBYT, $00 ;JSR LAB_GBYT ; get BASIC byte back BEQ WExit ; exit if no following CMP #$44 ; else is it "," BNE LAB_MMSE ; if not do syntax error LAB_TBSZ JSR LAB_SGBY ; scan and get byte parameter TXA ; copy TAB size BMI TabErr ; if >127 do function call error & exit CPX #$01 ; compare with min-1 BCC TabErr ; if <=1 do function call error & exit LDA TWidth ; set flags for width BEQ LAB_SVTB ; skip check if infinite line CPX TWidth ; compare TAB with width BEQ LAB_SVTB ; ok if = BCS TabErr ; branch if too big LAB_SVTB STX TabSiz ; save TAB size ; calculate tab column limit from TAB size. The Iclim is set to the last tab ; position on a line that still has at least one whole tab width between it ; and the end of the line. WExit LDA TWidth ; get width BEQ LAB_SULP ; branch if infinite line CMP TabSiz ; compare with tab size BCS LAB_WDLP ; branch if >= tab size STA TabSiz ; else make tab size = terminal width LAB_SULP SEC ; set carry for subtract LAB_WDLP SBC TabSiz ; subtract tab size BCS LAB_WDLP ; loop while no borrow ADC TabSiz ; add tab size back CLC ; clear carry for add ADC TabSiz ; add tab size back again STA Iclim ; save for now LDA TWidth ; get width back SEC ; set carry for subtract SBC Iclim ; subtract remainder STA Iclim ; save tab column limit LAB_NOSQ RTS TabErr JMP LAB_FCER ; do function call error, then warm start ; perform SQR() LAB_SQR LDA FAC1_s ; get FAC1 sign BMI TabErr ; if -ve do function call error LAB_NOFC LDA FAC1_e ; get exponent BEQ LAB_NOSQ ; do root if non zero JSR LAB_27AB ; round & copy FAC1 to FAC2 LDA #$00 ; clear A STA FACt_3 ; clear remainder STA FACt_2 ; STA FACt_1 ; STA TempB ; STA FAC1_3 ; clear root STA FAC1_2 ; STA FAC1_1 ; LDX #$18 ; 24 pairs of bits to do LDA FAC2_e ; get exponent AND #$01 ; check odd/even BNE LAB_SQE2 ; if odd only 1 shift first time LAB_SQE1 ASL FAC2_3 ; shift highest bit of number .. ROL FAC2_2 ; ROL FAC2_1 ; ROL FACt_3 ; .. into remainder ROL FACt_2 ; ROL FACt_1 ; ROL TempB ; .. never overflows LAB_SQE2 ASL FAC2_3 ; shift highest bit of number .. ROL FAC2_2 ; ROL FAC2_1 ; ROL FACt_3 ; .. into remainder ROL FACt_2 ; ROL FACt_1 ; ROL TempB ; .. never overflows ASL FAC1_3 ; root = root * 2 ROL FAC1_2 ; ROL FAC1_1 ; .. never overflows LDA FAC1_3 ; get root low byte ROL A ; *2 STA Temp3 ; save partial low byte LDA FAC1_2 ; get root low mid byte ROL A ; *2 STA Temp3+1 ; save partial low mid byte LDA FAC1_1 ; get root high mid byte ROL A ; *2 STA Temp3+2 ; save partial high mid byte LDA #$00 ; get root high byte (always $00) ROL A ; *2 STA Temp3+3 ; save partial high byte ; carry clear for subtract +1 LDA FACt_3 ; get remainder low byte SBC Temp3 ; subtract partial low byte STA Temp3 ; save partial low byte LDA FACt_2 ; get remainder low mid byte SBC Temp3+1 ; subtract partial low mid byte STA Temp3+1 ; save partial low mid byte LDA FACt_1 ; get remainder high mid byte SBC Temp3+2 ; subtract partial high mid byte TAY ; copy partial high mid byte LDA TempB ; get remainder high byte SBC Temp3+3 ; subtract partial high byte BCC LAB_SQNS ; skip sub if remainder smaller STA TempB ; save remainder high byte STY FACt_1 ; save remainder high mid byte LDA Temp3+1 ; get remainder low mid byte STA FACt_2 ; save remainder low mid byte LDA Temp3 ; get partial low byte STA FACt_3 ; save remainder low byte INC FAC1_3 ; increment root low byte (never any rollover) LAB_SQNS DEX ; decrement bit pair count BNE LAB_SQE1 ; loop if not all done SEC ; set carry for subtract LDA FAC2_e ; get exponent SBC #$80 ; normalise ROR A ; /2 and re-bias to $80 ADC #$00 ; add bit zero back in (allow for half shift) STA FAC1_e ; save it JMP LAB_24D5 ; normalise FAC1 & return ; perform VARPTR() LAB_VARPTR JSR LAB_1BFE ; scan for "(" , else do syntax error, then warm start JSR LAB_GVAR ; get var address JSR LAB_1BFB ; scan for ")" , else do syntax error, then warm start LDY Cvaral ; get var address low byte LDA Cvarah ; get var address high byte JMP LAB_AYFC ; save & convert integer AY to FAC1 & return ; perform PI LAB_PI LSR Dtypef ; clear data type flag, $FF=string, $00=numeric LDA #LAB_2C7C ; set (2*pi) pointer high byte JSR LAB_UFAC ; unpack memory (AY) into FAC1 DEC FAC1_e ; make result = PI RTS ; perform TWOPI LAB_TWOPI LSR Dtypef ; clear data type flag, $FF=string, $00=numeric LDA #LAB_2C7C ; set (2*pi) pointer high byte JMP LAB_UFAC ; unpack memory (AY) into FAC1 & return ; system dependant i/o vectors ; these are in RAM and are set by the monitor at start-up XSAVE .BYTE 00 YSAVE .BYTE 00 ASAVE .BYTE 00 CHROUT TAX LDA $E407 PHA LDA $E406 PHA TXA RTS ; CHRIN LDA #$C0 STA $10 LDA $E425 PHA LDA $E424 PHA RTS ; V_INPT ; JMP (VEC_IN) ; non halting scan input device STX XSAVE STY YSAVE STA ASAVE JSR CHRIN LDX XSAVE LDY YSAVE RTS V_OUTP ; JMP (VEC_OUT) ; send byte to output device STX XSAVE STY YSAVE STA ASAVE JSR CHROUT LDY YSAVE LDX XSAVE LDA ASAVE RTS V_LOAD JMP (VEC_LD) ; load BASIC program V_SAVE JMP (VEC_SV) ; save BASIC program ; The rest are tables messages and code for RAM ; the rest of the code is tables and BASIC start-up code PG2_TABS .byte $00 ; ctrl-c flag - $00 = enabled .byte $00 ; ctrl-c byte - GET needs this .byte $00 ; ctrl-c byte timeout - GET needs this .word CTRLC ; ctrl c check vector ; .word xxxx ; non halting key input - monitor to set this ; .word xxxx ; output vector - monitor to set this ; .word xxxx ; load vector - monitor to set this ; .word xxxx ; save vector - monitor to set this PG2_TABE ; character get subroutine for zero page ; For a 1.8432MHz 6502 including the JSR & RTS ; fastest (>=":") = 29 cycles = 15.7uS ; slowest (<":") = 40 cycles = 21.7uS ; space skip = +21 cycles = +11.4uS ; inc across page = +4 cycles = +2.2uS ; the target address for the LDA at LAB_2CF4 becomes the BASIC execute pointer once the ; block is copied to it's destination, any non zero page address will do at assembly ; time, to assemble a three byte instruction. ; page 0 initialisation table from $BC ; increment & scan memory LAB_2CEE INC Bpntrl ; increment BASIC execute pointer low byte BNE LAB_2CF4 ; branch if no carry ; else INC Bpntrh ; increment BASIC execute pointer high byte ; page 0 initialisation table from $C2 ; scan memory LAB_2CF4 LDA $FFFF ; get byte to scan (addr set by call routine) CMP #$3A ; compare with ":" BCS LAB_2D05 ; exit if>= (not numeric, carry set) CMP #$20 ; compare with " " BEQ LAB_2CEE ; 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_2D05 RTS ; ; page zero initialisation table $00-$12 inclusive StrTab .byte $4C ; JMP opcode .word LAB_COLD ; initial warm start vector (cold start) .byte $00 ; these bytes are not used by BASIC .word $0000 ; .word $0000 ; .word $0000 ; .byte $4C ; JMP opcode .word LAB_FCER ; initial user function vector ("Function call" error) .byte $00 ; default NULL count .byte $00 ; clear terminal position .byte $00 ; default terminal width byte .byte $F2 ; default limit for TAB = 14 .word Ram_base ; start of user RAM EndTab LAB_MSZM .byte "Memory size ",$00 LAB_SMSG .byte " Bytes free",$0D,$0A,$0A .byte "Enhanced BASIC",$0A,$00 ; numeric constants and series ; constants and series for LOG(n) LAB_25A0 .byte $02 ; counter .byte $80,$19,$56,$62 ; 0.59898 .byte $80,$76,$22,$F3 ; 0.96147 .byte $82,$38,$AA,$40 ; 2.88539 LAB_25AD .byte $80,$35,$04,$F3 ; 0.70711 1/root 2 LAB_25B1 .byte $81,$35,$04,$F3 ; 1.41421 root 2 LAB_25B5 .byte $80,$80,$00,$00 ; -0.5 LAB_25B9 .byte $80,$31,$72,$18 ; 0.69315 LOG(2) ; numeric PRINT constants LAB_2947 .byte $91,$43,$4F,$F8 ; 99999.9375 (max value with at least one decimal) LAB_294B .byte $94,$74,$23,$F7 ; 999999.4375 (max value before scientific notation) LAB_294F .byte $94,$74,$24,$00 ; 1000000 ; EXP(n) constants and series LAB_2AFA .byte $81,$38,$AA,$3B ; 1.4427 (1/LOG base 2 e) LAB_2AFE .byte $06 ; counter .byte $74,$63,$90,$8C ; 2.17023e-4 .byte $77,$23,$0C,$AB ; 0.00124 .byte $7A,$1E,$94,$00 ; 0.00968 .byte $7C,$63,$42,$80 ; 0.05548 .byte $7E,$75,$FE,$D0 ; 0.24023 .byte $80,$31,$72,$15 ; 0.69315 .byte $81,$00,$00,$00 ; 1.00000 ; trigonometric constants and series LAB_2C78 .byte $81,$49,$0F,$DB ; 1.570796371 (pi/2) as floating # LAB_2C84 .byte $04 ; counter .byte $86,$1E,$D7,$FB ; 39.7109 .byte $87,$99,$26,$65 ;-76.575 .byte $87,$23,$34,$58 ; 81.6022 .byte $86,$A5,$5D,$E1 ;-41.3417 LAB_2C7C .byte $83,$49,$0F,$DB ; 6.28319 (2*pi) as floating # LAB_2CC9 .byte $08 ; counter .byte $78,$3A,$C5,$37 ; 0.00285 .byte $7B,$83,$A2,$5C ;-0.0160686 .byte $7C,$2E,$DD,$4D ; 0.0426915 .byte $7D,$99,$B0,$1E ;-0.0750429 .byte $7D,$59,$ED,$24 ; 0.106409 .byte $7E,$91,$72,$00 ;-0.142036 .byte $7E,$4C,$B9,$73 ; 0.199926 .byte $7F,$AA,$AA,$53 ;-0.333331 LAB_259C .byte $81 LAB_1D96 ; $00,$00 used for undefined variables .byte $00,$00,$00 ; 1.000000 LAB_2AFD .byte $81,$80,$00,$00 ; -1.00000 (used for DEC) ; misc constants LAB_1DF7 .byte $90 ;-32768 (uses first three bytes from 0.5) LAB_2A96 .byte $80,$00,$00,$00 ; 0.5 LAB_2C80 .byte $7F,$00,$00,$00 ; 0.25 LAB_26B5 .byte $84,$20,$00,$00 ; 10.0000 divide by 10 constant ; This table is used in converting numbers to ASCII. LAB_2A9A LAB_2A9B = LAB_2A9A+1 LAB_2A9C = LAB_2A9B+1 .byte $FE,$79,$60 ; -100000 .byte $00,$27,$10 ; 10000 .byte $FF,$FC,$18 ; -1000 .byte $00,$00,$64 ; 100 .byte $FF,$FF,$F6 ; -10 .byte $00,$00,$01 ; 1 LAB_CTBL .word (LAB_END-1) ; END .word (LAB_FOR-1) ; FOR .word (LAB_NEXT-1) ; NEXT .word (LAB_DATA-1) ; DATA .word (LAB_INPUT-1) ; INPUT .word (LAB_DIM-1) ; DIM .word (LAB_READ-1) ; READ .word (LAB_LET-1) ; LET .word (LAB_DEC-1) ; DEC new command .word (LAB_GOTO-1) ; GOTO .word (LAB_RUN-1) ; RUN .word (LAB_IF-1) ; IF .word (LAB_RESTORE-1) ; RESTORE modified command .word (LAB_GOSUB-1) ; GOSUB .word (LAB_RETIRQ-1) ; RETIRQ new command .word (LAB_RETNMI-1) ; RETNMI new command .word (LAB_RETURN-1) ; RETURN .word (LAB_REM-1) ; REM .word (LAB_STOP-1) ; STOP .word (LAB_ON-1) ; ON modified command .word (LAB_NULL-1) ; NULL modified command .word (LAB_INC-1) ; INC new command .word (LAB_WAIT-1) ; WAIT .word (V_LOAD-1) ; LOAD .word (V_SAVE-1) ; SAVE .word (LAB_DEF-1) ; DEF .word (LAB_POKE-1) ; POKE .word (LAB_DOKE-1) ; DOKE new command .word (LAB_CALL-1) ; CALL new command .word (LAB_DO-1) ; DO new command .word (LAB_LOOP-1) ; LOOP new command .word (LAB_PRINT-1) ; PRINT .word (LAB_CONT-1) ; CONT .word (LAB_LIST-1) ; LIST .word (LAB_CLEAR-1) ; CLEAR .word (LAB_NEW-1) ; NEW .word (LAB_WDTH-1) ; WIDTH new command .word (LAB_GET-1) ; GET new command .word (LAB_SWAP-1) ; SWAP new command .word (LAB_BITSET-1) ; BITSET new command .word (LAB_BITCLR-1) ; BITCLR new command .word (LAB_IRQ-1) ; IRQ new command .word (LAB_NMI-1) ; NMI new command ; action addresses for functions LAB_FTBL = *-(TK_SGN-$80)*2 ; offset for table start LAB_FTBM = LAB_FTBL+$01 .word LAB_SGN ; SGN() .word LAB_INT ; INT() .word LAB_ABS ; ABS() .word Usrjmp ; USR() .word LAB_FRE ; FRE() .word LAB_POS ; POS() .word LAB_SQR ; SQR() .word LAB_RND ; RND() modified function .word LAB_LOG ; LOG() .word LAB_EXP ; EXP() .word LAB_COS ; COS() .word LAB_SIN ; SIN() .word LAB_TAN ; TAN() .word LAB_ATN ; ATN() .word LAB_PEEK ; PEEK() .word LAB_DEEK ; DEEK() new function .word LAB_SADD ; SADD() new function .word LAB_LENS ; LEN() .word LAB_STRS ; STR$() .word LAB_VAL ; VAL() .word LAB_ASC ; ASC() .word LAB_UCASE ; UCASE$() new function .word LAB_LCASE ; LCASE$() new function .word LAB_CHRS ; CHR$() .word LAB_HEXS ; HEX$() new function .word LAB_BINS ; BIN$() new function .word LAB_BTST ; BITTST() new function .word LAB_MAX ; MAX() new function .word LAB_MIN ; MIN() new function .word LAB_PI ; PI new function .word LAB_TWOPI ; TWOPI new function .word LAB_VARPTR ; VARPTR() new function .word LAB_LEFT ; LEFT$() .word LAB_RIGHT ; RIGHT$() .word LAB_MIDS ; MID$() ; hierarchy and action addresses for operator LAB_OPPT .byte $79 ; + .word (LAB_ADD-1) .byte $79 ; - .word (LAB_SUBTRACT-1) .byte $7B ; * .word (LAB_MULTIPLY-1) .byte $7B ; / .word (LAB_DIVIDE-1) .byte $7F ; ^ .word (LAB_POWER-1) .byte $50 ; AND .word (LAB_AND-1) .byte $46 ; EOR new operator .word (LAB_EOR-1) .byte $46 ; OR .word (LAB_OR-1) .byte $56 ; >> new operator .word (LAB_RSHIFT-1) .byte $56 ; << new operator .word (LAB_LSHIFT-1) .byte $7D ; > .word (LAB_GTHAN-1) .byte $5A ; = .word (LAB_EQUAL-1) .byte $64 ; < .word (LAB_LTHAN-1) ; Table of Basic keywords. the parsing code has been re written and the ; table can now extend up to 512 bytes. LAB_KEYT .cbyte "END" ; $80 END .cbyte "FOR" ; $81 FOR .cbyte "NEXT" ; $82 NEXT .cbyte "DATA" ; $83 DATA .cbyte "INPUT" ; $84 INPUT .cbyte "DIM" ; $85 DIM .cbyte "READ" ; $86 READ .cbyte "LET" ; $87 LET .cbyte "DEC" ; $88 DEC new command .cbyte "GOTO" ; $89 GOTO .cbyte "RUN" ; $8A RUN .cbyte "IF" ; $8B IF .cbyte "RESTORE" ; $8C RESTORE modified command .cbyte "GOSUB" ; $8D GOSUB .cbyte "RETIRQ" ; $8E RETIRQ new command .cbyte "RETNMI" ; $8F RETNMI new command .cbyte "RETURN" ; $90 RETURN .cbyte "REM" ; $91 REM .cbyte "STOP" ; $92 STOP .cbyte "ON" ; $93 ON modified command .cbyte "NULL" ; $94 NULL modified command .cbyte "INC" ; $95 INC new command .cbyte "WAIT" ; $96 WAIT .cbyte "LOAD" ; $97 LOAD user to do this .cbyte "SAVE" ; $98 SAVE user to do this .cbyte "DEF" ; $99 DEF .cbyte "POKE" ; $9A POKE .cbyte "DOKE" ; $9B DOKE new command .cbyte "CALL" ; $9C CALL new command .cbyte "DO" ; $9D DO new command .cbyte "LOOP" ; $9E LOOP new command .cbyte "PRINT" ; $9F PRINT .cbyte "CONT" ; $A0 CONT .cbyte "LIST" ; $A1 LIST .cbyte "CLEAR" ; $A2 CLEAR .cbyte "NEW" ; $A3 NEW .cbyte "WIDTH" ; $A4 WIDTH new command .cbyte "GET" ; $A5 GET new command .cbyte "SWAP" ; $A6 SWAP new command .cbyte "BITSET" ; $A7 BITSET new command .cbyte "BITCLR" ; $A8 BITCLR new command .cbyte "IRQ" ; $A9 IRQ new command .cbyte "NMI" ; $AA NMI new command .cbyte "TAB(" ; $AB TAB( .cbyte "TO" ; $AC TO .cbyte "FN" ; $AD FN .cbyte "SPC(" ; $AE SPC( .cbyte "THEN" ; $AF THEN .cbyte "NOT" ; $B0 NOT .cbyte "STEP" ; $B1 STEP .cbyte "UNTIL" ; $B2 UNTIL new command .cbyte "WHILE" ; $B3 WHILE new command .cbyte "OFF" ; $B4 OFF new command .cbyte "+" ; $B5 + .cbyte "-" ; $B6 - .cbyte "*" ; $B7 * .cbyte "/" ; $B8 / .cbyte "^" ; $B9 ^ .cbyte "AND" ; $BA AND .cbyte "EOR" ; $BB EOR new operator .cbyte "OR" ; $BC OR .cbyte ">>" ; $BD >> new operator .cbyte "<<" ; $BE << new operator .cbyte ">" ; $BF > .cbyte "=" ; $C0 = .cbyte "<" ; $C1 < .cbyte "SGN" ; $C2 SGN .cbyte "INT" ; $C3 INT .cbyte "ABS" ; $C4 ABS .cbyte "USR" ; $C5 USR .cbyte "FRE" ; $C6 FRE .cbyte "POS" ; $C7 POS .cbyte "SQR" ; $C8 SQR .cbyte "RND" ; $C9 RND modified function .cbyte "LOG" ; $CA LOG .cbyte "EXP" ; $CB EXP .cbyte "COS" ; $CC COS .cbyte "SIN" ; $CD SIN .cbyte "TAN" ; $CE TAN .cbyte "ATN" ; $CF ATN .cbyte "PEEK" ; $D0 PEEK .cbyte "DEEK" ; $D1 DEEK new function .cbyte "SADD" ; $D2 SADD new function .cbyte "LEN" ; $D3 LEN .cbyte "STR$" ; $D4 STR$ .cbyte "VAL" ; $D5 VAL .cbyte "ASC" ; $D6 ASC .cbyte "UCASE$" ; $D7 UCASE$ new function .cbyte "LCASE$" ; $D8 LCASE$ new function .cbyte "CHR$" ; $D9 CHR$ .cbyte "HEX$" ; $DA HEX$ new function .cbyte "BIN$" ; $DB BIN$ new function .cbyte "BITTST" ; $DC BITTST new function .cbyte "MAX" ; $DD MAX new function .cbyte "MIN" ; $DE MIN new function .cbyte "PI" ; $DF PI new function .cbyte "TWOPI" ; $E0 TWOPI new function .cbyte "VARPTR" ; $E1 VARPTR new function .cbyte "LEFT$" ; $E2 LEFT$ .cbyte "RIGHT$" ; $E3 RIGHT$ .cbyte "MID$" ; $E4 MID$ .byte $00 ; end of table ; BASIC messages, mostly error messages LAB_BAER .word LAB_NF ;$00 NEXT without FOR .word LAB_SN ;$02 syntax .word LAB_RG ;$04 RETURN without GOSUB .word LAB_OD ;$06 out of data .word LAB_FC ;$08 function call .word LAB_OV ;$0A overflow .word LAB_OM ;$0C out of memory .word LAB_US ;$0E undefined statement .word LAB_BS ;$10 array bounds .word LAB_DD ;$12 double dimension array .word LAB_D0 ;$14 divide by 0 .word LAB_ID ;$16 illegal direct .word LAB_TM ;$18 type mismatch .word LAB_LS ;$1A long string .word LAB_ST ;$1C string too complex .word LAB_CN ;$1E continue error .word LAB_UF ;$20 undefined function .word LAB_LD ;$22 LOOP without DO ; I may implement these two errors to force definition of variables and ; dimensioning of arrays before use. ; .word LAB_UV ;$24 undefined variable ; the above error has been tested and works (see code & comments below LAB_1D8B) ; .word LAB_UA ;$26 undimensioned array LAB_NF .byte "NEXT without FOR",$00 LAB_SN .byte "Syntax",$00 LAB_RG .byte "RETURN without GOSUB",$00 LAB_OD .byte "Out of DATA",$00 LAB_FC .byte "Function call",$00 LAB_OV .byte "Overflow",$00 LAB_OM .byte "Out of memory",$00 LAB_US .byte "Undefined statement",$00 LAB_BS .byte "Array bounds",$00 LAB_DD .byte "Double dimension",$00 LAB_D0 .byte "Divide by zero",$00 LAB_ID .byte "Illegal direct",$00 LAB_TM .byte "Type mismatch",$00 LAB_LS .byte "String too long",$00 LAB_ST .byte "String too complex",$00 LAB_CN .byte "Can't continue",$00 LAB_UF .byte "Undefined function",$00 LAB_LD .byte "LOOP without DO",$00 ;LAB_UV .byte "Undefined variable",$00 ; the above error has been tested and works (see code & comments below LAB_1D8B) ;LAB_UA .byte "Undimensioned array",$00 LAB_BMSG .byte $0D,$0A,"Break",$00 LAB_EMSG .byte " Error",$00 LAB_LMSG .byte " in line",$00 LAB_RMSG .byte $0D,$0A,"Ready",$0D,$0A,$00 LAB_IMSG .byte " Extra ignored",$0D,$0A,$00 LAB_REDO .byte " Redo from start",$0D,$0A,$00 END