box elements of struct-arrays when a struct class is used as the element type
							parent
							
								
									07ab5f006d
								
							
						
					
					
						commit
						24c2eaae01
					
				| 
						 | 
					@ -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