src/compiler/early-lexenv.lisp

   1 ;;;; This file contains early compiler-related structure definitions.
   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!C")
  13
  14 (declaim (simple-vector **policy-primary-qualities**))
  15 (!defglobal **policy-primary-qualities**
  16         #(;; ANSI standard qualities
  17           compilation-speed
  18           debug
  19           safety
  20           space
  21           speed
  22           ;; SBCL extensions
  23           ;;
  24           ;; FIXME: INHIBIT-WARNINGS is a misleading name for this.
  25           ;; Perhaps BREVITY would be better. But the ideal name would
  26           ;; have connotations of suppressing not warnings but only
  27           ;; optimization-related notes, which is already mostly the
  28           ;; behavior, and should probably become the exact behavior.
  29           ;; Perhaps INHIBIT-NOTES?
  30           inhibit-warnings))
  31
  32 (eval-when (:compile-toplevel :load-toplevel :execute)
  33   (defconstant n-policy-primary-qualities (length **policy-primary-qualities**))
  34   ;; 1 bit per quality is stored to indicate whether it was explicitly given
  35   ;; a value in a lexical policy. In addition to the 5 ANSI-standard qualities,
  36   ;; SBCL defines one more "primary" quality and 16 dependent qualities.
  37   ;; Both kinds take up 1 bit in the mask of specified qualities.
  38   (defconstant max-policy-qualities 32))
  39
  40 ;; Each primary and dependent quality policy is assigned a small integer index.
  41 ;; The POLICY struct represents a set of policies in an order-insensitive way
  42 ;; that facilitates quicker lookup than scanning an alist.
  43 (defstruct (policy (:constructor make-policy
  44                                  (primary-qualities &optional presence-bits)))
  45   ;; Mask with a 1 for each quality that has an explicit value in this policy.
  46   ;; Primary qualities fill the mask from left-to-right and dependent qualities
  47   ;; from right-to-left.
  48   ;; xc has trouble folding this MASK-FIELD, but it works when host-evaluated.
  49   (presence-bits #.(mask-field
  50                     (byte n-policy-primary-qualities
  51                           (- max-policy-qualities n-policy-primary-qualities))
  52                     -1)
  53                  :type (unsigned-byte #.max-policy-qualities))
  54   ;; For efficiency, primary qualities are segregated because there are few
  55   ;; enough of them to fit in a fixnum.
  56   (primary-qualities 0 :type (unsigned-byte #.(* 2 n-policy-primary-qualities)))
  57   ;; 2 bits per dependent quality is a fixnum on 64-bit build, not on 32-bit.
  58   ;; It would certainly be possible to constrain this to storing exactly
  59   ;; the 16 currently defined dependent qualities,
  60   ;; but that would be overly limiting.
  61   (dependent-qualities 0
  62    :type (unsigned-byte #.(* (- max-policy-qualities n-policy-primary-qualities)
  63                              2))))
  64
  65 (defvar *handled-conditions* nil)
  66 (defvar *disabled-package-locks* nil)
  67
  68 ;;; The LEXENV represents the lexical environment used for IR1 conversion.
  69 ;;; (This is also what shows up as an ENVIRONMENT value in macroexpansion.)
  70 #!-sb-fluid (declaim (inline internal-make-lexenv)) ; only called in one place
  71 (defstruct (lexenv
  72              (:include abstract-lexenv)
  73              #-no-ansi-print-object
  74              (:print-function
  75               (lambda (lexenv stream depth)
  76                 (if (null-lexenv-p lexenv)
  77                     (print-unreadable-object (lexenv stream)
  78                       (write-string "NULL-LEXENV" stream))
  79                     (default-structure-print lexenv stream depth))))
  80              (:copier nil)
  81              (:constructor make-null-lexenv ())
  82              (:constructor make-almost-null-lexenv (%policy handled-conditions))
  83              (:constructor make-package-lock-lexenv
  84                            (disabled-package-locks %policy
  85                             &aux (handled-conditions nil)))
  86              (:constructor internal-make-lexenv
  87                            (funs vars blocks tags
  88                             type-restrictions
  89                             lambda cleanup handled-conditions
  90                             disabled-package-locks %policy user-data
  91                             parent)))
  92   ;; an alist of (NAME . WHAT), where WHAT is either a FUNCTIONAL (a
  93   ;; local function), a DEFINED-FUN, representing an
  94   ;; INLINE/NOTINLINE declaration, or a list (MACRO . <function>) (a
  95   ;; local macro, with the specifier expander). Note that NAME may be
  96   ;; a (SETF <name>) list, not necessarily a single symbol.
  97   (funs nil :type list)
  98   ;; an alist translating variable names to LEAF structures. A special
  99   ;; binding is indicated by a :SPECIAL GLOBAL-VAR leaf. Each special
 100   ;; binding within the code gets a distinct leaf structure, as does
 101   ;; the current "global" value on entry to the code compiled.
 102   ;; (locally (special ...)) is handled by adding the most recent
 103   ;; special binding to the front of the list.
 104   ;;
 105   ;; If the CDR is (MACRO . <exp>), then <exp> is the expansion of a
 106   ;; symbol macro.
 107   (vars nil :type list)
 108   ;; BLOCKS and TAGS are alists from block and go-tag names to 2-lists
 109   ;; of the form (<entry> <continuation>), where <continuation> is the
 110   ;; continuation to exit to, and <entry> is the corresponding ENTRY
 111   ;; node.
 112   (blocks nil :type list)
 113   (tags nil :type list)
 114   ;; an alist (THING . CTYPE) which is used to keep track of
 115   ;; "pervasive" type declarations. When THING is a leaf, this is for
 116   ;; type declarations that pertain to the type in a syntactic extent
 117   ;; which does not correspond to a binding of the affected name.
 118   (type-restrictions nil :type list)
 119   ;; the lexically enclosing lambda, if any
 120   ;;
 121   ;; FIXME: This should be :TYPE (OR CLAMBDA NULL), but it was too hard
 122   ;; to get CLAMBDA defined in time for the cross-compiler.
 123   (lambda nil)
 124   ;; the lexically enclosing cleanup, or NIL if none enclosing within LAMBDA
 125   (cleanup nil)
 126   ;; condition types we handle with a handler around the compiler
 127   (handled-conditions *handled-conditions*)
 128   ;; lexically disabled package locks (list of symbols)
 129   (disabled-package-locks *disabled-package-locks*)
 130   ;; the current OPTIMIZE policy. this is null in the null environment,
 131   ;; and the global policy is stored in *POLICY*. (Because we want to
 132   ;; be able to affect it from :WITH-COMPILATION-UNIT.) NIL here also
 133   ;; works as a convenient null-lexenv identifier.
 134   (%policy nil :type (or null policy))
 135   ;; A list associating extra user info to symbols.  The entries
 136   ;; are of the form (:declare name . value),
 137   ;; (:variable name key . value), or (:function name key . value)
 138   (user-data nil :type list)
 139   parent
 140   ;; Cache of all visible variables, including the ones coming from
 141   ;; (call-lexenv lambda)
 142   ;; Used for LEAF-VISIBLE-TO-DEBUGGER-P
 143   (var-cache nil :type (or null hash-table)))
 144
 145 ;;; the lexical environment we are currently converting in
 146 (defvar *lexenv*)
 147 (declaim (type lexenv *lexenv*))
 148
 149 ;;; an object suitable for input to standard functions that accept
 150 ;;; "environment objects" (of the ANSI glossary)
 151 (def!type lexenv-designator () '(or abstract-lexenv null))
 152
 153 (defvar *policy*)
 154 (defun lexenv-policy (lexenv)
 155   (or (lexenv-%policy lexenv) *policy*))
 156
 157 (defun null-lexenv-p (lexenv)
 158   (not (lexenv-%policy lexenv)))