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