More float tests, x86 float fixes

release
slava 2006-05-06 03:06:08 +00:00
parent 6318d7d719
commit e13b28e0d5
8 changed files with 96 additions and 43 deletions

View File

@ -1,6 +1,8 @@
should fix in 0.82:
- clean up/rewrite register allocation
- moving between int and float vregs
- intrinsic fixnum>float float>fixnum
- amd64 %box-struct
- when generating a 32-bit image on a 64-bit system, large numbers which should

View File

@ -125,7 +125,7 @@ M: #if generate-node ( node -- next )
end-basic-block
<label> dup %jump-t
] H{
{ +input { { 0 "flag" } } }
{ +input { { f "flag" } } }
} with-template generate-if ;
! #call
@ -145,7 +145,8 @@ M: #if generate-node ( node -- next )
save-xt
t 0 <int-vreg> load-literal
"end" get save-xt
0 <int-vreg> phantom-d get phantom-push ;
0 <int-vreg> phantom-d get phantom-push
compute-free-vregs ;
: do-if-intrinsic ( node -- next )
[ <label> dup ] keep if-intrinsic call
@ -193,10 +194,12 @@ M: #dispatch generate-node ( node -- next )
UNION: immediate fixnum POSTPONE: f ;
: generate-push ( node -- )
[
>#push< dup literal-template
dup requested-vregs ensure-vregs
alloc-vregs [ [ load-literal ] 2each ] keep
phantom-d get phantom-append ;
phantom-d get phantom-append
] with-scope ;
M: #push generate-node ( #push -- )
generate-push iterate-next ;

View File

