From ac26fca899425f3409b1530ff7dc478d2af0dfe1 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Thu, 21 Aug 2008 19:44:47 +0000 Subject: [PATCH] Only three variables *COMPILE-PRINT*, *COMPILE-VERBOSE* and *SUPPRESS-COMPILER-MESSAGES* to govern information printed by COMPILE-FILE/COMPILE --- src/CHANGELOG | 23 +++++++++------- src/cmp/cmpdefs.lsp | 13 +++++---- src/cmp/cmpmain.lsp | 65 +++++++++++++++++++++++++++++---------------- src/cmp/cmptop.lsp | 5 ++-- src/cmp/cmputil.lsp | 40 +++++++++++----------------- 5 files changed, 78 insertions(+), 68 deletions(-) diff --git a/src/CHANGELOG b/src/CHANGELOG index ecf61ddb9..fe79cfd66 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -6,6 +6,14 @@ ECL 0.9l-p1: - The compiler now signals compiler-error, compiler-warning and compiler-note for errors, warnings and notes, respectively. + - Printing of compiler messages is now ruled by *COMPILE-PRINT*, *COMPILE-VERBOSE* + and *SUPPRESS-COMPILER-MESSAGES*. The latter is either NIL or a valid lisp type + which denotes which compiler messages are suppressed. If *SUPPRESS-COMPILER-MESSAGES* + is NIL and *COMPILE-VERBOSE* is NIL, then no messages are shown. + + - *SUPPRESS-COMPILER-NOTES* and *SUPPRES-COMPILER-WARNINGS* are deprecated and + will be removed in next release. + - ECL allows the user to set up handlers for different compiler conditions, including errors, warnings and simple notes. The recommended procedure is to use HANDLER-BIND and _NOT_ to transfer control out of the compilation @@ -13,17 +21,12 @@ ECL 0.9l-p1: and MUFFLE-WARNING. (use-package :c) - (let ((messages nil)) - (handler-bind ((compiler-error #'(lambda (c) - (push c messages) - (abort c))) - (compiler-message #'(lambda (c) - (push c messages) - (muffle-warning)))) - (let ((*compile-verbose* nil)) - (compile-file "foo.lsp"))) + (let ((warnings nil)) + (handler-bind ((compiler-message #'(lambda (c) + (push c warnings)))) + (compile-file "foo.lsp" :verbose nil :print nil)) (format t "~&;;; Printing compiler messages") - (loop for m in (nreverse messages) + (loop for m in (nreverse warnings) for i from 0 do (format t "~&~@<;;; ~@;Message #~D~%~A~:>" i m))) diff --git a/src/cmp/cmpdefs.lsp b/src/cmp/cmpdefs.lsp index bcc533fa2..2e8b74e9e 100644 --- a/src/cmp/cmpdefs.lsp +++ b/src/cmp/cmpdefs.lsp @@ -39,7 +39,8 @@ "COMPILER-MESSAGE-FILE-POSITION" "COMPILER-MESSAGE-FORM" "*SUPPRESS-COMPILER-WARNINGS*" - "*SUPPRESS-COMPILER-NOTES*") + "*SUPPRESS-COMPILER-NOTES*" + "*SUPPRESS-COMPILER-MESSAGES*") (:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP" "MACRO" "*COMPILER-CONSTANTS*" "REGISTER-GLOBAL" "CMP-ENV-REGISTER-MACROLET" "COMPILER-LET")) @@ -276,13 +277,11 @@ each form it processes. The default value is NIL.") "This variable controls whether the compiler should display messages about its progress. The default value is T.") -(defvar *suppress-compiler-warnings* nil - "This variable controls whether the compiler should issue warnings. -The default value is NIL.") +(defvar *suppress-compiler-messages* nil + "A type denoting which compiler messages and conditions are _not_ displayed.") -(defvar *suppress-compiler-notes* nil - "This variable controls whether the compiler displays compilation notices. -The default value is NIL.") +(defvar *suppress-compiler-notes* nil) ; Deprecated +(defvar *suppress-compiler-warnings* nil) ; Deprecated (defvar *compiler-break-enable* nil) diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index b58ce25f9..965861f9d 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -302,8 +302,16 @@ filesystem or in the database of ASDF modules." (epilogue-code (when (eq target :program) '(SI::TOP-LEVEL))) #+:win32 (system :console) &aux - (*suppress-compiler-notes* (or *suppress-compiler-notes* (not *compile-verbose*))) - (*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not *compile-verbose*)))) + (*suppress-compiler-messages* (or *suppress-compiler-messages* + (not *compile-verbose*)))) + ;; Deprecated, to be removed in next release + (when *suppress-compiler-notes* + (setf *suppress-compiler-messages* + `(or ,*suppress-compiler-messages* compiler-note))) + (when *suppress-compiler-warnings* + (setf *suppress-compiler-messages* + `(or ,*suppress-compiler-messages* compiler-warning))) + ;; ;; The epilogue-code can be either a string made of C code, or a ;; lisp form. In the latter case we add some additional C code to @@ -458,8 +466,8 @@ static cl_object VV[VM]; (defun compile-file (input-pathname &key - (verbose *compile-verbose*) - (print *compile-print*) + ((:verbose *compile-verbose*) *compile-verbose*) + ((:print *compile-print*) *compile-print*) (c-file nil) (h-file nil) (data-file nil) @@ -474,12 +482,19 @@ static cl_object VV[VM]; (*print-pretty* nil) (*compile-file-pathname* nil) (*compile-file-truename* nil) - (*compile-verbose* verbose) - (*suppress-compiler-notes* (or *suppress-compiler-notes* (not verbose))) - (*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not verbose))) + (*suppress-compiler-messages* + (or *suppress-compiler-messages* (not *compile-verbose*))) init-name) (declare (notinline compiler-cc)) + ;; Deprecated, to be removed in next release + (when *suppress-compiler-notes* + (setf *suppress-compiler-messages* + `(or ,*suppress-compiler-messages* compiler-note))) + (when *suppress-compiler-warnings* + (setf *suppress-compiler-messages* + `(or ,*suppress-compiler-messages* compiler-warning))) + #-dlopen (unless system-p (format t "~%;;;~ @@ -500,8 +515,6 @@ static cl_object VV[VM]; (when (eq output-file 'T) (setf output-file *compile-file-truename*)) - (setf output-file (compile-file-pathname output-file :type (if system-p :object :fasl))) - (when (and system-p load) (error "Cannot load system files.")) @@ -510,11 +523,8 @@ static cl_object VV[VM]; (let* ((eof '(NIL)) (*compiler-in-use* *compiler-in-use*) (*load-time-values* nil) ;; Load time values are compiled - (o-pathname (or #+dlopen (and system-p output-file) - #-dlopen output-file - (compile-file-pathname (or output-file input-pathname) :type :object))) - #+dlopen - (so-pathname (unless system-p output-file)) + (o-pathname (compile-file-pathname output-file :type :object)) + (so-pathname (compile-file-pathname output-file :type :fasl)) (c-pathname (get-output-pathname o-pathname c-file :c)) (h-pathname (get-output-pathname o-pathname h-file :h)) (data-pathname (get-output-pathname o-pathname data-file :data)) @@ -524,6 +534,8 @@ static cl_object VV[VM]; (with-compiler-env (compiler-conditions) + (setf output-file (if system-p o-pathname so-pathname)) + (print-compiler-info) (when (probe-file "./cmpinit.lsp") @@ -562,12 +574,13 @@ static cl_object VV[VM]; (unless system-p (bundle-cc (si::coerce-to-filename so-pathname) init-name (si::coerce-to-filename o-pathname))) - (unless (if system-p - (probe-file o-pathname) - (probe-file so-pathname)) + (unless (setf output-file (probe-file output-file)) (cmperr "The C compiler failed to compile the intermediate file."))) (cmpprogress "~&;;; Finished compiling ~a.~%" (namestring input-pathname)) - + + (when (and load output-file (not system-p)) + (load output-file :verbose *compile-verbose*)) + ) ; with-compiler-env (unless c-file (cmp-delete-file c-pathname)) @@ -576,9 +589,7 @@ static cl_object VV[VM]; (cmp-delete-file data-pathname)) #+dlopen (unless system-p (cmp-delete-file o-pathname)) - (compiler-output-values (truename #+dlopen (if system-p o-pathname so-pathname) - #-dlopen o-pathname) - compiler-conditions))) + (compiler-output-values output-file compiler-conditions))) (defun compiler-output-values (main-value conditions) (loop for i in conditions @@ -603,8 +614,8 @@ static cl_object VV[VM]; #+dlopen (defun compile (name &optional (def nil supplied-p) &aux form data-pathname - (*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not *compile-verbose*))) - (*suppress-compiler-notes* (or *suppress-compiler-notes* (not *compile-verbose*))) + (*suppress-compiler-messages* (or *suppress-compiler-messages* + (not *compile-verbose*))) (*compiler-in-use* *compiler-in-use*) (*standard-output* *standard-output*) (*error-output* *error-output*) @@ -615,6 +626,14 @@ static cl_object VV[VM]; (unless (symbolp name) (error "~s is not a symbol." name)) + ;; Deprecated, to be removed in next release + (when *suppress-compiler-notes* + (setf *suppress-compiler-messages* + `(or ,*suppress-compiler-messages* compiler-note))) + (when *suppress-compiler-warnings* + (setf *suppress-compiler-messages* + `(or ,*suppress-compiler-messages* compiler-warning))) + (cond ((and supplied-p def) (when (functionp def) (unless (function-lambda-expression def) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index fe0a0eb44..e0382588e 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -27,8 +27,7 @@ (catch *cmperr-tag* (when (consp form) (let ((fun (car form)) (args (cdr form)) fd) - (when (and *compile-print* - (member fun *toplevel-forms-to-print*)) + (when (member fun *toplevel-forms-to-print*) (print-current-form)) (cond ((consp fun) (t1ordinary form)) @@ -525,7 +524,7 @@ (lambda-list (c1form-arg 0 lambda-expr)) (requireds (car lambda-list))) (declare (fixnum level nenvs)) - (when *compile-print* (print-emitting fun)) + (print-emitting fun) (wt-comment (cond ((fun-global fun) "function definition for ") ((eq (fun-closure fun) 'CLOSURE) "closure ") (t "local function ")) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 37f958c79..068e233d0 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -56,16 +56,13 @@ (slot-value condition 'variable))))) (defun print-compiler-message (c stream) - (format stream "~&~@<;;; ~@;~A~:>" c)) + (unless (typep c *suppress-compiler-messages*) + (format stream "~&~@<;;; ~@;~A~:>" c))) (defun handle-note (c) nil) -(defun handle-warning (c) - (push c *compiler-conditions*) - nil) - -(defun handle-error (c) +(defun handle-warning/error (c) (push c *compiler-conditions*) nil) @@ -103,8 +100,8 @@ (declare (special *compiler-conditions*)) (restart-case (handler-bind ((compiler-note #'handle-note) - (warning #'handle-warning) - (compiler-error #'handle-error)) + (warning #'handle-warning/error) + (compiler-error #'handle-warning/error)) (handler-bind ((error #'handle-internal-error)) (if *compiler-in-use* (error "The compiler was called recursively.") @@ -165,43 +162,36 @@ lower-bound n)) -(defun do-cmpwarn (suppress &rest args) +(defun do-cmpwarn (&rest args) (declare (si::c-local)) (let ((condition (apply #'make-condition args))) (restart-case (signal condition) (muffle-warning () :REPORT "Skip warning" (return-from do-cmpwarn nil))) - (unless suppress - (print-compiler-message condition t)))) + (print-compiler-message condition t))) (defun cmpwarn (string &rest args) - (do-cmpwarn *suppress-compiler-warnings* 'compiler-warning - :format-control string - :format-arguments args)) + (do-cmpwarn 'compiler-warning :format-control string :format-arguments args)) (defun cmpnote (string &rest args) - (do-cmpwarn *suppress-compiler-notes* 'compiler-note - :format-control string - :format-arguments args)) + (do-cmpwarn 'compiler-note :format-control string :format-arguments args)) (defun print-current-form () - (when *compile-verbose* + (when *compile-print* (let ((*print-length* 2) (*print-level* 2)) (format t "~&;;; Compiling ~s.~%" *current-form*))) nil) (defun print-emitting (f) - (let* ((name (fun-name f))) - (unless name - (setf name (fun-description f))) - (when (and name *compile-verbose*) - (format t "~&;;; Emitting code for ~s.~%" name)))) + (when *compile-print* + (let* ((name (or (fun-name f) (fun-description f)))) + (when name + (format t "~&;;; Emitting code for ~s.~%" name))))) (defun undefined-variable (sym) - (do-cmpwarn *suppress-compiler-warnings* - 'compiler-undefined-variable :name sym)) + (do-cmpwarn 'compiler-undefined-variable :name sym)) (defun baboon (&aux (*print-case* :upcase)) (signal 'compiler-internal-error