From 1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Wed, 12 Dec 2001 18:33:40 +0000 Subject: [PATCH] 0.pre7.88: s/ir2-physenv-environment/ir2-physenv-closure/ changed most ~D in FORMAT strings to ~W changed debugger prompt to "5]", "5[2]", "5[3]", etc. --- NEWS | 4 ++-- TODO | 4 ---- src/code/array.lisp | 21 +++++++++++---------- src/code/class.lisp | 4 ++-- src/code/condition.lisp | 2 +- src/code/debug-int.lisp | 6 +++--- src/code/debug.lisp | 25 ++++++++----------------- src/code/dyncount.lisp | 2 +- src/code/early-extensions.lisp | 2 +- src/code/fd-stream.lisp | 4 ++-- src/code/fop.lisp | 2 +- src/code/gc.lisp | 2 +- src/code/host-alieneval.lisp | 2 +- src/code/inspect.lisp | 6 +++--- src/code/interr.lisp | 4 ++-- src/code/late-format.lisp | 10 +++++----- src/code/load.lisp | 4 ++-- src/code/ntrace.lisp | 2 +- src/code/parse-defmacro-errors.lisp | 8 ++++---- src/code/room.lisp | 16 ++++++++-------- src/code/run-program.lisp | 4 ++-- src/code/seq.lisp | 2 +- src/code/serve-event.lisp | 2 +- src/code/sharpm.lisp | 10 +++++----- src/code/target-alieneval.lisp | 6 +++--- src/code/target-format.lisp | 23 +++++++++++------------ src/code/target-sxhash.lisp | 2 +- src/compiler/aliencomp.lisp | 4 ++-- src/compiler/alpha/insts.lisp | 2 +- src/compiler/alpha/static-fn.lisp | 2 +- src/compiler/array-tran.lisp | 6 +++--- src/compiler/assem.lisp | 22 +++++++++++----------- src/compiler/compiler-error.lisp | 2 +- src/compiler/debug-dump.lisp | 3 +-- src/compiler/debug.lisp | 23 ++++++++++++----------- src/compiler/disassem.lisp | 4 ++-- src/compiler/dump.lisp | 2 +- src/compiler/generic/genesis.lisp | 14 +++++++------- src/compiler/generic/utils.lisp | 4 ++-- src/compiler/globaldb.lisp | 2 +- src/compiler/gtn.lisp | 2 +- src/compiler/ir1report.lisp | 2 +- src/compiler/ir1util.lisp | 2 +- src/compiler/ir2tran.lisp | 8 ++++---- src/compiler/ltn.lisp | 4 ++-- src/compiler/main.lisp | 12 ++++++------ src/compiler/meta-vmdef.lisp | 14 +++++++------- src/compiler/node.lisp | 2 +- src/compiler/represent.lisp | 4 ++-- src/compiler/target-disassem.lisp | 20 ++++++++++---------- src/compiler/vop.lisp | 2 +- src/compiler/x86/static-fn.lisp | 2 +- src/compiler/x86/vm.lisp | 2 +- src/pcl/cache.lisp | 4 ++-- src/pcl/construct.lisp | 4 ++-- src/pcl/describe.lisp | 2 +- src/pcl/dfun.lisp | 2 +- src/pcl/methods.lisp | 2 +- src/pcl/print-object.lisp | 2 +- tests/stream.impure-cload.lisp | 2 +- tests/stress-gc.lisp | 6 +++--- version.lisp-expr | 2 +- 62 files changed, 179 insertions(+), 192 deletions(-) diff --git a/NEWS b/NEWS index b699c6e..0336a7a 100644 --- a/NEWS +++ b/NEWS @@ -907,7 +907,7 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: :SB-PROPAGATE-FUN-TYPE are no longer considered to be optional features. Instead, the code that they used to control is always built into the system. -?? minor incompatible change: The debugger prompt sequence now goes +* minor incompatible change: The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc. as you get deeper into recursive calls to the debugger command loop, instead of the old "5]", "5]]", "5]]]" sequence. (I was motivated to do this when squabbles between @@ -922,7 +922,7 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: favor of new corresponding names DEFINE-FOO, for consistency with the naming convention used in the ANSI standard (DEFSTRUCT, DEFVAR, DEFINE-CONDITION, DEFINE-MODIFY-MACRO..). This mostly affects - internal symbols, but a few external symbols like + internal symbols, but a few supported extensions like SB-ALIEN:DEF-ALIEN-FUNCTION are also affected. * minor incompatible change: DEFINE-ALIEN-FUNCTION (also known by the old deprecated name DEF-ALIEN-FUNCTION) now does DECLAIM FTYPE diff --git a/TODO b/TODO index b56ab35..303b744 100644 --- a/TODO +++ b/TODO @@ -6,12 +6,8 @@ for 0.7.0: EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup: ** made inlining DEFUN inside MACROLET work again * incompatible changes listed in NEWS: - ** changed debugger prompt to "5]", "5[2]", "5[3]", etc. ** changed default output representation of *PRINT-ESCAPE*-ed unprintable ASCII characters to #\Nul, #\Soh, etc. -* some easy FIXMEs with high disruptive potential: - ** Search lists go away. - ** Grep for ~D and and change most of them to ~S. * more renaming in global external names: ** used DEFINE-THE-FOO-THING and DEFFOO style consistently (and deprecated supported extensions named in the DEF-FOO diff --git a/src/code/array.lisp b/src/code/array.lisp index 36ceafb..c061ddb 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -182,8 +182,8 @@ (error "can't specify both :INITIAL-ELEMENT and ~ :INITIAL-CONTENTS")) (unless (= length (length initial-contents)) - (error "There are ~D elements in the :INITIAL-CONTENTS, but ~ - the vector length is ~D." + (error "There are ~W elements in the :INITIAL-CONTENTS, but ~ + the vector length is ~W." (length initial-contents) length)) (replace array initial-contents)) @@ -212,8 +212,9 @@ (unless (and (fixnump fill-pointer) (>= fill-pointer 0) (<= fill-pointer length)) - (error "invalid fill-pointer ~D" - fill-pointer)) + ;; FIXME: should be TYPE-ERROR? + (error "invalid fill-pointer ~W" + fill-pointer)) fill-pointer)))) (setf (%array-fill-pointer-p array) t)) (t @@ -274,12 +275,12 @@ (t (unless (typep contents 'sequence) (error "malformed :INITIAL-CONTENTS: ~S is not a ~ - sequence, but ~D more layer~:P needed." + sequence, but ~W more layer~:P needed." contents (- (length dimensions) axis))) (unless (= (length contents) (car dims)) (error "malformed :INITIAL-CONTENTS: Dimension of ~ - axis ~D is ~D, but ~S is ~D long." + axis ~W is ~W, but ~S is ~W long." axis (car dims) contents (length contents))) (if (listp contents) (dolist (content contents) @@ -346,7 +347,7 @@ (list subscripts)) (let ((rank (array-rank array))) (unless (= rank (length subscripts)) - (error "wrong number of subscripts, ~D, for array of rank ~D" + (error "wrong number of subscripts, ~W, for array of rank ~W" (length subscripts) rank)) (if (array-header-p array) (do ((subs (nreverse subscripts) (cdr subs)) @@ -360,7 +361,7 @@ (declare (fixnum index dim)) (unless (< -1 index dim) (if invalid-index-error-p - (error "invalid index ~D~[~;~:; on axis ~:*~D~] in ~S" + (error "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S" index axis array) (return-from %array-row-major-index nil))) (incf result (* chunk-size index)) @@ -368,7 +369,7 @@ (let ((index (first subscripts))) (unless (< -1 index (length (the (simple-array * (*)) array))) (if invalid-index-error-p - (error "invalid index ~D in ~S" index array) + (error "invalid index ~W in ~S" index array) (return-from %array-row-major-index nil))) index)))) @@ -556,7 +557,7 @@ (error "Vector axis is not zero: ~S" axis-number)) (length (the (simple-array * (*)) array))) ((>= axis-number (%array-rank array)) - (error "~D is too big; ~S only has ~D dimension~:P." + (error "Axis number ~W is too big; ~S only has ~D dimension~:P." axis-number array (%array-rank array))) (t (%array-dimension array axis-number)))) diff --git a/src/code/class.lisp b/src/code/class.lisp index 4abd970..51d4911 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -394,8 +394,8 @@ (let ((old-length (layout-length old-layout))) (unless (= old-length length) (warn "change in instance length of class ~S:~% ~ - ~A length: ~D~% ~ - ~A length: ~D" + ~A length: ~W~% ~ + ~A length: ~W" name old-context old-length context length) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 935a2a6..43d9366 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -659,7 +659,7 @@ (:report (lambda (condition stream) (let ((error-stream (stream-error-stream condition))) - (format stream "READER-ERROR ~@[at ~D ~]on ~S:~%~?" + (format stream "READER-ERROR ~@[at ~W ~]on ~S:~%~?" (file-position error-stream) error-stream (reader-error-format-control condition) (reader-error-format-arguments condition)))))) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 134cd9a..2362e87 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -204,7 +204,7 @@ (def!method print-object ((debug-var debug-var) stream) (print-unreadable-object (debug-var stream :type t :identity t) (format stream - "~S ~D" + "~S ~W" (debug-var-symbol debug-var) (debug-var-id debug-var)))) @@ -1568,7 +1568,7 @@ (defun assign-minimal-var-names (vars) (declare (simple-vector vars)) (let* ((len (length vars)) - (width (length (format nil "~D" (1- len))))) + (width (length (format nil "~W" (1- len))))) (dotimes (i len) (setf (compiled-debug-var-symbol (svref vars i)) (intern (format nil "ARG-~V,'0D" width i) @@ -3300,7 +3300,7 @@ (do-debug-fun-blocks (block debug-fun) (do-debug-block-locations (loc block) (fill-in-code-location loc) - (format t "~S code location at ~D" + (format t "~S code location at ~W" (compiled-code-location-kind loc) (compiled-code-location-pc loc)) (sb!debug::print-code-location-source-form loc 0) diff --git a/src/code/debug.lisp b/src/code/debug.lisp index f8c18b7..5e6dd5a 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -54,17 +54,8 @@ "Should the debugger display beginner-oriented help messages?") (defun debug-prompt (stream) - - ;; old behavior, will probably go away in sbcl-0.7.x - (format stream "~%~D" (sb!di:frame-number *current-frame*)) - (dotimes (i *debug-command-level*) - (write-char #\] stream)) - (write-char #\space stream) - - ;; planned new behavior, delayed since it will break ILISP - #+nil (format stream - "~%~D~:[~;[~D~]] " + "~%~W~:[~;[~W~]] " (sb!di:frame-number *current-frame*) (> *debug-command-level* 1) *debug-command-level*)) @@ -774,7 +765,7 @@ reset to ~S." (let ((level *debug-command-level*) (restart-commands (make-restart-commands))) (with-simple-restart (abort - "Reduce debugger level (to debug level ~D)." + "Reduce debugger level (to debug level ~W)." level) (debug-prompt *debug-io*) (force-output *debug-io*) @@ -903,7 +894,7 @@ reset to ~S." (let ((v (find id vars :key #'sb!di:debug-var-id))) (unless v (error - "invalid variable ID, ~D: should have been one of ~S" + "invalid variable ID, ~W: should have been one of ~S" id (mapcar #'sb!di:debug-var-id vars))) ,(ecase ref-or-set @@ -1029,7 +1020,7 @@ argument") (let* ((name (if (symbolp form) (symbol-name form) - (format nil "~D" form))) + (format nil "~W" form))) (len (length name)) (res nil)) (declare (simple-string name) @@ -1075,7 +1066,7 @@ argument") #'(lambda () (/show0 "in restart-command closure, about to i-r-i") (invoke-restart-interactively restart)))) - (push (cons (format nil "~d" num) restart-fun) commands) + (push (cons (prin1-to-string num) restart-fun) commands) (unless (or (null (restart-name restart)) (find name commands :key #'car :test #'string=)) (push (cons name restart-fun) commands)))) @@ -1231,7 +1222,7 @@ argument") (setf any-p t) (when (eq (sb!di:debug-var-validity v location) :valid) (setf any-valid-p t) - (format t "~S~:[#~D~;~*~] = ~S~%" + (format t "~S~:[#~W~;~*~] = ~S~%" (sb!di:debug-var-symbol v) (zerop (sb!di:debug-var-id v)) (sb!di:debug-var-id v) @@ -1412,8 +1403,8 @@ argument") (when prev-location (let ((this-num (1- this-num))) (if (= prev-num this-num) - (format t "~&~D: " prev-num) - (format t "~&~D-~D: " prev-num this-num))) + (format t "~&~W: " prev-num) + (format t "~&~W-~W: " prev-num this-num))) (print-code-location-source-form prev-location 0) (when *print-location-kind* (format t "~S " (sb!di:code-location-kind prev-location))) diff --git a/src/code/dyncount.lisp b/src/code/dyncount.lisp index fcdb4a3..c14cb73 100644 --- a/src/code/dyncount.lisp +++ b/src/code/dyncount.lisp @@ -430,7 +430,7 @@ comments from CMU CL: cost) total-cost)) (when (zerop (decf counter)) - (format t "[End of top ~D]~%" cut-off)))))) + (format t "[End of top ~W]~%" cut-off)))))) ;;; Divide SORTED into two lists, the first CUT-OFF elements long. Any VOP ;;; names that match one of the report strings are moved into the REPORT list diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index b7d82b6..120d07b 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -403,7 +403,7 @@ (n-cache (gensym))) (unless (= (length default-values) values) - (error "The number of default values ~S differs from :VALUES ~D." + (error "The number of default values ~S differs from :VALUES ~W." default values)) (collect ((inlines) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 20a8c2f..aea8b57 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -985,7 +985,7 @@ input-buffer-p (name (if file (format nil "file ~S" file) - (format nil "descriptor ~D" fd))) + (format nil "descriptor ~W" fd))) auto-close) (declare (type index fd) (type (or index null) timeout) (type (member :none :line :full) buffering)) @@ -1007,7 +1007,7 @@ (lambda () (sb!unix:unix-close fd) #!+sb-show - (format *terminal-io* "** closed file descriptor ~D **~%" + (format *terminal-io* "** closed file descriptor ~W **~%" fd)))) stream)) diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 59761b5..b290907 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -110,7 +110,7 @@ (declare (ignorable arg)) #!+sb-show (when *show-fop-nop4-p* - (format *debug-io* "~&/FOP-NOP4 ARG=~D=#X~X~%" arg arg)))) + (format *debug-io* "~&/FOP-NOP4 ARG=~W=#X~X~%" arg arg)))) (define-fop (fop-nop 0 :nope)) (define-fop (fop-pop 1 nil) (push-fop-table (pop-stack))) diff --git a/src/code/gc.lisp b/src/code/gc.lisp index fc87d3d..f5cbc27 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -285,7 +285,7 @@ function should notify the user that the system has finished GC'ing.") *soft-heap-limit*))) (when soft-heap-limit-exceeded? (cerror "Continue with GC." - "soft heap limit exceeded (temporary new limit=~D)" + "soft heap limit exceeded (temporary new limit=~W)" *soft-heap-limit*)) (when (and *gc-trigger* (> pre-gc-dynamic-usage *gc-trigger*)) (setf *need-to-collect-garbage* t)) diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index be87e0f..ed5bbf3 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -560,7 +560,7 @@ #!+alpha (64 'sap-ref-64))))) (if ref-fun `(,ref-fun ,sap (/ ,offset sb!vm:n-byte-bits)) - (error "cannot extract ~D bit integers" + (error "cannot extract ~W-bit integers" (alien-integer-type-bits type))))) ;;;; the BOOLEAN type diff --git a/src/code/inspect.lisp b/src/code/inspect.lisp index a764389..2fe8ca2 100644 --- a/src/code/inspect.lisp +++ b/src/code/inspect.lisp @@ -76,7 +76,7 @@ evaluated expressions. (format s "~%The object contains nothing to inspect.~%") (return-from %inspect (reread))) (t - (format s "~%Enter a valid index (~:[0-~D~;0~]).~%" + (format s "~%Enter a valid index (~:[0-~W~;0~]).~%" (= elements-length 1) (1- elements-length)) (return-from %inspect (reread)))))) (symbol @@ -211,7 +211,7 @@ evaluated expressions. (defmethod inspected-parts ((object vector)) (values (format nil - "The object is a ~:[~;displaced ~]VECTOR of length ~D.~%" + "The object is a ~:[~;displaced ~]VECTOR of length ~W.~%" (and (array-header-p object) (%array-displaced-p object)) (length object)) @@ -228,7 +228,7 @@ evaluated expressions. (multiple-value-bind (q r) (floor index dim) (setq index q) (push r list))) - (format nil "[~D~{,~D~}]" (car list) (cdr list))))) + (format nil "[~W~{,~W~}]" (car list) (cdr list))))) (defmethod inspected-parts ((object array)) (let* ((length (min (array-total-size object) *inspect-length*)) diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 18e5ae3..10f50d4 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -257,7 +257,7 @@ (deferr invalid-array-index-error (array bound index) (error 'simple-error :format-control - "invalid array index ~D for ~S (should be nonnegative and <~D)" + "invalid array index ~W for ~S (should be nonnegative and <~W)" :format-arguments (list index array bound))) (deferr object-not-simple-array-error (object) @@ -468,7 +468,7 @@ (cond ((null handler) (error 'simple-error :format-control - "unknown internal error, ~D? args=~S" + "unknown internal error, ~D, args=~S" :format-arguments (list error-number (mapcar #'(lambda (sc-offset) diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index db53996..27d2b3a 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -263,7 +263,7 @@ (error 'format-error :complaint - "too many parameters, expected no more than ~D" + "too many parameters, expected no more than ~W" :arguments (list ,(length specs)) :offset (caar ,params))) ,,@body))) @@ -617,8 +617,8 @@ `(if (<= 0 ,posn (length orig-args)) (setf args (nthcdr ,posn orig-args)) (error 'format-error - :complaint "Index ~D out of bounds. Should have been ~ - between 0 and ~D." + :complaint "Index ~W out of bounds. Should have been ~ + between 0 and ~W." :arguments (list ,posn (length orig-args)) :offset ,(1- end))))) (if colonp @@ -634,8 +634,8 @@ (setf args (nthcdr new-posn orig-args)) (error 'format-error :complaint - "Index ~D is out of bounds; should have been ~ - between 0 and ~D." + "Index ~W is out of bounds; should have been ~ + between 0 and ~W." :arguments (list new-posn (length orig-args)) :offset ,(1- end))))))) diff --git a/src/code/load.lisp b/src/code/load.lisp index bd764fd..caa2706 100644 --- a/src/code/load.lisp +++ b/src/code/load.lisp @@ -244,9 +244,9 @@ (flet ((check-version (variant possible-implementation needed-version) (when (string= possible-implementation implementation) (unless (= version needed-version) - (error "~@<~S is in ~A fasl file format version ~D, ~ + (error "~@<~S is in ~A fasl file format version ~W, ~ but this version of SBCL uses ~ - format version ~D.~:@>" + format version ~W.~:@>" stream variant version diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index cdf1660..bebb448 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -182,7 +182,7 @@ (dolist (entry *traced-entries*) (when (cdr entry) (incf depth))) (format t - "~@V,0T~D: " + "~@V,0T~W: " (+ (mod (* depth *trace-indentation-step*) (- *max-trace-indentation* *trace-indentation-step*)) *trace-indentation-step*) diff --git a/src/code/parse-defmacro-errors.lisp b/src/code/parse-defmacro-errors.lisp index 62972d4..104fd18 100644 --- a/src/code/parse-defmacro-errors.lisp +++ b/src/code/parse-defmacro-errors.lisp @@ -65,17 +65,17 @@ (arg-count-error-argument condition) (arg-count-error-lambda-list condition)) (cond ((null (arg-count-error-maximum condition)) - (format stream "at least ~D expected" + (format stream "at least ~W expected" (arg-count-error-minimum condition))) ((= (arg-count-error-minimum condition) (arg-count-error-maximum condition)) - (format stream "exactly ~D expected" + (format stream "exactly ~W expected" (arg-count-error-minimum condition))) (t - (format stream "between ~D and ~D expected" + (format stream "between ~W and ~W expected" (arg-count-error-minimum condition) (arg-count-error-maximum condition)))) - (format stream ", but ~D found" + (format stream ", but ~W found" (length (arg-count-error-argument condition)))))) (define-condition defmacro-ll-broken-key-list-error diff --git a/src/code/room.lisp b/src/code/room.lisp index a5735e0..0b9a24a 100644 --- a/src/code/room.lisp +++ b/src/code/room.lisp @@ -316,7 +316,7 @@ (format t "~%~A:~% ~:D bytes, ~:D object~:P" name total-bytes total-objects) (dolist (space (spaces)) - (format t ", ~D% ~(~A~)" + (format t ", ~W% ~(~A~)" (round (* (cdr space) 100) total-bytes) (car space))) (format t ".~%") @@ -465,7 +465,7 @@ #.instance-header-widetag) (incf descriptor-words (truncate size n-word-bytes))) (t - (error "bogus type: ~D" type)))) + (error "bogus widetag: ~W" type)))) space)) (format t "~:D words allocated for descriptor objects.~%" descriptor-words) @@ -478,7 +478,7 @@ ;;; TOP-N types with largest usage. (defun instance-usage (space &key (top-n 15)) (declare (type spaces space) (type (or fixnum null) top-n)) - (format t "~2&~@[Top ~D ~]~(~A~) instance types:~%" top-n space) + (format t "~2&~@[Top ~W ~]~(~A~) instance types:~%" top-n space) (let ((totals (make-hash-table :test 'eq)) (total-objects 0) (total-bytes 0)) @@ -515,13 +515,13 @@ (objects (cadr what))) (incf printed-bytes bytes) (incf printed-objects objects) - (format t " ~A: ~:D bytes, ~D object~:P.~%" (car what) + (format t " ~A: ~:D bytes, ~:D object~:P.~%" (car what) bytes objects))) (let ((residual-objects (- total-objects printed-objects)) (residual-bytes (- total-bytes printed-bytes))) (unless (zerop residual-objects) - (format t " Other types: ~:D bytes, ~D object~:P.~%" + (format t " Other types: ~:D bytes, ~:D object~:P.~%" residual-bytes residual-objects)))) (format t " ~:(~A~) instance total: ~:D bytes, ~:D object~:P.~%" @@ -548,11 +548,11 @@ (setf start-addr (sb!di::get-lisp-obj-address object) total-bytes bytes)) (when start-addr - (format t "~D bytes at #X~X~%" total-bytes start-addr) + (format t "~:D bytes at #X~X~%" total-bytes start-addr) (setf start-addr nil)))) space) (when start-addr - (format t "~D bytes at #X~X~%" total-bytes start-addr)))) + (format t "~:D bytes at #X~X~%" total-bytes start-addr)))) (values)) ;;;; PRINT-ALLOCATED-OBJECTS @@ -600,7 +600,7 @@ ;; FIXME: What is this? (ERROR "Argh..")? or ;; a warning? or code that can be removed ;; once the system is stable? or what? - (format stream "~2&**** Page ~D, address ~X:~%" + (format stream "~2&**** Page ~W, address ~X:~%" pages-so-far addr)) (setq last-page this-page) (incf pages-so-far)))) diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index db90d0a..35f4583 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -174,7 +174,7 @@ (defmethod print-object ((process process) stream) (print-unreadable-object (process stream :type t) (format stream - "~D ~S" + "~W ~S" (process-pid process) (process-status process))) process) @@ -380,7 +380,7 @@ (when (streamp pty) (multiple-value-bind (new-fd errno) (sb-unix:unix-dup master) (unless new-fd - (error "couldn't SB-UNIX:UNIX-DUP ~D: ~A" master (strerror errno))) + (error "couldn't SB-UNIX:UNIX-DUP ~W: ~A" master (strerror errno))) (push new-fd *close-on-error*) (copy-descriptor-to-stream new-fd pty cookie))) (values name diff --git a/src/code/seq.lisp b/src/code/seq.lisp index 90639c2..8463694 100644 --- a/src/code/seq.lisp +++ b/src/code/seq.lisp @@ -56,7 +56,7 @@ :datum vector :expected-type `(vector ,declared-length) :format-control - "Vector length (~D) doesn't match declared length (~D)." + "Vector length (~W) doesn't match declared length (~W)." :format-arguments (list actual-length declared-length)))) vector) (defun sequence-of-checked-length-given-type (sequence result-type) diff --git a/src/code/serve-event.lisp b/src/code/serve-event.lisp index f0c6961..c4d856d 100644 --- a/src/code/serve-event.lisp +++ b/src/code/serve-event.lisp @@ -70,7 +70,7 @@ (def!method print-object ((handler handler) stream) (print-unreadable-object (handler stream :type t) (format stream - "~A on ~:[~;BOGUS ~]descriptor ~D: ~S" + "~A on ~:[~;BOGUS ~]descriptor ~W: ~S" (handler-direction handler) (handler-bogus handler) (handler-descriptor handler) diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp index f0a1168..b3eecb2 100644 --- a/src/code/sharpm.lisp +++ b/src/code/sharpm.lisp @@ -14,7 +14,7 @@ ;;; FIXME: Is it standard to ignore numeric args instead of raising errors? (defun ignore-numarg (sub-char numarg) (when numarg - (warn "A numeric argument was ignored in #~D~A." numarg sub-char))) + (warn "A numeric argument was ignored in #~W~A." numarg sub-char))) ;;;; reading arrays and vectors: the #(, #*, and #A readmacros @@ -92,14 +92,14 @@ (make-array (dims) :initial-contents contents)) (unless (typep seq 'sequence) (%reader-error stream - "#~DA axis ~D is not a sequence:~% ~S" + "#~WA axis ~W is not a sequence:~% ~S" dimensions axis seq)) (let ((len (length seq))) (dims len) (unless (= axis (1- dimensions)) (when (zerop len) (%reader-error stream - "#~DA axis ~D is empty, but is not ~ + "#~WA axis ~W is empty, but is not ~ the last dimension." dimensions axis)) (setq seq (elt seq 0)))))))) @@ -157,13 +157,13 @@ ((not radix) (%reader-error stream "radix missing in #R")) ((not (<= 2 radix 36)) - (%reader-error stream "illegal radix for #R: ~D" radix)) + (%reader-error stream "illegal radix for #R: ~D." radix)) (t (let ((res (let ((*read-base* radix)) (read stream t nil t)))) (unless (typep res 'rational) (%reader-error stream - "#~A (base ~D) value is not a rational: ~S." + "#~A (base ~D.) value is not a rational: ~S." sub-char radix res)) diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index e7d5054..eafe1e7 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -341,7 +341,7 @@ (etypecase type (alien-pointer-type (when (cdr indices) - (error "too many indices when derefing ~S: ~D" + (error "too many indices when DEREF'ing ~S: ~W" type (length indices))) (let ((element-type (alien-pointer-type-to type))) @@ -353,7 +353,7 @@ 0)))) (alien-array-type (unless (= (length indices) (length (alien-array-type-dimensions type))) - (error "incorrect number of indices when derefing ~S: ~D" + (error "incorrect number of indices when DEREF'ing ~S: ~W" type (length indices))) (labels ((frob (dims indices offset) (if (null dims) @@ -561,7 +561,7 @@ (alien-fun-type (unless (= (length (alien-fun-type-arg-types type)) (length args)) - (error "wrong number of arguments for ~S~%expected ~D, got ~D" + (error "wrong number of arguments for ~S~%expected ~W, got ~W" type (length (alien-fun-type-arg-types type)) (length args))) diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index a129f24..8a69dab 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -21,13 +21,12 @@ generally expand into additional text to be output, usually consuming one or more of the FORMAT-ARGUMENTS in the process. A few useful directives are: - ~A or ~nA Prints one argument as if by PRINC - ~S or ~nS Prints one argument as if by PRIN1 - ~D or ~nD Prints one argument as a decimal integer - ~% Does a TERPRI - ~& Does a FRESH-LINE - - where n is the width of the field in which the object is printed. + ~A or ~nA Prints one argument as if by PRINC + ~S or ~nS Prints one argument as if by PRIN1 + ~D or ~nD Prints one argument as a decimal integer + ~% Does a TERPRI + ~& Does a FRESH-LINE + where n is the width of the field in which the object is printed. DESTINATION controls where the result will go. If DESTINATION is T, then the output is sent to the standard output stream. If it is NIL, then the @@ -153,7 +152,7 @@ (when ,params (error 'format-error :complaint - "too many parameters, expected no more than ~D" + "too many parameters, expected no more than ~W" :arguments (list ,(length specs)) :offset (caar ,params))) ,@body)))) @@ -833,8 +832,8 @@ (if (<= 0 posn (length orig-args)) (setf args (nthcdr posn orig-args)) (error 'format-error - :complaint "Index ~D is out of bounds. (It should ~ - have been between 0 and ~D.)" + :complaint "Index ~W is out of bounds. (It should ~ + have been between 0 and ~W.)" :arguments (list posn (length orig-args)))))) (if colonp (interpret-bind-defaults ((n 1)) params @@ -846,8 +845,8 @@ (setf args (nthcdr new-posn orig-args)) (error 'format-error :complaint - "Index ~D is out of bounds. (It should - have been between 0 and ~D.)" + "Index ~W is out of bounds. (It should + have been between 0 and ~W.)" :arguments (list new-posn (length orig-args)))))))) (interpret-bind-defaults ((n 1)) params diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index c77b257..7dfcd3e 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -99,7 +99,7 @@ ;;; (unless (string= (gethash hash ht) string) ;;; (format t "collision: ~S ~S~%" string (gethash hash ht))) ;;; (setf (gethash hash ht) string)))) -;;; (format t "final count=~D~%" (hash-table-count ht))) +;;; (format t "final count=~W~%" (hash-table-count ht))) (defun %sxhash-simple-string (x) (declare (optimize speed)) diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index 80176a6..ead78df 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -186,7 +186,7 @@ (typecase alien-type (alien-pointer-type (when (cdr indices) - (abort-ir1-transform "too many indices for pointer deref: ~D" + (abort-ir1-transform "too many indices for pointer deref: ~W" (length indices))) (let ((element-type (alien-pointer-type-to alien-type))) (if indices @@ -607,7 +607,7 @@ (let ((arg-types (alien-fun-type-arg-types alien-type))) (unless (= (length args) (length arg-types)) (abort-ir1-transform - "wrong number of arguments; expected ~D, got ~D" + "wrong number of arguments; expected ~W, got ~W" (length arg-types) (length args))) (collect ((params) (deports)) diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index 277d010..f456c41 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -67,7 +67,7 @@ (defparameter float-reg-symbols (coerce - (loop for n from 0 to 31 collect (make-symbol (format nil "~d" n))) + (loop for n from 0 to 31 collect (make-symbol (format nil "~D" n))) 'vector)) (sb!disassem:define-argument-type fp-reg diff --git a/src/compiler/alpha/static-fn.lisp b/src/compiler/alpha/static-fn.lisp index 026b910..bffe879 100644 --- a/src/compiler/alpha/static-fn.lisp +++ b/src/compiler/alpha/static-fn.lisp @@ -42,7 +42,7 @@ (assert (and (<= num-args register-arg-count) (<= num-results register-arg-count)) (num-args num-results) - "Either too many args (~D) or too many results (~D). Max = ~D" + "Either too many args (~W) or too many results (~W). Max = ~W" num-args num-results register-arg-count) (let ((num-temps (max num-args num-results))) (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results)) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index e94f70d..c6dae10 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -379,7 +379,7 @@ (give-up-ir1-transform "The array dimensions are unknown; must call ARRAY-DIMENSION at runtime.")) (unless (> (length dims) axis) - (abort-ir1-transform "The array has dimensions ~S, ~D is too large." + (abort-ir1-transform "The array has dimensions ~S, ~W is too large." dims axis)) (let ((dim (nth axis dims))) @@ -548,14 +548,14 @@ (cond (,end (unless (or ,unsafe? (<= ,end ,size)) ,(if fail-inline? - `(error "End ~D is greater than total size ~D." + `(error "End ~W is greater than total size ~W." ,end ,size) `(failed-%with-array-data ,array ,start ,end))) ,end) (t ,size)))) (unless (or ,unsafe? (<= ,start ,defaulted-end)) ,(if fail-inline? - `(error "Start ~D is greater than end ~D." ,start ,defaulted-end) + `(error "Start ~W is greater than end ~W." ,start ,defaulted-end) `(failed-%with-array-data ,array ,start ,end))) (do ((,data ,array (%array-data-vector ,data)) (,cumulative-offset 0 diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp index ef7b90c..fbe7d5b 100644 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -192,7 +192,7 @@ name) '))) (when (inst-depth inst) - (format stream ", depth=~D" (inst-depth inst))))) + (format stream ", depth=~W" (inst-depth inst))))) #!+sb-show-assem (defun reset-inst-ids () @@ -230,7 +230,7 @@ (multiple-value-bind (loc-num size) (sb!c:location-number read) #!+sb-show-assem (format *trace-output* - "~&~S reads ~S[~D for ~D]~%" + "~&~S reads ~S[~W for ~W]~%" inst read loc-num size) (when loc-num ;; Iterate over all the locations for this TN. @@ -267,7 +267,7 @@ (multiple-value-bind (loc-num size) (sb!c:location-number write) #!+sb-show-assem (format *trace-output* - "~&~S writes ~S[~D for ~D]~%" + "~&~S writes ~S[~W for ~W]~%" inst write loc-num size) (when loc-num ;; Iterate over all the locations for this TN. @@ -908,13 +908,13 @@ p ;; the branch has two dependents and one of them dpends on (chooser-index note))) (old-size (chooser-size note))) (when (> new-size old-size) - (error "~S emitted ~D bytes, but claimed its max was ~D." + (error "~S emitted ~W bytes, but claimed its max was ~W." note new-size old-size)) (let ((additional-delta (- old-size new-size))) (when (< (find-alignment additional-delta) (chooser-alignment note)) - (error "~S shrunk by ~D bytes, but claimed that it ~ - preserve ~D bits of alignment." + (error "~S shrunk by ~W bytes, but claimed that it ~ + preserves ~W bits of alignment." note additional-delta (chooser-alignment note))) (incf delta additional-delta) (emit-filler segment additional-delta)) @@ -927,7 +927,7 @@ p ;; the branch has two dependents and one of them dpends on ;; The chooser passed on shrinking. Make sure it didn't emit ;; anything. (unless (= (segment-current-index segment) (chooser-index note)) - (error "Chooser ~S passed, but not before emitting ~D bytes." + (error "Chooser ~S passed, but not before emitting ~W bytes." note (- (segment-current-index segment) (chooser-index note)))) @@ -955,8 +955,8 @@ p ;; the branch has two dependents and one of them dpends on (old-size (alignment-size note)) (additional-delta (- old-size size))) (when (minusp additional-delta) - (error "Alignment ~S needs more space now? It was ~D, ~ - and is ~D now." + (error "Alignment ~S needs more space now? It was ~W, ~ + and is ~W now." note old-size size)) (when (plusp additional-delta) (emit-filler segment additional-delta) @@ -1027,7 +1027,7 @@ p ;; the branch has two dependents and one of them dpends on (funcall function segment posn) (let ((new-size (- (segment-current-index segment) index))) (unless (= new-size old-size) - (error "~S emitted ~D bytes, but claimed it was ~D." + (error "~S emitted ~W bytes, but claimed it was ~W." note new-size old-size))) (let ((tail (segment-last-annotation segment))) (if tail @@ -1316,7 +1316,7 @@ p ;; the branch has two dependents and one of them dpends on (num-bytes (multiple-value-bind (quo rem) (truncate total-bits assembly-unit-bits) (unless (zerop rem) - (error "~D isn't an even multiple of ~D." + (error "~W isn't an even multiple of ~W." total-bits assembly-unit-bits)) quo)) (bytes (make-array num-bytes :initial-element nil)) diff --git a/src/compiler/compiler-error.lisp b/src/compiler/compiler-error.lisp index 43f90c7..ac85e40 100644 --- a/src/compiler/compiler-error.lisp +++ b/src/compiler/compiler-error.lisp @@ -84,7 +84,7 @@ (:report (lambda (condition stream) (format stream - "~@<~S failure in ~S~@[ at character ~D~]: ~2I~_~A~:>" + "~@<~S failure in ~S~@[ at character ~W~]: ~2I~_~A~:>" 'read 'compile-file (input-error-in-compile-file-position condition) diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 2a107f6..ff7298f 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -366,8 +366,7 @@ (frob-leaf leaf (leaf-info leaf) gensym-p)))) (frob-lambda fun t) (when (>= level 2) - (dolist (x (ir2-physenv-environment - (physenv-info (lambda-physenv fun)))) + (dolist (x (ir2-physenv-closure (physenv-info (lambda-physenv fun)))) (let ((thing (car x))) (when (lambda-var-p thing) (frob-leaf thing (cdr x) (= level 3))))) diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp index a9c1694..3ae89d9 100644 --- a/src/compiler/debug.lisp +++ b/src/compiler/debug.lisp @@ -567,10 +567,10 @@ (num 0 (1+ num))) ((null ref) (when (< num count) - (barf "There should be at least ~D ~A in ~S, but are only ~D." + (barf "There should be at least ~W ~A in ~S, but there are only ~W." count what vop num)) (when (and (not more-p) (> num count)) - (barf "There should be ~D ~A in ~S, but are ~D." + (barf "There should be ~W ~A in ~S, but are ~W." count what vop num))) (unless (eq (tn-ref-vop ref) vop) (barf "VOP is ~S isn't ~S." ref vop)) @@ -713,8 +713,8 @@ (incf const)) (format stream - "~%TNs: ~D local, ~D temps, ~D constant, ~D env, ~D comp, ~D global.~@ - Wired: ~D, Unused: ~D. ~D block~:P, ~D global conflict~:P.~%" + "~%TNs: ~W local, ~W temps, ~W constant, ~W env, ~W comp, ~W global.~@ + Wired: ~W, Unused: ~W. ~W block~:P, ~W global conflict~:P.~%" local temps const environment comp global wired unused (ir2-block-count component) confs)) @@ -819,15 +819,15 @@ (barf "strange TN ~S in LTN map for ~S" tn block))))))) ;;; All TNs live at the beginning of an environment must be passing -;;; locations associated with that environment. We make an exception for wired -;;; TNs in XEP functions, since we randomly reference wired TNs to access the -;;; full call passing locations. +;;; locations associated with that environment. We make an exception +;;; for wired TNs in XEP functions, since we randomly reference wired +;;; TNs to access the full call passing locations. (defun check-environment-lifetimes (component) (dolist (fun (component-lambdas component)) (let* ((env (lambda-physenv fun)) (2env (physenv-info env)) (vars (lambda-vars fun)) - (closure (ir2-physenv-environment 2env)) + (closure (ir2-physenv-closure 2env)) (pc (ir2-physenv-return-pc-pass 2env)) (fp (ir2-physenv-old-fp 2env)) (2block (block-info (lambda-block (physenv-lambda env))))) @@ -846,8 +846,9 @@ (barf "strange TN live at head of ~S: ~S" env tn)))))) (values)) -;;; Check for some basic sanity in the TN conflict data structures, and also -;;; check that no TNs are unexpectedly live at environment entry. +;;; Check for some basic sanity in the TN conflict data structures, +;;; and also check that no TNs are unexpectedly live at environment +;;; entry. (defun check-life-consistency (component) (check-tn-conflicts component) (check-block-conflicts component) @@ -1057,7 +1058,7 @@ (vop-next vop)) (number 0 (1+ number))) ((null vop)) - (format t "~D: " number) + (format t "~W: " number) (print-vop vop))) ;;; This is like PRINT-NODES, but dumps the IR2 representation of the diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 25f6431..4af4cf7 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -697,7 +697,7 @@ format-length) (error "~@" + instruction-format ~W bits wide.~:>" arg-name bytespec format-length)) @@ -1513,7 +1513,7 @@ (multiple-value-bind (bytes rbits) (truncate bits sb!vm:n-byte-bits) (when (not (zerop rbits)) - (error "~D bits is not a byte-multiple." bits)) + (error "~W bits is not a byte-multiple." bits)) bytes)) (defun sign-extend (int size) diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index c8d880d..bb1aacf 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -898,7 +898,7 @@ ;; argument and the number of bytes actually written. I added this ;; assertion while trying to debug portable genesis. -- WHN 19990902 (unless (= code-length nwritten) - (error "internal error, code-length=~D, nwritten=~D" + (error "internal error, code-length=~W, nwritten=~W" code-length nwritten))) (values)) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 4960357..2f7d6a7 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -160,7 +160,7 @@ (ash (descriptor-low des) (- 1 sb!vm:n-lowtag-bits))))) (format stream - "for fixnum: ~D" + "for fixnum: ~W" (if (> unsigned #x1FFFFFFF) (- unsigned #x40000000) unsigned)))) @@ -285,7 +285,7 @@ (defun make-fixnum-descriptor (num) (when (>= (integer-length num) (1+ (- sb!vm:n-word-bits sb!vm:n-lowtag-bits))) - (error "~D is too big for a fixnum." num)) + (error "~W is too big for a fixnum." num)) (make-random-descriptor (ash num (1- sb!vm:n-lowtag-bits)))) (defun make-other-immediate-descriptor (data type) @@ -593,7 +593,7 @@ ((> index words) (unless (zerop (integer-length remainder)) ;; FIXME: Shouldn't this be a fatal error? - (warn "~D words of ~D were written, but ~D bits were left over." + (warn "~W words of ~W were written, but ~W bits were left over." words n remainder))) (let ((word (ldb (byte sb!vm:n-word-bits 0) remainder))) (write-wordindexed handle index @@ -1108,7 +1108,7 @@ (descriptor-low *nil-descriptor*)))) (unless (= offset-wanted offset-found) ;; FIXME: should be fatal - (warn "Offset from ~S to ~S is ~D, not ~D" + (warn "Offset from ~S to ~S is ~W, not ~W" symbol nil offset-found @@ -1417,7 +1417,7 @@ (desired (sb!vm:static-fun-offset sym))) (unless (= offset desired) ;; FIXME: should be fatal - (warn "Offset from FDEFN ~S to ~S is ~D, not ~D." + (warn "Offset from FDEFN ~S to ~S is ~W, not ~W." sym nil offset desired)))))) (defun list-all-fdefn-objects () @@ -1952,7 +1952,7 @@ (8 sb!vm:simple-array-unsigned-byte-8-widetag) (16 sb!vm:simple-array-unsigned-byte-16-widetag) (32 sb!vm:simple-array-unsigned-byte-32-widetag) - (t (error "losing element size: ~D" sizebits)))) + (t (error "losing element size: ~W" sizebits)))) (result (allocate-vector-object *dynamic* sizebits len type)) (start (+ (descriptor-byte-offset result) (ash sb!vm:vector-data-offset sb!vm:word-shift))) @@ -2307,7 +2307,7 @@ #!+sb-show (when *show-pre-fixup-code-p* (format *trace-output* - "~&/raw code from code-fop ~D ~D:~%" + "~&/raw code from code-fop ~W ~W:~%" nconst code-size) (do ((i start (+ i sb!vm:n-word-bytes))) diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp index f690caa..b63b3c6 100644 --- a/src/compiler/generic/utils.lisp +++ b/src/compiler/generic/utils.lisp @@ -15,7 +15,7 @@ (defun fixnumize (num) (if (<= #x-20000000 num #x1fffffff) (ash num 2) - (error "~D is too big for a fixnum." num))) + (error "~W is too big for a fixnum." num))) ;;;; routines for dealing with static symbols @@ -43,7 +43,7 @@ (- (pad-data-block (1- symbol-size)))) (pad-data-block symbol-size)) (unless (and (zerop rem) (<= 0 n (1- (length *static-symbols*)))) - (error "The byte offset ~D is not valid." offset)) + (error "The byte offset ~W is not valid." offset)) (elt *static-symbols* n)))) ;;; Return the (byte) offset from NIL to the start of the fdefn object diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index d759515..cd2e53c 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -152,7 +152,7 @@ (:print-object (lambda (x s) (print-unreadable-object (x s) (format s - "~S ~S, Number = ~D" + "~S ~S, Number = ~W" (class-info-name (type-info-class x)) (type-info-name x) (type-info-number x))))) diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp index 876e14a..58755f1 100644 --- a/src/compiler/gtn.lisp +++ b/src/compiler/gtn.lisp @@ -73,7 +73,7 @@ reversed-ir2-physenv-alist))) (let ((res (make-ir2-physenv - :environment (nreverse reversed-ir2-physenv-alist) + :closure (nreverse reversed-ir2-physenv-alist) :return-pc-pass (make-return-pc-passing-location (external-entry-point-p clambda))))) (setf (physenv-info lambda-physenv) res) diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp index eadcf86..6143aee 100644 --- a/src/compiler/ir1report.lisp +++ b/src/compiler/ir1report.lisp @@ -277,7 +277,7 @@ (cond ((= *last-message-count* 1) (when terpri (terpri *error-output*))) ((> *last-message-count* 1) - (format *error-output* "~&; [Last message occurs ~D times.]~2%" + (format *error-output* "~&; [Last message occurs ~W times.]~2%" *last-message-count*))) (setq *last-message-count* 0)) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 2bd0896..4328b58 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -1329,7 +1329,7 @@ ;; compiler to be able to use WITH-COMPILATION-UNIT on ;; arbitrarily huge blocks of code. -- WHN) (let ((*compiler-error-context* node)) - (compiler-note "*INLINE-EXPANSION-LIMIT* (~D) was exceeded, ~ + (compiler-note "*INLINE-EXPANSION-LIMIT* (~W) was exceeded, ~ probably trying to~% ~ inline a recursive function." *inline-expansion-limit*)) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index b7fff6f..8fa72f4 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -57,7 +57,7 @@ (declaim (ftype (function ((or nlx-info lambda-var) physenv) tn) find-in-physenv)) (defun find-in-physenv (thing physenv) - (or (cdr (assoc thing (ir2-physenv-environment (physenv-info physenv)))) + (or (cdr (assoc thing (ir2-physenv-closure (physenv-info physenv)))) (etypecase thing (lambda-var ;; I think that a failure of this assertion means that we're @@ -649,7 +649,7 @@ (locs loc)))) (when old-fp - (dolist (thing (ir2-physenv-environment called-env)) + (dolist (thing (ir2-physenv-closure called-env)) (temps (find-in-physenv (car thing) this-1env)) (locs (cdr thing))) @@ -1023,13 +1023,13 @@ (t ;; No more args, so normal entry. (vop xep-allocate-frame node block start-label nil))) - (if (ir2-physenv-environment env) + (if (ir2-physenv-closure env) (let ((closure (make-normal-tn *backend-t-primitive-type*))) (vop setup-closure-environment node block start-label closure) (when (getf (functional-plist ef) :fin-function) (vop funcallable-instance-lexenv node block closure closure)) (let ((n -1)) - (dolist (loc (ir2-physenv-environment env)) + (dolist (loc (ir2-physenv-closure env)) (vop closure-ref node block closure (incf n) (cdr loc))))) (vop setup-environment node block start-label))) diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp index 0da76e3..a728e2e 100644 --- a/src/compiler/ltn.lisp +++ b/src/compiler/ltn.lisp @@ -813,7 +813,7 @@ (valid (valid-function-use call type)) (strict-valid (valid-function-use call type :strict-result t))) - (frob "unable to do ~A (cost ~D) because:" + (frob "unable to do ~A (cost ~W) because:" (or (template-note loser) (template-name loser)) (template-cost loser)) (cond @@ -831,7 +831,7 @@ (let ((*compiler-error-context* call)) (compiler-note "~{~?~^~&~6T~}" (if template - `("forced to do ~A (cost ~D)" + `("forced to do ~A (cost ~W)" (,(or (template-note template) (template-name template)) ,(template-cost template)) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 84e9f86..af9ba1d 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -179,7 +179,7 @@ (when (and warnings (> undefined-warning-count warn-count)) (let ((more (- undefined-warning-count warn-count))) (compiler-style-warning - "~D more use~:P of undefined ~(~A~) ~S" + "~W more use~:P of undefined ~(~A~) ~S" more kind name)))))) (dolist (kind '(:variable :function :type)) @@ -201,11 +201,11 @@ (format *error-output* "~&") (pprint-logical-block (*error-output* nil :per-line-prefix "; ") (compiler-mumble "compilation unit ~:[finished~;aborted~]~ - ~[~:;~:*~& caught ~D fatal ERROR condition~:P~]~ - ~[~:;~:*~& caught ~D ERROR condition~:P~]~ - ~[~:;~:*~& caught ~D WARNING condition~:P~]~ - ~[~:;~:*~& caught ~D STYLE-WARNING condition~:P~]~ - ~[~:;~:*~& printed ~D note~:P~]" + ~[~:;~:*~& caught ~W fatal ERROR condition~:P~]~ + ~[~:;~:*~& caught ~W ERROR condition~:P~]~ + ~[~:;~:*~& caught ~W WARNING condition~:P~]~ + ~[~:;~:*~& caught ~W STYLE-WARNING condition~:P~]~ + ~[~:;~:*~& printed ~W note~:P~]" abort-p *aborted-compilation-unit-count* *compiler-error-count* diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 90cfd02..4979d4b 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -126,7 +126,7 @@ (declare (type list locations reserve-locations alternate-scs constant-scs)) (declare (type boolean save-p)) (unless (= (logcount alignment) 1) - (error "alignment not a power of two: ~D" alignment)) + (error "alignment not a power of two: ~W" alignment)) (let ((sb (meta-sb-or-lose sb-name))) (if (eq (sb-kind sb) :finite) @@ -136,7 +136,7 @@ (dolist (el locations) (declare (type unsigned-byte el)) (unless (<= 1 (+ el element-size) size) - (error "SC element ~D out of bounds for ~S" el sb)))) + (error "SC element ~W out of bounds for ~S" el sb)))) (when locations (error ":LOCATIONS is meaningless in a ~S SB." (sb-kind sb)))) @@ -176,7 +176,7 @@ (let ((old (svref *backend-sc-numbers* ',number))) (when (and old (not (eq (sc-name old) ',name))) - (warn "redefining SC number ~D from ~S to ~S" ',number + (warn "redefining SC number ~W from ~S to ~S" ',number (sc-name old) ',name))) (setf (svref *backend-sc-numbers* ',number) @@ -1309,7 +1309,7 @@ (eq (car x) :constant))) types) num) - (error "expected ~D ~:[result~;argument~] type~P: ~S" + (error "expected ~W ~:[result~;argument~] type~P: ~S" num load-p types num))) (when more-op @@ -1462,7 +1462,7 @@ (let ((nvars (length (vop-parse-variant-vars parse)))) (unless (= (length variant) nvars) - (error "expected ~D variant values: ~S" nvars variant))) + (error "expected ~W variant values: ~S" nvars variant))) `(make-vop-info :name ',(vop-parse-name parse) @@ -1748,7 +1748,7 @@ (when (or (vop-parse-more-args parse) (vop-parse-more-results parse)) (error "cannot use VOP with variable operand count templates")) (unless (= noperands (length operands)) - (error "called with ~D operands, but was expecting ~D" + (error "called with ~W operands, but was expecting ~W" (length operands) noperands)) (multiple-value-bind (acode abinds n-args) @@ -1811,7 +1811,7 @@ (<= (length fixed-results) result-count)) (error "too many fixed results")) (unless (= (length info) info-count) - (error "expected ~D info args" info-count)) + (error "expected ~W info args" info-count)) (multiple-value-bind (acode abinds n-args) (make-operand-list fixed-args (car (last args)) nil) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index c6bba14..e2635d2 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -304,7 +304,7 @@ (test-constraint nil :type (or sset null))) (def!method print-object ((cblock cblock) stream) (print-unreadable-object (cblock stream :type t :identity t) - (format stream ":START c~D" (cont-num (block-start cblock))))) + (format stream ":START c~W" (cont-num (block-start cblock))))) ;;; The BLOCK-ANNOTATION class is inherited (via :INCLUDE) by ;;; different BLOCK-INFO annotation structures so that code diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp index a6a7480..77fafae 100644 --- a/src/compiler/represent.lisp +++ b/src/compiler/represent.lisp @@ -370,12 +370,12 @@ (vop-results op-vop))) (error "couldn't find op? bug!"))))) (compiler-note - "doing ~A (cost ~D)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~ + "doing ~A (cost ~W)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~ the ~:R ~:[result~;argument~] of ~A" note cost name arg-p name pos arg-p op-note))) (t - (compiler-note "doing ~A (cost ~D)~@[ from ~S~]~@[ to ~S~]" + (compiler-note "doing ~A (cost ~W)~@[ from ~S~]~@[ to ~S~]" note cost (get-operand-name op-tn t) (get-operand-name dest-tn nil))))) (values)) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 8789353..600442e 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -268,7 +268,7 @@ (def!method print-object ((seg segment) stream) (print-unreadable-object (seg stream :type t) (let ((addr (sb!sys:sap-int (funcall (seg-sap-maker seg))))) - (format stream "#X~X[~D]~:[ (#X~X)~;~*~]~@[ in ~S~]" + (format stream "#X~X[~W]~:[ (#X~X)~;~*~]~@[ in ~S~]" addr (seg-length seg) (= (seg-virtual-location seg) addr) @@ -326,7 +326,7 @@ (def!method print-object ((dstate disassem-state) stream) (print-unreadable-object (dstate stream :type t) (format stream - "+~D~@[ in ~S~]" + "+~W~@[ in ~S~]" (dstate-cur-offs dstate) (dstate-segment dstate)))) @@ -481,7 +481,7 @@ (alignment (dstate-alignment dstate))) (unless (aligned-p location alignment) (when stream - (format stream "~A~Vt~D~%" '.align + (format stream "~A~Vt~W~%" '.align (dstate-argument-column dstate) alignment)) (incf(dstate-next-offs dstate) @@ -647,7 +647,7 @@ (incf max) (setf (cdr label) max) (setf (gethash (car label) label-hash) - (format nil "L~D" max))))) + (format nil "L~W" max))))) (setf (dstate-labels dstate) labels)))) ;;; Get the instruction-space, creating it if necessary. @@ -750,7 +750,7 @@ (when (or (null label-location) (> label-location location)) (return)) (unless (< label-location location) - (format stream " L~D:" (cdr next-label))) + (format stream " L~W:" (cdr next-label))) (pop (dstate-cur-labels dstate)))) ;; move to the instruction column @@ -958,7 +958,7 @@ (let ((fun-offset (sb!kernel:get-closure-length fun))) ;; There is function header fun-offset words from the ;; code header. - (format t "Fun-header ~S at offset ~D (words): ~S~A => ~S~%" + (format t "Fun-header ~S at offset ~W (words): ~S~A => ~S~%" fun fun-offset (sb!kernel:code-header-ref @@ -1167,7 +1167,7 @@ :debug-vars debug-vars)) (let ((debug-var (aref debug-vars debug-var-offset))) #+nil - (format t ";;; At offset ~D: ~S~%" debug-var-offset debug-var) + (format t ";;; At offset ~W: ~S~%" debug-var-offset debug-var) (let* ((sc-offset (sb!di::compiled-debug-var-sc-offset debug-var)) (sb-name @@ -1175,7 +1175,7 @@ (sb!c:sc-sb (aref sc-vec (sb!c:sc-offset-scn sc-offset)))))) #+nil - (format t ";;; SET: ~S[~D]~%" + (format t ";;; SET: ~S[~W]~%" sb-name (sb!c:sc-offset-offset sc-offset)) (unless (null sb-name) (let ((group (cdr (assoc sb-name groups)))) @@ -1267,7 +1267,7 @@ (when stream (unless at-block-begin (terpri stream)) - (format stream ";;; [~D] " + (format stream ";;; [~W] " (sb!di:code-location-form-number loc)) (prin1-short form stream) @@ -1348,7 +1348,7 @@ (let ((name (sb!c::compiled-debug-fun-name fmap-entry)) (kind (sb!c::compiled-debug-fun-kind fmap-entry))) #+nil - (format t ";;; SAW ~S ~S ~S,~S ~D,~D~%" + (format t ";;; SAW ~S ~S ~S,~S ~W,~W~%" name kind first-block-seen-p nil-block-seen-p last-offset (sb!c::compiled-debug-fun-start-pc fmap-entry)) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 1a40424..2929961 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -338,7 +338,7 @@ ;; Elements of this list have a one-to-one correspondence with ;; elements of the PHYSENV-CLOSURE list of the PHYSENV object that ;; links to us. - (environment (missing-arg) :type list :read-only t) + (closure (missing-arg) :type list :read-only t) ;; the TNs that hold the OLD-FP and RETURN-PC within the function. ;; We always save these so that the debugger can do a backtrace, ;; even if the function has no return (and thus never uses them). diff --git a/src/compiler/x86/static-fn.lisp b/src/compiler/x86/static-fn.lisp index cb26b35..ba94709 100644 --- a/src/compiler/x86/static-fn.lisp +++ b/src/compiler/x86/static-fn.lisp @@ -39,7 +39,7 @@ (defun static-fun-template-vop (num-args num-results) (unless (and (<= num-args register-arg-count) (<= num-results register-arg-count)) - (error "either too many args (~D) or too many results (~D); max = ~D" + (error "either too many args (~W) or too many results (~W); max = ~W" num-args num-results register-arg-count)) (let ((num-temps (max num-args num-results))) (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results)) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index afdd9d9..57b90fa 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -440,7 +440,7 @@ (< -1 offset (length name-vec)) (svref name-vec offset)) ;; FIXME: Shouldn't this be an ERROR? - (format nil "" offset sc-name)))) + (format nil "" offset sc-name)))) (float-registers (format nil "FR~D" offset)) (stack (format nil "S~D" offset)) (constant (format nil "Const~D" offset)) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index f8f0f35..64e0f9b 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -201,7 +201,7 @@ (setq head (cache-vector-ref head 0)) (incf free)) (format t - "~&There ~4D are caches of size ~4D. (~D free ~3D%)" + "~&There are ~4D caches of size ~4D. (~D free ~3D%)" allocated size free @@ -1068,7 +1068,7 @@ (sep (when home (line-separation home i)))) (when (and sep (> sep limit)) (error "bad cache ~S ~@ - value at location ~D: ~D lines from its home. The limit is ~D." + value at location ~W: ~W lines from its home. The limit is ~W." cache location sep limit)))) (setq location (next-location location)))))) diff --git a/src/pcl/construct.lisp b/src/pcl/construct.lisp index 5f3b40c..577ecfd 100644 --- a/src/pcl/construct.lisp +++ b/src/pcl/construct.lisp @@ -453,7 +453,7 @@ (defun reset-constructors () (multiple-value-bind (nclass ncons) (map-constructors #'install-lazy-constructor-installer ) - (format t "~&~D classes, ~D constructors." nclass ncons))) + (format t "~&~W classes, ~W constructors." nclass ncons))) (defun disable-constructors () (multiple-value-bind (nclass ncons) @@ -467,7 +467,7 @@ (constructor-class c) () () () ()) 'fallback))))) - (format t "~&~D classes, ~D constructors." nclass ncons))) + (format t "~&~W classes, ~W constructors." nclass ncons))) (defun enable-constructors () (reset-constructors)) diff --git a/src/pcl/describe.lisp b/src/pcl/describe.lisp index 998d45c..b02ccb0 100644 --- a/src/pcl/describe.lisp +++ b/src/pcl/describe.lisp @@ -115,7 +115,7 @@ (ft "It has no name (the name is NIL).~%"))) (ft "The direct superclasses are: ~:S, and the direct~%~ subclasses are: ~:S. The class precedence list is:~%~S~%~ - There are ~D methods specialized for this class." + There are ~W methods specialized for this class." (mapcar #'pretty-class (class-direct-superclasses class)) (mapcar #'pretty-class (class-direct-subclasses class)) (mapcar #'pretty-class (class-precedence-list class)) diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp index 609e8b0..c4cda03 100644 --- a/src/pcl/dfun.lisp +++ b/src/pcl/dfun.lisp @@ -1578,7 +1578,7 @@ And so, we are saved. (sort (third type+count+sizes) #'< :key #'car))) *dfun-count*) (mapc #'(lambda (type+count+sizes) - (format t "~&There are ~D dfuns of type ~S." + (format t "~&There are ~W dfuns of type ~S." (cadr type+count+sizes) (car type+count+sizes)) (format t "~% ~S~%" (caddr type+count+sizes))) *dfun-count*) diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp index 34e166a..bea7cd3 100644 --- a/src/pcl/methods.lisp +++ b/src/pcl/methods.lisp @@ -589,7 +589,7 @@ (defun error-need-at-least-n-args (function n) - (error "~@" + (error "~@" function n)) diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp index 9eb42a7..964c84b 100644 --- a/src/pcl/print-object.lisp +++ b/src/pcl/print-object.lisp @@ -132,7 +132,7 @@ (defmethod print-object ((cache cache) stream) (print-unreadable-object (cache stream :type t :identity t) (format stream - "~D ~S ~D" + "~W ~S ~W" (cache-nkeys cache) (cache-valuep cache) (cache-nlines cache)))) diff --git a/tests/stream.impure-cload.lisp b/tests/stream.impure-cload.lisp index 0075908..a4443ed 100644 --- a/tests/stream.impure-cload.lisp +++ b/tests/stream.impure-cload.lisp @@ -29,7 +29,7 @@ (defvar *scratch-file-stream*) (dolist (scratch-file-length '(1 ; everyone's favorite corner case 200123)) ; hopefully much bigger than buffer - (format t "/SCRATCH-FILE-LENGTH=~D~%" scratch-file-length) + (format t "/SCRATCH-FILE-LENGTH=~W~%" scratch-file-length) (with-open-file (s *scratch-file-name* :direction :output) (dotimes (i scratch-file-length) (write-char #\x s))) diff --git a/tests/stress-gc.lisp b/tests/stress-gc.lisp index 7fff862..f791ddd 100644 --- a/tests/stress-gc.lisp +++ b/tests/stress-gc.lisp @@ -36,7 +36,7 @@ result)) (defun stress-gc (n-passes &optional (size 3000)) - (format t "~&beginning STRESS-GC N-PASSES=~D SIZE=~D~%" n-passes size) + (format t "~&beginning STRESS-GC N-PASSES=~W SIZE=~W~%" n-passes size) (let ((generations (make-array (isqrt size) :initial-element nil)) ;; We allocate on the order of MOST-POSITIVE-FIXNUM things ;; before doing a full GC. @@ -69,7 +69,7 @@ (assert-generation i-generation generation-i)) (setf (aref generations i-generation) generation-i)))) - (format t "~&done with STRESS-GC N-PASSES=~D SIZE=~D~%" n-passes size)) + (format t "~&done with STRESS-GC N-PASSES=~W SIZE=~W~%" n-passes size)) (defvar *expected*) (defvar *got*) @@ -84,7 +84,7 @@ ;; wimpy to inspect lexical variables. (let ((*expected* (funcall repr index-within-generation)) (*got* element-of-generation)) - (error "bad element #~D in generation #~D:~% expected ~S~% from ~S,~% got ~S" + (error "bad element #~W in generation #~D:~% expected ~S~% from ~S,~% got ~S" index-within-generation index-of-generation *expected* diff --git a/version.lisp-expr b/version.lisp-expr index 4b86698..18dcf15 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.pre7.87" +"0.pre7.88" -- 1.7.10.4