Mercurial > hg > index.cgi
changeset 64:2205c3c59a33
Checkpoint
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sat, 22 Apr 2023 08:47:54 -0600 |
| parents | a3122251b5fe |
| children | bb9fe2bd4894 |
| files | src/lwbasic.s |
| diffstat | 1 files changed, 199 insertions(+), 15 deletions(-) [+] |
line wrap: on
line diff
--- a/src/lwbasic.s Thu Feb 23 21:56:49 2023 -0700 +++ b/src/lwbasic.s Sat Apr 22 08:47:54 2023 -0600 @@ -41,6 +41,9 @@ keyb_shift equ 0x01 ; shift pressed linebuffsize equ 0x100 ; the line input buffer (256 bytes) stringstacknum equ 20 ; number of entries on the anonymous string descriptor stack +valtype_none equ 0 ; unknown value type +valtype_int equ 1 ; integer (32 bit) value (signed) +valtype_float equ 2 ; float type (40 bit) value ifdef COCO3 ; GIME INIT0 GIME_COCO equ 0x80 ; Set for coco2 compatible mode (video display) @@ -230,10 +233,18 @@ tok_kwnum rmb 1 ; the actual token number tok_kwmatchl rmb 1 ; the length of the best match during lookup tok_kwmatch rmb 2 ; the current best matched token number -valtype0 rmb 1 ; type of value in valaccum0 -valaccum0 rmb 6 ; bucket of bytes for valaccum0 -valtype1 rmb 1 ; type of value in valaccum1 -valaccum1 rmb 6 ; bucket of bytes for valaccum1 +val0.type rmb 1 ; type of value in val0 +val0 rmb 0 ; bucket of bytes for val0 +val0.int rmb 0 ; 32 bit signed integer value (val0) +val0.exp rmb 1 ; floating point exponent (val0) +val0.mant rmb 4 ; floating point mantissa (val0) +val0.sign rmb 1 ; floating point sign (val0) +val1.type rmb 1 ; type of value in val1 +val1 rmb 0 ; bucket of bytes for val1 +val1.int rmb 0 ; 32 bit signed integer value (val1) +val1.exp rmb 1 ; floating point exponent (val1) +val1.mant rmb 4 ; floating point mantissa (val1) +val1.sign rmb 1 ; floating point sign (val1) rmb 0x71-* ; align RSTFLG/RSTVEC for stock ROM compatibility RSTFLG rmb 1 ; 0x55 if RSTVEC is valid RSTVEC rmb 2 ; points to warm start routine (must start with NOP) @@ -1529,7 +1540,91 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; PRINT command -cmd_print rts +cmd_print beq cmd_printeol ; brif no argument - do a newline +cmd_print0 cmpa #'; ; semicolon? + bne cmd_print1 ; brif not + jsr nextchar ; skip the semicolon + bne cmd_print0 ; brif not end of the statement + rts +cmd_print1 jsr eval_expr ; evaluate the expression + ldb val0.type ; get value type + cmpb #valtype_int ; integer? + beq cmd_printint ; brif so - print integer + lda #'! ; flag unknown expression type + jsr console_outchr + jsr console_outchr + jsr console_outchr +cmd_printnext jsr curchar ; see what we have here + bra cmd_print ; and go process +cmd_printeol jmp console_outnl ; do a newline and return +cmd_printint leas -12,s ; make a buffer + leay ,s ; point to buffer + lda #0x20 ; default sign (positive) + ldb val0.int ; is it negative? + bpl cmd_printint0 ; brif not + lda #'- ; negative sign +cmd_printint0 sta ,y+ ; save sign + ldu #cmd_printintpc ; point to positive constant table + ldx #10 ; there are 10 constants to process + tsta ; negative value? + bmi cmd_printint3 ; brif so - start with addition loop +; subtraction loop - positive residue +cmd_printint1 lda #'0-1 ; initialize digit + sta ,y +cmd_printint2 inc ,y ; bump digit + ldd val0.int+2 ; subtract constant + subd 2,u + std val0.int+2 + ldd val0.int + sbcb 1,u + sbca ,u + std val0.int + bcc cmd_printint2 ; brif we didn't go negative + leay 1,y ; move to next digit in buffer + leau 4,u ; move to next constant + leax -1,x ; done all constants? + beq cmd_printint5 ; brif so - handle cleanup +; addition loop - negative residue +cmd_printint3 lda #'0-1 ; initialize digit + sta ,y +cmd_printint4 inc ,y ; bump digit + ldd val0.int+2 ; add the constant to the residue + addd 2,u + std val0.int+2 + ldd val0.int + adcb 1,u + adca ,u + std val0.int + bcc cmd_printint3 ; brif we didn't go positive (subtraction loop) + leay 1,y ; move to next digit + leau 4,u ; move to next constant + leax -1,x ; done all digits? + bne cmd_printint1 ; brif not - go do a subtraction loop +cmd_printint5 clr ,y ; NUL terminate the string + leax 1,s ; point past the sign +cmd_printint6 lda ,x+ ; get digit + beq cmd_printint8 ; brif end of number + cmpa #'0 ; is it a zero? + beq cmd_printint6 ; brif so - skip it +cmd_printint7 lda ,s ; get the sign + sta ,-x ; put it at the start of the number + jsr console_outstr ; display the number + leas 12,s ; clean up stack + bra cmd_printnext ; go print the next thing +cmd_printint8 leax -1,x ; restore one of the zeros + bra cmd_printint7 ; go finish up +cmd_printintpc fqb 1000000000 ; 10^9 + fqb 100000000 ; 10^8 + fqb 10000000 ; 10^7 + fqb 1000000 ; 10^6 + fqb 100000 ; 10^5 + fqb 10000 ; 10^4 + fqb 1000 ; 10^3 + fqb 100 ; 10^2 + fqb 10 ; 10^1 + fqb 1 ; 10^0 + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Error messages ; @@ -1558,6 +1653,8 @@ fcn 'Undefined line number' deferr rg fcn 'RETURN without GOSUB' + deferr ov + fcn 'Overflow' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The LET command which is the default if no token begins a statement cmd_let jmp SNERROR ; not yet implemented @@ -1591,26 +1688,113 @@ eval_expr3 jsr nextchar ; eat the operator token ldx 1,x ; get handler address of this operator pshs x ; save handler address for later - lda valtype0 ; get current value type - ldx valaccum0 ; get value accumlator contents (6 bytes) - ldy valaccum0+2 - ldu valaccum0+4 + lda val0.type ; get current value type + ldx val0 ; get value accumlator contents (6 bytes) + ldy val0+2 + ldu val0+4 pshs a,x,y,u ; save it on the stack jsr eval_expraux ; evaluate the following term and higher precedence expressions puls a,x,y,u ; get back saved value - stx valaccum1 ; save it to the second value accumulator - sty valaccum1+2 - stu valaccum1+4 - sta valtype1 ; save previous value type + stx val1 ; save it to the second value accumulator + sty val1+2 + stu val1+4 + sta val1.type ; save previous value type jsr [,s++] ; go handle the operator puls b ; get back the previous operator precedence bra eval_expr0 ; go process another operator or end of expression -eval_term jmp SNERROR +eval_term jsr curchar ; get current input character + beq eval_term0 ; brif end of input - this is an error + bcs eval_number ; brif digit - we have a number +; bmi eval_func ; brif we have a token - handle function call + cmpa #'. ; decimal point? + beq eval_number ; brif so - evaluate number + cmpa #'- ; negative sign? + beq eval_number ; brif so - evaluate number + cmpa #'+ ; positive sign? + beq eval_number ; brif so - evaluate number +eval_term0 jmp SNERROR ; we have something unrecognized - raise error +; Evaluate a number constant. Currently this only handles 32 bit integers. +eval_number ldb #valtype_int ; start with integer value + stb val0.type ; set return value + ldx zero ; blank out the value + stx val0 + stx val0+2 + stx val0+4 + bra eval_number1 ; go do the parsing +eval_number0 jsr nextchar ; fetch next input + beq eval_numberr ; brif end of expression - bail +eval_number1 cmpa #'- ; negative? + bne eval_number2 ; brif not + com val0.sign ; invert sign + bra eval_number0 ; deal with next input +eval_number2 cmpa #'+ ; unary +? + beq eval_number0 ; brif so - skip it +eval_number5 beq eval_float ; brif decimal - force float + cmpa #'0 ; is it a number? + blo eval_numberr ; brif below digit + cmpa #'9 ; is it still a number? + bhi eval_numberr ; brif above digit + suba #'0 ; offset to binary digit value + pshs a ; save digit value + ldx val0.int ; get current value for later (for quick multiply by 10) + ldd val0.int+2 + pshs d,x ; stored with words swapped on stack for efficiency for later + lsl val0.int+3 ; times 2 + rol val0.int+2 + rol val0.int+1 + rol val0.int + bcs OVERROR ; brif overflowed + lsl val0.int+3 ; times 4 + rol val0.int+2 + rol val0.int+1 + rol val0.int + bcs OVERROR ; brif overflowed + ldd val0.int+2 ; times 5 (add original value) + addd ,s++ + std val0.int+2 + ldd val0.int + adcb 1,s + adca ,s++ + std val0.int + bcs OVERROR + lsl val0.int+3 ; times 10 + rol val0.int+2 + rol val0.int+1 + rol val0.int + bcs OVERROR ; brif overflowed + ldd val0.int+2 ; get low word + addb ,s+ ; add in current digit + adca #0 + std val0.int+2 + ldd val0.int + adcb #0 + adca #0 + std val0.int + bcs OVERROR ; brif overflowed + bpl eval_number4 ; brif we haven't wrapped negative + cmpd #0x8000 ; is it valid negative two's complement? + bhi OVERROR ; brif not + ldd val0.int+2 ; is it still valid two's complement (max negative)? + bne OVERROR ; brif so +eval_number4 jsr nextchar ; fetch next input character + bra eval_number5 ; go handle it +OVERROR ldb #err_ov ; flag overflow + jmp ERROR +eval_numberr ldb val0.sign ; is the number we want negative? + beq eval_numberr0 ; brif not + ldd zero ; negate the value + subd val0.int+2 + std val0.int+2 + ldd zero + subd val0.int + std val0.int +eval_numberr0 rts +eval_float jmp SNERROR ; we don't handle floating point yet ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Operator table ; ; Each entry starts with the precedence value followed by the handler routine. Each handler will receive its left -; operand in valaccum1 and its right operand in valaccum0 and should return its result in valaccum0. +; operand in val1 and its right operand in val0 and should return its result in val0. oper_tab fcb 0x79 ; addition fdb SNERROR fcb 0x79 ; subtraction