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