From 8f719f421329f6a75c77edbc3658493d554b8d54 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 14 Jan 1992 16:08:19 +0000
Subject: [PATCH] Updated the integer move/coerce VOPs to correspond to the
 MIPS version. The fixnum cases are split off so that we have a better idea of
 the cost (for efficiency notes.)  Added notes to these VOPs.

---
 compiler/sparc/move.lisp | 215 ++++++++++++++++++++++++---------------
 1 file changed, 131 insertions(+), 84 deletions(-)

diff --git a/compiler/sparc/move.lisp b/compiler/sparc/move.lisp
index 8365afaa1..6ceb8c2b2 100644
--- a/compiler/sparc/move.lisp
+++ b/compiler/sparc/move.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/move.lisp,v 1.2 1991/11/09 02:38:21 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/move.lisp,v 1.3 1992/01/14 16:08:19 ram Exp $
 ;;;
 ;;;    This file contains the SPARC VM definition of operand loading/saving and
 ;;; the Move VOP.
@@ -140,103 +140,149 @@
 
 ;;;; Moves and coercions:
 
-;;; Move a tagged number to an untagged representation.
+;;; These MOVE-TO-WORD VOPs move a tagged integer to a raw full-word
+;;; representation.  Similarly, the MOVE-FROM-WORD VOPs converts a raw integer
+;;; to a tagged bignum or fixnum.
+
+;;; Arg is a fixnum, so just shift it.  We need a type restriction because some
+;;; possible arg SCs (control-stack) overlap with possible bignum arg SCs.
+;;;
+(define-vop (move-to-word/fixnum)
+  (:args (x :scs (any-reg descriptor-reg)))
+  (:results (y :scs (signed-reg unsigned-reg)))
+  (:arg-types tagged-num)
+  (:note "fixnum untagging")
+  (:generator 1
+    (inst sra y x 2)))
+;;;
+(define-move-vop move-to-word/fixnum :move
+  (any-reg descriptor-reg) (signed-reg unsigned-reg))
+
+;;; Arg is a non-immediate constant, load it.
+(define-vop (move-to-word-c)
+  (:args (x :scs (constant)))
+  (:results (y :scs (signed-reg unsigned-reg)))
+  (:note "constant load")
+  (:generator 1
+    (inst li y (tn-value x))))
 ;;;
-(define-vop (move-to-signed/unsigned)
-  (:args (x :scs (any-reg descriptor-reg constant)))
+(define-move-vop move-to-word-c :move
+  (constant) (signed-reg unsigned-reg))
+
+
+;;; Arg is a fixnum or bignum, figure out which and load if necessary.
+(define-vop (move-to-word/integer)
+  (:args (x :scs (descriptor-reg)))
   (:results (y :scs (signed-reg unsigned-reg)))
+  (:note "integer to untagged word coercion")
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 4
-    (sc-case x
-      (any-reg
-       (inst sra y x 2))
-      (constant
-       (inst li y (tn-value x)))
-      (descriptor-reg
-       (let ((done (gen-label)))
-	 (inst andcc temp x 3)
-	 (inst b :eq done)
-	 (sc-case y
-	   (signed-reg
-	    (inst sra y x 2))
-	   (unsigned-reg
-	    (inst srl y x 2)))
-
-	 (loadw y x bignum-digits-offset other-pointer-type)
-
-	 (emit-label done))))))
+    (let ((done (gen-label)))
+      (inst andcc temp x 3)
+      (inst b :eq done)
+      (sc-case y
+	(signed-reg
+	 (inst sra y x 2))
+	(unsigned-reg
+	 (inst srl y x 2)))
+      
+      (loadw y x bignum-digits-offset other-pointer-type)
+      
+      (emit-label done))))
+;;;
+(define-move-vop move-to-word/integer :move
+  (descriptor-reg) (signed-reg unsigned-reg))
 
+
+
+;;; Result is a fixnum, so we can just shift.  We need the result type
+;;; restriction because of the control-stack ambiguity noted above.
 ;;;
-(define-move-vop move-to-signed/unsigned :move
-  (any-reg descriptor-reg) (signed-reg unsigned-reg))
+(define-vop (move-from-word/fixnum)
+  (:args (x :scs (signed-reg unsigned-reg)))
+  (:results (y :scs (any-reg descriptor-reg)))
+  (:result-types tagged-num)
+  (:note "fixnum tagging")
+  (:generator 1
+    (inst sll y x 2)))
+;;;
+(define-move-vop move-from-word/fixnum :move
+  (signed-reg unsigned-reg) (any-reg descriptor-reg))
 
 
-;;; Move an untagged number to a tagged representation.
+;;; Result may be a bignum, so we have to check.  Use a worst-case cost to make
+;;; sure people know they may be number consing.
 ;;;
