X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fsparc%2Fmove.lisp;h=fb3c9de49cdc18da6ae5bd26fffd7574be917350;hb=51bc001b7a98af096af782a672389e51004af068;hp=72080a2e1cab31c1ea244ef2b3fea62007d22314;hpb=e6a7faf7fe4193f61eeaf1151f891c38b7c8e6ed;p=sbcl.git

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))