0.8.10.45:
authorChristophe Rhodes <csr21@cam.ac.uk>
Sat, 22 May 2004 09:09:02 +0000 (09:09 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Sat, 22 May 2004 09:09:02 +0000 (09:09 +0000)
Merge %%NIP-VALUES for PPC (David Steuber sbcl-devel 2004-05-22)
... s/spark/sparc/ :-)
... claim that it's fixed even though I haven't guessed at the
HPPA version.  The next person who wants to build on
HPPA gets to implement it.

NEWS
src/compiler/ir2tran.lisp
src/compiler/ppc/values.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 26fedd7..c591c77 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2422,9 +2422,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
     (reported by Antonio Menezes Leitao)
   * fixed bug 307: The obsolete instance protocol ensures that
     subclasses are properly obsoleted.  (thanks to Nikodemus Siivola)
-  * on MIPS, SPARC, X86 and Alpha fixed bug 298, revealed by Paul
-    F. Dietz' test suite: SBCL can remove dead unknown-values globs
-    from the middle of the stack.
+  * fixed bug 298, revealed by Paul F. Dietz' test suite: SBCL can
+    remove dead unknown-values globs from the middle of the stack.
   * added a new restart to *BREAK-ON-SIGNALS* handling to make it
     easier to resume long computations after using *BREAK-ON-SIGNALS*
     to diagnose and fix failures.  (thanks to Nikodemus Siivola)
index ed620a8..cf611d4 100644 (file)
 (defoptimizer (%nip-values ir2-convert) ((last-nipped last-preserved 
                                                      &rest moved)
                                          node block)
-  #!-(or x86 alpha sparc mips)
-  (bug "%NIP-VALUES is not implemented on this platform.")
-  #!+(or x86 alpha sparc mips)
   (let (;; pointer immediately after the nipped block
        (2after (lvar-info (lvar-value last-nipped)))
        ;; pointer to the first nipped word
index 9e0efc2..c3b2340 100644 (file)
   (:generator 1
     (move csp-tn ptr)))
 
+;;; sparc version translated to ppc by David Steuber with help from #lisp.
+(define-vop (%%nip-values)
+  (:args (last-nipped-ptr :scs (any-reg) :target dest)
+         (last-preserved-ptr :scs (any-reg) :target src)
+         (moved-ptrs :scs (any-reg) :more t))
+  (:results (r-moved-ptrs :scs (any-reg) :more t))
+  (:temporary (:sc any-reg) src)
+  (:temporary (:sc any-reg) dest)
+  (:temporary (:sc non-descriptor-reg) temp)
+  (:ignore r-moved-ptrs)
+  (:generator 1
+    (inst mr dest last-nipped-ptr)
+    (inst mr src last-preserved-ptr)
+    (inst cmplw csp-tn src)
+    (inst ble DONE)
+    LOOP
+    (loadw temp src)
+    (inst addi dest dest n-word-bytes)
+    (inst addi src src n-word-bytes)
+    (storew temp dest -1)
+    (inst cmplw csp-tn src)
+    (inst bgt LOOP)
+    DONE
+    (inst mr csp-tn dest)
+    (inst sub src src dest)
+    (loop for moved = moved-ptrs then (tn-ref-across moved)
+          while moved
+          do (sc-case (tn-ref-tn moved)
+               ((descriptor-reg any-reg)
+                (inst sub (tn-ref-tn moved) (tn-ref-tn moved) src))
+               ((control-stack)
+                (load-stack-tn temp (tn-ref-tn moved))
+                (inst sub temp temp src)
+                (store-stack-tn (tn-ref-tn moved) temp))))))
+
 
 ;;; Push some values onto the stack, returning the start and number of values
 ;;; pushed as results.  It is assumed that the Vals are wired to the standard
index c058216..6f83b1c 100644 (file)
@@ -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.8.10.44"
+"0.8.10.45"