From 8097f555eb90f15c51b96e20bd88db15757247b9 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 12 Mar 2002 15:47:52 +0000 Subject: [PATCH] 0.7.1.37: merged CSR --- build-order.lisp-expr | 6 ++++-- src/code/late-format.lisp | 13 ++++++++----- src/compiler/x86/array.lisp | 36 ++++++++++++++++++++++++++++++++++++ tests/print.impure.lisp | 22 ++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 71 insertions(+), 8 deletions(-) diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 921c0d4..8c77713 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -515,7 +515,8 @@ ("src/compiler/target/nlx") ("src/compiler/target/show") ("src/compiler/target/array" - ;; KLUDGE: Compiling this file raises alarming warnings of the form + ;; KLUDGE: Compiling this file for X86 raises alarming warnings of + ;; the form ;; Argument FOO to VOP CHECK-BOUND has SC restriction ;; DESCRIPTOR-REG which is not allowed by the operand type: ;; (:OR POSITIVE-FIXNUM) @@ -525,7 +526,8 @@ ;; these warnings are severe enough that they would ordinarily abort ;; compilation, for now we blithely ignore them and press on to more ;; pressing problems. Someday, though, it would be nice to figure out - ;; what the problem is and fix it.. -- WHN 19990323 + ;; what the problem is and fix it. (See the comments in + ;; src/compiler/x86/array for a candidate patch.) -- WHN 19990323 :ignore-failure-p) ("src/compiler/target/pred") ("src/compiler/target/type-vops") diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index d84c503..9063fa4 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -1158,8 +1158,8 @@ ;; subseq expansion. (subseq foo (1+ slash) (1- end))))) (first-colon (position #\: name)) - (last-colon (if first-colon (position #\: name :from-end t))) - (package-name (if last-colon + (second-colon (if first-colon (position #\: name :start (1+ first-colon)))) + (package-name (if first-colon (subseq name 0 first-colon) "COMMON-LISP-USER")) (package (find-package package-name))) @@ -1169,7 +1169,10 @@ (error 'format-error :complaint "no package named ~S" :args (list package-name))) - (intern (if first-colon - (subseq name (1+ first-colon)) - name) + (intern (cond + ((and second-colon (= second-colon (1+ first-colon))) + (subseq name (1+ second-colon))) + (first-colon + (subseq name (1+ first-colon))) + (t name)) package)))) diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp index a7828a0d..7228e6d 100644 --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -72,6 +72,42 @@ ;;; Note that the immediate SC for the index argument is disabled ;;; because it is not possible to generate a valid error code SC for ;;; an immediate value. +;;; +;;; FIXME: As per the KLUDGE note explaining the :IGNORE-FAILURE-P +;;; flag in build-order.lisp-expr, compiling this file causes warnings +;;; Argument FOO to VOP CHECK-BOUND has SC restriction +;;; DESCRIPTOR-REG which is not allowed by the operand type: +;;; (:OR POSITIVE-FIXNUM) +;;; CSR's message "format ~/ /" on sbcl-devel 2002-03-12 contained +;;; a possible patch, described as +;;; Another patch is included more for information than anything -- +;;; removing the descriptor-reg SCs from the CHECK-BOUND vop in +;;; x86/array.lisp seems to allow that file to compile without error[*], +;;; and build; I haven't tested rebuilding capability, but I'd be +;;; surprised if there were a problem. I'm not certain that this is the +;;; correct fix, though, as the restrictions on the arguments to the VOP +;;; aren't the same as in the sparc and alpha ports, where, incidentally, +;;; the corresponding file builds without error currently. +;;; Since neither of us (CSR or WHN) was quite sure that this is the +;;; right thing, I've just recorded the patch here in hopes it might +;;; help when someone attacks this problem again: +;;; diff -u -r1.7 array.lisp +;;; --- src/compiler/x86/array.lisp 11 Oct 2001 14:05:26 -0000 1.7 +;;; +++ src/compiler/x86/array.lisp 12 Mar 2002 12:23:37 -0000 +;;; @@ -76,10 +76,10 @@ +;;; (:translate %check-bound) +;;; (:policy :fast-safe) +;;; (:args (array :scs (descriptor-reg)) +;;; - (bound :scs (any-reg descriptor-reg)) +;;; - (index :scs (any-reg descriptor-reg #+nil immediate) :target result)) +;;; + (bound :scs (any-reg)) +;;; + (index :scs (any-reg #+nil immediate) :target result)) +;;; (:arg-types * positive-fixnum tagged-num) +;;; - (:results (result :scs (any-reg descriptor-reg))) +;;; + (:results (result :scs (any-reg))) +;;; (:result-types positive-fixnum) +;;; (:vop-var vop) +;;; (:save-p :compute-only) (define-vop (check-bound) (:translate %check-bound) (:policy :fast-safe) diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp index c0064d1..d9fa69e 100644 --- a/tests/print.impure.lisp +++ b/tests/print.impure.lisp @@ -63,5 +63,27 @@ (assert (string= (format nil "~1,3,8,' $" 7.3) " 007.3")) (assert (string= (format nil "~2,3,8,'0$" 7.3) "00007.30")) +;;; Check for symbol lookup in ~/ / directive -- double-colon was +;;; broken in 0.7.1.36 and earlier +(defun print-foo (stream arg colonp atsignp &rest params) + (declare (ignore colonp atsignp params)) + (format stream "~d" arg)) + +(assert (string= (format nil "~/print-foo/" 2) "2")) +(assert (string= (format nil "~/cl-user:print-foo/" 2) "2")) +(assert (string= (format nil "~/cl-user::print-foo/" 2) "2")) +(assert (raises-error? (format nil "~/cl-user:::print-foo/" 2))) +(assert (raises-error? (format nil "~/cl-user:a:print-foo/" 2))) +(assert (raises-error? (format nil "~/a:cl-user:print-foo/" 2))) +(assert (raises-error? (format nil "~/cl-user:print-foo:print-foo/" 2))) + +;;; better make sure that we get this one right, too +(defun print-foo\:print-foo (stream arg colonp atsignp &rest params) + (declare (ignore colonp atsignp params)) + (format stream "~d" arg)) + +(assert (string= (format nil "~/cl-user:print-foo:print-foo/" 2) "2")) +(assert (string= (format nil "~/cl-user::print-foo:print-foo/" 2) "2")) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 4d77eb1..4306c93 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.36" +"0.7.1.37" -- 1.7.10.4