Mercurial > hg > index.cgi
view src/expr.s @ 80:bb50ac9fdf37
Checkpoint with very basic integer and floating point arithmetic, untested
This commit has implementations for floating point add, subtract, multiply,
and divide, along with 32 bit signed integer equivalents. These can probably
be optimized and they are untested.
| author | William Astle <lost@l-w.ca> |
|---|---|
| date | Sat, 07 Oct 2023 02:56:59 -0600 |
| parents | ba559f231929 |
| children | f959c92bc329 |
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 numeric constant. This process works as follows: ; ; 0. Clear the value to a zero integer ; 1. Check for signs and flag appropriately ; 2. Read character ; 3. If decimal or exponential indicator, go to step 6 ; 4. If not digit, return integer result ; 5. Multiply accumulator by 10 and add digit value; go back to step 2 ; 6. Convert accumulator to floating point; set accumulated decimal exponent and decimal flag to 0 ; 7. If decimal point, flag decimal seen (0xff) and go to step 15 (or raise error if second decimal point) ; 8. If digit, multiply by 10 and add digit value; go to step 15 ; 9. If E or e, go handle decimal exponent at step 12 ; 10. Apply accumulated decimal exponent to the result (through multiplication/division by 10) ; 11. Return floating point result ; 12. Read character ; 13. If not digit, go handle return at step 10 ; 14. Multiply exponent accumulator by 10 and add digit value; raise error on overflow or go back to step 12 ; 15. Read a character and go to step 7 ; ; If the result ends up being larger than a floating point value can hold, return Overflow eval_number if 0 ldb #valtype_int ; flag result as an integer stb val0+val.type ldx zero ; blank out the value except type stx val0 stx val0+2 stx val0+4 bra eval_number1 ; go do the parsing eval_number0 jsr nextchar ; fetch next input beq eval_number6 ; 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.fpssign ; invert sign (multiple negatives will flip this multiple times) bra eval_number0 ; deal with next input eval_number2 cmpa #'+ ; unary +? beq eval_number0 ; brif so - skip it cmpa #tok_plus ; unary + (operator plus)? beq eval_number0 ; brif so - skip it eval_number5 cmpa #'. ; decimal point? beq eval_number8 ; brif decimal - force float cmpa #'0 ; is it a number? blo eval_number6 ; brif below digit cmpa #'9 ; is it still a number? bhi eval_number6 ; 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 rol val0+val.fpsexp ; overflow into fp exponent lsl val0+val.int+3 ; times 4 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int rol val0+val.fpsexp ; 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 ldb val0+val.fpsexp ; and handle overflow bits adcb #0 stb val0+val.fpsexp lsl val0+val.int+3 ; times 10 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int rol val0+val.fpsexp 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 lda val0+val.fpsexp ; and handle overflow adca #0 sta val0+val.fpsexp bne eval_number11 ; if we overflowed, go continue parsing as floating point lda val0+val.int ; get back high byte and check for overflow bpl eval_number4 ; brif we haven't wrapped negative cmpd #0x8000 ; is it valid negative two's complement? bhi eval_number11 ; brif not - we're in floating point territory ldd val0+val.int+2 ; is it still valid two's complement (max negative)? bne eval_number11 ; brif not - we're in floating point territory eval_number4 jsr nextchar ; fetch next input character bra eval_number5 ; go handle it eval_number6 cmpa #'E ; base 10 exponent? beq eval_number8 ; brif so cmpa #'e ; base 10 exponent in lower case? beq eval_number8 ; brif so ldb val0+val.fpssign ; did we want a negative value? beq eval_number7 ; brif not jsr val_negint32 ; negate the 32 bit integer to correct two's complement eval_number7 clr val0+val.fpssign ; clear sign bits for book keeping rts eval_number11 jsr nextchar ; each the character already processed eval_number8 lda #0x9f ; exponent if binary point is to the right of the mantissa clr val0extra ; clear extra precision bits for val0 ldb #valtype_float ; flag value as floating point stb val0+val.type ldb val0+val.fpsexp ; do we have overflow bits to shift? beq eval_number10 ; brif not eval_number9 inca ; bump exponent to account for extra bits lsrb ; shift some bits over ror val0+val.fpssig ror val0+val.fpssig+1 ror val0+val.fpssig+2 ror val0+val.fpssig+3 ror val0extra tstb ; all bits shifted into mantissa? bne eval_number9 ; brif not eval_number10 sta val0+val.fpsexp ; save adjusted exponent ldx #val0 ; normalize the result for further operations jsr fp_normalize clr ,-s ; flag for decimal point seen clr ,-s ; current decimal exponent value jsr curchar ; get current input character bra eval_number20 ; go evaluate the floating point value eval_number40 jsr nextchar ; fetch next input eval_number20 bcs eval_number29 ; brif digit cmpa #'. ; is it a decimal? bne eval_number21 ; brif not com 1,s ; flag decimal seen bne eval_number40 jmp SNERROR ; brif unexpected second decimal point eval_number21 cmpa #'E ; decimal exponent? beq eval_number26 ; brif so cmpa #'e ; decimal exponent lower case? beq eval_number26 eval_number22 ldb ,s ; get decimal exponent count and set flags beq eval_number25 ; brif no adjustment needed bmi eval_number24 ; brif we need to divide eval_number23 jsr fp_mul10 ; multiply by 10 dec ,s ; done? bne eval_number23 ; brif not rts eval_number24 jsr fp_div10 ; divide by 10 inc ,s ; done? bne eval_number24 ; brif not eval_number25 rts eval_number26 clrb ; blank out decimal exponent accumulator clr ,-s ; set sign positive jsr nextchar ; get next input bcs eval_number28 ; brif digit - positive exponent cmpa #'+ ; positive? beq eval_number27 ; brif so - skip it cmpa #tok_plus ; positive (plus operator)? beq eval_number27 cmpa #'- ; negative? beq eval_number30 ; brif so cmpa #tok_minus ; negative (minus operator)? bne eval_number31 ; brif not eval_number30 com ,s ; get sign negative eval_number27 jsr nextchar ; get next character bcs eval_number28 ; brif digit eval_number31 lda ,s+ ; get negative flag, set flags, and clean up the stack beq eval_number32 ; brif positive negb ; we have a negative decimal exponent - handle it eval_number32 addb ,s ; add in decimal exponent adjustment stb ,s ; save it for cleanup bra eval_number22 ; go finish up eval_number28 suba #'0 ; digit-ize it pshs a ; save it for later lda #10 ; multiply value by 10 and add digit mul addb ,s+ bpl eval_number27 ; go handle another digit if we didn't overflow negative OVERROR ldb #err_ov ; flag overflow jmp ERROR eval_number29 ldb ,s ; get exponent adjustment addb 1,s ; subtract if decimal point was seen for later fixup stb 1,s suba #'0 ; digit-ize the character pshs a ; save it for later jsr fp_mul10 ; multiply by 10 jsr val0toval1 ; save residue puls b ; get back digit value clra ; make it floating point std val0+val.int+2 sta val0+val.int+1 sta val0+val.int jsr val_int32tofloat ; convert to floating point jsr fp_add ; add val1 to val0 bra eval_number40 ; go handle another character endc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Operator handling routines ; ; binary plus: addition and concatenation oper_plus ldb val.type,x ; get type of the left operand cmpb valtype_string ; is it string? bne oper_plus0 ; brif not cmpb val.type,u ; is right operand also string? lbeq SNERROR ; brif so - do string concatenation oper_plus0 jsr val_matchtypes ; go match data types jmp val_add ; go add the values ; binary minus: subtraction oper_minus jsr val_matchtypes ; go match data types jmp val_sub ; do subtraction *pragmapop list