src/compiler/early-c.lisp

   1 ;;;; This file contains compiler code and compiler-related stuff which
   2 ;;;; can be built early on. Some of the stuff may be here because it's
   3 ;;;; needed early on, some other stuff (e.g. constants) just because
   4 ;;;; it might as well be done early so we don't have to think about
   5 ;;;; whether it's done early enough.
   6
   7 ;;;; This software is part of the SBCL system. See the README file for
   8 ;;;; more information.
   9 ;;;;
  10 ;;;; This software is derived from the CMU CL system, which was
  11 ;;;; written at Carnegie Mellon University and released into the
  12 ;;;; public domain. The software is in the public domain and is
  13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  14 ;;;; files for more information.
  15
  16 (in-package "SB!C")
  17
  18 ;;; FIXME: Shouldn't SB!C::&MORE be in this list?
  19 (defconstant-eqx sb!xc:lambda-list-keywords
  20   '(&optional &rest &key &aux &body &whole &allow-other-keys &environment)
  21   #!+sb-doc
  22   #'equal
  23   "symbols which are magical in a lambda list")
  24 \f
  25 ;;;; cross-compiler-only versions of CL special variables, so that we
  26 ;;;; don't have weird interactions with the host compiler
  27
  28 (defvar sb!xc:*compile-file-pathname*)
  29 (defvar sb!xc:*compile-file-truename*)
  30 (defvar sb!xc:*compile-print*)
  31 (defvar sb!xc:*compile-verbose*)
  32 \f
  33 ;;;; miscellaneous types used both in the cross-compiler and on the target
  34
  35 ;;;; FIXME: The INDEX and LAYOUT-DEPTHOID definitions probably belong
  36 ;;;; somewhere else, not "early-c", since they're after all not part
  37 ;;;; of the compiler.
  38
  39 ;;; the type of LAYOUT-DEPTHOID slot values
  40 (def!type sb!kernel::layout-depthoid () '(or index (integer -1 -1)))
  41
  42 ;;; a value for an optimization declaration
  43 (def!type policy-quality () '(or (rational 0 3) null))
  44 \f
  45 ;;;; policy stuff
  46
  47 ;;; CMU CL used a special STRUCTURE-OBJECT type POLICY to represent
  48 ;;; the state of optimization policy at any point in compilation. This
  49 ;;; became a little unwieldy, especially because of cold init issues
  50 ;;; for structures and structure accessors, so in SBCL we use an alist
  51 ;;; instead.
  52 (deftype policy () 'list)
  53
  54 ;;; names of recognized optimization qualities which don't have
  55 ;;; special defaulting behavior
  56 (defvar *policy-basic-qualities*)
  57
  58 ;;; FIXME: I'd like to get rid of DECLAIM OPTIMIZE-INTERFACE in favor
  59 ;;; of e.g. (DECLAIM (OPTIMIZE (INTERFACE-SPEED 2) (INTERFACE-SAFETY 3))).
  60 #|
  61 ;;; a list of conses (DEFAULTING-QUALITY . DEFAULT-QUALITY) of qualities
  62 ;;; which default to other qualities when undefined, e.g. interface
  63 ;;; speed defaulting to basic speed
  64 (defvar *policy-defaulting-qualities*)
  65 |#
  66
  67 (defun optimization-quality-p (name)
  68   (or (member name *policy-basic-qualities*)
  69       ;; FIXME: Uncomment this when OPTIMIZE-INTERFACE goes away.
  70       #|(member name *policy-defaulting-qualities* :key #'car)|#))
  71
  72 ;;; *DEFAULT-POLICY* holds the current global compiler policy
  73 ;;; information, as an alist mapping from optimization quality name to
  74 ;;; quality value. Inside the scope of declarations, new entries are
  75 ;;; added at the head of the alist.
  76 ;;;
  77 ;;; *DEFAULT-INTERFACE-POLICY* holds any values specified by an
  78 ;;; OPTIMIZE-INTERFACE declaration.
  79 (declaim (type policy *default-policy* *default-interface-policy*))
  80 (defvar *default-policy*)          ; initialized in cold init
  81 (defvar *default-interface-policy*) ; initialized in cold init
  82
  83 ;;; This is to be called early in cold init to set things up, and may
  84 ;;; also be called again later in cold init in order to reset default
  85 ;;; optimization policy back to default values after toplevel PROCLAIM
  86 ;;; OPTIMIZE forms have messed with it.
  87 (defun !policy-cold-init-or-resanify ()
  88   (setf *policy-basic-qualities*
  89         '(;; ANSI standard qualities
  90           compilation-speed
  91           debug
  92           safety
  93           space
  94           speed
  95           ;; SBCL extensions
  96           ;;
  97           ;; FIXME: INHIBIT-WARNINGS is a misleading name for this.
  98           ;; Perhaps BREVITY would be better. But the ideal name would
  99           ;; have connotations of suppressing not warnings but only
 100           ;; optimization-related notes, which is already mostly the
 101           ;; behavior, and should probably become the exact behavior.
 102           ;; Perhaps INHIBIT-NOTES?
 103           inhibit-warnings))
 104   (setf *policy-defaulting-qualities*
 105         '((interface-speed . speed)
 106           (interface-safety . safety)))
 107   (setf *default-policy*
 108         (mapcar (lambda (name)
 109                   ;; CMU CL didn't use 1 as the default for everything,
 110                   ;; but since ANSI says 1 is the ordinary value, we do.
 111                   (cons name 1))
 112                 *policy-basic-qualities*))
 113   (setf *default-interface-policy*
 114         *default-policy*))
 115 ;;; On the cross-compilation host, we initialize the compiler immediately.
 116 #+sb-xc-host (!policy-cold-init-or-resanify)
 117
 118 ;;; Is X the name of an optimization quality?
 119 (defun policy-quality-p (x)
 120   (memq x *policy-basic-qualities*))
 121 \f
 122 ;;; possible values for the INLINE-ness of a function.
 123 (deftype inlinep ()
 124   '(member :inline :maybe-inline :notinline nil))
 125 (defparameter *inlinep-translations*
 126   '((inline . :inline)
 127     (notinline . :notinline)
 128     (maybe-inline . :maybe-inline)))
 129
 130 ;;; The lexical environment we are currently converting in.
 131 (defvar *lexenv*)
 132 (declaim (type lexenv *lexenv*))
 133
 134 ;;; *FREE-VARIABLES* translates from the names of variables referenced
 135 ;;; globally to the LEAF structures for them. *FREE-FUNCTIONS* is like
 136 ;;; *FREE-VARIABLES*, only it deals with function names.
 137 (defvar *free-variables*)
 138 (defvar *free-functions*)
 139 (declaim (hash-table *free-variables* *free-functions*))
 140
 141 ;;; We use the same Constant structure to represent all equal anonymous
 142 ;;; constants. This hashtable translates from constants to the Leafs that
 143 ;;; represent them.
 144 (defvar *constants*)
 145 (declaim (hash-table *constants*))
 146
 147 ;;; miscellaneous forward declarations
 148 (defvar *code-segment*)
 149 #!+sb-dyncount (defvar *collect-dynamic-statistics*)
 150 (defvar *component-being-compiled*)
 151 (defvar *compiler-error-context*)
 152 (defvar *compiler-error-count*)
 153 (defvar *compiler-warning-count*)
 154 (defvar *compiler-style-warning-count*)
 155 (defvar *compiler-note-count*)
 156 (defvar *converting-for-interpreter*)
 157 (defvar *count-vop-usages*)
 158 (defvar *current-path*)
 159 (defvar *current-component*)
 160 (defvar *default-policy*)
 161 (defvar *default-interface-policy*)
 162 (defvar *dynamic-counts-tn*)
 163 (defvar *elsewhere*)
 164 (defvar *event-info*)
 165 (defvar *event-note-threshold*)
 166 (defvar *failure-p*)
 167 (defvar *fixups*)
 168 (defvar *in-pack*)
 169 (defvar *info-environment*)
 170 (defvar *lexenv*)
 171 (defvar *source-info*)
 172 (defvar *trace-table*)
 173 (defvar *undefined-warnings*)
 174 (defvar *warnings-p*)
 175 \f
 176 ;;;; miscellaneous utilities
 177
 178 ;;; Delete any undefined warnings for NAME and KIND. This is for the
 179 ;;; benefit of the compiler, but it's sometimes called from stuff like
 180 ;;; type-defining code which isn't logically part of the compiler.
 181 (declaim (ftype (function ((or symbol cons) keyword) (values))
 182                 note-name-defined))
 183 (defun note-name-defined (name kind)
 184   ;; We do this BOUNDP check because this function can be called when
 185   ;; not in a compilation unit (as when loading top-level forms).
 186   (when (boundp '*undefined-warnings*)
 187     (setq *undefined-warnings*
 188           (delete-if (lambda (x)
 189                        (and (equal (undefined-warning-name x) name)
 190                             (eq (undefined-warning-kind x) kind)))
 191                      *undefined-warnings*)))
 192   (values))
 193
 194 ;;; to be called when a variable is lexically bound
 195 (declaim (ftype (function (symbol) (values)) note-lexical-binding))
 196 (defun note-lexical-binding (symbol)
 197   (let ((name (symbol-name symbol)))
 198     ;; This check is intended to protect us from getting silently
 199     ;; burned when we define
 200     ;;   foo.lisp:
 201     ;;     (DEFVAR *FOO* -3)
 202     ;;     (DEFUN FOO (X) (+ X *FOO*))
 203     ;;   bar.lisp:
 204     ;;     (DEFUN BAR (X)
 205     ;;       (LET ((*FOO* X))
 206     ;;         (FOO 14)))
 207     ;; and then we happen to compile bar.lisp before foo.lisp.
 208     (when (and (char= #\* (aref name 0))
 209                (char= #\* (aref name (1- (length name)))))
 210       ;; FIXME: should be COMPILER-STYLE-WARNING?
 211       (style-warn "using the lexical binding of the symbol ~S, not the~@
 212 dynamic binding, even though the symbol name follows the usual naming~@
 213 convention (names like *FOO*) for special variables" symbol)))
 214   (values))