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

basis/compiler/cfg/intrinsics/intrinsics.factor

@@ -109,7 +109,6 @@ IN: compiler.cfg.intrinsics
     } enable-intrinsics ;
 
 : enable-float-functions ( -- )
-    ! Everything except for fsqrt
     {
         { math.libm:facos [ drop "acos" emit-unary-float-function ] }
         { math.libm:fasin [ drop "asin" emit-unary-float-function ] }
@@ -127,6 +126,9 @@ IN: compiler.cfg.intrinsics
         { math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
         { math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }
         { math.libm:fatanh [ drop "atanh" emit-unary-float-function ] }
+        { math.libm:fsqrt [ drop "sqrt" emit-unary-float-function ] }
+        { math.floats.private:float-min [ drop "fmin" emit-binary-float-function ] }
+        { math.floats.private:float-max [ drop "fmax" emit-binary-float-function ] }
     } enable-intrinsics ;
 
 : enable-min/max ( -- )

basis/cpu/ppc/ppc.factor

@@ -281,6 +281,23 @@ M:: ppc %box-float ( dst src temp -- )
     dst 16 float temp %allot
     src dst float-offset STFD ;
 
+: float-function-param ( i spill-slot -- )
+    [ float-regs param-regs nth 1 ] [ n>> spill@ ] bi* LFD ;
+
+: float-function-return ( reg -- )
+    float-regs return-reg 2dup = [ 2drop ] [ FMR ] if ;
+
+M:: ppc %unary-float-function ( dst src func -- )
+    0 src float-function-param
+    func f %alien-invoke
+    dst float-function-return ;
+
+M:: ppc %binary-float-function ( dst src1 src2 func -- )
+    0 src1 float-function-param
+    1 src2 float-function-param
+    func f %alien-invoke
+    dst float-function-return ;
+
 M:: ppc %unbox-any-c-ptr ( dst src temp -- )
     [
         { "is-byte-array" "end" "start" } [ define-label ] each
@@ -338,7 +355,8 @@ M:: ppc %box-alien ( dst src temp -- )
 M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
     [
         "end" define-label
-        "ok" define-label
+        "alloc" define-label
+        "simple-case" define-label
         ! If displacement is zero, return the base
         dst base MR
         0 displacement 0 CMPI
@@ -347,19 +365,21 @@ M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
         displacement' :> temp
         dst 4 cells alien temp %allot
         ! If base is already a displaced alien, unpack it
-        base' base MR
-        displacement' displacement MR
         0 base \ f tag-number CMPI
-        "ok" get BEQ
+        "simple-case" get BEQ
         temp base header-offset LWZ
         0 temp alien type-number tag-fixnum CMPI
-        "ok" get BNE
+        "simple-case" get BNE
         ! displacement += base.displacement
         temp base 3 alien@ LWZ
         displacement' displacement temp ADD
         ! base = base.base
         base' base 1 alien@ LWZ
-        "ok" resolve-label
+        "alloc" get B
+        "simple-case" resolve-label
+        displacement' displacement MR
+        base' base MR
+        "alloc" resolve-label
         ! Store underlying-alien slot
         base' dst 1 alien@ STW
         ! Store offset
@@ -678,6 +698,8 @@ M: ppc %unbox-small-struct ( size -- )
         { 4 [ %unbox-struct-4 ] }
     } case ;
 
+enable-float-functions
+
 USE: vocabs.loader
 
 {

basis/cpu/x86/64/64.factor

@@ -218,12 +218,12 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
 ! x86-64.
 enable-alien-4-intrinsics
 
-! SSE2 is always available on x86-64.
-enable-sse2
-
 ! Enable fast calling of libc math functions
 enable-float-functions
 
+! SSE2 is always available on x86-64.
+enable-sse2
+
 USE: vocabs.loader
 
 {