Mercurial > hg > index.cgi
diff 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 diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/expr.s Sun Aug 06 00:41:26 2023 -0600 @@ -0,0 +1,176 @@ + *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