diff --git a/assembly/assemfile.lisp b/assembly/assemfile.lisp index 227d02b04e2cffeb9a6d6d88d04e50e7ba5ceb72..fe9571bdfb181f7d54f28d9cb765787bba211036 100644 --- a/assembly/assemfile.lisp +++ b/assembly/assemfile.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.37 1994/10/31 04:57:57 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.38 2003/01/06 15:10:15 toy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -129,7 +129,7 @@ ,@(generate-return-sequence (or (cadr (assoc :return-style options)) :raw))) (when *compile-print* - (format *error-output* "~S assembled~%" ',name))))) + (format *error-output* "; ~S assembled~%" ',name))))) (defun arg-or-res-spec (reg) `(,(reg-spec-name reg) diff --git a/code/gc.lisp b/code/gc.lisp index 77f62769d68a6b2029742f8d2a68e4c7446ba31f..7eaaf45529627c5ddc678d276bc2b522630b420d 100644 --- a/code/gc.lisp +++ b/code/gc.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.30 2002/11/19 12:38:55 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.31 2003/01/06 15:10:16 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -319,7 +319,7 @@ (defun default-gc-notify-before (bytes-in-use) (when (eq *gc-verbose* :beep) (system:beep *standard-output*)) - (format t "~&[GC threshold exceeded with ~:D bytes in use. ~ + (format t "~&; [GC threshold exceeded with ~:D bytes in use. ~ Commencing GC.]~%" bytes-in-use) (finish-output)) ;;; @@ -329,9 +329,9 @@ bytes). It should notify the user that the system is going to GC.") (defun default-gc-notify-after (bytes-retained bytes-freed new-trigger) - (format t "[GC completed with ~:D bytes retained and ~:D bytes freed.]~%" + (format t "~&; [GC completed with ~:D bytes retained and ~:D bytes freed.]~%" bytes-retained bytes-freed) - (format t "[GC will next occur when at least ~:D bytes are in use.]~%" + (format t "~&; [GC will next occur when at least ~:D bytes are in use.]~%" new-trigger) (when (eq *gc-verbose* :beep) (system:beep *standard-output*)) diff --git a/code/time.lisp b/code/time.lisp index 701fcb8bcc5897d8193014e0b9782e0a2ed7dfc0..59bc1275f6aa55d26703d87ce1451958d433de12 100644 --- a/code/time.lisp +++ b/code/time.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.20 2002/11/05 22:45:41 cracauer Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.21 2003/01/06 15:10:16 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -336,22 +336,25 @@ (time-get-sys-info)) (setq new-real-time (- (get-internal-real-time) real-time-overhead)) (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0))) - (format *trace-output* - "~&Evaluation took:~% ~ + (terpri *trace-output*) + (pprint-logical-block (*trace-output* nil :per-line-prefix "; ") + (format *trace-output* + "Evaluation took:~% ~ ~S second~:P of real time~% ~ ~S second~:P of user run time~% ~ ~S second~:P of system run time~% ~ ~@[[Run times include ~S second~:P GC run time]~% ~]~ ~S page fault~:P and~% ~ ~:D bytes consed.~%" - (max (/ (- new-real-time old-real-time) - (float internal-time-units-per-second)) - 0.0) - (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0) - (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0) - (unless (zerop gc-run-time) - (/ (float gc-run-time) - (float internal-time-units-per-second))) - (max (- new-page-faults old-page-faults) 0) - (max (- new-bytes-consed old-bytes-consed cons-overhead) - 0))))))) + (max (/ (- new-real-time old-real-time) + (float internal-time-units-per-second)) + 0.0) + (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0) + (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0) + (unless (zerop gc-run-time) + (/ (float gc-run-time) + (float internal-time-units-per-second))) + (max (- new-page-faults old-page-faults) 0) + (max (- new-bytes-consed old-bytes-consed cons-overhead) + 0)))) + (terpri *trace-output*))))) diff --git a/compiler/disassem.lisp b/compiler/disassem.lisp index 3856658a8beebcf16a4fc623dacb6cfe769d0b55..cbf06834a70d49be2207a87e0e0eb3e51854f010 100644 --- a/compiler/disassem.lisp +++ b/compiler/disassem.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.33 2002/10/07 14:31:06 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.34 2003/01/06 15:10:17 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2428,12 +2428,13 @@ (type disassem-state dstate)) (with-print-restrictions (dolist (note (dstate-notes dstate)) - (format stream "~vt; " *note-column*) - (etypecase note - (string - (write-string note stream)) - (function - (funcall note stream))) + (format stream "~vt" *note-column*) + (pprint-logical-block (stream nil :per-line-prefix "; ") + (etypecase note + (string + (write-string note stream)) + (function + (funcall note stream)))) (terpri stream)) (fresh-line stream) (setf (dstate-notes dstate) nil))) diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index 796891d36c09df1683b68a03db66ceaefd90b1b7..bd008c59bea724f195b8bba72c040b21a5c15429 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.134 2002/12/13 19:25:50 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.135 2003/01/06 15:10:17 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3344,7 +3344,7 @@ (ir1-convert start cont `(%%defmacro ',name ,fun ,doc))) (when *compile-print* - (compiler-mumble "Converted ~S.~%" name)))) + (compiler-mumble "~&; Converted ~S.~%" name)))) (defun do-compiler-macro-compile-time (name def) @@ -3370,7 +3370,7 @@ (ir1-convert start cont `(%%define-compiler-macro ',name ,fun ,doc))) (when *compile-print* - (compiler-mumble "Converted ~S.~%" name)))) + (compiler-mumble "~&; Converted ~S.~%" name)))) ;;; Update the global environment to correspond to the new definition. @@ -3634,4 +3634,4 @@ ,@(when save-expansion `(',save-expansion))))) (when *compile-print* - (compiler-mumble "Converted ~S.~%" name)))))) + (compiler-mumble "~&; Converted ~S.~%" name)))))) diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp index 8b18df85ee2c5af6a8cffbc24fcb40555398d591..44d86c033bee1adc4a7a6cc7a4e15e1cc3256f0c 100644 --- a/compiler/ir1util.lisp +++ b/compiler/ir1util.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.86 2002/08/26 19:57:07 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.87 2003/01/06 15:10:17 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1698,7 +1698,7 @@ (*print-lines* (or *error-print-lines* *print-lines*)) (*print-pretty* pretty)) (if pretty - (format nil " ~S~%" form) + (format nil "~@<; ~@; ~S~:>~%" form) (prin1-to-string form)))) @@ -1824,8 +1824,10 @@ (cond ((= *last-message-count* 1) (when terpri (terpri *compiler-error-output*))) ((> *last-message-count* 1) - (format *compiler-error-output* "[Last message occurs ~D times]~2%" - *last-message-count*))) + (pprint-logical-block (*compiler-error-output* nil :per-line-prefix "; ") + (format *compiler-error-output* "[Last message occurs ~D times]" + *last-message-count*)) + (format *compiler-error-output* "~2%"))) (setq *last-message-count* 0)) @@ -1857,65 +1859,75 @@ (let ((stream *compiler-error-output*) (context (find-error-context format-args))) (cond - (context - (let ((file (compiler-error-context-file-name context)) - (in (compiler-error-context-context context)) - (form (compiler-error-context-original-source context)) - (enclosing (compiler-error-context-enclosing-source context)) - (source (compiler-error-context-source context)) - (last *last-error-context*)) - (compiler-notification what context) + (context + (let ((file (compiler-error-context-file-name context)) + (in (compiler-error-context-context context)) + (form (compiler-error-context-original-source context)) + (enclosing (compiler-error-context-enclosing-source context)) + (source (compiler-error-context-source context)) + (last *last-error-context*)) + (compiler-notification what context) - (unless (and last - (equal file (compiler-error-context-file-name last))) - (when (pathnamep file) - (note-message-repeats) - (setq last nil) - (format stream "~2&File: ~A~%" (namestring file)))) + (unless (and last + (equal file (compiler-error-context-file-name last))) + (when (pathnamep file) + (note-message-repeats) + (setq last nil) + (format stream "~2&") + (pprint-logical-block (stream nil :per-line-prefix "; ") + (format stream "~2&File: ~A" (namestring file))) + (format stream "~%"))) - (unless (and last - (equal in (compiler-error-context-context last))) - (note-message-repeats) - (setq last nil) - (format stream "~2&In:~{~<~% ~4:;~{ ~S~}~>~^ =>~}~%" in)) + (unless (and last + (equal in (compiler-error-context-context last))) + (note-message-repeats) + (setq last nil) + (format stream "~2&") + (pprint-logical-block (stream nil :per-line-prefix "; ") + (format stream "In:~{~<~% ~4:;~{ ~S~}~>~^ =>~}" in)) + (format stream "~2%")) - (unless (and last - (string= form - (compiler-error-context-original-source last))) - (note-message-repeats) - (setq last nil) - (write-string form stream)) + (unless (and last + (string= form + (compiler-error-context-original-source last))) + (note-message-repeats) + (setq last nil) + (write-string form stream)) - (unless (and last - (equal enclosing - (compiler-error-context-enclosing-source last))) - (when enclosing - (note-message-repeats) - (setq last nil) - (format stream "--> ~{~<~%--> ~1:;~A~> ~}~%" enclosing))) + (unless (and last + (equal enclosing + (compiler-error-context-enclosing-source last))) + (when enclosing + (note-message-repeats) + (setq last nil) + (format stream "; --> ~{~<~%; --> ~1:;~A~> ~}~%" enclosing))) - (unless (and last - (equal source (compiler-error-context-source last))) - (setq *last-format-string* nil) - (when source - (note-message-repeats) - (dolist (src source) - (write-line "==>" stream) - (write-string src stream)))))) - (t - (compiler-notification what nil) - (note-message-repeats) - (setq *last-format-string* nil) - (format stream "~2&"))) - - (setq *last-error-context* context) + (unless (and last + (equal source (compiler-error-context-source last))) + (setq *last-format-string* nil) + (when source + (note-message-repeats) + (dolist (src source) + (write-line "; ==>" stream) + (write-string src stream)))))) + (t + (pprint-logical-block (stream nil :per-line-prefix "; ") + (compiler-notification what nil)) + (note-message-repeats) + (setq *last-format-string* nil) + (format stream "~2&"))) + + (setq *last-error-context* context) - (unless (and (equal format-string *last-format-string*) - (tree-equal format-args *last-format-args*)) - (note-message-repeats nil) - (setq *last-format-string* format-string) - (setq *last-format-args* format-args) - (format stream "~&~:(~A~): ~?~&" what format-string format-args))))) + (unless (and (equal format-string *last-format-string*) + (tree-equal format-args *last-format-args*)) + (note-message-repeats nil) + (setq *last-format-string* format-string) + (setq *last-format-args* format-args) + (format stream "~&") + (let ((*print-lines* nil)) + (pprint-logical-block (stream nil :per-line-prefix "; ") + (format stream "~:(~A~): ~?~&" what format-string format-args))))))) (incf *last-message-count*) (undefined-value)) diff --git a/compiler/main.lisp b/compiler/main.lisp index ded912a32efbd3931dcb24911392c40fdb5443ce..47bd694ff1f4c00b449eab7a1c86d311fdb4334e 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.129 2002/11/19 12:55:02 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.130 2003/01/06 15:10:18 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -418,7 +418,7 @@ (return nil))))))) (when *compile-print* - (compiler-mumble "~&~:[~;Byte ~]Compiling ~A: " + (compiler-mumble "~&; ~:[~;Byte ~]Compiling ~A: " *byte-compiling* (component-name component))) @@ -585,11 +585,11 @@ (zerop *compiler-warning-count*) (zerop *compiler-note-count*))) (compiler-mumble - "~2&Compilation unit ~:[finished~;aborted~].~ - ~[~:;~:*~& ~D fatal error~:P~]~ - ~[~:;~:*~& ~D error~:P~]~ - ~[~:;~:*~& ~D warning~:P~]~ - ~[~:;~:*~& ~D note~:P~]~2%" + "~2&; Compilation unit ~:[finished~;aborted~].~ + ~[~:;~:*~&; ~D fatal error~:P~]~ + ~[~:;~:*~&; ~D error~:P~]~ + ~[~:;~:*~&; ~D warning~:P~]~ + ~[~:;~:*~&; ~D note~:P~]~2%" abort-p abort-count *compiler-error-count* @@ -1021,7 +1021,7 @@ (let ((comment (coerce (second form) 'simple-string))) (setf (file-info-comment file) comment) (when *compile-verbose* - (compiler-mumble "~&Comment: ~A~2&" comment))))))) + (compiler-mumble "~&; Comment: ~A~2&" comment))))))) ;;; PROCESS-COLD-LOAD-FORM -- Internal @@ -1618,14 +1618,14 @@ ;;; (defun start-error-output (source-info) (declare (type source-info source-info)) - (compiler-mumble "~2&Python version ~A, VM version ~A on ~A.~%" + (compiler-mumble "~2&; Python version ~A, VM version ~A on ~A.~%" compiler-version (backend-version *backend*) (ext:format-universal-time nil (get-universal-time) :style :government :print-weekday nil :print-timezone nil)) (dolist (x (source-info-files source-info)) - (compiler-mumble "Compiling: ~A ~A~%" + (compiler-mumble "; Compiling: ~A ~A~%" (namestring (file-info-name x)) (ext:format-universal-time nil (file-info-write-date x) :style :government @@ -1636,7 +1636,7 @@ ;;; (defun finish-error-output (source-info won) (declare (type source-info source-info)) - (compiler-mumble "~&Compilation ~:[aborted after~;finished in~] ~A.~&" + (compiler-mumble "~&; Compilation ~:[aborted after~;finished in~] ~A.~&" won (elapsed-time-to-string (- (get-universal-time) @@ -1769,7 +1769,7 @@ (close-fasl-file fasl-file (not compile-won)) (setq output-file-pathname (pathname (fasl-file-stream fasl-file))) (when (and compile-won *compile-verbose*) - (compiler-mumble "~2&~A written.~%" + (compiler-mumble "~2&; ~A written.~%" (namestring output-file-pathname)))) (when *compile-verbose*