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

compiler.cfg.intrinsics.allot: clean up

db4
Slava Pestov 2010-07-16 20:04:03 -04:00
parent e5dd21b0b9
commit e3edb2653d
2 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/cfg/builder/alien/boxing/boxing.factor
View File

@ -118,7 +118,7 @@ M: long-long-type box
<gc-map> ^^box-long-long ;
M: struct-c-type box
'[ _ heap-size emit-allot-byte-array dup ^^unbox-byte-array ] 2dip
'[ _ heap-size ^^allot-byte-array dup ^^unbox-byte-array ] 2dip
implode-struct ;
GENERIC: box-parameter ( vregs reps c-type -- dst )

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

@ -62,16 +62,15 @@ IN: compiler.cfg.intrinsics.allot
: bytes>cells ( m -- n ) cell align cell /i ;
: ^^allot-byte-array ( n -- dst )
16 + byte-array ^^allot ;
: ^^allot-byte-array ( len -- dst )
dup 16 + byte-array ^^allot [ byte-array store-length ] keep ;
: emit-allot-byte-array ( len -- dst )
dup ^^allot-byte-array
[ byte-array store-length ] [ ds-push ] [ ] tri ;
ds-drop ^^allot-byte-array dup ds-push ;
: emit-(byte-array) ( node -- )
dup node-input-infos first literal>> dup expand-(byte-array)?
[ nip ds-drop 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
@ -83,7 +82,6 @@ IN: compiler.cfg.intrinsics.allot
:: emit-<byte-array> ( node -- )
node node-input-infos first literal>> dup expand-<byte-array>? [
:> len
ds-drop
len emit-allot-byte-array :> reg
len reg zero-byte-array
] [ drop node emit-primitive ] if ;