From 3d1044ebd697fd4831eb5998a5f245fe596c9606 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 4 Jul 2005 10:16:22 +0000
Subject: [PATCH] 0.9.2.21: 	Merge THS patches for MOVE and branch delay
 scheduling 	(3 parts, "Mips branch delay slot audit"
 sbcl-devel 2005-06-19) 	... prefer MOVE to INST
 MOVE; 	... be more careful with branch delay slots; 	...
 preschedule where possible.

---
 src/assembly/mips/arith.lisp      |   47 ++++++++++++++++---------------------
 src/assembly/mips/assem-rtns.lisp |   25 ++++++++++----------
 src/assembly/mips/support.lisp    |    6 ++---
 src/compiler/mips/arith.lisp      |    4 ++--
 src/compiler/mips/c-call.lisp     |    3 +--
 src/compiler/mips/call.lisp       |   41 ++++++++++++++++----------------
 src/compiler/mips/cell.lisp       |    3 +--
 src/compiler/mips/debug.lisp      |    2 +-
 src/compiler/mips/macros.lisp     |   12 +++++-----
 src/compiler/mips/nlx.lisp        |    7 +++---
 src/compiler/mips/static-fn.lisp  |    4 ++--
 src/compiler/mips/type-vops.lisp  |    2 +-
 src/compiler/mips/values.lisp     |   12 +++++-----
 version.lisp-expr                 |    2 +-
 14 files changed, 80 insertions(+), 90 deletions(-)

diff --git a/src/assembly/mips/arith.lisp b/src/assembly/mips/arith.lisp
index c36fcdd..8a54196 100644
--- a/src/assembly/mips/arith.lisp
+++ b/src/assembly/mips/arith.lisp
@@ -27,9 +27,9 @@
   ;; DO-STATIC-FUN
   (inst lw lip null-tn (static-fun-offset 'two-arg-+))
   (inst li nargs (fixnumize 2))
-  (inst move ocfp cfp-tn)
+  (move ocfp cfp-tn)
   (inst j lip)
-  (inst move cfp-tn csp-tn)
+  (move cfp-tn csp-tn t)
 
   DO-ADD
   (inst sra temp2 y n-fixnum-tag-bits)
@@ -77,9 +77,9 @@
   ;; DO-STATIC-FUN
   (inst lw lip null-tn (static-fun-offset 'two-arg--))
   (inst li nargs (fixnumize 2))
-  (inst move ocfp cfp-tn)
+  (move ocfp cfp-tn)
   (inst j lip)
-  (inst move cfp-tn csp-tn)
+  (move cfp-tn csp-tn t)
 
   DO-SUB
   (inst sra temp2 y n-fixnum-tag-bits)
@@ -152,12 +152,8 @@
   (pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset)))
     (inst or res alloc-tn other-pointer-lowtag)
     (storew temp res 0 other-pointer-lowtag))
-
-  (storew lo res bignum-digits-offset other-pointer-lowtag)
-
-  ;; Out of here
   (inst b DONE)
-  (inst nop)
+  (storew lo res bignum-digits-offset other-pointer-lowtag)
 
   TWO-WORDS
   (pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset)))
@@ -165,18 +161,15 @@
     (storew temp res 0 other-pointer-lowtag))
 
   (storew lo res bignum-digits-offset other-pointer-lowtag)
