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

compiler.cfg.intrinsics.allot: fix <byte-array> intrinsic for real. Don't ever check in code without testing it

db4
Slava Pestov 2010-05-05 13:17:20 -04:00
parent aaa706dd29
commit 07092df20b
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
basis/compiler/cfg/intrinsics/allot/allot.factor
View File

@ -4,7 +4,8 @@ USING: kernel math math.order sequences accessors arrays
byte-arrays layouts classes.tuple.private fry locals byte-arrays layouts classes.tuple.private fry locals
compiler.tree.propagation.info compiler.cfg.hats compiler.tree.propagation.info compiler.cfg.hats
compiler.cfg.instructions compiler.cfg.stacks compiler.cfg.instructions compiler.cfg.stacks
compiler.cfg.utilities compiler.cfg.builder.blocks ; compiler.cfg.utilities compiler.cfg.builder.blocks
compiler.constants cpu.architecture alien.c-types ;
IN: compiler.cfg.intrinsics.allot IN: compiler.cfg.intrinsics.allot
: ##set-slots ( regs obj class -- ) : ##set-slots ( regs obj class -- )
@ -73,10 +74,16 @@ IN: compiler.cfg.intrinsics.allot
dup node-input-infos first literal>> dup expand-(byte-array)? dup node-input-infos first literal>> dup expand-(byte-array)?
[ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ; [ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
:: zero-byte-array ( len reg -- )
0 ^^load-literal :> elt
reg ^^tagged>integer :> reg
len 3 + 4 /i iota [
[ elt reg ] dip 4 * byte-array-offset + int-rep uint ##store-memory-imm
] each ;
:: emit-<byte-array> ( node -- ) :: emit-<byte-array> ( node -- )
node node-input-infos first literal>> dup expand-<byte-array>? [ node node-input-infos first literal>> dup expand-<byte-array>? [
:> len :> len
0 ^^load-literal :> elt
len emit-allot-byte-array :> reg len emit-allot-byte-array :> reg
len cell align cell /i reg elt byte-array store-initial-element len reg zero-byte-array
] [ drop node emit-primitive ] if ; ] [ drop node emit-primitive ] if ;