Fix setters for value struct slots and add unit test for this case; this fixes an io.mmap regression on Windows
parent
5af6c10eed
commit
a4a6885189
|
@ -26,7 +26,7 @@ M: array box-return drop "void*" box-return ;
|
||||||
|
|
||||||
M: array stack-size drop "void*" stack-size ;
|
M: array stack-size drop "void*" stack-size ;
|
||||||
|
|
||||||
M: array c-type-boxer-quot drop f ;
|
M: array c-type-boxer-quot drop [ ] ;
|
||||||
|
|
||||||
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
|
||||||
namespaces make parser sequences strings words assocs splitting
|
namespaces make parser sequences strings words assocs splitting
|
||||||
math.parser cpu.architecture alien alien.accessors quotations
|
math.parser cpu.architecture alien alien.accessors quotations
|
||||||
layouts system compiler.units io.files io.encodings.binary
|
layouts system compiler.units io.files io.encodings.binary
|
||||||
accessors combinators effects continuations fry call ;
|
accessors combinators effects continuations fry call classes ;
|
||||||
IN: alien.c-types
|
IN: alien.c-types
|
||||||
|
|
||||||
DEFER: <int>
|
DEFER: <int>
|
||||||
|
@ -13,18 +13,20 @@ DEFER: *char
|
||||||
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
|
: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
|
||||||
|
|
||||||
TUPLE: c-type
|
TUPLE: c-type
|
||||||
class
|
{ class class initial: object }
|
||||||
boxer boxer-quot unboxer unboxer-quot
|
boxer
|
||||||
getter setter
|
{ boxer-quot callable }
|
||||||
reg-class size align stack-align? ;
|
unboxer
|
||||||
|
{ unboxer-quot callable }
|
||||||
: new-c-type ( class -- type )
|
{ getter callable }
|
||||||
new
|
{ setter callable }
|
||||||
int-regs >>reg-class
|
{ reg-class initial: int-regs }
|
||||||
object >>class ; inline
|
size
|
||||||
|
align
|
||||||
|
stack-align? ;
|
||||||
|
|
||||||
: <c-type> ( -- type )
|
: <c-type> ( -- type )
|
||||||
\ c-type new-c-type ;
|
\ c-type new ;
|
||||||
|
|
||||||
SYMBOL: c-types
|
SYMBOL: c-types
|
||||||
|
|
||||||
|
@ -224,7 +226,7 @@ M: f byte-length drop 0 ;
|
||||||
TUPLE: long-long-type < c-type ;
|
TUPLE: long-long-type < c-type ;
|
||||||
|
|
||||||
: <long-long-type> ( -- type )
|
: <long-long-type> ( -- type )
|
||||||
long-long-type new-c-type ;
|
long-long-type new ;
|
||||||
|
|
||||||
M: long-long-type unbox-parameter ( n type -- )
|
M: long-long-type unbox-parameter ( n type -- )
|
||||||
c-type-unboxer %unbox-long-long ;
|
c-type-unboxer %unbox-long-long ;
|
||||||
|
|
|
@ -42,3 +42,18 @@ C-UNION: barx
|
||||||
[ ] [ \ foox-x "help" get execute ] unit-test
|
[ ] [ \ foox-x "help" get execute ] unit-test
|
||||||
[ ] [ \ set-foox-x "help" get execute ] unit-test
|
[ ] [ \ set-foox-x "help" get execute ] unit-test
|
||||||
] when
|
] when
|
||||||
|
|
||||||
|
C-STRUCT: nested
|
||||||
|
{ "int" "x" } ;
|
||||||
|
|
||||||
|
C-STRUCT: nested-2
|
||||||
|
{ "nested" "y" } ;
|
||||||
|
|
||||||
|
[ 4 ] [
|
||||||
|
"nested-2" <c-object>
|
||||||
|
"nested" <c-object>
|
||||||
|
4 over set-nested-x
|
||||||
|
over set-nested-2-y
|
||||||
|
nested-2-y
|
||||||
|
nested-x
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -2,10 +2,18 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
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 ;
|
||||||
IN: alien.structs
|
IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type size align fields boxer-quot unboxer-quot getter setter ;
|
TUPLE: struct-type
|
||||||
|
size
|
||||||
|
align
|
||||||
|
fields
|
||||||
|
{ boxer-quot callable }
|
||||||
|
{ unboxer-quot callable }
|
||||||
|
{ getter callable }
|
||||||
|
{ setter callable } ;
|
||||||
|
|
||||||
M: struct-type heap-size size>> ;
|
M: struct-type heap-size size>> ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue