This commit is contained in:
~d6 2022-01-09 19:11:21 -05:00
parent e3905178a4
commit 9b63c1eb6c
1 changed files with 17 additions and 22 deletions

View File

@ -277,29 +277,24 @@
( 9. x*2^p < y*2^p if x < y )
@lt-bf16 ( x* y* -> bool^ )
,&y STR2 ,&x STR2
DUP2 ;non-nan JSR2 STH SWP2 ( is y not nan? )
DUP2 ;non-nan JSR2 STH SWP2 ( is x not nan? )
STH2r ORA ,&not-nan JCN ( is either x or y not nan? )
POP2 POP2 #00 JMP2r ( else return false )
,&y LDR2 ;non-nan JSR2 ( is y not nan? )
,&x LDR2 ;non-nan JSR2 ( is x not nan? )
ORA ,&not-nan JCN #00 JMP2r ( false if x and y are nan )
&not-nan
DUP2 ;non-zero JSR2 STH SWP2 ( is y non-zero? )
DUP2 ;non-zero JSR2 STH SWP2 ( is x non-zero? )
STH2r ORA ,&not-zero JCN ( both x and y non-zero? )
POP2 POP2 #00 JMP2r
,&y ;non-zero JSR2 ( is y non-zero? )
,&x ;non-zero JSR2 ( is x non-zero? )
ORA ,&not-zero JCN #00 JMP2r ( false if x and y are zero )
&not-zero
DUP2 ;sign JSR2 STH SWP2
DUP2 ;sign JSR2 STH SWP2
STH2r EQUk ,&same-sign JCN
GTH STH POP2 POP2 STHr JMP2r
,&x LDR2 ;sign JSR2 ( sign of x )
,&y LDR2 ;sign JSR2 ( sign of y )
EQUk ,&same-sign JCN GTH JMP2r ( return unless signs are eq )
[ &x $2 &y $2 ]
&same-sign
DUP2 ;exponent JSR2 STH SWP2
DUP2 ;exponent JSR2 STH SWP2
STH2r EQUk ,&exp-eq JCN
LTH STH POP2 POP2 STHr JMP2r
&exp-eq
POP2
;mantissa JSR2 STH
;exponent JSR2 STHr
LTH JMP2r
&same-sign POP
,&x LDR2 ;exponent JSR2 ( exponent of x )
,&y LDR2 ;exponent JSR2 ( exponent of y )
EQUk ,&exp-eq JCN LTH JMP2r ( return ex < ey unless exps are eq )
&exp-eq POP
,&x LDR2 ;mantissa JSR2 ( mantissa of x )
,&y LDR2 ;exponent JSR2 ( mantissa of y )
LTH JMP2r ( mx < my )