*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
;
; 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