*pragmapush list
                *pragma list
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Arithmetic package
;
; This section contains routines that handle floating point and integer arithmetic. It mostly delegates to int.s and
; fps.s.
;
; Most routines take a pointer to a value accumulator in X. Some take two pointers with the second in U.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Match operands for a numeric calculation. This works as follows:
;
; * If both operands are the same, ensure the type is numeric and return
; * If one operand is floating point, convert the other to floating point, as long as it is numeric
; * If one or both operands are not numeric, raise a type mismatch
; The operands are in (X) and (U)
val_matchtypes  ldb val.type,x                  ; get the type of first argument
                cmpb #valtype_int               ; is it integer?
                beq val_matchtypes0             ; brif so
                cmpb #valtype_float             ; is it floating point?
                beq val_matchtypes1             ; brif so
TMERROR         ldb #err_tm                     ; raise a type mismatch
                jmp ERROR
val_matchtypes0 ldb val.type,u                  ; get type of second operand
                cmpb #valtype_int               ; is it integer?
                bne val_matchtypes2             ; brif not
val_matchtypes3 rts                             ; both types int - we're good so return
val_matchtypes2 cmpb #valtype_float             ; is it floating point?
                bne TMERROR                     ; brif not - raise error
                pshs x                          ; save X which may be clobbered
                leay ,x                         ; point to input operand as destination for conversion
;                jsr fps_fromint32               ; convert first argument to floating point
                puls x,pc                       ; restore second operand pointer and return
val_matchtypes1 ldb val.type,u                  ; get second argument type
                cmpb #valtype_float             ; is it floating point?
                beq val_matchtypes3             ; brif so - we're good
                cmpb #valtype_int               ; is it integer?
                bne TMERROR                     ; brif not - invalid type combination
                pshs x                          ; save X which mill be clobbered
                leax ,u                         ; convert (U) to floating point
                leay ,u
;                jsr fps_fromint32
                puls x,pc                       ; restore argument pointer and return
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Addition and subtraction of values; must enter with values of matching types and the result type already set
; to the correct type.
;
; Calculates (X) + (U) -> (Y) (addition)
; Calculates (X) - (U) -> (Y) (subtraction)
val_add         ldb val.type,x                  ; get type of left operand
                cmpb valtype_int                ; is it integer?
                lbeq int32_add                  ; brif so - do integer addition
                cmpb #valtype_float             ; floating point?
                lbeq fps_add                    ; brif so - do floating point addition
                jmp TMERROR                     ; we have a type we don't understand
val_sub         ldb val.type,x                  ; get type of left operand
                cmpb valtype_int                ; is it integer?
                lbeq int32_sub                  ; brif so - do integer addition
                cmpb #valtype_float             ; floating point?
                lbeq fps_sub                    ; brif so - do floating point addition
                jmp TMERROR                     ; we have a type we don't understand
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Multiplication
;
; Calculates (X) × (U) -> (Y)
;
; The result might overflow the integer type. In this case, an actual overflow error will occur.
val_mul         ldb val.type,x                  ; get type of left operand
                cmpb #valtype_int               ; integer?
                lbeq int32_mul                  ; brif so - do integer multiplication
                cmpb #valtype_float             ; is it float?
                lbeq fps_mul                    ; brif so - do floating point multiplication
                jmp TMERROR                     ; have an unhandled type - bail on it
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Division
;
; Calculates (X) ÷ (U) -> (Y)
;
; The integer operation simply truncates the result ("rounds toward zero")
val_div         ldb val.type,x                  ; get type of left operand
                cmpb #valtype_int               ; integer?
                lbeq int32_div                  ; brif so - do integerdivision
                cmpb #valtype_float             ; floating point?
                lbeq fps_div                    ; brif so - do floating point division
                jmp TMERROR                     ; unsupported type
                if 0
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Modulus - note that this is a division operator returning effectively the remainder, not an absolute value as is
; sometimes meant by "modulus".
;
; Calculates (X) <MOD> (U) -> (Y)
;
; Note: modulus will have the same sign as the quotient so that (U) * [(X) / (U)] + [(X) MOD (U)] gives (X) (integer)
; Note2: the modulus can be calculated on floating point values in which case it will represent the fraction part
;    of the quotient multiplied by the divisor, again with the same sign as the quotient
val_mod         ldb val.type,x                  ; get type of left operand
                cmpb #valtype_int               ; integer?
                lbeq int32_mod                  ; do integer modulus
                cmpb #valtype_float             ; floating point?
                lbeq fps_mod                    ; floating point modulus
                jmp TMERROR                     ; unsupported type
                endc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Parse a number to either an integer or a floating point value and return the result in val0
