Mercurial > hg > index.cgi
view src/expr.s @ 75:5f8f0b0781e8
Split some code into separate files for easier management (3)
Because the source for lwbasic is so large, split it into several
different files to make it easier to navigate and modify. This is
part three of the split. Includes a file missing from part one.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sun, 06 Aug 2023 00:41:26 -0600 |
| parents | |
| children | eb2681108660 |
line wrap: on
line source
*pragmapush list *pragma list ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; The LET command which is the default if no token begins a statement cmd_let jmp SNERROR ; not yet implemented ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Expression Evaluation Package ; ; This is the expression evaluator. It handles everything from parsing numbers to dispatching function calls. The main ; entry point is eval_expr which will evaluate an arbitrary expression. It returns as soon as it reaches something it ; doesn't understand as part of an expression. ; ; The special handling for relational operators is required because Basic allows them in all eval_expr clrb ; flag previous operator as minimum precdence (end of expression) eval_expraux jsr eval_term ; evaluate the first term of the expression eval_expr0 jsr curchar ; fetch current input beq eval_expr1 ; brif end of expression - we're done cmpa #tok_or ; is it above operators? bhi eval_expr1 ; brif so suba #tok_plus ; offset to zero for first operator token bcc eval_expr2 ; brif it is an operator eval_expr1 rts eval_expr2 pshs b ; save previous operator precedence ldx #oper_tab ; point to operator table tfr a,b ; shift to B for "ABX" abx ; add three times (3 bytes per entry) abx ; OBS: TFR + ABX + ABX + ABX is faster than LDB + MUL + ABX abx ; now X points to the operator entry in the table ldb ,x ; get precedence of current operation cmpb ,s ; is it higher than the current operation? bhi eval_expr3 ; brif so - process this operator puls b,pc ; return current value to complete previous operation eval_expr3 jsr nextchar ; eat the operator token ldx 1,x ; get handler address of this operator leas -val.size,s ; make room for the result accumulator pshs x ; save handler address for later lda val0+val.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 val1 ; save it to the second value accumulator sty val1+2 stu val1+4 sta val1+val.type ; save previous value type ldx #val1 ; point to left operand ldu #val0 ; point to right operand leay 2,s ; point to return value location jsr [,s++] ; go handle the operator puls a,x,y,u ; get return value sta val0 stx val0+1 sty val0+3 stu val0+5 puls b ; get back the previous operator precedence bra eval_expr0 ; go process another operator or end of expression 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+val.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 (ascii sign)? beq eval_number3 ; brif so cmpa #tok_minus ; negative (operator negative)? bne eval_number2 ; brif not eval_number3 com val0+val.fpsign ; invert sign bra eval_number0 ; deal with next input eval_number2 cmpa #'+ ; unary +? beq eval_number0 ; brif so - skip it eval_number5 cmpa #'. ; decimal point? 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+val.int ; get current value for later (for quick multiply by 10) ldd val0+val.int+2 pshs d,x ; stored with words swapped on stack for efficiency for later lsl val0+val.int+3 ; times 2 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int bcs OVERROR ; brif overflowed lsl val0+val.int+3 ; times 4 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int bcs OVERROR ; brif overflowed ldd val0+val.int+2 ; times 5 (add original value) addd ,s++ std val0+val.int+2 ldd val0+val.int adcb 1,s adca ,s++ std val0+val.int bcs OVERROR lsl val0+val.int+3 ; times 10 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int bcs OVERROR ; brif overflowed ldd val0+val.int+2 ; get low word addb ,s+ ; add in current digit adca #0 std val0+val.int+2 ldd val0+val.int adcb #0 adca #0 std val0+val.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+val.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+val.fpsign ; is the number we want negative? beq eval_numberr0 ; brif not jsr val_negint32 ; negate the integer 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 val1 and its right operand in val0 and should return its result in val0. oper_tab fcb 0x79 ; addition fdb oper_plus fcb 0x79 ; subtraction fdb oper_minus fcb 0x7b ; multiplication fdb SNERROR fcb 0x7b ; division fdb SNERROR fcb 0x7f ; exponentiation fdb SNERROR fcb 0x64 ; less than fdb SNERROR fcb 0x64 ; equal to fdb SNERROR fcb 0x64 ; greater than fdb SNERROR fcb 0x64 ; less than or equal to fdb SNERROR fcb 0x64 ; greater than or equal to fdb SNERROR fcb 0x64 ; not equal to fdb SNERROR fcb 0x50 ; boolean AND fdb SNERROR fcb 0x46 ; boolean OR fdb SNERROR *pragmapop list