! (c)2009, 2010 Slava Pestov, Joe Groff bsd license
USING: accessors alien alien.c-types alien.arrays alien.strings
arrays byte-arrays cpu.architecture fry io io.encodings.binary
-io.files io.streams.memory kernel libc math sequences words ;
+io.files io.streams.memory kernel libc math sequences words
+macros ;
IN: alien.data
GENERIC: require-c-array ( c-type -- )
unclip [ array-length ] dip [ <c-direct-array> ] 2curry ;
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
+
+ERROR: local-allocation-error ;
+
+<PRIVATE
+
+: (local-allot) ( size -- alien ) local-allocation-error ;
+
+MACRO: (local-allots) ( c-types -- quot )
+ [ dup c-type-boxer-quot '[ _ heap-size (local-allot) @ ] ] map [ ] join ;
+
+PRIVATE>
+
+: with-scoped-allocation ( c-types quot -- )
+ [ (local-allots) ] dip call ; inline
compiler.cfg.comparisons ;
QUALIFIED: alien
QUALIFIED: alien.accessors
+QUALIFIED: alien.data.private
QUALIFIED: alien.c-types
QUALIFIED: kernel
QUALIFIED: arrays
{ byte-arrays:<byte-array> [ emit-<byte-array> ] }
{ byte-arrays:(byte-array) [ emit-(byte-array) ] }
{ kernel:<wrapper> [ emit-simple-allot ] }
+ { alien.data.private:(local-allot) [ emit-local-allot ] }
{ alien:<displaced-alien> [ emit-<displaced-alien> ] }
{ alien.accessors:alien-unsigned-1 [ int-rep alien.c-types:uchar emit-load-memory ] }
{ alien.accessors:set-alien-unsigned-1 [ int-rep alien.c-types:uchar emit-store-memory ] }
0 int-rep f ^^load-memory-imm
hashcode-shift ^^shr-imm
] unary-op ;
+
+: emit-local-allot ( node -- )
+ dup node-input-infos first literal>> dup integer?
+ [ nip ds-drop f ^^local-allot ^^box-alien ds-push ]
+ [ drop emit-primitive ]
+ if ;
math memory namespaces namespaces.private parser
quotations sequences specialized-arrays stack-checker
stack-checker.errors system threads tools.test words
-alien.complex concurrency.promises ;
+alien.complex concurrency.promises alien.data ;
FROM: alien.c-types => float short ;
SPECIALIZED-ARRAY: float
SPECIALIZED-ARRAY: char
[ S{ test-struct-11 f 7 -3 } ]
[ 3 4 7 fastcall-struct-return-iii-callback fastcall-struct-return-iii-indirect ] unit-test
+
+! Stack allocation
+: blah ( -- x ) { RECT } [ 1.5 >>x 2.0 >>y [ x>> ] [ y>> ] bi * >fixnum ] with-scoped-allocation ;
+
+[ 3 ] [ blah ] unit-test
classes.algebra combinators generic.math splitting fry locals
classes.tuple alien.accessors classes.tuple.private
slots.private definitions strings.private vectors hashtables
-generic quotations alien
+generic quotations alien alien.data.private
stack-checker.dependencies
compiler.tree.comparisons
compiler.tree.propagation.info
\ fixnum-max { fixnum fixnum } "input-classes" set-word-prop
\ fixnum-max [ interval-max ] [ fixnum-valued ] binary-op
+
+\ (local-allot) { alien } "default-output-classes" set-word-prop