;
; This works by first detecting any sign indicators and handling those. Multiple prefix signs are supported. Note that
; in the regular expression evaluation sequence, unary minus and plus will be handled by the expression evaluator so
; in that case, the number evaluator would not need to care about those. However, in the case of an arbitrary string
; fed into the evaluator, those must be handled. Note that there is no need to handle tokenized sign indicators because
; the only place where they would be tokenized is in a proper expression.
;
; Once leading signs are handled, any base specifiers or other modifiers are handled. If none of those intercept the
; parsing, the regular number parsing continues as follows.
;
; 1. Read a sequence of digits. The digits are stored in backed BCD form in the significand of fpa0. An arbitrary number
;    of leading zeroes will be skipped. A count of significant digits is maintained while reading digits as is the
;    position of a decimal point if one is encountered. Once one digit more than the maximum possible precision of any
;    supported number type is read, subsequent digits will not be stored, but the counters will still be updated.
; 2. Any subsequent "E" or "e" followed by either a positive or negative decimal exponent is read, with the sign
;    indicator being optional.
; 3. The decimal offset calculated in (1) is adjusted by the exponent read in (2) if any.
; 4. Range checks are completed as follows:
; 4a. If the calculated decimal exponent is beyond the supported range of any floating point or integer type, raise
;    an overflow error.
; 4b. If the number is an integer in the range of -0x80000000 to 0x7fffffff, it is converted to a signed binary integer
;    and the result is returned
; 4b. Set the exponent correctly then normalize the result to val0
val_parsenum    ldd zero                        ; zero out digit accumulator
                std fpa0+fpa.sig
                std fpa0+fpa.sig+2
                std fpa0+fpa.sig+4
                std fpa0+fpa.sig+6
                std fpa0+fpa.sig+8
                sta fpa0+fpa.sign               ; set number sign to positive
                std fpaextra+4                  ; clear out decimal exponent and sign
                std fpaextra                    ; set digit count and decimal flag to zero and no decimal
                sta fpaextra+2                  ; set decimal position to 0 - unused if decimal not seen
                sta fpaextra+6                  ; set number of leading zeroes seen
                ldx #fpa0+fpa.sig               ; point to digit storage location
                lda #0xf0                       ; set digit mask
                sta fpaextra+3
                jsr curchar                     ; get back current input
                bne val_parsenum1               ; brif we have input
                jmp SNERROR                     ; raise syntax error
val_parsenum0   jsr nextchar                    ; fetch next input
val_parsenum1   bcs val_parsenum3               ; brif digit - short ciruit other checks
                cmpa #'.                        ; does it start with a decimal?
                beq val_parsenum5a              ; brif so
                cmpa #'+                        ; unary plus?
                beq val_parsenum0               ; brif so - it's a no-op but supported for symmetry with unary minus
                cmpa #'-                        ; negative?
                bne val_parsenum5               ; brif not
                com fpa0+fpa.sign               ; invert the sign
                bra val_parsenum0               ; eat the sign and see if there's more signs
val_parsenum1a  inc fpaextra+6                  ; bump zero counter
val_parsenum2   jsr nextchar                    ; fetch next character in number
                bcc val_parsenum5               ; brif not a digit
val_parsenum3   ldb fpaextra                    ; is it within the digit count?
                cmpb #11                        ; (11 digits holds both 10 digit fp and 32 bit integer)
                bhs val_parsenum4               ; brif so - don't convert it
                suba #0x30                      ; binary-ize the digit
                bne val_parsenum3a              ; brif not zero
                tstb                            ; no digits?
                bne val_parsenum3a              ; brif not - we've seen something significant
                ldb fpaextra+1                  ; decimal seen?
                bne val_parsenum1a              ; brif so - count the leading zeros
                bra val_parsenum2               ; otherwise don't count it and skip it
