From 26a7e29ef5e1fc86298baa6c69178aa8b1e3a2d7 Mon Sep 17 00:00:00 2001
From: Thiemo Seufer <ths@networkno.de>
Date: Wed, 28 Sep 2005 13:42:24 +0000
Subject: [PATCH] 0.9.5.6: 	Random collection of small code
 improvements.

---
 src/code/debug-int.lisp     |   43 ++++++++++++++++++++++---------------------
 src/compiler/mips/call.lisp |    3 ++-
 src/compiler/mips/nlx.lisp  |    2 +-
 version.lisp-expr           |    2 +-
 4 files changed, 26 insertions(+), 24 deletions(-)

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 4149832..47dc215 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -823,6 +823,7 @@
                                                         escaped)
                                  (if up-frame (1+ (frame-number up-frame)) 0)
                                  escaped))))))
+
 #!+(or x86 x86-64)
 (defun compute-calling-frame (caller ra up-frame)
   (declare (type system-area-pointer caller ra))
@@ -992,14 +993,14 @@ register."
         (or (fun-code-header object)
             :undefined-function)
         (let ((lowtag (lowtag-of object)))
-          (if (= lowtag sb!vm:other-pointer-lowtag)
-              (let ((widetag (widetag-of object)))
-                (cond ((= widetag sb!vm:code-header-widetag)
-                       object)
-                      ((= widetag sb!vm:return-pc-header-widetag)
-                       (lra-code-header object))
-                      (t
-                       nil))))))))
+          (when (= lowtag sb!vm:other-pointer-lowtag)
+            (let ((widetag (widetag-of object)))
+              (cond ((= widetag sb!vm:code-header-widetag)
+                     object)
+                    ((= widetag sb!vm:return-pc-header-widetag)
+                     (lra-code-header object))
+                    (t
+                     nil))))))))
 
 ;;;; frame utilities
 
@@ -3136,19 +3137,19 @@ register."
   ;; no more breakpoints active at this location, then the normal
   ;; instruction has been put back, and we do not need to
   ;; DO-DISPLACED-INST.
-  (let ((data (breakpoint-data component offset nil)))
-    (when (and data (breakpoint-data-breakpoints data))
-      ;; The breakpoint is still active, so we need to execute the
-      ;; displaced instruction and leave the breakpoint instruction
-      ;; behind. The best way to do this is different on each machine,
-      ;; so we just leave it up to the C code.
-      (breakpoint-do-displaced-inst signal-context
-                                    (breakpoint-data-instruction data))
-      ;; Some platforms have no usable sigreturn() call.  If your
-      ;; implementation of arch_do_displaced_inst() _does_ sigreturn(),
-      ;; it's polite to warn here
-      #!+(and sparc solaris)
-      (error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
+  (setf data (breakpoint-data component offset nil))
+  (when (and data (breakpoint-data-breakpoints data))
+    ;; The breakpoint is still active, so we need to execute the
+    ;; displaced instruction and leave the breakpoint instruction
+    ;; behind. The best way to do this is different on each machine,
+    ;; so we just leave it up to the C code.
+    (breakpoint-do-displaced-inst signal-context
+                                  (breakpoint-data-instruction data))
+    ;; Some platforms have no usable sigreturn() call.  If your
+    ;; implementation of arch_do_displaced_inst() _does_ sigreturn(),
+    ;; it's polite to warn here
+    #!+(and sparc solaris)
+    (error "BREAKPOINT-DO-DISPLACED-INST returned?")))
 
 (defun invoke-breakpoint-hooks (breakpoints component offset)
   (let* ((debug-fun (debug-fun-from-pc component offset))
diff --git a/src/compiler/mips/call.lisp b/src/compiler/mips/call.lisp
index 3168b88..03408ca 100644
--- a/src/compiler/mips/call.lisp
+++ b/src/compiler/mips/call.lisp
@@ -53,6 +53,7 @@
    (make-wired-tn *fixnum-primitive-type*
                   control-stack-arg-scn
                   ocfp-save-offset)))
+
 (!def-vm-support-routine make-return-pc-save-location (env)
   (let ((ptype *backend-t-primitive-type*))
     (specify-save-tn
@@ -267,7 +268,7 @@ default-value-8
         ;; gets confused.
         (without-scheduling ()
           (note-this-location vop :single-value-return)
-          (inst move csp-tn ocfp-tn)
+          (move csp-tn ocfp-tn t)
           (inst nop))
         (when lra-label
           (inst compute-code-from-lra code-tn code-tn lra-label temp)))
diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp
index b59518f..ed25b12 100644
--- a/src/compiler/mips/nlx.lisp
+++ b/src/compiler/mips/nlx.lisp
@@ -232,8 +232,8 @@
       (emit-label loop)
       (loadw temp src)
       (inst addu src src n-word-bytes)
-      (storew temp dst)
       (inst addu num num (fixnumize -1))
+      (storew temp dst)
       (inst bne num zero-tn loop)
       (inst addu dst dst n-word-bytes)
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 98f4850..d73e05c 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.5.5"
+"0.9.5.6"
-- 
1.7.10.4