From: William Harold Newman Date: Mon, 16 Apr 2001 14:05:41 +0000 (+0000) Subject: 0.6.11.38: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=231721189e1e2431597dc013aaf5eee01bc41a51;p=sbcl.git 0.6.11.38: got rid of CONDITION-FUNCTION-NAME logic, since it was messy and it didn't work very well and, given BACKTRACE, it seemed mostly redundant bumped fasl file version since CONDITION layout changed renamed FIND-CALLER-NAME to FIND-CALLER-NAME-AND-FRAME used BREAK's *STACK-TOP-HINT* idiom in ERROR and CERROR too removed PRINT-SIMPLE-ERROR stuff, so that SIMPLE-ERROR just prints as SIMPLE-CONDITION WHITESPACE-CHAR-P belongs in target-char.lisp (and in SB!INT). --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 88fead7..662458a 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -754,6 +754,7 @@ retained, possibly temporariliy, because it might be used internally." ;; misc. utilities used internally "LEGAL-FUNCTION-NAME-P" "FUNCTION-NAME-BLOCK-NAME" + "WHITESPACE-CHAR-P" "LISTEN-SKIP-WHITESPACE" "PACKAGE-INTERNAL-SYMBOL-COUNT" "PACKAGE-EXTERNAL-SYMBOL-COUNT" "PROPER-LIST-OF-LENGTH-P" @@ -1133,7 +1134,7 @@ is a good idea, but see SB-SYS for blurring of boundaries." "%COERCE-CALLABLE-TO-FUNCTION" "FUNCTION-SUBTYPE" "*MAXIMUM-ERROR-DEPTH*" "%SET-SYMBOL-PLIST" "INFINITE-ERROR-PROTECT" - "FIND-CALLER-NAME" + "FIND-CALLER-NAME-AND-FRAME" "%SET-SYMBOL-VALUE" "%SET-SYMBOL-PACKAGE" "OUTPUT-SYMBOL-NAME" "FSET" "RAW-DEFINITION" @@ -1195,7 +1196,7 @@ is a good idea, but see SB-SYS for blurring of boundaries." "MAKE-UNDEFINED-CLASS" "CLASS-DIRECT-SUPERCLASSES" "MAKE-LAYOUT" "BYTE-FUNCTION-TYPE" "REDEFINE-LAYOUT-WARNING" "SLOT-CLASS" - "INSURED-FIND-CLASS" "CONDITION-FUNCTION-NAME" + "INSURED-FIND-CLASS" ;; symbols from former SB!CONDITIONS "*HANDLER-CLUSTERS*" "*RESTART-CLUSTERS*" diff --git a/src/code/cold-error.lisp b/src/code/cold-error.lisp index b2089e0..6e89c6b 100644 --- a/src/code/cold-error.lisp +++ b/src/code/cold-error.lisp @@ -68,6 +68,15 @@ :format-control "bad argument to ~S: ~S" :format-arguments (list function-name datum))))) +;;; a shared idiom in ERROR, CERROR, and BREAK: The user probably +;;; doesn't want to hear that the error "occurred in" one of these +;;; functions, so we try to point the top of the stack to our caller +;;; instead. +(eval-when (:compile-toplevel :execute) + (defmacro-mundanely maybe-find-stack-top-hint () + `(or sb!debug:*stack-top-hint* + (nth-value 1 (sb!kernel:find-caller-name-and-frame))))) + (defun error (datum &rest arguments) #!+sb-doc "Invoke the signal facility on a condition formed from datum and arguments. @@ -80,16 +89,7 @@ (sb!kernel:infinite-error-protect (let ((condition (coerce-to-condition datum arguments 'simple-error 'error)) - ;; FIXME: Why is *STACK-TOP-HINT* in SB-DEBUG instead of SB-DI? - ;; SB-DEBUG should probably be only for true interface stuff. - (sb!debug:*stack-top-hint* sb!debug:*stack-top-hint*)) - (unless (and (condition-function-name condition) - sb!debug:*stack-top-hint*) - (multiple-value-bind (name frame) (sb!kernel:find-caller-name) - (unless (condition-function-name condition) - (setf (condition-function-name condition) name)) - (unless sb!debug:*stack-top-hint* - (setf sb!debug:*stack-top-hint* frame)))) + (sb!debug:*stack-top-hint* (maybe-find-stack-top-hint))) (let ((sb!debug:*stack-top-hint* nil)) (signal condition)) (invoke-debugger condition)))) @@ -104,14 +104,7 @@ arguments 'simple-error 'error))) - (sb!debug:*stack-top-hint* sb!debug:*stack-top-hint*)) - (unless (and (condition-function-name condition) - sb!debug:*stack-top-hint*) - (multiple-value-bind (name frame) (sb!kernel:find-caller-name) - (unless (condition-function-name condition) - (setf (condition-function-name condition) name)) - (unless sb!debug:*stack-top-hint* - (setf sb!debug:*stack-top-hint* frame)))) + (sb!debug:*stack-top-hint* (maybe-find-stack-top-hint))) (with-condition-restarts condition (list (find-restart 'continue)) (let ((sb!debug:*stack-top-hint* nil)) (signal condition)) @@ -124,9 +117,7 @@ of condition handling occurring." (sb!kernel:infinite-error-protect (with-simple-restart (continue "Return from BREAK.") - (let ((sb!debug:*stack-top-hint* - (or sb!debug:*stack-top-hint* - (nth-value 1 (sb!kernel:find-caller-name))))) + (let ((sb!debug:*stack-top-hint* (maybe-find-stack-top-hint))) (invoke-debugger (coerce-to-condition datum arguments 'simple-condition 'break))))) nil) diff --git a/src/code/error.lisp b/src/code/error.lisp index 78b73a1..3f6c497 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -27,9 +27,10 @@ () (:report (lambda (condition stream) - (format stream "Layout-invalid error in ~S:~@ - Type test of class ~S was passed obsolete instance:~% ~S" - (condition-function-name condition) + (format stream + "~@" (sb!kernel:class-proper-name (type-error-expected-type condition)) (type-error-datum condition))))) @@ -38,7 +39,8 @@ (possibilities :reader case-failure-possibilities :initarg :possibilities)) (:report (lambda (condition stream) - (format stream "~@<~S fell through ~S expression. ~:_Wanted one of ~:S.~:>" + (format stream "~@<~S fell through ~S expression. ~ + ~:_Wanted one of ~:S.~:>" (type-error-datum condition) (case-failure-name condition) (case-failure-possibilities condition))))) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 0d6163e..c3a4f09 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -68,165 +68,138 @@ (deferr object-not-function-error (object) (error 'type-error - :function-name name :datum object :expected-type 'function)) (deferr object-not-list-error (object) (error 'type-error - :function-name name :datum object :expected-type 'list)) (deferr object-not-bignum-error (object) (error 'type-error - :function-name name :datum object :expected-type 'bignum)) (deferr object-not-ratio-error (object) (error 'type-error - :function-name name :datum object :expected-type 'ratio)) (deferr object-not-single-float-error (object) (error 'type-error - :function-name name :datum object :expected-type 'single-float)) (deferr object-not-double-float-error (object) (error 'type-error - :function-name name :datum object :expected-type 'double-float)) #!+long-float (deferr object-not-long-float-error (object) (error 'type-error - :function-name name :datum object :expected-type 'long-float)) (deferr object-not-simple-string-error (object) (error 'type-error - :function-name name :datum object :expected-type 'simple-string)) (deferr object-not-simple-bit-vector-error (object) (error 'type-error - :function-name name :datum object :expected-type 'simple-bit-vector)) (deferr object-not-simple-vector-error (object) (error 'type-error - :function-name name :datum object :expected-type 'simple-vector)) (deferr object-not-fixnum-error (object) (error 'type-error - :function-name name :datum object :expected-type 'fixnum)) (deferr object-not-function-or-symbol-error (object) (error 'type-error - :function-name name :datum object :expected-type '(or function symbol))) (deferr object-not-vector-error (object) (error 'type-error - :function-name name :datum object :expected-type 'vector)) (deferr object-not-string-error (object) (error 'type-error - :function-name name :datum object :expected-type 'string)) (deferr object-not-bit-vector-error (object) (error 'type-error - :function-name name :datum object :expected-type 'bit-vector)) (deferr object-not-array-error (object) (error 'type-error - :function-name name :datum object :expected-type 'array)) (deferr object-not-number-error (object) (error 'type-error - :function-name name :datum object :expected-type 'number)) (deferr object-not-rational-error (object) (error 'type-error - :function-name name :datum object :expected-type 'rational)) (deferr object-not-float-error (object) (error 'type-error - :function-name name :datum object :expected-type 'float)) (deferr object-not-real-error (object) (error 'type-error - :function-name name :datum object :expected-type 'real)) (deferr object-not-integer-error (object) (error 'type-error - :function-name name :datum object :expected-type 'integer)) (deferr object-not-cons-error (object) (error 'type-error - :function-name name :datum object :expected-type 'cons)) (deferr object-not-symbol-error (object) (error 'type-error - :function-name name :datum object :expected-type 'symbol)) (deferr undefined-symbol-error (fdefn-or-symbol) (error 'undefined-function - :function-name name :name (etypecase fdefn-or-symbol (symbol fdefn-or-symbol) (fdefn (fdefn-name fdefn-or-symbol))))) (deferr object-not-coerceable-to-function-error (object) (error 'type-error - :function-name name :datum object :expected-type 'coerceable-to-function)) (deferr invalid-argument-count-error (nargs) (error 'simple-program-error - :function-name name :format-control "invalid number of arguments: ~S" :format-arguments (list nargs))) (deferr bogus-argument-to-values-list-error (list) (error 'simple-type-error - :function-name name :datum list :expected-type 'list :format-control @@ -234,42 +207,37 @@ :format-arguments (list list))) (deferr unbound-symbol-error (symbol) - (error 'unbound-variable :function-name name :name symbol)) + (error 'unbound-variable :name symbol)) (deferr object-not-base-char-error (object) (error 'type-error - :function-name name :datum object :expected-type 'base-char)) (deferr object-not-sap-error (object) (error 'type-error - :function-name name :datum object :expected-type 'system-area-pointer)) (deferr invalid-unwind-error () (error 'simple-control-error - :function-name name :format-control - "attempt to RETURN-FROM a block or GO to a tag that no longer exists")) + "attempt to RETURN-FROM a block or GO to a tag that no longer exists" + )) (deferr unseen-throw-tag-error (tag) (error 'simple-control-error - :function-name name :format-control "attempt to THROW to a tag that does not exist: ~S" :format-arguments (list tag))) (deferr nil-function-returned-error (function) (error 'simple-control-error - :function-name name :format-control "A function with declared result type NIL returned:~% ~S" :format-arguments (list function))) (deferr division-by-zero-error (this that) (error 'division-by-zero - :function-name name :operation 'division :operands (list this that))) @@ -278,193 +246,163 @@ (layout-invalid (%instance-layout object))) 'layout-invalid 'type-error) - :function-name name :datum object :expected-type type)) (deferr layout-invalid-error (object layout) (error 'layout-invalid - :function-name name :datum object :expected-type (layout-class layout))) (deferr odd-key-arguments-error () (error 'simple-program-error - :function-name name :format-control "odd number of &KEY arguments")) (deferr unknown-key-argument-error (key-name) (error 'simple-program-error - :function-name name :format-control "unknown &KEY argument: ~S" :format-arguments (list key-name))) (deferr invalid-array-index-error (array bound index) (error 'simple-error - :function-name name :format-control "invalid array index ~D for ~S (should be nonnegative and <~D)" :format-arguments (list index array bound))) (deferr object-not-simple-array-error (object) (error 'type-error - :function-name name :datum object :expected-type 'simple-array)) (deferr object-not-signed-byte-32-error (object) (error 'type-error - :function-name name :datum object :expected-type '(signed-byte 32))) (deferr object-not-unsigned-byte-32-error (object) (error 'type-error - :function-name name :datum object :expected-type '(unsigned-byte 32))) (deferr object-not-simple-array-unsigned-byte-2-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (unsigned-byte 2) (*)))) (deferr object-not-simple-array-unsigned-byte-4-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (unsigned-byte 4) (*)))) (deferr object-not-simple-array-unsigned-byte-8-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (unsigned-byte 8) (*)))) (deferr object-not-simple-array-unsigned-byte-16-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (unsigned-byte 16) (*)))) (deferr object-not-simple-array-unsigned-byte-32-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (unsigned-byte 32) (*)))) (deferr object-not-simple-array-signed-byte-8-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (signed-byte 8) (*)))) (deferr object-not-simple-array-signed-byte-16-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (signed-byte 16) (*)))) (deferr object-not-simple-array-signed-byte-30-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (signed-byte 30) (*)))) (deferr object-not-simple-array-signed-byte-32-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (signed-byte 32) (*)))) (deferr object-not-simple-array-single-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array single-float (*)))) (deferr object-not-simple-array-double-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array double-float (*)))) (deferr object-not-simple-array-complex-single-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (complex single-float) (*)))) (deferr object-not-simple-array-complex-double-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (complex double-float) (*)))) #!+long-float (deferr object-not-simple-array-complex-long-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(simple-array (complex long-float) (*)))) (deferr object-not-complex-error (object) (error 'type-error - :function-name name :datum object :expected-type 'complex)) (deferr object-not-complex-rational-error (object) (error 'type-error - :function-name name :datum object :expected-type '(complex rational))) (deferr object-not-complex-single-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(complex single-float))) (deferr object-not-complex-double-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(complex double-float))) #!+long-float (deferr object-not-complex-long-float-error (object) (error 'type-error - :function-name name :datum object :expected-type '(complex long-float))) (deferr object-not-weak-pointer-error (object) (error 'type-error - :function-name name :datum object :expected-type 'weak-pointer)) (deferr object-not-instance-error (object) (error 'type-error - :function-name name :datum object :expected-type 'instance)) (deferr object-not-complex-vector-error (object) (error 'type-error - :function-name name :datum object :expected-type '(and vector (not simple-array)))) ;;;; fetching errorful function name -;;; This variable is used to prevent infinite recursive lossage when +;;; This flag is used to prevent infinite recursive lossage when ;;; we can't find the caller for some reason. (defvar *finding-name* nil) -(defun find-caller-name () +(defun find-caller-name-and-frame () (if *finding-name* (values "" nil) (handler-case @@ -520,7 +458,6 @@ (svref *internal-errors* error-number)))) (cond ((null handler) (error 'simple-error - :function-name name :format-control "unknown internal error, ~D? args=~S" :format-arguments @@ -531,7 +468,6 @@ arguments)))) ((not (functionp handler)) (error 'simple-error - :function-name name :format-control "internal error ~D: ~A; args=~S" :format-arguments (list error-number diff --git a/src/code/late-target-error.lisp b/src/code/late-target-error.lisp index fc31a55..af708fe 100644 --- a/src/code/late-target-error.lisp +++ b/src/code/late-target-error.lisp @@ -54,11 +54,9 @@ condition-class make-condition-class) (:copier nil)) - - (function-name nil) ;; actual initargs supplied to MAKE-CONDITION (actual-initargs (required-argument) :type list) - ;; plist mapping slot names to any values that were assigned or + ;; a plist mapping slot names to any values that were assigned or ;; defaulted after creation (assigned-slots () :type list)) @@ -562,39 +560,19 @@ (define-condition simple-warning (simple-condition warning) ()) -(defun print-simple-error (condition stream) - (format stream - ;; FIXME: It seems reasonable to display the "in function - ;; ~S" information, but doesn't the logic to display it - ;; belong in the debugger or someplace like that instead of - ;; in the format string for this particular family of - ;; conditions? Then this printer might look more - ;; ("~@<~S: ~2I~:_~?~:>" (TYPE-OF C) ..) instead. - "~@" - (condition-function-name condition) - (simple-condition-format-control condition) - (simple-condition-format-arguments condition))) - -(define-condition simple-error (simple-condition error) () - ;; This is the condition type used by ERROR and CERROR when - ;; a format-control string is supplied as the first argument. - (:report print-simple-error)) +;;; This is the condition type used by ERROR and CERROR when +;;; a format-control string is supplied as the first argument. +(define-condition simple-error (simple-condition error) ()) (define-condition storage-condition (serious-condition) ()) -;;; FIXME: Should we really be reporting CONDITION-FUNCTION-NAME data -;;; on an ad hoc basis, for some conditions and not others? Why not -;;; standardize it somehow? perhaps by making the debugger report it? - (define-condition type-error (error) ((datum :reader type-error-datum :initarg :datum) (expected-type :reader type-error-expected-type :initarg :expected-type)) (:report (lambda (condition stream) (format stream - "~@" - (condition-function-name condition) + "~@" (type-error-datum condition) (type-error-expected-type condition))))) @@ -608,7 +586,7 @@ (:report (lambda (condition stream) (format stream - "END-OF-FILE on ~S" + "end of file on ~S" (stream-error-stream condition))))) (define-condition file-error (error) @@ -616,8 +594,12 @@ (:report (lambda (condition stream) (format stream - "~@" - (condition-function-name condition) + "~@" + (file-error-pathname condition) + ;; FIXME: ANSI's FILE-ERROR doesn't have FORMAT-CONTROL and + ;; FORMAT-ARGUMENTS, and the inheritance here doesn't seem + ;; to give us FORMAT-CONTROL or FORMAT-ARGUMENTS either. + ;; So how does this work? (serious-condition-format-control condition) (serious-condition-format-arguments condition))))) @@ -631,16 +613,14 @@ (:report (lambda (condition stream) (format stream - "error in ~S: The variable ~S is unbound." - (condition-function-name condition) + "The variable ~S is unbound." (cell-error-name condition))))) (define-condition undefined-function (cell-error) () (:report (lambda (condition stream) (format stream - "error in ~S: The function ~S is undefined." - (condition-function-name condition) + "The function ~S is undefined." (cell-error-name condition))))) (define-condition arithmetic-error (error) @@ -674,8 +654,6 @@ (format stream "~S cannot be printed readably." obj))))) (define-condition reader-error (parse-error stream-error) - ;; FIXME: Do we need FORMAT-CONTROL and FORMAT-ARGUMENTS when - ;; we have an explicit :REPORT function? I thought we didn't.. ((format-control :reader reader-error-format-control :initarg :format-control) @@ -727,8 +705,7 @@ (:report (lambda (condition stream) (format stream - "error in ~S: ~S: index too large" - (condition-function-name condition) + "The index ~S is too large." (type-error-datum condition))))) (define-condition io-timeout (stream-error) @@ -737,7 +714,7 @@ (lambda (condition stream) (declare (type stream stream)) (format stream - "IO-TIMEOUT ~(~A~)ing ~S" + "I/O timeout ~(~A~)ing ~S" (io-timeout-direction condition) (stream-error-stream condition))))) @@ -765,7 +742,7 @@ (:report (lambda (condition stream) (format stream - "unexpected EOF on ~S ~A" + "unexpected end of file on ~S ~A" (stream-error-stream condition) (reader-eof-error-context condition))))) diff --git a/src/code/load.lisp b/src/code/load.lisp index 756dcc0..e11aaa3 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -292,8 +292,9 @@ (flet ((check-version (variant possible-implementation needed-version) (when (string= possible-implementation implementation) (unless (= version needed-version) - (error "~@<~S was compiled for ~A fasl file format ~ - version ~D, but we need version ~D.~:@>" + (error "~@<~S is in ~A fasl file format version ~D, ~ + but this version of SBCL uses ~ + format version ~D.~:@>" stream variant version diff --git a/src/code/parse-defmacro-errors.lisp b/src/code/parse-defmacro-errors.lisp index cea6ca6..456c352 100644 --- a/src/code/parse-defmacro-errors.lisp +++ b/src/code/parse-defmacro-errors.lisp @@ -17,10 +17,10 @@ ;;; We save space in macro definitions by calling this function. (defun do-arg-count-error (error-kind name arg lambda-list minimum maximum) - (multiple-value-bind (fname sb!debug:*stack-top-hint*) (find-caller-name) + (multiple-value-bind (fname sb!debug:*stack-top-hint*) + (find-caller-name-and-frame) (error 'defmacro-ll-arg-count-error :kind error-kind - :function-name fname :name name :argument arg :lambda-list lambda-list @@ -34,15 +34,10 @@ :initform nil))) (defun print-defmacro-ll-bind-error-intro (condition stream) - (if (null (defmacro-lambda-list-bind-error-name condition)) - (format stream - "error while parsing arguments to ~A in ~S:~%" - (defmacro-lambda-list-bind-error-kind condition) - (condition-function-name condition)) - (format stream - "error while parsing arguments to ~A ~S:~%" - (defmacro-lambda-list-bind-error-kind condition) - (defmacro-lambda-list-bind-error-name condition)))) + (format stream + "error while parsing arguments to ~A~@[ ~S~]:~%" + (defmacro-lambda-list-bind-error-kind condition) + (defmacro-lambda-list-bind-error-name condition))) (define-condition defmacro-bogus-sublist-error (defmacro-lambda-list-bind-error) diff --git a/src/code/print.lisp b/src/code/print.lisp index 40ec188..7bb66a9 100644 --- a/src/code/print.lisp +++ b/src/code/print.lisp @@ -272,17 +272,6 @@ (write-char #\> stream)))) nil) -;;;; WHITESPACE-CHAR-P - -;;; This is used in other files, but is defined in this one for some reason. -(defun whitespace-char-p (char) - #!+sb-doc - "Determines whether or not the character is considered whitespace." - (or (char= char #\space) - (char= char (code-char tab-char-code)) - (char= char (code-char return-char-code)) - (char= char #\linefeed))) - ;;;; circularity detection stuff ;;; When *PRINT-CIRCLE* is T, this gets bound to a hash table that diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp index a002989..f8aef32 100644 --- a/src/code/target-char.lisp +++ b/src/code/target-char.lisp @@ -218,6 +218,13 @@ ;; Else, fail. (t nil)))) +(defun whitespace-char-p (x) + (and (characterp x) + (or (char= x #\space) + (char= x (code-char tab-char-code)) + (char= x (code-char return-char-code)) + (char= x #\linefeed)))) + (defun alphanumericp (char) #!+sb-doc "Given a character-object argument, alphanumericp returns T if the diff --git a/src/code/target-extensions.lisp b/src/code/target-extensions.lisp index 28699d1..2daa462 100644 --- a/src/code/target-extensions.lisp +++ b/src/code/target-extensions.lisp @@ -36,12 +36,11 @@ (unless (sb!impl::whitespacep char) (return (unread-char char stream)))))) +;;; like LISTEN, but any whitespace in the input stream will be flushed (defun listen-skip-whitespace (&optional (stream *standard-input*)) - #!+sb-doc - "See LISTEN. Any whitespace in the input stream will be flushed." (do ((char (read-char-no-hang stream nil nil nil) (read-char-no-hang stream nil nil nil))) ((null char) nil) - (cond ((not (sb!impl::whitespace-char-p char)) + (cond ((not (whitespace-char-p char)) (unread-char char stream) (return t))))) diff --git a/src/compiler/x86/backend-parms.lisp b/src/compiler/x86/backend-parms.lisp index 2599866..c3d470d 100644 --- a/src/compiler/x86/backend-parms.lisp +++ b/src/compiler/x86/backend-parms.lisp @@ -20,7 +20,7 @@ (setf *backend-fasl-file-type* "x86f") (setf *backend-fasl-file-implementation* :x86) -(setf *backend-fasl-file-version* 9) +(setf *backend-fasl-file-version* 10) ;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC. ;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot. ;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET @@ -35,11 +35,17 @@ ;;; 7 = around sbcl-0.6.9.8, merged SB-CONDITIONS package into SB-KERNEL ;;; 8 = sbcl-0.6.10.4 revived Gray stream support, changing stream layouts. ;;; 9 = deleted obsolete CONS-UNIQUE-TAG bytecode in sbcl-0.6.11.8 +;;; (somewhere in here also changes to AND and OR CTYPE layouts) +;;; 10 = new layout for CONDITION in sbcl-0.6.11.38 (setf *backend-register-save-penalty* 3) (setf *backend-byte-order* :little-endian) +;;; KLUDGE: It would seem natural to set this by asking our C runtime +;;; code for it, but mostly we need it for GENESIS, which doesn't in +;;; general have our C runtime code running to ask, so instead we set +;;; it by hand. -- WHN 2001-04-15 (setf *backend-page-size* 4096) ;;; comment from CMU CL: ;;; diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index 22f6db9..bf55281 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -1083,9 +1083,7 @@ (lambda (condition stream) ;; Don't try to print the structure, since it probably won't work. (format stream - "obsolete structure error in ~S:~@ - for a structure of type: ~S" - (sb-kernel::condition-function-name condition) + "~@" (type-of (obsolete-structure-datum condition)))))) (defun obsolete-instance-trap (owrapper nwrapper instance) diff --git a/version.lisp-expr b/version.lisp-expr index 5938907..feb70db 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.11.37" +"0.6.11.38"