Mercurial > hg > index.cgi

comparison src/number.s @ 85:663d8e77b579

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implmement BCD floating point and update number parsing and printing Implements a BCD floating point system with 10 decimal digits of precistion and an exponent range of -63 to +63. Also include parsing integer and floating point values and printing them out.
author William Astle <lost@l-w.ca>
date Sun, 15 Oct 2023 22:15:36 -0600
parents f959c92bc329
children de42b8f77bc2
comparison
equal deleted inserted replaced
84:f959c92bc329 85:663d8e77b579
27 val_matchtypes3 rts ; both types int - we're good so return 27 val_matchtypes3 rts ; both types int - we're good so return
28 val_matchtypes2 cmpb #valtype_float ; is it floating point? 28 val_matchtypes2 cmpb #valtype_float ; is it floating point?
29 bne TMERROR ; brif not - raise error 29 bne TMERROR ; brif not - raise error
30 pshs x ; save X which may be clobbered 30 pshs x ; save X which may be clobbered
31 leay ,x ; point to input operand as destination for conversion 31 leay ,x ; point to input operand as destination for conversion
32 jsr fps_fromint32 ; convert first argument to floating point 32 ; jsr fps_fromint32 ; convert first argument to floating point
33 puls x,pc ; restore second operand pointer and return 33 puls x,pc ; restore second operand pointer and return
34 val_matchtypes1 ldb val.type,u ; get second argument type 34 val_matchtypes1 ldb val.type,u ; get second argument type
35 cmpb #valtype_float ; is it floating point? 35 cmpb #valtype_float ; is it floating point?
36 beq val_matchtypes3 ; brif so - we're good 36 beq val_matchtypes3 ; brif so - we're good
37 cmpb #valtype_int ; is it integer? 37 cmpb #valtype_int ; is it integer?
38 bne TMERROR ; brif not - invalid type combination 38 bne TMERROR ; brif not - invalid type combination
39 pshs x ; save X which mill be clobbered 39 pshs x ; save X which mill be clobbered
40 leax ,u ; convert (U) to floating point 40 leax ,u ; convert (U) to floating point
41 leay ,u 41 leay ,u
42 jsr fps_fromint32 42 ; jsr fps_fromint32
43 puls x,pc ; restore argument pointer and return 43 puls x,pc ; restore argument pointer and return
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45 ; Addition and subtraction of values; must enter with values of matching types and the result type already set 45 ; Addition and subtraction of values; must enter with values of matching types and the result type already set
46 ; to the correct type. 46 ; to the correct type.
47 ; 47 ;
99 cmpb #valtype_float ; floating point? 99 cmpb #valtype_float ; floating point?
100 lbeq fps_mod ; floating point modulus 100 lbeq fps_mod ; floating point modulus
101 jmp TMERROR ; unsupported type 101 jmp TMERROR ; unsupported type
102 endc 102 endc
103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
104 ; Parse a number to either an integer or a floating point value 104 ; Parse a number to either an integer or a floating point value and return the result in val0
105 ; 105 ;
106 ; First, identify any sign present. Then parse the remainder as an integer until either a decimal point, an exponential 106 ; This works by first detecting any sign indicators and handling those. Multiple prefix signs are supported. Note that
107 ; indicator, or the value gets larger than 32 bits. If any of those eventualities happens, convert to floating point 107 ; in the regular expression evaluation sequence, unary minus and plus will be handled by the expression evaluator so
108 ; and then continue parsing the number as floating point. The result will be stored to (Y). 108 ; in that case, the number evaluator would not need to care about those. However, in the case of an arbitrary string
109 ; fed into the evaluator, those must be handled. Note that there is no need to handle tokenized sign indicators because
110 ; the only place where they would be tokenized is in a proper expression.
111 ;
112 ; Once leading signs are handled, any base specifiers or other modifiers are handled. If none of those intercept the
113 ; parsing, the regular number parsing continues as follows.
114 ;
115 ; 1. Read a sequence of digits. The digits are stored in backed BCD form in the significand of fpa0. An arbitrary number
116 ; of leading zeroes will be skipped. A count of significant digits is maintained while reading digits as is the
117 ; position of a decimal point if one is encountered. Once one digit more than the maximum possible precision of any
118 ; supported number type is read, subsequent digits will not be stored, but the counters will still be updated.
119 ; 2. Any subsequent "E" or "e" followed by either a positive or negative decimal exponent is read, with the sign
120 ; indicator being optional.
121 ; 3. The decimal offset calculated in (1) is adjusted by the exponent read in (2) if any.
122 ; 4. Range checks are completed as follows:
123 ; 4a. If the calculated decimal exponent is beyond the supported range of any floating point or integer type, raise
124 ; an overflow error.
125 ; 4b. If the number is an integer in the range of -0x80000000 to 0x7fffffff, it is converted to a signed binary integer
126 ; and the result is returned
127 ; 4b. Set the exponent correctly then normalize the result to val0
109 val_parsenum lbeq SNERROR ; brif no numberr to parse 128 val_parsenum lbeq SNERROR ; brif no numberr to parse
110 ldd zero ; zero out integer value accumulator 129 ldd zero ; zero out digit accumulator
111 std fpa0extra 130 stx fpa0+fpa.sig
112 std fpa0extra+2 131 stx fpa0+fpa.sig+2
113 std fpa0extra+4 132 stx fpa0+fpa.sig+4
114 std fpa0extra+6 133 stx fpa0+fpa.sig+6
115 sta fpa0extra12 ; zero out result sign to default positive 134 stx fpa0+fpa.sig+8
116 jsr curchar ; get current input character 135 sta fpa0+fpa.sign ; set number sign to positive
117 bra val_parsenum1 ; parse flags 136 std fpaextra+4 ; clear out decimal exponent and sign
118 val_parsenum0 jsr nextchar ; get next input character 137 std fpaextra ; set digit count and decimal flag to zero and no decimal
119 val_parsenum1 bcs val_parsenum5 ; brif digit 138 sta fpaextra+2 ; set decimal position to 0 - unused if decimal not seen
120 beq val_parsenum ; brif end of input 139 ldx #fpa0+fpa.sig ; point to digit storage location
121 cmpa #'. ; decimal? 140 lda #0xf0 ; set digit mask
122 lbeq val_parsefloat ; switch to parsing floating point 141 sta fpaextra+3
123 cmpa #'- ; minus? 142 jsr curchar ; get back current input
124 beq val_parsenum2 ; brif so 143 bra val_parsenum1
125 cmpa #tok_minus ; unary minus operator? 144 val_parsenum0 jsr nextchar ; fetch next input
145 val_parsenum1 bcs val_parsenum3 ; brif digit - short ciruit other checks
146 cmpa #'+ ; unary plus?
147 beq val_parsenum0 ; brif so - it's a no-op but supported for symmetry with unary minus
148 cmpa #'- ; negative?
149 bne val_parsenum5 ; brif not
150 com fpa0+fpa.sign ; invert the sign
151 bra val_parsenum0 ; eat the sign and see if there's more signs
152 val_parsenum2 jsr nextchar ; fetch next character in number
153 bcc val_parsenum5 ; brif not a digit
154 val_parsenum3 ldb fpaextra ; is it within the digit count?
155 cmpb #11 ; (11 digits holds both 10 digit fp and 32 bit integer)
156 bhs val_parsenum4 ; brif so - don't convert it
157 suba #0x30 ; binary-ize the digit
158 bne val_parsenum3a ; brif not zero
159 tstb ; no digits?
160 beq val_parsenum2 ; brif so - skip leading zeroes
161 val_parsenum3a ldb #0x11 ; put in both digit spots
162 mul
163 andb fpaextra+3 ; only keep the one we need
164 orb ,x ; merge with existing digit
165 stb ,x ; put in digit location
166 com fpaextra+3 ; flip digit position mask
167 bpl val_parsenum4 ; brif not moving to new location
168 leax 1,x ; move to new digit storage location
169 val_parsenum4 inc fpaextra ; bump digit count
170 lbmi OVERROR ; brif it overflowed - we can't parse more than 127 digits!
171 ldb fpaextra+2 ; get decimal position counter
172 subb fpaextra+1 ; subtract decimal flag (will be 0xff or -1 if decimal seen)
173 stb fpaextra+2
174 bra val_parsenum2 ; go handle another digit or whatever
175 val_parsenum5 cmpa #'. ; decimal?
126 bne val_parsenum3 ; brif not 176 bne val_parsenum3 ; brif not
127 val_parsenum2 com fpa0extra12 ; invert current sign 177 com fpaextra ; flag decimal seen
128 bra val_parsenum0 ; go handle more stuff at the start of the number 178 lbeq SNERROR ; brif already seen a decimal point - syntax error
129 val_parsenum3 cmpa #'+ ; unary +? 179 bra val_parsenum2 ; go parse more digits
130 beq val_parsenum0 ; brif so - skip it 180 val_parsenum6 cmpa #'E ; decimal exponent?
131 cmpa #tok_plus ; unary + operator? 181 beq val_parsenum7 ; brif so
132 beq val_parsenum0 ; brif so - skip it 182 cmpa #'e ; lower case exponent indicator?
133 val_parsenum4 lda fpa0extra4 ; is bit 7 of high byte set? 183 bne val_parsenum11 ; brif not - we have the end of the number here
134 bpl val_parsenum4a ; brif not - no overflow 184 val_parsenum7 jsr nextchar ; eat exponent indicator
135 ldb fpa0extra12 ; do we want negative? 185 bcs val_parsenum9 ; brif digit
136 lbpl val_parsefloat ; brif not - we overflowed so convert to floating point 186 cmpa #'+ ; positive?
137 anda #0x7f ; lose sign bit then see if any other bits are set 187 beq val_parsenum8 ; brif no
138 ora fpa0extra5 188 cmpa #'- ; negative?
139 ora fpa0extra6 189 lbne SNERROR ; brif not positive, negative, or digit
140 ora fpa0extra7 190 com fpaextra+5 ; make sign of exponent negative
141 lbne val_parsefloat ; brif nonzero bits - too big for max negative 2's complement 191 val_parsenum8 jsr nextchar ; eat exponent sign/get next digit
142 val_parsenum4a lda fpa0extra12 ; do we want negative? 192 bcc val_parsenum10 ; brif not a digit - done with number
143 bpl val_parsenum4b ; brif not 193 val_parsenum9 suba #0x30 ; binary-ize the digit
144 ldd zero ; negate it 194 sta fpaextra+6 ; save digit value
145 subd fpa0extra6 195 ldb fpaextra+4 ; get calculated exponent
146 std fpa0extra6 196 lda #10 ; multiply by 10
197 mul
198 lbcs OVERROR ; brif decimal exponent overlows ±127 - we just don't handle that
199 addb fpaextra+6 ; add digit in
200 lbmi OVERROR ; same as above - make sure exponent in range
201 stb fpaextra+4 ; save new decimal exponent
202 bra val_parsenum8 ; handle another digit
203 val_parsenum10 lda fpaextra+5 ; get sign of exponent
204 bpl val_parsenum11 ; brif positive
205 neg fpaextra+4 ; negate resulting exponent
206 val_parsenum11 ldb fpaextra ; get number of digits provided
207 subb fpaextra+2 ; subtract out count of fractional digits giving whole number digits
208 addb fpaextra+4 ; add in decimal exponent adjustment
209 stb fpa0+fpa.exp ; set result exponent
210 ; Normalization is not required here though rounding might be. Rounding will be handled during floating point return.
211 ; By ensuring there were no leading zeroes converted, the result is already pre-normalized without losing precision due
212 ; to an aribtrary number of leading zeroes.
213 cmpb fpaextra ; is the exponent less than the number of digits?
214 blt val_parsenum13 ; brif so - return floating point (signed comparison!)
215 cmpb #10 ; is exponent in the range for a binary integer?
216 bgt val_parsenum13 ; brif not - return floating point
217 ; Compare with 2147483648, the maximum *negative* value; note that this is a floating point comparison because we
218 ; already normalized everything above and it handles exponents properly
219 lda fpa0+fpa.exp ; compare exponents (unbiased)
220 cmpa #9
221 bne val_parsenum12
222 ldx fpa0+fpa.sig ; compare top of significand
223 cmpx #0x2147
224 bne val_parsenum12
225 ldx fpa0+fpa.sig+2 ; compare middle of significand
226 cmpx #0x4836
227 bne val_parsenum12
228 ldx fpa0+fpa.sig+4 ; compare bottom of significand plus extra digits
229 cmpx #0x4800
230 val_parsenum12 bgt val_parsenum13 ; brif too big for integer
231 blt val_parsenum14 ; brif it fits in a positive integer
232 ldb fpa0+fpa.sign ; negative?
233 bpl val_parsenum14 ; brif not - doesn't fit in integer
234 val_parsenum13 lda #valtype_float ; set return value to floating point
235 sta val0+val.type
236 lda fpa0+fpa.exp ; put the bias into the exponent
237 adda #64
238 sta fpa0+fpa.exp
239 ldy #val0+val.value ; normalize/round and return the result
240 jmp fps_normalize
241 val_parsenum14 lda #valtype_int ; set value type to integer
242 sta val0+val.type
243 ldb #9 ; exponent needed for decimal point to the right of significand
244 subb fpa0+fpa.exp ; number of digit shifts needed to denormalize
245 beq val_parsenum16 ; brif already denormalized
246 lslb ; do 4 shifts per digit
247 lslb
248 val_parsenum15 lsr fpa0+fpa.sig ; shift a digit right
249 ror fpa0+fpa.sig+1
250 ror fpa0+fpa.sig+2
251 ror fpa0+fpa.sig+3
252 ror fpa0+fpa.sig+4
253 decb ; done all shifts?
254 bne val_parsenum15
255 ; Now convert BCD digit sequence in fpa0 significand to binary value in val0
256 val_parsenum16 ldb #40 ; 40 bit shifts needed for whole significand
257 stb fpa0+fpa.extra ; use extra precision byte as counter
258 val_parsenum17 lsl fpa0+fpa.sig+4 ; shift a bit into the binary result
259 rol fpa0+fpa.sig+3
260 rol fpa0+fpa.sig+2
261 rol fpa0+fpa.sig+1
262 rol fpa0+fpa.sig
263 rol val0+val.int+3
264 rol val0+val.int+2
265 rol val0+val.int+1
266 rol val0+val.int
267 ldx #fpa0+fpa.sig ; point to BCD digits
268 val_parsenum18 lda ,x ; get byte to check
269 beq val_parsenum20 ; short circuit check if digits are 0
270 anda #0x88 ; keep bit 3 of each digit; adjustment on >= 8
271 lsra ; shift over and mulply by adjustment factor
272 lsra
273 lsra
274 ldb #3 ; the adjustment is a subtraction by 3
275 mul
276 negb ; now subtract from digit
277 addb ,x
278 stb ,x+
279 val_parsenum18a cmpx #fpa0+fpa.sig+5 ; done all 5 bytes?
280 blo val_parsenum18 ; brif not
281 dec fpa0+fpa.extra ; done all bits?
282 bne val_parsenum17 ; brif not
283 ldb fpa0+fpa.sign ; do we want negative?
284 bpl val_parsenum19 ; brif not
285 ldd zero ; negate the value through subtracting from 0
286 subd val0+val.int+2
287 std val0+val.int+2
147 ldd zero 288 ldd zero
148 sbcb fpa0extra5 289 sbcb val0+val.int+1
149 sbca fpa0extra4 290 sbca val0+val.int
150 std fpa0extra4 291 std val0+val.int
151 val_parsenum4b ldd fpa0extra6 ; copy value to result location 292 val_parsenum19 rts
152 std val.int+2,y 293 val_parsenum20 leax 1,x ; move to next digit
153 ldd fpa0extra4 294 bra val_parsenum18a ; go back to mainline
154 std val.int,y
155 lda #valtype_int ; set value type to integer
156 sta val.type,y
157 rts
158 val_parsenum4c jsr nextchar ; fetch next character (after a digit)
159 bcs val_parsenum5 ; it's a digit
160 cmpa #'. ; decimal?
161 beq val_parsefloat ; brif so - handle floating point
162 cmpa #'E ; exponent?
163 beq val_parsefloat ; brif so - handle floating point
164 cmpa #'e ; exponent but lower case?
165 beq val_parsefloat ; brif so - handle floating point
166 bra val_parsenum4 ; unrecognized character - treat as end of number
167 val_parsenum5 suba #'0 ; offset digit to binary
168 pshs a ; save it for later addition
169 ldx fpa0extra4 ; save original value
170 stx fpa0extra8
171 ldx fpa0extra6
172 stx fpa0extra10
173 lsl fpa0extra7 ; shift partial result left (times 2)
174 rol fpa0extra6
175 rol fpa0extra5
176 rol fpa0extra4
177 rol fpa0extra3
178 lsl fpa0extra7 ; shift partial result left (times 4)
179 rol fpa0extra6
180 rol fpa0extra5
181 rol fpa0extra4
182 rol fpa0extra3
183 ldd fpa0extra6 ; add in original value (time 5)
184 addd fpa0extra10
185 std fpa0extra6
186 ldd fpa0extra8
187 adcb fpa0extra5
188 adca fpa0extra4
189 std fpa0extra4
190 ldb fpa0extra3
191 adcb #0
192 stb fpa0extra3
193 lsl fpa0extra7 ; shift partial result left (times 10)
194 rol fpa0extra6
195 rol fpa0extra5
196 rol fpa0extra4
197 rol fpa0extra3
198 ldd fpa0extra6 ; add in new digit
199 addb ,s+
200 adca #0
201 std fpa0extra6
202 ldd fpa0extra4 ; and propagate carry
203 adcb #0
204 adca #0
205 std fpa0extra4
206 ldb fpa0extra3
207 adcb #0
208 stb fpa0extra3
209 beq val_parsenum4c ; go handle next digit if we didn't overflow past 32 bits
210 jsr nextchar ; eat the digit we just handled
211 val_parsefloat pshs y ; save destination pointer
212 lda #valtype_float ; set return type to floating point
213 sta val.type,y
214 ldx #fpa0extra ; point to integer accumulator
215 jsr fps_fromuint64 ; convert to floating point
216 clr fpa0extra11 ; zero out decimal counter
217 clr fpa0extra10 ; zero out decimal exponent counter
218 clr fpa0extra9 ; flag for decimal seen
219 jsr curchar ; fetch current character
220 bra val_parsefloat1 ; go handle character
221 val_parsefloat0 jsr nextchar ; fetch next character
222 val_parsefloat1 bcc val_parsefloat2 ; brif not digit
223 suba #'0 ; adjust digit to binary
224 sta fpa0extra3 ; save it for later (upper 3 bytes of 32 bit value already 0)
225 ldx ,s ; get destination value
226 jsr fps_mul10 ; do a quick multiply by 10
227 ldx #fpa0extra ; convert digit to floating point
228 ldy #fpa1
229 jsr fps_fromuint32
230 ldu #fpa1 ; add digit to accumulated value
231 ldx ,s
232 leay ,x
233 jsr fps_add
234 lda fpa0extra11 ; update decimal counter
235 suba fpa0extra9
236 sta fpa0extra11
237 bra val_parsefloat0 ; go handle another digit
238 val_parsefloat2 cmpa #'. ; decimal?
239 bne val_parsefloat7 ; brif not
240 com fpa0extra9 ; flag for decimal
241 bne val_parsefloat0 ; brif not two decimals - keep parsing
242 val_parsefloat3 ldb fpa0extra10 ; fetch decimal exponent counter
243 subb fpa0extra11 ; subtract out decimal places provided
244 beq val_parsefloat6 ; brif no adjustment needed
245 stb fpa0extra9 ; save counter
246 bmi val_parsefloat5 ; brif negative exponent - need to do divisions
247 val_parsefloat4 ldx ,s ; point to destination value
248 jsr fps_mul10 ; multiply by 10
249 dec fpa0extra9 ; done all of them?
250 bne val_parsefloat4 ; brif not
251 bra val_parsefloat6
252 val_parsefloat5 ldx ,s ; point to destination value
253 jsr fps_div10 ; divide by 10
254 inc fpa0extra9 ; done all of them?
255 bne val_parsefloat5 ; brif not
256 val_parsefloat6 puls y ; get back destination pointer
257 lda fpa0extra12 ; get desired sign
258 sta val.fpssign,y ; set in result
259 rts
260 val_parsefloat7 cmpa #'E ; decimal exponent?
261 beq val_parsefloat8 ; brif so
262 cmpa #'e ; decimal exponent, lower case edition?
263 bne val_parsefloat3 ; brif not - must be end of number
264 val_parsefloat8 clr fpa0extra9 ; set sign of exponent to positive
265 jsr nextchar ; fetch exponent character
266 bcs val_parsefloat11 ; brif digit
267 cmpa #'+ ; positive exponent?
268 beq val_parsefloat10 ; brif so - skip it
269 cmpa #tok_plus ; positive exponent, operator style?
270 beq val_parsefloat10 ; brif so - skip it
271 cmpa #'- ; negative exponent?
272 beq val_parsefloat9 ; brif so
273 cmpa #tok_minus ; negative exponent, operator style?
274 bne val_parsefloat3 ; brif not - must be end of exponent
275 val_parsefloat9 com fpa0extra9 ; set exponent to negative
276 val_parsefloat10
277 jsr nextchar ; eat exponent sign
278 bcc val_parsefloat12 ; brif end of exponent - apply sign
279 val_parsefloat11
280 suba #'0 ; binary-ize digit
281 sta fpa0extra8 ; save digit for later
282 lda #10 ; mutiply current decimal exponent by 10
283 ldb fpa0extra10 ; get current exponent
284 mul
285 adca #0 ; set A if we overflowed *or* bit 7 of B is set
286 lbne OVERROR ; brif exponent overflow
287 addb fpa0extra8 ; add in digit
288 lbvs OVERROR ; brif exponent overflow
289 stb fpa0extra10 ; save new exponent
290 bra val_parsefloat10 ; go handle next exponent digit
291 val_parsefloat12
292 ldb fpa0extra9 ; do we have a negative exponent?
293 beq val_parsefloat3 ; brif not, go adjust value by exponent and return
294 neg fpa0extra10 ; set base 10 exponent negative
295 bra val_parsefloat3 ; go adjust value by exponent and return
296 *pragmapop list 295 *pragmapop list