Merge branch 'master' of git://factorcode.org/git/factor

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 -- )

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
 

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"