src/code/early-fasl.lisp

   1 ;;;; needed-early, or at least meaningful-early, stuff for FASL files
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!FASL")
  13 \f
  14 ;;;; various constants and essentially-constants
  15
  16 (defun fasl-target-features ()
  17   #+sb-xc-host sb-cold:*shebang-features*
  18   #-sb-xc-host *features*)
  19
  20 ;;; a string which appears at the start of a fasl file header
  21 ;;;
  22 ;;; This value is used to identify fasl files. Even though this is not
  23 ;;; declared as a constant (because ANSI Common Lisp has no facility
  24 ;;; for declaring values which are constant under EQUAL but not EQL),
  25 ;;; obviously you shouldn't mess with it lightly. If you do set a new
  26 ;;; value for some reason, keep these things in mind:
  27 ;;; * To avoid confusion with the similar but incompatible CMU CL
  28 ;;;   fasl file format, the value should not be "FASL FILE", which
  29 ;;;   is what CMU CL used for the same purpose.
  30 ;;; * Since its presence at the head of a file is used by LOAD to
  31 ;;;   decide whether a file is to be fasloaded or just loaded
  32 ;;;   ordinarily (as source), the value should be something which
  33 ;;;   can't legally appear at the head of a Lisp source file.
  34 ;;; * The value should not contain any line-terminating characters,
  35 ;;;   because they're hard to express portably and because the LOAD
  36 ;;;   code might reasonably use READ-LINE to get the value to compare
  37 ;;;   against.
  38 (defglobal *fasl-header-string-start-string* "# FASL")
  39
  40 ;;; a list of *(SHEBANG-)FEATURES* flags which affect binary compatibility,
  41 ;;; i.e. which must be the same between the SBCL which compiled the code
  42 ;;; and the SBCL which executes the code. This is a property of SBCL executables
  43 ;;; in the abstract, not of this particular SBCL executable,
  44 ;;; so any flag in this list may or may not be present
  45 ;;; in the *FEATURES* list of this particular build.
  46 (defglobal *features-potentially-affecting-fasl-format*
  47     (append '(:sb-thread :sb-package-locks :sb-unicode :cheneygc
  48               :gencgc :msan :sb-safepoint :sb-safepoint-strictly)
  49             #!+(or x86 x86-64) '(:int4-breakpoints :ud2-breakpoints)))
  50
  51 ;;; Return a string representing symbols in *FEATURES-POTENTIALLY-AFFECTING-FASL-FORMAT*
  52 ;;; which are present in a particular compilation.
  53 (defun compute-features-affecting-fasl-format ()
  54   (let ((list (sort (copy-list (intersection *features-potentially-affecting-fasl-format*
  55                                              (fasl-target-features)))
  56                     #'string< :key #'symbol-name)))
  57     ;; Stringify the subset of *FEATURES* that affect fasl format.
  58     ;; A list would be the natural representation choice for this, but a string
  59     ;; is convenient for and a requirement for writing to and reading from fasls
  60     ;; at this stage of the loading. WITH-STANDARD-IO-SYNTAX and WRITE-TO-STRING
  61     ;; would work, but this is simple enough to do by hand.
  62     (with-simple-output-to-string (stream)
  63       (let ((delimiter #\())
  64         (dolist (symbol list)
  65           (write-char delimiter stream)
  66           (write-string (string symbol) stream)
  67           (setq delimiter #\Space)))
  68       (write-char #\) stream))))
  69
  70 #-sb-xc-host
  71 (eval-when (:compile-toplevel)
  72   (let ((string (compute-features-affecting-fasl-format)))
  73     (assert (and (> (length string) 2)
  74                  (not (find #\newline string))
  75                  (not (find #\# string))
  76                  (not (search ".." string))))))
  77
  78 ;;; the code for a character which terminates a fasl file header
  79 (defconstant +fasl-header-string-stop-char-code+ 255)
  80
  81 ;;; This value should be incremented when the system changes in such a
  82 ;;; way that it will no longer work reliably with old fasl files. In
  83 ;;; practice, I (WHN) have often forgotten to increment it for CVS
  84 ;;; versions which break binary compatibility. But it certainly should
  85 ;;; be incremented for release versions which break binary
  86 ;;; compatibility.
  87 (defconstant +fasl-file-version+ 78)
  88 ;;; (description of versions before 0.9.0.1 deleted in 0.9.17)
  89 ;;; 56: (2005-05-22) Something between 0.9.0.1 and 0.9.0.14. My money is
  90 ;;;     on 0.9.0.6 (MORE CASE CONSISTENCY).
  91 ;;; 57: (2005-06-12) Raw slot rearrangement in 0.9.1.38
  92 ;;; 58: (2005-08-16) Multiple incompatible changes between 0.9.3 and 0.9.3.60
  93 ;;; 59: (2005-09-18) METAOBJECT implementation, removal of INSTANCE and
  94 ;;;     FUNCALLABLE-INSTANCE classes.
  95 ;;; 60: (2005-10-24) Bumped for 0.9.6
  96 ;;; 61: (2005-11-06) Improved source location recording added extra parameters
  97 ;;;     to multiple %DEFMUMBLE functions.
  98 ;;; 62: (2005-12-30) Make the count of FASL header counted strings
  99 ;;;     a 32-bit value also on 64-bit platforms.
 100 ;;; 63: (2006-01-27) Shuffle storage classes around to reduce the error
 101 ;;;     trap information size on RISCy platforms.
 102 ;;; 64: (2006-03-24) New calling convention for unknown-values on x86 and
 103 ;;;     x86-64.  Also (belatedly) PPC/gencgc, including :gencgc on FPAFF.
 104 ;;; 65: (2006-04-11) Package locking interface changed.
 105 ;;; 66: (2006-05-13) Fopcompiler
 106 ;;; 67: (2006-07-25) Reports on #lisp about 0.9.13 fasls being invalid on
 107 ;;;     0.9.14.something
 108 ;;; 68: (2006-08-14) changed number of arguments of LOAD-DEFMETHOD
 109 ;;; 69: (2006-08-17) changed validity of various initargs for methods
 110 ;;; 70: (2006-09-13) changes to *PSEUDO-ATOMIC* on x86 and x86-64
 111 ;;; 71: (2006-11-19) CLOS calling convention changes
 112 ;;; 72: (2006-12-05) Added slot to the primitive function type
 113 ;;; 73: (2007-04-13) Changed a hash function
 114 ;;; 74: (2007-06-05) UNWIND-TO-FRAME-AND-CALL
 115 ;;; 75: (2007-08-06) FD-STREAM layout changes
 116 ;;; 76: (2007-10-05) MUTEX layout changes
 117 ;;; 77: (2007-11-08) Essentially obsolete fasl-file-version, fasls are now
 118 ;;;     considered compatible only when the version numbers of the compiling
 119 ;;;     SBCL instance is exactly the same as the one of the loading instance.
 120 ;;;     Further fasl-file-version bumps should only be done for real changes
 121 ;;;     in the fasl format, not for changes in function/macro signatures or
 122 ;;;     lisp data structures.
 123 ;;; 78: (2010-04-02) Add FOP-{SMALL-,}NAMED-PACKAGE, remove FOP-NORMAL-LOAD
 124 ;;;     and FOP-MAYBE-COLD-LOAD.
 125
 126 ;;; the conventional file extension for our fasl files
 127 (declaim (type simple-string *fasl-file-type*))
 128 (defvar *fasl-file-type* "fasl")
 129 \f
 130 ;;;; information about below-Lisp-level linkage
 131
 132 ;;; Note:
 133 ;;;   Assembler routines are named by full Lisp symbols: they
 134 ;;;     have packages and that sort of native Lisp stuff associated
 135 ;;;     with them. We can compare them with EQ.
 136 (defglobal *assembler-routines* nil)
 137
 138 \f
 139 ;;;; the FOP database
 140
 141 ;;; a vector indexed by a FaslOP that yields a function which performs
 142 ;;; the operation. Most functions take 0 arguments - they only manipulate
 143 ;;; the fop stack. But if the fop is defined to receive an argument (or two)
 144 ;;; then loader's main loop is responsible for supplying it.
 145 (defglobal **fop-funs** (make-array 256 :initial-element 0))
 146 (declaim (simple-vector **fop-funs**))
 147
 148 ;;; Two arrays indicate fop function signature.
 149 ;;; The first array indicates how many integer operands follow the opcode.
 150 ;;; The second tells whether the fop wants its result pushed on the stack.
 151 (declaim (type (cons (simple-array (mod 4) (256)) (simple-bit-vector 256))
 152                **fop-signatures**))
 153 (defglobal **fop-signatures**
 154     (cons (make-array 256 :element-type '(mod 4) :initial-element 0)
 155           (make-array 256 :element-type 'bit :initial-element 0)))
 156 \f
 157 ;;;; variables
 158
 159 (defvar *load-depth* 0
 160   "the current number of recursive LOADs")
 161 (declaim (type index *load-depth*))
 162
 163 (defun make-fop-vector (size)
 164   (declare (type index size))
 165   (let ((vector (make-array size)))
 166     (setf (aref vector 0) 0)
 167     vector))
 168
 169 ;;; a holder for the FASL file we're reading from
 170 (defstruct (fasl-input (:conc-name %fasl-input-)
 171                        (:constructor make-fasl-input (stream))
 172                        (:predicate nil)
 173                        (:copier nil))
 174   (stream nil :type ansi-stream :read-only t)
 175   (table (make-fop-vector 1000) :type simple-vector)
 176   (stack (make-fop-vector 100) :type simple-vector)
 177   (name-buffer (vector (make-string  1 :element-type 'character)
 178                        (make-string 31 :element-type 'base-char)))
 179   (deprecated-stuff nil :type list)
 180   ;; Sometimes we want to skip over any FOPs with side-effects (like
 181   ;; function calls) while executing other FOPs. SKIP-UNTIL will
 182   ;; either contain the position where the skipping will stop, or
 183   ;; NIL if we're executing normally.
 184   (skip-until nil))
 185 (declaim (freeze-type fasl-input))