From db0f40e481950bf091f2024d39710878823edae1 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 13 May 2010 01:46:58 -0400
Subject: [PATCH] compiler: small fixes and cleanups

---
 .../alias-analysis-tests.factor               | 21 ++++++++++++++++++-
 .../cfg/alias-analysis/alias-analysis.factor  |  4 ++++
 .../cfg/instructions/instructions.factor      |  8 +------
 basis/compiler/tests/codegen.factor           |  7 +++++++
 .../known-words/known-words.factor            |  5 +++++
 .../tree/propagation/propagation-tests.factor | 19 +++++++++++++++++
 6 files changed, 56 insertions(+), 8 deletions(-)

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
index 4a41129ef4..b0085c2032 100644
--- 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 438395e2a7..e6ecefd665 100644
--- 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 28b52e7a4f..4fa8145c4c 100644
--- 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 2edb016734..e9127f71e4 100644
--- 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 7fb36c96fd..aab40ec77c 100644
--- 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 17701e94c1..e738a70fc3 100644
--- 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