-(define-vop (move-from-signed/unsigned)
+(define-vop (move-from-signed)
   (:args (arg :scs (signed-reg unsigned-reg) :target x))
   (:results (y :scs (any-reg descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
+  (:note "signed word to integer coercion")
   (:generator 20
-    (sc-case y
-      (any-reg
-       ;; The results must be a fixnum, so we can just do the shift.
-       (inst sll y arg 2))
-      (descriptor-reg
-       ;; The results might be a bignum, so we have to make sure.
-       (move x arg)
-       (sc-case arg
-	 (signed-reg
-	  (let ((fixnum (gen-label))
-		(done (gen-label)))
-	    (inst sra temp x 29)
-	    (inst cmp temp)
-	    (inst b :eq fixnum)
-	    (inst orncc temp zero-tn temp)
-	    (inst b :eq done)
-	    (inst sll y x 2)
-
-	    (with-fixed-allocation
-		(y temp bignum-type (1+ bignum-digits-offset))
-	      (storew x y bignum-digits-offset other-pointer-type))
-	    (inst b done)
-	    (inst nop)
-
-	    (emit-label fixnum)
-	    (inst sll y x 2)
-	    (emit-label done)))
-	 (unsigned-reg
-	  (let ((done (gen-label))
-		(one-word (gen-label)))
-	    (inst sra temp x 29)
-	    (inst cmp temp)
-	    (inst b :eq done)
-	    (inst sll y x 2)
-
-	    (pseudo-atomic (temp)
-	      (inst add y alloc-tn other-pointer-type)
-	      (inst add alloc-tn
-		    (pad-data-block (1+ bignum-digits-offset)))
-	      (inst cmp x)
-	      (inst b :ge one-word)
-	      (inst li temp (logior (ash 1 type-bits) bignum-type))
-	      (inst add alloc-tn
-		    (- (pad-data-block (+ bignum-digits-offset 2))
-		       (pad-data-block (+ bignum-digits-offset 1))))
-	      (inst li temp (logior (ash 2 type-bits) bignum-type))
-	      (emit-label one-word)
-	      (storew temp y 0 other-pointer-type)
-	      (storew x y bignum-digits-offset other-pointer-type))
-	    (emit-label done))))))))
+    (move x arg)
+    (let ((fixnum (gen-label))
+	  (done (gen-label)))
+      (inst sra temp x 29)
+      (inst cmp temp)
+      (inst b :eq fixnum)
+      (inst orncc temp zero-tn temp)
+      (inst b :eq done)
+      (inst sll y x 2)
+      
+      (with-fixed-allocation
+	(y temp bignum-type (1+ bignum-digits-offset))
+	(storew x y bignum-digits-offset other-pointer-type))
+      (inst b done)
+      (inst nop)
       
+      (emit-label fixnum)
+      (inst sll y x 2)
+      (emit-label done))))
 ;;;
-(define-move-vop move-from-signed/unsigned :move
-  (signed-reg unsigned-reg) (any-reg descriptor-reg))
+(define-move-vop move-from-signed :move
+  (signed-reg) (descriptor-reg))
+
+
+;;; Check for fixnum, and possibly allocate one or two word bignum result.  Use
+;;; a worst-case cost to make sure people know they may be number consing.
+;;;
+(define-vop (move-from-unsigned)
+  (:args (arg :scs (signed-reg unsigned-reg) :target x))
+  (:results (y :scs (any-reg descriptor-reg)))
+  (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp)
+  (:note "unsigned word to integer coercion")
+  (:generator 20
+    (move x arg)
+    (let ((done (gen-label))
+	  (one-word (gen-label)))
+      (inst sra temp x 29)
+      (inst cmp temp)
+      (inst b :eq done)
+      (inst sll y x 2)
+      
+      (pseudo-atomic (temp)
+	(inst add y alloc-tn other-pointer-type)
+	(inst add alloc-tn
+	      (pad-data-block (1+ bignum-digits-offset)))
+	(inst cmp x)
+	(inst b :ge one-word)
+	(inst li temp (logior (ash 1 type-bits) bignum-type))
+	(inst add alloc-tn
+	      (- (pad-data-block (+ bignum-digits-offset 2))
+		 (pad-data-block (+ bignum-digits-offset 1))))
+	(inst li temp (logior (ash 2 type-bits) bignum-type))
+	(emit-label one-word)
+	(storew temp y 0 other-pointer-type)
+	(storew x y bignum-digits-offset other-pointer-type))
+      (emit-label done))))
+;;;
+(define-move-vop move-from-unsigned :move
+  (unsigned-reg) (descriptor-reg))
 
 
 ;;; Move untagged numbers.
 ;;;
-(define-vop (signed/unsigned-move)
+(define-vop (word-move)
   (:args (x :target y
 	    :scs (signed-reg unsigned-reg)
 	    :load-if (not (location= x y))))
@@ -244,21 +290,23 @@
 	       :load-if (not (location= x y))))
   (:effects)
   (:affected)
-  (:generator 1
+  (:note "word integer move")
+  (:generator 0
     (move y x)))
 ;;;
-(define-move-vop signed/unsigned-move :move
+(define-move-vop word-move :move
   (signed-reg unsigned-reg) (signed-reg unsigned-reg))
 
 
 ;;; Move untagged number arguments/return-values.
 ;;;
-(define-vop (move-signed/unsigned-argument)
+(define-vop (move-word-argument)
   (:args (x :target y
 	    :scs (signed-reg unsigned-reg))
 	 (fp :scs (any-reg)
 	     :load-if (not (sc-is y sap-reg))))
   (:results (y))
+  (:note "word integer argument move")
   (:generator 0
     (sc-case y
       ((signed-reg unsigned-reg)
@@ -266,7 +314,7 @@
       ((signed-stack unsigned-stack)
        (storew x fp (tn-offset y))))))
 ;;;
-(define-move-vop move-signed/unsigned-argument :move-argument
+(define-move-vop move-word-argument :move-argument
   (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg))
 
 
@@ -275,4 +323,3 @@
 ;;;
 (define-move-vop move-argument :move-argument
   (signed-reg unsigned-reg) (any-reg descriptor-reg))
-
-- 
GitLab