X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fdefun-load-or-cload-xcompiler.lisp;h=b3e8e2ecd8669df21e42b26f4f55fbd37b6f55f6;hb=21e84b532732503bc7cf8bb006fc3e9812505dd5;hp=a861cb68a39767032bec3c8d6c72c0db41f93a2e;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/cold/defun-load-or-cload-xcompiler.lisp b/src/cold/defun-load-or-cload-xcompiler.lisp index a861cb6..b3e8e2e 100644 --- a/src/cold/defun-load-or-cload-xcompiler.lisp +++ b/src/cold/defun-load-or-cload-xcompiler.lisp @@ -9,12 +9,12 @@ (in-package "SB-COLD") -;;;; $Header$ - ;;; Either load or compile-then-load the cross-compiler into the ;;; cross-compilation host Common Lisp. (defun load-or-cload-xcompiler (load-or-cload-stem) + (declare (type function load-or-cload-stem)) + ;; The running-in-the-host-Lisp Python cross-compiler defines its ;; own versions of a number of functions which should not overwrite ;; host-Lisp functions. Instead we put them in a special package. @@ -24,40 +24,131 @@ ;; compilation of the target. (let ((package-name "SB-XC")) (make-package package-name :use nil :nicknames nil) - (dolist (name '("*COMPILE-FILE-PATHNAME*" - "*COMPILE-FILE-TRUENAME*" - "*COMPILE-PRINT*" - "*COMPILE-VERBOSE*" - "ARRAY-RANK-LIMIT" - "ARRAY-DIMENSION-LIMIT" - "ARRAY-TOTAL-SIZE-LIMIT" - "BUILT-IN-CLASS" - "CLASS" "CLASS-NAME" "CLASS-OF" - "COMPILE-FILE" - "COMPILE-FILE-PATHNAME" - "COMPILER-MACRO-FUNCTION" - "CONSTANTP" - "DEFCONSTANT" - "DEFINE-MODIFY-MACRO" - "DEFINE-SETF-EXPANDER" - "DEFMACRO" "DEFSETF" "DEFSTRUCT" "DEFTYPE" - "FBOUNDP" "FDEFINITION" "FMAKUNBOUND" - "FIND-CLASS" - "GET-SETF-EXPANSION" - "LAMBDA-LIST-KEYWORDS" - "LISP-IMPLEMENTATION-TYPE" "LISP-IMPLEMENTATION-VERSION" - "MACRO-FUNCTION" - "MACROEXPAND" "MACROEXPAND-1" "*MACROEXPAND-HOOK*" - "MAKE-LOAD-FORM" - "PACKAGE" "PACKAGEP" - "PROCLAIM" - "SPECIAL-OPERATOR-P" - "STANDARD-CLASS" - "STRUCTURE-CLASS" - "SUBTYPEP" - "TYPE-OF" "TYPEP" - "WITH-COMPILATION-UNIT")) + (dolist (name '(;; the constants (except for T and NIL which have + ;; a specially hacked correspondence between + ;; cross-compilation host Lisp and target Lisp) + "ARRAY-DIMENSION-LIMIT" + "ARRAY-RANK-LIMIT" + "ARRAY-TOTAL-SIZE-LIMIT" + "BOOLE-1" + "BOOLE-2" + "BOOLE-AND" + "BOOLE-ANDC1" + "BOOLE-ANDC2" + "BOOLE-C1" + "BOOLE-C2" + "BOOLE-CLR" + "BOOLE-EQV" + "BOOLE-IOR" + "BOOLE-NAND" + "BOOLE-NOR" + "BOOLE-ORC1" + "BOOLE-ORC2" + "BOOLE-SET" + "BOOLE-XOR" + "CALL-ARGUMENTS-LIMIT" + "CHAR-CODE-LIMIT" + "DOUBLE-FLOAT-EPSILON" + "DOUBLE-FLOAT-NEGATIVE-EPSILON" + "INTERNAL-TIME-UNITS-PER-SECOND" + "LAMBDA-LIST-KEYWORDS" + "LAMBDA-PARAMETERS-LIMIT" + "LEAST-NEGATIVE-DOUBLE-FLOAT" + "LEAST-NEGATIVE-LONG-FLOAT" + "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT" + "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT" + "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT" + "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT" + "LEAST-NEGATIVE-SHORT-FLOAT" + "LEAST-NEGATIVE-SINGLE-FLOAT" + "LEAST-POSITIVE-DOUBLE-FLOAT" + "LEAST-POSITIVE-LONG-FLOAT" + "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT" + "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT" + "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT" + "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT" + "LEAST-POSITIVE-SHORT-FLOAT" + "LEAST-POSITIVE-SINGLE-FLOAT" + "LONG-FLOAT-EPSILON" + "LONG-FLOAT-NEGATIVE-EPSILON" + "MOST-NEGATIVE-DOUBLE-FLOAT" + "MOST-NEGATIVE-FIXNUM" + "MOST-NEGATIVE-LONG-FLOAT" + "MOST-NEGATIVE-SHORT-FLOAT" + "MOST-NEGATIVE-SINGLE-FLOAT" + "MOST-POSITIVE-DOUBLE-FLOAT" + "MOST-POSITIVE-FIXNUM" + "MOST-POSITIVE-LONG-FLOAT" + "MOST-POSITIVE-SHORT-FLOAT" + "MOST-POSITIVE-SINGLE-FLOAT" + "MULTIPLE-VALUES-LIMIT" + "PI" + "SHORT-FLOAT-EPSILON" + "SHORT-FLOAT-NEGATIVE-EPSILON" + "SINGLE-FLOAT-EPSILON" + "SINGLE-FLOAT-NEGATIVE-EPSILON" + + ;; everything else which needs a separate + ;; existence in xc and target + "BOOLE" + "BOOLE-CLR" "BOOLE-SET" "BOOLE-1" "BOOLE-2" + "BOOLE-C1" "BOOLE-C2" "BOOLE-AND" "BOOLE-IOR" + "BOOLE-XOR" "BOOLE-EQV" "BOOLE-NAND" "BOOLE-NOR" + "BOOLE-ANDC1" "BOOLE-ANDC2" "BOOLE-ORC1" "BOOLE-ORC2" + "BUILT-IN-CLASS" + "BYTE" "BYTE-POSITION" "BYTE-SIZE" + "CHAR-CODE" + "CLASS" "CLASS-NAME" "CLASS-OF" + "CODE-CHAR" + "COMPILE-FILE" + "COMPILE-FILE-PATHNAME" + "*COMPILE-FILE-PATHNAME*" + "*COMPILE-FILE-TRUENAME*" + "*COMPILE-PRINT*" + "*COMPILE-VERBOSE*" + "COMPILER-MACRO-FUNCTION" + "CONSTANTP" + "DEFCONSTANT" + "DEFINE-MODIFY-MACRO" + "DEFINE-SETF-EXPANDER" + "DEFMACRO" "DEFSETF" "DEFSTRUCT" "DEFTYPE" + "DEPOSIT-FIELD" "DPB" + "FBOUNDP" "FDEFINITION" "FMAKUNBOUND" + "FIND-CLASS" + "GET-SETF-EXPANSION" + "LDB" "LDB-TEST" + "LISP-IMPLEMENTATION-TYPE" "LISP-IMPLEMENTATION-VERSION" + "MACRO-FUNCTION" + "MACROEXPAND" "MACROEXPAND-1" "*MACROEXPAND-HOOK*" + "MAKE-LOAD-FORM" + "MAKE-LOAD-FORM-SAVING-SLOTS" + "MASK-FIELD" + "PACKAGE" "PACKAGEP" + "PROCLAIM" + "SPECIAL-OPERATOR-P" + "STANDARD-CLASS" + "STRUCTURE-CLASS" + "SUBTYPEP" + "TYPE-OF" "TYPEP" + "UPGRADED-ARRAY-ELEMENT-TYPE" + "UPGRADED-COMPLEX-PART-TYPE" + "WITH-COMPILATION-UNIT")) (export (intern name package-name) package-name))) + ;; don't watch: + (dolist (package (list-all-packages)) + (when (= (mismatch (package-name package) "SB!") 3) + (shadowing-import + (mapcar (lambda (name) (find-symbol name "SB-XC")) + '("BYTE" "BYTE-POSITION" "BYTE-SIZE" + "DPB" "LDB" "LDB-TEST" + "DEPOSIT-FIELD" "MASK-FIELD" + + "BOOLE" + "BOOLE-CLR" "BOOLE-SET" "BOOLE-1" "BOOLE-2" + "BOOLE-C1" "BOOLE-C2" "BOOLE-AND" "BOOLE-IOR" + "BOOLE-XOR" "BOOLE-EQV" "BOOLE-NAND" "BOOLE-NOR" + "BOOLE-ANDC1" "BOOLE-ANDC2" "BOOLE-ORC1" "BOOLE-ORC2")) + package))) ;; Build a version of Python to run in the host Common Lisp, to be ;; used only in cross-compilation. @@ -68,11 +159,11 @@ ;; with the ordinary Lisp compiler, and this is intentional, in ;; order to make the compiler aware of the definitions of assembly ;; routines. - (for-stems-and-flags (stem flags) + (do-stems-and-flags (stem flags) (unless (find :not-host flags) (funcall load-or-cload-stem - stem - :ignore-failure-p (find :ignore-failure-p flags)) + stem + :ignore-failure-p (find :ignore-failure-p flags)) #!+sb-show (warn-when-cl-snapshot-diff *cl-snapshot*))) ;; If the cross-compilation host is SBCL itself, we can use the