X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=c3afdc717d064dcfb0dbf3e57d5f4721865bb1fc;hb=ebc0f0ebf9efd39519ab86ba28c33abdb25443e0;hp=c7d814cbe75b3342b44e8a2e24cca19734560459;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index c7d814c..c3afdc7 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -28,7 +28,8 @@ #!+sb-show *compiler-trace-output* *last-source-context* *last-original-source* *last-source-form* *last-format-string* *last-format-args* - *last-message-count* *lexenv* *fun-names-in-this-file* + *last-message-count* *last-error-context* + *lexenv* *fun-names-in-this-file* *allow-instrumenting*)) ;;; Whether call of a function which cannot be defined causes a full @@ -114,6 +115,8 @@ (defvar *compile-object* nil) (declaim (type object *compile-object*)) + +(defvar *fopcompile-label-counter*) ;;;; WITH-COMPILATION-UNIT and WITH-COMPILATION-VALUES @@ -742,7 +745,7 @@ ;;; Given a pathname, return a SOURCE-INFO structure. (defun make-file-source-info (file external-format) (let ((file-info (make-file-info :name (truename file) - :untruename file + :untruename (merge-pathnames file) :external-format external-format :write-date (file-write-date file)))) @@ -851,16 +854,19 @@ ;;; *TOPLEVEL-LAMBDAS* instead. (defun convert-and-maybe-compile (form path) (declare (list path)) - (let* ((*top-level-form-noted* (note-top-level-form form t)) - (*lexenv* (make-lexenv - :policy *policy* - :handled-conditions *handled-conditions* - :disabled-package-locks *disabled-package-locks*)) - (tll (ir1-toplevel form path nil))) - (if (eq *block-compile* t) - (push tll *toplevel-lambdas*) - (compile-toplevel (list tll) nil)) - nil)) + (if (fopcompilable-p form) + (let ((*fopcompile-label-counter* 0)) + (fopcompile form path nil)) + (let* ((*top-level-form-noted* (note-top-level-form form t)) + (*lexenv* (make-lexenv + :policy *policy* + :handled-conditions *handled-conditions* + :disabled-package-locks *disabled-package-locks*)) + (tll (ir1-toplevel form path nil))) + (if (eq *block-compile* t) + (push tll *toplevel-lambdas*) + (compile-toplevel (list tll) nil)) + nil))) ;;; Macroexpand FORM in the current environment with an error handler. ;;; We only expand one level, so that we retain all the intervening @@ -1184,7 +1190,9 @@ ;; sequence of steps in ANSI's "3.2.3.1 Processing of ;; Top Level Forms". #-sb-xc-host - (let ((expanded (preprocessor-macroexpand-1 form))) + (let ((expanded + (let ((*current-path* path)) + (preprocessor-macroexpand-1 form)))) (cond ((eq expanded form) (when compile-time-too (eval-in-lexenv form *lexenv*))