1 ;;;; This file contains early compiler-related structure definitions.
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 (declaim (simple-vector **policy-primary-qualities
**))
15 (!defglobal
**policy-primary-qualities
**
16 #(;; ANSI standard qualities
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?
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))
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
))
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
)
65 (defvar *handled-conditions
* nil
)
66 (defvar *disabled-package-locks
* nil
)
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
72 (:include abstract-lexenv
)
73 #-no-ansi-print-object
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
))))
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
89 lambda cleanup handled-conditions
90 disabled-package-locks %policy user-data
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.
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.
105 ;; If the CDR is (MACRO . <exp>), then <exp> is the expansion of a
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
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
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.
124 ;; the lexically enclosing cleanup, or NIL if none enclosing within LAMBDA
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
)
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
)))
145 ;;; the lexical environment we are currently converting in
147 (declaim (type lexenv
*lexenv
*))
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
))
154 (defun lexenv-policy (lexenv)
155 (or (lexenv-%policy lexenv
) *policy
*))
157 (defun null-lexenv-p (lexenv)
158 (not (lexenv-%policy lexenv
)))