X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=0d6bebd8d8dfece62cd700c90b7b5f28cedc4930;hb=05525d3a5906d7a89fcb689c26177732493c40ce;hp=88b04884437484c647b69305ef2eea94255627c1;hpb=f399a6fcad06989b7cb70c00fc7a4a4850a22ab8;p=sbcl.git diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 88b0488..0d6bebd 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -30,6 +30,10 @@ *last-source-form* *last-format-string* *last-format-args* *last-message-count* *lexenv*)) +;;; 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*) @@ -87,6 +91,11 @@ ;;; 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*) @@ -121,12 +130,13 @@ `(%with-compilation-unit (lambda () ,@body) ,@options)) (defun %with-compilation-unit (fn &key override) + (declare (type function fn)) (let ((succeeded-p nil)) (if (and *in-compilation-unit* (not override)) ;; 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 @@ -139,16 +149,17 @@ (*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))))))))) ;;; This is to be called at the end of a compilation unit. It signals ;;; any residual warnings about unknown stuff, then prints the total @@ -172,14 +183,20 @@ (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) + (symbolp name) ; FIXME: (SETF CL:fo) + (eq (symbol-package name) *cl-package*) + *flame-on-necessarily-undefined-function*) + #+sb-xc-host nil + (compiler-warn "undefined ~(~A~): ~S" 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 @@ -799,11 +816,11 @@ ;;; Process a top level use of LOCALLY, or anything else (e.g. ;;; MACROLET) at top level which has declarations and ordinary forms. ;;; We parse declarations and then recursively process the body. -(defun process-toplevel-locally (body path compile-time-too) +(defun process-toplevel-locally (body path compile-time-too &key vars funs) (declare (list path)) - (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) + (multiple-value-bind (forms decls) (parse-body body nil) (let* ((*lexenv* - (process-decls decls nil nil (make-continuation))) + (process-decls decls vars funs (make-continuation))) ;; 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 @@ -870,14 +887,20 @@ (setf (component-name component) (debug-namify "~S initial component" name)) (setf (component-kind component) :initial) - (let* ((locall-fun (ir1-convert-lambda - definition - :debug-name (debug-namify "top level local call ~S" - name))) + (let* ((locall-fun (ir1-convert-lambdalike + definition + :debug-name (debug-namify "top level local call ~S" + name) + ;; KLUDGE: we do this so that we get to have + ;; nice debug returnness in functions defined + ;; from the REPL + :allow-debug-catch-tag t)) (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun) :source-name (or name '.anonymous.) :debug-name (unless name "top level form")))) + (when name + (assert-global-function-definition-type name locall-fun)) (setf (functional-entry-fun fun) locall-fun (functional-kind fun) :external (functional-has-external-references-p fun) t) @@ -903,8 +926,8 @@ ;; nice default for things where we don't have a ;; real source path (as in e.g. inside CL:COMPILE). '(original-source-start 0 0))) - (unless (or (null name) (legal-fun-name-p name)) - (error "not a legal function name: ~S" name)) + (when name + (legal-fun-name-or-type-error name)) (let* ((*lexenv* (make-lexenv :policy *policy*)) (fun (make-functional-from-toplevel-lambda lambda-expression :name name @@ -935,47 +958,59 @@ (compile-component component-from-dfo) (replace-toplevel-xeps component-from-dfo))) - (prog1 - (let ((entry-table (etypecase *compile-object* - (fasl-output (fasl-output-entry-table - *compile-object*)) - (core-object (core-object-entry-table - *compile-object*))))) - (multiple-value-bind (result found-p) - (gethash (leaf-info fun) entry-table) - (aver found-p) - result)) - ;; KLUDGE: This code duplicates some other code in this - ;; file. In the great reorganzation, the flow of program logic - ;; changed from the original CMUCL model, and that path (as of - ;; sbcl-0.7.5 in SUB-COMPILE-FILE) was no longer followed for - ;; CORE-OBJECTS, leading to BUG 156. This place is - ;; transparently not the right one for this code, but I don't - ;; have a clear enough overview of the compiler to know how to - ;; rearrange it all so that this operation fits in nicely, and - ;; it was blocking reimplementation of - ;; (DECLAIM (INLINE FOO)) (MACROLET ((..)) (DEFUN FOO ...)) - ;; - ;; FIXME: This KLUDGE doesn't solve all the problem in an - ;; ideal way, as (1) definitions typed in at the REPL without - ;; an INLINE declaration will give a NULL - ;; FUNCTION-LAMBDA-EXPRESSION (allowable, but not ideal) and - ;; (2) INLINE declarations will yield a - ;; FUNCTION-LAMBDA-EXPRESSION headed by - ;; SB-C:LAMBDA-WITH-LEXENV, even for null LEXENV. - ;; - ;; CSR, 2002-07-02 - (when (core-object-p *compile-object*) - (fix-core-source-info *source-info* *compile-object*)) - - (mapc #'clear-ir1-info components-from-dfo) - (clear-stuff))))) + (let ((entry-table (etypecase *compile-object* + (fasl-output (fasl-output-entry-table + *compile-object*)) + (core-object (core-object-entry-table + *compile-object*))))) + (multiple-value-bind (result found-p) + (gethash (leaf-info fun) entry-table) + (aver found-p) + (prog1 + result + ;; KLUDGE: This code duplicates some other code in this + ;; file. In the great reorganzation, the flow of program + ;; logic changed from the original CMUCL model, and that + ;; path (as of sbcl-0.7.5 in SUB-COMPILE-FILE) was no + ;; longer followed for CORE-OBJECTS, leading to BUG + ;; 156. This place is transparently not the right one for + ;; this code, but I don't have a clear enough overview of + ;; the compiler to know how to rearrange it all so that + ;; this operation fits in nicely, and it was blocking + ;; reimplementation of (DECLAIM (INLINE FOO)) (MACROLET + ;; ((..)) (DEFUN FOO ...)) + ;; + ;; FIXME: This KLUDGE doesn't solve all the problem in an + ;; ideal way, as (1) definitions typed in at the REPL + ;; without an INLINE declaration will give a NULL + ;; FUNCTION-LAMBDA-EXPRESSION (allowable, but not ideal) + ;; and (2) INLINE declarations will yield a + ;; FUNCTION-LAMBDA-EXPRESSION headed by + ;; SB-C:LAMBDA-WITH-LEXENV, even for null LEXENV. -- CSR, + ;; 2002-07-02 + ;; + ;; (2) is probably fairly easy to fix -- it is, after all, + ;; a matter of list manipulation (or possibly of teaching + ;; CL:FUNCTION about SB-C:LAMBDA-WITH-LEXENV). (1) is + ;; significantly harder, as the association between + ;; function object and source is a tricky one. + ;; + ;; FUNCTION-LAMBDA-EXPRESSION "works" (i.e. returns a + ;; non-NULL list) when the function in question has been + ;; compiled by (COMPILE '(LAMBDA ...)); it does not + ;; work when it has been compiled as part of the top-level + ;; EVAL strategy of compiling everything inside (LAMBDA () + ;; ...). -- CSR, 2002-11-02 + (when (core-object-p *compile-object*) + (fix-core-source-info *source-info* *compile-object* result)) + + (mapc #'clear-ir1-info components-from-dfo) + (clear-stuff))))))) (defun process-toplevel-cold-fset (name lambda-expression path) (unless (producing-fasl-file) (error "can't COLD-FSET except in a fasl file")) - (unless (legal-fun-name-p name) - (error "not a legal function name: ~S" name)) + (legal-fun-name-or-type-error name) (fasl-dump-cold-fset name (%compile lambda-expression *compile-object* @@ -1006,125 +1041,134 @@ path) (throw 'process-toplevel-form-error-abort nil)))) - (if (atom form) - ;; (There are no EVAL-WHEN issues in the ATOM case until - ;; SBCL gets smart enough to handle global - ;; DEFINE-SYMBOL-MACRO.) - (convert-and-maybe-compile form path) - (flet ((need-at-least-one-arg (form) - (unless (cdr form) - (compiler-error "~S form is too short: ~S" - (car form) - form)))) - (case (car form) - ;; In the cross-compiler, top level COLD-FSET arranges - ;; for static linking at cold init time. - #+sb-xc-host - ((cold-fset) - (aver (not compile-time-too)) - (destructuring-bind (cold-fset fun-name lambda-expression) form - (declare (ignore cold-fset)) - (process-toplevel-cold-fset fun-name - lambda-expression - path))) - ((eval-when macrolet symbol-macrolet);things w/ 1 arg before body - (need-at-least-one-arg form) - (destructuring-bind (special-operator magic &rest body) form - (ecase special-operator - ((eval-when) - ;; CT, LT, and E here are as in Figure 3-7 of ANSI - ;; "3.2.3.1 Processing of Top Level Forms". - (multiple-value-bind (ct lt e) - (parse-eval-when-situations magic) - (let ((new-compile-time-too (or ct - (and compile-time-too - e)))) - (cond (lt (process-toplevel-progn - body path new-compile-time-too)) - (new-compile-time-too (eval - `(progn ,@body))))))) - ((macrolet) - (funcall-in-macrolet-lexenv - magic - (lambda () - (process-toplevel-locally body - path - compile-time-too)))) - ((symbol-macrolet) - (funcall-in-symbol-macrolet-lexenv - magic - (lambda () - (process-toplevel-locally body - path - compile-time-too))))))) - ((locally) - (process-toplevel-locally (rest form) path compile-time-too)) - ((progn) - (process-toplevel-progn (rest form) path compile-time-too)) - ;; When we're cross-compiling, consider: what should we - ;; do when we hit e.g. - ;; (EVAL-WHEN (:COMPILE-TOPLEVEL) - ;; (DEFUN FOO (X) (+ 7 X)))? - ;; DEFUN has a macro definition in the cross-compiler, - ;; and a different macro definition in the target - ;; compiler. The only sensible thing is to use the - ;; target compiler's macro definition, since the - ;; cross-compiler's macro is in general into target - ;; functions which can't meaningfully be executed at - ;; cross-compilation time. So make sure we do the EVAL - ;; here, before we macroexpand. - ;; - ;; Then things get even dicier with something like - ;; (DEFCONSTANT-EQX SB!XC:LAMBDA-LIST-KEYWORDS ..) - ;; where we have to make sure that we don't uncross - ;; the SB!XC: prefix before we do EVAL, because otherwise - ;; we'd be trying to redefine the cross-compilation host's - ;; constants. - ;; - ;; (Isn't it fun to cross-compile Common Lisp?:-) - #+sb-xc-host - (t - (when compile-time-too - (eval form)) ; letting xc host EVAL do its own macroexpansion - (let* (;; (We uncross the operator name because things - ;; like SB!XC:DEFCONSTANT and SB!XC:DEFTYPE - ;; should be equivalent to their CL: counterparts - ;; when being compiled as target code. We leave - ;; the rest of the form uncrossed because macros - ;; might yet expand into EVAL-WHEN stuff, and - ;; things inside EVAL-WHEN can't be uncrossed - ;; until after we've EVALed them in the - ;; cross-compilation host.) - (slightly-uncrossed (cons (uncross (first form)) - (rest form))) - (expanded (preprocessor-macroexpand-1 - slightly-uncrossed))) - (if (eq expanded slightly-uncrossed) - ;; (Now that we're no longer processing toplevel - ;; forms, and hence no longer need to worry about - ;; EVAL-WHEN, we can uncross everything.) - (convert-and-maybe-compile expanded path) - ;; (We have to demote COMPILE-TIME-TOO to NIL - ;; here, no matter what it was before, since - ;; otherwise we'd tend to EVAL subforms more than - ;; once, because of WHEN COMPILE-TIME-TOO form - ;; above.) - (process-toplevel-form expanded path nil)))) - ;; When we're not cross-compiling, we only need to - ;; macroexpand once, so we can follow the 1-thru-6 - ;; sequence of steps in ANSI's "3.2.3.1 Processing of - ;; Top Level Forms". - #-sb-xc-host - (t - (let ((expanded (preprocessor-macroexpand-1 form))) + (flet ((default-processor (form) + ;; When we're cross-compiling, consider: what should we + ;; do when we hit e.g. + ;; (EVAL-WHEN (:COMPILE-TOPLEVEL) + ;; (DEFUN FOO (X) (+ 7 X)))? + ;; DEFUN has a macro definition in the cross-compiler, + ;; and a different macro definition in the target + ;; compiler. The only sensible thing is to use the + ;; target compiler's macro definition, since the + ;; cross-compiler's macro is in general into target + ;; functions which can't meaningfully be executed at + ;; cross-compilation time. So make sure we do the EVAL + ;; here, before we macroexpand. + ;; + ;; Then things get even dicier with something like + ;; (DEFCONSTANT-EQX SB!XC:LAMBDA-LIST-KEYWORDS ..) + ;; where we have to make sure that we don't uncross + ;; the SB!XC: prefix before we do EVAL, because otherwise + ;; we'd be trying to redefine the cross-compilation host's + ;; constants. + ;; + ;; (Isn't it fun to cross-compile Common Lisp?:-) + #+sb-xc-host + (progn + (when compile-time-too + (eval form)) ; letting xc host EVAL do its own macroexpansion + (let* (;; (We uncross the operator name because things + ;; like SB!XC:DEFCONSTANT and SB!XC:DEFTYPE + ;; should be equivalent to their CL: counterparts + ;; when being compiled as target code. We leave + ;; the rest of the form uncrossed because macros + ;; might yet expand into EVAL-WHEN stuff, and + ;; things inside EVAL-WHEN can't be uncrossed + ;; until after we've EVALed them in the + ;; cross-compilation host.) + (slightly-uncrossed (cons (uncross (first form)) + (rest form))) + (expanded (preprocessor-macroexpand-1 + slightly-uncrossed))) + (if (eq expanded slightly-uncrossed) + ;; (Now that we're no longer processing toplevel + ;; forms, and hence no longer need to worry about + ;; EVAL-WHEN, we can uncross everything.) + (convert-and-maybe-compile expanded path) + ;; (We have to demote COMPILE-TIME-TOO to NIL + ;; here, no matter what it was before, since + ;; otherwise we'd tend to EVAL subforms more than + ;; once, because of WHEN COMPILE-TIME-TOO form + ;; above.) + (process-toplevel-form expanded path nil)))) + ;; When we're not cross-compiling, we only need to + ;; macroexpand once, so we can follow the 1-thru-6 + ;; sequence of steps in ANSI's "3.2.3.1 Processing of + ;; Top Level Forms". + #-sb-xc-host + (let ((expanded (preprocessor-macroexpand-1 form))) (cond ((eq expanded form) (when compile-time-too - (eval form)) + (eval-in-lexenv form *lexenv*)) (convert-and-maybe-compile form path)) (t (process-toplevel-form expanded path - compile-time-too)))))))))) + compile-time-too)))))) + (if (atom form) + #+sb-xc-host + ;; (There are no xc EVAL-WHEN issues in the ATOM case until + ;; (1) SBCL gets smart enough to handle global + ;; DEFINE-SYMBOL-MACRO or SYMBOL-MACROLET and (2) SBCL + ;; implementors start using symbol macros in a way which + ;; interacts with SB-XC/CL distinction.) + (convert-and-maybe-compile form path) + #-sb-xc-host + (default-processor form) + (flet ((need-at-least-one-arg (form) + (unless (cdr form) + (compiler-error "~S form is too short: ~S" + (car form) + form)))) + (case (car form) + ;; In the cross-compiler, top level COLD-FSET arranges + ;; for static linking at cold init time. + #+sb-xc-host + ((cold-fset) + (aver (not compile-time-too)) + (destructuring-bind (cold-fset fun-name lambda-expression) form + (declare (ignore cold-fset)) + (process-toplevel-cold-fset fun-name + lambda-expression + path))) + ((eval-when macrolet symbol-macrolet);things w/ 1 arg before body + (need-at-least-one-arg form) + (destructuring-bind (special-operator magic &rest body) form + (ecase special-operator + ((eval-when) + ;; CT, LT, and E here are as in Figure 3-7 of ANSI + ;; "3.2.3.1 Processing of Top Level Forms". + (multiple-value-bind (ct lt e) + (parse-eval-when-situations magic) + (let ((new-compile-time-too (or ct + (and compile-time-too + e)))) + (cond (lt (process-toplevel-progn + body path new-compile-time-too)) + (new-compile-time-too (eval-in-lexenv + `(progn ,@body) + *lexenv*)))))) + ((macrolet) + (funcall-in-macrolet-lexenv + magic + (lambda (&key funs) + (declare (ignore funs)) + (process-toplevel-locally body + path + compile-time-too)))) + ((symbol-macrolet) + (funcall-in-symbol-macrolet-lexenv + magic + (lambda (&key vars) + (process-toplevel-locally body + path + compile-time-too + :vars vars))))))) + ((locally) + (process-toplevel-locally (rest form) path compile-time-too)) + ((progn) + (process-toplevel-progn (rest form) path compile-time-too)) + (t (default-processor form)))))))) (values)) @@ -1179,68 +1223,29 @@ ;;;; COMPILE-FILE -;;; We build a list of top level lambdas, and then periodically smash -;;; them together into a single component and compile it. -(defvar *pending-toplevel-lambdas*) - -;;; The maximum number of top level lambdas we put in a single -;;; top level component. -;;; -;;; CMU CL 18b used this nontrivially by default (setting it to 10) -;;; but consequently suffered from the inability to execute some -;;; troublesome constructs correctly, e.g. inability to load a fasl -;;; file compiled from the source file -;;; (defpackage "FOO" (:use "CL")) -;;; (print 'foo::bar) -;;; because it would dump data-setup fops (including a FOP-PACKAGE for -;;; "FOO") for the second form before dumping the the code in the -;;; first form, or the fop to execute the code in the first form. By -;;; setting this value to 0 by default, we avoid this badness. This -;;; increases the number of toplevel form functions, and so increases -;;; the size of object files. -;;; -;;; The variable is still supported because when we are compiling the -;;; SBCL system itself, which is known not contain any troublesome -;;; constructs, we can set it to a nonzero value, which reduces the -;;; number of toplevel form objects, reducing the peak memory usage in -;;; GENESIS, which is desirable, since at least for SBCL version -;;; 0.6.7, this is the high water mark for memory usage during system -;;; construction. -(defparameter *toplevel-lambda-max* 0) - (defun object-call-toplevel-lambda (tll) (declare (type functional tll)) (let ((object *compile-object*)) (etypecase object - (fasl-output - (fasl-dump-toplevel-lambda-call tll object)) - (core-object - (core-call-toplevel-lambda tll object)) + (fasl-output (fasl-dump-toplevel-lambda-call tll object)) + (core-object (core-call-toplevel-lambda tll object)) (null)))) -;;; Add LAMBDAS to the pending lambdas. If this leaves more than -;;; *TOPLEVEL-LAMBDA-MAX* lambdas in the list, or if FORCE-P is true, -;;; then smash the lambdas into a single component, compile it, and -;;; call the resulting function. -(defun sub-compile-toplevel-lambdas (lambdas force-p) +;;; Smash LAMBDAS into a single component, compile it, and arrange for +;;; the resulting function to be called. +(defun sub-compile-toplevel-lambdas (lambdas) (declare (list lambdas)) - (setq *pending-toplevel-lambdas* - (append *pending-toplevel-lambdas* lambdas)) - (let ((pending *pending-toplevel-lambdas*)) - (when (and pending - (or (> (length pending) *toplevel-lambda-max*) - force-p)) - (multiple-value-bind (component tll) (merge-toplevel-lambdas pending) - (setq *pending-toplevel-lambdas* ()) - (compile-component component) - (clear-ir1-info component) - (object-call-toplevel-lambda tll)))) + (when lambdas + (multiple-value-bind (component tll) (merge-toplevel-lambdas lambdas) + (compile-component component) + (clear-ir1-info component) + (object-call-toplevel-lambda tll))) (values)) ;;; Compile top level code and call the top level lambdas. We pick off ;;; top level lambdas in non-top-level components here, calling ;;; SUB-c-t-l-l on each subsequence of normal top level lambdas. -(defun compile-toplevel-lambdas (lambdas force-p) +(defun compile-toplevel-lambdas (lambdas) (declare (list lambdas)) (let ((len (length lambdas))) (flet ((loser (start) @@ -1257,11 +1262,8 @@ len))) (do* ((start 0 (1+ loser)) (loser (loser start) (loser start))) - ((>= start len) - (when force-p - (sub-compile-toplevel-lambdas nil t))) - (sub-compile-toplevel-lambdas (subseq lambdas start loser) - (or force-p (/= loser len))) + ((>= start len)) + (sub-compile-toplevel-lambdas (subseq lambdas start loser)) (unless (= loser len) (object-call-toplevel-lambda (elt lambdas loser)))))) (values)) @@ -1280,20 +1282,17 @@ (maybe-mumble "IDFO ") (multiple-value-bind (components top-components hairy-top) (find-initial-dfo lambdas) - (let ((*all-components* (append components top-components)) - (toplevel-closure nil)) + (let ((*all-components* (append components top-components))) (when *check-consistency* (maybe-mumble "[check]~%") (check-ir1-consistency *all-components*)) (dolist (component (append hairy-top top-components)) - (when (pre-physenv-analyze-toplevel component) - (setq toplevel-closure t))) + (pre-physenv-analyze-toplevel component)) (dolist (component components) (compile-component component) - (when (replace-toplevel-xeps component) - (setq toplevel-closure t))) + (replace-toplevel-xeps component)) (when *check-consistency* (maybe-mumble "[check]~%") @@ -1301,7 +1300,7 @@ (if load-time-value-p (compile-load-time-value-lambda lambdas) - (compile-toplevel-lambdas lambdas toplevel-closure)) + (compile-toplevel-lambdas lambdas)) (mapc #'clear-ir1-info components) (clear-stuff))) @@ -1329,7 +1328,6 @@ (sb!xc:*compile-file-pathname* nil) (sb!xc:*compile-file-truename* nil) (*toplevel-lambdas* ()) - (*pending-toplevel-lambdas* ()) (*compiler-error-bailout* (lambda () (compiler-mumble "~2&; fatal error, aborting compilation~%") @@ -1356,7 +1354,6 @@ (sub-sub-compile-file info) (finish-block-compilation) - (compile-toplevel-lambdas () t) (let ((object *compile-object*)) (etypecase object (fasl-output (fasl-dump-source-info info object)) @@ -1468,7 +1465,7 @@ (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 @@ -1551,7 +1548,7 @@ #!+sb-doc "Return a pathname describing what file COMPILE-FILE would write to given these arguments." - (pathname output-file)) + (merge-pathnames output-file (merge-pathnames input-file))) ;;;; MAKE-LOAD-FORM stuff @@ -1633,7 +1630,6 @@ (:ignore-it nil) (t - (compile-toplevel-lambdas () t) (when (fasl-constant-already-dumped-p constant *compile-object*) (return-from emit-make-load-form nil)) (let* ((name (let ((*print-level* 1) (*print-length* 2)) @@ -1668,3 +1664,15 @@ (when circular-ref (setf (cdr circular-ref) (append (cdr circular-ref) (cdr info)))))))))))) + + +;;;; Host compile time definitions +#+sb-xc-host +(defun compile-in-lexenv (name lambda lexenv) + (declare (ignore lexenv)) + (compile name lambda)) + +#+sb-xc-host +(defun eval-in-lexenv (form lexenv) + (declare (ignore lexenv)) + (eval form))