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

db4
Slava Pestov 2010-05-19 01:53:32 -04:00
parent 9730ec1707
commit 9e59192c73
2 changed files with 15 additions and 5 deletions

View File

@ -65,7 +65,13 @@ M: c-type unbox-parameter unbox ;
M: long-long-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 -- ) GENERIC: unbox-return ( src c-type -- )
@ -114,7 +120,10 @@ M: c-type box-parameter box ;
M: long-long-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 ) GENERIC: box-return ( c-type -- dst )

View File

@ -5,7 +5,8 @@ io.backend io.pathnames io.streams.string kernel
math memory namespaces namespaces.private parser math memory namespaces namespaces.private parser
quotations sequences specialized-arrays stack-checker quotations sequences specialized-arrays stack-checker
stack-checker.errors system threads tools.test words 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 ; FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: float SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char SPECIALIZED-ARRAY: char
@ -455,11 +456,11 @@ STRUCT: double-rect
void { void* void* double-rect } cdecl alien-indirect void { void* void* double-rect } cdecl alien-indirect
"example" get-global ; "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> 1.0 2.0 3.0 4.0 <double-rect>
double-rect-callback double-rect-test double-rect-callback double-rect-test
>double-rect< [ >c-ptr class ] [ >double-rect< ] bi
] unit-test ] unit-test
STRUCT: test_struct_14 STRUCT: test_struct_14