diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor index 0234c12808..abfad6a451 100644 --- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor +++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor @@ -118,7 +118,7 @@ M: long-long-type box ^^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 ) diff --git a/basis/compiler/cfg/intrinsics/allot/allot.factor b/basis/compiler/cfg/intrinsics/allot/allot.factor index 1b7e183b79..72816bde7f 100644 --- a/basis/compiler/cfg/intrinsics/allot/allot.factor +++ b/basis/compiler/cfg/intrinsics/allot/allot.factor @@ -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- ( node -- ) node node-input-infos first literal>> dup expand-? [ :> len - ds-drop len emit-allot-byte-array :> reg len reg zero-byte-array ] [ drop node emit-primitive ] if ;