changeset 84:f959c92bc329

New first pass implementation of number parsing, untested Rewrite number parsing using recently constructed infrastructure. The result is untested.
author William Astle <lost@l-w.ca>
date Sun, 08 Oct 2023 00:17:20 -0600
parents a492441bfc56
children 663d8e77b579
files src/expr.s src/number.s
diffstat 2 files changed, 194 insertions(+), 176 deletions(-) [+]
line wrap: on
line diff
--- a/src/expr.s	Sat Oct 07 15:17:44 2023 -0600
+++ b/src/expr.s	Sun Oct 08 00:17:20 2023 -0600
@@ -88,182 +88,7 @@
 ; 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
+eval_number     jmp val_parsenum                ; if we don't recognize anything else, just parse a numer
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; Operator table
 ;
--- a/src/number.s	Sat Oct 07 15:17:44 2023 -0600
+++ b/src/number.s	Sun Oct 08 00:17:20 2023 -0600
@@ -100,4 +100,197 @@
                 lbeq fps_mod                    ; floating point modulus
                 jmp TMERROR                     ; unsupported type
                 endc
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Parse a number to either an integer or a floating point value
+;
+; First, identify any sign present. Then parse the remainder as an integer until either a decimal point, an exponential
+; indicator, or the value gets larger than 32 bits. If any of those eventualities happens, convert to floating point
+; and then continue parsing the number as floating point. The result will be stored to (Y).
+val_parsenum    lbeq SNERROR                    ; brif no numberr to parse
+                ldd zero                        ; zero out integer value accumulator
+                std fpa0extra
+                std fpa0extra+2
+                std fpa0extra+4
+                std fpa0extra+6
+                sta fpa0extra12                 ; zero out result sign to default positive
+                jsr curchar                     ; get current input character
+                bra val_parsenum1               ; parse flags
+val_parsenum0   jsr nextchar                    ; get next input character
+val_parsenum1   bcs val_parsenum5               ; brif digit
+                beq val_parsenum                ; brif end of input
+                cmpa #'.                        ; decimal?
+                lbeq val_parsefloat             ; switch to parsing floating point
+                cmpa #'-                        ; minus?
+                beq val_parsenum2               ; brif so
+                cmpa #tok_minus                 ; unary minus operator?
+                bne val_parsenum3               ; brif not
+val_parsenum2   com fpa0extra12                 ; invert current sign
+                bra val_parsenum0               ; go handle more stuff at the start of the number
+val_parsenum3   cmpa #'+                        ; unary +?
+                beq val_parsenum0               ; brif so - skip it
+                cmpa #tok_plus                  ; unary + operator?
+                beq val_parsenum0               ; brif so - skip it
+val_parsenum4   lda fpa0extra4                  ; is bit 7 of high byte set?
+                bpl val_parsenum4a              ; brif not - no overflow
+                ldb fpa0extra12                 ; do we want negative?
+                lbpl val_parsefloat             ; brif not - we overflowed so convert to floating point
+                anda #0x7f                      ; lose sign bit then see if any other bits are set
+                ora fpa0extra5
+                ora fpa0extra6
+                ora fpa0extra7
+                lbne val_parsefloat             ; brif nonzero bits - too big for max negative 2's complement
+val_parsenum4a  lda fpa0extra12                 ; do we want negative?
+                bpl val_parsenum4b              ; brif not
+                ldd zero                        ; negate it
+                subd fpa0extra6
+                std fpa0extra6
+                ldd zero
+                sbcb fpa0extra5
+                sbca fpa0extra4
+                std fpa0extra4
+val_parsenum4b  ldd fpa0extra6                  ; copy value to result location
+                std val.int+2,y
+                ldd fpa0extra4
+                std val.int,y
+                lda #valtype_int                ; set value type to integer
+                sta val.type,y
+                rts
+val_parsenum4c  jsr nextchar                    ; fetch next character (after a digit)
+                bcs val_parsenum5               ; it's a digit
+                cmpa #'.                        ; decimal?
+                beq val_parsefloat              ; brif so - handle floating point
+                cmpa #'E                        ; exponent?
+                beq val_parsefloat              ; brif so - handle floating point
+                cmpa #'e                        ; exponent but lower case?
+                beq val_parsefloat              ; brif so - handle floating point
+                bra val_parsenum4               ; unrecognized character - treat as end of number
+val_parsenum5   suba #'0                        ; offset digit to binary
+                pshs a                          ; save it for later addition
+                ldx fpa0extra4                  ; save original value
+                stx fpa0extra8
+                ldx fpa0extra6
+                stx fpa0extra10
+                lsl fpa0extra7                  ; shift partial result left (times 2)
+                rol fpa0extra6
+                rol fpa0extra5
+                rol fpa0extra4
+                rol fpa0extra3
+                lsl fpa0extra7                  ; shift partial result left (times 4)
+                rol fpa0extra6
+                rol fpa0extra5
+                rol fpa0extra4
+                rol fpa0extra3
+                ldd fpa0extra6                  ; add in original value (time 5)
+                addd fpa0extra10
+                std fpa0extra6
+                ldd fpa0extra8
+                adcb fpa0extra5
+                adca fpa0extra4
+                std fpa0extra4
+                ldb fpa0extra3
+                adcb #0
+                stb fpa0extra3
+                lsl fpa0extra7                  ; shift partial result left (times 10)
+                rol fpa0extra6
+                rol fpa0extra5
+                rol fpa0extra4
+                rol fpa0extra3
+                ldd fpa0extra6                  ; add in new digit
+                addb ,s+
+                adca #0
+                std fpa0extra6
+                ldd fpa0extra4                  ; and propagate carry
+                adcb #0
+                adca #0
+                std fpa0extra4
+                ldb fpa0extra3
+                adcb #0
+                stb fpa0extra3
+                beq val_parsenum4c              ; go handle next digit if we didn't overflow past 32 bits
+                jsr nextchar                    ; eat the digit we just handled
+val_parsefloat  pshs y                          ; save destination pointer
+                lda #valtype_float              ; set return type to floating point
+                sta val.type,y
+                ldx #fpa0extra                  ; point to integer accumulator
+                jsr fps_fromuint64              ; convert to floating point
+                clr fpa0extra11                 ; zero out decimal counter
+                clr fpa0extra10                 ; zero out decimal exponent counter
+                clr fpa0extra9                  ; flag for decimal seen
+                jsr curchar                     ; fetch current character
+                bra val_parsefloat1             ; go handle character
+val_parsefloat0 jsr nextchar                    ; fetch next character
+val_parsefloat1 bcc val_parsefloat2             ; brif not digit
+                suba #'0                        ; adjust digit to binary
+                sta fpa0extra3                  ; save it for later (upper 3 bytes of 32 bit value already 0)
+                ldx ,s                          ; get destination value
+                jsr fps_mul10                   ; do a quick multiply by 10
+                ldx #fpa0extra                  ; convert digit to floating point
+                ldy #fpa1
+                jsr fps_fromuint32
+                ldu #fpa1                       ; add digit to accumulated value
+                ldx ,s
+                leay ,x
+                jsr fps_add
+                lda fpa0extra11                 ; update decimal counter
+                suba fpa0extra9
+                sta fpa0extra11
+                bra val_parsefloat0             ; go handle another digit
+val_parsefloat2 cmpa #'.                        ; decimal?
+                bne val_parsefloat7             ; brif not
+                com fpa0extra9                  ; flag for decimal
+                bne val_parsefloat0             ; brif not two decimals - keep parsing
+val_parsefloat3 ldb fpa0extra10                 ; fetch decimal exponent counter
+                subb fpa0extra11                ; subtract out decimal places provided
+                beq val_parsefloat6             ; brif no adjustment needed
+                stb fpa0extra9                  ; save counter
+                bmi val_parsefloat5             ; brif negative exponent - need to do divisions
+val_parsefloat4 ldx ,s                          ; point to destination value
+                jsr fps_mul10                   ; multiply by 10
+                dec fpa0extra9                  ; done all of them?
+                bne val_parsefloat4             ; brif not
+                bra val_parsefloat6
+val_parsefloat5 ldx ,s                          ; point to destination value
+                jsr fps_div10                   ; divide by 10
+                inc fpa0extra9                  ; done all of them?
+                bne val_parsefloat5             ; brif not
+val_parsefloat6 puls y                          ; get back destination pointer
+                lda fpa0extra12                 ; get desired sign
+                sta val.fpssign,y               ; set in result
+                rts
+val_parsefloat7 cmpa #'E                        ; decimal exponent?
+                beq val_parsefloat8             ; brif so
+                cmpa #'e                        ; decimal exponent, lower case edition?
+                bne val_parsefloat3             ; brif not - must be end of number
+val_parsefloat8 clr fpa0extra9                  ; set sign of exponent to positive
+                jsr nextchar                    ; fetch exponent character
+                bcs val_parsefloat11            ; brif digit
+                cmpa #'+                        ; positive exponent?
+                beq val_parsefloat10            ; brif so - skip it
+                cmpa #tok_plus                  ; positive exponent, operator style?
+                beq val_parsefloat10            ; brif so - skip it
+                cmpa #'-                        ; negative exponent?
+                beq val_parsefloat9             ; brif so
+                cmpa #tok_minus                 ; negative exponent, operator style?
+                bne val_parsefloat3             ; brif not - must be end of exponent
+val_parsefloat9 com fpa0extra9                  ; set exponent to negative
+val_parsefloat10
+                jsr nextchar                    ; eat exponent sign
+                bcc val_parsefloat12            ; brif end of exponent - apply sign
+val_parsefloat11
+                suba #'0                        ; binary-ize digit
+                sta fpa0extra8                  ; save digit for later
+                lda #10                         ; mutiply current decimal exponent by 10
+                ldb fpa0extra10                 ; get current exponent
+                mul
+                adca #0                         ; set A if we overflowed *or* bit 7 of B is set
+                lbne OVERROR                    ; brif exponent overflow
+                addb fpa0extra8                 ; add in digit
+                lbvs OVERROR                    ; brif exponent overflow
+                stb fpa0extra10                 ; save new exponent
+                bra val_parsefloat10            ; go handle next exponent digit
+val_parsefloat12
+                ldb fpa0extra9                  ; do we have a negative exponent?
+                beq val_parsefloat3             ; brif not, go adjust value by exponent and return
+                neg fpa0extra10                 ; set base 10 exponent negative
+                bra val_parsefloat3             ; go adjust value by exponent and return
                 *pragmapop list