val_parsenum3a  ldb #0x11                       ; put in both digit spots
                mul
                andb fpaextra+3                 ; only keep the one we need
                orb ,x                          ; merge with existing digit
                stb ,x                          ; put in digit location
                com fpaextra+3                  ; flip digit position mask
                bpl val_parsenum4               ; brif not moving to new location
                leax 1,x                        ; move to new digit storage location
val_parsenum4   inc fpaextra                    ; bump digit count
                bmi val_overror                 ; brif it overflowed - we can't parse more than 127 digits!
                bra val_parsenum2               ; go handle another digit or whatever
val_parsenum5   cmpa #'.                        ; decimal?
                bne val_parsenum6               ; brif not
val_parsenum5a  ldb fpaextra                    ;* set decimal offset (digits to the left of decimal), account for
                stb fpaextra+2
                com fpaextra+1                  ; flag decimal seen
                lbeq SNERROR                    ; brif already seen a decimal point - syntax error
                bra val_parsenum2               ; process more digits
val_parsenum6   ldb fpaextra                    ; get number of digits provided; will be exponent if no decimal
                tst fpaextra+1                  ; decimal seen?
                beq val_parsenum6a              ; brif not
                ldb fpaextra+2                  ; get decimal offset - this is the exponent
val_parsenum6a  decb                            ; adjust for the decimal position in the significand
                subb fpaextra+6                 ; account for leading zeroes after the decimal point
                bvs val_overror                 ; brif it overflowed
                stb fpa0+fpa.exp                ; save base exponent of number
                cmpa #'E                        ; decimal exponent?
                beq val_parsenum7               ; brif so
                cmpa #'e                        ; lower case exponent indicator?
                bne val_parsenum11b             ; brif not - we have the end of the number here
val_parsenum7   jsr nextchar                    ; eat exponent indicator
                bcs val_parsenum9               ; brif digit
                cmpa #'+                        ; positive?
                beq val_parsenum8               ; brif no
                cmpa #tok_plus                  ; tokenized plus?
                beq val_parsenum8               ; brif so
                cmpa #'-                        ; negative?
                beq val_parsenum7a              ; brif so
                cmpa #tok_minus                 ; tokenized minus?
                lbne SNERROR                    ; brif not positive, negative, or digit
val_parsenum7a  com fpaextra+5                  ; make sign of exponent negative
val_parsenum8   jsr nextchar                    ; eat exponent sign/get next digit
                bcc val_parsenum10              ; brif not a digit - done with number
val_parsenum9   suba #0x30                      ; binary-ize the digit
                sta fpaextra+6                  ; save digit value
                ldb fpaextra+4                  ; get calculated exponent
                lda #10                         ; multiply by 10, MUL sets C equal to bit 7 of B
                mul
                bcc val_parsenum9a              ; don't brif ±127 - we just don't handle that
val_overror     jmp OVERROR                     ; raise overflow
val_parsenum9a  addb fpaextra+6                 ; add digit in
                bvs val_overror                 ; brif we went above 63
                stb fpaextra+4                  ; save new decimal exponent
                bra val_parsenum8               ; handle another digit
val_parsenum10  lda fpaextra+5                  ; get sign of exponent
                bpl val_parsenum11              ; brif positive
                neg fpaextra+4                  ; negate resulting exponent
val_parsenum11  ldb fpa0+fpa.exp                ; get significand exponent
                addb fpaextra+4                 ; add in decimal exponent adjustment
                bvs val_overror                 ; brif it overflowed
                stb fpa0+fpa.exp
val_parsenum11b cmpb #63                        ; too high?
                bgt val_overror                 ; brif too high
                cmpb #-64                       ; too low?
                bge val_parsenum11a             ; brif so - minimize to "0"
                ldb #valtype_int                ; set result to integer
                stb val0+val.type
                ldd zero                        ; set result to zero
                std val0+val.int
                std val0+val.int+2
                rts
