Updated alien interface for x86

library/compiler/ppc/alien.factor

@@ -65,12 +65,6 @@ M: %alien-callback generate-node ( vop -- )
     3 0 input load-indirect
     "run_callback" f compile-c-call ;
 
-: do-returns ( quot -- )
-    { T{ int-regs } T{ float-regs f 8 } }
-    dup length [
-        rot [ >r [ cell * ] keep rot r> call ] keep
-    ] 2each ;
-
 : save-return 0 swap [ return-reg ] keep freg>stack ;
 : load-return 0 swap [ return-reg ] keep stack>freg ;
 

library/compiler/x86/alien.factor

@@ -4,22 +4,64 @@ IN: compiler-backend
 USING: alien assembler compiler inference kernel
 kernel-internals lists math memory namespaces words ;
 
-GENERIC: push-reg ( reg-class -- )
+GENERIC: push-return-reg ( reg-class -- )
+GENERIC: pop-return-reg ( reg-class -- )
 
-M: int-regs push-reg drop EAX PUSH ;
+M: int-regs push-return-reg drop EAX PUSH ;
+M: int-regs pop-return-reg drop EAX POP ;
 
-M: float-regs push-reg
+: FSTP 4 = [ FSTPS ] [ FSTPL ] if ;
-    ESP swap reg-size [ SUB  { ESP } ] keep
+
-    4 = [ FSTPS ] [ FSTPL ] if ;
+M: float-regs push-return-reg
+    ESP swap reg-size [ SUB  { ESP } ] keep FSTP ;
+
+: FLD 4 = [ FLDS ] [ FLDL ] if ;
+
+M: float-regs pop-return-reg
+	reg-size { ESP } over FLD ESP swap ADD ;
 
 M: %unbox generate-node
-    drop 2 input f compile-c-call  1 input push-reg ;
+    drop 2 input f compile-c-call  1 input push-return-reg ;
+
+M: %unbox-struct generate-node ( vop -- )
+    drop
+    ! Increase stack size
+    ESP 2 input SUB
+    ! Save destination address in EAX
+    EAX ESP MOV
+    ! Load struct size
+    2 input PUSH
+    ! Load destination address
+    EAX PUSH
+    ! Copy the struct to the stack
+    "unbox_value_struct" f compile-c-call
+    ! Clean up
+    EAX POP
+    ECX POP ;
 
 M: %box generate-node
     drop
-    0 input push-reg
+    1 input push-return-reg
+    2 input f compile-c-call
+    ESP 1 input reg-size ADD ;
+
+M: %alien-callback generate-node ( vop -- )
+    drop
+    EAX 0 input load-indirect
+    EAX PUSH
+    "run_callback" f compile-c-call
+    EAX POP ;
+
+M: %callback-value generate-node ( vop -- )
+    drop
+    ! Call the unboxer
     1 input f compile-c-call
-    ESP 0 input reg-size ADD ;
+    ! Save return register
+    0 input push-return-reg
+    ! Restore data/callstacks
+    "unnest_stacks" f compile-c-call
+    ! Restore return register
+    0 input pop-return-reg ;
 
 M: %cleanup generate-node
     drop 0 input dup zero? [ drop ] [ ESP swap ADD ] if ;

library/compiler/x86/assembler.factor

@@ -278,6 +278,10 @@ M: operand CMP OCT: 071 2-operand ;
 : FSTPS ( operand -- ) HEX: d9 assemble-1 (FSTP) ;
 : FSTPL ( operand -- ) HEX: dd assemble-1 (FSTP) ;
 
+: (FLD) BIN: 100 f HEX: 04 1-operand ;
+: FLDS ( operand -- ) HEX: d9 assemble-1 (FLD) ;
+: FLDL ( operand -- ) HEX: dd assemble-1 (FLD) ;
+
 ( SSE multimedia instructions )
 
 : 2-operand-sse ( dst src op1 op2 -- )