@ -122,7 +122,7 @@ SYMBOL: @
{ { -1 @ } [ nip 0 swap - ] }
} define-identities
[ / /i /f fixnum/i fixnum/f bignum/i bignum/f float/f ] {
[ / fixnum/i fixnum/f bignum/i bignum/f float/f ] {
{ { @ 1 } [ drop ] }
{ { @ -1 } [ drop 0 swap - ] }
} define-identities
@ -176,7 +176,7 @@ SYMBOL: @
{ { @ @ } [ 2drop t ] }
} define-identities
[ eq? number= = ] {
[ eq? bignum= float= number= = ] {
{ { @ @ } [ 2drop t ] }
} define-identities

View File

@ -286,28 +286,28 @@ M: integer CALL HEX: e8 assemble-1 from assemble-4 ;
M: callable CALL 0 CALL relative-4 ;
M: operand CALL BIN: 010 t HEX: ff 1-operand ;
GENERIC: JUMPcc ( opcode addr -- )
M: integer JUMPcc ( opcode addr -- )
HEX: 0f assemble-1 swap assemble-1 from assemble-4 ;
M: callable JUMPcc ( opcode addr -- )
>r 0 JUMPcc r> relative-4 ;
G: JUMPcc ( addr opcode -- ) 1 standard-combination ;
M: integer JUMPcc ( addr opcode -- )
swap HEX: 0f assemble-1 swap assemble-1 from assemble-4 ;
M: callable JUMPcc ( addr opcode -- )
swap >r 0 swap JUMPcc r> relative-4 ;
: JO HEX: 80 swap JUMPcc ;
: JNO HEX: 81 swap JUMPcc ;
: JB HEX: 82 swap JUMPcc ;
: JAE HEX: 83 swap JUMPcc ;
: JE HEX: 84 swap JUMPcc ; ! aka JZ
: JNE HEX: 85 swap JUMPcc ;
: JBE HEX: 86 swap JUMPcc ;
: JA HEX: 87 swap JUMPcc ;
: JS HEX: 88 swap JUMPcc ;
: JNS HEX: 89 swap JUMPcc ;
: JP HEX: 8a swap JUMPcc ;
: JNP HEX: 8b swap JUMPcc ;
: JL HEX: 8c swap JUMPcc ;
: JGE HEX: 8d swap JUMPcc ;
: JLE HEX: 8e swap JUMPcc ;
: JG HEX: 8f swap JUMPcc ;
: JO HEX: 80 JUMPcc ;
: JNO HEX: 81 JUMPcc ;
: JB HEX: 82 JUMPcc ;
: JAE HEX: 83 JUMPcc ;
: JE HEX: 84 JUMPcc ; ! aka JZ
: JNE HEX: 85 JUMPcc ;
: JBE HEX: 86 JUMPcc ;
: JA HEX: 87 JUMPcc ;
: JS HEX: 88 JUMPcc ;
: JNS HEX: 89 JUMPcc ;
: JP HEX: 8a JUMPcc ;
: JNP HEX: 8b JUMPcc ;
: JL HEX: 8c JUMPcc ;
: JGE HEX: 8d JUMPcc ;
: JLE HEX: 8e JUMPcc ;
: JG HEX: 8f JUMPcc ;
: RET ( -- ) HEX: c3 assemble-1 ;

View File

@ -60,10 +60,10 @@ M: float-regs (%replace) ( vreg loc reg-class -- )
} define-if-intrinsic ;
{
{ float< JL }
{ float<= JLE }
{ float> JG }
{ float>= JGE }
{ float< JB }
{ float<= JBE }
{ float> JA }
{ float>= JAE }
{ float= JE }
} [
first2 define-float-jump

View File

@ -3,9 +3,9 @@
IN: math-internals
USING: math kernel ;
: float= ( n n -- )
: float= ( n n -- ? )
#! The compiler replaces this with a better intrinsic.
[ double>bits ] 2apply number= ;
[ double>bits ] 2apply number= ; foldable
IN: math
@ -20,7 +20,8 @@ M: real <=> - ;
: fp-nan? ( float -- ? )
double>bits -51 shift BIN: 111111111111 [ bitand ] keep = ;
M: float zero? ( float -- ? ) dup 0.0 = swap -0.0 = or ;
M: float zero? ( float -- ? )
dup 0.0 float= swap -0.0 float= or ;
M: float < float< ;
M: float <= float<= ;

View File

@ -23,3 +23,54 @@ USING: compiler kernel memory math math-internals test ;
[ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-1 ] unit-test
[ 0.5 ] [ 1.0 2.0 [ float/f ] compile-1 ] unit-test
[ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-1 ] unit-test
[ t ] [ 1.0 2.0 [ float< ] compile-1 ] unit-test
[ t ] [ 1.0 [ 2.0 float< ] compile-1 ] unit-test
[ f ] [ 1.0 [ 2.0 swap float< ] compile-1 ] unit-test
[ f ] [ 1.0 1.0 [ float< ] compile-1 ] unit-test
[ f ] [ 1.0 [ 1.0 float< ] compile-1 ] unit-test
[ f ] [ 1.0 [ 1.0 swap float< ] compile-1 ] unit-test
[ f ] [ 3.0 1.0 [ float< ] compile-1 ] unit-test
[ f ] [ 3.0 [ 1.0 float< ] compile-1 ] unit-test
[ t ] [ 3.0 [ 1.0 swap float< ] compile-1 ] unit-test
[ t ] [ 1.0 2.0 [ float<= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 2.0 float<= ] compile-1 ] unit-test
[ f ] [ 1.0 [ 2.0 swap float<= ] compile-1 ] unit-test
[ t ] [ 1.0 1.0 [ float<= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 1.0 float<= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 1.0 swap float<= ] compile-1 ] unit-test
[ f ] [ 3.0 1.0 [ float<= ] compile-1 ] unit-test
[ f ] [ 3.0 [ 1.0 float<= ] compile-1 ] unit-test
[ t ] [ 3.0 [ 1.0 swap float<= ] compile-1 ] unit-test
[ f ] [ 1.0 2.0 [ float> ] compile-1 ] unit-test
[ f ] [ 1.0 [ 2.0 float> ] compile-1 ] unit-test
[ t ] [ 1.0 [ 2.0 swap float> ] compile-1 ] unit-test
[ f ] [ 1.0 1.0 [ float> ] compile-1 ] unit-test
[ f ] [ 1.0 [ 1.0 float> ] compile-1 ] unit-test
[ f ] [ 1.0 [ 1.0 swap float> ] compile-1 ] unit-test
[ t ] [ 3.0 1.0 [ float> ] compile-1 ] unit-test
[ t ] [ 3.0 [ 1.0 float> ] compile-1 ] unit-test
[ f ] [ 3.0 [ 1.0 swap float> ] compile-1 ] unit-test
[ f ] [ 1.0 2.0 [ float>= ] compile-1 ] unit-test
[ f ] [ 1.0 [ 2.0 float>= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 2.0 swap float>= ] compile-1 ] unit-test
[ t ] [ 1.0 1.0 [ float>= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 1.0 float>= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 1.0 swap float>= ] compile-1 ] unit-test
[ t ] [ 3.0 1.0 [ float>= ] compile-1 ] unit-test
[ t ] [ 3.0 [ 1.0 float>= ] compile-1 ] unit-test
[ f ] [ 3.0 [ 1.0 swap float>= ] compile-1 ] unit-test
[ f ] [ 1.0 2.0 [ float= ] compile-1 ] unit-test
[ t ] [ 1.0 1.0 [ float= ] compile-1 ] unit-test
[ f ] [ 1.0 [ 2.0 float= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 1.0 float= ] compile-1 ] unit-test
[ f ] [ 1.0 [ 2.0 swap float= ] compile-1 ] unit-test
[ t ] [ 1.0 [ 1.0 swap float= ] compile-1 ] unit-test
[ t ] [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
[ t ] [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test
[ f ] [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-1 ] unit-test

View File

@ -1,5 +1,5 @@
IN: temporary
USING: compiler kernel math test vectors ;
USING: compiler kernel kernel-internals math test vectors ;
[ 5 ] [ 5 [ 0 + ] compile-1 ] unit-test
[ 5 ] [ 5 [ 0 swap + ] compile-1 ] unit-test
@ -22,12 +22,6 @@ USING: compiler kernel math test vectors ;
[ 0 ] [ 5 [ 1 mod ] compile-1 ] unit-test
[ 0 ] [ 5 [ 1 rem ] compile-1 ] unit-test
[ 5 ] [ 5 [ 1 ^ ] compile-1 ] unit-test
[ 25 ] [ 5 [ 2 ^ ] compile-1 ] unit-test
[ 1/5 ] [ 5 [ -1 ^ ] compile-1 ] unit-test
[ 1/25 ] [ 5 [ -2 ^ ] compile-1 ] unit-test
[ 1 ] [ 5 [ 1 swap ^ ] compile-1 ] unit-test
[ 5 ] [ 5 [ -1 bitand ] compile-1 ] unit-test
[ 0 ] [ 5 [ 0 bitand ] compile-1 ] unit-test
[ 5 ] [ 5 [ -1 swap bitand ] compile-1 ] unit-test
@ -58,3 +52,5 @@ USING: compiler kernel math test vectors ;
[ t ] [ 5 [ dup = ] compile-1 ] unit-test
[ t ] [ 5 [ dup number= ] compile-1 ] unit-test
[ t ] [ \ vector [ \ vector = ] compile-1 ] unit-test
[ 3 ] [ 10/3 [ { ratio } declare 1 /i ] compile-1 ] unit-test