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 ; <gc-map> ^^box-long-long ;
M: struct-c-type box 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 ; implode-struct ;
GENERIC: box-parameter ( vregs reps c-type -- dst ) 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 ; : bytes>cells ( m -- n ) cell align cell /i ;
: ^^allot-byte-array ( n -- dst ) : ^^allot-byte-array ( len -- dst )
16 + byte-array ^^allot ; dup 16 + byte-array ^^allot [ byte-array store-length ] keep ;
: emit-allot-byte-array ( len -- dst ) : emit-allot-byte-array ( len -- dst )
dup ^^allot-byte-array ds-drop ^^allot-byte-array dup ds-push ;
[ byte-array store-length ] [ ds-push ] [ ] tri ;
: emit-(byte-array) ( node -- ) : emit-(byte-array) ( node -- )
dup node-input-infos first literal>> dup expand-(byte-array)? 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 -- ) :: zero-byte-array ( len reg -- )
0 ^^load-literal :> elt 0 ^^load-literal :> elt
@ -83,7 +82,6 @@ IN: compiler.cfg.intrinsics.allot
:: 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
ds-drop
len emit-allot-byte-array :> reg len emit-allot-byte-array :> reg
len reg zero-byte-array len reg zero-byte-array
] [ drop node emit-primitive ] if ; ] [ drop node emit-primitive ] if ;