From 794555376b9c8553f1aa0e48a72974637ce28fb0 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Sun, 6 Mar 2016 23:46:59 -0500 Subject: [PATCH] Remove DEFMACRO-MUNDANELY. Because 3 variations on DEFMACRO is too many. --- package-data-list.lisp-expr | 1 - src/code/cold-init.lisp | 3 +- src/code/defbangconstant.lisp | 18 ++-- src/code/defbangmacro.lisp | 2 +- src/code/defboot.lisp | 64 ++++++------- src/code/defmacro.lisp | 202 ++++++++++++++++----------------------- src/code/defpackage.lisp | 2 +- src/code/defstruct.lisp | 2 +- src/code/destructuring-bind.lisp | 2 +- src/code/hash-table.lisp | 4 +- src/code/host-alieneval.lisp | 2 +- src/code/late-defbangmethod.lisp | 2 +- src/code/late-extensions.lisp | 4 +- src/code/late-format.lisp | 2 +- src/code/loop.lisp | 24 ++--- src/code/macros.lisp | 38 ++++---- src/code/package.lisp | 10 +- src/code/setf.lisp | 22 ++--- src/cold/chill.lisp | 4 +- src/compiler/defconstant.lisp | 6 +- 20 files changed, 188 insertions(+), 226 deletions(-) rewrite src/code/defmacro.lisp (65%) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index c6f9e92a7..702fffa13 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1096,7 +1096,6 @@ possibly temporarily, because it might be used internally." ;; other variations on DEFFOO stuff useful for bootstrapping ;; and cross-compiling - "DEFMACRO-MUNDANELY" "DEFCONSTANT-EQX" "DEFINE-UNSUPPORTED-FUN" diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index c67b07aeb..e1e38e94a 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -493,8 +493,7 @@ process to continue normally." ;; DEF!TYPE DEF!CONSTANT DEF!MACRO DEF!STRUCT ;; does not work, they stick around as uninterned symbols. ;; Some other macros must expand into them. Ugh. - (dolist (s '(defenum defmacro-mundanely defun-cached - with-globaldb-name + (dolist (s '(defenum defun-cached with-globaldb-name . #!+sb-show () #!-sb-show (/hexstr /nohexstr /noshow /noshow0 /noxhow diff --git a/src/code/defbangconstant.lisp b/src/code/defbangconstant.lisp index 36dacc618..08cf11b85 100644 --- a/src/code/defbangconstant.lisp +++ b/src/code/defbangconstant.lisp @@ -69,12 +69,16 @@ ;;; which are appropriately compared using the function given by the ;;; EQX argument instead of EQL. ;;; -(#+sb-xc-host defmacro - #-sb-xc-host defmacro-mundanely ; don't want this definition until warm load - defconstant-eqx (symbol expr eqx &optional doc) - `(def!constant ,symbol - (%defconstant-eqx-value ',symbol ,expr ,eqx) - ,@(when doc (list doc)))) +(let () ; ensure non-toplevelness + ;; :compile-toplevel for #+sb-xc-host is (mostly) irrelevant, + ;; since the fasl file will be loaded. + ;; the #-sb-xc-host code is different though. + (#+sb-xc-host defmacro + #-sb-xc-host sb!xc:defmacro + defconstant-eqx (symbol expr eqx &optional doc) + `(def!constant ,symbol + (%defconstant-eqx-value ',symbol ,expr ,eqx) + ,@(when doc (list doc))))) ;; We want DEFCONSTANT-EQX to work in cold-load so that non-EQL-comparable ;; constants (like BYTE specifiers) can be accessed immediately in cold-init. @@ -85,7 +89,7 @@ ;; have it dumped in the usual way. SB!XC:CONSTANTP recognizes that BYTE ;; can be folded; and (2) we must avoid %DEFCONSTANT-EQX-VALUE. #+sb-xc -(eval-when (:compile-toplevel) ; DEFMACRO-MUNDANELY took care of load-time +(eval-when (:compile-toplevel) ; SB!XC:DEFMACRO took care of load-time (sb!xc:defmacro defconstant-eqx (symbol expr eqx &optional doc) (declare (ignore eqx)) `(sb!c::%defconstant ',symbol diff --git a/src/code/defbangmacro.lisp b/src/code/defbangmacro.lisp index 85fd92848..bd7bc22b5 100644 --- a/src/code/defbangmacro.lisp +++ b/src/code/defbangmacro.lisp @@ -55,7 +55,7 @@ ;; and getting all confused. Using an ordinary assignment (and not ;; any special forms like DEFMACRO) guarantees that there are no ;; effects at compile time. - #+sb-xc `(defmacro-mundanely ,name ,@rest)) + #+sb-xc `(sb!xc:defmacro ,name ,@rest)) #+sb-xc-host (defun force-delayed-def!macros () diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 2e0598bf8..75c84bf0e 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -23,7 +23,7 @@ ;;;; IN-PACKAGE -(defmacro-mundanely in-package (string-designator) +(sb!xc:defmacro in-package (string-designator) (let ((string (string string-designator))) `(eval-when (:compile-toplevel :load-toplevel :execute) (setq *package* (find-undeleted-package-or-lose ,string))))) @@ -34,7 +34,7 @@ (and (listp x) (every #'symbolp x))) -(defmacro-mundanely multiple-value-bind (vars value-form &body body) +(sb!xc:defmacro multiple-value-bind (vars value-form &body body) (if (list-of-symbols-p vars) ;; It's unclear why it would be important to special-case the LENGTH=1 case ;; at this level, but the CMU CL code did it, so.. -- WHN 19990411 @@ -49,7 +49,7 @@ ,value-form))) (error "Vars is not a list of symbols: ~S" vars))) -(defmacro-mundanely multiple-value-setq (vars value-form) +(sb!xc:defmacro multiple-value-setq (vars value-form) (unless (list-of-symbols-p vars) (error "Vars is not a list of symbols: ~S" vars)) ;; MULTIPLE-VALUE-SETQ is required to always return just the primary @@ -60,13 +60,13 @@ `(values (setf (values ,@vars) ,value-form)) `(values ,value-form))) -(defmacro-mundanely multiple-value-list (value-form) +(sb!xc:defmacro multiple-value-list (value-form) `(multiple-value-call #'list ,value-form)) ;;;; various conditional constructs ;;; COND defined in terms of IF -(defmacro-mundanely cond (&rest clauses) +(sb!xc:defmacro cond (&rest clauses) (if (endp clauses) nil (let ((clause (first clauses)) @@ -98,19 +98,19 @@ (cond ((singleton-p forms) (car forms)) ((not forms) nil) (t `(progn ,@forms))))) - (defmacro-mundanely when (test &body forms) + (sb!xc:defmacro when (test &body forms) #!+sb-doc "If the first argument is true, the rest of the forms are evaluated as a PROGN." `(if ,test ,(prognify forms))) - (defmacro-mundanely unless (test &body forms) + (sb!xc:defmacro unless (test &body forms) #!+sb-doc "If the first argument is not true, the rest of the forms are evaluated as a PROGN." `(if ,test nil ,(prognify forms)))) -(defmacro-mundanely and (&rest forms) +(sb!xc:defmacro and (&rest forms) (cond ((endp forms) t) ((endp (rest forms)) ;; Preserve non-toplevelness of the form! @@ -120,7 +120,7 @@ evaluated as a PROGN." (and ,@(rest forms)) nil)))) -(defmacro-mundanely or (&rest forms) +(sb!xc:defmacro or (&rest forms) (cond ((endp forms) nil) ((endp (rest forms)) ;; Preserve non-toplevelness of the form! @@ -140,18 +140,18 @@ evaluated as a PROGN." (,let ,varlist ,@decls (tagbody ,@body)))))) - (defmacro-mundanely prog (varlist &body body-decls) + (sb!xc:defmacro prog (varlist &body body-decls) (prog-expansion-from-let varlist body-decls 'let)) - (defmacro-mundanely prog* (varlist &body body-decls) + (sb!xc:defmacro prog* (varlist &body body-decls) (prog-expansion-from-let varlist body-decls 'let*))) -(defmacro-mundanely prog1 (result &body body) +(sb!xc:defmacro prog1 (result &body body) (let ((n-result (gensym))) `(let ((,n-result ,result)) ,@body ,n-result))) -(defmacro-mundanely prog2 (form1 result &body body) +(sb!xc:defmacro prog2 (form1 result &body body) `(prog1 (progn ,form1 ,result) ,@body)) ;;;; DEFUN @@ -176,7 +176,7 @@ evaluated as a PROGN." ;; the only unsurprising choice. (info :function :inline-expansion-designator name))) -(defmacro-mundanely defun (&environment env name lambda-list &body body) +(sb!xc:defmacro defun (&environment env name lambda-list &body body) #!+sb-doc "Define a function at top level." #+sb-xc-host @@ -245,7 +245,7 @@ evaluated as a PROGN." ;;;; DEFVAR and DEFPARAMETER -(defmacro-mundanely defvar (var &optional (val nil valp) (doc nil docp)) +(sb!xc:defmacro defvar (var &optional (val nil valp) (doc nil docp)) #!+sb-doc "Define a special variable at top level. Declare the variable SPECIAL and, optionally, initialize it. If the variable already has a @@ -261,7 +261,7 @@ evaluated as a PROGN." ,@(and docp `(',doc))))) -(defmacro-mundanely defparameter (var val &optional (doc nil docp)) +(sb!xc:defmacro defparameter (var val &optional (doc nil docp)) #!+sb-doc "Define a parameter that is not normally changed by the program, but that may be changed without causing an error. Declare the @@ -337,10 +337,10 @@ evaluated as a PROGN." (return-from ,block (progn ,@(rest endlist)))))))))))) ;; This is like DO, except it has no implicit NIL block. - (defmacro-mundanely do-anonymous (varlist endlist &rest body) + (sb!xc:defmacro do-anonymous (varlist endlist &rest body) (frob-do-body varlist endlist body 'let 'psetq 'do-anonymous (sb!xc:gensym))) - (defmacro-mundanely do (varlist endlist &body body) + (sb!xc:defmacro do (varlist endlist &body body) #!+sb-doc "DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form* Iteration construct. Each Var is initialized in parallel to the value of the @@ -352,7 +352,7 @@ evaluated as a PROGN." used as an alternate exit mechanism." (frob-do-body varlist endlist body 'let 'psetq 'do nil)) - (defmacro-mundanely do* (varlist endlist &body body) + (sb!xc:defmacro do* (varlist endlist &body body) #!+sb-doc "DO* ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form* Iteration construct. Each Var is initialized sequentially (like LET*) to the @@ -371,7 +371,7 @@ evaluated as a PROGN." ;;; defined that it looks as though it's worth just implementing them ;;; ASAP, at the cost of being unable to use the standard ;;; destructuring mechanisms. -(defmacro-mundanely dotimes ((var count &optional (result nil)) &body body) +(sb!xc:defmacro dotimes ((var count &optional (result nil)) &body body) (cond ((integerp count) `(do ((,var 0 (1+ ,var))) ((>= ,var ,count) ,result) @@ -386,7 +386,7 @@ evaluated as a PROGN." (type integer ,c)) ,@body))))) -(defmacro-mundanely dolist ((var list &optional (result nil)) &body body &environment env) +(sb!xc:defmacro dolist ((var list &optional (result nil)) &body body &environment env) ;; We repeatedly bind the var instead of setting it so that we never ;; have to give the var an arbitrary value such as NIL (which might ;; conflict with a declaration). If there is a result form, we @@ -459,7 +459,7 @@ evaluated as a PROGN." (setf (info :variable :always-bound '*restart-clusters*) #+sb-xc :always-bound #-sb-xc :eventually) -(defmacro-mundanely with-condition-restarts +(sb!xc:defmacro with-condition-restarts (condition-form restarts-form &body body) #!+sb-doc "Evaluates the BODY in a dynamic environment where the restarts in the list @@ -479,7 +479,7 @@ evaluated as a PROGN." (dolist (,restart ,restarts) (pop (restart-associated-conditions ,restart))))))) -(defmacro-mundanely restart-bind (bindings &body forms) +(sb!xc:defmacro restart-bind (bindings &body forms) #!+sb-doc "(RESTART-BIND ({(case-name function {keyword value}*)}*) forms) Executes forms in a dynamic context where the given bindings are in @@ -538,7 +538,7 @@ evaluated as a PROGN." expression)) expression))) -(defmacro-mundanely restart-case (expression &body clauses &environment env) +(sb!xc:defmacro restart-case (expression &body clauses &environment env) #!+sb-doc "(RESTART-CASE form {(case-name arg-list {keyword value}* body)}*) The form is evaluated in a dynamic context where the clauses have @@ -630,7 +630,7 @@ evaluated as a PROGN." ,(munge-restart-case-expression expression env))) ,@(mapcan #'make-apply-and-return clauses-data)))))))) -(defmacro-mundanely with-simple-restart ((restart-name format-string +(sb!xc:defmacro with-simple-restart ((restart-name format-string &rest format-arguments) &body forms) #!+sb-doc @@ -650,7 +650,7 @@ evaluated as a PROGN." (format ,stream ,format-string ,@format-arguments)) (values nil t))))) -(defmacro-mundanely %handler-bind (bindings form &environment env) +(sb!xc:defmacro %handler-bind (bindings form &environment env) (unless bindings (return-from %handler-bind form)) ;; As an optimization, this looks at the handler parts of BINDINGS @@ -780,7 +780,7 @@ evaluated as a PROGN." *handler-clusters*))) ,form))))) -(defmacro-mundanely handler-bind (bindings &body forms) +(sb!xc:defmacro handler-bind (bindings &body forms) #!+sb-doc "(HANDLER-BIND ( {(type handler)}* ) body) @@ -798,7 +798,7 @@ condition." ;; Need to catch FP errors here! #!+x86 (multiple-value-prog1 (progn ,@forms) (float-wait)))) -(defmacro-mundanely handler-case (form &rest cases) +(sb!xc:defmacro handler-case (form &rest cases) #!+sb-doc "(HANDLER-CASE form { (type ([var]) body) }* ) @@ -867,18 +867,18 @@ specification." ;;;; miscellaneous -(defmacro-mundanely return (&optional (value nil)) +(sb!xc:defmacro return (&optional (value nil)) `(return-from nil ,value)) -(defmacro-mundanely lambda (&whole whole args &body body) +(sb!xc:defmacro lambda (&whole whole args &body body) (declare (ignore args body)) `#',whole) -(defmacro-mundanely named-lambda (&whole whole name args &body body) +(sb!xc:defmacro named-lambda (&whole whole name args &body body) (declare (ignore name args body)) `#',whole) -(defmacro-mundanely lambda-with-lexenv (&whole whole +(sb!xc:defmacro lambda-with-lexenv (&whole whole declarations macros symbol-macros &body body) (declare (ignore declarations macros symbol-macros body)) diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp dissimilarity index 65% index 2d9368da4..c6a78facc 100644 --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -1,120 +1,82 @@ -;;;; DEFMACRO machinery - -;;;; This software is part of the SBCL system. See the README file for -;;;; more information. -;;;; -;;;; This software is derived from the CMU CL system, which was -;;;; written at Carnegie Mellon University and released into the -;;;; public domain. The software is in the public domain and is -;;;; provided with absolutely no warranty. See the COPYING and CREDITS -;;;; files for more information. - -(in-package "SB!IMPL") - -;;; the guts of the DEFMACRO macro, pulled out into a separate -;;; function in order to make it easier to express the common -;;; bootstrap idiom -;;; CL:DEFMACRO SB!XC:DEFMACRO -;;; SB!XC:DEFMACRO CL:DEFMACRO -(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) - (defun %expander-for-defmacro (name lambda-list body) - (unless (symbolp name) - (error "The macro name ~S is not a symbol." name)) - ;; When we are building the cross-compiler, we could be in a host - ;; lisp which implements CL macros (e.g. CL:AND) as special - ;; operators (while still providing a macroexpansion for - ;; compliance): therefore can't use the host's SPECIAL-OPERATOR-P - ;; as a discriminator, but that's OK because the set of forms the - ;; cross-compiler compiles is tightly controlled. -- CSR, - ;; 2003-04-20 - #-sb-xc-host - (when (special-operator-p name) - (error "The special operator ~S can't be redefined as a macro." - name)) - ;; The name of the lambda is (MACRO-FUNCTION name) - ;; which does not conflict with any legal function name. - (let ((def (make-macro-lambda (sb!c::debug-name 'macro-function name) - lambda-list body 'defmacro name))) - `(progn - #-sb-xc-host - ;; Getting this to cross-compile with the check enabled - ;; would require %COMPILER-DEFMACRO to be defined earlier, - ;; but symmetry suggests it be near %COMPILER-DEFUN, - ;; which isn't soon enough. So leave it out. - (eval-when (:compile-toplevel) - (sb!c::%compiler-defmacro :macro-function ',name t)) - (eval-when (:compile-toplevel :load-toplevel :execute) - (sb!c::%defmacro ',name ,def (sb!c:source-location))))))) - -(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) - (defun sb!c::%defmacro (name definition source-location) - (declare (ignorable source-location)) ; xc-host doesn't use - ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO - ;; should deal with clearing old compiler information for - ;; the functional value." - (let ((kind (info :function :kind name))) - ;; Check for special form before package locks. - (when (eq :special-form kind) - (error "The special operator ~S can't be redefined as a macro." - name)) - (with-single-package-locked-error (:symbol name "defining ~S as a macro") - (when (eq :function kind) - (style-warn - "~S is being redefined as a macro when it was ~ - previously ~(~A~) to be a function." - name (info :function :where-from name)) - (undefine-fun-name name)) - (clear-info :function :where-from name) - #-sb-xc-host - (when (fboundp name) - ;; Someday we could check for macro arguments - ;; being incompatibly redefined. Doing this right - ;; will involve finding the old macro lambda-list - ;; and comparing it with the new one. - (warn 'redefinition-with-defmacro - :name name - :new-function definition - :new-location source-location)) - (setf (sb!xc:macro-function name) definition))) - name)) - -;;; Parse the definition and make an expander function. The actual -;;; definition is done by %DEFMACRO which we expand into. After the -;;; compiler has gotten the information it wants out of macro -;;; definition, it compiles a call to %DEFMACRO which happens at load -;;; time. -(defmacro sb!xc:defmacro (name lambda-list &rest body) - (%expander-for-defmacro name lambda-list body)) - -;;; In the cross-compiler, we not only need to support the definition -;;; of target macros at cross-compiler-build-time (with SB!XC:DEFMACRO -;;; running in the cross-compilation host), we also need to support -;;; the definition of target macros at target compilation time (with -;;; CL:DEFMACRO processed by the cross-compiler).. -#+sb-xc-host -(sb!xc:defmacro defmacro (name lambda-list &rest body) - (%expander-for-defmacro name lambda-list body)) - -;;; DEFMACRO-MUNDANELY is like SB!XC:DEFMACRO, except that it doesn't -;;; have any EVAL-WHEN or IR1 magic associated with it, so it only -;;; takes effect in :LOAD-TOPLEVEL or :EXECUTE situations. -(def!macro defmacro-mundanely (name lambda-list &body body) - - ;; old way: - ;;(let ((whole (gensym "WHOLE-")) - ;; (environment (gensym "ENVIRONMENT-"))) - ;; (multiple-value-bind (new-body local-decs doc) - ;; (parse-defmacro lambda-list whole body name 'defmacro - ;; :environment environment) - ;; `(progn - ;; (setf (sb!xc:macro-function ',name) - ;; (lambda (,whole ,environment) - ;; ,@local-decs - ;; (block ,name - ;; ,new-body))) - ;; (setf (fdocumentation ',name 'macro) - ;; ,doc) - ;; ',name))) - - `(let () - (sb!xc:defmacro ,name ,lambda-list ,@body))) +;;;; DEFMACRO machinery + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!IMPL") + +(let () + (defmacro sb!xc:defmacro (name lambda-list &body body) + (unless (symbolp name) + (error "The macro name ~S is not a symbol." name)) + ;; When we are building the cross-compiler, we could be in a host + ;; lisp which implements CL macros (e.g. CL:AND) as special + ;; operators (while still providing a macroexpansion for + ;; compliance): therefore can't use the host's SPECIAL-OPERATOR-P + ;; as a discriminator, but that's OK because the set of forms the + ;; cross-compiler compiles is tightly controlled. -- CSR, + ;; 2003-04-20 + #-sb-xc-host + (when (special-operator-p name) + (error "The special operator ~S can't be redefined as a macro." + name)) + ;; The name of the lambda is (MACRO-FUNCTION name) + ;; which does not conflict with any legal function name. + (let ((def (make-macro-lambda (sb!c::debug-name 'macro-function name) + lambda-list body 'defmacro name))) + `(progn + ;; %COMPILER-DEFMACRO just performs a check for duplicate definitions + ;; within a file. + (eval-when (:compile-toplevel) + (sb!c::%compiler-defmacro :macro-function ',name t)) + (eval-when (:compile-toplevel :load-toplevel :execute) + (sb!c::%defmacro ',name ,def (sb!c:source-location))))))) + +(defun sb!c::%defmacro (name definition source-location) + (declare (ignorable source-location)) ; xc-host doesn't use + ;; old note (ca. 1985, maybe:-): "Eventually %%DEFMACRO + ;; should deal with clearing old compiler information for + ;; the functional value." + (let ((kind (info :function :kind name))) + ;; Check for special form before package locks. + (when (eq :special-form kind) + (error "The special operator ~S can't be redefined as a macro." + name)) + (with-single-package-locked-error (:symbol name "defining ~S as a macro") + (when (eq :function kind) + (style-warn + "~S is being redefined as a macro when it was previously ~(~A~) to be a function." + name (info :function :where-from name)) + (undefine-fun-name name)) + (clear-info :function :where-from name) + #-sb-xc-host + (when (fboundp name) + ;; Someday we could check for macro arguments + ;; being incompatibly redefined. Doing this right + ;; will involve finding the old macro lambda-list + ;; and comparing it with the new one. + (warn 'redefinition-with-defmacro :name name + :new-function definition :new-location source-location)) + (setf (sb!xc:macro-function name) definition))) + name) + +#+sb-xc-host +(let ((real-expander (macro-function 'sb!xc:defmacro))) + ;; Inform the cross-compiler how to expand SB!XC:DEFMACRO (= DEFMACRO). + (setf (sb!xc:macro-function 'sb!xc:defmacro) + (lambda (form env) + (declare (ignore env)) + ;; Since SB!KERNEL:LEXENV isn't compatible with the host, + ;; just pass NIL. The expansion correctly captures a non-null + ;; environment, but the expander doesn't need it. + (funcall real-expander form nil))) + ;; Building the cross-compiler should skip the compile-time-too + ;; processing SB!XC:DEFMACRO. + (setf (macro-function 'sb!xc:defmacro) + (lambda (form env) `(let () ,(funcall real-expander form env))))) diff --git a/src/code/defpackage.lisp b/src/code/defpackage.lisp index c007ba8e3..7d6e12343 100644 --- a/src/code/defpackage.lisp +++ b/src/code/defpackage.lisp @@ -29,7 +29,7 @@ ;; "mundanely" because this macro can't work (never has, never will) ;; until the target system is fully operational. -(defmacro-mundanely defpackage (package &rest options) +(sb!xc:defmacro defpackage (package &rest options) #!+sb-doc #.(format nil "Defines a new package called PACKAGE. Each of OPTIONS should be one of the diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 472f06799..ce14a5fd7 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -103,7 +103,7 @@ ;;; re. %DELAYED-GET-COMPILER-LAYOUT and COMPILE-TIME-FIND-LAYOUT, above.. ;;; -;;; FIXME: Perhaps both should be defined with DEFMACRO-MUNDANELY? +;;; FIXME: Perhaps both should be defined with SB!XC:DEFMACRO? ;;; FIXME: Do we really need both? If so, their names and implementations ;;; should probably be tweaked to be more parallel. diff --git a/src/code/destructuring-bind.lisp b/src/code/destructuring-bind.lisp index 32867bc4b..c11f59c18 100644 --- a/src/code/destructuring-bind.lisp +++ b/src/code/destructuring-bind.lisp @@ -9,7 +9,7 @@ (in-package "SB!IMPL") -(defmacro-mundanely destructuring-bind (lambda-list expression &body body) +(sb!xc:defmacro destructuring-bind (lambda-list expression &body body) #!+sb-doc "Bind the variables in LAMBDA-LIST to the corresponding values in the tree structure resulting from the evaluation of EXPRESSION." diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index 07784d49c..e67fd214d 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -105,7 +105,7 @@ ;; the generational garbage collector needs to know it. (defconstant +magic-hash-vector-value+ (ash 1 (1- sb!vm:n-word-bits))) -(defmacro-mundanely with-locked-hash-table ((hash-table) &body body) +(sb!xc:defmacro with-locked-hash-table ((hash-table) &body body) #!+sb-doc "Limits concurrent accesses to HASH-TABLE for the duration of BODY. If HASH-TABLE is synchronized, BODY will execute with exclusive @@ -119,7 +119,7 @@ unspecified." `(sb!thread::with-recursive-lock ((hash-table-lock ,hash-table)) ,@body)) -(defmacro-mundanely with-locked-system-table ((hash-table) &body body) +(sb!xc:defmacro with-locked-system-table ((hash-table) &body body) `(sb!thread::with-recursive-system-lock ((hash-table-lock ,hash-table)) ,@body)) diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index 113394c96..24282ddae 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -1225,7 +1225,7 @@ ;;;; the ADDR macro -(defmacro-mundanely addr (expr &environment env) +(sb!xc:defmacro addr (expr &environment env) #!+sb-doc "Return an Alien pointer to the data addressed by Expr, which must be a call to SLOT or DEREF, or a reference to an Alien variable." diff --git a/src/code/late-defbangmethod.lisp b/src/code/late-defbangmethod.lisp index f5c640263..6602b781c 100644 --- a/src/code/late-defbangmethod.lisp +++ b/src/code/late-defbangmethod.lisp @@ -12,5 +12,5 @@ ;;; DEF!METHOD = cold DEFMETHOD, a version of DEFMETHOD which, when used ;;; before real CLOS DEFMETHOD is available, saves up its definition to be ;;; executed later when CLOS is available -(defmacro-mundanely def!method (&rest args) +(sb!xc:defmacro def!method (&rest args) `(push (cons (sb!c:source-location) ',args) *delayed-def!method-args*)) diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp index a160eefc1..309dd7cd8 100644 --- a/src/code/late-extensions.lisp +++ b/src/code/late-extensions.lisp @@ -96,7 +96,7 @@ ;;;; DEFGLOBAL -(defmacro-mundanely defglobal (name value &optional (doc nil docp)) +(sb!xc:defmacro defglobal (name value &optional (doc nil docp)) #!+sb-doc "Defines NAME as a global variable that is always bound. VALUE is evaluated and assigned to NAME both at compile- and load-time, but only if NAME is not @@ -117,7 +117,7 @@ See also the declarations SB-EXT:GLOBAL and SB-EXT:ALWAYS-BOUND." (%defglobal ',name (unless ,boundp ,value) ,boundp ',doc ,docp (sb!c:source-location)))))) -(defmacro-mundanely define-load-time-global (name value &optional (doc nil docp)) +(sb!xc:defmacro define-load-time-global (name value &optional (doc nil docp)) #!+sb-doc "Defines NAME as a global variable that is always bound. VALUE is evaluated and assigned to NAME at load-time, but only if NAME is not already bound. diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp index 21cae908a..22eab3d29 100644 --- a/src/code/late-format.lisp +++ b/src/code/late-format.lisp @@ -277,7 +277,7 @@ (values `(write-string ,directive stream) more-directives)))) -(defmacro-mundanely expander-next-arg (string offset) +(sb!xc:defmacro expander-next-arg (string offset) `(if args (pop args) (error 'format-error diff --git a/src/code/loop.lisp b/src/code/loop.lisp index ae93b203f..11328b29c 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -90,13 +90,13 @@ ;;;; list collection macrology -(sb!int:defmacro-mundanely with-loop-list-collection-head +(sb!xc:defmacro with-loop-list-collection-head ((head-var tail-var &optional user-head-var) &body body) (let ((l (and user-head-var (list (list user-head-var nil))))) `(let* ((,head-var (list nil)) (,tail-var ,head-var) ,@l) ,@body))) -(sb!int:defmacro-mundanely loop-collect-rplacd +(sb!xc:defmacro loop-collect-rplacd (&environment env (head-var tail-var &optional user-head-var) form) (setq form (sb!int:%macroexpand form env)) (flet ((cdr-wrap (form n) @@ -142,7 +142,7 @@ (setq ,user-head-var (cdr ,head-var))))) answer)))) -(sb!int:defmacro-mundanely loop-collect-answer (head-var +(sb!xc:defmacro loop-collect-answer (head-var &optional user-head-var) (or user-head-var `(cdr ,head-var))) @@ -200,7 +200,7 @@ constructed. (gensym "LOOP-MAXMIN-FLAG-"))) operation) -(sb!int:defmacro-mundanely with-minimax-value (lm &body body) +(sb!xc:defmacro with-minimax-value (lm &body body) (let ((init (loop-typed-init (loop-minimax-type lm))) (which (car (loop-minimax-operations lm))) (infinity-data (loop-minimax-infinity-data lm)) @@ -219,7 +219,7 @@ constructed. (declare (type ,type ,answer-var ,temp-var)) ,@body)))) -(sb!int:defmacro-mundanely loop-accumulate-minimax-value (lm operation form) +(sb!xc:defmacro loop-accumulate-minimax-value (lm operation form) (let* ((answer-var (loop-minimax-answer-variable lm)) (temp-var (loop-minimax-temp-variable lm)) (flag-var (loop-minimax-flag-variable lm)) @@ -264,7 +264,7 @@ code to be loaded. (and (symbolp loop-token) (values (gethash (symbol-name loop-token) table)))) -(sb!int:defmacro-mundanely loop-store-table-data (symbol table datum) +(sb!xc:defmacro loop-store-table-data (symbol table datum) `(setf (gethash (symbol-name ,symbol) ,table) ,datum)) (defstruct (loop-universe @@ -328,7 +328,7 @@ code to be loaded. (defvar *loop-desetq-temporary* (make-symbol "LOOP-DESETQ-TEMP")) -(sb!int:defmacro-mundanely loop-really-desetq (&environment env +(sb!xc:defmacro loop-really-desetq (&environment env &rest var-val-pairs) (labels ((find-non-null (var) ;; See whether there's any non-null thing here. Recurse @@ -500,7 +500,7 @@ code to be loaded. (setq constantp nil value nil))) (values form constantp value))) -(sb!int:defmacro-mundanely loop-body (prologue +(sb!xc:defmacro loop-body (prologue before-loop main-body after-loop @@ -581,7 +581,7 @@ code to be loaded. (push (car cdr) result)))))) (values (transform tree) ignores)))) -(sb!int:defmacro-mundanely loop-destructuring-bind +(sb!xc:defmacro loop-destructuring-bind (lambda-list args &rest body) (multiple-value-bind (d-lambda-list ignores) (transform-destructuring lambda-list) @@ -1065,7 +1065,7 @@ code to be loaded. dtype (data nil)) ;collector-specific data -(sb!int:defmacro-mundanely with-sum-count (lc &body body) +(sb!xc:defmacro with-sum-count (lc &body body) (let* ((type (loop-collector-dtype lc)) (temp-var (car (loop-collector-tempvars lc)))) (multiple-value-bind (type init) @@ -1946,10 +1946,10 @@ code to be loaded. (let ((tag (gensym))) `(block nil (tagbody ,tag (progn ,@keywords-and-forms) (go ,tag)))))) -(sb!int:defmacro-mundanely loop (&environment env &rest keywords-and-forms) +(sb!xc:defmacro loop (&environment env &rest keywords-and-forms) (loop-standard-expansion keywords-and-forms env *loop-ansi-universe*)) -(sb!int:defmacro-mundanely loop-finish () +(sb!xc:defmacro loop-finish () #!+sb-doc "Cause the iteration to terminate \"normally\", the same as implicit termination by an iteration driving clause, or by use of WHILE or diff --git a/src/code/macros.lisp b/src/code/macros.lisp index 5857f81a6..3c2744efc 100644 --- a/src/code/macros.lisp +++ b/src/code/macros.lisp @@ -24,7 +24,7 @@ ;;; ;;; ASSERT-ERROR isn't defined until a later file because it uses the ;;; macro RESTART-CASE, which isn't defined until a later file. -(defmacro-mundanely assert (test-form &optional places datum &rest arguments +(sb!xc:defmacro assert (test-form &optional places datum &rest arguments &environment env) #!+sb-doc "Signals an error if the value of TEST-FORM is NIL. Returns NIL. @@ -114,7 +114,7 @@ ;;; ;;; CHECK-TYPE-ERROR isn't defined until a later file because it uses ;;; the macro RESTART-CASE, which isn't defined until a later file. -(defmacro-mundanely check-type (place type &optional type-string +(sb!xc:defmacro check-type (place type &optional type-string &environment env) #!+sb-doc "Signal a restartable error of type TYPE-ERROR if the value of PLACE @@ -144,7 +144,7 @@ invoked. In that case it will store into PLACE and start over." ;;;; DEFINE-SYMBOL-MACRO -(defmacro-mundanely define-symbol-macro (name expansion) +(sb!xc:defmacro define-symbol-macro (name expansion) `(eval-when (:compile-toplevel :load-toplevel :execute) (sb!c::%define-symbol-macro ',name ',expansion (sb!c:source-location)))) @@ -176,7 +176,7 @@ invoked. In that case it will store into PLACE and start over." ;;;; DEFINE-COMPILER-MACRO -(defmacro-mundanely define-compiler-macro (name lambda-list &body body) +(sb!xc:defmacro define-compiler-macro (name lambda-list &body body) #!+sb-doc "Define a compiler-macro for NAME." (legal-fun-name-or-type-error name) @@ -366,14 +366,14 @@ invoked. In that case it will store into PLACE and start over." `((t (case-failure ',name ,keyform-value ',keys)))))))) ) ; EVAL-WHEN -(defmacro-mundanely case (keyform &body cases) +(sb!xc:defmacro case (keyform &body cases) #!+sb-doc "CASE Keyform {({(Key*) | Key} Form*)}* Evaluates the Forms in the first clause with a Key EQL to the value of Keyform. If a singleton key is T then the clause is a default clause." (case-body 'case keyform cases t 'eql nil nil nil)) -(defmacro-mundanely ccase (keyform &body cases) +(sb!xc:defmacro ccase (keyform &body cases) #!+sb-doc "CCASE Keyform {({(Key*) | Key} Form*)}* Evaluates the Forms in the first clause with a Key EQL to the value of @@ -381,28 +381,28 @@ invoked. In that case it will store into PLACE and start over." signalled." (case-body 'ccase keyform cases t 'eql t t t)) -(defmacro-mundanely ecase (keyform &body cases) +(sb!xc:defmacro ecase (keyform &body cases) #!+sb-doc "ECASE Keyform {({(Key*) | Key} Form*)}* Evaluates the Forms in the first clause with a Key EQL to the value of Keyform. If none of the keys matches then an error is signalled." (case-body 'ecase keyform cases t 'eql t nil t)) -(defmacro-mundanely typecase (keyform &body cases) +(sb!xc:defmacro typecase (keyform &body cases) #!+sb-doc "TYPECASE Keyform {(Type Form*)}* Evaluates the Forms in the first clause for which TYPEP of Keyform and Type is true." (case-body 'typecase keyform cases nil 'typep nil nil nil)) -(defmacro-mundanely ctypecase (keyform &body cases) +(sb!xc:defmacro ctypecase (keyform &body cases) #!+sb-doc "CTYPECASE Keyform {(Type Form*)}* Evaluates the Forms in the first clause for which TYPEP of Keyform and Type is true. If no form is satisfied then a correctable error is signalled." (case-body 'ctypecase keyform cases nil 'typep t t t)) -(defmacro-mundanely etypecase (keyform &body cases) +(sb!xc:defmacro etypecase (keyform &body cases) #!+sb-doc "ETYPECASE Keyform {(Type Form*)}* Evaluates the Forms in the first clause for which TYPEP of Keyform and Type @@ -413,7 +413,7 @@ invoked. In that case it will store into PLACE and start over." ;;; correct one based on the value of VAR. This was originally used ;;; only for strings, hence the name. Renaming it to something more ;;; generic might not be a bad idea. -(defmacro-mundanely string-dispatch ((&rest types) var &body body) +(sb!xc:defmacro string-dispatch ((&rest types) var &body body) (let ((fun (sb!xc:gensym "STRING-DISPATCH-FUN"))) `(flet ((,fun (,var) ,@body)) @@ -426,7 +426,7 @@ invoked. In that case it will store into PLACE and start over." ;;;; WITH-FOO i/o-related macros -(defmacro-mundanely with-open-stream ((var stream) &body forms-decls) +(sb!xc:defmacro with-open-stream ((var stream) &body forms-decls) (multiple-value-bind (forms decls) (parse-body forms-decls nil) (let ((abortp (gensym))) `(let ((,var ,stream) @@ -439,12 +439,12 @@ invoked. In that case it will store into PLACE and start over." (when ,var (close ,var :abort ,abortp))))))) -(defmacro-mundanely with-open-file ((stream filespec &rest options) +(sb!xc:defmacro with-open-file ((stream filespec &rest options) &body body) `(with-open-stream (,stream (open ,filespec ,@options)) ,@body)) -(defmacro-mundanely with-input-from-string ((var string &key index start end) +(sb!xc:defmacro with-input-from-string ((var string &key index start end) &body forms-decls) (multiple-value-bind (forms decls) (parse-body forms-decls nil) `(let ((,var @@ -463,7 +463,7 @@ invoked. In that case it will store into PLACE and start over." ,@(when index `((setf ,index (string-input-stream-current ,var)))))))) -(defmacro-mundanely with-output-to-string +(sb!xc:defmacro with-output-to-string ((var &optional string &key (element-type ''character)) &body forms-decls) (multiple-value-bind (forms decls) (parse-body forms-decls nil) @@ -492,7 +492,7 @@ invoked. In that case it will store into PLACE and start over." ;;;; miscellaneous macros -(defmacro-mundanely nth-value (n form &environment env) +(sb!xc:defmacro nth-value (n form &environment env) #!+sb-doc "Evaluate FORM and return the Nth value (zero based) without consing a temporary list of values." @@ -518,7 +518,7 @@ invoked. In that case it will store into PLACE and start over." (lambda (n &rest list) (nth (truly-the index n) list)) (the index ,n) ,form)))) -(defmacro-mundanely declaim (&rest specs) +(sb!xc:defmacro declaim (&rest specs) #!+sb-doc "DECLAIM Declaration* Do a declaration or declarations for the global environment." @@ -530,7 +530,7 @@ invoked. In that case it will store into PLACE and start over." ;; Avoid unknown return values in emitted code for PRINT-UNREADABLE-OBJECT (declaim (ftype (sfunction (t t t t &optional t) null) %print-unreadable-object)) -(defmacro-mundanely print-unreadable-object ((object stream &key type identity) +(sb!xc:defmacro print-unreadable-object ((object stream &key type identity) &body body) #!+sb-doc "Output OBJECT to STREAM with \"#<\" prefix, \">\" suffix, optionally @@ -543,7 +543,7 @@ invoked. In that case it will store into PLACE and start over." `(dx-flet ((,fun () ,@body)) (,@call #',fun))) call))) -(defmacro-mundanely ignore-errors (&rest forms) +(sb!xc:defmacro ignore-errors (&rest forms) #!+sb-doc "Execute FORMS handling ERROR conditions, returning the result of the last form, or (VALUES NIL the-ERROR-that-was-caught) if an ERROR was handled." diff --git a/src/code/package.lisp b/src/code/package.lisp index 5070b1d8d..054ed9881 100644 --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -115,7 +115,7 @@ (tagbody ,@forms (go ,next)) (return ,result-form)))))))))) -(defmacro-mundanely do-symbols ((var &optional +(sb!xc:defmacro do-symbols ((var &optional (package '*package*) result-form) &body body-decls) @@ -127,7 +127,7 @@ :internal :external :inherited) var body-decls result-form)) -(defmacro-mundanely do-external-symbols ((var &optional +(sb!xc:defmacro do-external-symbols ((var &optional (package '*package*) result-form) &body body-decls) @@ -138,7 +138,7 @@ (expand-iterator `((find-undeleted-package-or-lose ,package) :external) var body-decls result-form)) -(defmacro-mundanely do-all-symbols ((var &optional +(sb!xc:defmacro do-all-symbols ((var &optional result-form) &body body-decls) #!+sb-doc @@ -151,7 +151,7 @@ ;;;; WITH-PACKAGE-ITERATOR -(defmacro-mundanely with-package-iterator ((mname package-list +(sb!xc:defmacro with-package-iterator ((mname package-list &rest symbol-types) &body body) #!+sb-doc @@ -186,7 +186,7 @@ of :INHERITED :EXTERNAL :INTERNAL." (car (truly-the list ,pkglist)))))) ,@body)))))) -(defmacro-mundanely with-package-graph ((&key) &body forms) +(sb!xc:defmacro with-package-graph ((&key) &body forms) `(flet ((thunk () ,@forms)) (declare (dynamic-extent #'thunk)) (call-with-package-graph #'thunk))) diff --git a/src/code/setf.lisp b/src/code/setf.lisp index 9b7de22d5..cf4330042 100644 --- a/src/code/setf.lisp +++ b/src/code/setf.lisp @@ -149,7 +149,7 @@ (list form))) forms))) - (defmacro-mundanely setf (&whole form &rest args &environment env) + (sb!xc:defmacro setf (&whole form &rest args &environment env) #!+sb-doc "Takes pairs of arguments like SETQ. The first is a place and the second is the value that is supposed to go into that place. Returns the last @@ -181,7 +181,7 @@ ;; various SETF-related macros - (defmacro-mundanely shiftf (&whole form &rest args &environment env) + (sb!xc:defmacro shiftf (&whole form &rest args &environment env) #!+sb-doc "One or more SETF-style place expressions, followed by a single value expression. Evaluates all of the expressions in turn, then @@ -245,7 +245,7 @@ setters))) `(,@setters nil)))) - (defmacro-mundanely psetf (&rest pairs &environment env) + (sb!xc:defmacro psetf (&rest pairs &environment env) #!+sb-doc "This is to SETF as PSETQ is to SETQ. Args are alternating place expressions and values to go into those places. All of the subforms and @@ -253,7 +253,7 @@ updated. Returns NIL." (expand pairs env 'psetf 'setf)) - (defmacro-mundanely psetq (&rest pairs &environment env) + (sb!xc:defmacro psetq (&rest pairs &environment env) #!+sb-doc "PSETQ {var value}* Set the variables to the values, like SETQ, except that assignments @@ -266,7 +266,7 @@ ;;; definition in the cross-compiler itself, so that after that, any ;;; ROTATEF operations can no longer be compiled, because ;;; GET-SETF-EXPANSION is called instead of SB!XC:GET-SETF-EXPANSION. -(defmacro-mundanely rotatef (&rest args &environment env) +(sb!xc:defmacro rotatef (&rest args &environment env) #!+sb-doc "Takes any number of SETF-style place expressions. Evaluates all of the expressions in turn, then assigns to each place the value of the form to @@ -291,7 +291,7 @@ `(let* ,(reduce #'append(let*-bindings)) ,@(thunk (mv-bindings) (cdr (getters)))))))) -(defmacro-mundanely push (obj place &environment env) +(sb!xc:defmacro push (obj place &environment env) #!+sb-doc "Takes an object and a location holding a list. Conses the object onto the list, returning the modified list. OBJ is evaluated before PLACE." @@ -302,7 +302,7 @@ ;; - At least two produce an incorrect expansion that doesn't even work. (expand-rmw-macro 'cons (list obj) place '() nil env '(item))) -(defmacro-mundanely pushnew (obj place &rest keys &environment env) +(sb!xc:defmacro pushnew (obj place &rest keys &environment env) #!+sb-doc "Takes an object and a location holding a list. If the object is already in the list, does nothing; otherwise, conses the object onto @@ -314,7 +314,7 @@ ;; The spec only mentions that ITEM is eval'd before PLACE. (expand-rmw-macro 'adjoin (list obj) place keys nil env '(item))) -(defmacro-mundanely pop (place &environment env) +(sb!xc:defmacro pop (place &environment env) #!+sb-doc "The argument is a location holding a list. Pops one item off the front of the list and returns it." @@ -332,7 +332,7 @@ ,setter ,ret))))) -(defmacro-mundanely remf (place indicator &environment env) +(sb!xc:defmacro remf (place indicator &environment env) #!+sb-doc "Place may be any place expression acceptable to SETF, and is expected to hold a property list or (). This list is destructively altered to @@ -386,13 +386,13 @@ (,(car newval) (,operator ,delta ,getter)) ,@(cdr newval)) ,setter))))) - (defmacro-mundanely incf (place &optional (delta 1) &environment env) + (sb!xc:defmacro incf (place &optional (delta 1) &environment env) #!+sb-doc "The first argument is some location holding a number. This number is incremented by the second argument, DELTA, which defaults to 1." (expand place delta env '+)) - (defmacro-mundanely decf (place &optional (delta 1) &environment env) + (sb!xc:defmacro decf (place &optional (delta 1) &environment env) #!+sb-doc "The first argument is some location holding a number. This number is decremented by the second argument, DELTA, which defaults to 1." diff --git a/src/cold/chill.lisp b/src/cold/chill.lisp index 9c9df4462..59f8f2c9d 100644 --- a/src/cold/chill.lisp +++ b/src/cold/chill.lisp @@ -63,7 +63,7 @@ (export '(sb-disassem::!begin-instruction-definitions) 'sb-disassem) -(export '(sb-int::def!method sb-int::defmacro-mundanely +(export '(sb-int::def!method sb-int::!cold-init-forms sb-int::!coerce-to-specialized sb-int::/show sb-int::/noshow sb-int::/show0 sb-int::/noshow0 @@ -71,8 +71,6 @@ 'sb-int) (setf (macro-function 'sb-int:def!method) (macro-function 'defmethod)) -(defmacro sb-int:defmacro-mundanely (name lambda-list &body body) - `(let () (defmacro ,name ,lambda-list ,@body))) (defmacro sb-int:!cold-init-forms (&rest forms) `(progn ,@forms)) diff --git a/src/compiler/defconstant.lisp b/src/compiler/defconstant.lisp index 5ce6096bb..b19d7bc5e 100644 --- a/src/compiler/defconstant.lisp +++ b/src/compiler/defconstant.lisp @@ -125,9 +125,9 @@ ;; the symbols which ANSI requires to be exported from CL. * Make a ;; nickname SB!CL which behaves like SB!XC. * Go through the ;; loaded-on-the-host code making every target definition be in SB-CL. - ;; E.g. DEFMACRO-MUNDANELY DEFCONSTANT becomes DEFMACRO-MUNDANELY - ;; SB!CL:DEFCONSTANT. * Make IN-TARGET-COMPILATION-MODE do UNUSE-PACKAGE - ;; CL and USE-PACKAGE SB-CL in each of the target packages (then undo it + ;; E.g. SB!XC:DEFMACRO DEFCONSTANT becomes SB!XC:DEFMACRO SB!CL:DEFCONSTANT. + ;; * Make IN-TARGET-COMPILATION-MODE do UNUSE-PACKAGE CL and + ;; USE-PACKAGE SB-CL in each of the target packages (then undo it ;; on exit). * Make the cross-compiler's implementation of EVAL-WHEN ;; (:COMPILE-TOPLEVEL) do UNCROSS. (This may not require any change.) * ;; Hack GENESIS as necessary so that it outputs SB-CL stuff as COMMON-LISP -- 2.11.4.GIT