Mercurial > hg > index.cgi
view src/expr.s @ 77:ba559f231929
Initial modification for number parser that handles floats and ints
author | William Astle <lost@l-w.ca> |
---|---|
date | Thu, 10 Aug 2023 00:24:52 -0600 |
parents | eb2681108660 |
children | bb50ac9fdf37 |
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 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.fpsign ; 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.fpexp ; 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.fpexp ; 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.fpexp ; and handle overflow bits adcb #0 stb val0+val.fpexp lsl val0+val.int+3 ; times 10 rol val0+val.int+2 rol val0+val.int+1 rol val0+val.int rol val0+val.fpexp 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.fpexp ; and handle overflow adca #0 sta val0+val.fpexp 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.fpsign ; 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.fpsign ; 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.fpexp ; 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.fpmant ror val0+val.fpmant+1 ror val0+val.fpmant+2 ror val0+val.fpmant+3 ror val0extra tstb ; all bits shifted into mantissa? bne eval_number9 ; brif not eval_number10 sta val0+val.fpexp ; 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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