; Normalization is not required here though rounding might be. Rounding will be handled during floating point return.
; By ensuring there were no leading zeroes converted, the result is already pre-normalized without losing precision due
; to an aribtrary number of leading zeroes.
val_parsenum11a cmpb fpaextra                   ; is the exponent less than the number of digits?
                blt val_parsenum13              ; brif so - return floating point (signed comparison!)
                cmpb #10                        ; is exponent in the range for a binary integer?
                bgt val_parsenum13              ; brif not - return floating point
; Compare with 2147483648, the maximum *negative* value; note that this is a floating point comparison because we
; already normalized everything above and it handles exponents properly
                lda fpa0+fpa.exp                ; compare exponents (unbiased), exponent adjusted for above code
                cmpa #10
                bne val_parsenum12
                ldx fpa0+fpa.sig                ; compare top of significand
                cmpx #0x2147
                bne val_parsenum12
                ldx fpa0+fpa.sig+2              ; compare middle of significand
                cmpx #0x4836
                bne val_parsenum12
                ldx fpa0+fpa.sig+4              ; compare bottom of significand plus extra digits
                cmpx #0x4800
val_parsenum12  bgt val_parsenum13              ; brif too big for integer
                blt val_parsenum14              ; brif it fits in a positive integer
                ldb fpa0+fpa.sign               ; negative?
                bpl val_parsenum14              ; brif not - doesn't fit in integer
val_parsenum13  lda #valtype_float              ; set return value to floating point
                sta val0+val.type
                lda fpa0+fpa.exp                ; put the bias into the exponent
                adda #64
                sta fpa0+fpa.exp
                ldy #val0+val.value             ; normalize/round and return the result
                jmp fps_normalize
val_parsenum14  lda #valtype_int                ; set value type to integer
                sta val0+val.type
                ldb #10                         ; exponent needed for decimal point to the right of significand
                subb fpa0+fpa.exp               ; number of digit shifts needed to denormalize
                beq val_parsenum16              ; brif already denormalized
                lslb                            ; do 4 shifts per digit
                lslb
val_parsenum15  lsr fpa0+fpa.sig                ; shift a digit right
                ror fpa0+fpa.sig+1
                ror fpa0+fpa.sig+2
                ror fpa0+fpa.sig+3
                ror fpa0+fpa.sig+4
                decb                            ; done all shifts?
                bne val_parsenum15
; Now convert BCD digit sequence in fpa0 significand to binary value in val0
val_parsenum16  ldb #32                         ; 40 bit shifts needed for whole significand
                stb fpa0+fpa.extra              ; use extra precision byte as counter
val_parsenum17  lsr fpa0+fpa.sig                ; shift a bit into the binary result
                ror fpa0+fpa.sig+1
                ror fpa0+fpa.sig+2
                ror fpa0+fpa.sig+3
                ror fpa0+fpa.sig+4
                ror val0+val.int
                ror val0+val.int+1
                ror val0+val.int+2
                ror val0+val.int+3
                ldx #fpa0+fpa.sig               ; point to BCD digits
val_parsenum18  lda ,x                          ; get byte to check
                beq val_parsenum20              ; short circuit check if digits are 0
                anda #0x88                      ; keep bit 3 of each digit; adjustment on >= 8
                lsra                            ; shift over and mulply by adjustment factor
                lsra
                lsra
                ldb #3                          ; the adjustment is a subtraction by 3
                mul
                negb                            ; now subtract from digit
                addb ,x
                stb ,x+
val_parsenum18a cmpx #fpa0+fpa.sig+5            ; done all 5 bytes?
                blo val_parsenum18              ; brif not
                dec fpa0+fpa.extra              ; done all bits?
                bne val_parsenum17              ; brif not
                ldb fpa0+fpa.sign               ; do we want negative?
                bpl val_parsenum19              ; brif not
                ldd zero                        ; negate the value through subtracting from 0
                subd val0+val.int+2
                std val0+val.int+2
                ldd zero
                sbcb val0+val.int+1
                sbca val0+val.int
                std val0+val.int
val_parsenum19  rts
val_parsenum20  leax 1,x                        ; move to next digit
                bra val_parsenum18a             ; go back to mainline
                *pragmapop list