Index: lib/nfcomp.lisp =================================================================== --- lib/nfcomp.lisp (revision 14310) +++ lib/nfcomp.lisp (working copy) @@ -198,65 +198,89 @@ output-file (pathname-type (backend-target-fasl-pathname *target-backend*)))) - (let* ((*features* (append (if (listp features) features (list features)) (setup-target-features target-backend *features*))) - (*fasl-deferred-warnings* nil) ; !!! WITH-COMPILATION-UNIT ... - (*fasl-save-local-symbols* save-local-symbols) - (*save-source-locations* save-source-locations) - (*fasl-save-doc-strings* save-doc-strings) - (*fasl-save-definitions* save-definitions) - (*fasl-break-on-program-errors* break-on-program-errors) - (*fcomp-warnings-header* nil) - (*compile-file-pathname* orig-src) - (*compile-file-truename* (truename src)) - (*package* *package*) - (*readtable* *readtable*) - (*compile-print* print) - (*compile-verbose* verbose) - (*fasl-target* (backend-name target-backend)) - (*fasl-backend* target-backend) - (*fasl-target-big-endian* (arch::target-big-endian - (backend-target-arch target-backend))) - (*target-ftd* (backend-target-foreign-type-data target-backend)) - (defenv (new-definition-environment)) - (lexenv (new-lexical-environment defenv)) - (*fasl-compile-time-env* (new-lexical-environment (new-definition-environment))) - (*fcomp-external-format* external-format) - (forms nil)) - (let ((current *outstanding-deferred-warnings*) last) - (when (and current - (setq last (deferred-warnings.last-file current)) - (equalp *compile-file-pathname* (cdr last))) - ;; Discard previous deferred warnings when recompiling exactly the same file again, - ;; since most likely this is due to an interactive "retry compilation" request and - ;; we want to avoid duplicate warnings. - (setf (deferred-warnings.last-file current) nil))) + (let* ((new-features '())) + (unwind-protect + (let* ((*features* (append (if (listp features) + features + (list features)) + (setup-target-features target-backend *features*))) + (initial-features *features*) + (*fasl-deferred-warnings* nil) ; !!! WITH-COMPILATION-UNIT ... + (*fasl-save-local-symbols* save-local-symbols) + (*save-source-locations* save-source-locations) + (*fasl-save-doc-strings* save-doc-strings) + (*fasl-save-definitions* save-definitions) + (*fasl-break-on-program-errors* break-on-program-errors) + (*fcomp-warnings-header* nil) + (*compile-file-pathname* orig-src) + (*compile-file-truename* (truename src)) + (*package* *package*) + (*readtable* *readtable*) + (*compile-print* print) + (*compile-verbose* verbose) + (*fasl-target* (backend-name target-backend)) + (*fasl-backend* target-backend) + (*fasl-target-big-endian* (arch::target-big-endian + (backend-target-arch target-backend))) + (*target-ftd* (backend-target-foreign-type-data target-backend)) + (defenv (new-definition-environment)) + (lexenv (new-lexical-environment defenv)) + (*fasl-compile-time-env* (new-lexical-environment + (new-definition-environment))) + (*fcomp-external-format* external-format) + (forms nil)) + (unwind-protect + (progn + (let ((current *outstanding-deferred-warnings*) last) + (when (and current + (setq last (deferred-warnings.last-file current)) + (equalp *compile-file-pathname* (cdr last))) + ;; Discard previous deferred warnings when recompiling + ;; exactly the same file again, since most likely this is + ;; due to an interactive "retry compilation" request and we + ;; want to avoid duplicate warnings. + (setf (deferred-warnings.last-file current) nil))) + + (let* ((*outstanding-deferred-warnings* (%defer-warnings nil))) + (rplacd (defenv.type defenv) *outstanding-deferred-warnings*) + (setf (defenv.defined defenv) + (deferred-warnings.defs *outstanding-deferred-warnings*)) + + (setq forms (fcomp-file src + (or compile-file-original-truename + (namestring orig-src)) + compile-file-original-buffer-offset + lexenv)) + + (setf (deferred-warnings.warnings *outstanding-deferred-warnings*) + (append *fasl-deferred-warnings* + (deferred-warnings.warnings + *outstanding-deferred-warnings*))) + (when *compile-verbose* (fresh-line)) + (multiple-value-bind (any harsh) + (report-deferred-warnings *compile-file-pathname*) + (setq *fasl-warnings-signalled-p* (or *fasl-warnings-signalled-p* any) + *fasl-non-style-warnings-signalled-p* + (if (eq harsh :very) :very + (or *fasl-non-style-warnings-signalled-p* harsh))))) + (when (and *fasl-break-on-program-errors* + (eq *fasl-non-style-warnings-signalled-p* :very)) + (cerror "create the output file despite the errors" + "Serious errors encountered during compilation of ~s" + src)) + (fasl-scan-forms-and-dump-file forms output-file lexenv) + (values output-file + (truename (pathname output-file)) + *fasl-warnings-signalled-p* + (and *fasl-non-style-warnings-signalled-p* t))) + ;; Record features added + (setf new-features (set-difference *features* initial-features)))) + ;; Put new features onto *features* + (when (not (null new-features)) + (setf *features* (append new-features *features*))))))) + + - (let* ((*outstanding-deferred-warnings* (%defer-warnings nil))) - (rplacd (defenv.type defenv) *outstanding-deferred-warnings*) - (setf (defenv.defined defenv) (deferred-warnings.defs *outstanding-deferred-warnings*)) - - (setq forms (fcomp-file src - (or compile-file-original-truename (namestring orig-src)) - compile-file-original-buffer-offset - lexenv)) - - (setf (deferred-warnings.warnings *outstanding-deferred-warnings*) - (append *fasl-deferred-warnings* (deferred-warnings.warnings *outstanding-deferred-warnings*))) - (when *compile-verbose* (fresh-line)) - (multiple-value-bind (any harsh) (report-deferred-warnings *compile-file-pathname*) - (setq *fasl-warnings-signalled-p* (or *fasl-warnings-signalled-p* any) - *fasl-non-style-warnings-signalled-p* (if (eq harsh :very) :very - (or *fasl-non-style-warnings-signalled-p* harsh))))) - (when (and *fasl-break-on-program-errors* (eq *fasl-non-style-warnings-signalled-p* :very)) - (cerror "create the output file despite the errors" - "Serious errors encountered during compilation of ~s" - src)) - (fasl-scan-forms-and-dump-file forms output-file lexenv) - (values output-file - (truename (pathname output-file)) - *fasl-warnings-signalled-p* - (and *fasl-non-style-warnings-signalled-p* t))))) - (defvar *fcomp-locked-hash-tables*) (defvar *fcomp-load-forms-environment* nil)