From 60f847ea4c1f97feab94775a383078b80375cee7 Mon Sep 17 00:00:00 2001 From: Jeremy Hughes Date: Wed, 8 Jul 2009 14:00:48 +1200 Subject: [PATCH] alien.marshall.*: replace &free in marshallers with free in unmarshallers --- basis/alien/marshall/marshall.factor | 178 ++++++++---------- basis/alien/marshall/private/private.factor | 9 +- .../alien/marshall/syntax/syntax-tests.factor | 4 +- 3 files changed, 90 insertions(+), 101 deletions(-) diff --git a/basis/alien/marshall/marshall.factor b/basis/alien/marshall/marshall.factor index 1aa7a4bff2..5e52281f80 100644 --- a/basis/alien/marshall/marshall.factor +++ b/basis/alien/marshall/marshall.factor @@ -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 ] diff --git a/basis/alien/marshall/private/private.factor b/basis/alien/marshall/private/private.factor index 901d713009..869f50705b 100644 --- a/basis/alien/marshall/private/private.factor +++ b/basis/alien/marshall/private/private.factor @@ -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 -- ) 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: diff --git a/basis/alien/marshall/syntax/syntax-tests.factor b/basis/alien/marshall/syntax/syntax-tests.factor index f324d6b791..7a96245d12 100644 --- a/basis/alien/marshall/syntax/syntax-tests.factor +++ b/basis/alien/marshall/syntax/syntax-tests.factor @@ -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