diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index ca0c5df0fa..3102d75a4e 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -21,7 +21,7 @@ M: ##slot temp-vregs temp>> 1array ; M: ##set-slot temp-vregs temp>> 1array ; M: ##string-nth temp-vregs temp>> 1array ; M: ##set-string-nth-fast temp-vregs temp>> 1array ; -M: ##box-displaced-alien temp-vregs temp>> 1array ; +M: ##box-displaced-alien temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ; M: ##compare temp-vregs temp>> 1array ; M: ##compare-imm temp-vregs temp>> 1array ; M: ##compare-float temp-vregs temp>> 1array ; diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index 1eb7c01671..2d79cbebc3 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -58,7 +58,7 @@ IN: compiler.cfg.hats : ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline : ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline : ^^box-displaced-alien ( base displacement base-class -- dst ) - ^^r3 [ next-vreg ] dip ##box-displaced-alien ; inline + ^^r3 [ next-vreg next-vreg ] dip ##box-displaced-alien ; inline : ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline : ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ; : ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index eb358f0437..a7cc2e0603 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -126,7 +126,7 @@ INSN: ##unbox-float < ##unary ; INSN: ##unbox-any-c-ptr < ##unary/temp ; INSN: ##box-float < ##unary/temp ; INSN: ##box-alien < ##unary/temp ; -INSN: ##box-displaced-alien < ##binary temp base-class ; +INSN: ##box-displaced-alien < ##binary temp1 temp2 base-class ; : ##unbox-f ( dst src -- ) drop 0 ##load-immediate ; : ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ; diff --git a/basis/compiler/cfg/renaming/functor/functor.factor b/basis/compiler/cfg/renaming/functor/functor.factor index 05e1015432..b307155091 100644 --- a/basis/compiler/cfg/renaming/functor/functor.factor +++ b/basis/compiler/cfg/renaming/functor/functor.factor @@ -141,7 +141,9 @@ M: ##set-string-nth-fast rename-insn-temps TEMP-QUOT change-temp drop ; M: ##box-displaced-alien rename-insn-temps - TEMP-QUOT change-temp drop ; + TEMP-QUOT change-temp1 + TEMP-QUOT change-temp2 + drop ; M: ##compare rename-insn-temps TEMP-QUOT change-temp drop ; diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor index 7de2ff6c52..4b071ba5e2 100644 --- a/basis/compiler/cfg/representations/preferred/preferred.factor +++ b/basis/compiler/cfg/representations/preferred/preferred.factor @@ -25,7 +25,7 @@ M: ##slot temp-vreg-reps drop { int-rep } ; M: ##set-slot temp-vreg-reps drop { int-rep } ; M: ##string-nth temp-vreg-reps drop { int-rep } ; M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ; -M: ##box-displaced-alien temp-vreg-reps drop { int-rep } ; +M: ##box-displaced-alien temp-vreg-reps drop { int-rep int-rep } ; M: ##compare temp-vreg-reps drop { int-rep } ; M: ##compare-imm temp-vreg-reps drop { int-rep } ; M: ##compare-float temp-vreg-reps drop { int-rep } ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 83d7341a8e..00a36cc55f 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -193,7 +193,7 @@ M: ##box-float generate-insn dst/src/temp %box-float ; M: ##box-alien generate-insn dst/src/temp %box-alien ; M: ##box-displaced-alien generate-insn - [ dst/src1/src2 ] [ temp>> ] bi %box-displaced-alien ; + [ dst/src1/src2 ] [ temp1>> ] [ temp2>> ] tri %box-displaced-alien ; M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ; M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ; diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 23d26b0033..988164143f 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -519,6 +519,14 @@ cell 8 = [ underlying>> ] unit-test +[ ALIEN: 1234 ALIEN: 2234 ] [ + ALIEN: 234 [ + { c-ptr } declare + [ 1000 swap ] + [ 2000 swap ] bi + ] compile-call +] unit-test + [ B{ 0 0 0 0 } [ { byte-array } declare ] compile-call ] must-fail diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 35772f1b1a..c1c54be321 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -126,7 +126,7 @@ HOOK: %unbox-float cpu ( dst src -- ) HOOK: %unbox-any-c-ptr cpu ( dst src temp -- ) HOOK: %box-float cpu ( dst src temp -- ) HOOK: %box-alien cpu ( dst src temp -- ) -HOOK: %box-displaced-alien cpu ( dst displacement base temp -- ) +HOOK: %box-displaced-alien cpu ( dst displacement base temp1 temp2 -- ) HOOK: %alien-unsigned-1 cpu ( dst src -- ) HOOK: %alien-unsigned-2 cpu ( dst src -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index d21f5756b9..33619ca3e3 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -335,7 +335,7 @@ M:: ppc %box-alien ( dst src temp -- ) "f" resolve-label ] with-scope ; -M:: ppc %box-displaced-alien ( dst displacement base temp -- ) +M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- ) [ "end" define-label "ok" define-label @@ -343,7 +343,12 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- ) dst base MR 0 displacement 0 CMPI "end" get BEQ + ! Quickly use displacement' before its needed for real, as allot temporary + displacement' :> temp + dst 4 cells alien temp %allot ! If base is already a displaced alien, unpack it + base' base MR + displacement' displacement MR 0 base \ f tag-number CMPI "ok" get BEQ temp base header-offset LWZ @@ -351,11 +356,17 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- ) "ok" get BNE ! displacement += base.displacement temp base 3 alien@ LWZ - displacement displacement temp ADD + displacement' displacement temp ADD ! base = base.base - base base 1 alien@ LWZ + base' base 1 alien@ LWZ "ok" resolve-label - dst displacement base temp %allot-alien + ! Store underlying-alien slot + base' dst 1 alien@ STW + ! Store offset + displacement' dst 3 alien@ STW + ! Store expired slot (its ok to clobber displacement') + temp \ f tag-number %load-immediate + temp dst 2 alien@ STW "end" resolve-label ] with-scope ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index da7b89de0b..630be55c67 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -278,7 +278,7 @@ M:: x86 %box-alien ( dst src temp -- ) "end" resolve-label ] with-scope ; -M:: x86 %box-displaced-alien ( dst displacement base temp -- ) +M:: x86 %box-displaced-alien ( dst displacement base displacement' base' -- ) [ "end" define-label "ok" define-label @@ -286,17 +286,23 @@ M:: x86 %box-displaced-alien ( dst displacement base temp -- ) dst base MOV displacement 0 CMP "end" get JE + ! Quickly use displacement' before its needed for real, as allot temporary + dst 4 cells alien displacement' %allot ! If base is already a displaced alien, unpack it + base' base MOV + displacement' displacement MOV base \ f tag-number CMP "ok" get JE base header-offset [+] alien type-number tag-fixnum CMP "ok" get JNE ! displacement += base.displacement - displacement base 3 alien@ ADD + displacement' base 3 alien@ ADD ! base = base.base - base base 1 alien@ MOV + base' base 1 alien@ MOV "ok" resolve-label - dst displacement base temp %allot-alien + dst 1 alien@ base' MOV ! alien + dst 2 alien@ \ f tag-number MOV ! expired + dst 3 alien@ displacement' MOV ! displacement "end" resolve-label ] with-scope ; diff --git a/basis/struct-arrays/struct-arrays-tests.factor b/basis/struct-arrays/struct-arrays-tests.factor index 64639c7ca1..a57bb0259c 100755 --- a/basis/struct-arrays/struct-arrays-tests.factor +++ b/basis/struct-arrays/struct-arrays-tests.factor @@ -44,3 +44,10 @@ STRUCT: test-struct-array S{ test-struct-array f 20 20 } } second ] unit-test + +! Regression +STRUCT: fixed-string { text char[100] } ; + +[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [ + ALIEN: 123 4 fixed-string [ (underlying)>> ] { } map-as +] unit-test