From d4fb62259d04a4513d6ae20ca9f2487c4dfe1c1a Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 19 May 2004 10:17:53 +0000 Subject: [PATCH] 0.8.10.35: Implement %%NIP-VALUES on Alpha --- NEWS | 5 +++-- src/compiler/alpha/values.lisp | 34 ++++++++++++++++++++++++++++++++++ src/compiler/ir2tran.lisp | 14 ++++++++------ tests/compiler.impure.lisp | 1 + version.lisp-expr | 2 +- 5 files changed, 47 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index f251dc9..f77510e 100644 --- a/NEWS +++ b/NEWS @@ -2415,8 +2415,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 X86 fixed bug 298, revealed by Paul F. Dietz' test suite: SBCL - can remove dead unknown-values globs from the middle of the stack. + * on 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/alpha/values.lisp b/src/compiler/alpha/values.lisp index 1c77585..6b385a4 100644 --- a/src/compiler/alpha/values.lisp +++ b/src/compiler/alpha/values.lisp @@ -16,6 +16,40 @@ (:generator 1 (move ptr csp-tn))) +(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 + (move last-nipped-ptr dest) + (move last-preserved-ptr src) + (inst cmple csp-tn src temp) + (inst bne temp DONE) + LOOP + (loadw temp src) + (inst addq dest n-word-bytes dest) + (inst addq src n-word-bytes src) + (storew temp dest -1) + (inst cmple csp-tn src temp) + (inst beq temp LOOP) + DONE + (inst lda csp-tn 0 dest) + (inst subq src dest src) + (loop for moved = moved-ptrs then (tn-ref-across moved) + while moved + do (sc-case (tn-ref-tn moved) + ((descriptor-reg any-reg) + (inst subq (tn-ref-tn moved) src (tn-ref-tn moved))) + ((control-stack) + (load-stack-tn temp (tn-ref-tn moved)) + (inst subq temp src temp) + (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 argument locations. Nvals is the number of values to diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 7c4e321..cdd89f6 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -1282,15 +1282,17 @@ (vop reset-stack-pointer node block (first (ir2-lvar-locs 2lvar))))) -(defoptimizer (%nip-values ir2-convert) ((last-nipped last-preserved &rest moved) +(defoptimizer (%nip-values ir2-convert) ((last-nipped last-preserved + &rest moved) node block) - #!-x86 + #!-(or x86 alpha) (bug "%NIP-VALUES is not implemented on this platform.") - #!+x86 - (let ((2after (lvar-info (lvar-value last-nipped))) - ; pointer immediately after the nipped block + #!+(or x86 alpha) + (let (;; pointer immediately after the nipped block + (2after (lvar-info (lvar-value last-nipped))) + ;; pointer to the first nipped word (2first (lvar-info (lvar-value last-preserved))) - ; pointer to the first nipped word + (moved-tns (loop for lvar-ref in moved for lvar = (lvar-value lvar-ref) for 2lvar = (lvar-info lvar) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 67152a1..33936a5 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -893,6 +893,7 @@ ;;;; MUFFLE-CONDITIONS test (corresponds to the test in the manual) (defvar *compiler-note-count* 0) +#-alpha ; KLUDGE (handler-bind ((sb-ext:compiler-note (lambda (c) (declare (ignore c)) (incf *compiler-note-count*)))) diff --git a/version.lisp-expr b/version.lisp-expr index 13a03f1..bd602f0 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.34" +"0.8.10.35" -- 1.7.10.4