Mercurial > hg > index.cgi
view src/number.s @ 125:0607e4e20702
Correct offset error for keyword table lookup
author | William Astle <lost@l-w.ca> |
---|---|
date | Sun, 07 Jan 2024 20:35:51 -0700 |
parents | 2f97bfecffab |
children | 9d57279c900e |
line wrap: on
line source
*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 of these routines take a single parameter in val0 or two parameters in val0 and val1. They will typically return ; their results in val0. ; ; For binary operations, the left operand will be in val1 and the right operand will be in val0. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 val0 and val1 val_matchtypes ldb val0+val.type ; get the type of first argument cmpb val1+val.type ; do types match? bne val_matchtypes1 ; brif not cmpb #valtype_int ; integer? beq val_matchtypes0 ; brif so - it's good cmpb #valtype_float ; floating point? bne TMERROR ; brif not val_matchtypes0 rts ; types match and are good TMERROR ldb #err_tm ; raise a type mismatch jmp ERROR val_matchtypes1 cmpb #valtype_float ; is first argument float? bne val_matchtypes2 ; brif not ldb val1+val.type ; get second type cmpb #valtype_int ; is it integer? bne TMERROR ; brif not - don't know how to convert ldx #val1 ; go convert val1 to floating point jmp fps_fromint val_matchtypes2 cmpb #valtype_int ; are we an integer? bne TMERROR ; brif not - we don't know how to convert ldb val1+val.type ; get second type cmpb #valtype_float ; is it floating point? bne TMERROR ; brif not - we don't know how to convert ldx #val0 ; convert val0 to floating point jmp fps_fromint ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; 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 #9 ; is the exponent greater than possible for a 32 bit integer? bgt val_parsenum13 lda fpaextra ; fetch the number of digits deca ; account for the decimal point offset cmpa fpa0+fpa.exp ; do we have more digits than the exponent (fractional)? bgt val_parsenum13 ; brif we have more digits than exponent ; 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) cmpa #9 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 jsr fps_normalizea0 ; normalize fpa0 ldx #val0 ; pack the result to the right place and return jmp fps_pack0 val_parsenum14 lda #valtype_int ; set value type to integer sta val0+val.type ldb fpa0+fpa.exp ; add the exponent bias in addb #64 stb fpa0+fpa.exp jsr fps_toint1 ; go convert to an integer ldd fpa0+fpa.sig+1 ; copy result to val0 std val0+val.int ldd fpa0+fpa.sig+3 std val0+val.int+2 rts *pragmapop list