From 4d146e6d6b59d1b00d5cbb4ddc57fd9431c09b1b Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Fri, 17 Nov 2017 16:10:06 -0500 Subject: [PATCH] Optionally be less noisy during build if --noinform is added to the SBCL invocation options in make-target-2 --- make-host-1.lisp | 13 ++++++++-- src/code/cold-init.lisp | 11 +++++---- src/code/setf-funs.lisp | 7 +++--- src/code/shaketree.lisp | 2 +- src/cold/shared.lisp | 7 ------ src/compiler/generic/genesis.lisp | 50 +++++++++++++++++---------------------- src/compiler/target-disassem.lisp | 7 +++--- src/pcl/print-object.lisp | 9 ++++--- src/runtime/fullcgc.c | 21 +++++++++------- 9 files changed, 67 insertions(+), 60 deletions(-) diff --git a/make-host-1.lisp b/make-host-1.lisp index e6bc2694b..5b765e448 100644 --- a/make-host-1.lisp +++ b/make-host-1.lisp @@ -5,8 +5,17 @@ ;;; things.) (setf *print-level* 5 *print-length* 5) -(progn (load "src/cold/shared.lisp") - (load "tools-for-build/ldso-stubs.lisp")) +(progn + (load "src/cold/shared.lisp") + (load "tools-for-build/ldso-stubs.lisp") + (let ((*print-pretty* nil) + (*print-length* nil)) + (dolist (thing '("*SHEBANG-FEATURES*" "*SHEBANG-BACKEND-SUBFEATURES*")) + (let ((val (symbol-value (intern thing "SB-COLD")))) + (when val + (format t "~&target *~A* = ~S~%" + (subseq thing (length "*SHEBANG-") (1- (length thing))) + val)))))) (in-package "SB-COLD") (progn (setf *host-obj-prefix* "obj/from-host/") diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index a249b8f6e..dea61b598 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -78,6 +78,8 @@ ,@forms (dolist (f wrapped-functions) (unencapsulate f '!cold-init)))) +(defun !c-runtime-noinform-p () (/= (extern-alien "lisp_startup_options" char) 0)) + ;;; called when a cold system starts up (defun !cold-init (&aux real-choose-symbol-out-fun) "Give the world a shove and hope it spins." @@ -90,7 +92,8 @@ (setq *error-output* (!make-cold-stderr-stream) *standard-output* *error-output* *trace-output* *error-output*) - (write-string "COLD-INIT... ") + (unless (!c-runtime-noinform-p) + (write-string "COLD-INIT... ")) ;; Assert that FBOUNDP doesn't choke when its answer is NIL. ;; It was fine if T because in that case the legality of the arg is certain. @@ -178,8 +181,9 @@ ;; fixups be done separately? Wouldn't that be clearer and better? ;; -- WHN 19991204 (/show0 "doing cold toplevel forms and fixups") - (progn (write `("Length(TLFs)= " ,(length *!cold-toplevels*))) - (terpri)) + (unless (!c-runtime-noinform-p) + (write `("Length(TLFs)= " ,(length *!cold-toplevels*))) + (terpri)) ;; only the basic external formats are present at this point. (setq sb!impl::*default-external-format* :latin-1) @@ -297,7 +301,6 @@ (/show0 "back from first GC") ;; The show is on. - (terpri) (/show0 "going into toplevel loop") (handling-end-of-the-world (toplevel-init) diff --git a/src/code/setf-funs.lisp b/src/code/setf-funs.lisp index b64ca0337..b6f938c17 100644 --- a/src/code/setf-funs.lisp +++ b/src/code/setf-funs.lisp @@ -22,9 +22,10 @@ (setf (info :function :type s) (specifier-type (type-specifier ftype))) (push s l)))) - (let ((*print-pretty* nil) - (*print-length* nil)) - (format t "~&; Fixed ftypes: ~S~%" (sort l #'string<)))) + (unless (sb-impl::!c-runtime-noinform-p) + (let ((*print-pretty* nil) + (*print-length* nil)) + (format t "~&; Fixed ftypes: ~S~%" (sort l #'string<))))) (eval-when (:compile-toplevel :execute) diff --git a/src/code/shaketree.lisp b/src/code/shaketree.lisp index 1e0f8f3e3..87f9e1025 100644 --- a/src/code/shaketree.lisp +++ b/src/code/shaketree.lisp @@ -40,5 +40,5 @@ (loop for (internals externals . package) in list do (reintern internals (package-internal-symbols package) package) (reintern externals (package-external-symbols package) package)) - (format t "~&Dropped ~D symbols~%" n-dropped) + #+nil (format t "~&Dropped ~D symbols~%" n-dropped) (force-output))))) diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 28394fe32..adac9f80d 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -210,13 +210,6 @@ #'identity))) (funcall customizer default-subfeatures))) -(progn (write-string "target *FEATURES* = ") - (write *shebang-features* :pretty nil :length nil) - (terpri) - (write-string "*shebang-backend-subfeatures* = ") - (write *shebang-backend-subfeatures* :pretty nil :length nil) - (terpri)) - ;;; Call for effect of signaling an error if no target picked. (target-platform-name) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 1befc6f91..d61704f39 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -1950,7 +1950,6 @@ core and return a descriptor to it." ;; the C runtime. #!-sb-dynamic-core (defun load-cold-foreign-symbol-table (filename) - (/show "load-cold-foreign-symbol-table" filename) (with-open-file (file filename) (loop for line = (read-line file nil nil) while line do @@ -2000,7 +1999,6 @@ core and return a descriptor to it." (not (= old-value value))) (warn "redefining ~S from #X~X to #X~X" name old-value value))) - (/show "adding to *cold-foreign-symbol-table*:" name value) (setf (gethash name *cold-foreign-symbol-table*) value) #!+win32 (let ((at-position (position #\@ name))) @@ -3437,7 +3435,7 @@ III. initially undefined function references (alphabetically): *core-file*)))) num) -(defun output-gspace (gspace) +(defun output-gspace (gspace verbose) (force-output *core-file*) (let* ((posn (file-position *core-file*)) (bytes (* (gspace-free-word-index gspace) sb!vm:n-word-bytes)) @@ -3446,12 +3444,9 @@ III. initially undefined function references (alphabetically): (file-position *core-file* (* sb!c:+backend-page-bytes+ (1+ *data-page*))) - (format t - "writing ~S byte~:P [~S page~:P] from ~S~%" - total-bytes - pages - gspace) - (force-output) + (when verbose + (format t "writing ~S byte~:P [~S page~:P] from ~S~%" + total-bytes pages gspace)) ;; Note: It is assumed that the GSPACE allocation routines always ;; allocate whole pages (of size +backend-page-bytes+) and that any @@ -3487,14 +3482,13 @@ III. initially undefined function references (alphabetically): ;;; the "initial core file" because core files could be created later ;;; by executing SAVE-LISP in a running system, perhaps after we've ;;; added some functionality to the system.) -(declaim (ftype (function (string)) write-initial-core-file)) -(defun write-initial-core-file (filename) +(defun write-initial-core-file (filename verbose) (let ((filenamestring (namestring filename)) (*data-page* 0)) - (format t "[building initial core file in ~S: ~%" filenamestring) - (force-output) + (when verbose + (format t "[building initial core file in ~S: ~%" filenamestring)) (with-open-file (*core-file* filenamestring :direction :output @@ -3528,7 +3522,8 @@ III. initially undefined function references (alphabetically): (list *dynamic*)))) ;; length = (5 words/space) * N spaces + 2 for header. (write-word (+ (* (length spaces) 5) 2)) - (mapc #'output-gspace spaces)) + (dolist (space spaces) + (output-gspace space verbose))) ;; Write the initial function. (write-word initial-fun-core-entry-type-code) @@ -3536,18 +3531,17 @@ III. initially undefined function references (alphabetically): (let* ((cold-name (cold-intern '!cold-init)) (initial-fun (cold-fdefn-fun (cold-fdefinition-object cold-name)))) - (format t - "~&/(DESCRIPTOR-BITS INITIAL-FUN)=#X~X~%" - (descriptor-bits initial-fun)) + (when verbose + (format t "~&/INITIAL-FUN=#X~X~%" (descriptor-bits initial-fun))) (write-word (descriptor-bits initial-fun))) ;; Write the End entry. (write-word end-core-entry-type-code) (write-word 2))) - (format t "done]~%") - (force-output) - (/show "leaving WRITE-INITIAL-CORE-FILE") + (when verbose + (format t "done]~%") + (force-output)) (values)) ;;;; the actual GENESIS function @@ -3708,12 +3702,13 @@ III. initially undefined function references (alphabetically): (layout (gethash name *cold-layouts*))) (aver layout) (write-slots layout *host-layout-of-layout* :info dd)))) - (format t "~&; SB!Loader: (~D~@{+~D~}) structs/consts/funs/methods/other~%" - (length *known-structure-classoids*) - (length *!cold-defconstants*) - (length *!cold-defuns*) - (reduce #'+ *cold-methods* :key (lambda (x) (length (cdr x)))) - (length *!cold-toplevels*))) + (when verbose + (format t "~&; SB!Loader: (~D~@{+~D~}) structs/consts/funs/methods/other~%" + (length *known-structure-classoids*) + (length *!cold-defconstants*) + (length *!cold-defuns*) + (reduce #'+ *cold-methods* :key (lambda (x) (length (cdr x)))) + (length *!cold-toplevels*)))) (dolist (symbol '(*!cold-defconstants* *!cold-defuns* *!cold-toplevels*)) (cold-set symbol (list-to-core (nreverse (symbol-value symbol)))) @@ -3760,7 +3755,6 @@ III. initially undefined function references (alphabetically): (vector-in-core (nreverse *cold-assembler-objects*))))) (when core-file-name (finish-symbols)) - (/show "back from FINISH-SYMBOLS") (finalize-load-time-value-noise) ;; Write results to files. @@ -3768,7 +3762,7 @@ III. initially undefined function references (alphabetically): (with-open-file (stream map-file-name :direction :output :if-exists :supersede) (write-map stream))) (when core-file-name - (write-initial-core-file core-file-name)) + (write-initial-core-file core-file-name verbose)) (unless c-header-dir-name (return-from sb-cold:genesis)) (let ((filename (format nil "~A/Makefile.features" c-header-dir-name))) diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 7ca94b4b8..e229eef6b 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -798,9 +798,10 @@ (collect-inst-variants (logically-readonlyize (string-upcase symbol)) package it cache)))) - (apply 'format t - "~&Disassembler: ~D printers, ~D prefilters, ~D labelers~%" - (mapcar (lambda (x) (length (cdr x))) cache)))) + (unless (sb!impl::!c-runtime-noinform-p) + (apply 'format t + "~&Disassembler: ~D printers, ~D prefilters, ~D labelers~%" + (mapcar (lambda (x) (length (cdr x))) cache))))) ;;; Get the instruction-space, creating it if necessary. (defun get-inst-space (&key (package sb!assem::*backend-instruction-set-package*) diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp index a930badd4..76f67ee9f 100644 --- a/src/pcl/print-object.lisp +++ b/src/pcl/print-object.lisp @@ -33,13 +33,16 @@ ;;; by the printer doing bootstrapping, and immediately replace it ;;; with some new printing logic, so that the Lisp printer stays ;;; crippled only for the shortest necessary time. -(write-string "; Removing placeholder PRINT-OBJECT ...") (force-output) +(unless (sb-impl::!c-runtime-noinform-p) + (write-string "; Removing placeholder PRINT-OBJECT ...") + (force-output)) (let ((*print-pretty* t)) ; use pretty printer dispatch table, not PRINT-OBJECT (fmakunbound 'print-object) (defgeneric print-object (object stream)) (!incorporate-cross-compiled-methods 'print-object)) -(write-string " done -") +(unless (sb-impl::!c-runtime-noinform-p) + (write-string " done +")) ;;;; PRINT-OBJECT methods for objects from PCL classes ;;;; diff --git a/src/runtime/fullcgc.c b/src/runtime/fullcgc.c index 212191078..fafc1596a 100644 --- a/src/runtime/fullcgc.c +++ b/src/runtime/fullcgc.c @@ -376,10 +376,11 @@ void execute_full_mark_phase() #define timediff(b,a,field) \ (double)((a.field.tv_sec-b.field.tv_sec)*1000000 + \ (a.field.tv_usec-b.field.tv_usec)) / 1000000.0 - fprintf(stderr, - "[Mark phase: %d pages used, HT-count=%d, ET=%f+%f sys+usr]\n", - (int)(page_table_pages - free_page), mark_bits.count, - timediff(before, after, ru_stime), timediff(before, after, ru_utime)); + if (gencgc_verbose) + fprintf(stderr, + "[Mark phase: %d pages used, HT-count=%d, ET=%f+%f sys+usr]\n", + (int)(page_table_pages - free_page), mark_bits.count, + timediff(before, after, ru_stime), timediff(before, after, ru_utime)); #endif } @@ -522,11 +523,13 @@ void execute_full_sweep_phase() #endif if (sweeplog) fprintf(sweeplog, "-- dynamic space --\n"); walk_generation(sweep, -1, (uword_t)words_zeroed); - fprintf(stderr, "[Sweep phase: "); - int i; - for(i=6;i>=0;--i) - fprintf(stderr, "%ld%s", words_zeroed[i], i?"+":""); - fprintf(stderr, " words zeroed]\n"); + if (gencgc_verbose) { + fprintf(stderr, "[Sweep phase: "); + int i; + for(i=6;i>=0;--i) + fprintf(stderr, "%ld%s", words_zeroed[i], i?"+":""); + fprintf(stderr, " words zeroed]\n"); + } hopscotch_destroy(&mark_bits); #ifdef LOG_SWEEP_ACTIONS fclose(sweeplog); -- 2.11.4.GIT