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 drop [ ] ;
34 M: array c-type-unboxer-quot drop [ >c-ptr ] ;
36 M: value-type c-type-rep drop int-rep ;
38 M: value-type c-type-getter
39 drop [ swap <displaced-alien> ] ;
41 M: value-type c-type-setter ( type -- quot )
42 [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
43 '[ @ swap @ _ memcpy ] ;
45 PREDICATE: string-type < pair
46 first2 [ "char*" = ] [ word? ] bi* and ;
48 M: string-type c-type ;
50 M: string-type c-type-class drop object ;
52 M: string-type c-type-boxed-class drop object ;
54 M: string-type heap-size
55 drop "void*" heap-size ;
57 M: string-type c-type-align
58 drop "void*" c-type-align ;
60 M: string-type c-type-stack-align?
61 drop "void*" c-type-stack-align? ;
63 M: string-type unbox-parameter
64 drop "void*" unbox-parameter ;
66 M: string-type unbox-return
67 drop "void*" unbox-return ;
69 M: string-type box-parameter
70 drop "void*" box-parameter ;
72 M: string-type box-return
73 drop "void*" box-return ;
75 M: string-type stack-size
76 drop "void*" stack-size ;
78 M: string-type c-type-rep
81 M: string-type c-type-boxer
82 drop "void*" c-type-boxer ;
84 M: string-type c-type-unboxer
85 drop "void*" c-type-unboxer ;
87 M: string-type c-type-boxer-quot
88 second '[ _ alien>string ] ;
90 M: string-type c-type-unboxer-quot
91 second '[ _ string>alien ] ;
93 M: string-type c-type-getter
96 M: string-type c-type-setter
97 drop [ set-alien-cell ] ;
99 { "char*" utf8 } "char*" typedef
100 "char*" "uchar*" typedef