1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.strings alien.c-types alien.accessors alien.structs
4 arrays words sequences math kernel namespaces fry libc cpu.architecture
8 UNION: value-type array struct-type ;
12 M: array c-type-class drop object ;
14 M: array c-type-boxed-class drop object ;
16 M: array heap-size unclip [ product ] [ heap-size ] bi* * ;
18 M: array c-type-align first c-type-align ;
20 M: array c-type-stack-align? drop f ;
22 M: array unbox-parameter drop "void*" unbox-parameter ;
24 M: array unbox-return drop "void*" unbox-return ;
26 M: array box-parameter drop "void*" box-parameter ;
28 M: array box-return drop "void*" box-return ;
30 M: array stack-size drop "void*" stack-size ;
32 M: array c-type-boxer-quot
35 [ [ require-c-type-arrays ] keep ] bi*
36 [ <c-type-direct-array> ] 2curry ;
38 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
40 M: value-type c-type-rep drop int-rep ;
42 M: value-type c-type-getter
43 drop [ swap <displaced-alien> ] ;
45 M: value-type c-type-setter ( type -- quot )
46 [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
47 '[ @ swap @ _ memcpy ] ;
49 PREDICATE: string-type < pair
50 first2 [ "char*" = ] [ word? ] bi* and ;
52 M: string-type c-type ;
54 M: string-type c-type-class drop object ;
56 M: string-type c-type-boxed-class drop object ;
58 M: string-type heap-size
59 drop "void*" heap-size ;
61 M: string-type c-type-align
62 drop "void*" c-type-align ;
64 M: string-type c-type-stack-align?
65 drop "void*" c-type-stack-align? ;
67 M: string-type unbox-parameter
68 drop "void*" unbox-parameter ;
70 M: string-type unbox-return
71 drop "void*" unbox-return ;
73 M: string-type box-parameter
74 drop "void*" box-parameter ;
76 M: string-type box-return
77 drop "void*" box-return ;
79 M: string-type stack-size
80 drop "void*" stack-size ;
82 M: string-type c-type-rep
85 M: string-type c-type-boxer
86 drop "void*" c-type-boxer ;
88 M: string-type c-type-unboxer
89 drop "void*" c-type-unboxer ;
91 M: string-type c-type-boxer-quot
92 second '[ _ alien>string ] ;
94 M: string-type c-type-unboxer-quot
95 second '[ _ string>alien ] ;
97 M: string-type c-type-getter
100 M: string-type c-type-setter
101 drop [ set-alien-cell ] ;
103 { "char*" utf8 } "char*" typedef
104 "char*" "uchar*" typedef