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

box elements of struct-arrays when a struct class is used as the element type

Joe Groff 2009-08-26 17:19:30 -05:00
parent 6d65bc593f
commit e9a0c96563
3 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/alien/structs/structs.factor
View File

@ -3,7 +3,7 @@
USING: accessors arrays assocs generic hashtables kernel kernel.private
math namespaces parser sequences strings words libc fry
alien.c-types alien.structs.fields cpu.architecture math.order
quotations byte-arrays struct-arrays ;
quotations byte-arrays ;
IN: alien.structs
TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
@ -12,16 +12,6 @@ M: struct-type c-type ;
M: struct-type c-type-stack-align? drop f ;
M: struct-type <c-type-array> ( len c-type -- array )
dup c-type-array-constructor
[ execute( len -- array ) ]
[ <struct-array> ] ?if ; inline
M: struct-type <c-type-direct-array> ( alien len c-type -- array )
dup c-type-direct-array-constructor
[ execute( alien len -- array ) ]
[ <direct-struct-array> ] ?if ; inline
: if-value-struct ( ctype true false -- )
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline

18
basis/classes/struct/struct.factor
View File

@ -1,10 +1,10 @@
! (c)Joe Groff bsd license
USING: accessors alien alien.c-types alien.structs alien.structs.fields arrays
byte-arrays classes classes.parser classes.tuple
classes.tuple.parser classes.tuple.private combinators
combinators.smart fry generalizations generic.parser kernel
kernel.private lexer libc macros make math math.order parser
quotations sequences slots slots.private struct-arrays
USING: accessors alien alien.c-types alien.structs
alien.structs.fields arrays byte-arrays classes classes.parser
classes.tuple classes.tuple.parser classes.tuple.private
combinators combinators.smart fry generalizations generic.parser
kernel kernel.private lexer libc macros make math math.order
parser quotations sequences slots slots.private struct-arrays
vectors words ;
FROM: slots => reader-word writer-word ;
IN: classes.struct
@ -236,9 +236,9 @@ SYNTAX: STRUCT:
SYNTAX: UNION-STRUCT:
parse-struct-definition define-union-struct-class ;
SYNTAX: S{
scan-word dup struct-slots parse-tuple-literal-slots parsed ;
USING: vocabs vocabs.loader ;
"prettyprint" vocab [ "classes.struct.prettyprint" require ] when
SYNTAX: S{
scan-word dup struct-slots parse-tuple-literal-slots parsed ;

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

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types byte-arrays kernel libc
math sequences sequences.private ;
USING: accessors alien alien.c-types alien.structs byte-arrays
classes.struct kernel libc math sequences sequences.private ;
IN: struct-arrays
: c-type-struct-class ( c-type -- class )
@ -16,11 +16,14 @@ TUPLE: struct-array
M: struct-array length length>> ;
M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ;
: (nth-ptr) ( i struct-array -- alien )
[ element-size>> * ] [ underlying>> ] bi <displaced-alien> ; inline
M: struct-array nth-unsafe
[ element-size>> * ] [ underlying>> ] bi <displaced-alien> ;
[ (nth-ptr) ] [ class>> ] bi [ memory>struct ] when* ; inline
M: struct-array set-nth-unsafe
[ nth-unsafe swap ] [ element-size>> ] bi memcpy ;
[ (nth-ptr) swap ] [ element-size>> ] bi memcpy ;
M: struct-array new-sequence
[ element-size>> [ * <byte-array> ] 2keep ]
@ -50,3 +53,14 @@ ERROR: bad-byte-array-length byte-array ;
[ heap-size calloc ] 2keep <direct-struct-array> ; inline
INSTANCE: struct-array sequence
M: struct-type <c-type-array> ( len c-type -- array )
dup c-type-array-constructor
[ execute( len -- array ) ]
[ <struct-array> ] ?if ; inline
M: struct-type <c-type-direct-array> ( alien len c-type -- array )
dup c-type-direct-array-constructor
[ execute( alien len -- array ) ]
[ <direct-struct-array> ] ?if ; inline