compiler.cfg.builder.alien: use ##local-allot to fix value struct passing on Win64

diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
index 70a572b97fb309166f7a0fe7146046686673ff66..7c43a87fed0535d97a311f0cccac6876addf1ae3 100644 (file)
--- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor
+++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor
@@ -65,7 +65,13 @@ M: c-type unbox-parameter unbox ;
 
 M: long-long-type unbox-parameter unbox ;
 
-M: struct-c-type unbox-parameter frob-struct unbox ;
+M: struct-c-type unbox-parameter
+    dup value-struct? [ unbox ] [
+        [ nip heap-size f ^^local-allot dup ]
+        [ [ ^^unbox-any-c-ptr ] dip explode-struct keys ] 2bi
+        implode-struct
+        1array { { int-rep f } }
+    ] if ;
 
 GENERIC: unbox-return ( src c-type -- )
 
@@ -114,7 +120,10 @@ M: c-type box-parameter box ;
 
 M: long-long-type box-parameter box ;
 
-M: struct-c-type box-parameter frob-struct box ;
+M: struct-c-type box-parameter
+    dup value-struct?
+    [ [ [ drop first ] dip explode-struct keys ] keep ] unless
+    box ;
 
 GENERIC: box-return ( c-type -- dst )
 

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
index c106fb1774641d9901efd98556301b51e3252bf5..09bcf3e2819454e5d1b7a67c7722fad439a4849a 100755 (executable)
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -5,7 +5,8 @@ io.backend io.pathnames io.streams.string kernel
 math memory namespaces namespaces.private parser
 quotations sequences specialized-arrays stack-checker
 stack-checker.errors system threads tools.test words
-alien.complex concurrency.promises alien.data ;
+alien.complex concurrency.promises alien.data
+byte-arrays classes ;
 FROM: alien.c-types => float short ;
 SPECIALIZED-ARRAY: float
 SPECIALIZED-ARRAY: char
@@ -455,11 +456,11 @@ STRUCT: double-rect
     void { void* void* double-rect } cdecl alien-indirect
     "example" get-global ;
 
-[ 1.0 2.0 3.0 4.0 ]
+[ byte-array 1.0 2.0 3.0 4.0 ]
 [
     1.0 2.0 3.0 4.0 <double-rect>
     double-rect-callback double-rect-test
-    >double-rect<
+    [ >c-ptr class ] [ >double-rect< ] bi
 ] unit-test
 
 STRUCT: test_struct_14