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                     "WITH-COMPILATION-UNIT"))
 127       (export (intern name package-name) package-name)))
 128   ;; don't watch:
 129   (dolist (package-name '("SB!ALIEN"
 130                           "SB!ALIEN-INTERNALS"
 131                           "SB!ASSEM"
 132                           "SB!BIGNUM"
 133                           "SB!C"
 134                           "SB!DEBUG"
 135                           "SB!DI"
 136                           "SB!DISASSEM"
 137                           #!+sb-dyncount "SB!DYNCOUNT"
 138                           "SB!FASL"
 139                           "SB!IMPL"
 140                           "SB!EXT"
 141                           "SB!FORMAT"
 142                           "SB!GRAY"
 143                           "SB!INT"
 144                           "SB!KERNEL"
 145                           "SB!LOOP"
 146                           "SB!PCL"
 147                           "SB!PRETTY"
 148                           "SB!PROFILE"
 149                           "SB!SYS"
 150                           "SB!UNIX"
 151                           "SB!VM"
 152                           "SB!WALKER"))
 153     (shadowing-import (mapcar (lambda (name) (find-symbol name "SB-XC"))
 154                               '("BYTE" "BYTE-POSITION" "BYTE-SIZE"
 155                                 "DPB" "LDB" "LDB-TEST"
 156                                 "DEPOSIT-FIELD" "MASK-FIELD"))
 157                       package-name))
 158
 159   ;; Build a version of Python to run in the host Common Lisp, to be
 160   ;; used only in cross-compilation.
 161   ;;
 162   ;; Note that files which are marked :ASSEM, to cause them to be
 163   ;; processed with SB!C:ASSEMBLE-FILE when we're running under the
 164   ;; cross-compiler or the target lisp, are still processed here, just
 165   ;; with the ordinary Lisp compiler, and this is intentional, in
 166   ;; order to make the compiler aware of the definitions of assembly
 167   ;; routines.
 168   (do-stems-and-flags (stem flags)
 169     (unless (find :not-host flags)
 170       (funcall load-or-cload-stem
 171                stem
 172                :ignore-failure-p (find :ignore-failure-p flags))
 173       #!+sb-show (warn-when-cl-snapshot-diff *cl-snapshot*)))
 174
 175   ;; If the cross-compilation host is SBCL itself, we can use the
 176   ;; PURIFY extension to freeze everything in place, reducing the
 177   ;; amount of work done on future GCs. In machines with limited
 178   ;; memory, this could help, by reducing the amount of memory which
 179   ;; needs to be juggled in a full GC. And it can hardly hurt, since
 180   ;; (in the ordinary build procedure anyway) essentially everything
 181   ;; which is reachable at this point will remain reachable for the
 182   ;; entire run.
 183   #+sbcl (sb-ext:purify)
 184
 185   (values))