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

View File

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

View File

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

View File

@ -1,7 +1,7 @@
! 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 byte-arrays kernel libc USING: accessors alien alien.c-types alien.structs byte-arrays
math sequences sequences.private ; classes.struct kernel libc math sequences sequences.private ;
IN: struct-arrays IN: struct-arrays
: c-type-struct-class ( c-type -- class ) : c-type-struct-class ( c-type -- class )
@ -16,11 +16,14 @@ TUPLE: struct-array
M: struct-array length length>> ; M: struct-array length length>> ;
M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; 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 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 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 M: struct-array new-sequence
[ element-size>> [ * <byte-array> ] 2keep ] [ element-size>> [ * <byte-array> ] 2keep ]
@ -50,3 +53,14 @@ ERROR: bad-byte-array-length byte-array ;
[ heap-size calloc ] 2keep <direct-struct-array> ; inline [ heap-size calloc ] 2keep <direct-struct-array> ; inline
INSTANCE: struct-array sequence 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