common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Rearrange SB-C::PROCESS-TOPLEVEL-FORM

Browse source 
I finally figured out why the code was so confused/confusing:

* The comment that "The only sensible thing" is the target compiler's macro
  was the direct opposite of reality. The code of course did the right thing.

* The comment that "we can uncross everything" was very disingenuous,
  considering that we don't uncross more than one atom per level of recursion.

* We don't _need_ to do something different for atoms when cross-compiling
  - they rarely occur - however we must not compute the "slightly uncrossed"
  form as (NIL) if the original was NIL, by accidentally taking car/cdr of NIL.

* After cleaning up that mess, it became evident that the non-macro case
  for both + and - sb-xc-host were really nearly identical.

* Inadvertently or purposely we did not bind *TOP-LEVEL-FORM-P* to NIL for
  non-toplevel code in the cross-compiler. When fixed, this bug revealed that
  we expected to treat *all* DEFUNs as if toplevel, because we correctly emit
  "undefined" warnings for the ones inside toplevel FLETs. make-host-1 would
  resolve the warnings by loading each fasl, thus having an actual definition.
  Cross-compiling can't do that, but we can whitelist those functions.
This commit is contained in:
Douglas Katzman 2019-01-29 11:35:50 -05:00
parent c78dfcd103
commit 41486a1638
2 changed files with 129 additions and 143 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
package-data-list.lisp-expr
View file

@ -3605,4 +3605,21 @@ SBCL itself"
sb-impl::stringify-package-designator
sb-impl::stringify-string-designator
sb-impl::stringify-string-designators
sb-impl::unencapsulate-generic-function))
sb-impl::unencapsulate-generic-function)
;; The following functions are in fact defined during make-host-2
;; but they are non-toplevel so they appear to be undefined.
(sb-int:gensymify*
sb-int:keywordicate
sb-int:package-symbolicate
sb-int:symbolicate
sb-kernel::preinform-compiler-about-accessors
sb-kernel::preinform-compiler-about-slot-functions
sb-impl::bytes-per-utf8-character-aref
sb-impl::bytes-per-utf8-character-sap-ref-8
sb-impl::user-homedir-namestring
sb-c::apply-core-fixups
sb-c::compiled-debug-info-char-offset
sb-c::compiled-debug-info-tlf-number
sb-c::fopcompilable-p
sb-c::pack-xref-data
sb-sys:reinit-internal-real-time))

253
src/compiler/main.lisp
View file

@ -1451,148 +1451,116 @@ necessary, since type inference may take arbitrarily long to converge.")
path)
(throw 'process-toplevel-form-error-abort nil)))
(*top-level-form-p* t))
(labels
((defer (form)
(push (vector *source-paths* *policy* *handled-conditions*
*disabled-package-locks* *lexenv* form path)
(queued-tlfs)))
(default-processor (form)
(let ((*top-level-form-noted* (note-top-level-form 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
(when (and (queued-tlfs)
(not (whitelisted-compile-time-form-p form)))
(process-queued-tlfs))
(let ((*compile-time-eval* t))
(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 intact 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.)
(cond ((deferrable-tlf-p expanded)
(defer expanded))
(t
(when (and (queued-tlfs)
(not (whitelisted-load-time-form-p expanded)))
(process-queued-tlfs))
(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-compile-toplevel (list form) path))
(cond ((deferrable-tlf-p form)
(defer form))
(t
(when (and (queued-tlfs)
(not (whitelisted-load-time-form-p form)))
(process-queued-tlfs))
(let (*top-level-form-p*)
(convert-and-maybe-compile form path nil)))))
(t
(process-toplevel-form expanded
path
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)
((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-compile-toplevel body path))))))
((macrolet)
(funcall-in-macrolet-lexenv
magic
(lambda (&optional funs)
(process-toplevel-locally body
path
compile-time-too
:funs funs))
:compile))
((symbol-macrolet)
(funcall-in-symbol-macrolet-lexenv
magic
(lambda (&optional vars)
(process-toplevel-locally body
path
compile-time-too
:vars vars))
:compile)))))
((locally)
(process-toplevel-locally (rest form) path compile-time-too))
((progn)
(process-toplevel-progn (rest form) path compile-time-too))
(t (default-processor form))))))))
(case (if (listp form) (car form))
((eval-when macrolet symbol-macrolet) ; things w/ 1 arg before body
(unless (cdr form)
(compiler-error "~S form is too short: ~S" (car form) 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-compile-toplevel body path))))))
((macrolet)
(funcall-in-macrolet-lexenv
magic
(lambda (&optional funs)
(process-toplevel-locally body path compile-time-too :funs funs))
:compile))
((symbol-macrolet)
(funcall-in-symbol-macrolet-lexenv
magic
(lambda (&optional vars)
(process-toplevel-locally body path compile-time-too :vars vars))
:compile)))))
((locally)
(process-toplevel-locally (rest form) path compile-time-too))
((progn)
(process-toplevel-progn (rest form) path compile-time-too))
(t
(flet ((process-nonmacro (form)
(cond ((deferrable-tlf-p form)
(push (vector *source-paths* *policy* *handled-conditions*
*disabled-package-locks* *lexenv* form path)
(queued-tlfs)))
(t
(when (and (queued-tlfs)
(not (whitelisted-load-time-form-p form)))
(process-queued-tlfs))
(let (*top-level-form-p*)
(convert-and-maybe-compile form path))))))
(let ((*top-level-form-noted* (note-top-level-form form)))
#+sb-xc-host
(cond
((atom form)
;; assert that we don't, in our own code, use a DEFINE-SYMBOL-MACRO
;; expanding into (PROGN (EVAL-WHEN (:COMPILE-TOPLEVEL ...) ...))
;; or something equally whacky, if not more so, than that.
(aver (self-evaluating-p form)))
(t
;; 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/target-compiler,
;; and a different macro definition in the host compiler.
;; The only sensible thing is to use the host's macro, since the
;; cross-compiler's macro is in general into target functions
;; which can't meaningfully be executed by the host.
;; 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?:-)
(when compile-time-too
(when (and (queued-tlfs)
(not (whitelisted-compile-time-form-p form)))
(process-queued-tlfs))
(let ((*compile-time-eval* t))
(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 intact 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 (neq expanded slightly-uncrossed) ; macro
;; (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)
(process-nonmacro slightly-uncrossed)))))
;; 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 ((neq expanded form) ; macro -> take it from the top
(process-toplevel-form expanded path compile-time-too))
(t
(when compile-time-too
(eval-compile-toplevel (list form) path))
(process-nonmacro form))))))))))
(values))
@ -1759,6 +1727,7 @@ necessary, since type inference may take arbitrarily long to converge.")
(setq *block-compile* nil)
(setq *entry-points* nil)))
(declaim (ftype function handle-condition-p))
(flet ((get-handled-conditions ()
(let ((ctxt *compiler-error-context*))
(lexenv-handled-conditions