src/cold/defun-load-or-cload-xcompiler.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB-COLD")
  11
  12 ;;; Either load or compile-then-load the cross-compiler into the
  13 ;;; cross-compilation host Common Lisp.
  14 (defun load-or-cload-xcompiler (load-or-cload-stem)
  15
  16   (declare (type function load-or-cload-stem))
  17
  18   ;; The running-in-the-host-Lisp Python cross-compiler defines its
  19   ;; own versions of a number of functions which should not overwrite
  20   ;; host-Lisp functions. Instead we put them in a special package.
  21   ;;
  22   ;; The common theme of the functions, macros, constants, and so
  23   ;; forth in this package is that they run in the host and affect the
  24   ;; compilation of the target.
  25   (let ((package-name "SB-XC"))
  26     (make-package package-name :use nil :nicknames nil)
  27     (dolist (name '(;; the constants (except for T and NIL which have
  28                     ;; a specially hacked correspondence between
  29                     ;; cross-compilation host Lisp and target Lisp)
  30                     "ARRAY-DIMENSION-LIMIT"
  31                     "ARRAY-RANK-LIMIT"
  32                     "ARRAY-TOTAL-SIZE-LIMIT"
  33                     "BOOLE-1"
  34                     "BOOLE-2"
  35                     "BOOLE-AND"
  36                     "BOOLE-ANDC1"
  37                     "BOOLE-ANDC2"
  38                     "BOOLE-C1"
  39                     "BOOLE-C2"
  40                     "BOOLE-CLR"
  41                     "BOOLE-EQV"
  42                     "BOOLE-IOR"
  43                     "BOOLE-NAND"
  44                     "BOOLE-NOR"
  45                     "BOOLE-ORC1"
  46                     "BOOLE-ORC2"
  47                     "BOOLE-SET"
  48                     "BOOLE-XOR"
  49                     "CALL-ARGUMENTS-LIMIT"
  50                     "CHAR-CODE-LIMIT"
  51                     "DOUBLE-FLOAT-EPSILON"
  52                     "DOUBLE-FLOAT-NEGATIVE-EPSILON"
  53                     "INTERNAL-TIME-UNITS-PER-SECOND"
  54                     "LAMBDA-LIST-KEYWORDS"
  55                     "LAMBDA-PARAMETERS-LIMIT"
  56                     "LEAST-NEGATIVE-DOUBLE-FLOAT"
  57                     "LEAST-NEGATIVE-LONG-FLOAT"
  58                     "LEAST-NEGATIVE-NORMALIZED-DOUBLE-FLOAT"
  59                     "LEAST-NEGATIVE-NORMALIZED-LONG-FLOAT"
  60                     "LEAST-NEGATIVE-NORMALIZED-SHORT-FLOAT"
  61                     "LEAST-NEGATIVE-NORMALIZED-SINGLE-FLOAT"
  62                     "LEAST-NEGATIVE-SHORT-FLOAT"
  63                     "LEAST-NEGATIVE-SINGLE-FLOAT"
  64                     "LEAST-POSITIVE-DOUBLE-FLOAT"
  65                     "LEAST-POSITIVE-LONG-FLOAT"
  66                     "LEAST-POSITIVE-NORMALIZED-DOUBLE-FLOAT"
  67                     "LEAST-POSITIVE-NORMALIZED-LONG-FLOAT"
  68                     "LEAST-POSITIVE-NORMALIZED-SHORT-FLOAT"
  69                     "LEAST-POSITIVE-NORMALIZED-SINGLE-FLOAT"
  70                     "LEAST-POSITIVE-SHORT-FLOAT"
  71                     "LEAST-POSITIVE-SINGLE-FLOAT"
  72                     "LONG-FLOAT-EPSILON"
  73                     "LONG-FLOAT-NEGATIVE-EPSILON"
  74                     "MOST-NEGATIVE-DOUBLE-FLOAT"
  75                     "MOST-NEGATIVE-FIXNUM"
  76                     "MOST-NEGATIVE-LONG-FLOAT"
  77                     "MOST-NEGATIVE-SHORT-FLOAT"
  78                     "MOST-NEGATIVE-SINGLE-FLOAT"
  79                     "MOST-POSITIVE-DOUBLE-FLOAT"
  80                     "MOST-POSITIVE-FIXNUM"
  81                     "MOST-POSITIVE-LONG-FLOAT"
  82                     "MOST-POSITIVE-SHORT-FLOAT"
  83                     "MOST-POSITIVE-SINGLE-FLOAT"
  84                     "MULTIPLE-VALUES-LIMIT"
  85                     "PI"
  86                     "SHORT-FLOAT-EPSILON"
  87                     "SHORT-FLOAT-NEGATIVE-EPSILON"
  88                     "SINGLE-FLOAT-EPSILON"
  89                     "SINGLE-FLOAT-NEGATIVE-EPSILON"
  90
  91                     ;; everything else which needs a separate
  92                     ;; existence in xc and target
  93                     "BUILT-IN-CLASS"
  94                     "BYTE" "BYTE-POSITION" "BYTE-SIZE"
  95                     "CLASS" "CLASS-NAME" "CLASS-OF"
  96                     "COMPILE-FILE"
  97                     "COMPILE-FILE-PATHNAME"
  98                     "*COMPILE-FILE-PATHNAME*"
  99                     "*COMPILE-FILE-TRUENAME*"
 100                     "*COMPILE-PRINT*"
 101                     "*COMPILE-VERBOSE*"
 102                     "COMPILER-MACRO-FUNCTION"
 103                     "CONSTANTP"
 104                     "DEFCONSTANT"
 105                     "DEFINE-MODIFY-MACRO"
 106                     "DEFINE-SETF-EXPANDER"
 107                     "DEFMACRO" "DEFSETF" "DEFSTRUCT" "DEFTYPE"
 108                     "DEPOSIT-FIELD" "DPB"
 109                     "FBOUNDP" "FDEFINITION" "FMAKUNBOUND"
 110                     "FIND-CLASS"
 111                     "GET-SETF-EXPANSION"
 112                     "LDB" "LDB-TEST"
 113                     "LISP-IMPLEMENTATION-TYPE" "LISP-IMPLEMENTATION-VERSION"
 114                     "MACRO-FUNCTION"
 115                     "MACROEXPAND" "MACROEXPAND-1" "*MACROEXPAND-HOOK*"
 116                     "MAKE-LOAD-FORM"
 117                     "MAKE-LOAD-FORM-SAVING-SLOTS"
 118                     "MASK-FIELD"
 119                     "PACKAGE" "PACKAGEP"
 120                     "PROCLAIM"
 121                     "SPECIAL-OPERATOR-P"
 122                     "STANDARD-CLASS"
 123                     "STRUCTURE-CLASS"
 124                     "SUBTYPEP"
 125                     "TYPE-OF" "TYPEP"
 126                     "UPGRADED-ARRAY-ELEMENT-TYPE"
 127                     "WITH-COMPILATION-UNIT"))
 128       (export (intern name package-name) package-name)))
 129   ;; don't watch:
 130   (dolist (package-name '("SB!ALIEN"
 131                           "SB!ALIEN-INTERNALS"
 132                           "SB!ASSEM"
 133                           "SB!BIGNUM"
 134                           "SB!C"
 135                           "SB!DEBUG"
 136                           "SB!DI"
 137                           "SB!DISASSEM"
 138                           #!+sb-dyncount "SB!DYNCOUNT"
 139                           "SB!FASL"
 140                           "SB!IMPL"
 141                           "SB!EXT"
 142                           "SB!FORMAT"
 143                           "SB!GRAY"
 144                           "SB!INT"
 145                           "SB!KERNEL"
 146                           "SB!LOOP"
 147                           "SB!PCL"
 148                           "SB!PRETTY"
 149                           "SB!PROFILE"
 150                           "SB!SYS"
 151                           "SB!THREAD"
 152                           "SB!UNIX"
 153                           "SB!VM"
 154                           "SB!WALKER"))
 155     (shadowing-import (mapcar (lambda (name) (find-symbol name "SB-XC"))
 156                               '("BYTE" "BYTE-POSITION" "BYTE-SIZE"
 157                                 "DPB" "LDB" "LDB-TEST"
 158                                 "DEPOSIT-FIELD" "MASK-FIELD"))
 159                       package-name))
 160
 161   ;; Build a version of Python to run in the host Common Lisp, to be
 162   ;; used only in cross-compilation.
 163   ;;
 164   ;; Note that files which are marked :ASSEM, to cause them to be
 165   ;; processed with SB!C:ASSEMBLE-FILE when we're running under the
 166   ;; cross-compiler or the target lisp, are still processed here, just
 167   ;; with the ordinary Lisp compiler, and this is intentional, in
 168   ;; order to make the compiler aware of the definitions of assembly
 169   ;; routines.
 170   (do-stems-and-flags (stem flags)
 171     (unless (find :not-host flags)
 172       (funcall load-or-cload-stem
 173                stem
 174                :ignore-failure-p (find :ignore-failure-p flags))
 175       #!+sb-show (warn-when-cl-snapshot-diff *cl-snapshot*)))
 176
 177   ;; If the cross-compilation host is SBCL itself, we can use the
 178   ;; PURIFY extension to freeze everything in place, reducing the
 179   ;; amount of work done on future GCs. In machines with limited
 180   ;; memory, this could help, by reducing the amount of memory which
 181   ;; needs to be juggled in a full GC. And it can hardly hurt, since
 182   ;; (in the ordinary build procedure anyway) essentially everything
 183   ;; which is reachable at this point will remain reachable for the
 184   ;; entire run.
 185   #+sbcl (sb-ext:purify)
 186
 187   (values))