Mercurial > hg > index.cgi

comparison src/number.s @ 78:718f9b7381b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Slight improvements to some floating point code
author William Astle <lost@l-w.ca>
date Sun, 10 Sep 2023 20:05:47 -0600
parents eb2681108660
children df86e6d64ce2
comparison
equal deleted inserted replaced
77:ba559f231929 78:718f9b7381b3
107 rol val.fpmant,x 107 rol val.fpmant,x
108 fp_normalize2 bpl fp_normalize1 ; brif we have to do a bit shift 108 fp_normalize2 bpl fp_normalize1 ; brif we have to do a bit shift
109 pshs b ; apply exponent counter to exponent 109 pshs b ; apply exponent counter to exponent
110 lda val.fpexp,x 110 lda val.fpexp,x
111 suba ,s+ 111 suba ,s+
112 bls fp_normalize6 ; brif we underflowed to zero 112 bls fp_normalize6 ; brif we underflowed to zero; overflow is impossible
113 bcc fp_normalize3 ; brif we did not overflow
114 OVERROR2 jmp OVERROR ; raise overflow
115 fp_normalize3 lsl ,s+ ; set C if the high bit of extra precision is set 113 fp_normalize3 lsl ,s+ ; set C if the high bit of extra precision is set
116 bcs fp_normalize5 ; brif bit set - we have to do rounding 114 bcs fp_normalize5 ; brif bit set - we have to do rounding
117 fp_normalize4 rts ; return if no rounding 115 fp_normalize4 rts ; return if no rounding
118 fp_normalize5 ldu val.fpmant+2,x ; add one to mantissa 116 fp_normalize5 ldu val.fpmant+2,x ; add one to mantissa
119 leau 1,u 117 leau 1,u
123 leau 1,u 121 leau 1,u
124 stu val.fpmant,x 122 stu val.fpmant,x
125 bne fp_normalize4 ; brif high word doesn't carry 123 bne fp_normalize4 ; brif high word doesn't carry
126 ror val.fpmant,x ; shift right C in to high bit of mantissa (already set to get here) 124 ror val.fpmant,x ; shift right C in to high bit of mantissa (already set to get here)
127 inc val.fpexp,x ; bump exponent for a right shift 125 inc val.fpexp,x ; bump exponent for a right shift
128 beq OVERROR2 ; brif it overflows (> +127) 126 bne fp_normalize4 ; brif it doesn't overflow (> +127)
129 rts ; return result (only possible result was mantissa wrapped to zero) 127 OVERROR2 jmp OVERROR ; raise overflow
130 fp_normalize6 clr val.fpmant,x ; clear mantissa 128 fp_normalize6 clr val.fpmant,x ; clear mantissa
131 clr val.fpmant+1,x 129 clr val.fpmant+1,x
132 clr val.fpmant+2,x 130 clr val.fpmant+2,x
133 clr val.fpmant+3,x 131 clr val.fpmant+3,x
134 fp_normalize7 clr val.fpexp,x ; clear exponent and sign 132 fp_normalize7 clr val.fpexp,x ; clear exponent and sign
148 std val.int+2,y 146 std val.int+2,y
149 ldd val.int,x 147 ldd val.int,x
150 adcb val.int+1,u 148 adcb val.int+1,u
151 adca val.int,u 149 adca val.int,u
152 std val.int,y 150 std val.int,y
153 lbvs OVERROR ; brif calculation overflowed 151 bvs OVERROR2 ; brif calculation overflowed
154 rts 152 rts
155 val_sub ldb val.type,x ; get type of left operand 153 val_sub ldb val.type,x ; get type of left operand
156 stb val.type,y ; set result type 154 stb val.type,y ; set result type
157 cmpb #valtype_float ; floating point? 155 cmpb #valtype_float ; floating point?
158 beq fp_sub ; brif so 156 beq fp_sub ; brif so
161 std val.int+2,y 159 std val.int+2,y
162 ldd val.int,x 160 ldd val.int,x
163 sbcb val.int+1,u 161 sbcb val.int+1,u
164 sbca val.int,u 162 sbca val.int,u
165 std val.int,y 163 std val.int,y
166 lbvs OVERROR ; brif overflow 164 bvs OVERROR2 ; brif overflow
167 rts 165 rts
168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
169 ; FP subtraction: just invert the sign of the second operand and add; operands must be writable and they should be 167 ; FP subtraction: just invert the sign of the second operand and add; operands must be writable and they should be
170 ; considered to be clobbered 168 ; considered to be clobbered
171 fp_sub com val.fpsign,u ; negate right operand 169 fp_sub com val.fpsign,u ; negate right operand