]> gitweb.factorcode.org Git - factor.git/commitdiff
compiler.cfg.intrinsics.allot: clean up
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 17 Jul 2010 00:04:03 +0000 (20:04 -0400)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Sat, 17 Jul 2010 00:04:03 +0000 (20:04 -0400)
basis/compiler/cfg/builder/alien/boxing/boxing.factor
basis/compiler/cfg/intrinsics/allot/allot.factor

index 0234c128085f480c9f68db6bf8c4b04f2658d61d..abfad6a451c4863219480f020664928c502fb1d3 100644 (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 )
index 1b7e183b7941bb26bdf45662b9fb2f0622bfe0bd..72816bde7f52d83ae7265f13aa50b86387515a82 100644 (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 ;