steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

struct-arrays: hack it up so that if the class name is a literal parameter for the constructor, then the array works in deployed apps even if not every call site of nth or set-nth is inlined on the array. Fixes tools.deploy.test.5 regression after kqueue was converted to use STRUCT:. Because of Dan's call(-inlining, no perf regression on struct-arrays benchmark!

db4
Slava Pestov 2009-08-31 05:42:28 -05:00
parent 6ed46177e9
commit 2e119a0ae7
1 changed files with 29 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
basis/struct-arrays/struct-arrays.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.structs byte-arrays USING: accessors alien alien.c-types alien.structs byte-arrays
classes.struct kernel libc math parser sequences sequences.private ; classes.struct kernel libc math parser sequences
sequences.private words fry memoize compiler.units ;
IN: struct-arrays IN: struct-arrays
: c-type-struct-class ( c-type -- class ) : c-type-struct-class ( c-type -- class )
@ -11,7 +12,8 @@ TUPLE: struct-array
{ underlying c-ptr read-only } { underlying c-ptr read-only }
{ length array-capacity read-only } { length array-capacity read-only }
{ element-size array-capacity read-only } { element-size array-capacity read-only }
{ class read-only } ; { class read-only }
{ ctor read-only } ;
M: struct-array length length>> ; inline M: struct-array length length>> ; inline
M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
@ -20,34 +22,46 @@ M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
[ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline [ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
M: struct-array nth-unsafe M: struct-array nth-unsafe
[ (nth-ptr) ] [ class>> dup struct-class? ] bi [ memory>struct ] [ drop ] if ; inline [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
M: struct-array set-nth-unsafe M: struct-array set-nth-unsafe
[ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
! Foldable memo word. This is an optimization; by precompiling a
! constructor for array elements, we avoid memory>struct's slow path.
MEMO: struct-element-constructor ( c-type -- word )
[
"struct-array-ctor" f <word>
[
swap dup struct-class?
[ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if
(( alien -- object )) define-inline
] keep
] with-compilation-unit ; foldable
: <direct-struct-array> ( alien length c-type -- struct-array )
[ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ]
tri struct-array boa ; inline
M: struct-array new-sequence M: struct-array new-sequence
[ element-size>> [ * (byte-array) ] 2keep ] [ element-size>> * (byte-array) ] [ length>> ] [ class>> ] tri
[ class>> ] bi struct-array boa ; inline <direct-struct-array> ; inline
M: struct-array resize ( n seq -- newseq ) M: struct-array resize ( n seq -- newseq )
[ [ element-size>> * ] [ underlying>> ] bi resize ] [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
[ [ element-size>> ] [ class>> ] bi ] 2bi <direct-struct-array> ; inline
struct-array boa ;
: <struct-array> ( length c-type -- struct-array ) : <struct-array> ( length c-type -- struct-array )
[ heap-size [ * <byte-array> ] 2keep ] [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; inline
[ c-type-struct-class ] bi struct-array boa ; inline
ERROR: bad-byte-array-length byte-array ; ERROR: bad-byte-array-length byte-array ;
: byte-array>struct-array ( byte-array c-type -- struct-array ) : byte-array>struct-array ( byte-array c-type -- struct-array )
[ heap-size [ [
heap-size
[ dup length ] dip /mod 0 = [ dup length ] dip /mod 0 =
[ drop bad-byte-array-length ] unless [ drop bad-byte-array-length ] unless
] keep ] [ c-type-struct-class ] bi struct-array boa ; inline ] keep <direct-struct-array> ; inline
: <direct-struct-array> ( alien length c-type -- struct-array )
[ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
: malloc-struct-array ( length c-type -- struct-array ) : malloc-struct-array ( length c-type -- struct-array )
[ heap-size calloc ] 2keep <direct-struct-array> ; inline [ heap-size calloc ] 2keep <direct-struct-array> ; inline