-  (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
-
-  ;; Out of here
   (inst b DONE)
-  (inst nop)
+  (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
 
   DO-STATIC-FUN
   (inst lw lip null-tn (static-fun-offset 'two-arg-*))
   (inst li nargs (fixnumize 2))
-  (inst move ocfp cfp-tn)
+  (move ocfp cfp-tn)
   (inst j lip)
-  (inst move cfp-tn csp-tn)
+  (move cfp-tn csp-tn t)
 
   DONE)
 
@@ -209,13 +202,13 @@
 	  ;; DO-STATIC-FUN
 	  (inst lw lip null-tn (static-fun-offset ',static-fn))
 	  (inst li nargs (fixnumize 2))
-	  (inst move ocfp cfp-tn)
+	  (move ocfp cfp-tn)
 	  (inst j lip)
-	  (inst move cfp-tn csp-tn)
+	  (move cfp-tn csp-tn t)
 	  
 	  DO-COMPARE
 	  (inst beq temp DONE)
-	  (inst move res null-tn)
+	  (move res null-tn t)
 	  (load-symbol res t)
 
 	  DONE)))
@@ -248,13 +241,13 @@
   ;; DO-STATIC-FUN
   (inst lw lip null-tn (static-fun-offset 'eql))
   (inst li nargs (fixnumize 2))
-  (inst move ocfp cfp-tn)
+  (move ocfp cfp-tn)
   (inst j lip)
-  (inst move cfp-tn csp-tn)
+  (move cfp-tn csp-tn t)
 
   RETURN
   (inst bne x y DONE)
-  (inst move res null-tn)
+  (move res null-tn t)
 
   RETURN-T
   (load-symbol res t)
@@ -285,13 +278,13 @@
   ;; DO-STATIC-FUN
   (inst lw lip null-tn (static-fun-offset 'two-arg-=))
   (inst li nargs (fixnumize 2))
-  (inst move ocfp cfp-tn)
+  (move ocfp cfp-tn)
   (inst j lip)
-  (inst move cfp-tn csp-tn)
+  (move cfp-tn csp-tn t)
 
   RETURN
   (inst bne x y DONE)
-  (inst move res null-tn)
+  (move res null-tn t)
   (load-symbol res t)
 
   DONE)
@@ -320,13 +313,13 @@
   ;; DO-STATIC-FUN
   (inst lw lip null-tn (static-fun-offset 'two-arg-/=))
   (inst li nargs (fixnumize 2))
-  (inst move ocfp cfp-tn)
+  (move ocfp cfp-tn)
   (inst j lip)
-  (inst move cfp-tn csp-tn)
+  (move cfp-tn csp-tn t)
 
   RETURN
   (inst beq x y DONE)
-  (inst move res null-tn)
+  (move res null-tn t)
   (load-symbol res t)
 
   DONE)
diff --git a/src/assembly/mips/assem-rtns.lisp b/src/assembly/mips/assem-rtns.lisp
index 0e3a85c..4836e5b 100644
--- a/src/assembly/mips/assem-rtns.lisp
+++ b/src/assembly/mips/assem-rtns.lisp
@@ -64,16 +64,16 @@
   (inst nop)
 
   DEFAULT-A0-AND-ON
-  (inst move a0 null-tn)
-  (inst move a1 null-tn)
+  (move a0 null-tn)
+  (move a1 null-tn)
   DEFAULT-A2-AND-ON
-  (inst move a2 null-tn)
+  (move a2 null-tn)
   DEFAULT-A3-AND-ON
-  (inst move a3 null-tn)
+  (move a3 null-tn)
   DEFAULT-A4-AND-ON
-  (inst move a4 null-tn)
+  (move a4 null-tn)
   DEFAULT-A5-AND-ON
-  (inst move a5 null-tn)
+  (move a5 null-tn)
   DONE
   
   ;; Clear the stack.
@@ -168,8 +168,9 @@
   (declare (ignore start count))
 
   (let ((error (generate-error-code nil invalid-unwind-error)))
-    (inst beq block zero-tn error))
-  
+    (inst beq block zero-tn error)
+    (inst nop))
+
   (load-symbol-value cur-uwp *current-unwind-protect-block*)
   (loadw target-uwp block unwind-block-current-uwp-slot)
   (inst bne cur-uwp target-uwp do-uwp)
@@ -212,12 +213,10 @@
   (loadw tag catch catch-block-tag-slot)
   (inst beq tag target exit)
   (inst nop)
-  (loadw catch catch catch-block-previous-catch-slot)
   (inst b loop)
-  (inst nop)
+  (loadw catch catch catch-block-previous-catch-slot)
   
-  exit
+  EXIT
   
-  (move target catch)
   (inst j (make-fixup 'unwind :assembly-routine))
-  (inst nop))
+  (move target catch t))
diff --git a/src/assembly/mips/support.lisp b/src/assembly/mips/support.lisp
index 2bad731..8800efc 100644
--- a/src/assembly/mips/support.lisp
+++ b/src/assembly/mips/support.lisp
@@ -31,10 +31,10 @@
 	    (note-next-instruction ,vop :call-site)
 	    (inst j (make-fixup ',name :assembly-routine))
 	    (inst nop)
-	    (emit-return-pc lra-label)
-	    (note-this-location ,vop :single-value-return)
 	    (without-scheduling ()
-	      (move csp-tn ocfp-tn)
+	      (emit-return-pc lra-label)
+	      (note-this-location ,vop :single-value-return)
+	      (inst move csp-tn ocfp-tn)
 	      (inst nop))
 	    (inst compute-code-from-lra code-tn code-tn
 		  lra-label ,temp)
diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp
index ae219c5..93e0bf6 100644
--- a/src/compiler/mips/arith.lisp
+++ b/src/compiler/mips/arith.lisp
@@ -238,7 +238,7 @@
     (inst bne temp zero-tn done)
     (inst srl result number ndesc)
     (inst b done)
-    (inst move result zero-tn)
+    (move result zero-tn t)
 
     POSITIVE
     ;; The result-type assures us that this shift will not overflow.
@@ -340,7 +340,7 @@
 	  (test (gen-label)))
       (move shift arg)
       (inst bgez shift test)
-      (move res zero-tn)
+      (move res zero-tn t)
       (inst b test)
       (inst nor shift shift)
 
diff --git a/src/compiler/mips/c-call.lisp b/src/compiler/mips/c-call.lisp
index d020fce..6b9eece 100644
--- a/src/compiler/mips/c-call.lisp
+++ b/src/compiler/mips/c-call.lisp
@@ -250,9 +250,8 @@
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
 	(store-stack-tn nfp-save cur-nfp))
-      (move cfunc function)
       (inst jal (make-fixup "call_into_c" :foreign))
-      (inst nop)
+      (move cfunc function t)
       (when cur-nfp
 	(load-stack-tn cur-nfp nfp-save)))))
 
diff --git a/src/compiler/mips/call.lisp b/src/compiler/mips/call.lisp
index a33e696..9e33759 100644
--- a/src/compiler/mips/call.lisp
+++ b/src/compiler/mips/call.lisp
@@ -267,7 +267,7 @@ default-value-8
 	;; gets confused.
 	(without-scheduling ()
 	  (note-this-location vop :single-value-return)
-	  (move csp-tn ocfp-tn)
+	  (inst move csp-tn ocfp-tn)
 	  (inst nop))
 	(when lra-label
 	  (inst compute-code-from-lra code-tn code-tn lra-label temp)))
@@ -282,7 +282,7 @@ default-value-8
 	  ;; If there are no stack results, clear the stack now.
 	  (if (> nvals register-arg-count)
 	      (inst addu temp nargs-tn (fixnumize (- register-arg-count)))
-	      (move csp-tn ocfp-tn)))
+	      (move csp-tn ocfp-tn t)))
 	
 	;; Do the single value calse.
 	(do ((i 1 (1+ i))
@@ -291,7 +291,7 @@ default-value-8
 	  (move (tn-ref-tn val) null-tn))
 	(when (> nvals register-arg-count)
 	  (inst b default-stack-vals)
-	  (move ocfp-tn csp-tn))
+	  (move ocfp-tn csp-tn t))
 	
 	(emit-label regs-defaulted)
 	
@@ -380,9 +380,8 @@ default-value-8
 	  ((null arg))
 	(storew (first arg) args i))
       (move start args)
-      (move count nargs)
       (inst b done)
-      (inst nop)))
+      (move count nargs t)))
   (values))
 
 
@@ -573,7 +572,7 @@ default-value-8
 	      (bytes-needed-for-non-descriptor-stack-frame))))
     (inst addu lip return-pc-temp (- n-word-bytes other-pointer-lowtag))
     (inst j lip)
-    (move cfp-tn ocfp-temp)
+    (move cfp-tn ocfp-temp t)
     (trace-table-entry trace-table-normal)))
 
 
@@ -739,7 +738,7 @@ default-value-8
 			    '((:load-ocfp
 			       (sc-case ocfp
 				 (any-reg
-				  (inst move ocfp-pass ocfp))
+				  (move ocfp-pass ocfp t))
 				 (control-stack
 				  (inst lw ocfp-pass cfp-tn
 					(ash (tn-offset ocfp)
@@ -747,7 +746,7 @@ default-value-8
 			      (:load-return-pc
 			       (sc-case return-pc
 				 (descriptor-reg
-				  (inst move return-pc-pass return-pc))
+				  (move return-pc-pass return-pc t))
 				 (control-stack
 				  (inst lw return-pc-pass cfp-tn
 					(ash (tn-offset return-pc)
@@ -761,7 +760,7 @@ default-value-8
 			      (:frob-nfp
 			       (store-stack-tn nfp-save cur-nfp))
 			      (:save-fp
-			       (inst move ocfp-pass cfp-tn))
+			       (move ocfp-pass cfp-tn t))
 			      (:load-fp
 			       ,(if variable
 				    '(move cfp-tn new-fp)
@@ -811,9 +810,10 @@ default-value-8
 		 (do-next-filler)
 		 (return)))
 	   
+	   (do-next-filler)
 	   (note-this-location vop :call-site)
 	   (inst j entry-point)
-	   (do-next-filler))
+	   (inst nop))
 
 	 ,@(ecase return
 	     (:fixed
@@ -870,15 +870,14 @@ default-value-8
     (move ocfp ocfp-arg)
     (move lra lra-arg)
 
-    ;; Clear the number stack if anything is there.
+    ;; Clear the number stack if anything is there and jump to the
+    ;; assembly-routine that does the bliting.
+    (inst j (make-fixup 'tail-call-variable :assembly-routine))
     (let ((cur-nfp (current-nfp-tn vop)))
-      (when cur-nfp
+      (if cur-nfp
 	(inst addu nsp-tn cur-nfp
-	      (bytes-needed-for-non-descriptor-stack-frame))))
-
-    ;; And jump to the assembly-routine that does the bliting.
-    (inst j (make-fixup 'tail-call-variable :assembly-routine))
-    (inst nop)))
+	      (bytes-needed-for-non-descriptor-stack-frame))
+	(inst nop)))))
 
 
 ;;;; Unknown values return:
@@ -1002,9 +1001,9 @@ default-value-8
       (move ocfp ocfp-arg)
       (move lra lra-arg)
       (move vals vals-arg)
-      (move nvals nvals-arg)
+
       (inst j (make-fixup 'return-multiple :assembly-routine))
-      (inst nop))
+      (move nvals nvals-arg t))
     (trace-table-entry trace-table-normal)))
 
 
@@ -1068,7 +1067,7 @@ default-value-8
       ;; Everything of interest in registers.
       (inst blez count do-regs)
       ;; Initialize dst to be end of stack.
-      (move dst csp-tn)
+      (move dst csp-tn t)
       ;; Initialize src to be end of args.
       (inst addu src cfp-tn nargs-tn)
 
@@ -1125,7 +1124,7 @@ default-value-8
       (move count count-arg)
       ;; Check to see if there are any arguments.
       (inst beq count zero-tn done)
-      (move result null-tn)
+      (move result null-tn t)
 
       ;; We need to do this atomically.
       (pseudo-atomic (pa-flag)
diff --git a/src/compiler/mips/cell.lisp b/src/compiler/mips/cell.lisp
index 7a80016..860063b 100644
--- a/src/compiler/mips/cell.lisp
+++ b/src/compiler/mips/cell.lisp
@@ -335,8 +335,7 @@
     (inst addu lip offset object)
     (inst sw value lip (- (* instance-slots-offset n-word-bytes)
 			  instance-pointer-lowtag))
-    (unless (location= result value)
-      (move result value))))
+    (move result value)))
 
 (define-vop (raw-instance-ref/single)
   (:translate %raw-instance-ref/single)
diff --git a/src/compiler/mips/debug.lisp b/src/compiler/mips/debug.lisp
index 7883ec1..92e868e 100644
--- a/src/compiler/mips/debug.lisp
+++ b/src/compiler/mips/debug.lisp
@@ -92,7 +92,7 @@
       (assemble (*elsewhere*)
 	(emit-label bogus)
 	(inst b done)
-	(move code null-tn)))))
+	(move code null-tn t)))))
 
 (define-vop (code-from-lra code-from-mumble)
   (:translate lra-code-header)
diff --git a/src/compiler/mips/macros.lisp b/src/compiler/mips/macros.lisp
index e582930..b7f153d 100644
--- a/src/compiler/mips/macros.lisp
+++ b/src/compiler/mips/macros.lisp
@@ -28,10 +28,10 @@
   is nil)."
   (once-only ((n-dst dst)
 	      (n-src src))
-    (if always-emit-code-p
-	`(inst move ,n-dst ,n-src)
-	`(unless (location= ,n-dst ,n-src)
-	   (inst move ,n-dst ,n-src)))))
+    `(if (location= ,n-dst ,n-src)
+	 (when ,always-emit-code-p
+	   (inst nop))
+	 (inst move ,n-dst ,n-src))))
 
 (defmacro def-mem-op (op inst shift load)
   `(defmacro ,op (object base &optional (offset 0) (lowtag 0))
@@ -81,7 +81,7 @@
      (inst addu ,lip ,function (- (ash simple-fun-code-offset word-shift)
 				   fun-pointer-lowtag))
      (inst j ,lip)
-     (move code-tn ,function)))
+     (move code-tn ,function t)))
 
 (defmacro lisp-return (return-pc lip &key (offset 0) (frob-code t))
   "Return to RETURN-PC.  LIP is an interior-reg temporary."
@@ -90,7 +90,7 @@
 	   (- (* (1+ ,offset) n-word-bytes) other-pointer-lowtag))
      (inst j ,lip)
      ,(if frob-code
-	  `(move code-tn ,return-pc)
+	  `(move code-tn ,return-pc t)
 	  '(inst nop))))
 
 
diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp
index cb58be0..76174ca 100644
--- a/src/compiler/mips/nlx.lisp
+++ b/src/compiler/mips/nlx.lisp
@@ -156,7 +156,7 @@
 	  ((= nvals 1)
 	   (let ((no-values (gen-label)))
 	     (inst beq count zero-tn no-values)
-	     (move (tn-ref-tn values) null-tn)
+	     (move (tn-ref-tn values) null-tn t)
 	     (loadw (tn-ref-tn values) start)
 	     (emit-label no-values)))
 	  (t
@@ -223,8 +223,9 @@
 	(any-reg (move new-start dst))
 	(control-stack (store-stack-tn new-start dst)))
       (inst beq num zero-tn done)
+      (inst nop)
       (sc-case new-count
-	(any-reg (inst move new-count num))
+	(any-reg (move new-count num))
 	(control-stack (store-stack-tn new-count num)))
 
       ;; Copy stuff on stack.
@@ -237,7 +238,7 @@
       (inst addu dst dst n-word-bytes)
 
       (emit-label done)
-      (inst move csp-tn dst))))
+      (move csp-tn dst))))
 
 
 ;;; This VOP is just to force the TNs used in the cleanup onto the stack.
diff --git a/src/compiler/mips/static-fn.lisp b/src/compiler/mips/static-fn.lisp
index d5e99a9..d905ca0 100644
--- a/src/compiler/mips/static-fn.lisp
+++ b/src/compiler/mips/static-fn.lisp
@@ -71,11 +71,11 @@
 	     (inst lw entry-point null-tn (static-fun-offset symbol))
 	     (when cur-nfp
 	       (store-stack-tn nfp-save cur-nfp))
-	     (inst move ocfp cfp-tn)
+	     (move ocfp cfp-tn)
 	     (inst compute-lra-from-code lra code-tn lra-label temp)
 	     (note-this-location vop :call-site)
 	     (inst j entry-point)
-	     (inst move cfp-tn csp-tn)
+	     (move cfp-tn csp-tn t)
 	     (emit-return-pc lra-label)
 	     ,(collect ((bindings) (links))
 		(do ((temp (temp-names) (cdr temp))
diff --git a/src/compiler/mips/type-vops.lisp b/src/compiler/mips/type-vops.lisp
index 48107f2..483a944 100644
--- a/src/compiler/mips/type-vops.lisp
+++ b/src/compiler/mips/type-vops.lisp
@@ -191,7 +191,7 @@
       ;; Is it a fixnum?
       (inst and temp value 3)
       (inst beq temp zero-tn fixnum)
-      (inst move temp value)
+      (move temp value t)
 
       ;; If not, is it an other pointer?
       (inst and temp value lowtag-mask)
diff --git a/src/compiler/mips/values.lisp b/src/compiler/mips/values.lisp
index cf0e8dd..3281c5d 100644
--- a/src/compiler/mips/values.lisp
+++ b/src/compiler/mips/values.lisp
@@ -46,9 +46,9 @@
   (:temporary (:sc non-descriptor-reg) temp)
   (:ignore r-moved-ptrs)
   (:generator 1
-    (inst move src last-preserved-ptr)
-    (inst move dest last-nipped-ptr)
-    (inst move temp zero-tn)
+    (move src last-preserved-ptr)
+    (move dest last-nipped-ptr)
+    (move temp zero-tn)
     (inst sltu temp src csp-tn)
     (inst beq temp zero-tn DONE)
     (inst nop) ; not strictly necessary
@@ -61,7 +61,7 @@
     (inst bne temp zero-tn LOOP)
     (inst nop)
     DONE
-    (inst move csp-tn dest)
+    (move csp-tn dest)
     (inst sub src src dest)
     (loop for moved = moved-ptrs then (tn-ref-across moved)
           while moved
@@ -163,8 +163,8 @@
        (inst addu src context skip)))
     (move count num)
     (inst beq num zero-tn done)
-    (inst move start csp-tn)
-    (inst move dst csp-tn)
+    (move start csp-tn t)
+    (move dst csp-tn)
     (inst addu csp-tn count)
     LOOP
     (inst lw temp src)
diff --git a/version.lisp-expr b/version.lisp-expr
index 6aed87d..a0d1725 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".)
-"0.9.2.20"
+"0.9.2.21"
-- 
1.7.10.4