From: David Lichteblau <david@lichteblau.com>
Date: Wed, 6 Jun 2012 14:24:00 +0000 (+0200)
Subject: Relax an implicit restriction on the number of code constants on SPARC
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=27a88f9d3a898640b8bc03bc6699cdee7e058732;p=sbcl.git

Relax an implicit restriction on the number of code constants on SPARC

Previously, LOAD-CONSTANT was restricted by SPARC's particularly small
13 bit immediate field, allowing fewer constants than on other platforms.

Fixes lp#1008996.
---

diff --git a/src/compiler/sparc/move.lisp b/src/compiler/sparc/move.lisp
index 72080a2..fb3c9de 100644
--- a/src/compiler/sparc/move.lisp
+++ b/src/compiler/sparc/move.lisp
@@ -41,7 +41,31 @@
 
 (define-move-fun (load-constant 5) (vop x y)
   ((constant) (descriptor-reg))
-  (loadw y code-tn (tn-offset x) other-pointer-lowtag))
+  ;; Does the (positive) offset fit into our signed 13 bit immediate?
+  ;; Else go through a temporary register.  Note that PPC (for example)
+  ;; does not try to support arbitrarily large constant offsets, but PPC
+  ;; supports 16 bit immediates, so the restriction is not as severe
+  ;; there.
+  (let ((nbits 12))
+    (cond
+      ((<= (- (ash (tn-offset x) word-shift) other-pointer-lowtag)
+           (1- (ash 1 nbits)))
+       (loadw y code-tn (tn-offset x) other-pointer-lowtag))
+      (t
+       ;; Use LIP as a temporary.  This should be OK, because LIP is only
+       ;; used within VOPs, whereas we get called to supply the VOP's
+       ;; parameters much earlier.  And LIP-TN is relative to CODE-TN, so
+       ;; the GC should be fine with this.
+       (move lip-tn code-tn)
+       ;; When ADDing the offset, we need multiple steps, because ADD's
+       ;; immediate has the same size restriction as LOADW's.  Take care
+       ;; to add in word-sized steps, so that the LIP remains valid.
+       (let ((stepsize (logandc2 (1- (ash 1 nbits)) (1- (ash 1 word-shift)))))
+         (multiple-value-bind (q r)
+             (truncate (ash (tn-offset x) word-shift) stepsize)
+           (dotimes (x q) (inst add lip-tn stepsize))
+           (when (plusp r) (inst add lip-tn r))))
+       (loadw y lip-tn 0 other-pointer-lowtag)))))
 
 (define-move-fun (load-stack 5) (vop x y)
   ((control-stack) (any-reg descriptor-reg))
diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp
index 95d29f2..c282c6a 100644
--- a/src/compiler/sparc/vm.lisp
+++ b/src/compiler/sparc/vm.lisp
@@ -299,6 +299,7 @@
   (defregtn zero any-reg)
   (defregtn null descriptor-reg)
   (defregtn code descriptor-reg)
+  (defregtn lip descriptor-reg)
   (defregtn alloc any-reg)
 
   (defregtn nargs any-reg)
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index a6df1ea..263aef1 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -2274,4 +2274,15 @@
       (assert (= quo -1))
       (assert (= rem (float -228645653448151381))))))
 
+(defmacro def-many-code-constants ()
+  `(defun many-code-constants ()
+     ,@(loop for i from 0 below 1000
+          collect `(print ,(format nil "hi-~d" i)))))
+
+(test-util:with-test (:name :many-code-constants)
+  (def-many-code-constants)
+  (assert (search "hi-999"
+                  (with-output-to-string (*standard-output*)
+                    (many-code-constants)))))
+
 ;;; success