%box-displaced-alien: fix clobberage found by Doug

diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index ca0c5df0fa217baf153de8ca30d7d4fc72263852..3102d75a4eced4f9bfcf670941c63082ef2748e6 100644 (file)
--- 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 1eb7c01671cd5a8174234eeaca37a41f67103a20..2d79cbebc3e492be1bc904d7c0f5482f49d56552 100644 (file)
--- 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 eb358f04377fc36ba5d89eab178b936c60072eb8..a7cc2e0603d725b5f536b21bb31c2b4ceaec7f1f 100644 (file)
--- 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 05e10154321537fef18dc5768b84009fe79f2aa4..b307155091d88128c67ef582750c7284ffb7811d 100644 (file)
--- 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 7de2ff6c52ee45d8f433404ad33b67ceea7dd49e..4b071ba5e24fced4a45c5c33dc0371c39e4e810b 100644 (file)
--- 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 83d7341a8e56ff20c55fd607f987a875430ca4b2..00a36cc55f08b4704c41353f84756b09b6db0610 100755 (executable)
--- 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 23d26b0033094ba1f9ac9abc771288620e34bdcf..988164143f53c9c2d6f2775359685009b6fe2188 100644 (file)
--- 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 <displaced-alien> ]
+        [ 2000 swap <displaced-alien> ] bi
+    ] compile-call
+] unit-test
+
 [
     B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
 ] must-fail

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 35772f1b1aa3ea91823f1a069749eda7ab5fbada..c1c54be3218a97986e08523c938a5e24c2971645 100644 (file)
--- 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 d21f5756b9a4e6b81139e3f44ceeb451a8fb2b83..33619ca3e35a73ca773ae2e147f61a84641f0d80 100644 (file)
--- 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 da7b89de0b4891e4d62be38c274110e40d75ab8b..630be55c67f473e79a3a3d8f746cbe48c5697f0a 100644 (file)
--- 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 64639c7ca1edfb836bcd40d5592e8ad789c78856..a57bb0259c540c4b0e5a8d29f9daa2b1be67cc73 100755 (executable)
--- 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 <direct-struct-array> [ (underlying)>> ] { } map-as
+] unit-test