box elements of struct-arrays when a struct class is used as the element type
parent
6d65bc593f
commit
e9a0c96563
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 ;
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue