#!+sb-show *compiler-trace-output*
*last-source-context* *last-original-source*
*last-source-form* *last-format-string* *last-format-args*
- *last-message-count* *lexenv*))
+ *last-message-count* *lexenv* *fun-names-in-this-file*))
+
+;;; Whether call of a function which cannot be defined causes a full
+;;; warning.
+(defvar *flame-on-necessarily-undefined-function* nil)
(defvar *check-consistency* nil)
(defvar *all-components*)
;;; normally causes nested uses to be no-ops).
(defvar *in-compilation-unit* nil)
+;;; This lock is siezed in the same situation: the compiler is not
+;;; presently thread-safe
+(defvar *big-compiler-lock*
+ (sb!thread:make-mutex :name "big compiler lock"))
+
;;; Count of the number of compilation units dynamically enclosed by
;;; the current active WITH-COMPILATION-UNIT that were unwound out of.
(defvar *aborted-compilation-unit-count*)
;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is
;; ordinarily (unless OVERRIDE) basically a no-op.
(unwind-protect
- (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
+ (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
(unless succeeded-p
(incf *aborted-compilation-unit-count*)))
- ;; FIXME: Now *COMPILER-FOO-COUNT* stuff is bound in more than
- ;; one place. If we can get rid of the IR1 interpreter, this
- ;; should be easier to clean up.
(let ((*aborted-compilation-unit-count* 0)
(*compiler-error-count* 0)
(*compiler-warning-count* 0)
(*compiler-note-count* 0)
(*undefined-warnings* nil)
(*in-compilation-unit* t))
- (handler-bind ((parse-unknown-type
- (lambda (c)
- (note-undefined-reference
- (parse-unknown-type-specifier c)
- :type))))
- (unwind-protect
- (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
- (unless succeeded-p
- (incf *aborted-compilation-unit-count*))
- (summarize-compilation-unit (not succeeded-p))))))))
+ (sb!thread:with-recursive-lock (*big-compiler-lock*)
+ (handler-bind ((parse-unknown-type
+ (lambda (c)
+ (note-undefined-reference
+ (parse-unknown-type-specifier c)
+ :type))))
+ (unwind-protect
+ (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
+ (unless succeeded-p
+ (incf *aborted-compilation-unit-count*))
+ (summarize-compilation-unit (not succeeded-p)))))))))
+
+;;; Is FUN-NAME something that no conforming program can rely on
+;;; defining as a function?
+(defun fun-name-reserved-by-ansi-p (fun-name)
+ (eq (symbol-package (fun-name-block-name fun-name))
+ *cl-package*))
;;; This is to be called at the end of a compilation unit. It signals
;;; any residual warnings about unknown stuff, then prints the total
(warnings (undefined-warning-warnings undef))
(undefined-warning-count (undefined-warning-count undef)))
(dolist (*compiler-error-context* warnings)
- (compiler-style-warn "undefined ~(~A~): ~S" kind name))
+ (if #-sb-xc-host (and (eq kind :function)
+ (fun-name-reserved-by-ansi-p name)
+ *flame-on-necessarily-undefined-function*)
+ #+sb-xc-host nil
+ (case name
+ ((declare)
+ (compiler-warn
+ "~@<There is no function named ~S. References to ~S in ~
+ some contexts (like starts of blocks) have special ~
+ meaning, but here it would have to be a function, ~
+ and that shouldn't be right.~:@>"
+ name name))
+ (t
+ (compiler-warn
+ "~@<The ~(~A~) ~S is undefined, and its name is ~
+ reserved by ANSI CL so that even if it it were ~
+ defined later, the code doing so would not be ~
+ portable.~:@>"
+ kind name)))
+ (compiler-style-warn "undefined ~(~A~): ~S" kind name)))
(let ((warn-count (length warnings)))
(when (and warnings (> undefined-warning-count warn-count))
(let ((more (- undefined-warning-count warn-count)))
(compiler-style-warn
"~W more use~:P of undefined ~(~A~) ~S"
more kind name))))))
-
+
(dolist (kind '(:variable :function :type))
(let ((summary (mapcar #'undefined-warning-name
(remove kind undefs :test-not #'eq
(multiple-value-bind (code-length trace-table fixups)
(generate-code component)
+ #-sb-xc-host
(when *compiler-trace-output*
(format *compiler-trace-output*
"~|~%disassembly of code for ~S~2%" component)
(defun describe-component (component *standard-output*)
(declare (type component component))
(format t "~|~%;;;; component: ~S~2%" (component-name component))
- (print-blocks component)
+ (print-all-blocks component)
(values))
(defun describe-ir2-component (component *standard-output*)
;;; We parse declarations and then recursively process the body.
(defun process-toplevel-locally (body path compile-time-too &key vars funs)
(declare (list path))
- (multiple-value-bind (forms decls) (parse-body body nil)
- (let* ((*lexenv*
- (process-decls decls vars funs (make-continuation)))
+ (multiple-value-bind (forms decls)
+ (parse-body body :doc-string-allowed nil :toplevel t)
+ (let* ((*lexenv* (process-decls decls vars funs))
+ ;; FIXME: VALUES declaration
+ ;;
;; Binding *POLICY* is pretty much of a hack, since it
;; causes LOCALLY to "capture" enclosed proclamations. It
;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the
(etypecase f
(clambda (list (lambda-component f)))
(optional-dispatch (let ((result nil))
- (labels ((frob (clambda)
- (pushnew (lambda-component clambda)
- result))
- (maybe-frob (maybe-clambda)
- (when maybe-clambda
- (frob maybe-clambda))))
- (mapc #'frob (optional-dispatch-entry-points f))
+ (flet ((maybe-frob (maybe-clambda)
+ (when (and maybe-clambda
+ (promise-ready-p maybe-clambda))
+ (pushnew (lambda-component
+ (force maybe-clambda))
+ result))))
+ (map nil #'maybe-frob (optional-dispatch-entry-points f))
(maybe-frob (optional-dispatch-more-entry f))
- (maybe-frob (optional-dispatch-main-entry f)))))))
+ (maybe-frob (optional-dispatch-main-entry f)))
+ result))))
(defun make-functional-from-toplevel-lambda (definition
&key
(declare (ignore funs))
(process-toplevel-locally body
path
- compile-time-too))))
+ compile-time-too))
+ :compile))
((symbol-macrolet)
(funcall-in-symbol-macrolet-lexenv
magic
(process-toplevel-locally body
path
compile-time-too
- :vars vars)))))))
+ :vars vars))
+ :compile)))))
((locally)
(process-toplevel-locally (rest form) path compile-time-too))
((progn)
(sb!xc:*compile-file-pathname* nil)
(sb!xc:*compile-file-truename* nil)
(*toplevel-lambdas* ())
+ (*fun-names-in-this-file* ())
(*compiler-error-bailout*
(lambda ()
(compiler-mumble "~2&; fatal error, aborting compilation~%")
(input-pathname (verify-source-file input-file))
(source-info (make-file-source-info input-pathname))
(*compiler-trace-output* nil)) ; might be modified below
-
+
(unwind-protect
(progn
(when output-file
projects / sbcl.git / blobdiff