Temporary fixes for x86-32 until FFI boxing is rewritten

diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor
index 7f42bdf3229459704c211af813db7dfad3c06e8b..d3bcbd351719dc342a9bbc688a496eb6f0def6ce 100644 (file)
--- a/basis/compiler/cfg/builder/alien/alien.factor
+++ b/basis/compiler/cfg/builder/alien/alien.factor
@@ -64,8 +64,7 @@ M:: struct-c-type unbox-parameter ( src c-type -- )
     ] when ;\r
 \r
 : (objects>registers) ( vregs -- )\r
-    ! Place instructions in reverse order, so that the\r
-    ! ##store-stack-param instructions come first. This ensures\r
+    ! Place ##store-stack-param instructions first. This ensures\r
     ! that no registers are used after the ##store-reg-param\r
     ! instructions.\r
     [\r
@@ -73,7 +72,7 @@ M:: struct-c-type unbox-parameter ( src c-type -- )
         [ [ alloc-stack-param ] keep \ ##store-stack-param new-insn ]\r
         [ [ next-reg-param ] keep \ ##store-reg-param new-insn ]\r
         if\r
-    ] map reverse % ;\r
+    ] map [ ##store-stack-param? ] partition [ % ] bi@ ;\r
 \r
 : objects>registers ( params -- stack-size )\r
     [ abi>> ] [ parameters>> ] [ return>> ] tri\r
@@ -230,8 +229,20 @@ GENERIC: flatten-c-type ( type -- reps )
 \r
 M: struct-c-type flatten-c-type\r
     flatten-struct-type [ first2 [ drop stack-params ] when ] map ;\r
+    \r
 M: long-long-type flatten-c-type drop { int-rep int-rep } ;\r
-M: c-type flatten-c-type rep>> 1array ;\r
+\r
+M: c-type flatten-c-type\r
+    rep>> {\r
+        { int-rep [ { int-rep } ] }\r
+        { float-rep [ float-on-stack? { stack-params } { float-rep } ? ] }\r
+        { double-rep [\r
+            float-on-stack?\r
+            cell 4 = { stack-params stack-params } { stack-params } ?\r
+            { double-rep } ?\r
+        ] }\r
+    } case ;\r
+    \r
 M: object flatten-c-type base-type flatten-c-type ;\r
 \r
 : flatten-c-types ( types -- reps )\r

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 2d9f845c57e7b161f30d2ab13f7a28aa90c4fe7a..3aa1f6735643bb1e356ff7c0e9908e9c81794bf0 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -552,6 +552,9 @@ HOOK: dummy-fp-params? cpu ( -- ? )
 ! If t, long longs are never passed in param regs
 HOOK: long-long-on-stack? cpu ( -- ? )
 
+! If t, floats are never passed in param regs
+HOOK: float-on-stack? cpu ( -- ? )
+
 ! If t, the struct return pointer is never passed in a param reg
 HOOK: struct-return-on-stack? cpu ( -- ? )
 

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 68957e0f5fd5cb1e4e26993520b0d9dc40baff40..bbd304ee47601d779b1be2b2108874e645d54af7 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -7,6 +7,7 @@ command-line make words compiler compiler.units
 compiler.constants compiler.alien compiler.codegen
 compiler.codegen.fixup compiler.cfg.instructions
 compiler.cfg.builder compiler.cfg.builder.alien
+compiler.cfg.builder.alien.params
 compiler.cfg.intrinsics compiler.cfg.stack-frame
 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
 cpu.architecture vm ;
@@ -116,11 +117,37 @@ M: stack-params store-return-reg drop EAX MOV ;
 M: int-rep load-return-reg drop EAX swap MOV ;
 M: int-rep store-return-reg drop EAX MOV ;
 
-M: float-rep load-return-reg drop FLDS ;
-M: float-rep store-return-reg drop FSTPS ;
-
-M: double-rep load-return-reg drop FLDL ;
-M: double-rep store-return-reg drop FSTPL ;
+:: load-float-return ( src x87-insn sse-insn -- )
+    src register? [
+        ESP 4 SUB
+        ESP [] src sse-insn execute
+        ESP [] x87-insn execute
+        ESP 4 ADD
+    ] [
+        src x87-insn execute
+    ] if ; inline
+
+:: store-float-return ( dst x87-insn sse-insn -- )
+    dst register? [
+        ESP 4 SUB
+        ESP [] x87-insn execute
+        dst ESP [] sse-insn execute
+        ESP 4 ADD
+    ] [
+        dst x87-insn execute
+    ] if ; inline
+
+M: float-rep load-return-reg
+    drop \ FLDS \ MOVSS load-float-return ;
+
+M: float-rep store-return-reg
+    drop \ FSTPS \ MOVSS store-float-return ;
+
+M: double-rep load-return-reg
+    drop \ FLDL \ MOVSD load-float-return ;
+
+M: double-rep store-return-reg
+    drop \ FSTPL \ MOVSD store-float-return ;
 
 M: x86.32 %prologue ( n -- )
     dup PUSH
@@ -138,9 +165,12 @@ M: x86.32 %prepare-jump
 
 M:: x86.32 %unbox ( dst src func rep -- )
     src func call-unbox-func
-    dst rep reg-class-of return-reg rep %copy ;
+    dst ?spill-slot rep store-return-reg ;
+
+M:: x86.32 %store-return ( src rep -- )
+    src ?spill-slot rep load-return-reg ;
 
-M:: x86.32 %store-long-long-return ( src1 src2 n func -- )
+M:: x86.32 %store-long-long-return ( src1 src2 -- )
     src2 EAX = [ src1 src2 XCHG src2 src1 ] [ src1 src2 ] if :> ( src1 src2 )
     EAX src1 int-rep %copy
     EDX src2 int-rep %copy ;
@@ -256,9 +286,9 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
     bi and ;
 
 : stack-arg-size ( params -- n )
-    dup abi>> '[
+    dup abi>> [
         alien-parameters flatten-c-types
-        [ _ alloc-parameter 2drop ] each
+        [ alloc-parameter 2drop ] each
         stack-params get
     ] with-param-regs ;
 
@@ -289,7 +319,10 @@ M: x86.32 dummy-fp-params? f ;
 
 M: x86.32 long-long-on-stack? t ;
 
-M: x86.32 structs-on-stack? t ;
+M: x86.32 float-on-stack? t ;
+
+M: x86.32 flatten-struct-type
+    stack-size cell /i { int-rep t } <repetition> ;
 
 M: x86.32 struct-return-on-stack? os linux? not ;
 

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 3721c17cf4332e3bcc53b14a222b11dde30384dc..0a4396188883abef2f2742e867044012559e6b58 100644 (file)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -124,6 +124,9 @@ M:: x86.64 %unbox ( dst src func rep -- )
         { float-regs [ float-regs get pop swap MOVSD ] }
     } case ;
 
+M:: x86.64 %store-return ( src rep -- )
+    rep reg-class-of return-reg src rep %copy ;
+
 M:: x86.64 %store-struct-return ( src c-type -- )
     ! Move src to R11 so that we don't clobber it.
     R11 src int-rep %copy
@@ -220,6 +223,8 @@ M:: x86.64 %call-gc ( gc-roots -- )
 
 M: x86.64 long-long-on-stack? f ;
 
+M: x86.64 float-on-stack? f ;
+
 M: x86.64 struct-return-on-stack? f ;
 
 ! The result of reading 4 bytes from memory is a fixnum on

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index bdf325a8264b46a2cafd9eab820bf95f4d84736f..78e613179525c6b3957bdec0fd20a4cfca1d4d8f 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1458,9 +1458,6 @@ M:: x86 %store-reg-param ( src reg rep -- )
 M:: x86 %store-stack-param ( src n rep -- )
     n param@ src rep %copy ;
 
-M:: x86 %store-return ( src rep -- )
-    rep reg-class-of return-reg src rep %copy ;
-
 HOOK: struct-return@ cpu ( n -- operand )
 
 M: x86 %prepare-struct-area ( dst -- )