alien.marshall.*: replace &free in marshallers with free in unmarshallers
Jeremy Hughes
parent
bc6e5de911
commit
60f847ea4c
basis/alien/marshall
|
|
@ -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 ]
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue