Steel Bank Common Lisp

Thiemo Seufer <ths@...> writes:

> this fixes broken branch delay slot usages in the mips port,
> pre-schedules other usages of branch delay slots to be more
> efficient, makes sure that instructions in (without-scheduling ...)
> are actually emitted, and remove uselesss nops.
>
> It also updates the parameter list for eval-when and removes some
> unnecessary progns.
>
> Index: src/compiler/mips/type-vops.lisp
> ===================================================================
> RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/type-vops.lisp,v
> retrieving revision 1.3
> diff -u -p -r1.3 type-vops.lisp
> --- src/compiler/mips/type-vops.lisp	11 Jul 2003 08:38:12 -0000	1.3
> +++ src/compiler/mips/type-vops.lisp	9 Jun 2005 12:05:03 -0000
> @@ -24,7 +24,8 @@
>    (let ((drop-through (gen-label)))
>      (assemble ()
>        (inst and temp value 3)
> -      (inst beq temp zero-tn (if not-p drop-through target)))
> +      (inst beq temp zero-tn (if not-p drop-through target))
> +      (inst nop))
>      (%test-headers value target not-p nil headers
>  		   :drop-through drop-through :temp temp)))

I'm pretty sure this extra nop, and similar ones you've added in
type-vops.lisp, aren't in fact necessary.  The first instruction of a
%TEST-FOO sequence involves moving something into the temporary
register, which is harmless.

Cheers,

Christophe

Christophe Rhodes wrote:
[snip]
> I'm pretty sure this extra nop, and similar ones you've added in
> type-vops.lisp, aren't in fact necessary.  The first instruction of a
> %TEST-FOO sequence involves moving something into the temporary
> register, which is harmless.

Updated accordingly.


Thiemo


Index: src/assembly/mips/arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/arith.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 arith.lisp
--- src/assembly/mips/arith.lisp	3 Jun 2005 10:17:26 -0000	1.2
+++ src/assembly/mips/arith.lisp	9 Jun 2005 12:05:02 -0000
@@ -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,11 +161,8 @@
     (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-*))
Index: src/assembly/mips/assem-rtns.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/assem-rtns.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 assem-rtns.lisp
--- src/assembly/mips/assem-rtns.lisp	30 Apr 2005 09:40:41 -0000	1.2
+++ src/assembly/mips/assem-rtns.lisp	9 Jun 2005 12:05:02 -0000
@@ -146,9 +146,8 @@
 	
   DONE
   ;; We are done.  Do the jump.
-  (progn
-    (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
-    (lisp-jump temp lip)))
+  (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
+  (lisp-jump temp lip))
 
 
 ;;;; Non-local exit noise.
@@ -181,9 +180,8 @@
       
   (loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
   (loadw code-tn cur-uwp unwind-block-current-code-slot)
-  (progn
-    (loadw lra cur-uwp unwind-block-entry-pc-slot)
-    (lisp-return lra lip :frob-code nil))
+  (loadw lra cur-uwp unwind-block-entry-pc-slot)
+  (lisp-return lra lip :frob-code nil)
 
   do-uwp
 
@@ -212,12 +210,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
   
-  (move target catch)
   (inst j (make-fixup 'unwind :assembly-routine))
-  (inst nop))
+  (inst move target catch))
Index: src/assembly/mips/support.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/support.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 support.lisp
--- src/assembly/mips/support.lisp	2 Aug 2004 12:29:30 -0000	1.2
+++ src/assembly/mips/support.lisp	9 Jun 2005 12:05:02 -0000
@@ -34,7 +34,7 @@
 	    (emit-return-pc lra-label)
 	    (note-this-location ,vop :single-value-return)
 	    (without-scheduling ()
-	      (move csp-tn ocfp-tn)
+	      (inst move csp-tn ocfp-tn)
 	      (inst nop))
 	    (inst compute-code-from-lra code-tn code-tn
 		  lra-label ,temp)
Index: src/compiler/mips/arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/arith.lisp,v
retrieving revision 1.13
diff -u -p -r1.13 arith.lisp
--- src/compiler/mips/arith.lisp	19 Dec 2004 07:01:10 -0000	1.13
+++ src/compiler/mips/arith.lisp	9 Jun 2005 12:05:03 -0000
@@ -331,7 +331,7 @@
 	  (test (gen-label)))
       (move shift arg)
       (inst bgez shift test)
-      (move res zero-tn)
+      (inst move res zero-tn)
       (inst b test)
       (inst nor shift shift)
 
Index: src/compiler/mips/c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/c-call.lisp,v
retrieving revision 1.4
diff -u -p -r1.4 c-call.lisp
--- src/compiler/mips/c-call.lisp	20 May 2005 09:45:14 -0000	1.4
+++ src/compiler/mips/c-call.lisp	9 Jun 2005 12:05:03 -0000
@@ -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)
+      (inst move cfunc function)
       (when cur-nfp
 	(load-stack-tn cur-nfp nfp-save)))))
 
Index: src/compiler/mips/call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/call.lisp,v
retrieving revision 1.7
diff -u -p -r1.7 call.lisp
--- src/compiler/mips/call.lisp	4 May 2005 10:35:51 -0000	1.7
+++ src/compiler/mips/call.lisp	9 Jun 2005 12:05:03 -0000
@@ -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)))
+	      (inst move csp-tn ocfp-tn)))
 	
 	;; 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))
+	  (inst move ocfp-tn csp-tn))
 	
 	(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)))
+      (inst move count nargs)))
   (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)
+    (inst move cfp-tn ocfp-temp)
     (trace-table-entry trace-table-normal)))
 
 
@@ -812,8 +811,9 @@ default-value-8
 		 (return)))
 	   
 	   (note-this-location vop :call-site)
+	   (do-next-filler)
 	   (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,8 @@ 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))
+      (inst move nvals nvals-arg))
     (trace-table-entry trace-table-normal)))
 
 
@@ -1068,7 +1066,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)
+      (inst move dst csp-tn)
       ;; Initialize src to be end of args.
       (inst addu src cfp-tn nargs-tn)
 
@@ -1125,7 +1123,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)
+      (inst move result null-tn)
 
       ;; We need to do this atomically.
       (pseudo-atomic (pa-flag)
Index: src/compiler/mips/debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/debug.lisp,v
retrieving revision 1.1
diff -u -p -r1.1 debug.lisp
--- src/compiler/mips/debug.lisp	1 Sep 2002 22:34:18 -0000	1.1
+++ src/compiler/mips/debug.lisp	9 Jun 2005 12:05:03 -0000
@@ -92,7 +92,7 @@
       (assemble (*elsewhere*)
 	(emit-label bogus)
 	(inst b done)
-	(move code null-tn)))))
+	(inst move code null-tn)))))
 
 (define-vop (code-from-lra code-from-mumble)
   (:translate lra-code-header)
Index: src/compiler/mips/macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/macros.lisp,v
retrieving revision 1.8
diff -u -p -r1.8 macros.lisp
--- src/compiler/mips/macros.lisp	6 May 2005 18:58:37 -0000	1.8
+++ src/compiler/mips/macros.lisp	9 Jun 2005 12:05:03 -0000
@@ -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)))
+     (inst move code-tn ,function)))
 
 (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)
+	  `(inst move code-tn ,return-pc)
 	  '(inst nop))))
 
 
@@ -182,7 +182,7 @@
 
 
 ;;;; Error Code
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defun emit-error-break (vop kind code values)
     (let ((vector (gensym)))
       `((let ((vop ,vop))
@@ -252,9 +252,6 @@
      ,@forms
      (without-scheduling ()
        (let ((label (gen-label)))
-	 (inst nop)
-	 (inst nop)
-	 (inst nop)
 	 (inst bgez ,flag-tn label)
 	 (inst addu alloc-tn (1- ,extra))
 	 (inst break 16)
Index: src/compiler/mips/move.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/move.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 move.lisp
--- src/compiler/mips/move.lisp	27 Oct 2004 16:40:00 -0000	1.2
+++ src/compiler/mips/move.lisp	9 Jun 2005 12:05:03 -0000
@@ -239,7 +239,7 @@
     (inst sll y x 2)
       
     (pseudo-atomic
-	(pa-flag :extra (pad-data-block (+ bignum-digits-offset 2)))
+      (pa-flag :extra (pad-data-block (+ bignum-digits-offset 2)))
       (inst or y alloc-tn other-pointer-lowtag)
       (inst slt temp x zero-tn)
       (inst sll temp n-widetag-bits)
Index: src/compiler/mips/nlx.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/nlx.lisp,v
retrieving revision 1.4
diff -u -p -r1.4 nlx.lisp
--- src/compiler/mips/nlx.lisp	7 Mar 2003 12:15:28 -0000	1.4
+++ src/compiler/mips/nlx.lisp	9 Jun 2005 12:05:03 -0000
@@ -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)
+	     (inst move (tn-ref-tn values) null-tn)
 	     (loadw (tn-ref-tn values) start)
 	     (emit-label no-values)))
 	  (t
@@ -223,6 +223,7 @@
 	(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))
 	(control-stack (store-stack-tn new-count num)))
@@ -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.
Index: src/compiler/mips/values.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/values.lisp,v
retrieving revision 1.3
diff -u -p -r1.3 values.lisp
--- src/compiler/mips/values.lisp	13 Sep 2004 13:23:44 -0000	1.3
+++ src/compiler/mips/values.lisp	9 Jun 2005 12:05:03 -0000
@@ -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

Thiemo Seufer wrote:
> Christophe Rhodes wrote:
> [snip]
> > I'm pretty sure this extra nop, and similar ones you've added in
> > type-vops.lisp, aren't in fact necessary.  The first instruction of a
> > %TEST-FOO sequence involves moving something into the temporary
> > register, which is harmless.
> 
> Updated accordingly.

Ping?


Thiemo

Thiemo Seufer wrote:
> Christophe Rhodes wrote:
> [snip]
> > I'm pretty sure this extra nop, and similar ones you've added in
> > type-vops.lisp, aren't in fact necessary.  The first instruction of a
> > %TEST-FOO sequence involves moving something into the temporary
> > register, which is harmless.
> 
> Updated accordingly.

I decided to go one step further and make sure branch delay slots
are rather filled with nops than with nop-like moves. This may help
instruction scheduling on some CPUs. The always-emit-code-p parameter
of the move macro wasn't used before.

I also split the patch in more manageable pieces, the first one
as appended prefers only (move ...) instead of (inst move ...).


Thiemo


Index: src/compiler/mips/macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/macros.lisp,v
retrieving revision 1.8
diff -u -p -r1.8 macros.lisp
--- src/compiler/mips/macros.lisp	6 May 2005 18:58:37 -0000	1.8
+++ src/compiler/mips/macros.lisp	19 Jun 2005 19:17:50 -0000
@@ -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))
Index: src/assembly/mips/arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/arith.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 arith.lisp
--- src/assembly/mips/arith.lisp	3 Jun 2005 10:17:26 -0000	1.2
+++ src/assembly/mips/arith.lisp	19 Jun 2005 19:17:49 -0000
@@ -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)
@@ -175,9 +171,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)
 
   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)
Index: src/assembly/mips/assem-rtns.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/assem-rtns.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 assem-rtns.lisp
--- src/assembly/mips/assem-rtns.lisp	30 Apr 2005 09:40:41 -0000	1.2
+++ src/assembly/mips/assem-rtns.lisp	19 Jun 2005 19:17:50 -0000
@@ -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.
Index: src/compiler/mips/arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/arith.lisp,v
retrieving revision 1.13
diff -u -p -r1.13 arith.lisp
--- src/compiler/mips/arith.lisp	19 Dec 2004 07:01:10 -0000	1.13
+++ src/compiler/mips/arith.lisp	19 Jun 2005 19:17:50 -0000
@@ -229,7 +229,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.
Index: src/compiler/mips/call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/call.lisp,v
retrieving revision 1.7
diff -u -p -r1.7 call.lisp
--- src/compiler/mips/call.lisp	4 May 2005 10:35:51 -0000	1.7
+++ src/compiler/mips/call.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)
 	
@@ -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)
Index: src/compiler/mips/static-fn.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/static-fn.lisp,v
retrieving revision 1.3
diff -u -p -r1.3 static-fn.lisp
--- src/compiler/mips/static-fn.lisp	4 May 2005 10:35:51 -0000	1.3
+++ src/compiler/mips/static-fn.lisp	19 Jun 2005 19:17:50 -0000
@@ -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))
Index: src/compiler/mips/type-vops.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/type-vops.lisp,v
retrieving revision 1.3
diff -u -p -r1.3 type-vops.lisp
--- src/compiler/mips/type-vops.lisp	11 Jul 2003 08:38:12 -0000	1.3
+++ src/compiler/mips/type-vops.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)
Index: src/compiler/mips/values.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/values.lisp,v
retrieving revision 1.3
diff -u -p -r1.3 values.lisp
--- src/compiler/mips/values.lisp	13 Sep 2004 13:23:44 -0000	1.3
+++ src/compiler/mips/values.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)
Index: src/compiler/mips/cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/cell.lisp,v
retrieving revision 1.3
diff -u -p -r1.3 cell.lisp
--- src/compiler/mips/cell.lisp	12 Jun 2005 14:02:44 -0000	1.3
+++ src/compiler/mips/cell.lisp	19 Jun 2005 19:17:50 -0000
@@ -335,8 +336,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)
Index: src/compiler/mips/nlx.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/nlx.lisp,v
retrieving revision 1.4
diff -u -p -r1.4 nlx.lisp
--- src/compiler/mips/nlx.lisp	7 Mar 2003 12:15:28 -0000	1.4
+++ src/compiler/mips/nlx.lisp	19 Jun 2005 19:17:50 -0000
@@ -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.

Thiemo Seufer wrote:
> Christophe Rhodes wrote:
> [snip]
> > I'm pretty sure this extra nop, and similar ones you've added in
> > type-vops.lisp, aren't in fact necessary.  The first instruction of a
> > %TEST-FOO sequence involves moving something into the temporary
> > register, which is harmless.
> 
> Updated accordingly.

The second part of the revised version. It fixes many branch slot
correctness issues.


Thiemo


Index: src/assembly/mips/assem-rtns.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/assem-rtns.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 assem-rtns.lisp
--- src/assembly/mips/assem-rtns.lisp	30 Apr 2005 09:40:41 -0000	1.2
+++ src/assembly/mips/assem-rtns.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)
Index: src/assembly/mips/support.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/support.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 support.lisp
--- src/assembly/mips/support.lisp	2 Aug 2004 12:29:30 -0000	1.2
+++ src/assembly/mips/support.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)
Index: src/compiler/mips/call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/call.lisp,v
retrieving revision 1.7
diff -u -p -r1.7 call.lisp
--- src/compiler/mips/call.lisp	4 May 2005 10:35:51 -0000	1.7
+++ src/compiler/mips/call.lisp	19 Jun 2005 19:17:50 -0000
@@ -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))
@@ -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)))
 
 
@@ -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
@@ -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)
Index: src/compiler/mips/debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/debug.lisp,v
retrieving revision 1.1
diff -u -p -r1.1 debug.lisp
--- src/compiler/mips/debug.lisp	1 Sep 2002 22:34:18 -0000	1.1
+++ src/compiler/mips/debug.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)
Index: src/compiler/mips/macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/macros.lisp,v
retrieving revision 1.8
diff -u -p -r1.8 macros.lisp
--- src/compiler/mips/macros.lisp	6 May 2005 18:58:37 -0000	1.8
+++ src/compiler/mips/macros.lisp	19 Jun 2005 19:17:50 -0000
@@ -81,7 +82,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 +91,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))))
 
 
Index: src/compiler/mips/nlx.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/nlx.lisp,v
retrieving revision 1.4
diff -u -p -r1.4 nlx.lisp
--- src/compiler/mips/nlx.lisp	7 Mar 2003 12:15:28 -0000	1.4
+++ src/compiler/mips/nlx.lisp	19 Jun 2005 19:17:50 -0000
@@ -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.
Index: src/compiler/mips/arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/arith.lisp,v
retrieving revision 1.13
diff -u -p -r1.13 arith.lisp
--- src/compiler/mips/arith.lisp	19 Dec 2004 07:01:10 -0000	1.13
+++ src/compiler/mips/arith.lisp	19 Jun 2005 19:17:50 -0000
@@ -331,7 +331,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)

Thiemo Seufer wrote:
> Christophe Rhodes wrote:
> [snip]
> > I'm pretty sure this extra nop, and similar ones you've added in
> > type-vops.lisp, aren't in fact necessary.  The first instruction of a
> > %TEST-FOO sequence involves moving something into the temporary
> > register, which is harmless.
> 
> Updated accordingly.

The third part, preschedule to fill branch delay slots where possible.


Thiemo


Index: src/assembly/mips/arith.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/arith.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 arith.lisp
--- src/assembly/mips/arith.lisp	3 Jun 2005 10:17:26 -0000	1.2
+++ src/assembly/mips/arith.lisp	19 Jun 2005 19:17:49 -0000
@@ -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,11 +161,8 @@
     (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-*))
Index: src/assembly/mips/assem-rtns.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/assembly/mips/assem-rtns.lisp,v
retrieving revision 1.2
diff -u -p -r1.2 assem-rtns.lisp
--- src/assembly/mips/assem-rtns.lisp	30 Apr 2005 09:40:41 -0000	1.2
+++ src/assembly/mips/assem-rtns.lisp	19 Jun 2005 19:17:50 -0000
@@ -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))
Index: src/compiler/mips/c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/c-call.lisp,v
retrieving revision 1.4
diff -u -p -r1.4 c-call.lisp
--- src/compiler/mips/c-call.lisp	20 May 2005 09:45:14 -0000	1.4
+++ src/compiler/mips/c-call.lisp	19 Jun 2005 19:17:50 -0000
@@ -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)))))
 
Index: src/compiler/mips/call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/call.lisp,v
retrieving revision 1.7
diff -u -p -r1.7 call.lisp
--- src/compiler/mips/call.lisp	4 May 2005 10:35:51 -0000	1.7
+++ src/compiler/mips/call.lisp	19 Jun 2005 19:17:50 -0000
@@ -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))
 
 
@@ -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)))

Thiemo Seufer <ths@...> writes:

> I decided to go one step further and make sure branch delay slots
> are rather filled with nops than with nop-like moves. This may help
> instruction scheduling on some CPUs. The always-emit-code-p parameter
> of the move macro wasn't used before.
>
> I also split the patch in more manageable pieces, the first one
> as appended prefers only (move ...) instead of (inst move ...).

Thanks.  I merged this (and the two related patches) into
sbcl-0.9.2.21.  Please shout if I've broken anything!

Cheers,

Christophe