float-regs cleanup

diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor
index f72bc15c882d8a4bb7894aef884b1c60acabc601..9c7a5316c0ef5f00b25d05575721ce45c84e7c12 100644 (file)
--- a/library/alien/c-types.factor
+++ b/library/alien/c-types.factor
@@ -214,7 +214,7 @@ global [ c-types nest drop ] bind
     cell "align" set
     "box_float" "boxer" set
     "unbox_float" "unboxer" set
-    << float-regs f >> "reg-class" set
+    << float-regs f 4 >> "reg-class" set
 ] "float" define-primitive-type
 
 [
@@ -224,7 +224,7 @@ global [ c-types nest drop ] bind
     cell 2 * "align" set
     "box_double" "boxer" set
     "unbox_double" "unboxer" set
-    << double-regs f >> "reg-class" set
+    << float-regs f 8 >> "reg-class" set
 ] "double" define-primitive-type
 
 ! FIXME for 64-bit platforms

diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor
index ea41fad2740001de2b918efd7d61046c2658d744..1d86aa8ca510bb3ea817fdbad2c3566fceb4b6dc 100644 (file)
--- a/library/alien/compiler.factor
+++ b/library/alien/compiler.factor
@@ -79,14 +79,17 @@ C: alien-node make-node ;
 
 : parameters alien-node-parameters reverse ;
 
+: c-aligned c-size cell align ;
+
 : stack-space ( parameters -- n )
-    0 swap [ c-size cell align + ] each ;
+    0 swap [ c-aligned + ] each ;
 
 : unbox-parameter ( n parameter -- node )
     c-type [ "unboxer" get "reg-class" get ] bind %unbox ;
 
-: unbox-parameters ( len params -- )
-    [ >r 1 - dup r> unbox-parameter ] map nip % ;
+: unbox-parameters ( params -- )
+    [ stack-space ] keep
+    [ [ c-aligned - dup ] keep unbox-parameter ] map nip % ;
 
 : load-parameter ( n parameter -- node )
     c-type "reg-class" swap hash
@@ -97,9 +100,8 @@ C: alien-node make-node ;
     [
         0 int-regs set
         0 float-regs set
-        0 double-regs set
         reverse 0 swap
-        [ dupd load-parameter >r 1 + r> ] map nip
+        [ 2dup load-parameter >r c-aligned + r> ] map nip
     ] with-scope % ;
 
 : linearize-parameters ( parameters -- )
@@ -108,8 +110,7 @@ C: alien-node make-node ;
     #! architectures where parameters are passed in registers
     #! (PowerPC).
     dup stack-space %parameters ,
-    [ length ] keep tuck
-    unbox-parameters load-parameters ;
+    dup unbox-parameters load-parameters ;
 
 : linearize-return ( return -- )
     alien-node-return dup "void" = [

diff --git a/library/compiler/ppc/alien.factor b/library/compiler/ppc/alien.factor
index f3dd15c020d91b4bc204a7fee94b91c860fe8ede..0799f8d831c32108025a6171a1e60d4d34da311e 100644 (file)
--- a/library/compiler/ppc/alien.factor
+++ b/library/compiler/ppc/alien.factor
@@ -7,7 +7,7 @@ M: %alien-invoke generate-node ( vop -- )
     dup vop-in-1 swap vop-in-2 load-library compile-c-call ;
 
 : stack-reserve 8 + 16 align ;
-: stack@ 3 + cell * ;
+: stack@ 12 + ;
 
 M: %parameters generate-node ( vop -- )
     vop-in-1 dup 0 =
@@ -21,13 +21,11 @@ M: int-regs store-insn drop STW ;
 M: int-regs return-reg drop 3 ;
 M: int-regs load-insn drop 3 + 1 rot LWZ ;
 
-M: float-regs store-insn drop STFS ;
+M: float-regs store-insn
+    float-regs-size 4 = [ STFS ] [ STFD ] ifte ;
 M: float-regs return-reg drop 1 ;
-M: float-regs load-insn drop 1 + 1 rot LFS ;
-
-M: double-regs store-insn drop STFD ;
-M: double-regs return-reg drop 1 ;
-M: double-regs load-insn drop 1 + 1 rot LFD ;
+M: float-regs load-insn
+    >r 1 + 1 rot r> float-regs-size 4 = [ LFS ] [ LFD ] ifte ;
 
 M: %unbox generate-node ( vop -- )
     [ vop-in-2 f compile-c-call ] keep

diff --git a/library/compiler/vops.factor b/library/compiler/vops.factor
index 5e14359be4d4013616f5a07c667dddf6ba5f6ff6..19492572edaab9ea62427174e2ca6d259b234125 100644 (file)
--- a/library/compiler/vops.factor
+++ b/library/compiler/vops.factor
@@ -23,8 +23,7 @@ TUPLE: vreg n ;
 
 ! Register classes
 TUPLE: int-regs ;
-TUPLE: float-regs ;
-TUPLE: double-regs ;
+TUPLE: float-regs size ;
 
 ! A virtual operation
 TUPLE: vop inputs outputs label ;

diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor
index d39e70d4e4d09e61c0442774718f2222c9e683dd..7f4b3e920f3875e8e2fd560a13b4c1652ebb8cdb 100644 (file)
--- a/library/compiler/x86/alien.factor
+++ b/library/compiler/x86/alien.factor
@@ -22,13 +22,10 @@ GENERIC: push-reg ( reg-class -- )
 M: int-regs reg-size drop cell ;
 M: int-regs push-reg drop EAX PUSH ;
 
-M: float-regs reg-size drop 4 ;
+M: float-regs reg-size float-reg-size ;
 M: float-regs push-reg
-    ESP swap reg-size SUB  [ ESP ] FSTPS ;
-
-M: double-regs reg-size drop 8 ;
-M: double-regs push-reg
-    ESP swap reg-size SUB  [ ESP ] FSTPL ;
+    ESP swap reg-size [ SUB  [ ESP ] ] keep
+    4 = [ FSTPS ] [ FSTPL ] ifte ;
 
 M: %unbox generate-node
     dup vop-in-2 f compile-c-call  vop-in-3 push-reg ;

diff --git a/library/test/crashes.factor b/library/test/crashes.factor
index 37a978ae792d3dfdce31431dcaa57e7826a93c71..894cf0affefc2d349c787e7948853994b6a2e97f 100644 (file)
--- a/library/test/crashes.factor
+++ b/library/test/crashes.factor
@@ -29,15 +29,3 @@ prettyprint sequences strings test vectors words ;
     full-gc
     full-gc
 ] unit-test
-
-! Out of memory handling
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop
-1000000 <vector> drop

diff --git a/native/float.c b/native/float.c
index 2c5f5237b1aca5c2b07a9fa0438c3d5563f56bce..d2064253593140077d1cb65f6092c689198e680d 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -27,6 +27,13 @@ void in_if_test(float x, int y, float z)
        printf("%f\n",z);
 }
 
+void in_id_test(double x, int y, double z)
+{
+       printf("%f\n",x);
+       printf("%d\n",y);
+       printf("%f\n",z);
+}
+
 double to_float(CELL tagged)
 {
        F_RATIO* r;