From: Paul Khuong <pvk@pvk.ca>
Date: Sat, 18 Jul 2009 17:53:00 +0000 (+0000)
Subject: 1.0.30.3: deal with load-time-value constants more aggressively
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e6a7faf7fe4193f61eeaf1151f891c38b7c8e6ed;p=sbcl.git

1.0.30.3: deal with load-time-value constants more aggressively

* Revert 1.0.29.54.rc5 to allow constant moves from LTV TNs.

* Modify the relevant VOPs to handle LTV constants correctly.
  While this mostly results in duplicated code, VOPs can generate
  better code even for unknown values in the constant vector.
---

diff --git a/src/compiler/alpha/move.lisp b/src/compiler/alpha/move.lisp
index bfdb4fe..6416dc6 100644
--- a/src/compiler/alpha/move.lisp
+++ b/src/compiler/alpha/move.lisp
@@ -161,7 +161,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst li (tn-value x) y)))
+    (cond ((sc!c::tn-leaf x)
+           (inst li (tn-value x) y))
+          (t
+           (loadw y code-tn (tn-offset x) other-pointer-lowtag)
+           (inst sra y n-fixnum-tag-bits y)))))
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
 
diff --git a/src/compiler/hppa/move.lisp b/src/compiler/hppa/move.lisp
index 724ab93..67b535b 100644
--- a/src/compiler/hppa/move.lisp
+++ b/src/compiler/hppa/move.lisp
@@ -143,7 +143,7 @@
   (:arg-types tagged-num)
   (:note "fixnum untagging")
   (:generator 1
-    (inst sra x 2 y)))
+    (inst sra x n-fixnum-tag-bits y)))
 
 (define-move-vop move-to-word/fixnum :move
   (any-reg descriptor-reg) (signed-reg unsigned-reg))
@@ -154,7 +154,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst li (tn-value x) y)))
+    (cond ((sb!c::tn-leaf x)
+           (inst li (tn-value x) y))
+          (t
+           (loadw y code-tn (tn-offset x) other-pointer-lowtag)
+           (inst sra y n-fixnum-tag-bits y)))))
 
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
diff --git a/src/compiler/mips/move.lisp b/src/compiler/mips/move.lisp
index b839199..5bb0c85 100644
--- a/src/compiler/mips/move.lisp
+++ b/src/compiler/mips/move.lisp
@@ -141,7 +141,7 @@
   (:arg-types tagged-num)
   (:note "fixnum untagging")
   (:generator 1
-    (inst sra y x 2)))
+    (inst sra y x n-fixnum-tag-bits)))
 ;;;
 (define-move-vop move-to-word/fixnum :move
   (any-reg descriptor-reg) (signed-reg unsigned-reg))
@@ -152,7 +152,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst li y (tn-value x))))
+    (cond ((sb!c::tn-leaf x)
+           (inst li y (tn-value x)))
+          (t
+           (loadw y code-tn (tn-offset x) other-pointer-lowtag)
+           (inst sra y y n-fixnum-tag-bits)))))
 ;;;
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp
index 966925b..a948dee 100644
--- a/src/compiler/ppc/move.lisp
+++ b/src/compiler/ppc/move.lisp
@@ -141,7 +141,7 @@
   (:arg-types tagged-num)
   (:note "fixnum untagging")
   (:generator 1
-    (inst srawi y x 2)))
+    (inst srawi y x n-fixnum-tag-bits)))
 (define-move-vop move-to-word/fixnum :move
   (any-reg descriptor-reg) (signed-reg unsigned-reg))
 
@@ -151,7 +151,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst lr y (tn-value x))))
+    (cond ((sb!c::tn-leaf x)
+           (inst lr y (tn-value x)))
+          (t
+           (loadw y code-tn (tn-offset x) other-pointer-lowtag)
+           (inst srawi y y n-fixnum-tag-bits)))))
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
 
diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp
index c4b92cc..8d2418e 100644
--- a/src/compiler/represent.lisp
+++ b/src/compiler/represent.lisp
@@ -414,12 +414,7 @@
                    (operand-restriction-ok
                     (first (template-result-types info))
                     (if write-p op-ptype other-ptype)
-                    :t-ok nil)
-                   ;; KLUDGE: Move VOPs with constant SCs can't use
-                   ;; load-time-value TNs. FIXME: if the VOPs were more
-                   ;; clever they could -- this is the release bandaid.
-                   (or (not (eq 'constant (sc-name op-sc)))
-                       (tn-leaf op-tn)))
+                    :t-ok nil))
           (return info))))))
 
 ;;; Emit a coercion VOP for OP BEFORE the specifed VOP or die trying.
diff --git a/src/compiler/sparc/move.lisp b/src/compiler/sparc/move.lisp
index 5b4bc1b..72080a2 100644
--- a/src/compiler/sparc/move.lisp
+++ b/src/compiler/sparc/move.lisp
@@ -150,7 +150,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst li y (tn-value x))))
+    (cond ((sb!c::tn-leaf x)
+           (inst li y (tn-value x)))
+          (t
+           (loadw y code-tn (tn-offset x) other-pointer-lowtag)
+           (inst sra y y n-fixnum-tag-bits)))))
 
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp
index cd6642b..b5c628b 100644
--- a/src/compiler/x86-64/move.lisp
+++ b/src/compiler/x86-64/move.lisp
@@ -248,7 +248,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst mov y (tn-value x))))
+    (cond ((sb!c::tn-leaf x)
+           (inst mov y (tn-value x)))
+          (t
+           (inst mov y x)
+           (inst sar y n-fixnum-tag-bits)))))
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
 
diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp
index 2c198a9..344c572 100644
--- a/src/compiler/x86/move.lisp
+++ b/src/compiler/x86/move.lisp
@@ -150,7 +150,7 @@
   (:note "fixnum untagging")
   (:generator 1
     (move y x)
-    (inst sar y 2)))
+    (inst sar y n-fixnum-tag-bits)))
 (define-move-vop move-to-word/fixnum :move
   (any-reg descriptor-reg) (signed-reg unsigned-reg))
 
@@ -160,7 +160,11 @@
   (:results (y :scs (signed-reg unsigned-reg)))
   (:note "constant load")
   (:generator 1
-    (inst mov y (tn-value x))))
+    (cond ((sb!c::tn-leaf x)
+           (inst mov y (tn-value x)))
+          (t
+           (inst mov y x)
+           (inst sar y n-fixnum-tag-bits)))))
 (define-move-vop move-to-word-c :move
   (constant) (signed-reg unsigned-reg))
 
diff --git a/version.lisp-expr b/version.lisp-expr
index c5fcc61..f1151b4 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.30.2"
+"1.0.30.3"