From: Christophe Rhodes Date: Fri, 21 May 2004 13:59:16 +0000 (+0000) Subject: 0.8.10.44: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f1acc17f83cdfa9454a53bd0ee9bd0e9b9482817;p=sbcl.git 0.8.10.44: Implement %%NIP-VALUES on MIPS ... spookily similar to the sparc version, yes; ... MORE BOILERPLATE. --- diff --git a/NEWS b/NEWS index dea236b..26fedd7 100644 --- a/NEWS +++ b/NEWS @@ -2422,9 +2422,9 @@ 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 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. + * 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. * 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) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 4dde647..ed620a8 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -1285,9 +1285,9 @@ (defoptimizer (%nip-values ir2-convert) ((last-nipped last-preserved &rest moved) node block) - #!-(or x86 alpha sparc) + #!-(or x86 alpha sparc mips) (bug "%NIP-VALUES is not implemented on this platform.") - #!+(or x86 alpha sparc) + #!+(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 diff --git a/src/compiler/mips/insts.lisp b/src/compiler/mips/insts.lisp index 6ae9eb8..5e733fe 100644 --- a/src/compiler/mips/insts.lisp +++ b/src/compiler/mips/insts.lisp @@ -1,9 +1,18 @@ +;;; the instruction set definition for MIPS + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") (setf *assem-scheduler-p* t) (setf *assem-max-locations* 68) - - ;;;; Constants, types, conversion functions, some disassembler stuff. diff --git a/src/compiler/mips/values.lisp b/src/compiler/mips/values.lisp index c9427a1..ecee7d0 100644 --- a/src/compiler/mips/values.lisp +++ b/src/compiler/mips/values.lisp @@ -1,3 +1,14 @@ +;;;; the MIPS implementation of unknown-values VOPs + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") (define-vop (reset-stack-pointer) @@ -5,6 +16,42 @@ (:generator 1 (move csp-tn ptr))) +(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 move src last-preserved-ptr) + (inst move dest last-nipped-ptr) + (inst move temp zero-tn) + (inst sltu temp src csp-tn) + (inst beq temp zero-tn DONE) + (inst nop) ; not strictly necessary + LOOP + (loadw temp src) + (inst add dest dest n-word-bytes) + (inst add src src n-word-bytes) + (storew temp dest -1) + (inst sltu temp src csp-tn) + (inst bne temp zero-tn LOOP) + (inst nop) + DONE + (inst move 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 @@ -42,10 +89,8 @@ (move start start-temp) (inst li count (fixnumize nvals)))) - ;;; Push a list of values on the stack, returning Start and Count as used in ;;; unknown values continuations. -;;; (define-vop (values-list) (:args (arg :scs (descriptor-reg) :target list)) (:arg-types list) @@ -76,10 +121,8 @@ DONE (inst subu count csp-tn start))) - ;;; Copy the more arg block to the top of the stack so we can use them ;;; as function arguments. -;;; (define-vop (%more-arg-values) (:args (context :scs (descriptor-reg any-reg) :target src) (skip :scs (any-reg zero immediate)) diff --git a/version.lisp-expr b/version.lisp-expr index d5c45db..c058216 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.8.10.43" +"0.8.10.44"