1 ! Copyright (C) 2009 Jeremy Hughes.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.inline arrays
4 combinators fry functors kernel lexer libc macros math
5 sequences specialized-arrays.alien libc.private
6 combinators.short-circuit ;
7 IN: alien.marshall.private
9 : bool>arg ( ? -- 1/0/obj )
16 MACRO: marshall-x* ( num-quot seq-quot -- alien )
17 '[ bool>arg dup number? _ _ if ] ;
19 : ptr-pass-through ( obj quot -- alien )
20 over { [ c-ptr? ] [ ] } 1&& [ drop ] [ call ] if ; inline
22 : malloc-underlying ( obj -- alien )
23 underlying>> malloc-byte-array ;
25 FUNCTOR: define-primitive-marshallers ( TYPE -- )
28 >TYPE-array IS >${TYPE}-array
29 marshall-TYPE DEFINES marshall-${TYPE}
30 (marshall-TYPE*) DEFINES (marshall-${TYPE}*)
31 (marshall-TYPE**) DEFINES (marshall-${TYPE}**)
32 marshall-TYPE* DEFINES marshall-${TYPE}*
33 marshall-TYPE** DEFINES marshall-${TYPE}**
34 marshall-TYPE*-free DEFINES marshall-${TYPE}*-free
35 marshall-TYPE**-free DEFINES marshall-${TYPE}**-free
36 unmarshall-TYPE* DEFINES unmarshall-${TYPE}*
37 unmarshall-TYPE*-free DEFINES unmarshall-${TYPE}*-free
40 : (marshall-TYPE*) ( n/seq -- alien )
41 [ <TYPE> malloc-byte-array ]
42 [ >TYPE-array malloc-underlying ]
45 : marshall-TYPE* ( n/seq -- alien )
46 [ (marshall-TYPE*) ] ptr-pass-through ;
48 : (marshall-TYPE**) ( seq -- alien )
49 [ marshall-TYPE* ] void*-array{ } map-as malloc-underlying ;
51 : marshall-TYPE** ( seq -- alien )
52 [ (marshall-TYPE**) ] ptr-pass-through ;
53 : unmarshall-TYPE* ( alien -- n )
55 : unmarshall-TYPE*-free ( alien -- n )
56 [ unmarshall-TYPE* ] keep add-malloc free ;
59 SYNTAX: PRIMITIVE-MARSHALLERS:
60 ";" parse-tokens [ define-primitive-marshallers ] each ;