steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

alien.marshall: rewrote bool marshalling

db4
Jeremy Hughes 2009-07-14 10:21:32 +12:00
parent c0714c6135
commit c5e30fee3e
1 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
basis/alien/marshall/marshall.factor
View File

@ -14,8 +14,8 @@ specialized-arrays.ulonglong specialized-arrays.ushort strings
unix.utilities vocabs.parser words libc.private struct-arrays ; unix.utilities vocabs.parser words libc.private struct-arrays ;
IN: alien.marshall IN: alien.marshall
<< primitive-types [ "void*" = not ] filter << primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
[ define-primitive-marshallers ] each >> filter [ define-primitive-marshallers ] each >>
TUPLE: alien-wrapper { underlying alien } ; TUPLE: alien-wrapper { underlying alien } ;
TUPLE: struct-wrapper < alien-wrapper disposed ; TUPLE: struct-wrapper < alien-wrapper disposed ;
@ -56,6 +56,32 @@ M: struct-wrapper unmarshall-cast ;
: marshall-char**-or-strings ( n/string -- alien ) : marshall-char**-or-strings ( n/string -- alien )
[ (marshall-char**-or-strings) ] ptr-pass-through ; [ (marshall-char**-or-strings) ] ptr-pass-through ;
: marshall-bool ( ? -- n )
>boolean [ 1 ] [ 0 ] if ;
: (marshall-bool*) ( ?/seq -- alien )
[ marshall-bool <bool> malloc-byte-array ]
[ >bool-array malloc-underlying ]
marshall-x* ;
: marshall-bool* ( ?/seq -- alien )
[ (marshall-bool*) ] ptr-pass-through ;
: (marshall-bool**) ( seq -- alien )
[ marshall-bool* ] map >void*-array malloc-underlying ;
: marshall-bool** ( seq -- alien )
[ (marshall-bool**) ] ptr-pass-through ;
: unmarshall-bool ( n -- ? )
0 = not ;
: unmarshall-bool* ( alien -- ? )
*bool unmarshall-bool ;
: unmarshall-bool*-free ( alien -- ? )
[ *bool unmarshall-bool ] keep add-malloc free ;
: primitive-marshaller ( type -- quot/f ) : primitive-marshaller ( type -- quot/f )
{ {
{ "bool" [ [ marshall-bool ] ] } { "bool" [ [ marshall-bool ] ] }
@ -138,9 +164,6 @@ M: struct-wrapper unmarshall-cast ;
: unmarshall-char*-to-string-free ( alien -- string ) : unmarshall-char*-to-string-free ( alien -- string )
[ unmarshall-char*-to-string ] keep add-malloc free ; [ unmarshall-char*-to-string ] keep add-malloc free ;
: unmarshall-bool ( n -- ? )
0 = not ;
: primitive-unmarshaller ( type -- quot/f ) : primitive-unmarshaller ( type -- quot/f )
{ {
{ "bool" [ [ unmarshall-bool ] ] } { "bool" [ [ unmarshall-bool ] ] }