(declaim (special *constants* *free-vars* *component-being-compiled*
*code-vector* *next-location* *result-fixups*
*free-funs* *source-paths*
- *seen-blocks* *seen-funs* *list-conflicts-table*
*continuation-number* *continuation-numbers*
*number-continuations* *tn-id* *tn-ids* *id-tns*
*label-ids* *label-id* *id-labels*
(*compiler-note-count* 0)
(*undefined-warnings* nil)
(*in-compilation-unit* t))
- (with-world-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))))))))))
+ (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)))))))))
(if policy
(let ((*policy* (process-optimize-decl policy (unless override *policy*)))
(*policy-restrictions* (unless override *policy-restrictions*)))
;;; WARNINGS-P and FAILURE-P are as in CL:COMPILE or CL:COMPILE-FILE.
;;; This also wraps up WITH-IR1-NAMESPACE functionality.
(defmacro with-compilation-values (&body body)
- `(with-ir1-namespace
- (let ((*warnings-p* nil)
- (*failure-p* nil))
- (values (progn ,@body)
- *warnings-p*
- *failure-p*))))
+ `(let ((*continuation-number* 0)
+ (*continuation-numbers* (make-hash-table :test 'eq))
+ (*number-continuations* (make-hash-table :test 'eql))
+ (*tn-id* 0)
+ (*tn-ids* (make-hash-table :test 'eq))
+ (*id-tns* (make-hash-table :test 'eql))
+ (*label-id* 0)
+ (*label-ids* (make-hash-table :test 'eq))
+ (*id-labels* (make-hash-table :test 'eql)))
+ (unwind-protect
+ (with-ir1-namespace
+ (let ((*warnings-p* nil)
+ (*failure-p* nil))
+ (values (progn ,@body)
+ *warnings-p*
+ *failure-p*)))
+ (clrhash *tn-ids*)
+ (clrhash *id-tns*)
+ (clrhash *continuation-numbers*)
+ (clrhash *number-continuations*)
+ (clrhash *label-ids*)
+ (clrhash *id-labels*))))
\f
;;;; component compilation
(blast *free-funs*)
(blast *constants*))
(values))
-
-;;; Clear global variables used by the compiler.
-;;;
-;;; FIXME: It seems kinda nasty and unmaintainable to have to do this,
-;;; and it adds overhead even when people aren't using the compiler.
-;;; Perhaps we could make these global vars unbound except when
-;;; actually in use, so that this function could go away.
-(defun clear-stuff (&optional (debug-too t))
-
- ;; Clear global tables.
- (when (boundp '*free-funs*)
- (clrhash *free-funs*)
- (clrhash *free-vars*)
- (clrhash *constants*))
-
- ;; Clear debug counters and tables.
- (clrhash *seen-blocks*)
- (clrhash *seen-funs*)
- (clrhash *list-conflicts-table*)
-
- (when debug-too
- (clrhash *continuation-numbers*)
- (clrhash *number-continuations*)
- (setq *continuation-number* 0)
- (clrhash *tn-ids*)
- (clrhash *id-tns*)
- (setq *tn-id* 0)
- (clrhash *label-ids*)
- (clrhash *id-labels*)
- (setq *label-id* 0))
-
- ;; (Note: The CMU CL code used to set CL::*GENSYM-COUNTER* to zero here.
- ;; Superficially, this seemed harmful -- the user could reasonably be
- ;; surprised if *GENSYM-COUNTER* turned back to zero when something was
- ;; compiled. A closer inspection showed that this actually turned out to be
- ;; harmless in practice, because CLEAR-STUFF was only called from within
- ;; forms which bound CL::*GENSYM-COUNTER* to zero. However, this means that
- ;; even though zeroing CL::*GENSYM-COUNTER* here turned out to be harmless in
- ;; practice, it was also useless in practice. So we don't do it any more.)
-
- (values))
\f
;;;; trace output
(when (core-object-p *compile-object*)
(fix-core-source-info *source-info* *compile-object* result))
- (mapc #'clear-ir1-info components-from-dfo)
- (clear-stuff)))))))
+ (mapc #'clear-ir1-info components-from-dfo)))))))
(defun process-toplevel-cold-fset (name lambda-expression path)
(unless (producing-fasl-file)
(compile-load-time-value-lambda lambdas)
(compile-toplevel-lambdas lambdas))
- (mapc #'clear-ir1-info components)
- (clear-stuff)))
+ (mapc #'clear-ir1-info components)))
(values))
;;; Actually compile any stuff that has been queued up for block
(handler-case
(handler-bind (((satisfies handle-condition-p) #'handle-condition-handler))
(with-compilation-values
- (sb!xc:with-compilation-unit ()
- (clear-stuff)
-
+ (sb!xc:with-compilation-unit ()
+ (with-world-lock ()
(sub-sub-compile-file info)
-
(unless (zerop (hash-table-count *code-coverage-records*))
;; Dump the code coverage records into the fasl.
(fopcompile `(record-code-coverage
',(namestring *compile-file-pathname*)
',(let (list)
- (maphash (lambda (k v)
- (declare (ignore k))
- (push v list))
- *code-coverage-records*)
- list))
+ (maphash (lambda (k v)
+ (declare (ignore k))
+ (push v list))
+ *code-coverage-records*)
+ list))
nil
nil))
-
(finish-block-compilation)
(let ((object *compile-object*))
(etypecase object
(fasl-output (fasl-dump-source-info info object))
(core-object (fix-core-source-info info object))
(null)))
- nil)))
+ nil))))
;; Some errors are sufficiently bewildering that we just fail
;; immediately, without trying to recover and compile more of
;; the input file.