From 8efedbae269656a1397ec22b005bed3d2bffc2bd Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 13 Sep 2008 20:27:48 -0500
Subject: [PATCH 1/3] Fix tags
---
extra/morse/tags.txt | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/morse/tags.txt b/extra/morse/tags.txt
index 33a9488b16..1e107f52e4 100644
--- a/extra/morse/tags.txt
+++ b/extra/morse/tags.txt
@@ -1 +1 @@
-example
+examples
From 722cacddb485fa5c951ae4bf162c19e696a55b52 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 13 Sep 2008 20:28:13 -0500
Subject: [PATCH 2/3] Fixing some problems with returning structs by value in
x86.64 FFI
---
basis/alien/structs/structs.factor | 12 +-
basis/compiler/generator/generator.factor | 28 ++--
basis/compiler/tests/alien.factor | 106 +++++++++++++
basis/cpu/architecture/architecture.factor | 14 +-
.../cpu/ppc/architecture/architecture.factor | 7 +-
basis/cpu/x86/32/32.factor | 141 ++++++++++--------
basis/cpu/x86/64/64.factor | 128 +++++++++-------
.../cpu/x86/architecture/architecture.factor | 15 --
vm/ffi_test.c | 45 ++++++
vm/ffi_test.h | 16 ++
10 files changed, 349 insertions(+), 163 deletions(-)
diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index e82d663d08..ce30a2ee25 100755
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -18,20 +18,16 @@ M: struct-type c-type-align align>> ;
M: struct-type c-type-stack-align? drop f ;
M: struct-type unbox-parameter
- [ heap-size %unbox-struct ]
- [ unbox-parameter ]
- if-value-structs? ;
+ [ %unbox-struct ] [ unbox-parameter ] if-value-structs? ;
M: struct-type unbox-return
- f swap heap-size %unbox-struct ;
+ f swap %unbox-struct ;
M: struct-type box-parameter
- [ heap-size %box-struct ]
- [ box-parameter ]
- if-value-structs? ;
+ [ %box-struct ] [ box-parameter ] if-value-structs? ;
M: struct-type box-return
- f swap heap-size %box-struct ;
+ f swap %box-struct ;
M: struct-type stack-size
[ heap-size ] [ stack-size ] if-value-structs? ;
diff --git a/basis/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor
index 939d6e2276..0a9885357e 100755
--- a/basis/compiler/generator/generator.factor
+++ b/basis/compiler/generator/generator.factor
@@ -271,9 +271,7 @@ M: #return-recursive generate-node
! #alien-invoke
: large-struct? ( ctype -- ? )
- dup c-struct? [
- heap-size struct-small-enough? not
- ] [ drop f ] if ;
+ dup c-struct? [ struct-small-enough? not ] [ drop f ] if ;
: alien-parameters ( params -- seq )
dup parameters>>
@@ -304,10 +302,10 @@ M: #return-recursive generate-node
alien-parameters parameter-sizes drop ;
: alien-invoke-frame ( params -- n )
- #! One cell is temporary storage, temp@
- dup return>> return-size
- swap alien-stack-frame +
- cell + ;
+ #! Two cells for temporary storage, temp@ and on x86.64,
+ #! small struct return value unpacking
+ [ return>> return-size ] [ alien-stack-frame ] bi
+ + 2 cells + ;
: set-stack-frame ( n -- )
dup [ frame-required ] when* \ stack-frame set ;
@@ -361,17 +359,17 @@ M: float-regs inc-reg-class
[ spill-param ] [ fastcall-param ] if
[ param-reg ] keep ;
-: (flatten-int-type) ( size -- )
- cell /i "void*" c-type <repetition> % ;
+: (flatten-int-type) ( size -- types )
+ cell /i "void*" c-type <repetition> ;
-GENERIC: flatten-value-type ( type -- )
+GENERIC: flatten-value-type ( type -- types )
-M: object flatten-value-type , ;
+M: object flatten-value-type 1array ;
-M: struct-type flatten-value-type ( type -- )
+M: struct-type flatten-value-type ( type -- types )
stack-size cell align (flatten-int-type) ;
-M: long-long-type flatten-value-type ( type -- )
+M: long-long-type flatten-value-type ( type -- types )
stack-size cell align (flatten-int-type) ;
: flatten-value-types ( params -- params )
@@ -379,9 +377,9 @@ M: long-long-type flatten-value-type ( type -- )
[
0 [
c-type
- [ parameter-align (flatten-int-type) ] keep
+ [ parameter-align (flatten-int-type) % ] keep
[ stack-size cell align + ] keep
- flatten-value-type
+ flatten-value-type %
] reduce drop
] { } make ;
diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index dc73888796..635dd42532 100755
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -439,3 +439,109 @@ C-STRUCT: double-rect
[ 1.0 2.0 3.0 4.0 ]
[ 1.0 2.0 3.0 4.0 <double-rect> double-rect-test >double-rect< ] unit-test
+
+C-STRUCT: test_struct_14
+{ "double" "x1" }
+{ "double" "x2" } ;
+
+FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 ) ;
+
+[ 1.0 2.0 ] [
+ 1.0 2.0 ffi_test_40
+ [ test_struct_14-x1 ] [ test_struct_14-x2 ] bi
+] unit-test
+
+: callback-10 ( -- callback )
+ "test_struct_14" { "double" "double" } "cdecl"
+ [
+ "test_struct_14" <c-object>
+ [ set-test_struct_14-x2 ] keep
+ [ set-test_struct_14-x1 ] keep
+ ] alien-callback ;
+
+: callback-10-test ( x1 x2 callback -- result )
+ "test_struct_14" { "double" "double" } "cdecl" alien-indirect ;
+
+[ 1.0 2.0 ] [
+ 1.0 2.0 callback-10 callback-10-test
+ [ test_struct_14-x1 ] [ test_struct_14-x2 ] bi
+] unit-test
+
+FUNCTION: test-struct-12 ffi_test_41 ( int a, double x ) ;
+
+[ 1 2.0 ] [
+ 1 2.0 ffi_test_41
+ [ test-struct-12-a ] [ test-struct-12-x ] bi
+] unit-test
+
+: callback-11 ( -- callback )
+ "test-struct-12" { "int" "double" } "cdecl"
+ [
+ "test-struct-12" <c-object>
+ [ set-test-struct-12-x ] keep
+ [ set-test-struct-12-a ] keep
+ ] alien-callback ;
+
+: callback-11-test ( x1 x2 callback -- result )
+ "test-struct-12" { "int" "double" } "cdecl" alien-indirect ;
+
+[ 1 2.0 ] [
+ 1 2.0 callback-11 callback-11-test
+ [ test-struct-12-a ] [ test-struct-12-x ] bi
+] unit-test
+
+C-STRUCT: test_struct_15
+{ "float" "x" }
+{ "float" "y" } ;
+
+FUNCTION: test_struct_15 ffi_test_42 ( float x, float y ) ;
+
+[ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ test_struct_15-x ] [ test_struct_15-y ] bi ] unit-test
+
+: callback-12 ( -- callback )
+ "test_struct_15" { "float" "float" } "cdecl"
+ [
+ "test_struct_15" <c-object>
+ [ set-test_struct_15-y ] keep
+ [ set-test_struct_15-x ] keep
+ ] alien-callback ;
+
+: callback-12-test ( x1 x2 callback -- result )
+ "test_struct_15" { "float" "float" } "cdecl" alien-indirect ;
+
+[ 1.0 2.0 ] [
+ 1.0 2.0 callback-12 callback-12-test
+ [ test_struct_15-x ] [ test_struct_15-y ] bi
+] unit-test
+
+C-STRUCT: test_struct_16
+{ "float" "x" }
+{ "int" "a" } ;
+
+FUNCTION: test_struct_16 ffi_test_43 ( float x, int a ) ;
+
+[ 1.0 2 ] [ 1.0 2 ffi_test_43 [ test_struct_16-x ] [ test_struct_16-a ] bi ] unit-test
+
+: callback-13 ( -- callback )
+ "test_struct_16" { "float" "int" } "cdecl"
+ [
+ "test_struct_16" <c-object>
+ [ set-test_struct_16-a ] keep
+ [ set-test_struct_16-x ] keep
+ ] alien-callback ;
+
+: callback-13-test ( x1 x2 callback -- result )
+ "test_struct_16" { "float" "int" } "cdecl" alien-indirect ;
+
+[ 1.0 2 ] [
+ 1.0 2 callback-13 callback-13-test
+ [ test_struct_16-x ] [ test_struct_16-a ] bi
+] unit-test
+
+FUNCTION: test_struct_14 ffi_test_44 ( ) ; inline
+
+[ 1.0 2.0 ] [ ffi_test_44 [ test_struct_14-x1 ] [ test_struct_14-x2 ] bi ] unit-test
+
+: stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
+
+[ ] [ stack-frame-bustage 2drop ] unit-test
diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 432e748cbf..63c52d1025 100755
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -95,7 +95,7 @@ HOOK: %box-float cpu ( dst src -- )
HOOK: small-enough? cpu ( n -- ? )
! Is this structure small enough to be returned in registers?
-HOOK: struct-small-enough? cpu ( size -- ? )
+HOOK: struct-small-enough? cpu ( heap-size -- ? )
! Do we pass explode value structs?
HOOK: value-structs? cpu ( -- ? )
@@ -109,9 +109,9 @@ HOOK: %unbox cpu ( n reg-class func -- )
HOOK: %unbox-long-long cpu ( n func -- )
-HOOK: %unbox-small-struct cpu ( size -- )
+HOOK: %unbox-small-struct cpu ( c-type -- )
-HOOK: %unbox-large-struct cpu ( n size -- )
+HOOK: %unbox-large-struct cpu ( n c-type -- )
HOOK: %box cpu ( n reg-class func -- )
@@ -119,9 +119,9 @@ HOOK: %box-long-long cpu ( n func -- )
HOOK: %prepare-box-struct cpu ( size -- )
-HOOK: %box-small-struct cpu ( size -- )
+HOOK: %box-small-struct cpu ( c-type -- )
-HOOK: %box-large-struct cpu ( n size -- )
+HOOK: %box-large-struct cpu ( n c-type -- )
GENERIC: %save-param-reg ( stack reg reg-class -- )
@@ -169,14 +169,14 @@ PREDICATE: small-tagged < integer v>operand small-enough? ;
[ [ nip ] prepose ] dip if ;
inline
-: %unbox-struct ( n size -- )
+: %unbox-struct ( n c-type -- )
[
%unbox-small-struct
] [
%unbox-large-struct
] if-small-struct ;
-: %box-struct ( n size -- )
+: %box-struct ( n c-type -- )
[
%box-small-struct
] [
diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor
index 12fbbea82e..38ffe50bd6 100755
--- a/basis/cpu/ppc/architecture/architecture.factor
+++ b/basis/cpu/ppc/architecture/architecture.factor
@@ -195,10 +195,10 @@ M: ppc %unbox-long-long ( n func -- )
4 1 rot cell + local@ STW
] when* ;
-M: ppc %unbox-large-struct ( n size -- )
+M: ppc %unbox-large-struct ( n c-type -- )
! Value must be in r3
! Compute destination address
- 4 1 roll local@ ADDI
+ 4 1 roll heap-size local@ ADDI
! Load struct size
5 LI
! Call the function
@@ -227,8 +227,9 @@ M: ppc %prepare-box-struct ( size -- )
3 1 rot f struct-return@ ADDI
3 1 0 local@ STW ;
-M: ppc %box-large-struct ( n size -- )
+M: ppc %box-large-struct ( n c-type -- )
#! If n = f, then we're boxing a returned struct
+ heap-size
[ swap struct-return@ ] keep
! Compute destination address
3 1 roll ADDI
diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 5328f2a263..50d8025b38 100755
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -28,6 +28,10 @@ M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
M: x86.32 %alien-invoke (CALL) rel-dlsym ;
+M: x86.32 struct-small-enough? ( size -- ? )
+ heap-size { 1 2 4 8 } member?
+ os { linux netbsd solaris } member? not and ;
+
! On x86, parameters are never passed in registers.
M: int-regs return-reg drop EAX ;
M: int-regs param-regs drop { } ;
@@ -73,62 +77,6 @@ M: object %load-param-reg 3drop ;
M: object %save-param-reg 3drop ;
-M: x86.32 %prepare-unbox ( -- )
- #! Move top of data stack to EAX.
- EAX ESI [] MOV
- ESI 4 SUB ;
-
-: (%unbox) ( func -- )
- 4 [
- ! Push parameter
- EAX PUSH
- ! Call the unboxer
- f %alien-invoke
- ] with-aligned-stack ;
-
-M: x86.32 %unbox ( n reg-class func -- )
- #! The value being unboxed must already be in EAX.
- #! If n is f, we're unboxing a return value about to be
- #! returned by the callback. Otherwise, we're unboxing
- #! a parameter to a C function about to be called.
- (%unbox)
- ! Store the return value on the C stack
- over [ store-return-reg ] [ 2drop ] if ;
-
-M: x86.32 %unbox-long-long ( n func -- )
- (%unbox)
- ! Store the return value on the C stack
- [
- dup stack@ EAX MOV
- cell + stack@ EDX MOV
- ] when* ;
-
-M: x86.32 %unbox-struct-2
- #! Alien must be in EAX.
- 4 [
- EAX PUSH
- "alien_offset" f %alien-invoke
- ! Load second cell
- EDX EAX 4 [+] MOV
- ! Load first cell
- EAX EAX [] MOV
- ] with-aligned-stack ;
-
-M: x86.32 %unbox-large-struct ( n size -- )
- #! Alien must be in EAX.
- ! Compute destination address
- ECX ESP roll [+] LEA
- 12 [
- ! Push struct size
- PUSH
- ! Push destination address
- ECX PUSH
- ! Push source address
- EAX PUSH
- ! Copy the struct to the stack
- "to_value_struct" f %alien-invoke
- ] with-aligned-stack ;
-
: box@ ( n reg-class -- stack@ )
#! Used for callbacks; we want to box the values given to
#! us by the C function caller. Computes stack location of
@@ -172,8 +120,9 @@ M: x86.32 %box-long-long ( n func -- )
: struct-return@ ( size n -- n )
[ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ;
-M: x86.32 %box-large-struct ( n size -- )
+M: x86.32 %box-large-struct ( n c-type -- )
! Compute destination address
+ heap-size
[ swap struct-return@ ] keep
ECX ESP roll [+] LEA
8 [
@@ -191,7 +140,46 @@ M: x86.32 %prepare-box-struct ( size -- )
! Store it as the first parameter
ESP [] EAX MOV ;
-M: x86.32 %unbox-struct-1
+M: x86.32 %box-small-struct ( c-type -- )
+ #! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
+ 12 [
+ heap-size PUSH
+ EDX PUSH
+ EAX PUSH
+ "box_small_struct" f %alien-invoke
+ ] with-aligned-stack ;
+
+M: x86.32 %prepare-unbox ( -- )
+ #! Move top of data stack to EAX.
+ EAX ESI [] MOV
+ ESI 4 SUB ;
+
+: (%unbox) ( func -- )
+ 4 [
+ ! Push parameter
+ EAX PUSH
+ ! Call the unboxer
+ f %alien-invoke
+ ] with-aligned-stack ;
+
+M: x86.32 %unbox ( n reg-class func -- )
+ #! The value being unboxed must already be in EAX.
+ #! If n is f, we're unboxing a return value about to be
+ #! returned by the callback. Otherwise, we're unboxing
+ #! a parameter to a C function about to be called.
+ (%unbox)
+ ! Store the return value on the C stack
+ over [ store-return-reg ] [ 2drop ] if ;
+
+M: x86.32 %unbox-long-long ( n func -- )
+ (%unbox)
+ ! Store the return value on the C stack
+ [
+ dup stack@ EAX MOV
+ cell + stack@ EDX MOV
+ ] when* ;
+
+: %unbox-struct-1 ( -- )
#! Alien must be in EAX.
4 [
EAX PUSH
@@ -200,13 +188,38 @@ M: x86.32 %unbox-struct-1
EAX EAX [] MOV
] with-aligned-stack ;
-M: x86.32 %box-small-struct ( size -- )
- #! Box a <= 8-byte struct returned in EAX:DX. OS X only.
- 12 [
- PUSH
- EDX PUSH
+: %unbox-struct-2 ( -- )
+ #! Alien must be in EAX.
+ 4 [
EAX PUSH
- "box_small_struct" f %alien-invoke
+ "alien_offset" f %alien-invoke
+ ! Load second cell
+ EDX EAX 4 [+] MOV
+ ! Load first cell
+ EAX EAX [] MOV
+ ] with-aligned-stack ;
+
+M: x86 %unbox-small-struct ( size -- )
+ #! Alien must be in EAX.
+ heap-size cell align cell /i {
+ { 1 [ %unbox-struct-1 ] }
+ { 2 [ %unbox-struct-2 ] }
+ } case ;
+
+M: x86.32 %unbox-large-struct ( n c-type -- )
+ #! Alien must be in EAX.
+ heap-size
+ ! Compute destination address
+ ECX ESP roll [+] LEA
+ 12 [
+ ! Push struct size
+ PUSH
+ ! Push destination address
+ ECX PUSH
+ ! Push source address
+ EAX PUSH
+ ! Copy the struct to the stack
+ "to_value_struct" f %alien-invoke
] with-aligned-stack ;
M: x86.32 %prepare-alien-indirect ( -- )
diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index c135d0490d..01b8935e39 100755
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types arrays cpu.x86.assembler
cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
@@ -6,7 +6,7 @@ cpu.x86.allot cpu.architecture kernel kernel.private math
namespaces make sequences compiler.generator
compiler.generator.registers compiler.generator.fixup system
layouts alien alien.accessors alien.structs slots splitting
-assocs ;
+assocs combinators ;
IN: cpu.x86.64
M: x86.64 ds-reg R14 ;
@@ -48,6 +48,44 @@ M: stack-params %load-param-reg
M: stack-params %save-param-reg
>r stack-frame* + cell + swap r> %load-param-reg ;
+: with-return-regs ( quot -- )
+ [
+ V{ RDX RAX } clone int-regs set
+ V{ XMM1 XMM0 } clone float-regs set
+ call
+ ] with-scope ; inline
+
+! The ABI for passing structs by value is pretty messed up
+<< "void*" c-type clone "__stack_value" define-primitive-type
+stack-params "__stack_value" c-type (>>reg-class) >>
+
+: struct-types&offset ( struct-type -- pairs )
+ fields>> [
+ [ type>> ] [ offset>> ] bi 2array
+ ] map ;
+
+: split-struct ( pairs -- seq )
+ [
+ [ 8 mod zero? [ t , ] when , ] assoc-each
+ ] { } make { t } split harvest ;
+
+: flatten-small-struct ( c-type -- seq )
+ struct-types&offset split-struct [
+ [ c-type c-type-reg-class ] map
+ int-regs swap member? "void*" "double" ? c-type
+ ] map ;
+
+: flatten-large-struct ( c-type -- seq )
+ heap-size cell align
+ cell /i "__stack_value" c-type <repetition> ;
+
+M: struct-type flatten-value-type ( type -- seq )
+ dup heap-size 16 > [
+ flatten-large-struct
+ ] [
+ flatten-small-struct
+ ] if ;
+
M: x86.64 %prepare-unbox ( -- )
! First parameter is top of stack
RDI R14 [] MOV
@@ -62,22 +100,26 @@ M: x86.64 %unbox ( n reg-class func -- )
M: x86.64 %unbox-long-long ( n func -- )
int-regs swap %unbox ;
-M: x86.64 %unbox-struct-1 ( -- )
- #! Alien must be in RDI.
- "alien_offset" f %alien-invoke
- ! Load first cell
- RAX RAX [] MOV ;
+: %unbox-struct-field ( c-type i -- )
+ ! Alien must be in RDI.
+ RDI swap cells [+] swap reg-class>> {
+ { int-regs [ int-regs get pop swap MOV ] }
+ { double-float-regs [ float-regs get pop swap MOVSD ] }
+ } case ;
-M: x86.64 %unbox-struct-2 ( -- )
- #! Alien must be in RDI.
+M: x86.64 %unbox-small-struct ( c-type -- )
+ ! Alien must be in RDI.
"alien_offset" f %alien-invoke
- ! Load second cell
- RDX RAX cell [+] MOV
- ! Load first cell
- RAX RAX [] MOV ;
+ ! Move alien_offset() return value to RDI so that we don't
+ ! clobber it.
+ RDI RAX MOV
+ [
+ flatten-small-struct [ %unbox-struct-field ] each-index
+ ] with-return-regs ;
-M: x86.64 %unbox-large-struct ( n size -- )
+M: x86.64 %unbox-large-struct ( n c-type -- )
! Source is in RDI
+ heap-size
! Load destination address
RSI RSP roll [+] LEA
! Load structure size
@@ -100,20 +142,33 @@ M: x86.64 %box ( n reg-class func -- )
M: x86.64 %box-long-long ( n func -- )
int-regs swap %box ;
-M: x86.64 struct-small-enough? ( size -- ? ) 2 cells <= ;
+M: x86.64 struct-small-enough? ( size -- ? )
+ heap-size 2 cells <= ;
-M: x86.64 %box-small-struct ( size -- )
- #! Box a <= 16-byte struct returned in RAX:RDX.
- RDI RAX MOV
- RSI RDX MOV
- RDX swap MOV
- "box_small_struct" f %alien-invoke ;
+: box-struct-field@ ( i -- operand ) RSP swap 1+ cells [+] ;
+
+: %box-struct-field ( c-type i -- )
+ box-struct-field@ swap reg-class>> {
+ { int-regs [ int-regs get pop MOV ] }
+ { double-float-regs [ float-regs get pop MOVSD ] }
+ } case ;
+
+M: x86.64 %box-small-struct ( c-type -- )
+ #! Box a <= 16-byte struct.
+ [
+ [ flatten-small-struct [ %box-struct-field ] each-index ]
+ [ RDX swap heap-size MOV ] bi
+ RDI 0 box-struct-field@ MOV
+ RSI 1 box-struct-field@ MOV
+ "box_small_struct" f %alien-invoke
+ ] with-return-regs ;
: struct-return@ ( size n -- n )
[ ] [ \ stack-frame get swap - ] ?if ;
-M: x86.64 %box-large-struct ( n size -- )
+M: x86.64 %box-large-struct ( n c-type -- )
! Struct size is parameter 2
+ heap-size
RSI over MOV
! Compute destination address
swap struct-return@ RDI RSP rot [+] LEA
@@ -170,32 +225,3 @@ USE: cpu.x86.intrinsics
\ alien-signed-4 small-reg-32 define-signed-getter
\ set-alien-signed-4 small-reg-32 define-setter
-
-! The ABI for passing structs by value is pretty messed up
-<< "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>reg-class) >>
-
-: struct-types&offset ( struct-type -- pairs )
- fields>> [
- [ type>> ] [ offset>> ] bi 2array
- ] map ;
-
-: split-struct ( pairs -- seq )
- [
- [ 8 mod zero? [ t , ] when , ] assoc-each
- ] { } make { t } split harvest ;
-
-: flatten-large-struct ( type -- )
- heap-size cell align
- cell /i "__stack_value" c-type <repetition> % ;
-
-M: struct-type flatten-value-type ( type -- seq )
- dup heap-size 16 > [
- flatten-large-struct
- ] [
- struct-types&offset split-struct [
- [ c-type c-type-reg-class ] map
- int-regs swap member?
- "void*" "double" ? c-type ,
- ] each
- ] if ;
diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor
index 04b496f12a..c97552a649 100755
--- a/basis/cpu/x86/architecture/architecture.factor
+++ b/basis/cpu/x86/architecture/architecture.factor
@@ -139,21 +139,6 @@ M: x86 small-enough? ( n -- ? )
: temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
-HOOK: %unbox-struct-1 cpu ( -- )
-
-HOOK: %unbox-struct-2 cpu ( -- )
-
-M: x86 %unbox-small-struct ( size -- )
- #! Alien must be in EAX.
- cell align cell /i {
- { 1 [ %unbox-struct-1 ] }
- { 2 [ %unbox-struct-2 ] }
- } case ;
-
-M: x86 struct-small-enough? ( size -- ? )
- { 1 2 4 8 } member?
- os { linux netbsd solaris } member? not and ;
-
M: x86 %return ( -- ) 0 %unwind ;
! Alien intrinsics
diff --git a/vm/ffi_test.c b/vm/ffi_test.c
index 44a14f21f5..081ae42ebf 100755
--- a/vm/ffi_test.c
+++ b/vm/ffi_test.c
@@ -280,3 +280,48 @@ int ffi_test_39(long a, long b, struct test_struct_13 s)
if(a != b) abort();
return s.x1 + s.x2 + s.x3 + s.x4 + s.x5 + s.x6;
}
+
+struct test_struct_14 ffi_test_40(double x1, double x2)
+{
+ struct test_struct_14 retval;
+ retval.x1 = x1;
+ retval.x2 = x2;
+ printf("ffi_test_40(%f,%f)\n",x1,x2);
+ return retval;
+}
+
+struct test_struct_12 ffi_test_41(int a, double x)
+{
+ struct test_struct_12 retval;
+ retval.a = a;
+ retval.x = x;
+ printf("ffi_test_41(%d,%f)\n",a,x);
+ return retval;
+}
+
+struct test_struct_15 ffi_test_42(float x, float y)
+{
+ struct test_struct_15 retval;
+ retval.x = x;
+ retval.y = y;
+ printf("ffi_test_42(%f,%f)\n",x,y);
+ return retval;
+}
+
+struct test_struct_16 ffi_test_43(float x, int a)
+{
+ struct test_struct_16 retval;
+ retval.x = x;
+ retval.a = a;
+ printf("ffi_test_43(%f,%d)\n",x,a);
+ return retval;
+}
+
+struct test_struct_14 ffi_test_44(void)
+{
+ struct test_struct_14 retval;
+ retval.x1 = 1.0;
+ retval.x2 = 2.0;
+ //printf("ffi_test_44()\n");
+ return retval;
+}
diff --git a/vm/ffi_test.h b/vm/ffi_test.h
index 779cb97857..f9195a4285 100755
--- a/vm/ffi_test.h
+++ b/vm/ffi_test.h
@@ -71,3 +71,19 @@ DLLEXPORT unsigned long long ffi_test_38(unsigned long long x, unsigned long lon
struct test_struct_13 { float x1, x2, x3, x4, x5, x6; };
DLLEXPORT int ffi_test_39(long a, long b, struct test_struct_13 s);
+
+struct test_struct_14 { double x1, x2; };
+
+DLLEXPORT struct test_struct_14 ffi_test_40(double x1, double x2);
+
+DLLEXPORT struct test_struct_12 ffi_test_41(int a, double x);
+
+struct test_struct_15 { float x, y; };
+
+DLLEXPORT struct test_struct_15 ffi_test_42(float x, float y);
+
+struct test_struct_16 { float x; int a; };
+
+DLLEXPORT struct test_struct_16 ffi_test_43(float x, int a);
+
+DLLEXPORT struct test_struct_14 ffi_test_44();
From 2305117c213aa47cfaa80dd62f29df85cb4221fe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 13 Sep 2008 20:40:54 -0500
Subject: [PATCH 3/3] Fix PPC bootstrap
---
basis/cpu/ppc/architecture/architecture.factor | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor
index 38ffe50bd6..80ee1802e1 100755
--- a/basis/cpu/ppc/architecture/architecture.factor
+++ b/basis/cpu/ppc/architecture/architecture.factor
@@ -198,9 +198,9 @@ M: ppc %unbox-long-long ( n func -- )
M: ppc %unbox-large-struct ( n c-type -- )
! Value must be in r3
! Compute destination address
- 4 1 roll heap-size local@ ADDI
+ 4 1 roll local@ ADDI
! Load struct size
- 5 LI
+ heap-size 5 LI
! Call the function
"to_value_struct" f %alien-invoke ;