mirror of
https://github.com/sethm/symon.git
synced 2024-08-19 12:28:55 +00:00
This is something of a "Work in Progress" checkpoint of several features that are all half baked: 1. Allow loading of 16KB ROM files at address $C000 at run-time, not just at startup. See the "Load ROM..." File menu item. 2. Introduces the notion of "CPU Behaviors", so the core 6502 CPU implementation can match the behavior of either an early NMOS 6502, late NMOS 6502, or CMOS 65C02. Very little of this is actually implemented so far. 3. Adds a completely bogus implementation of the 6522 VIA (it does absolutely nothing right now). 4. Changes the address of the ACIA in the simulated system to match a real hardware implementation I put together.
8692 lines
244 KiB
NASM
8692 lines
244 KiB
NASM
|
|
; Enhanced BASIC to assemble under 6502 simulator, $ver 2.22
|
|
|
|
; $E7E1 $E7CF $E7C6 $E7D3 $E7D1 $E7D5 $E7CF $E81E $E825
|
|
|
|
; 2.00 new revision numbers start here
|
|
; 2.01 fixed LCASE$() and UCASE$()
|
|
; 2.02 new get value routine done
|
|
; 2.03 changed RND() to galoise method
|
|
; 2.04 fixed SPC()
|
|
; 2.05 new get value routine fixed
|
|
; 2.06 changed USR() code
|
|
; 2.07 fixed STR$()
|
|
; 2.08 changed INPUT and READ to remove need for $00 start to input buffer
|
|
; 2.09 fixed RND()
|
|
; 2.10 integrated missed changes from an earlier version
|
|
; 2.20 added ELSE to IF .. THEN and fixed IF .. GOTO <statement> to cause error
|
|
; 2.21 fixed IF .. THEN RETURN to not cause error
|
|
; 2.22 fixed RND() breaking the get byte routine
|
|
|
|
; 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 = $0A ; 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 = $0F ; BASIC terminal width byte
|
|
Iclim = $10 ; input column limit
|
|
Itempl = $11 ; temporary integer low byte
|
|
Itemph = Itempl+1 ; temporary integer high byte
|
|
|
|
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
|
|
|
|
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, $80=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
|
|
|
|
; = $D7 ; end of get BASIC char subroutine
|
|
|
|
Rbyte4 = $D8 ; extra PRNG byte
|
|
Rbyte1 = Rbyte4+1 ; most significant PRNG byte
|
|
Rbyte2 = Rbyte4+2 ; middle PRNG byte
|
|
Rbyte3 = Rbyte4+3 ; least significant PRNG byte
|
|
|
|
NmiBase = $DC ; NMI handler enabled/setup/triggered flags
|
|
; bit function
|
|
; === ========
|
|
; 7 interrupt enabled
|
|
; 6 interrupt setup
|
|
; 5 interrupt happened
|
|
; = $DD ; NMI handler addr low byte
|
|
; = $DE ; NMI handler addr high byte
|
|
IrqBase = $DF ; IRQ handler enabled/setup/triggered flags
|
|
; = $E0 ; IRQ handler addr low byte
|
|
; = $E1 ; 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
|
|
Decssp1 = Decss+1 ; number to decimal string start
|
|
|
|
; = $FF ; decimal string end
|
|
|
|
; token values needed for BASIC
|
|
|
|
; primary command tokens (can start a statement)
|
|
|
|
TK_END = $80 ; END token
|
|
TK_FOR = TK_END+1 ; FOR token
|
|
TK_NEXT = TK_FOR+1 ; NEXT token
|
|
TK_DATA = TK_NEXT+1 ; DATA token
|
|
TK_INPUT = TK_DATA+1 ; INPUT token
|
|
TK_DIM = TK_INPUT+1 ; DIM token
|
|
TK_READ = TK_DIM+1 ; READ token
|
|
TK_LET = TK_READ+1 ; LET token
|
|
TK_DEC = TK_LET+1 ; DEC token
|
|
TK_GOTO = TK_DEC+1 ; GOTO token
|
|
TK_RUN = TK_GOTO+1 ; RUN token
|
|
TK_IF = TK_RUN+1 ; IF token
|
|
TK_RESTORE = TK_IF+1 ; RESTORE token
|
|
TK_GOSUB = TK_RESTORE+1 ; GOSUB token
|
|
TK_RETIRQ = TK_GOSUB+1 ; RETIRQ token
|
|
TK_RETNMI = TK_RETIRQ+1 ; RETNMI token
|
|
TK_RETURN = TK_RETNMI+1 ; RETURN token
|
|
TK_REM = TK_RETURN+1 ; REM token
|
|
TK_STOP = TK_REM+1 ; STOP token
|
|
TK_ON = TK_STOP+1 ; ON token
|
|
TK_NULL = TK_ON+1 ; NULL token
|
|
TK_INC = TK_NULL+1 ; INC token
|
|
TK_WAIT = TK_INC+1 ; WAIT token
|
|
TK_LOAD = TK_WAIT+1 ; LOAD token
|
|
TK_SAVE = TK_LOAD+1 ; SAVE token
|
|
TK_DEF = TK_SAVE+1 ; DEF token
|
|
TK_POKE = TK_DEF+1 ; POKE token
|
|
TK_DOKE = TK_POKE+1 ; DOKE token
|
|
TK_CALL = TK_DOKE+1 ; CALL token
|
|
TK_DO = TK_CALL+1 ; DO token
|
|
TK_LOOP = TK_DO+1 ; LOOP token
|
|
TK_PRINT = TK_LOOP+1 ; PRINT token
|
|
TK_CONT = TK_PRINT+1 ; CONT token
|
|
TK_LIST = TK_CONT+1 ; LIST token
|
|
TK_CLEAR = TK_LIST+1 ; CLEAR token
|
|
TK_NEW = TK_CLEAR+1 ; NEW token
|
|
TK_WIDTH = TK_NEW+1 ; WIDTH token
|
|
TK_GET = TK_WIDTH+1 ; GET token
|
|
TK_SWAP = TK_GET+1 ; SWAP token
|
|
TK_BITSET = TK_SWAP+1 ; BITSET token
|
|
TK_BITCLR = TK_BITSET+1 ; BITCLR token
|
|
TK_IRQ = TK_BITCLR+1 ; IRQ token
|
|
TK_NMI = TK_IRQ+1 ; NMI token
|
|
|
|
; secondary command tokens, can't start a statement
|
|
|
|
TK_TAB = TK_NMI+1 ; TAB token
|
|
TK_ELSE = TK_TAB+1 ; ELSE token
|
|
TK_TO = TK_ELSE+1 ; TO token
|
|
TK_FN = TK_TO+1 ; FN token
|
|
TK_SPC = TK_FN+1 ; SPC token
|
|
TK_THEN = TK_SPC+1 ; THEN token
|
|
TK_NOT = TK_THEN+1 ; NOT token
|
|
TK_STEP = TK_NOT+1 ; STEP token
|
|
TK_UNTIL = TK_STEP+1 ; UNTIL token
|
|
TK_WHILE = TK_UNTIL+1 ; WHILE token
|
|
TK_OFF = TK_WHILE+1 ; OFF token
|
|
|
|
; opperator tokens
|
|
|
|
TK_PLUS = TK_OFF+1 ; + token
|
|
TK_MINUS = TK_PLUS+1 ; - token
|
|
TK_MUL = TK_MINUS+1 ; * token
|
|
TK_DIV = TK_MUL+1 ; / token
|
|
TK_POWER = TK_DIV+1 ; ^ token
|
|
TK_AND = TK_POWER+1 ; AND token
|
|
TK_EOR = TK_AND+1 ; EOR token
|
|
TK_OR = TK_EOR+1 ; OR token
|
|
TK_RSHIFT = TK_OR+1 ; RSHIFT token
|
|
TK_LSHIFT = TK_RSHIFT+1 ; LSHIFT token
|
|
TK_GT = TK_LSHIFT+1 ; > token
|
|
TK_EQUAL = TK_GT+1 ; = token
|
|
TK_LT = TK_EQUAL+1 ; < token
|
|
|
|
; functions tokens
|
|
|
|
TK_SGN = TK_LT+1 ; SGN token
|
|
TK_INT = TK_SGN+1 ; INT token
|
|
TK_ABS = TK_INT+1 ; ABS token
|
|
TK_USR = TK_ABS+1 ; USR token
|
|
TK_FRE = TK_USR+1 ; FRE token
|
|
TK_POS = TK_FRE+1 ; POS token
|
|
TK_SQR = TK_POS+1 ; SQR token
|
|
TK_RND = TK_SQR+1 ; RND token
|
|
TK_LOG = TK_RND+1 ; LOG token
|
|
TK_EXP = TK_LOG+1 ; EXP token
|
|
TK_COS = TK_EXP+1 ; COS token
|
|
TK_SIN = TK_COS+1 ; SIN token
|
|
TK_TAN = TK_SIN+1 ; TAN token
|
|
TK_ATN = TK_TAN+1 ; ATN token
|
|
TK_PEEK = TK_ATN+1 ; PEEK token
|
|
TK_DEEK = TK_PEEK+1 ; DEEK token
|
|
TK_SADD = TK_DEEK+1 ; SADD token
|
|
TK_LEN = TK_SADD+1 ; LEN token
|
|
TK_STRS = TK_LEN+1 ; STR$ token
|
|
TK_VAL = TK_STRS+1 ; VAL token
|
|
TK_ASC = TK_VAL+1 ; ASC token
|
|
TK_UCASES = TK_ASC+1 ; UCASE$ token
|
|
TK_LCASES = TK_UCASES+1 ; LCASE$ token
|
|
TK_CHRS = TK_LCASES+1 ; CHR$ token
|
|
TK_HEXS = TK_CHRS+1 ; HEX$ token
|
|
TK_BINS = TK_HEXS+1 ; BIN$ token
|
|
TK_BITTST = TK_BINS+1 ; BITTST token
|
|
TK_MAX = TK_BITTST+1 ; MAX token
|
|
TK_MIN = TK_MAX+1 ; MIN token
|
|
TK_PI = TK_MIN+1 ; PI token
|
|
TK_TWOPI = TK_PI+1 ; TWOPI token
|
|
TK_VPTR = TK_TWOPI+1 ; VARPTR token
|
|
TK_LEFTS = TK_VPTR+1 ; LEFT$ token
|
|
TK_RIGHTS = TK_LEFTS+1 ; RIGHT$ token
|
|
TK_MIDS = TK_RIGHTS+1 ; MID$ 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_SKFE = LAB_STAK+$FE
|
|
; flushed stack address
|
|
LAB_SKFF = LAB_STAK+$FF
|
|
; flushed stack address
|
|
|
|
ccflag = $0200 ; 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
|
|
|
|
; Ibuffs can now be anywhere in RAM, ensure that the max length is < $80
|
|
|
|
Ibuffs = IRQ_vec+$14
|
|
; start of input buffer after IRQ/NMI code
|
|
Ibuffe = Ibuffs+$47; end of input buffer
|
|
|
|
Ram_base = $0300 ; start of user RAM (set as needed, should be page aligned)
|
|
Ram_top = $C000 ; end of user RAM+1 (set as needed, should be page aligned)
|
|
|
|
; This start can be changed to suit your system
|
|
|
|
.org $C000
|
|
|
|
; BASIC cold start entry point
|
|
|
|
; new page 2 initialisation, copy block to ccflag on
|
|
|
|
LAB_COLD
|
|
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 (low addr)
|
|
LDY #>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_GBYT ; get last byte back
|
|
|
|
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 ; 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_top ; compare with top of RAM low byte
|
|
; BEQ MEM_OK ; branch if = RAM top
|
|
|
|
; BCS LAB_GMEM ; if too large go try again
|
|
|
|
;MEM_OK
|
|
STA Ememl ; set end of mem low byte
|
|
STY Ememh ; set end of mem high byte
|
|
STA Sstorl ; set bottom of string space low byte
|
|
STY Sstorh ; set bottom of string space high byte
|
|
|
|
LDY #<Ram_base ; set start addr low byte
|
|
LDX #>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 (low addr)
|
|
LDY #>LAB_SMSG ; point to sign-on message (high addr)
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
|
LDA #<LAB_1274 ; warm start vector low byte
|
|
LDY #>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
|
|
|
|
; 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
|
|
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
|
|
|
|
SEC ; set carry for add + 1, two's complement
|
|
EOR #$FF ; invert low byte for subtract
|
|
ADC Obendl ; add block end low 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 add + 1, two's complement
|
|
LAB_11F3
|
|
TYA ; get MOD(block length/$100) byte
|
|
EOR #$FF ; invert low byte for subtract
|
|
ADC Nbendl ; add destination end low 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 #$00 ; clear the index to restore bytes
|
|
LAB_1238
|
|
PLA ; pop byte
|
|
STA Adatal,X ; save byte to Adatal to expneg
|
|
INX ; increment index
|
|
CPX #$08 ; compare with end + 1
|
|
BMI LAB_1238 ; loop if more to do
|
|
|
|
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 and clear continue flag
|
|
LDA #<LAB_EMSG ; point to " Error" low addr
|
|
LDY #>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 low byte
|
|
LDY #>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
|
|
JSR LAB_GBYT ; 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 and 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 of input buffer
|
|
BEQ LAB_1319 ; if null line just go flush stack/vars and 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 and flush stack
|
|
LDX Smeml ; get start of mem low byte
|
|
LDA Smemh ; get start of mem high byte
|
|
LDY #$01 ; index to high byte of next line pointer
|
|
LAB_1325
|
|
STX ut1_pl ; set line start pointer low byte
|
|
STA ut1_ph ; set line start pointer high byte
|
|
LDA (ut1_pl),Y ; get it
|
|
BEQ LAB_133E ; exit if end of program
|
|
|
|
; rebuild chaining of Basic lines
|
|
|
|
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]
|
|
|
|
SEC ; set carry for add + 1
|
|
TYA ; copy end index
|
|
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
|
|
TYA ; clear A
|
|
ADC ut1_ph ; add line start pointer high byte + carry
|
|
INY ; increment index to high byte
|
|
STA (ut1_pl),Y ; save next line pointer low byte
|
|
BCC LAB_1325 ; go do next line, branch always, carry clear
|
|
|
|
|
|
LAB_133E
|
|
JMP LAB_127D ; else we just wait for Basic command, no "Ready"
|
|
|
|
; print "? " and get BASIC input
|
|
|
|
LAB_INLN
|
|
JSR LAB_18E3 ; print "?" character
|
|
JSR LAB_18E0 ; print " "
|
|
BNE LAB_1357 ; call for BASIC input and 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 #$0D ; 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 and [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 and 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
|
|
; position independent buffer version ..
|
|
; faster, dictionary search version ....
|
|
|
|
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 #<Ibuffs ; subtract input buffer start pointer
|
|
TAX ; copy result to X (index past line # if any)
|
|
|
|
STX Oquote ; clear open quote/DATA flag
|
|
LAB_13AC
|
|
LDA Ibuffs,X ; get byte from input buffer
|
|
BEQ LAB_13EC ; if null save byte then exit
|
|
|
|
CMP #'_' ; compare with "_"
|
|
BCS LAB_13EC ; if >= go save byte then continue crunching
|
|
|
|
CMP #'<' ; compare with "<"
|
|
BCS LAB_13CC ; if >= go crunch now
|
|
|
|
CMP #'0' ; compare with "0"
|
|
BCS LAB_13EC ; if >= go 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)
|
|
|
|
CMP #'*' ; compare with "*"
|
|
BCC LAB_13EC ; if < go save byte then continue crunching
|
|
|
|
; else crunch now
|
|
LAB_13CC
|
|
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
|
|
|
|
STX TempB ; save buffer read index
|
|
STY csidx ; copy buffer save index
|
|
LDY #<TAB_1STC ; get keyword first character table low address
|
|
STY ut2_pl ; save pointer low byte
|
|
LDY #>TAB_1STC ; get keyword first character table high address
|
|
STY ut2_ph ; save pointer high byte
|
|
LDY #$00 ; clear table pointer
|
|
|
|
LAB_13D0
|
|
CMP (ut2_pl),Y ; compare with keyword first character table byte
|
|
BEQ LAB_13D1 ; go do word_table_chr if match
|
|
|
|
BCC LAB_13EA ; if < keyword first character table byte go restore
|
|
; Y and save to crunched
|
|
|
|
INY ; else increment pointer
|
|
BNE LAB_13D0 ; and loop (branch always)
|
|
|
|
; have matched first character of some keyword
|
|
|
|
LAB_13D1
|
|
TYA ; copy matching index
|
|
ASL ; *2 (bytes per pointer)
|
|
TAX ; copy to new index
|
|
LDA TAB_CHRT,X ; get keyword table pointer low byte
|
|
STA ut2_pl ; save pointer low byte
|
|
LDA TAB_CHRT+1,X ; get keyword table pointer high byte
|
|
STA ut2_ph ; save pointer high byte
|
|
|
|
LDY #$FF ; clear table pointer (make -1 for start)
|
|
|
|
LDX TempB ; restore buffer read index
|
|
|
|
LAB_13D6
|
|
INY ; next table byte
|
|
LDA (ut2_pl),Y ; get byte from table
|
|
LAB_13D8
|
|
BMI LAB_13EA ; all bytes matched so go save token
|
|
|
|
INX ; next buffer byte
|
|
CMP Ibuffs,X ; compare with byte from input buffer
|
|
BEQ LAB_13D6 ; go compare next if match
|
|
|
|
BNE LAB_1417 ; branch if >< (not found keyword)
|
|
|
|
LAB_13EA
|
|
LDY csidx ; restore save index
|
|
|
|
; save crunched to output
|
|
LAB_13EC
|
|
INX ; increment buffer index (to next input byte)
|
|
INY ; increment save index (to next output byte)
|
|
STA Ibuffs,Y ; save byte to output
|
|
CMP #$00 ; set the flags, set carry
|
|
BEQ LAB_142A ; do exit if was null [EOL]
|
|
|
|
; A holds token or byte here
|
|
SBC #':' ; subtract ":" (carry set by CMP #00)
|
|
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
|
|
EOR #TK_REM-$3A ; effectively 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 (start byte!)
|
|
|
|
; 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
|
|
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
|
|
|
|
; old 541 new 507
|
|
|
|
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
|
|
|
|
LDY #$03 ; set index 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
|
|
BNE LAB_1455 ; if <> skip low byte check
|
|
|
|
LDA (Baslnl),Y ; get line # low byte
|
|
CMP Itempl ; compare with temporary integer low byte
|
|
LAB_1455
|
|
BCS LAB_145E ; 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)
|
|
|
|
LAB_145E
|
|
BEQ LAB_1460 ; exit if temp = found line #, carry is set
|
|
|
|
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 and 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 and 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_SKFE ; save to cleared stack
|
|
STA LAB_SKFF ; 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"
|
|
|
|
; else there was a following token (go do syntax error)
|
|
RTS
|
|
|
|
; perform LIST [n][-m]
|
|
; bigger, faster version (a _lot_ faster)
|
|
|
|
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 and 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)
|
|
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
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
JSR LAB_GFPN ; get fixed-point number into temp integer
|
|
BNE LAB_1460 ; exit if not ok
|
|
|
|
LAB_14D4
|
|
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
|
|
|
|
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)
|
|
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
|
|
RTS
|
|
|
|
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
|
|
|
|
LDX #>LAB_KEYT ; get table address high byte
|
|
ASL ; *2
|
|
ASL ; *4
|
|
BCC LAB_152F ; branch if no carry
|
|
|
|
INX ; else increment high byte
|
|
CLC ; clear carry for add
|
|
LAB_152F
|
|
ADC #<LAB_KEYT ; add low byte
|
|
BCC LAB_1530 ; branch if no carry
|
|
|
|
INX ; else increment high byte
|
|
LAB_1530
|
|
STA ut2_pl ; save table pointer low byte
|
|
STX ut2_ph ; save table pointer high byte
|
|
STY Tidx1 ; save index for line
|
|
LDY #$00 ; clear index
|
|
LDA (ut2_pl),Y ; get length
|
|
TAX ; copy length
|
|
INY ; increment index
|
|
LDA (ut2_pl),Y ; get 1st character
|
|
DEX ; decrement length
|
|
BEQ LAB_1508 ; if no more characters exit and print
|
|
|
|
JSR LAB_PRNA ; go print the character
|
|
INY ; increment index
|
|
LDA (ut2_pl),Y ; get keyword address low byte
|
|
PHA ; save it for now
|
|
INY ; increment index
|
|
LDA (ut2_pl),Y ; get keyword address high byte
|
|
LDY #$00
|
|
STA ut2_ph ; save keyword pointer high byte
|
|
PLA ; pull low byte
|
|
STA ut2_pl ; save keyword pointer low byte
|
|
LAB_1540
|
|
LDA (ut2_pl),Y ; get character
|
|
DEX ; decrement character count
|
|
BEQ LAB_1508 ; if last character exit and print
|
|
|
|
JSR LAB_PRNA ; go print the character
|
|
INY ; increment index
|
|
BNE LAB_1540 ; loop for next character
|
|
|
|
; perform FOR
|
|
|
|
LAB_FOR
|
|
LDA #$80 ; set FNX
|
|
STA Sufnxf ; set subscript/FNX flag
|
|
JSR LAB_LET ; go do LET
|
|
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 and 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 low byte
|
|
LDY #>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 and put on stack (returns to next instruction)
|
|
|
|
LAB_159F
|
|
LDA #<LAB_259C ; set 1 pointer low addr (default step size)
|
|
LDY #>LAB_259C ; set 1 pointer high addr
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
|
JSR LAB_GBYT ; scan memory
|
|
CMP #TK_STEP ; compare with STEP token
|
|
BNE LAB_15B3 ; jump if not "STEP"
|
|
|
|
;.was step so ..
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
JSR LAB_EVNM ; evaluate expression and check is numeric,
|
|
; else do type mismatch
|
|
LAB_15B3
|
|
JSR LAB_27CA ; return A=FF,C=1/-ve A=01,C=0/+ve
|
|
STA FAC1_s ; set FAC1 sign (b7)
|
|
; this is +1 for +ve step and -1 for -ve step, in NEXT we
|
|
; compare the FOR value and the TO value and return +1 if
|
|
; FOR > TO, 0 if FOR = TO and -1 if FOR < TO. the value
|
|
; here (+/-1) is then compared to that result and if they
|
|
; are the same (+ve and FOR > TO or -ve and FOR < TO) then
|
|
; the loop is done
|
|
JSR LAB_1B5B ; push sign, round FAC1 and 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 #':' ; 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
|
|
JSR LAB_IGBY ; increment and 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
|
|
ASL ; *2 bytes per vector and normalise token
|
|
BCS LAB_1609 ; branch if was token
|
|
|
|
JMP LAB_LET ; else go do implied LET
|
|
|
|
LAB_1609
|
|
CMP #(TK_TAB-$80)*2 ; compare normalised token * 2 with TAB
|
|
BCS LAB_15D9 ; branch if A>=TAB (do syntax error then warm start)
|
|
; only tokens before TAB can start a line
|
|
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 and 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 the carry, indicate a normal program end
|
|
LAB_163B
|
|
BNE LAB_167A ; if wasn't CTRL-C or there is a following byte return
|
|
|
|
LDA Bpntrh ; get the BASIC execute pointer high byte
|
|
EOR #>Ibuffs ; compare with buffer address high byte (Cb unchanged)
|
|
BEQ LAB_164F ; branch if the BASIC pointer is in the input 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 ; if was program end just do warm start
|
|
|
|
; else ..
|
|
LDA #<LAB_BMSG ; point to "Break" low byte
|
|
LDY #>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 and return)
|
|
|
|
BCC LAB_uflow ; else decrement high byte then save DATA pointer and
|
|
; 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 variables, flush stack and
|
|
; return
|
|
|
|
; 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
|
|
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
|
|
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
|
|
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
|
|
TAY ; save following token
|
|
TSX ; copy stack pointer
|
|
LDA LAB_STAK+3,X ; get token byte from stack
|
|
CMP #TK_DO ; compare with DO token
|
|
BNE LAB_DONOK ; branch if no matching DO
|
|
|
|
INX ; dump calling routine return address
|
|
INX ; dump calling routine return address
|
|
TXS ; correct stack
|
|
TYA ; get saved following token back
|
|
BEQ LoopAlways ; if no following token loop forever
|
|
; (stack pointer in X)
|
|
|
|
CMP #':' ; could be ':'
|
|
BEQ LoopAlways ; if :... loop forever
|
|
|
|
SBC #TK_UNTIL ; subtract token for UNTIL, we know carry is set here
|
|
TAX ; copy to X (if it was UNTIL then Y will be correct)
|
|
BEQ DoRest ; branch if was UNTIL
|
|
|
|
DEX ; decrement result
|
|
BNE LAB_16FC ; if not WHILE go do syntax error and warm start
|
|
; only if the token was WHILE will this fail
|
|
|
|
DEX ; set invert result byte
|
|
DoRest
|
|
STX Frnxth ; save invert result byte
|
|
JSR LAB_IGBY ; increment and 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
|
|
TSX ; copy stack pointer
|
|
EOR Frnxth ; EOR with invert byte
|
|
BNE LoopDone ; if <> 0 clear stack and back to interpreter loop
|
|
|
|
; loop condition wasn't met so do it again
|
|
LoopAlways
|
|
LDA LAB_STAK+2,X ; get current line low byte
|
|
STA Clinel ; save current line low byte
|
|
LDA LAB_STAK+3,X ; get current line high byte
|
|
STA Clineh ; save current line high byte
|
|
LDA LAB_STAK+4,X ; get BASIC execute pointer low byte
|
|
STA Bpntrl ; save BASIC execute pointer low byte
|
|
LDA LAB_STAK+5,X ; get BASIC execute pointer high byte
|
|
STA Bpntrh ; save BASIC execute pointer high byte
|
|
JSR LAB_GBYT ; scan memory
|
|
JMP LAB_15C2 ; go do interpreter inner loop
|
|
|
|
; clear stack and back to interpreter loop
|
|
LoopDone
|
|
INX ; dump DO token
|
|
INX ; dump current line low byte
|
|
INX ; dump current line high byte
|
|
INX ; dump BASIC execute pointer low byte
|
|
INX ; dump BASIC execute pointer high byte
|
|
TXS ; correct stack
|
|
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
|
|
PLA ; dump calling routine return address
|
|
PLA ; dump calling routine return address
|
|
PLA ; pull token
|
|
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 <var> 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 #':' ; 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]
|
|
LDY #$00 ; set search character = [EOL]
|
|
STY Asrch ; store search character
|
|
LAB_1725
|
|
TXA ; get alt search character
|
|
EOR Asrch ; toggle search character, effectively swap with $00
|
|
STA Asrch ; save swapped 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
|
|
BNE LAB_172D ; if not open quote go get next character
|
|
|
|
BEQ LAB_1725 ; if found go swap search character for alt search character
|
|
|
|
; perform IF
|
|
|
|
LAB_IF
|
|
JSR LAB_EVEX ; evaluate the expression
|
|
JSR LAB_GBYT ; scan memory
|
|
CMP #TK_THEN ; compare with THEN token
|
|
BEQ LAB_174B ; if it was THEN go do IF
|
|
|
|
; wasn't IF .. THEN so must be IF .. GOTO
|
|
CMP #TK_GOTO ; compare with GOTO token
|
|
BNE LAB_16FC ; if it wasn't GOTO go do syntax error
|
|
|
|
LDX Bpntrl ; save the basic pointer low byte
|
|
LDY Bpntrh ; save the basic pointer high byte
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
BCS LAB_16FC ; if not numeric go do syntax error
|
|
|
|
STX Bpntrl ; restore the basic pointer low byte
|
|
STY Bpntrh ; restore the basic pointer high byte
|
|
LAB_174B
|
|
LDA FAC1_e ; get FAC1 exponent
|
|
BEQ LAB_174E ; if the result was zero go look for an ELSE
|
|
|
|
JSR LAB_IGBY ; else increment and scan memory
|
|
BCS LAB_174D ; if not numeric go do var or keyword
|
|
|
|
LAB_174C
|
|
JMP LAB_GOTO ; else was numeric so do GOTO n
|
|
|
|
; is var or keyword
|
|
LAB_174D
|
|
CMP #TK_RETURN ; compare the byte with the token for RETURN
|
|
BNE LAB_174G ; if it wasn't RETURN go interpret BASIC code from (Bpntrl)
|
|
; and return to this code to process any following code
|
|
|
|
JMP LAB_1602 ; else it was RETURN so interpret BASIC code from (Bpntrl)
|
|
; but don't return here
|
|
|
|
LAB_174G
|
|
JSR LAB_15FF ; interpret BASIC code from (Bpntrl)
|
|
|
|
; the IF was executed and there may be a following ELSE so the code needs to return
|
|
; here to check and ignore the ELSE if present
|
|
|
|
LDY #$00 ; clear the index
|
|
LDA (Bpntrl),Y ; get the next BASIC byte
|
|
CMP #TK_ELSE ; compare it with the token for ELSE
|
|
BEQ LAB_DATA ; if ELSE ignore the following statement
|
|
|
|
; there was no ELSE so continue execution of IF <expr> THEN <stat> [: <stat>]. any
|
|
; following ELSE will, correctly, cause a syntax error
|
|
|
|
RTS ; else return to the interpreter inner loop
|
|
|
|
; perform ELSE after IF
|
|
|
|
LAB_174E
|
|
LDY #$00 ; clear the BASIC byte index
|
|
LDX #$01 ; clear the nesting depth
|
|
LAB_1750
|
|
INY ; increment the BASIC byte index
|
|
LDA (Bpntrl),Y ; get the next BASIC byte
|
|
BEQ LAB_1753 ; if EOL go add the pointer and return
|
|
|
|
CMP #TK_IF ; compare the byte with the token for IF
|
|
BNE LAB_1752 ; if not IF token skip the depth increment
|
|
|
|
INX ; else increment the nesting depth ..
|
|
BNE LAB_1750 ; .. and continue looking
|
|
|
|
LAB_1752
|
|
CMP #TK_ELSE ; compare the byte with the token for ELSE
|
|
BNE LAB_1750 ; if not ELSE token continue looking
|
|
|
|
DEX ; was ELSE so decrement the nesting depth
|
|
BNE LAB_1750 ; loop if still nested
|
|
|
|
INY ; increment the BASIC byte index past the ELSE
|
|
|
|
; found the matching ELSE, now do <{n|statement}>
|
|
|
|
LAB_1753
|
|
TYA ; else copy line index to A
|
|
CLC ; clear carry for add
|
|
ADC Bpntrl ; add the BASIC execute pointer low byte
|
|
STA Bpntrl ; save the BASIC execute pointer low byte
|
|
BCC LAB_1754 ; branch if no overflow to high byte
|
|
|
|
INC Bpntrh ; else increment the BASIC execute pointer high byte
|
|
LAB_1754
|
|
JSR LAB_GBYT ; scan memory
|
|
BCC LAB_174C ; if numeric do GOTO n
|
|
; the code will return to the interpreter loop at the
|
|
; tail end of the GOTO <n>
|
|
|
|
JMP LAB_15FF ; interpret BASIC code from (Bpntrl)
|
|
; the code will return to the interpreter loop at the
|
|
; tail end of the <statement>
|
|
|
|
; perform REM, skip (rest of) line
|
|
|
|
LAB_REM
|
|
JSR LAB_SNBL ; scan for next BASIC line
|
|
JMP LAB_170F ; go set BASIC execute pointer and return, branch always
|
|
|
|
LAB_16FD
|
|
JMP LAB_SNER ; do syntax error then warm start
|
|
|
|
; 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
|
|
|
|
CMP #TK_GOTO ; compare with GOTO token
|
|
LAB_1767
|
|
BNE LAB_16FD ; 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
|
|
JSR LAB_IGBY ; increment and 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 ","
|
|
|
|
LAB_177E
|
|
PLA ; else pull keyword token (run out of options)
|
|
; also dump +/-1 pointer low byte and exit
|
|
LAB_177F
|
|
RTS
|
|
|
|
; takes n * 106 + 11 cycles where n is the number of digits
|
|
|
|
; get fixed-point number into temp integer
|
|
|
|
LAB_GFPN
|
|
LDX #$00 ; clear reg
|
|
STX Itempl ; clear temporary integer low byte
|
|
LAB_1785
|
|
STX Itemph ; save temporary integer high byte
|
|
BCS LAB_177F ; return if carry set, end of scan, character was
|
|
; not 0-9
|
|
|
|
CPX #$19 ; compare high byte with $19
|
|
TAY ; ensure Zb = 0 if the branch is taken
|
|
BCS LAB_1767 ; branch if >=, makes max line # 63999 because next
|
|
; bit does *$0A, = 64000, compare at target will fail
|
|
; and do syntax error
|
|
|
|
SBC #'0'-1 ; subtract "0", $2F + carry, from byte
|
|
TAY ; copy binary digit
|
|
LDA Itempl ; get temporary integer low byte
|
|
ASL ; *2 low byte
|
|
ROL Itemph ; *2 high byte
|
|
ASL ; *2 low byte
|
|
ROL Itemph ; *2 high byte, *4
|
|
ADC Itempl ; + low byte, *5
|
|
STA Itempl ; save it
|
|
TXA ; get high byte copy to A
|
|
ADC Itemph ; + high byte, *5
|
|
ASL Itempl ; *2 low byte, *10d
|
|
ROL ; *2 high byte, *10d
|
|
TAX ; copy high byte back to X
|
|
TYA ; get binary digit back
|
|
ADC Itempl ; add number low byte
|
|
STA Itempl ; save number low byte
|
|
BCC LAB_17B3 ; if no overflow to high byte get next character
|
|
|
|
INX ; else increment high byte
|
|
LAB_17B3
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
JMP LAB_1785 ; loop for next character
|
|
|
|
; perform DEC
|
|
|
|
LAB_DEC
|
|
LDA #<LAB_2AFD ; set -1 pointer low byte
|
|
.byte $2C ; BIT abs to skip the LDA below
|
|
|
|
; perform INC
|
|
|
|
LAB_INC
|
|
LDA #<LAB_259C ; set 1 pointer low byte
|
|
LAB_17B5
|
|
PHA ; save +/-1 pointer low byte
|
|
LAB_17B7
|
|
JSR LAB_GVAR ; get var address
|
|
LDX Dtypef ; get data type flag, $FF=string, $00=numeric
|
|
BMI IncrErr ; exit if string
|
|
|
|
STA Lvarpl ; save var address low byte
|
|
STY Lvarph ; save var address high byte
|
|
JSR LAB_UFAC ; unpack memory (AY) into FAC1
|
|
PLA ; get +/-1 pointer low byte
|
|
PHA ; save +/-1 pointer low byte
|
|
LDY #>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)
|
|
|
|
JSR LAB_GBYT ; scan memory
|
|
CMP #',' ; compare with ","
|
|
BNE LAB_177E ; exit if not "," (either end or error)
|
|
|
|
; was "," so another INCR variable to do
|
|
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 ; 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) and return
|
|
|
|
; 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 and 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 and 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 and return
|
|
|
|
; make space and copy string
|
|
LAB_17FB
|
|
LDY #$00 ; index to length
|
|
LDA (des_pl),Y ; get string length
|
|
JSR LAB_209C ; 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 #<FAC1_e ; set descriptor pointer low byte
|
|
LDY #>FAC1_e ; get descriptor pointer high byte
|
|
|
|
; clean stack and 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
|
|
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) and 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 address
|
|
; and length on descriptor stack and update stack pointers
|
|
|
|
JMP LAB_17D5 ; do string LET and return
|
|
|
|
; perform PRINT
|
|
|
|
LAB_1829
|
|
JSR LAB_18C6 ; print string from Sutill/Sutilh
|
|
LAB_182C
|
|
JSR LAB_GBYT ; scan memory
|
|
|
|
; PRINT
|
|
|
|
LAB_PRINT
|
|
BEQ LAB_CRLF ; if nothing following just print CR/LF
|
|
|
|
LAB_1831
|
|
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 #',' ; 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 ; set X to buffer start-1 low byte
|
|
LDY #>Ibuffs ; set Y to buffer start-1 high byte
|
|
|
|
; print CR/LF
|
|
|
|
LAB_CRLF
|
|
LDA #$0D ; load [CR]
|
|
JSR LAB_PRNA ; go print the character
|
|
LDA #$0A ; load [LF]
|
|
BNE LAB_PRNA ; go print the character and return, branch always
|
|
|
|
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 ; if not go do 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)
|
|
|
|
; print A spaces
|
|
LAB_18B6
|
|
TAX ; copy result to X
|
|
LAB_18B7
|
|
TXA ; set flags on size for SPC
|
|
BEQ LAB_18BD ; branch if result was = $0, already here
|
|
|
|
; print X spaces
|
|
LAB_18BA
|
|
JSR LAB_18E0 ; print " "
|
|
DEX ; decrement count
|
|
BNE LAB_18BA ; loop if not all done
|
|
|
|
; continue with PRINT processing
|
|
LAB_18BD
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
BNE LAB_1831 ; if more to print go do it
|
|
|
|
RTS
|
|
|
|
; 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 #' ' ; 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
|
|
|
|
LDA TPos ; get position
|
|
SBC TabSiz ; subtract TAB size, carry set by CMP #$20 above
|
|
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 #$0D ; compare with [CR]
|
|
BNE LAB_188A ; branch if not [CR]
|
|
|
|
; else print nullct nulls after the [CR]
|
|
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 #$0D ; 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, $00=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 (low addr)
|
|
LDY #>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 #$00 ; set mode = INPUT
|
|
CMP Ibuffs ; test first byte in buffer
|
|
BNE LAB_1953 ; branch if not null input
|
|
|
|
CLC ; was null input so clear carry to exit program
|
|
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
|
|
LDA #$80 ; set mode = READ
|
|
|
|
LAB_1953
|
|
STA Imode ; set input mode flag, $00=INPUT, $80=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
|
|
JSR LAB_GBYT ; scan memory
|
|
BNE LAB_1988 ; branch if not null
|
|
|
|
; pointer was to null entry
|
|
BIT Imode ; test input mode flag, $00=INPUT, $80=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
|
|
JSR LAB_GBYT ; scan memory
|
|
LAB_1988
|
|
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 #',' ; 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
|
|
JSR LAB_GBYT ; scan memory
|
|
BEQ LAB_19C5 ; branch if null (last entry)
|
|
|
|
CMP #',' ; else compare with ","
|
|
BEQ LAB_19C2 ; branch if ","
|
|
|
|
JMP LAB_1904 ; else go handle bad input data
|
|
|
|
; got good input data
|
|
LAB_19C2
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
LAB_19C5
|
|
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
|
|
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
|
|
INY ; increment index
|
|
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, $80=READ
|
|
BPL LAB_1A0E ; branch if INPUT
|
|
|
|
JMP LAB_1624 ; save AY as DATA pointer and return
|
|
|
|
; 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 (low addr)
|
|
LDY #>LAB_IMSG ; point to extra ignored message (high addr)
|
|
JMP LAB_18C3 ; print null terminated string from memory and return
|
|
|
|
; search the stack for FOR 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
|
|
|
|
; 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 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
|
|
|
|
TXA ; copy stack pointer
|
|
SEC ; set carry for subtract
|
|
SBC #$F7 ; point to TO var
|
|
STA ut2_pl ; save pointer to TO var for compare
|
|
ADC #$FB ; point to STEP var
|
|
|
|
LDY #>LAB_STAK ; point to stack page high byte
|
|
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 #>LAB_STAK ; point to stack page high byte
|
|
JSR LAB_27FA ; compare FAC1 with (Y,ut2_pl) (TO value)
|
|
TSX ; get stack pointer back
|
|
CMP LAB_STAK+8,X ; compare 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
|
|
JSR LAB_GBYT ; scan memory
|
|
CMP #',' ; compare with ","
|
|
BNE LAB_1A98 ; branch if not "," (go do interpreter inner loop)
|
|
|
|
; was "," so another NEXT variable to do
|
|
JSR LAB_IGBY ; else increment and scan memory
|
|
JSR LAB_1A46 ; do NEXT (var)
|
|
|
|
; evaluate expression and 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
|
|
|
|
LAB_EVEZ
|
|
LDA #$00 ; set null precedence (flag done)
|
|
LAB_1ACC
|
|
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
|
|
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 ; *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
|
|
JSR LAB_IGBY ; increment and 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
|
|
BNE LAB_1B0B ; branch if not + token
|
|
|
|
BIT Dtypef ; test data type flag, $FF=string, $00=numeric
|
|
BPL LAB_1B0B ; branch if not string
|
|
|
|
; will only be $00 if type is string and token was +
|
|
JMP LAB_224D ; add strings, string 1 is in descriptor des_pl, string 2
|
|
; is in line, and return
|
|
|
|
LAB_1B0B
|
|
STA ut1_pl ; save it
|
|
ASL ; *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_1B9D ; exit if done
|
|
|
|
BNE LAB_1B86 ; else pop FAC2 and return, branch always
|
|
|
|
LAB_1B2A
|
|
ROL Dtypef ; shift data type flag into Cb
|
|
TXA ; copy compare function flag
|
|
STA Dtypef ; clear data type flag, X is 0xxx xxxx
|
|
ROL ; shift data type into compare function byte b0
|
|
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
|
|
TK_LT_PLUS = TK_LT-TK_PLUS
|
|
LDY #TK_LT_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 and 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
|
|
; now push sign, round FAC1 and put on stack
|
|
JSR LAB_1B5B ; function will return here, then the next RTS will call
|
|
; the function
|
|
LDA comp_f ; get compare function flag
|
|
PHA ; push compare evaluation byte
|
|
LDA LAB_OPPT,Y ; get precedence byte
|
|
JMP LAB_1ACC ; continue evaluating expression
|
|
|
|
LAB_1B53
|
|
JMP LAB_SNER ; do syntax error then warm start
|
|
|
|
; push sign, round FAC1 and put on stack
|
|
|
|
LAB_1B5B
|
|
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
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
|
PHA ; push sign
|
|
|
|
; round FAC1 and 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 ; flag function
|
|
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 and return
|
|
LAB_1B86
|
|
PLA ; pop byte
|
|
LSR ; 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
|
|
|
|
; 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 and return
|
|
|
|
; get value from line
|
|
|
|
LAB_GVAL
|
|
JSR LAB_IGBY ; increment and 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 and return
|
|
|
|
; get value from line .. continued
|
|
|
|
; wasn't a number so ..
|
|
LAB_1BAC
|
|
TAX ; set the flags
|
|
BMI LAB_1BD0 ; if -ve go test token values
|
|
|
|
; else it is either a string, number, variable or (<expr>)
|
|
CMP #'$' ; compare with "$"
|
|
BEQ LAB_1BA9 ; branch if "$", hex number
|
|
|
|
CMP #'%' ; else compare with "%"
|
|
BEQ LAB_1BA9 ; branch if "%", binary number
|
|
|
|
CMP #'.' ; compare with "."
|
|
BEQ LAB_1BA9 ; if so get FAC1 from string and return (e.g. was .123)
|
|
|
|
; it wasn't any sort of number so ..
|
|
CMP #$22 ; compare with "
|
|
BEQ LAB_1BC1 ; branch if open quote
|
|
|
|
; wasn't any sort of number so ..
|
|
|
|
; evaluate expression within parentheses
|
|
|
|
CMP #'(' ; compare with "("
|
|
BNE LAB_1C18 ; if not "(" get (var), return value in FAC1 and $ flag
|
|
|
|
LAB_1BF7
|
|
JSR LAB_EVEZ ; evaluate expression, no decrement
|
|
|
|
; 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 ")"
|
|
|
|
; 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 and scan memory then return
|
|
|
|
; scan for "(" , else do syntax error then warm start
|
|
|
|
LAB_1BFE
|
|
LDA #$28 ; load A with "("
|
|
BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
|
; (branch always)
|
|
|
|
; scan for "," , else do syntax error then warm start
|
|
|
|
LAB_1C01
|
|
LDA #$2C ; load A with ","
|
|
BNE LAB_SCCA ; scan for CHR$(A), else do syntax error then warm start
|
|
; (branch always)
|
|
|
|
; syntax error then warm start
|
|
|
|
LAB_SNER
|
|
LDX #$02 ; error code $02 ("Syntax" error)
|
|
JMP LAB_XERR ; do error #X, then warm start
|
|
|
|
; get value from line .. continued
|
|
; do tokens
|
|
|
|
LAB_1BD0
|
|
CMP #TK_MINUS ; compare with token for -
|
|
BEQ LAB_1C11 ; branch if - token (do set-up for functions)
|
|
|
|
; wasn't -n so ..
|
|
CMP #TK_PLUS ; compare with token for +
|
|
BEQ LAB_GVAL ; branch if + token (+n = n so ignore leading +)
|
|
|
|
CMP #TK_NOT ; compare with token for NOT
|
|
BNE LAB_1BE7 ; branch if not token for NOT
|
|
|
|
; was NOT token
|
|
TK_EQUAL_PLUS = TK_EQUAL-TK_PLUS
|
|
LDY #TK_EQUAL_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 and convert integer AY to FAC1 and return
|
|
|
|
; get value from line .. continued
|
|
|
|
; wasn't +, -, 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 +, -, NOT or FN so ..
|
|
LAB_1BEE
|
|
SBC #TK_SGN ; subtract with token for SGN
|
|
BCS LAB_1C27 ; if a function token go do it
|
|
|
|
JMP LAB_SNER ; else do syntax error
|
|
|
|
; set-up for functions
|
|
|
|
LAB_1C11
|
|
TK_GT_PLUS = TK_GT-TK_PLUS
|
|
LDY #TK_GT_PLUS*3 ; set offset from base to > operator
|
|
LAB_1C13
|
|
PLA ; dump return address low byte
|
|
PLA ; dump return address high byte
|
|
JMP LAB_1B1D ; execute function then continue evaluation
|
|
|
|
; variable name set-up
|
|
; get (var), return value in FAC_1 and $ flag
|
|
|
|
LAB_1C18
|
|
JSR LAB_GVAR ; get (var) address
|
|
STA FAC1_2 ; save address low byte in FAC1 mantissa2
|
|
STY FAC1_3 ; save address high byte in FAC1 mantissa3
|
|
LDX Dtypef ; get data type flag, $FF=string, $00=numeric
|
|
BMI 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
|
|
|
|
; new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed
|
|
; to process function calls. now the function vector is computed and pushed on the stack
|
|
; and the preprocess offset is read. if the preprocess offset is non zero then the vector
|
|
; is calculated and the routine called, if not this routine just does RTS. whichever
|
|
; happens the RTS at the end of this routine, or the end of the preprocess routine, calls
|
|
; the function code
|
|
|
|
; this also removes some less than elegant code that was used to bypass type checking
|
|
; for functions that returned strings
|
|
|
|
LAB_1C27
|
|
ASL ; *2 (2 bytes per function address)
|
|
TAY ; copy to index
|
|
|
|
LDA LAB_FTBM,Y ; get function jump vector high byte
|
|
PHA ; push functions jump vector high byte
|
|
LDA LAB_FTBL,Y ; get function jump vector low byte
|
|
PHA ; push functions jump vector low byte
|
|
|
|
LDA LAB_FTPM,Y ; get function pre process vector high byte
|
|
BEQ LAB_1C56 ; skip pre process if null vector
|
|
|
|
PHA ; push functions pre process vector high byte
|
|
LDA LAB_FTPL,Y ; get function pre process vector low byte
|
|
PHA ; push functions pre process vector low byte
|
|
|
|
LAB_1C56
|
|
RTS ; do function, or pre process, call
|
|
|
|
; process string expression in parenthesis
|
|
|
|
LAB_PPFS
|
|
JSR LAB_1BF7 ; process expression in parenthesis
|
|
JMP LAB_CTST ; check if source is string then do function,
|
|
; else do type mismatch
|
|
|
|
; process numeric expression in parenthesis
|
|
|
|
LAB_PPFN
|
|
JSR LAB_1BF7 ; process expression in parenthesis
|
|
JMP LAB_CTNM ; check if source is numeric then do function,
|
|
; else do type mismatch
|
|
|
|
; set numeric data type and increment BASIC execute pointer
|
|
|
|
LAB_PPBI
|
|
LSR Dtypef ; clear data type flag, $FF=string, $00=numeric
|
|
JMP LAB_IGBY ; increment and scan memory then do function
|
|
|
|
; process string for LEFT$, RIGHT$ or MID$
|
|
|
|
LAB_LRMS
|
|
JSR LAB_EVEZ ; evaluate (should be string) expression
|
|
JSR LAB_1C01 ; scan for ",", else do syntax error then warm start
|
|
JSR LAB_CTST ; check if source is string, else do type mismatch
|
|
|
|
PLA ; get function jump vector low byte
|
|
TAX ; save functions jump vector low byte
|
|
PLA ; get function jump vector high byte
|
|
TAY ; save functions jump vector high byte
|
|
LDA des_ph ; get descriptor pointer high byte
|
|
PHA ; push string pointer high byte
|
|
LDA des_pl ; get descriptor pointer low byte
|
|
PHA ; push string pointer low byte
|
|
TYA ; get function jump vector high byte back
|
|
PHA ; save functions jump vector high byte
|
|
TXA ; get function jump vector low byte back
|
|
PHA ; save functions jump vector low byte
|
|
JSR LAB_GTBY ; get byte parameter
|
|
TXA ; copy byte parameter to A
|
|
RTS ; go do function
|
|
|
|
; process numeric expression(s) for BIN$ or HEX$
|
|
|
|
LAB_BHSS
|
|
JSR LAB_EVEZ ; process expression
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
|
LDA FAC1_e ; get FAC1 exponent
|
|
CMP #$98 ; compare with exponent = 2^24
|
|
BCS LAB_BHER ; branch if n>=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
|
|
|
|
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
|
|
JSR LAB_GBYT ; get last byte back
|
|
CMP #')' ; is next character )
|
|
BNE LAB_BHER ; if not ")" go do error
|
|
|
|
LAB_1C54
|
|
RTS ; else do function
|
|
|
|
LAB_BHER
|
|
JMP LAB_FCER ; do function call error then warm start
|
|
|
|
; 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 and 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 and convert integer AY to FAC1 and return
|
|
|
|
; 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 and convert integer AY to FAC1 and return
|
|
|
|
; 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 and convert integer AY to FAC1 and return
|
|
|
|
; 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 low byte to FAC2
|
|
LDY #>FAC2_e ; set pointer high byte to FAC2
|
|
JSR LAB_27F8 ; compare FAC1 with FAC2 (AY)
|
|
TAX ; copy result
|
|
JMP LAB_1CE1 ; go evaluate result
|
|
|
|
; do string < compare
|
|
LAB_1CAE
|
|
LSR 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=pointer low byte,
|
|
; Y=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=pointer low byte,
|
|
; Y=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 str 1 length = string 2 length
|
|
|
|
LDA #$01 ; set str 1 length > string 2 length
|
|
BCC LAB_1CD6 ; branch if so
|
|
|
|
LDX str_ln ; get string 1 length
|
|
LDA #$FF ; set str 1 length < string 2 length
|
|
LAB_1CD6
|
|
STA FAC1_s ; save length compare
|
|
LDY #$FF ; set index
|
|
INX ; adjust for loop
|
|
LAB_1CDB
|
|
INY ; increment index
|
|
DEX ; decrement count
|
|
BNE LAB_1CE6 ; branch if still bytes to do
|
|
|
|
LDX FAC1_s ; get length compare back
|
|
LAB_1CE1
|
|
BMI LAB_1CF2 ; branch if str 1 < str 2
|
|
|
|
CLC ; flag str 1 <= str 2
|
|
BCC LAB_1CF2 ; go evaluate result
|
|
|
|
LAB_1CE6
|
|
LDA (FAC2_2),Y ; get string 2 byte
|
|
CMP (FAC1_1),Y ; compare with string 1 byte
|
|
BEQ LAB_1CDB ; loop if bytes =
|
|
|
|
LDX #$FF ; set str 1 < string 2
|
|
BCS LAB_1CF2 ; branch if so
|
|
|
|
LDX #$01 ; set str 1 > string 2
|
|
LAB_1CF2
|
|
INX ; x = 0, 1 or 2
|
|
TXA ; copy to A
|
|
ROL ; *2 (1, 2 or 4)
|
|
AND Cflag ; AND with comparison evaluation flag
|
|
BEQ LAB_1CFB ; branch if 0 (compare is false)
|
|
|
|
LDA #$FF ; else set result true
|
|
LAB_1CFB
|
|
JMP LAB_27DB ; save A as integer byte and 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
|
|
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 and 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 and convert integer AY to FAC1 and return
|
|
|
|
; perform >> (right shift)
|
|
|
|
LAB_RSHIFT
|
|
JSR GetPair ; get integer expression and 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 and convert integer AY to FAC1 and return
|
|
|
|
TooBig
|
|
LDA #$00 ; clear high byte
|
|
TAY ; copy to low byte
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
|
|
|
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)
|
|
JMP LAB_EVIR ; evaluate integer expression (no sign check)
|
|
|
|
; search for variable
|
|
|
|
; return pointer to variable in Cvaral/Cvarah
|
|
|
|
LAB_GVAR
|
|
LDX #$00 ; set DIM flag = $00
|
|
JSR LAB_GBYT ; scan memory (1st character)
|
|
LAB_1D10
|
|
STX Defdim ; save DIM flag
|
|
LAB_1D12
|
|
STA Varnm1 ; save 1st character
|
|
AND #$7F ; clear FN flag bit
|
|
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
|
|
JSR LAB_IGBY ; increment and 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
|
|
JSR LAB_IGBY ; increment and 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 #'$' ; 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
|
|
JSR LAB_IGBY ; increment and 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
|
|
ORA Sufnxf ; or with subscript/FNX flag (or FN name)
|
|
CMP #'(' ; compare with "("
|
|
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 #'a' ; compare with "a"
|
|
BCS LAB_1D83 ; go check <"z"+1
|
|
|
|
; check byte, return C=0 if<"A" or >"Z"
|
|
|
|
LAB_1D82
|
|
CMP #'A' ; 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 $85 (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
|
|
LAB_1C18p2 = LAB_1C18+2
|
|
CMP #<LAB_1C18p2 ; compare with expected calling routine return low byte
|
|
BNE LAB_1D98 ; if not get (var) go create new var
|
|
|
|
; This will only drop through if the call was from LAB_1C18 and is only called
|
|
; from there if it is searching for a variable from the RHS of a LET a=b statement
|
|
; it prevents the creation of variables not assigned a value.
|
|
|
|
; value returned by this is either numeric zero (exponent byte is $00) or null string
|
|
; (descriptor length byte is $00). in fact a pointer to any $00 byte would have done.
|
|
|
|
; doing this saves 6 bytes of variable memory and 168 machine cycles of time
|
|
|
|
; this is where you would put the undefined variable error call e.g.
|
|
|
|
; ; variable doesn't exist so flag error
|
|
; LDX #$24 ; error code $24 ("undefined variable" error)
|
|
; JMP LAB_XERR ; do error #X then warm start
|
|
|
|
; the above code has been tested and works a treat! (it replaces the three code lines
|
|
; below)
|
|
|
|
; else return dummy null value
|
|
LDA #<LAB_1D96 ; low byte point to $00,$00
|
|
; (uses part of misc constants table)
|
|
LDY #>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 ; *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
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
JSR LAB_EVNM ; evaluate expression and 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 low byte to -32768
|
|
LDY #>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 and return
|
|
|
|
; 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
|
|
JSR LAB_GBYT ; scan memory
|
|
CMP #',' ; 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 a 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
|
|
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 ; array data pointer high byte * 2
|
|
ASL Asptl ; array data pointer low byte * 4
|
|
ROL ; 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 ; *2
|
|
TAX ; save result low byte
|
|
TYA ; get result high byte
|
|
ROL ; *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
|
|
BPL 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 and convert integer AY to FAC1
|
|
|
|
LAB_AYFC
|
|
LSR 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, clear FAC1_3, normalise and return
|
|
|
|
; 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 and convert integer AY to FAC1 and return
|
|
|
|
; 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
|
|
STA func_l ; save function pointer low byte
|
|
STY func_h ; save function pointer high byte
|
|
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
|
|
; and 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 flag so array variable test fails
|
|
JSR LAB_1D12 ; search for FN variable
|
|
JMP LAB_CTNM ; check if source is numeric and return, else do type
|
|
; mismatch
|
|
|
|
; Evaluate FNx
|
|
LAB_201E
|
|
JSR LAB_200B ; check FNx syntax
|
|
PHA ; push function pointer low byte
|
|
TYA ; copy function pointer high byte
|
|
PHA ; push function pointer high byte
|
|
JSR LAB_1BFE ; scan for "(", else do syntax error then warm start
|
|
JSR LAB_EVEX ; evaluate expression
|
|
JSR LAB_1BFB ; scan for ")", else do syntax error then warm start
|
|
JSR LAB_CTNM ; check if source is numeric, else do type mismatch
|
|
PLA ; pop function pointer high byte
|
|
STA func_h ; restore it
|
|
PLA ; pop function pointer low byte
|
|
STA func_l ; 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 and 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
|
|
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 and 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
|
|
JSR LAB_296E ; convert FAC1 to string
|
|
LDA #<Decssp1 ; set result string low pointer
|
|
LDY #>Decssp1 ; 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 and 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
|
|
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 and 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 and update stack pointers
|
|
|
|
LAB_RTST
|
|
LDX next_s ; get string stack pointer
|
|
CPX #des_sk+$09 ; 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 and 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 #$02 ; set 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
|
|
LDY #$01 ; set index
|
|
LDA (ut1_pl),Y ; get name second byte
|
|
BPL LAB_218B ; skip if not string array
|
|
|
|
; was string array so ..
|
|
|
|
LDY #$04 ; set index
|
|
LDA (ut1_pl),Y ; get # of dimensions
|
|
ASL ; *2
|
|
ADC #$05 ; +5 (array header size)
|
|
JSR LAB_2208 ; go set up for first element
|
|
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 and return
|
|
|
|
INY ; else increment index
|
|
LAB_21D7
|
|
LDA (ut1_pl),Y ; get string length
|
|
BEQ LAB_2206 ; if null, step pointer to next string and return
|
|
|
|
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 and return
|
|
|
|
; 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 and return
|
|
|
|
; string pointer is < string storage pointer (pos in mem)
|
|
LAB_21EC
|
|
CMP Histrh ; compare to highest string high byte
|
|
BCC LAB_2207 ; if <, step pointer to next string and return
|
|
|
|
BNE LAB_21F6 ; if > update pointers, step to next and return
|
|
|
|
; high bytes were = so compare low bytes
|
|
CPX Histrl ; compare to highest string low byte
|
|
BCC LAB_2207 ; if <, step pointer to next string and return
|
|
|
|
; 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
|
|
CLC ; clear carry for add
|
|
LAB_2207
|
|
LDA g_step ; get step size
|
|
LAB_2208
|
|
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 and 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 and 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 descriptor pointer low byte
|
|
STY ut1_ph ; save descriptor 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!)
|
|
JMP LAB_RTST ; check for space on descriptor stack then put string
|
|
; address and length on descriptor stack and update stack
|
|
; pointers
|
|
|
|
; perform LEFT$()
|
|
|
|
LAB_LEFT
|
|
PHA ; push byte parameter
|
|
JSR LAB_236F ; pull string data and 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
|
|
PHA ; push byte parameter
|
|
JSR LAB_236F ; pull string data and 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 and update stack
|
|
; pointers
|
|
|
|
; perform MID$()
|
|
|
|
LAB_MIDS
|
|
PHA ; push byte parameter
|
|
LDA #$FF ; set default length = 255
|
|
STA mids_l ; save default length
|
|
JSR LAB_GBYT ; scan memory
|
|
CMP #')' ; 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 and 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 and 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 ; 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
|
|
TAY ; copy length to Y
|
|
BEQ NoString ; branch if null string
|
|
|
|
JSR LAB_MSSP ; make string space A bytes long A=length,
|
|
; 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
|
|
TAY ; get string length back
|
|
|
|
LC_loop
|
|
DEY ; decrement index
|
|
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
|
|
NoUcase
|
|
STA (Sutill),Y ; save byte back to string
|
|
TYA ; test index
|
|
BNE LC_loop ; loop if not all done
|
|
|
|
BEQ NoString ; tidy up and exit, branch always
|
|
|
|
; perform UCASE$()
|
|
|
|
LAB_UCASE
|
|
JSR LAB_EVST ; evaluate string
|
|
STA str_ln ; set string length
|
|
TAY ; copy length to Y
|
|
BEQ NoString ; branch if null string
|
|
|
|
JSR LAB_MSSP ; make string space A bytes long A=length,
|
|
; 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
|
|
TAY ; get string length back
|
|
|
|
UC_loop
|
|
DEY ; decrement index
|
|
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
|
|
NoLcase
|
|
STA (Sutill),Y ; save byte back to string
|
|
TYA ; test index
|
|
BNE UC_loop ; loop if not all done
|
|
|
|
NoString
|
|
JMP LAB_RTST ; check for space on descriptor stack then put string
|
|
; address and length on descriptor stack and update stack
|
|
; pointers
|
|
|
|
; perform SADD()
|
|
|
|
LAB_SADD
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
JSR LAB_GVAR ; get var address
|
|
|
|
JSR LAB_1BFB ; scan for ")", else do syntax error then warm start
|
|
JSR LAB_CTST ; check if source is string, else do type mismatch
|
|
|
|
LDY #$02 ; index to string pointer high byte
|
|
LDA (Cvaral),Y ; get string pointer high byte
|
|
TAX ; copy string pointer high byte to X
|
|
DEY ; index to string pointer low byte
|
|
LDA (Cvaral),Y ; get string pointer low byte
|
|
TAY ; copy string pointer low byte to Y
|
|
TXA ; copy string pointer high byte to A
|
|
JMP LAB_AYFC ; save and convert integer AY to FAC1 and return
|
|
|
|
; perform LEN()
|
|
|
|
LAB_LENS
|
|
JSR LAB_ESGL ; evaluate string, get length in A (and Y)
|
|
JMP LAB_1FD0 ; convert Y to byte in FAC1 and return
|
|
|
|
; evaluate string, get length in Y
|
|
|
|
LAB_ESGL
|
|
JSR LAB_EVST ; evaluate string
|
|
TAY ; copy length to Y
|
|
RTS
|
|
|
|
; perform ASC()
|
|
|
|
LAB_ASC
|
|
JSR LAB_ESGL ; evaluate string, get length in A (and 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 and 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
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
|
|
; get byte parameter
|
|
|
|
LAB_GTBY
|
|
JSR LAB_EVNM ; evaluate expression and 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 and return
|
|
|
|
; perform VAL()
|
|
|
|
LAB_VAL
|
|
JSR LAB_ESGL ; evaluate string, get length in A (and Y)
|
|
BNE LAB_23C5 ; branch if not null string
|
|
|
|
; string was null so set result = $00
|
|
JMP LAB_24F1 ; clear FAC1 exponent and sign and 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
|
|
LDA ut1_ph ; get string pointer high byte
|
|
STA Bpntrh ; save as BASIC execute pointer high byte
|
|
ADC #$00 ; add carry to high byte
|
|
STA ut2_ph ; save string end high byte
|
|
LDY #$00 ; set index to $00
|
|
LDA (ut2_pl),Y ; get string end +1 byte
|
|
PHA ; push it
|
|
TYA ; clear A
|
|
STA (ut2_pl),Y ; terminate string with $00
|
|
JSR LAB_GBYT ; scan memory
|
|
JSR LAB_2887 ; get FAC1 from string
|
|
PLA ; restore string end +1 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 and 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 and 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 and 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 and convert integer AY to FAC1 and return
|
|
|
|
; perform DOKE
|
|
|
|
LAB_DOKE
|
|
JSR LAB_EVNM ; evaluate expression and 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 and 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 and 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
|
|
EOR Dtypef ; compare with var2 data type
|
|
BPL 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
|
|
TAX ; save var1 byte
|
|
LDA (Cvaral),Y ; get byte from var2
|
|
STA (Lvarpl),Y ; save byte to var1
|
|
TXA ; 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 and 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 #<CallExit-1 ; set return address low byte
|
|
PHA ; put on stack
|
|
JMP (Itempl) ; do indirect jump to user routine
|
|
|
|
; if the called routine exits correctly then it will return to here. this will then get
|
|
; the next byte for the interpreter and return
|
|
|
|
CallExit
|
|
JMP LAB_GBYT ; scan memory and return
|
|
|
|
; perform WAIT
|
|
|
|
LAB_WAIT
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
|
STX Frnxtl ; save byte
|
|
LDX #$00 ; clear mask
|
|
JSR LAB_GBYT ; scan memory
|
|
BEQ LAB_2441 ; skip if no third argument
|
|
|
|
JSR LAB_SCGB ; scan for "," and get byte, else SN error then warm start
|
|
LAB_2441
|
|
STX Frnxth ; save EOR argument
|
|
LAB_2445
|
|
LDA (Itempl),Y ; get byte via temporary integer (addr)
|
|
EOR Frnxth ; EOR with second argument (mask)
|
|
AND Frnxtl ; AND with first argument (byte)
|
|
BEQ LAB_2445 ; loop if result is zero
|
|
|
|
LAB_244D
|
|
RTS
|
|
|
|
; perform subtraction, FAC1 from (AY)
|
|
|
|
LAB_2455
|
|
JSR LAB_264D ; unpack memory (AY) into FAC2
|
|
|
|
; perform subtraction, FAC1 from FAC2
|
|
|
|
LAB_SUBTRACT
|
|
LDA FAC1_s ; get FAC1 sign (b7)
|
|
EOR #$FF ; complement it
|
|
STA FAC1_s ; save FAC1 sign (b7)
|
|
EOR FAC2_s ; EOR with FAC2 sign (b7)
|
|
STA FAC_sc ; save sign compare (FAC1 EOR FAC2)
|
|
LDA FAC1_e ; get FAC1 exponent
|
|
JMP LAB_ADD ; go add FAC2 to FAC1
|
|
|
|
; perform addition
|
|
|
|
LAB_2467
|
|
JSR LAB_257B ; shift FACX A times right (>8 shifts)
|
|
BCC LAB_24A8 ;.go subtract mantissas
|
|
|
|
; add 0.5 to FAC1
|
|
|
|
LAB_244E
|
|
LDA #<LAB_2A96 ; set 0.5 pointer low byte
|
|
LDY #>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
|
|
|
|
; copy FAC2 to FAC1
|
|
|
|
LAB_279B
|
|
LDA FAC2_s ; get FAC2 sign (b7)
|
|
|
|
; save FAC1 sign and 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
|
|
|
|
; 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 and return
|
|
|
|
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 and 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 and sign
|
|
|
|
LAB_24F1
|
|
LDA #$00 ; clear A
|
|
LAB_24F3
|
|
STA FAC1_e ; set FAC1 exponent
|
|
|
|
; save FAC1 sign
|
|
|
|
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
|
|
BCS LAB_252A ; if carry then normalise FAC1 for C=1
|
|
|
|
RTS ; else just exit
|
|
|
|
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 and 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 and 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 #FACt_1-1 ; 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
|
|
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 ; 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 low byte
|
|
LDY #>LAB_25AD ; set 1/root2 pointer high byte
|
|
JSR LAB_246C ; add (AY) to FAC1 (1/root2)
|
|
LDA #<LAB_25B1 ; set root2 pointer low byte
|
|
LDY #>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 low byte
|
|
LDY #>LAB_259C ; set 1 pointer high byte
|
|
JSR LAB_2455 ; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1)
|
|
LDA #<LAB_25A0 ; set pointer low byte to counter
|
|
LDY #>LAB_25A0 ; set pointer high byte to counter
|
|
JSR LAB_2B6E ; ^2 then series evaluation
|
|
LDA #<LAB_25B5 ; set -0.5 pointer low byte
|
|
LDY #>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 low byte
|
|
LDY #>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
|
|
|
|
JSR LAB_2673 ; test and 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 and return
|
|
|
|
LAB_2622
|
|
BNE LAB_2627 ; branch if byte <> zero
|
|
|
|
JMP LAB_2569 ; shift FCAtemp << A+8 times
|
|
|
|
; else do shift and add
|
|
LAB_2627
|
|
LSR ; 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 ; 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 and 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 ; adjust exponent
|
|
STA FAC1_e ; save FAC1 exponent
|
|
BNE LAB_268B ; branch if not zero
|
|
|
|
JMP LAB_24F5 ; save FAC1 sign and 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)
|
|
BPL 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 and sign and return
|
|
|
|
; multiply by 10
|
|
|
|
LAB_269E
|
|
JSR LAB_27AB ; round and 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 and warm start
|
|
|
|
; divide by 10
|
|
|
|
LAB_26B9
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
|
LDA #<LAB_26B5 ; set pointer to 10d low addr
|
|
LDY #>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 and adjust accumulators
|
|
INC FAC1_e ; increment FAC1 exponent
|
|
BEQ LAB_269B ; if zero do overflow error
|
|
|
|
LDX #$FF ; set index for pre increment
|
|
LDA #$01 ; set bit to flag byte save
|
|
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 ; shift the result byte
|
|
BCC LAB_2702 ; if no carry skip the byte save
|
|
|
|
LDY #$01 ; set bit to flag byte save
|
|
INX ; else increment the index to FACt
|
|
CPX #$02 ; compare with the index to FACt_3
|
|
BMI LAB_2701 ; if not last byte just go save it
|
|
|
|
BNE LAB_272B ; if all done go save FAC1 rounding byte, normalise and
|
|
; return
|
|
|
|
LDY #$40 ; set bit to flag byte save for the rounding byte
|
|
LAB_2701
|
|
STA FACt_1,X ; write result byte to FACt_1 + index
|
|
TYA ; copy the next save byte flag
|
|
LAB_2702
|
|
PLP ; restore FAC2-FAC1 compare status
|
|
BCC LAB_2704 ; if FAC2 < FAC1 then skip the subtract
|
|
|
|
TAY ; save FAC2-FAC1 compare status
|
|
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 FAC2-FAC1 compare status
|
|
|
|
; 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
|
|
|
|
; do A<<6, save as FAC1 rounding byte, normalise and return
|
|
|
|
LAB_272B
|
|
LSR ; shift b1 - b0 ..
|
|
ROR ; ..
|
|
ROR ; .. to b7 - b6
|
|
STA FAC1_r ; save FAC1 rounding byte
|
|
PLP ; dump FAC2-FAC1 compare status
|
|
JMP LAB_273C ; copy temp to FAC1, normalise and 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 and 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 and 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 Adatal
|
|
|
|
LAB_276E
|
|
LDX #<Adatal ; set pointer low byte
|
|
LAB_2770
|
|
LDY #>Adatal ; set pointer high byte
|
|
BEQ LAB_2778 ; pack FAC1 into (XY) and return
|
|
|
|
; 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
|
|
|
|
; round and 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 and 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 ; 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 and normalise
|
|
|
|
LAB_27E3
|
|
LDA FAC1_1 ; get FAC1 mantissa1
|
|
EOR #$FF ; complement it
|
|
ROL ; sign bit into carry
|
|
|
|
; set exp=X, clearFAC1 mantissa3 and 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 and 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 and 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 and 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 and 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 and return
|
|
|
|
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 ; shift into carry
|
|
LDA #$98 ; set new exponent
|
|
STA FAC1_e ; save FAC1 exponent
|
|
LDA FAC1_3 ; get FAC1 mantissa3
|
|
STA Temp3 ; save for EXP() function
|
|
JMP LAB_24D0 ; do ABS and normalise FAC1
|
|
|
|
; clear FAC1 and 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
|
|
STY Dtypef ; clear data type flag, $FF=string, $00=numeric
|
|
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 and 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
|
|
JSR LAB_IGBY ; increment and 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
|
|
JSR LAB_IGBY ; increment and 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
|
|
JSR LAB_IGBY ; increment and 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
|
|
JSR LAB_IGBY ; increment and 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 and return
|
|
|
|
RTS
|
|
|
|
; do - FAC1 and return
|
|
|
|
LAB_28FB
|
|
JMP LAB_GTHAN ; do - FAC1 and 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
|
|
AND #$0F ; 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 and 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 and 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 ; * 2
|
|
ASL ; * 4
|
|
ADC expcnt ; * 5
|
|
ASL ; * 10
|
|
LDY #$00 ; set index
|
|
ADC (Bpntrl),Y ; add character (will be $30 too much!)
|
|
SBC #'0'-1 ; 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 low byte
|
|
LDY #>LAB_LMSG ; point to " in line " message high byte
|
|
JSR LAB_18C3 ; print null terminated string from memory
|
|
|
|
; 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 and normalise
|
|
LDY #$00 ; clear index
|
|
TYA ; clear A
|
|
JSR LAB_297B ; convert FAC1 to string, skip sign character save
|
|
JMP LAB_18C3 ; print null terminated string from memory and return
|
|
|
|
; convert FAC1 to ASCII string result in (AY)
|
|
; not any more, moved scratchpad to page 0
|
|
|
|
LAB_296E
|
|
LDY #$01 ; set index = 1
|
|
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 "-")
|
|
LAB_297B
|
|
STA FAC1_s ; clear 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 #'0' ; set character = "0"
|
|
JMP LAB_2A89 ; save last character, [EOT] and 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 low byte to 1,000,000
|
|
LDY #>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 low byte to 999999.4375 (max before sci note)
|
|
LDY #>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 low byte to 99999.9375
|
|
LDY #>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 #'0' ; 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 #'0'-1 ; 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 #'0' ; compare with "0"
|
|
BEQ LAB_2A4B ; loop until non "0" character found
|
|
|
|
CMP #'.' ; 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 and 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 #'-' ; 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 #'0'-1 ; 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 #':' ; 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] and exit
|
|
LAB_2A89
|
|
STA Decss,Y ; save last character to output string
|
|
|
|
; set null terminator and 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 #<Decssp1 ; set result string low pointer
|
|
LDY #>Decssp1 ; set result string high pointer
|
|
RTS
|
|
|
|
; perform power function
|
|
|
|
LAB_POWER
|
|
BEQ LAB_EXP ; go do EXP()
|
|
|
|
LDA FAC2_e ; get FAC2 exponent
|
|
BNE LAB_2ABF ; branch if FAC2<>0
|
|
|
|
JMP LAB_24F3 ; clear FAC1 exponent and sign and return
|
|
|
|
LAB_2ABF
|
|
LDX #<func_l ; set destination pointer low byte
|
|
LDY #>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
|
|
|
|
; else FAC2 is -ve and can only be raised to an
|
|
; integer power which gives an x +j0 result
|
|
JSR LAB_INT ; perform INT
|
|
LDA #<func_l ; set source pointer low byte
|
|
LDY #>func_l ; set source pointer high byte
|
|
JSR LAB_27F8 ; compare FAC1 with (AY)
|
|
BNE LAB_2AD9 ; branch if FAC1 <> (AY) to allow Function Call error
|
|
; this will leave FAC1 -ve and cause a Function Call
|
|
; error when LOG() is called
|
|
|
|
TYA ; clear sign b7
|
|
LDY Temp3 ; save mantissa 3 from INT() function as sign in Y
|
|
; for possible later negation, b0
|
|
LAB_2AD9
|
|
JSR LAB_279D ; save FAC1 sign and copy ABS(FAC2) to FAC1
|
|
TYA ; copy sign back ..
|
|
PHA ; .. and save it
|
|
JSR LAB_LOG ; do LOG(n)
|
|
LDA #<garb_l ; set pointer low byte
|
|
LDY #>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 ; pull sign from stack
|
|
LSR ; b0 is to be tested, shift to Cb
|
|
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 low byte
|
|
LDY #>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 ; get mantissa 3 from INT() function
|
|
CLC ; clear carry for add
|
|
ADC #$81 ; normalise +1
|
|
BEQ LAB_2B36 ; if $00 go handle overflow
|
|
|
|
SEC ; set carry for subtract
|
|
SBC #$01 ; now correct for exponent
|
|
PHA ; save FAC2 exponent
|
|
|
|
; swap FAC1 and 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 low byte
|
|
LDY #>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 and adjust accumulators and 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 ; set pointer low byte (Y already $00)
|
|
JSR LAB_25FB ; do convert AY, FCA1*(AY)
|
|
JSR LAB_2B88 ; go do series evaluation
|
|
LDA #<Adatal ; pointer to original # low byte
|
|
LDY #>Adatal ; pointer to original # high byte
|
|
JMP LAB_25FB ; do convert AY, FCA1*(AY) and return
|
|
|
|
; series evaluation
|
|
|
|
LAB_2B84
|
|
STA Cptrl ; save count pointer low byte
|
|
STY Cptrh ; save count pointer high byte
|
|
LAB_2B88
|
|
LDX #<numexp ; set pointer low byte
|
|
JSR LAB_2770 ; set pointer high byte and 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 low byte to partial @ numexp
|
|
LDY #>numexp ; set pointer high byte to partial @ numexp
|
|
DEC numcon ; decrement constants count
|
|
BNE LAB_2B9B ; loop until all done
|
|
|
|
RTS
|
|
|
|
; RND(n), 32 bit Galoise version. make n=0 for 19th next number in sequence or n<>0
|
|
; to get 19th next number in sequence after seed n. This version of the PRNG uses
|
|
; the Galois method and a sample of 65536 bytes produced gives the following values.
|
|
|
|
; Entropy = 7.997442 bits per byte
|
|
; Optimum compression would reduce these 65536 bytes by 0 percent
|
|
|
|
; Chi square distribution for 65536 samples is 232.01, and
|
|
; randomly would exceed this value 75.00 percent of the time
|
|
|
|
; Arithmetic mean value of data bytes is 127.6724, 127.5 would be random
|
|
; Monte Carlo value for Pi is 3.122871269, error 0.60 percent
|
|
; Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0
|
|
|
|
LAB_RND
|
|
LDA FAC1_e ; get FAC1 exponent
|
|
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 #$AF ; set EOR byte
|
|
LDY #$13 ; do this nineteen times
|
|
LoopPRN
|
|
ASL Rbyte1 ; shift PRNG most significant byte
|
|
ROL Rbyte2 ; shift PRNG middle byte
|
|
ROL Rbyte3 ; shift PRNG least significant byte
|
|
ROL Rbyte4 ; shift PRNG extra byte
|
|
BCC Ninc1 ; branch if bit 32 clear
|
|
|
|
TXA ; set EOR byte
|
|
EOR Rbyte1 ; EOR PRNG extra byte
|
|
STA Rbyte1 ; save new PRNG extra byte
|
|
Ninc1
|
|
DEY ; decrement loop count
|
|
BNE LoopPRN ; loop if not all done
|
|
|
|
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 and return
|
|
|
|
; perform COS()
|
|
|
|
LAB_COS
|
|
LDA #<LAB_2C78 ; set (pi/2) pointer low byte
|
|
LDY #>LAB_2C78 ; set (pi/2) pointer high byte
|
|
JSR LAB_246C ; add (AY) to FAC1
|
|
|
|
; perform SIN()
|
|
|
|
LAB_SIN
|
|
JSR LAB_27AB ; round and copy FAC1 to FAC2
|
|
LDA #<LAB_2C7C ; set (2*pi) pointer low byte
|
|
LDY #>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 and 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 low byte
|
|
LDY #>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 low byte
|
|
LDY #>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 low byte to counter
|
|
LDY #>LAB_2C84 ; set pointer high byte to counter
|
|
JMP LAB_2B6E ; ^2 then series evaluation and return
|
|
|
|
; 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 low byte
|
|
LDY #>func_l ; set sin(n) pointer high byte
|
|
JSR LAB_2778 ; pack FAC1 into (XY)
|
|
LDA #<Adatal ; set n pointer low addr
|
|
LDY #>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 low byte
|
|
LDY #>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 USR()
|
|
|
|
LAB_USR
|
|
JSR Usrjmp ; call user code
|
|
JMP LAB_1BFB ; scan for ")", else do syntax error then warm start
|
|
|
|
; 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 low byte
|
|
LDY #>LAB_259C ; set 1 pointer high byte
|
|
JSR LAB_26CA ; convert AY and do (AY)/FAC1
|
|
LAB_2CAF
|
|
LDA #<LAB_2CC9 ; set pointer low byte to counter
|
|
LDY #>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 low byte
|
|
LDY #>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 and 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 ; 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 ; 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_IGBY ; increment BASIC pointer
|
|
JSR LAB_GADB ; get two parameters for POKE or WAIT
|
|
CPX #$08 ; only 0 to 7 are allowed
|
|
BCS FCError ; branch if > 7
|
|
|
|
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
|
|
JSR LAB_IGBY ; update BASIC execute pointer (to character past ")")
|
|
LDA #$00 ; clear A
|
|
SEC ; set the carry
|
|
T_Bits
|
|
ROL ; 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
|
|
LDX #$18 ; character count
|
|
NextB1
|
|
LSR nums_1 ; shift highest byte
|
|
ROR nums_2 ; shift middle byte
|
|
ROR nums_3 ; shift lowest byte bit 0 to carry
|
|
TXA ; load with "0"/2
|
|
ROL ; shift in carry
|
|
STA (str_pl),Y ; save to temp string + index
|
|
DEY ; decrement index
|
|
BPL NextB1 ; loop if not done
|
|
|
|
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
|
|
STX str_ln ; X holds string length
|
|
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 and 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 and output
|
|
LDA nums_2 ; get middle byte
|
|
JSR LAB_A2HX ; convert A to ASCII hex byte and output
|
|
LDA nums_1 ; get highest byte
|
|
JSR LAB_A2HX ; convert A to ASCII hex byte and 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 and output .. note set decimal mode before calling
|
|
|
|
LAB_A2HX
|
|
TAX ; save byte
|
|
AND #$0F ; mask off top bits
|
|
JSR LAB_AL2X ; convert low nibble to ASCII and output
|
|
TXA ; get byte back
|
|
LSR ; /2 shift high nibble to low nibble
|
|
LSR ; /4
|
|
LSR ; /8
|
|
LSR ; /16
|
|
LAB_AL2X
|
|
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
|
|
|
|
LAB_NLTO
|
|
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
|
|
|
|
; gets here if the first character was "$" for hex
|
|
; get hex number
|
|
|
|
LAB_CHEX
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
BCC LAB_ISHN ; branch if numeric character
|
|
|
|
ORA #$20 ; case convert, allow "A" to "F" and "a" to "f"
|
|
SBC #'a' ; subtract "a" (carry set here)
|
|
CMP #$06 ; compare normalised with $06 (max+1)
|
|
BCS LAB_EXCH ; exit if >"f" or <"0"
|
|
|
|
ADC #$0A ; convert to nibble
|
|
LAB_ISHN
|
|
AND #$0F ; convert to binary
|
|
TAX ; save nibble
|
|
LDA FAC1_e ; get FAC1 exponent
|
|
BEQ LAB_MLTE ; skip multiply if zero
|
|
|
|
ADC #$04 ; add four to exponent (*16 - carry clear here)
|
|
BCC LAB_NLTO ; if no overflow do evaluate digit
|
|
|
|
LAB_MLTO
|
|
JMP LAB_2564 ; do overflow error and warm start
|
|
|
|
LAB_NXCH
|
|
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
|
|
|
|
; gets here if the first character was "%" for binary
|
|
; get binary number
|
|
|
|
LAB_CBIN
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
EOR #'0' ; convert "0" to 0 etc.
|
|
CMP #$02 ; compare with max+1
|
|
BCC LAB_NXCH ; branch exit if < 2
|
|
|
|
LAB_EXCH
|
|
JMP LAB_28F6 ; evaluate -ve flag and return
|
|
|
|
; 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 ; 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
|
|
|
|
EOR #TK_CLEAR ; compare with token for CLEAR, A = $00 if = TK_CLEAR
|
|
BEQ LAB_INEX ; go clear interrupt flags and 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 and return
|
|
|
|
LAB_INON
|
|
LDA PLUS_0,X ; get interrupt setup flag
|
|
ASL ; 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 and 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
|
|
JSR LAB_IGBY ; increment and 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 and 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 ; 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 ; copy setup to enabled (b7)
|
|
ORA NmiBase ; OR in setup flag
|
|
STA NmiBase ; save enabled flag
|
|
JMP LAB_16E8 ; go do rest of RETURN
|
|
|
|
; MAX() MIN() pre process
|
|
|
|
LAB_MMPP
|
|
JSR LAB_EVEZ ; process expression
|
|
JMP LAB_CTNM ; check if source is numeric, else do type mismatch
|
|
|
|
; perform MAX()
|
|
|
|
LAB_MAX
|
|
JSR LAB_PHFA ; push FAC1, evaluate expression,
|
|
; pull FAC2 and compare with FAC1
|
|
BPL LAB_MAX ; 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_MAX ; go do next (branch always)
|
|
|
|
; perform MIN()
|
|
|
|
LAB_MIN
|
|
JSR LAB_PHFA ; push FAC1, evaluate expression,
|
|
; pull FAC2 and compare with FAC1
|
|
BMI LAB_MIN ; branch if no swap to do
|
|
|
|
BEQ LAB_MIN ; 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_MIN ; 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
|
|
JMP LAB_IGBY ; update BASIC execute pointer (to chr past ")")
|
|
|
|
LAB_MMSE
|
|
JMP LAB_SNER ; do syntax error then warm start
|
|
|
|
; check for next, evaluate and return or exit
|
|
; this is the routine that does most of the work
|
|
|
|
LAB_PHFA
|
|
JSR LAB_GBYT ; get next BASIC byte
|
|
CMP #',' ; 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
|
|
|
|
JSR LAB_IGBY ; scan and get next BASIC byte (after ",")
|
|
JSR LAB_EVNM ; evaluate expression and 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 low byte to FAC2
|
|
LDY #>FAC2_e ; set pointer high byte to FAC2
|
|
JMP LAB_27F8 ; compare FAC1 with FAC2 (AY) and return
|
|
; returns A=$00 if FAC1 = (AY)
|
|
; returns A=$01 if FAC1 > (AY)
|
|
; returns A=$FF if FAC1 < (AY)
|
|
|
|
; perform WIDTH
|
|
|
|
LAB_WDTH
|
|
CMP #',' ; 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 and 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
|
|
JSR LAB_GBYT ; get BASIC byte back
|
|
BEQ WExit ; exit if no following
|
|
|
|
CMP #',' ; 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 and exit
|
|
|
|
CPX #$01 ; compare with min-1
|
|
BCC TabErr ; if <=1 do function call error and 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
|
|
|
|
LDA FAC1_e ; get exponent
|
|
BEQ LAB_NOSQ ; if zero just return
|
|
|
|
; else do root
|
|
JSR LAB_27AB ; round and 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
|
|
LSR ; check odd/even
|
|
BCS 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 ; *2
|
|
STA Temp3 ; save partial low byte
|
|
LDA FAC1_2 ; get root low mid byte
|
|
ROL ; *2
|
|
STA Temp3+1 ; save partial low mid byte
|
|
LDA FAC1_1 ; get root high mid byte
|
|
ROL ; *2
|
|
STA Temp3+2 ; save partial high mid byte
|
|
LDA #$00 ; get root high byte (always $00)
|
|
ROL ; *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 ; /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 and return
|
|
|
|
; perform VARPTR()
|
|
|
|
LAB_VARPTR
|
|
JSR LAB_IGBY ; increment and scan memory
|
|
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 and convert integer AY to FAC1 and return
|
|
|
|
; perform PI
|
|
|
|
LAB_PI
|
|
LDA #<LAB_2C7C ; set (2*pi) pointer low byte
|
|
LDY #>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
|
|
LDA #<LAB_2C7C ; set (2*pi) pointer low byte
|
|
LDY #>LAB_2C7C ; set (2*pi) pointer high byte
|
|
JMP LAB_UFAC ; unpack memory (AY) into FAC1 and return
|
|
|
|
; system dependant i/o vectors
|
|
; these are in RAM and are set by the monitor at start-up
|
|
|
|
V_INPT
|
|
JMP (VEC_IN) ; non halting scan input device
|
|
V_OUTP
|
|
JMP (VEC_OUT) ; send byte to output device
|
|
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 and 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 and 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 #TK_ELSE ; compare with the token for ELSE
|
|
BEQ LAB_2D05 ; exit if ELSE, not numeric, carry set
|
|
|
|
CMP #':' ; compare with ":"
|
|
BCS LAB_2D05 ; exit if >= ":", not numeric, carry set
|
|
|
|
CMP #' ' ; compare with " "
|
|
BEQ LAB_2CEE ; if " " go do next
|
|
|
|
SEC ; set carry for SBC
|
|
SBC #'0' ; 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 $0D,$0A,"Memory size ",$00
|
|
|
|
LAB_SMSG
|
|
.byte " Bytes free",$0D,$0A,$0A
|
|
.byte "Enhanced BASIC 2.22",$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 $80,$76,$22,$F1 ; 0.96147
|
|
.byte $82,$38,$AA,$40 ; 2.88539
|
|
;## .byte $82,$38,$AA,$45 ; 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
|
|
|
|
;## .byte $07 ; counter
|
|
;## .byte $74,$94,$2E,$40 ; -1/7! (-1/5040)
|
|
;## .byte $77,$2E,$4F,$70 ; 1/6! ( 1/720)
|
|
;## .byte $7A,$88,$02,$6E ; -1/5! (-1/120)
|
|
;## .byte $7C,$2A,$A0,$E6 ; 1/4! ( 1/24)
|
|
;## .byte $7E,$AA,$AA,$50 ; -1/3! (-1/6)
|
|
;## .byte $7F,$7F,$FF,$FF ; 1/2! ( 1/2)
|
|
;## .byte $81,$80,$00,$00 ; -1/1! (-1/1)
|
|
;## .byte $81,$00,$00,$00 ; 1/0! ( 1/1)
|
|
|
|
; 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 $86,$1E,$D7,$BA ; 39.7109
|
|
.byte $87,$99,$26,$65 ;-76.575
|
|
;## .byte $87,$99,$26,$64 ;-76.575
|
|
.byte $87,$23,$34,$58 ; 81.6022
|
|
.byte $86,$A5,$5D,$E1 ;-41.3417
|
|
;## .byte $86,$A5,$5D,$E0 ;-41.3417
|
|
LAB_2C7C
|
|
.byte $83,$49,$0F,$DB ; 6.28319 (2*pi) as floating #
|
|
;## .byte $83,$49,$0F,$DA ; 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
|
|
|
|
;## .byte $08 ; counter
|
|
;## .byte $78,$3B,$D7,$4A ; 1/17
|
|
;## .byte $7B,$84,$6E,$02 ;-1/15
|
|
;## .byte $7C,$2F,$C1,$FE ; 1/13
|
|
;## .byte $7D,$9A,$31,$74 ;-1/11
|
|
;## .byte $7D,$5A,$3D,$84 ; 1/9
|
|
;## .byte $7E,$91,$7F,$C8 ;-1/7
|
|
;## .byte $7E,$4C,$BB,$E4 ; 1/5
|
|
;## .byte $7F,$AA,$AA,$6C ;-1/3
|
|
|
|
LAB_1D96 = *+1 ; $00,$00 used for undefined variables
|
|
LAB_259C
|
|
.byte $81,$00,$00,$00 ; 1.000000, used for INC
|
|
LAB_2AFD
|
|
.byte $81,$80,$00,$00 ; -1.00000, used for DEC. must be on the same page as +1.00
|
|
|
|
; 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
|
|
|
|
; function pre process routine table
|
|
|
|
LAB_FTPL
|
|
LAB_FTPM = LAB_FTPL+$01
|
|
.word LAB_PPFN-1 ; SGN(n) process numeric expression in ()
|
|
.word LAB_PPFN-1 ; INT(n) "
|
|
.word LAB_PPFN-1 ; ABS(n) "
|
|
.word LAB_EVEZ-1 ; USR(x) process any expression
|
|
.word LAB_1BF7-1 ; FRE(x) "
|
|
.word LAB_1BF7-1 ; POS(x) "
|
|
.word LAB_PPFN-1 ; SQR(n) process numeric expression in ()
|
|
.word LAB_PPFN-1 ; RND(n) "
|
|
.word LAB_PPFN-1 ; LOG(n) "
|
|
.word LAB_PPFN-1 ; EXP(n) "
|
|
.word LAB_PPFN-1 ; COS(n) "
|
|
.word LAB_PPFN-1 ; SIN(n) "
|
|
.word LAB_PPFN-1 ; TAN(n) "
|
|
.word LAB_PPFN-1 ; ATN(n) "
|
|
.word LAB_PPFN-1 ; PEEK(n) "
|
|
.word LAB_PPFN-1 ; DEEK(n) "
|
|
.word $0000 ; SADD() none
|
|
.word LAB_PPFS-1 ; LEN($) process string expression in ()
|
|
.word LAB_PPFN-1 ; STR$(n) process numeric expression in ()
|
|
.word LAB_PPFS-1 ; VAL($) process string expression in ()
|
|
.word LAB_PPFS-1 ; ASC($) "
|
|
.word LAB_PPFS-1 ; UCASE$($) "
|
|
.word LAB_PPFS-1 ; LCASE$($) "
|
|
.word LAB_PPFN-1 ; CHR$(n) process numeric expression in ()
|
|
.word LAB_BHSS-1 ; HEX$(n) "
|
|
.word LAB_BHSS-1 ; BIN$(n) "
|
|
.word $0000 ; BITTST() none
|
|
.word LAB_MMPP-1 ; MAX() process numeric expression
|
|
.word LAB_MMPP-1 ; MIN() "
|
|
.word LAB_PPBI-1 ; PI advance pointer
|
|
.word LAB_PPBI-1 ; TWOPI "
|
|
.word $0000 ; VARPTR() none
|
|
.word LAB_LRMS-1 ; LEFT$() process string expression
|
|
.word LAB_LRMS-1 ; RIGHT$() "
|
|
.word LAB_LRMS-1 ; MID$() "
|
|
|
|
; action addresses for functions
|
|
|
|
LAB_FTBL
|
|
LAB_FTBM = LAB_FTBL+$01
|
|
.word LAB_SGN-1 ; SGN()
|
|
.word LAB_INT-1 ; INT()
|
|
.word LAB_ABS-1 ; ABS()
|
|
.word LAB_USR-1 ; USR()
|
|
.word LAB_FRE-1 ; FRE()
|
|
.word LAB_POS-1 ; POS()
|
|
.word LAB_SQR-1 ; SQR()
|
|
.word LAB_RND-1 ; RND() modified function
|
|
.word LAB_LOG-1 ; LOG()
|
|
.word LAB_EXP-1 ; EXP()
|
|
.word LAB_COS-1 ; COS()
|
|
.word LAB_SIN-1 ; SIN()
|
|
.word LAB_TAN-1 ; TAN()
|
|
.word LAB_ATN-1 ; ATN()
|
|
.word LAB_PEEK-1 ; PEEK()
|
|
.word LAB_DEEK-1 ; DEEK() new function
|
|
.word LAB_SADD-1 ; SADD() new function
|
|
.word LAB_LENS-1 ; LEN()
|
|
.word LAB_STRS-1 ; STR$()
|
|
.word LAB_VAL-1 ; VAL()
|
|
.word LAB_ASC-1 ; ASC()
|
|
.word LAB_UCASE-1 ; UCASE$() new function
|
|
.word LAB_LCASE-1 ; LCASE$() new function
|
|
.word LAB_CHRS-1 ; CHR$()
|
|
.word LAB_HEXS-1 ; HEX$() new function
|
|
.word LAB_BINS-1 ; BIN$() new function
|
|
.word LAB_BTST-1 ; BITTST() new function
|
|
.word LAB_MAX-1 ; MAX() new function
|
|
.word LAB_MIN-1 ; MIN() new function
|
|
.word LAB_PI-1 ; PI new function
|
|
.word LAB_TWOPI-1 ; TWOPI new function
|
|
.word LAB_VARPTR-1 ; VARPTR() new function
|
|
.word LAB_LEFT-1 ; LEFT$()
|
|
.word LAB_RIGHT-1 ; RIGHT$()
|
|
.word LAB_MIDS-1 ; 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
|
|
|
|
; keywords start with ..
|
|
; this is the first character table and must be in alphabetic order
|
|
|
|
TAB_1STC
|
|
.byte "*"
|
|
.byte "+"
|
|
.byte "-"
|
|
.byte "/"
|
|
.byte "<"
|
|
.byte "="
|
|
.byte ">"
|
|
.byte "?"
|
|
.byte "A"
|
|
.byte "B"
|
|
.byte "C"
|
|
.byte "D"
|
|
.byte "E"
|
|
.byte "F"
|
|
.byte "G"
|
|
.byte "H"
|
|
.byte "I"
|
|
.byte "L"
|
|
.byte "M"
|
|
.byte "N"
|
|
.byte "O"
|
|
.byte "P"
|
|
.byte "R"
|
|
.byte "S"
|
|
.byte "T"
|
|
.byte "U"
|
|
.byte "V"
|
|
.byte "W"
|
|
.byte "^"
|
|
.byte $00 ; table terminator
|
|
|
|
; pointers to keyword tables
|
|
|
|
TAB_CHRT
|
|
.word TAB_STAR ; table for "*"
|
|
.word TAB_PLUS ; table for "+"
|
|
.word TAB_MNUS ; table for "-"
|
|
.word TAB_SLAS ; table for "/"
|
|
.word TAB_LESS ; table for "<"
|
|
.word TAB_EQUL ; table for "="
|
|
.word TAB_MORE ; table for ">"
|
|
.word TAB_QEST ; table for "?"
|
|
.word TAB_ASCA ; table for "A"
|
|
.word TAB_ASCB ; table for "B"
|
|
.word TAB_ASCC ; table for "C"
|
|
.word TAB_ASCD ; table for "D"
|
|
.word TAB_ASCE ; table for "E"
|
|
.word TAB_ASCF ; table for "F"
|
|
.word TAB_ASCG ; table for "G"
|
|
.word TAB_ASCH ; table for "H"
|
|
.word TAB_ASCI ; table for "I"
|
|
.word TAB_ASCL ; table for "L"
|
|
.word TAB_ASCM ; table for "M"
|
|
.word TAB_ASCN ; table for "N"
|
|
.word TAB_ASCO ; table for "O"
|
|
.word TAB_ASCP ; table for "P"
|
|
.word TAB_ASCR ; table for "R"
|
|
.word TAB_ASCS ; table for "S"
|
|
.word TAB_ASCT ; table for "T"
|
|
.word TAB_ASCU ; table for "U"
|
|
.word TAB_ASCV ; table for "V"
|
|
.word TAB_ASCW ; table for "W"
|
|
.word TAB_POWR ; table for "^"
|
|
|
|
; tables for each start character, note if a longer keyword with the same start
|
|
; letters as a shorter one exists then it must come first, else the list is in
|
|
; alphabetical order as follows ..
|
|
|
|
; [keyword,token
|
|
; [keyword,token]]
|
|
; end marker (#$00)
|
|
|
|
TAB_STAR
|
|
.byte TK_MUL,$00 ; *
|
|
TAB_PLUS
|
|
.byte TK_PLUS,$00 ; +
|
|
TAB_MNUS
|
|
.byte TK_MINUS,$00 ; -
|
|
TAB_SLAS
|
|
.byte TK_DIV,$00 ; /
|
|
TAB_LESS
|
|
LBB_LSHIFT
|
|
.byte "<",TK_LSHIFT ; << note - "<<" must come before "<"
|
|
.byte TK_LT ; <
|
|
.byte $00
|
|
TAB_EQUL
|
|
.byte TK_EQUAL,$00 ; =
|
|
TAB_MORE
|
|
LBB_RSHIFT
|
|
.byte ">",TK_RSHIFT ; >> note - ">>" must come before ">"
|
|
.byte TK_GT ; >
|
|
.byte $00
|
|
TAB_QEST
|
|
.byte TK_PRINT,$00 ; ?
|
|
TAB_ASCA
|
|
LBB_ABS
|
|
.byte "BS(",TK_ABS ; ABS(
|
|
LBB_AND
|
|
.byte "ND",TK_AND ; AND
|
|
LBB_ASC
|
|
.byte "SC(",TK_ASC ; ASC(
|
|
LBB_ATN
|
|
.byte "TN(",TK_ATN ; ATN(
|
|
.byte $00
|
|
TAB_ASCB
|
|
LBB_BINS
|
|
.byte "IN$(",TK_BINS ; BIN$(
|
|
LBB_BITCLR
|
|
.byte "ITCLR",TK_BITCLR ; BITCLR
|
|
LBB_BITSET
|
|
.byte "ITSET",TK_BITSET ; BITSET
|
|
LBB_BITTST
|
|
.byte "ITTST(",TK_BITTST
|
|
; BITTST(
|
|
.byte $00
|
|
TAB_ASCC
|
|
LBB_CALL
|
|
.byte "ALL",TK_CALL ; CALL
|
|
LBB_CHRS
|
|
.byte "HR$(",TK_CHRS ; CHR$(
|
|
LBB_CLEAR
|
|
.byte "LEAR",TK_CLEAR ; CLEAR
|
|
LBB_CONT
|
|
.byte "ONT",TK_CONT ; CONT
|
|
LBB_COS
|
|
.byte "OS(",TK_COS ; COS(
|
|
.byte $00
|
|
TAB_ASCD
|
|
LBB_DATA
|
|
.byte "ATA",TK_DATA ; DATA
|
|
LBB_DEC
|
|
.byte "EC",TK_DEC ; DEC
|
|
LBB_DEEK
|
|
.byte "EEK(",TK_DEEK ; DEEK(
|
|
LBB_DEF
|
|
.byte "EF",TK_DEF ; DEF
|
|
LBB_DIM
|
|
.byte "IM",TK_DIM ; DIM
|
|
LBB_DOKE
|
|
.byte "OKE",TK_DOKE ; DOKE note - "DOKE" must come before "DO"
|
|
LBB_DO
|
|
.byte "O",TK_DO ; DO
|
|
.byte $00
|
|
TAB_ASCE
|
|
LBB_ELSE
|
|
.byte "LSE",TK_ELSE ; ELSE
|
|
LBB_END
|
|
.byte "ND",TK_END ; END
|
|
LBB_EOR
|
|
.byte "OR",TK_EOR ; EOR
|
|
LBB_EXP
|
|
.byte "XP(",TK_EXP ; EXP(
|
|
.byte $00
|
|
TAB_ASCF
|
|
LBB_FN
|
|
.byte "N",TK_FN ; FN
|
|
LBB_FOR
|
|
.byte "OR",TK_FOR ; FOR
|
|
LBB_FRE
|
|
.byte "RE(",TK_FRE ; FRE(
|
|
.byte $00
|
|
TAB_ASCG
|
|
LBB_GET
|
|
.byte "ET",TK_GET ; GET
|
|
LBB_GOSUB
|
|
.byte "OSUB",TK_GOSUB ; GOSUB
|
|
LBB_GOTO
|
|
.byte "OTO",TK_GOTO ; GOTO
|
|
.byte $00
|
|
TAB_ASCH
|
|
LBB_HEXS
|
|
.byte "EX$(",TK_HEXS ; HEX$(
|
|
.byte $00
|
|
TAB_ASCI
|
|
LBB_IF
|
|
.byte "F",TK_IF ; IF
|
|
LBB_INC
|
|
.byte "NC",TK_INC ; INC
|
|
LBB_INPUT
|
|
.byte "NPUT",TK_INPUT ; INPUT
|
|
LBB_INT
|
|
.byte "NT(",TK_INT ; INT(
|
|
LBB_IRQ
|
|
.byte "RQ",TK_IRQ ; IRQ
|
|
.byte $00
|
|
TAB_ASCL
|
|
LBB_LCASES
|
|
.byte "CASE$(",TK_LCASES
|
|
; LCASE$(
|
|
LBB_LEFTS
|
|
.byte "EFT$(",TK_LEFTS ; LEFT$(
|
|
LBB_LEN
|
|
.byte "EN(",TK_LEN ; LEN(
|
|
LBB_LET
|
|
.byte "ET",TK_LET ; LET
|
|
LBB_LIST
|
|
.byte "IST",TK_LIST ; LIST
|
|
LBB_LOAD
|
|
.byte "OAD",TK_LOAD ; LOAD
|
|
LBB_LOG
|
|
.byte "OG(",TK_LOG ; LOG(
|
|
LBB_LOOP
|
|
.byte "OOP",TK_LOOP ; LOOP
|
|
.byte $00
|
|
TAB_ASCM
|
|
LBB_MAX
|
|
.byte "AX(",TK_MAX ; MAX(
|
|
LBB_MIDS
|
|
.byte "ID$(",TK_MIDS ; MID$(
|
|
LBB_MIN
|
|
.byte "IN(",TK_MIN ; MIN(
|
|
.byte $00
|
|
TAB_ASCN
|
|
LBB_NEW
|
|
.byte "EW",TK_NEW ; NEW
|
|
LBB_NEXT
|
|
.byte "EXT",TK_NEXT ; NEXT
|
|
LBB_NMI
|
|
.byte "MI",TK_NMI ; NMI
|
|
LBB_NOT
|
|
.byte "OT",TK_NOT ; NOT
|
|
LBB_NULL
|
|
.byte "ULL",TK_NULL ; NULL
|
|
.byte $00
|
|
TAB_ASCO
|
|
LBB_OFF
|
|
.byte "FF",TK_OFF ; OFF
|
|
LBB_ON
|
|
.byte "N",TK_ON ; ON
|
|
LBB_OR
|
|
.byte "R",TK_OR ; OR
|
|
.byte $00
|
|
TAB_ASCP
|
|
LBB_PEEK
|
|
.byte "EEK(",TK_PEEK ; PEEK(
|
|
LBB_PI
|
|
.byte "I",TK_PI ; PI
|
|
LBB_POKE
|
|
.byte "OKE",TK_POKE ; POKE
|
|
LBB_POS
|
|
.byte "OS(",TK_POS ; POS(
|
|
LBB_PRINT
|
|
.byte "RINT",TK_PRINT ; PRINT
|
|
.byte $00
|
|
TAB_ASCR
|
|
LBB_READ
|
|
.byte "EAD",TK_READ ; READ
|
|
LBB_REM
|
|
.byte "EM",TK_REM ; REM
|
|
LBB_RESTORE
|
|
.byte "ESTORE",TK_RESTORE
|
|
; RESTORE
|
|
LBB_RETIRQ
|
|
.byte "ETIRQ",TK_RETIRQ ; RETIRQ
|
|
LBB_RETNMI
|
|
.byte "ETNMI",TK_RETNMI ; RETNMI
|
|
LBB_RETURN
|
|
.byte "ETURN",TK_RETURN ; RETURN
|
|
LBB_RIGHTS
|
|
.byte "IGHT$(",TK_RIGHTS
|
|
; RIGHT$(
|
|
LBB_RND
|
|
.byte "ND(",TK_RND ; RND(
|
|
LBB_RUN
|
|
.byte "UN",TK_RUN ; RUN
|
|
.byte $00
|
|
TAB_ASCS
|
|
LBB_SADD
|
|
.byte "ADD(",TK_SADD ; SADD(
|
|
LBB_SAVE
|
|
.byte "AVE",TK_SAVE ; SAVE
|
|
LBB_SGN
|
|
.byte "GN(",TK_SGN ; SGN(
|
|
LBB_SIN
|
|
.byte "IN(",TK_SIN ; SIN(
|
|
LBB_SPC
|
|
.byte "PC(",TK_SPC ; SPC(
|
|
LBB_SQR
|
|
.byte "QR(",TK_SQR ; SQR(
|
|
LBB_STEP
|
|
.byte "TEP",TK_STEP ; STEP
|
|
LBB_STOP
|
|
.byte "TOP",TK_STOP ; STOP
|
|
LBB_STRS
|
|
.byte "TR$(",TK_STRS ; STR$(
|
|
LBB_SWAP
|
|
.byte "WAP",TK_SWAP ; SWAP
|
|
.byte $00
|
|
TAB_ASCT
|
|
LBB_TAB
|
|
.byte "AB(",TK_TAB ; TAB(
|
|
LBB_TAN
|
|
.byte "AN(",TK_TAN ; TAN(
|
|
LBB_THEN
|
|
.byte "HEN",TK_THEN ; THEN
|
|
LBB_TO
|
|
.byte "O",TK_TO ; TO
|
|
LBB_TWOPI
|
|
.byte "WOPI",TK_TWOPI ; TWOPI
|
|
.byte $00
|
|
TAB_ASCU
|
|
LBB_UCASES
|
|
.byte "CASE$(",TK_UCASES
|
|
; UCASE$(
|
|
LBB_UNTIL
|
|
.byte "NTIL",TK_UNTIL ; UNTIL
|
|
LBB_USR
|
|
.byte "SR(",TK_USR ; USR(
|
|
.byte $00
|
|
TAB_ASCV
|
|
LBB_VAL
|
|
.byte "AL(",TK_VAL ; VAL(
|
|
LBB_VPTR
|
|
.byte "ARPTR(",TK_VPTR ; VARPTR(
|
|
.byte $00
|
|
TAB_ASCW
|
|
LBB_WAIT
|
|
.byte "AIT",TK_WAIT ; WAIT
|
|
LBB_WHILE
|
|
.byte "HILE",TK_WHILE ; WHILE
|
|
LBB_WIDTH
|
|
.byte "IDTH",TK_WIDTH ; WIDTH
|
|
.byte $00
|
|
TAB_POWR
|
|
.byte TK_POWER,$00 ; ^
|
|
|
|
; new decode table for LIST
|
|
; Table is ..
|
|
; byte - keyword length, keyword first character
|
|
; word - pointer to rest of keyword from dictionary
|
|
|
|
; note if length is 1 then the pointer is ignored
|
|
|
|
LAB_KEYT
|
|
.byte 3,'E'
|
|
.word LBB_END ; END
|
|
.byte 3,'F'
|
|
.word LBB_FOR ; FOR
|
|
.byte 4,'N'
|
|
.word LBB_NEXT ; NEXT
|
|
.byte 4,'D'
|
|
.word LBB_DATA ; DATA
|
|
.byte 5,'I'
|
|
.word LBB_INPUT ; INPUT
|
|
.byte 3,'D'
|
|
.word LBB_DIM ; DIM
|
|
.byte 4,'R'
|
|
.word LBB_READ ; READ
|
|
.byte 3,'L'
|
|
.word LBB_LET ; LET
|
|
.byte 3,'D'
|
|
.word LBB_DEC ; DEC
|
|
.byte 4,'G'
|
|
.word LBB_GOTO ; GOTO
|
|
.byte 3,'R'
|
|
.word LBB_RUN ; RUN
|
|
.byte 2,'I'
|
|
.word LBB_IF ; IF
|
|
.byte 7,'R'
|
|
.word LBB_RESTORE ; RESTORE
|
|
.byte 5,'G'
|
|
.word LBB_GOSUB ; GOSUB
|
|
.byte 6,'R'
|
|
.word LBB_RETIRQ ; RETIRQ
|
|
.byte 6,'R'
|
|
.word LBB_RETNMI ; RETNMI
|
|
.byte 6,'R'
|
|
.word LBB_RETURN ; RETURN
|
|
.byte 3,'R'
|
|
.word LBB_REM ; REM
|
|
.byte 4,'S'
|
|
.word LBB_STOP ; STOP
|
|
.byte 2,'O'
|
|
.word LBB_ON ; ON
|
|
.byte 4,'N'
|
|
.word LBB_NULL ; NULL
|
|
.byte 3,'I'
|
|
.word LBB_INC ; INC
|
|
.byte 4,'W'
|
|
.word LBB_WAIT ; WAIT
|
|
.byte 4,'L'
|
|
.word LBB_LOAD ; LOAD
|
|
.byte 4,'S'
|
|
.word LBB_SAVE ; SAVE
|
|
.byte 3,'D'
|
|
.word LBB_DEF ; DEF
|
|
.byte 4,'P'
|
|
.word LBB_POKE ; POKE
|
|
.byte 4,'D'
|
|
.word LBB_DOKE ; DOKE
|
|
.byte 4,'C'
|
|
.word LBB_CALL ; CALL
|
|
.byte 2,'D'
|
|
.word LBB_DO ; DO
|
|
.byte 4,'L'
|
|
.word LBB_LOOP ; LOOP
|
|
.byte 5,'P'
|
|
.word LBB_PRINT ; PRINT
|
|
.byte 4,'C'
|
|
.word LBB_CONT ; CONT
|
|
.byte 4,'L'
|
|
.word LBB_LIST ; LIST
|
|
.byte 5,'C'
|
|
.word LBB_CLEAR ; CLEAR
|
|
.byte 3,'N'
|
|
.word LBB_NEW ; NEW
|
|
.byte 5,'W'
|
|
.word LBB_WIDTH ; WIDTH
|
|
.byte 3,'G'
|
|
.word LBB_GET ; GET
|
|
.byte 4,'S'
|
|
.word LBB_SWAP ; SWAP
|
|
.byte 6,'B'
|
|
.word LBB_BITSET ; BITSET
|
|
.byte 6,'B'
|
|
.word LBB_BITCLR ; BITCLR
|
|
.byte 3,'I'
|
|
.word LBB_IRQ ; IRQ
|
|
.byte 3,'N'
|
|
.word LBB_NMI ; NMI
|
|
|
|
; secondary commands (can't start a statement)
|
|
|
|
.byte 4,'T'
|
|
.word LBB_TAB ; TAB
|
|
.byte 4,'E'
|
|
.word LBB_ELSE ; ELSE
|
|
.byte 2,'T'
|
|
.word LBB_TO ; TO
|
|
.byte 2,'F'
|
|
.word LBB_FN ; FN
|
|
.byte 4,'S'
|
|
.word LBB_SPC ; SPC
|
|
.byte 4,'T'
|
|
.word LBB_THEN ; THEN
|
|
.byte 3,'N'
|
|
.word LBB_NOT ; NOT
|
|
.byte 4,'S'
|
|
.word LBB_STEP ; STEP
|
|
.byte 5,'U'
|
|
.word LBB_UNTIL ; UNTIL
|
|
.byte 5,'W'
|
|
.word LBB_WHILE ; WHILE
|
|
.byte 3,'O'
|
|
.word LBB_OFF ; OFF
|
|
|
|
; opperators
|
|
|
|
.byte 1,'+'
|
|
.word $0000 ; +
|
|
.byte 1,'-'
|
|
.word $0000 ; -
|
|
.byte 1,'*'
|
|
.word $0000 ; *
|
|
.byte 1,'/'
|
|
.word $0000 ; /
|
|
.byte 1,'^'
|
|
.word $0000 ; ^
|
|
.byte 3,'A'
|
|
.word LBB_AND ; AND
|
|
.byte 3,'E'
|
|
.word LBB_EOR ; EOR
|
|
.byte 2,'O'
|
|
.word LBB_OR ; OR
|
|
.byte 2,'>'
|
|
.word LBB_RSHIFT ; >>
|
|
.byte 2,'<'
|
|
.word LBB_LSHIFT ; <<
|
|
.byte 1,'>'
|
|
.word $0000 ; >
|
|
.byte 1,'='
|
|
.word $0000 ; =
|
|
.byte 1,'<'
|
|
.word $0000 ; <
|
|
|
|
; functions
|
|
|
|
.byte 4,'S' ;
|
|
.word LBB_SGN ; SGN
|
|
.byte 4,'I' ;
|
|
.word LBB_INT ; INT
|
|
.byte 4,'A' ;
|
|
.word LBB_ABS ; ABS
|
|
.byte 4,'U' ;
|
|
.word LBB_USR ; USR
|
|
.byte 4,'F' ;
|
|
.word LBB_FRE ; FRE
|
|
.byte 4,'P' ;
|
|
.word LBB_POS ; POS
|
|
.byte 4,'S' ;
|
|
.word LBB_SQR ; SQR
|
|
.byte 4,'R' ;
|
|
.word LBB_RND ; RND
|
|
.byte 4,'L' ;
|
|
.word LBB_LOG ; LOG
|
|
.byte 4,'E' ;
|
|
.word LBB_EXP ; EXP
|
|
.byte 4,'C' ;
|
|
.word LBB_COS ; COS
|
|
.byte 4,'S' ;
|
|
.word LBB_SIN ; SIN
|
|
.byte 4,'T' ;
|
|
.word LBB_TAN ; TAN
|
|
.byte 4,'A' ;
|
|
.word LBB_ATN ; ATN
|
|
.byte 5,'P' ;
|
|
.word LBB_PEEK ; PEEK
|
|
.byte 5,'D' ;
|
|
.word LBB_DEEK ; DEEK
|
|
.byte 5,'S' ;
|
|
.word LBB_SADD ; SADD
|
|
.byte 4,'L' ;
|
|
.word LBB_LEN ; LEN
|
|
.byte 5,'S' ;
|
|
.word LBB_STRS ; STR$
|
|
.byte 4,'V' ;
|
|
.word LBB_VAL ; VAL
|
|
.byte 4,'A' ;
|
|
.word LBB_ASC ; ASC
|
|
.byte 7,'U' ;
|
|
.word LBB_UCASES ; UCASE$
|
|
.byte 7,'L' ;
|
|
.word LBB_LCASES ; LCASE$
|
|
.byte 5,'C' ;
|
|
.word LBB_CHRS ; CHR$
|
|
.byte 5,'H' ;
|
|
.word LBB_HEXS ; HEX$
|
|
.byte 5,'B' ;
|
|
.word LBB_BINS ; BIN$
|
|
.byte 7,'B' ;
|
|
.word LBB_BITTST ; BITTST
|
|
.byte 4,'M' ;
|
|
.word LBB_MAX ; MAX
|
|
.byte 4,'M' ;
|
|
.word LBB_MIN ; MIN
|
|
.byte 2,'P' ;
|
|
.word LBB_PI ; PI
|
|
.byte 5,'T' ;
|
|
.word LBB_TWOPI ; TWOPI
|
|
.byte 7,'V' ;
|
|
.word LBB_VPTR ; VARPTR
|
|
.byte 6,'L' ;
|
|
.word LBB_LEFTS ; LEFT$
|
|
.byte 7,'R' ;
|
|
.word LBB_RIGHTS ; RIGHT$
|
|
.byte 5,'M' ;
|
|
.word LBB_MIDS ; MID$
|
|
|
|
; BASIC messages, mostly error messages
|
|
|
|
LAB_BAER
|
|
.word ERR_NF ;$00 NEXT without FOR
|
|
.word ERR_SN ;$02 syntax
|
|
.word ERR_RG ;$04 RETURN without GOSUB
|
|
.word ERR_OD ;$06 out of data
|
|
.word ERR_FC ;$08 function call
|
|
.word ERR_OV ;$0A overflow
|
|
.word ERR_OM ;$0C out of memory
|
|
.word ERR_US ;$0E undefined statement
|
|
.word ERR_BS ;$10 array bounds
|
|
.word ERR_DD ;$12 double dimension array
|
|
.word ERR_D0 ;$14 divide by 0
|
|
.word ERR_ID ;$16 illegal direct
|
|
.word ERR_TM ;$18 type mismatch
|
|
.word ERR_LS ;$1A long string
|
|
.word ERR_ST ;$1C string too complex
|
|
.word ERR_CN ;$1E continue error
|
|
.word ERR_UF ;$20 undefined function
|
|
.word ERR_LD ;$22 LOOP without DO
|
|
|
|
; I may implement these two errors to force definition of variables and
|
|
; dimensioning of arrays before use.
|
|
|
|
; .word ERR_UV ;$24 undefined variable
|
|
|
|
; the above error has been tested and works (see code and comments below LAB_1D8B)
|
|
|
|
; .word ERR_UA ;$26 undimensioned array
|
|
|
|
ERR_NF .byte "NEXT without FOR",$00
|
|
ERR_SN .byte "Syntax",$00
|
|
ERR_RG .byte "RETURN without GOSUB",$00
|
|
ERR_OD .byte "Out of DATA",$00
|
|
ERR_FC .byte "Function call",$00
|
|
ERR_OV .byte "Overflow",$00
|
|
ERR_OM .byte "Out of memory",$00
|
|
ERR_US .byte "Undefined statement",$00
|
|
ERR_BS .byte "Array bounds",$00
|
|
ERR_DD .byte "Double dimension",$00
|
|
ERR_D0 .byte "Divide by zero",$00
|
|
ERR_ID .byte "Illegal direct",$00
|
|
ERR_TM .byte "Type mismatch",$00
|
|
ERR_LS .byte "String too long",$00
|
|
ERR_ST .byte "String too complex",$00
|
|
ERR_CN .byte "Can't continue",$00
|
|
ERR_UF .byte "Undefined function",$00
|
|
ERR_LD .byte "LOOP without DO",$00
|
|
|
|
;ERR_UV .byte "Undefined variable",$00
|
|
|
|
; the above error has been tested and works (see code and comments below LAB_1D8B)
|
|
|
|
;ERR_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
|
|
|
|
AA_end_basic
|