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 (file-comment
  19   "$Header$")
  20
  21 ;;; FIXME: shouldn't SB-C::&MORE be in this list?
  22 (defconstant sb!xc:lambda-list-keywords
  23   '(&optional &rest &key &aux &body &whole &allow-other-keys &environment)
  24   #!+sb-doc
  25   "symbols which are magical in a lambda list")
  26 \f
  27 ;;;; cross-compiler-only versions of CL special variables, so that we
  28 ;;;; don't have weird interactions with the host compiler
  29
  30 (defvar sb!xc:*compile-file-pathname*)
  31 (defvar sb!xc:*compile-file-truename*)
  32 (defvar sb!xc:*compile-print*)
  33 (defvar sb!xc:*compile-verbose*)
  34 \f
  35 ;;;; miscellaneous types used both in the cross-compiler and on the target
  36
  37 ;;;; FIXME: The INDEX and LAYOUT-DEPTHOID definitions probably belong
  38 ;;;; somewhere else, not "early-c", since they're after all not part
  39 ;;;; of the compiler.
  40
  41 (def!type sb!kernel:index () `(integer 0 (,sb!xc:array-dimension-limit)))
  42
  43 ;;; the type of LAYOUT-DEPTHOID slot values
  44 (def!type sb!kernel::layout-depthoid () '(or index (integer -1 -1)))
  45
  46 ;;; a value for an optimization declaration
  47 (def!type sb!c::cookie-quality () '(or (rational 0 3) null))
  48 \f
  49 ;;; A COOKIE holds information about the compilation environment for a
  50 ;;; node. See the LEXENV definition for a description of how it is
  51 ;;; used.
  52 (def!struct (cookie (:copier nil))
  53   (speed   nil :type cookie-quality)
  54   (space   nil :type cookie-quality)
  55   (safety  nil :type cookie-quality)
  56   (cspeed  nil :type cookie-quality)
  57   (brevity nil :type cookie-quality)
  58   (debug   nil :type cookie-quality))
  59
  60 ;;; KLUDGE: This needs to be executable in cold init toplevel forms, earlier
  61 ;;; than the default copier closure created by DEFSTRUCT toplevel forms would
  62 ;;; be available, and earlier than LAYOUT-INFO is initialized (which is a
  63 ;;; prerequisite for COPY-STRUCTURE to work), so we define it explicitly using
  64 ;;; DEFUN, so that it can be installed by the cold loader, and using
  65 ;;; hand-written, hand-maintained slot-by-slot copy it doesn't need to call
  66 ;;; COPY-STRUCTURE. -- WHN 19991019
  67 (defun copy-cookie (cookie)
  68   (make-cookie :speed   (cookie-speed   cookie)
  69                :space   (cookie-space   cookie)
  70                :safety  (cookie-safety  cookie)
  71                :cspeed  (cookie-cspeed  cookie)
  72                :brevity (cookie-brevity cookie)
  73                :debug   (cookie-debug   cookie)))
  74
  75 ;;; *DEFAULT-COOKIE* holds the current global compiler policy information.
  76 ;;; Whenever the policy is changed, we copy the structure so that old uses will
  77 ;;; still get the old values. *DEFAULT-INTERFACE-COOKIE* holds any values
  78 ;;; specified by an OPTIMIZE-INTERFACE declaration.
  79 ;;;
  80 ;;; FIXME: Why isn't COOKIE called POLICY?
  81 (declaim (type cookie *default-cookie* *default-interface-cookie*))
  82 (defvar *default-cookie*)          ; initialized in cold init
  83 (defvar *default-interface-cookie*) ; initialized in cold init
  84
  85 ;;; possible values for the INLINE-ness of a function.
  86 (deftype inlinep ()
  87   '(member :inline :maybe-inline :notinline nil))
  88 (defconstant inlinep-translations
  89   '((inline . :inline)
  90     (notinline . :notinline)
  91     (maybe-inline . :maybe-inline)))
  92
  93 ;;; The lexical environment we are currently converting in.
  94 (defvar *lexenv*)
  95 (declaim (type lexenv *lexenv*))
  96
  97 ;;; *FREE-VARIABLES* translates from the names of variables referenced
  98 ;;; globally to the LEAF structures for them. *FREE-FUNCTIONS* is like
  99 ;;; *FREE-VARIABLES*, only it deals with function names.
 100 (defvar *free-variables*)
 101 (defvar *free-functions*)
 102 (declaim (hash-table *free-variables* *free-functions*))
 103
 104 ;;; We use the same Constant structure to represent all equal anonymous
 105 ;;; constants. This hashtable translates from constants to the Leafs that
 106 ;;; represent them.
 107 (defvar *constants*)
 108 (declaim (hash-table *constants*))
 109
 110 ;;; miscellaneous forward declarations
 111 (defvar *code-segment*)
 112 #!+sb-dyncount (defvar *collect-dynamic-statistics*)
 113 (defvar *component-being-compiled*)
 114 (defvar *compiler-error-context*)
 115 (defvar *compiler-error-count*)
 116 (defvar *compiler-warning-count*)
 117 (defvar *compiler-style-warning-count*)
 118 (defvar *compiler-note-count*)
 119 (defvar *converting-for-interpreter*)
 120 (defvar *count-vop-usages*)
 121 (defvar *current-path*)
 122 (defvar *current-component*)
 123 (defvar *default-cookie*)
 124 (defvar *default-interface-cookie*)
 125 (defvar *dynamic-counts-tn*)
 126 (defvar *elsewhere*)
 127 (defvar *event-info*)
 128 (defvar *event-note-threshold*)
 129 (defvar *failure-p*)
 130 (defvar *fixups*)
 131 (defvar *in-pack*)
 132 (defvar *info-environment*)
 133 (defvar *lexenv*)
 134 (defvar *source-info*)
 135 (defvar *trace-table*)
 136 (defvar *undefined-warnings*)
 137 (defvar *warnings-p*)
 138 \f
 139 ;;;; miscellaneous utilities
 140
 141 ;;; Delete any undefined warnings for NAME and KIND. This is for the
 142 ;;; benefit of the compiler, but it's sometimes called from stuff like
 143 ;;; type-defining code which isn't logically part of the compiler.
 144 (declaim (ftype (function ((or symbol cons) keyword) (values))
 145                 note-name-defined))
 146 (defun note-name-defined (name kind)
 147   ;; We do this BOUNDP check because this function can be called when
 148   ;; not in a compilation unit (as when loading top-level forms).
 149   (when (boundp '*undefined-warnings*)
 150     (setq *undefined-warnings*
 151           (delete-if (lambda (x)
 152                        (and (equal (undefined-warning-name x) name)
 153                             (eq (undefined-warning-kind x) kind)))
 154                      *undefined-warnings*)))
 155   (values))
 156
 157 ;;; to be called when a variable is lexically bound
 158 (declaim (ftype (function (symbol) (values)) note-lexical-binding))
 159 (defun note-lexical-binding (symbol)
 160   (let ((name (symbol-name symbol)))
 161     ;; This check is intended to protect us from getting silently burned when
 162     ;; we define
 163     ;;   foo.lisp:
 164     ;;     (DEFVAR *FOO*)
 165     ;;     (DEFUN FOO (X) (1+ X *FOO*))
 166     ;;   bar.lisp:
 167     ;;     (DEFUN BAR (X)
 168     ;;       (LET ((*FOO* X))
 169     ;;         (FOO 14)))
 170     ;; and then we happen to compile bar.lisp before foo.lisp.
 171     (when (and (char= #\* (aref name 0))
 172                (char= #\* (aref name (1- (length name)))))
 173       (style-warn "using the lexical binding of the symbol ~S, not the~@
 174 dynamic binding, even though the symbol name follows the usual naming~@
 175 convention (names like *FOO*) for special variables" symbol)))
 176   (values))