alien.marshall.*: replace &free in marshallers with free in unmarshallers

db4
Jeremy Hughes 2009-07-08 14:00:48 +12:00
parent bc6e5de911
commit 60f847ea4c
3 changed files with 90 additions and 101 deletions

View File

@ -11,7 +11,7 @@ specialized-arrays.long specialized-arrays.longlong
specialized-arrays.short specialized-arrays.uchar
specialized-arrays.uint specialized-arrays.ulong
specialized-arrays.ulonglong specialized-arrays.ushort strings
unix.utilities vocabs.parser words ;
unix.utilities vocabs.parser words libc.private ;
IN: alien.marshall
<< primitive-types [ "void*" = not ] filter
@ -47,9 +47,6 @@ M: struct-wrapper dynamic-cast ;
: marshall-char*-or-string ( n/string -- alien )
[ (marshall-char*-or-string) ] ptr-pass-through ;
: marshall-char*-or-string-free ( n/string -- alien )
[ (marshall-char*-or-string) &free ] ptr-pass-through ;
: (marshall-char**-or-strings) ( seq -- alien )
dup first string?
[ utf8 strings>alien malloc-byte-array ]
@ -58,9 +55,6 @@ M: struct-wrapper dynamic-cast ;
: marshall-char**-or-strings ( n/string -- alien )
[ (marshall-char**-or-strings) ] ptr-pass-through ;
: marshall-char**-or-strings-free ( n/string -- alien )
[ (marshall-char**-or-strings) &free ] ptr-pass-through ;
: primitive-marshaller ( type -- quot/f )
{
{ "bool" [ [ marshall-bool ] ] }
@ -76,65 +70,6 @@ M: struct-wrapper dynamic-cast ;
{ "ulong" [ [ marshall-ulonglong ] ] }
{ "float" [ [ marshall-float ] ] }
{ "double" [ [ marshall-double ] ] }
{ "bool*" [ [ marshall-bool*-free ] ] }
{ "char*" [ [ marshall-char*-or-string-free ] ] }
{ "uchar*" [ [ marshall-uchar*-free ] ] }
{ "short*" [ [ marshall-short*-free ] ] }
{ "ushort*" [ [ marshall-ushort*-free ] ] }
{ "int*" [ [ marshall-int*-free ] ] }
{ "uint*" [ [ marshall-uint*-free ] ] }
{ "long*" [ [ marshall-long*-free ] ] }
{ "ulong*" [ [ marshall-ulong*-free ] ] }
{ "longlong*" [ [ marshall-longlong*-free ] ] }
{ "ulonglong*" [ [ marshall-ulonglong*-free ] ] }
{ "float*" [ [ marshall-float*-free ] ] }
{ "double*" [ [ marshall-double*-free ] ] }
{ "bool&" [ [ marshall-bool*-free ] ] }
{ "char&" [ [ marshall-char*-free ] ] }
{ "uchar&" [ [ marshall-uchar*-free ] ] }
{ "short&" [ [ marshall-short*-free ] ] }
{ "ushort&" [ [ marshall-ushort*-free ] ] }
{ "int&" [ [ marshall-int*-free ] ] }
{ "uint&" [ [ marshall-uint*-free ] ] }
{ "long&" [ [ marshall-long*-free ] ] }
{ "ulong&" [ [ marshall-ulong*-free ] ] }
{ "longlong&" [ [ marshall-longlong*-free ] ] }
{ "ulonglong&" [ [ marshall-ulonglong*-free ] ] }
{ "float&" [ [ marshall-float*-free ] ] }
{ "double&" [ [ marshall-double*-free ] ] }
{ "void*" [ [ marshall-void* ] ] }
{ "bool**" [ [ marshall-bool**-free ] ] }
{ "char**" [ [ marshall-char**-or-strings-free ] ] }
{ "uchar**" [ [ marshall-uchar**-free ] ] }
{ "short**" [ [ marshall-short**-free ] ] }
{ "ushort**" [ [ marshall-ushort**-free ] ] }
{ "int**" [ [ marshall-int**-free ] ] }
{ "uint**" [ [ marshall-uint**-free ] ] }
{ "long**" [ [ marshall-long**-free ] ] }
{ "ulong**" [ [ marshall-ulong**-free ] ] }
{ "longlong**" [ [ marshall-longlong**-free ] ] }
{ "ulonglong**" [ [ marshall-ulonglong**-free ] ] }
{ "float**" [ [ marshall-float**-free ] ] }
{ "double**" [ [ marshall-double**-free ] ] }
{ "void**" [ [ marshall-void** ] ] }
[ drop f ]
} case ;
: struct-primitive-marshaller ( type -- quot/f )
{
{ "bool" [ [ marshall-bool ] ] }
{ "char" [ [ marshall-char ] ] }
{ "uchar" [ [ marshall-uchar ] ] }
{ "short" [ [ marshall-short ] ] }
{ "ushort" [ [ marshall-ushort ] ] }
{ "int" [ [ marshall-int ] ] }
{ "uint" [ [ marshall-uint ] ] }
{ "long" [ [ marshall-long ] ] }
{ "ulong" [ [ marshall-ulong ] ] }
{ "longlong" [ [ marshall-longlong ] ] }
{ "ulonglong" [ [ marshall-ulonglong ] ] }
{ "float" [ [ marshall-float ] ] }
{ "double" [ [ marshall-double ] ] }
{ "bool*" [ [ marshall-bool* ] ] }
{ "char*" [ [ marshall-char*-or-string ] ] }
{ "uchar*" [ [ marshall-uchar* ] ] }
@ -195,17 +130,13 @@ M: struct-wrapper dynamic-cast ;
[ [ marshall-non-pointer ] ] if
] if* ;
: struct-field-marshaller ( type -- quot )
factorize-type dup struct-primitive-marshaller [ nip ] [
pointer?
[ [ marshall-pointer ] ]
[ [ marshall-non-pointer ] ] if
] if* ;
: unmarshall-char*-to-string ( alien -- string )
utf8 alien>string ;
: unmarshall-char*-to-string-free ( alien -- string )
[ unmarshall-char*-to-string ] keep add-malloc free ;
: unmarshall-bool ( n -- ? )
0 = not ;
@ -224,32 +155,76 @@ M: struct-wrapper dynamic-cast ;
{ "ulonglong" [ [ ] ] }
{ "float" [ [ ] ] }
{ "double" [ [ ] ] }
{ "bool*" [ [ *bool ] ] }
{ "bool*" [ [ unmarshall-bool*-free ] ] }
{ "char*" [ [ unmarshall-char*-to-string-free ] ] }
{ "uchar*" [ [ unmarshall-uchar*-free ] ] }
{ "short*" [ [ unmarshall-short*-free ] ] }
{ "ushort*" [ [ unmarshall-ushort*-free ] ] }
{ "int*" [ [ unmarshall-int*-free ] ] }
{ "uint*" [ [ unmarshall-uint*-free ] ] }
{ "long*" [ [ unmarshall-long*-free ] ] }
{ "ulong*" [ [ unmarshall-ulong*-free ] ] }
{ "longlong*" [ [ unmarshall-long*-free ] ] }
{ "ulonglong*" [ [ unmarshall-ulong*-free ] ] }
{ "float*" [ [ unmarshall-float*-free ] ] }
{ "double*" [ [ unmarshall-double*-free ] ] }
{ "bool&" [ [ unmarshall-bool*-free ] ] }
{ "char&" [ [ unmarshall-char*-free ] ] }
{ "uchar&" [ [ unmarshall-uchar*-free ] ] }
{ "short&" [ [ unmarshall-short*-free ] ] }
{ "ushort&" [ [ unmarshall-ushort*-free ] ] }
{ "int&" [ [ unmarshall-int*-free ] ] }
{ "uint&" [ [ unmarshall-uint*-free ] ] }
{ "long&" [ [ unmarshall-long*-free ] ] }
{ "ulong&" [ [ unmarshall-ulong*-free ] ] }
{ "longlong&" [ [ unmarshall-longlong*-free ] ] }
{ "ulonglong&" [ [ unmarshall-ulonglong*-free ] ] }
{ "float&" [ [ unmarshall-float*-free ] ] }
{ "double&" [ [ unmarshall-double*-free ] ] }
[ drop f ]
} case ;
: struct-primitive-unmarshaller ( type -- quot/f )
{
{ "bool" [ [ unmarshall-bool ] ] }
{ "char" [ [ ] ] }
{ "uchar" [ [ ] ] }
{ "short" [ [ ] ] }
{ "ushort" [ [ ] ] }
{ "int" [ [ ] ] }
{ "uint" [ [ ] ] }
{ "long" [ [ ] ] }
{ "ulong" [ [ ] ] }
{ "longlong" [ [ ] ] }
{ "ulonglong" [ [ ] ] }
{ "float" [ [ ] ] }
{ "double" [ [ ] ] }
{ "bool*" [ [ unmarshall-bool* ] ] }
{ "char*" [ [ unmarshall-char*-to-string ] ] }
{ "uchar*" [ [ *uchar ] ] }
{ "short*" [ [ *short ] ] }
{ "ushort*" [ [ *ushort ] ] }
{ "int*" [ [ *int ] ] }
{ "uint*" [ [ *uint ] ] }
{ "long*" [ [ *long ] ] }
{ "ulong*" [ [ *ulong ] ] }
{ "longlong*" [ [ *long ] ] }
{ "ulonglong*" [ [ *ulong ] ] }
{ "float*" [ [ *float ] ] }
{ "double*" [ [ *double ] ] }
{ "bool&" [ [ *bool ] ] }
{ "char&" [ [ *char ] ] }
{ "uchar&" [ [ *uchar ] ] }
{ "short&" [ [ *short ] ] }
{ "ushort&" [ [ *ushort ] ] }
{ "int&" [ [ *int ] ] }
{ "uint&" [ [ *uint ] ] }
{ "long&" [ [ *long ] ] }
{ "ulong&" [ [ *ulong ] ] }
{ "longlong&" [ [ *long ] ] }
{ "ulonglong&" [ [ *ulong ] ] }
{ "float&" [ [ *float ] ] }
{ "double&" [ [ *double ] ] }
{ "uchar*" [ [ unmarshall-uchar* ] ] }
{ "short*" [ [ unmarshall-short* ] ] }
{ "ushort*" [ [ unmarshall-ushort* ] ] }
{ "int*" [ [ unmarshall-int* ] ] }
{ "uint*" [ [ unmarshall-uint* ] ] }
{ "long*" [ [ unmarshall-long* ] ] }
{ "ulong*" [ [ unmarshall-ulong* ] ] }
{ "longlong*" [ [ unmarshall-long* ] ] }
{ "ulonglong*" [ [ unmarshall-ulong* ] ] }
{ "float*" [ [ unmarshall-float* ] ] }
{ "double*" [ [ unmarshall-double* ] ] }
{ "bool&" [ [ unmarshall-bool* ] ] }
{ "char&" [ [ unmarshall-char* ] ] }
{ "uchar&" [ [ unmarshall-uchar* ] ] }
{ "short&" [ [ unmarshall-short* ] ] }
{ "ushort&" [ [ unmarshall-ushort* ] ] }
{ "int&" [ [ unmarshall-int* ] ] }
{ "uint&" [ [ unmarshall-uint* ] ] }
{ "long&" [ [ unmarshall-long* ] ] }
{ "ulong&" [ [ unmarshall-ulong* ] ] }
{ "longlong&" [ [ unmarshall-longlong* ] ] }
{ "ulonglong&" [ [ unmarshall-ulonglong* ] ] }
{ "float&" [ [ unmarshall-float* ] ] }
{ "double&" [ [ unmarshall-double* ] ] }
[ drop f ]
} case ;
@ -276,6 +251,13 @@ M: struct-wrapper dynamic-cast ;
[ struct-unmarshaller ] if
] if* ;
: struct-field-unmarshaller ( type -- quot )
factorize-type dup struct-primitive-unmarshaller [ nip ] [
dup pointer?
[ pointer-unmarshaller ]
[ struct-unmarshaller ] if
] if* ;
: out-arg-unmarshaller ( type -- quot )
dup {
[ pointer-to-const? not ]

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.inline arrays
combinators fry functors kernel lexer libc macros math
sequences specialized-arrays.alien ;
sequences specialized-arrays.alien libc.private ;
IN: alien.marshall.private
: bool>arg ( ? -- 1/0/obj )
@ -23,6 +23,7 @@ MACRO: marshall-x* ( num-quot seq-quot -- alien )
FUNCTOR: define-primitive-marshallers ( TYPE -- )
<TYPE> IS <${TYPE}>
*TYPE IS *${TYPE}
>TYPE-array IS >${TYPE}-array
marshall-TYPE DEFINES marshall-${TYPE}
(marshall-TYPE*) DEFINES (marshall-${TYPE}*)
@ -31,6 +32,8 @@ marshall-TYPE* DEFINES marshall-${TYPE}*
marshall-TYPE** DEFINES marshall-${TYPE}**
marshall-TYPE*-free DEFINES marshall-${TYPE}*-free
marshall-TYPE**-free DEFINES marshall-${TYPE}**-free
unmarshall-TYPE* DEFINES unmarshall-${TYPE}*
unmarshall-TYPE*-free DEFINES unmarshall-${TYPE}*-free
WHERE
: marshall-TYPE ( n -- byte-array )
[ bool>arg ] ptr-pass-through ;
@ -49,6 +52,10 @@ WHERE
[ (marshall-TYPE*) &free ] ptr-pass-through ;
: marshall-TYPE**-free ( seq -- alien )
[ (marshall-TYPE**) &free ] ptr-pass-through ;
: unmarshall-TYPE* ( alien -- n )
*TYPE ; inline
: unmarshall-TYPE*-free ( alien -- n )
[ unmarshall-TYPE* ] keep add-malloc free ;
;FUNCTOR
SYNTAX: PRIMITIVE-MARSHALLERS:

View File

@ -20,9 +20,9 @@ C-MARSHALLED: unsigned-long* outarg2 ( unsigned-long a, unsigned-long* b )
;C-LIBRARY
{ 1 1 } [ outarg1 ] must-infer-as
[ 3 ] [ [ 1 outarg1 ] with-destructors ] unit-test
[ 3 ] [ 1 outarg1 ] unit-test
{ 2 2 } [ outarg2 ] must-infer-as
[ 18 15 ] [ [ 3 5 outarg2 ] with-destructors ] unit-test
[ 18 15 ] [ 3 5 outarg2 ] unit-test
DELETE-C-LIBRARY: test