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

classes.struct: make <struct>, malloc-struct, and clone work in deployed images where C type info has been stripped out

db4
Slava Pestov 2009-08-30 20:13:54 -05:00
parent d8e10a691d
commit 2dd3f5690d
1 changed files with 19 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -46,9 +46,6 @@ M: struct equal?
dup struct-class? [ '[ _ boa ] ] [ drop f ] if dup struct-class? [ '[ _ boa ] ] [ drop f ] if
] 1 define-partial-eval ] 1 define-partial-eval
M: struct clone
[ >c-ptr ] [ byte-length memory>byte-array ] [ class memory>struct ] tri ;
<PRIVATE <PRIVATE
: (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien ) : (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
'[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline '[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline
@ -58,13 +55,13 @@ PRIVATE>
[ heap-size malloc ] keep memory>struct ; inline [ heap-size malloc ] keep memory>struct ; inline
: malloc-struct ( class -- struct ) : malloc-struct ( class -- struct )
[ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ; [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ; inline
: (struct) ( class -- struct ) : (struct) ( class -- struct )
[ heap-size (byte-array) ] keep memory>struct ; inline [ heap-size (byte-array) ] keep memory>struct ; inline
: <struct> ( class -- struct ) : <struct> ( class -- struct )
[ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ; [ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ; inline
MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) ) MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
[ [
@ -119,13 +116,23 @@ M: struct-class writer-quot
\ cleave [ ] 2sequence \ cleave [ ] 2sequence
\ output>array [ ] 2sequence ; \ output>array [ ] 2sequence ;
: define-inline-method ( class generic quot -- )
[ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ;
: (define-struct-slot-values-method) ( class -- ) : (define-struct-slot-values-method) ( class -- )
[ \ struct-slot-values create-method-in ] [ \ struct-slot-values ] [ struct-slot-values-quot ] bi
[ struct-slot-values-quot ] bi define ; define-inline-method ;
: (define-byte-length-method) ( class -- ) : (define-byte-length-method) ( class -- )
[ \ byte-length create-method-in ] [ \ byte-length ] [ heap-size \ drop swap [ ] 2sequence ] bi
[ heap-size \ drop swap [ ] 2sequence ] bi define ; define-inline-method ;
: clone-underlying ( struct -- byte-array )
[ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
: (define-clone-method) ( class -- )
[ \ clone ] [ \ clone-underlying swap \ memory>struct [ ] 3sequence ] bi
define-inline-method ;
: slot>field ( slot -- field ) : slot>field ( slot -- field )
field-spec new swap { field-spec new swap {
@ -207,7 +214,9 @@ M: struct-class heap-size
: (struct-methods) ( class -- ) : (struct-methods) ( class -- )
[ (define-struct-slot-values-method) ] [ (define-struct-slot-values-method) ]
[ (define-byte-length-method) ] bi ; [ (define-byte-length-method) ]
[ (define-clone-method) ]
tri ;
: (struct-word-props) ( class slots size align -- ) : (struct-word-props) ( class slots size align -- )
[ [