diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 4306be61b5..8f2071a0dc 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -298,6 +298,14 @@ M:: ppc %binary-float-function ( dst src1 src2 func -- ) func f %alien-invoke dst float-function-return ; +! Internal format is always double-precision on PowerPC +M: ppc %single>double-float 2drop ; + +M: ppc %double>single-float 2drop ; + +M: ppc %unbox-alien ( dst src -- ) + alien-offset LWZ ; + M:: ppc %unbox-any-c-ptr ( dst src temp -- ) [ { "is-byte-array" "end" "start" } [ define-label ] each @@ -540,6 +548,7 @@ M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ; M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- ) src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1 dst temp branch1 branch2 (%boolean) ; + M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- ) src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1 dst temp branch1 branch2 (%boolean) ; @@ -559,7 +568,7 @@ M:: ppc %compare-branch ( label src1 src2 cc -- ) label cc %branch ; M:: ppc %compare-imm-branch ( label src1 src2 cc -- ) - src1 src2 (%compare) + src1 src2 (%compare-imm) label cc %branch ; :: (%branch) ( label branch1 branch2 -- ) @@ -571,7 +580,7 @@ M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- ) label branch1 branch2 (%branch) ; M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- ) - cc src1 src2 \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1 + src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1 label branch1 branch2 (%branch) ; : load-from-frame ( dst n rep -- ) diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor index 905e83dbdb..08a7621e88 100644 --- a/basis/math/floats/env/env-tests.factor +++ b/basis/math/floats/env/env-tests.factor @@ -102,31 +102,6 @@ set-default-fp-env -1.0 3.0 /f double>bits ] unit-test -[ - HEX: 0000,0000,0000,07e8 -] [ - +denormal-keep+ [ - 10.0 -320.0 ^ double>bits - ] with-denormal-mode -] unit-test - -[ - HEX: 0000,0000,0000,0000 -] [ - +denormal-flush+ [ - 10.0 -320.0 ^ double>bits - ] with-denormal-mode -] unit-test - -! ensure denormal mode is restored to +denormal-keep+ -[ - HEX: 0000,0000,0000,07e8 -] [ - +denormal-keep+ [ - 10.0 -320.0 ^ double>bits - ] with-denormal-mode -] unit-test - [ { +fp-zero-divide+ } [ 1.0 0.0 /f ] with-fp-traps ] must-fail [ { +fp-inexact+ } [ 1.0 3.0 /f ] with-fp-traps ] must-fail [ { +fp-invalid-operation+ } [ -1.0 fsqrt ] with-fp-traps ] must-fail @@ -136,6 +111,11 @@ set-default-fp-env ! Ensure traps get cleared [ 1/0. ] [ 1.0 0.0 /f ] unit-test +! Ensure state is back to normal +[ +round-nearest+ ] [ rounding-mode ] unit-test +[ +denormal-keep+ ] [ denormal-mode ] unit-test +[ { } ] [ fp-traps ] unit-test + ! In case the tests screw up the FP env because of bugs in math.floats.env set-default-fp-env diff --git a/vm/cpu-x86.32.S b/vm/cpu-x86.32.S index f308bf0b92..0c4166cfe5 100644 --- a/vm/cpu-x86.32.S +++ b/vm/cpu-x86.32.S @@ -75,12 +75,8 @@ DEF(void,get_x87_env,(void*)): DEF(void,set_x87_env,(const void*)): movl 4(%esp), %eax - fldcw 2(%eax) - movb 4(%eax), %dl - test %dl, %dl - jz 1f fnclex -1: + fldcw 2(%eax) ret #include "cpu-x86.S"