1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.structs byte-arrays
4 classes classes.struct kernel libc math parser sequences
5 sequences.private words fry memoize compiler.units ;
9 { underlying c-ptr read-only }
10 { length array-capacity read-only }
11 { element-size array-capacity read-only }
17 : (nth-ptr) ( i struct-array -- alien )
18 [ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
20 : (struct-element-constructor) ( struct-class -- word )
22 "struct-array-ctor" f <word>
23 [ swap '[ _ memory>struct ] (( alien -- object )) define-inline ] keep
24 ] with-compilation-unit ;
26 ! Foldable memo word. This is an optimization; by precompiling a
27 ! constructor for array elements, we avoid memory>struct's slow path.
28 MEMO: struct-element-constructor ( struct-class -- word )
29 (struct-element-constructor) ; foldable
33 M: struct-array length length>> ; inline
35 M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
37 M: struct-array nth-unsafe
38 [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
40 M: struct-array set-nth-unsafe
41 [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
43 ERROR: not-a-struct-class struct-class ;
45 : <direct-struct-array> ( alien length struct-class -- struct-array )
46 dup struct-class? [ not-a-struct-class ] unless
47 [ heap-size ] [ ] [ struct-element-constructor ]
48 tri struct-array boa ; inline
50 M: struct-array new-sequence
51 [ element-size>> * (byte-array) ] [ class>> ] 2bi
52 <direct-struct-array> ; inline
54 M: struct-array resize ( n seq -- newseq )
55 [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
56 <direct-struct-array> ; inline
58 : <struct-array> ( length struct-class -- struct-array )
59 [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; inline
61 ERROR: bad-byte-array-length byte-array ;
63 : byte-array>struct-array ( byte-array c-type -- struct-array )
66 [ dup length ] dip /mod 0 =
67 [ drop bad-byte-array-length ] unless
68 ] keep <direct-struct-array> ; inline
70 : struct-array-on ( struct length -- struct-array )
71 [ [ >c-ptr ] [ class ] bi ] dip swap <direct-struct-array> ; inline
73 : malloc-struct-array ( length c-type -- struct-array )
74 [ heap-size calloc ] 2keep <direct-struct-array> ; inline
76 INSTANCE: struct-array sequence
78 M: struct-type <c-array> ( len c-type -- array )
79 dup c-array-constructor
80 [ execute( len -- array ) ]
81 [ <struct-array> ] ?if ; inline
83 M: struct-type <c-direct-array> ( alien len c-type -- array )
84 dup c-direct-array-constructor
85 [ execute( alien len -- array ) ]
86 [ <direct-struct-array> ] ?if ; inline
88 : >struct-array ( sequence class -- struct-array )
89 [ dup length ] dip <struct-array>
90 [ 0 swap copy ] keep ; inline
93 \ } scan-word [ >struct-array ] curry parse-literal ;
96 scan-word [ scan-object scan-object ] dip <direct-struct-array> parsed ;
98 USING: vocabs vocabs.loader ;
100 "prettyprint" vocab [ "struct-arrays.prettyprint" require ] when