classes.struct: make <struct>, malloc-struct, and clone work in deployed images where C type info has been stripped out
parent
d8e10a691d
commit
2dd3f5690d
|
@ -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 -- )
|
||||||
[
|
[
|
||||||
|
|
Loading…
Reference in New Issue