compiler: small fixes and cleanups

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
index 4a41129ef4171060341c2da620690f62b53db4ac..b0085c20325f8ddee2aee2aa64446cfb46461a7e 100644 (file)
--- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
@@ -1,6 +1,6 @@
 USING: arrays compiler.cfg.alias-analysis compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons
-cpu.architecture tools.test ;
+cpu.architecture tools.test byte-arrays layouts literals alien ;
 IN: compiler.cfg.alias-analysis.tests
 
 ! Redundant load elimination
@@ -242,3 +242,22 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##compare f 2 0 1 cc= }
     } alias-analysis-step
 ] unit-test
+
+! Make sure that input to ##box-displaced-alien becomes heap-ac
+[
+    V{
+        T{ ##allot f 1 16 byte-array }
+        T{ ##load-reference f 2 10 }
+        T{ ##box-displaced-alien f 3 2 1 4 byte-array }
+        T{ ##slot-imm f 5 3 1 $[ alien type-number ] }
+        T{ ##compare f 6 5 1 cc= }
+    }
+] [
+    V{
+        T{ ##allot f 1 16 byte-array }
+        T{ ##load-reference f 2 10 }
+        T{ ##box-displaced-alien f 3 2 1 4 byte-array }
+        T{ ##slot-imm f 5 3 1 $[ alien type-number ] }
+        T{ ##compare f 6 5 1 cc= }
+    } alias-analysis-step
+] unit-test

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
index 438395e2a7921d9ed0e6fa6df17ac6eff43ee8f9..e6ecefd665f0f5e14bef46f8b2240530439fc386 100644 (file)
--- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
@@ -255,6 +255,10 @@ M: ##allocation analyze-aliases*
     #! object.
     dup dst>> set-new-ac ;
 
+M: ##box-displaced-alien analyze-aliases*
+    [ call-next-method ]
+    [ base>> heap-ac get merge-acs ] bi ;
+
 M: ##read analyze-aliases*
     call-next-method
     dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 28b52e7a4fba5a31cea531ce1b53e6f0a96e846d..4fa8145c4cf0c29ed7f303c9fedf85901b105ec9 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/basis/compiler/cfg/instructions/instructions.factor
@@ -13,7 +13,7 @@ V{ } clone insn-classes set-global
 
 : new-insn ( ... class -- insn ) f swap boa ; inline
 
-! Virtual CPU instructions, used by CFG and machine IRs
+! Virtual CPU instructions, used by CFG IR
 TUPLE: insn ;
 
 ! Instructions which are referentially transparent; used for
@@ -364,12 +364,6 @@ use: src1
 temp: temp/int-rep
 literal: rep vcc ;
 
-INSN: _test-vector-branch
-literal: label
-use: src1
-temp: temp/int-rep
-literal: rep vcc ;
-
 PURE-INSN: ##add-vector
 def: dst
 use: src1 src2

diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index 2edb0167342d3755708e170646c80ab00cfe88f3..e9127f71e4b0679e112277b866200bbbc48f7809 100644 (file)
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -472,3 +472,10 @@ TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-
     ] when ;
 
 [ ] [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test
+
+! Alias analysis bug
+[ t ] [
+    [
+        10 10 <byte-array> [ <displaced-alien> underlying>> ] keep eq?
+    ] compile-call
+] unit-test

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 7fb36c96fd76d9bdb732403d05605d7a12661500..aab40ec77c102a3538daa49e110365e109fb6987 100644 (file)
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -272,6 +272,11 @@ generic-comparison-ops [
     2drop alien \ f class-or <class-info>
 ] "outputs" set-word-prop
 
+\ <displaced-alien> [
+    [ interval>> 0 swap interval-contains? ] dip
+    class>> alien class-or alien ? <class-info>
+] "outputs" set-word-prop
+
 { <tuple> <tuple-boa> } [
     [
         literal>> dup array? [ first ] [ drop tuple ] if <class-info>

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 17701e94c1a8cd604ca3852711cc1faa2824c988..e738a70fc3377f604aed521ca1ac6486cf542270 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -976,3 +976,22 @@ M: tuple-with-read-only-slot clone
     ! Should actually be 0 23 2^ 1 - [a,b]
     [ string-nth ] final-info first interval>> 0 23 2^ [a,b] =
 ] unit-test
+
+! Non-zero displacement for <displaced-alien> restricts the output type
+[ t ] [
+    [ { byte-array } declare <displaced-alien> ] final-classes
+    first byte-array alien class-or class=
+] unit-test
+
+[ V{ alien } ] [
+    [ { alien } declare <displaced-alien> ] final-classes
+] unit-test
+
+[ t ] [
+    [ { POSTPONE: f } declare <displaced-alien> ] final-classes
+    first \ f alien class-or class=
+] unit-test
+
+[ V{ alien } ] [
+    [ { byte-array } declare [ 10 bitand 2 + ] dip <displaced-alien> ] final-classes
+] unit-test