1.0.3.13: working NaN comparison tests outside Darwin
[sbcl.git] / 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 ;;; ANSI limits on compilation
19 (def!constant sb!xc:call-arguments-limit sb!xc:most-positive-fixnum
20   #!+sb-doc
21   "The exclusive upper bound on the number of arguments which may be passed
22   to a function, including &REST args.")
23 (def!constant sb!xc:lambda-parameters-limit sb!xc:most-positive-fixnum
24   #!+sb-doc
25   "The exclusive upper bound on the number of parameters which may be specifed
26   in a given lambda list. This is actually the limit on required and &OPTIONAL
27   parameters. With &KEY and &AUX you can get more.")
28 (def!constant sb!xc:multiple-values-limit sb!xc:most-positive-fixnum
29   #!+sb-doc
30   "The exclusive upper bound on the number of multiple VALUES that you can
31   return.")
32
33 (defconstant-eqx sb!xc:lambda-list-keywords
34   '(&allow-other-keys
35     &aux
36     &body
37     &environment
38     &key
39     &more
40     &optional
41     &rest
42     &whole)
43   #'equal
44   #!+sb-doc
45   "symbols which are magical in a lambda list")
46 \f
47 ;;;; cross-compiler-only versions of CL special variables, so that we
48 ;;;; don't have weird interactions with the host compiler
49
50 (defvar sb!xc:*compile-file-pathname*)
51 (defvar sb!xc:*compile-file-truename*)
52 (defvar sb!xc:*compile-print*)
53 (defvar sb!xc:*compile-verbose*)
54 \f
55 ;;;; miscellaneous types used both in the cross-compiler and on the target
56
57 ;;;; FIXME: The INDEX and LAYOUT-DEPTHOID definitions probably belong
58 ;;;; somewhere else, not "early-c", since they're after all not part
59 ;;;; of the compiler.
60
61 ;;; the type of LAYOUT-DEPTHOID slot values
62 (def!type sb!kernel::layout-depthoid () '(or index (integer -1 -1)))
63 \f
64 ;;; possible values for the INLINE-ness of a function.
65 (deftype inlinep ()
66   '(member :inline :maybe-inline :notinline nil))
67 (defparameter *inlinep-translations*
68   '((inline . :inline)
69     (notinline . :notinline)
70     (maybe-inline . :maybe-inline)))
71
72 ;;; the lexical environment we are currently converting in
73 (defvar *lexenv*)
74 (declaim (type lexenv *lexenv*))
75
76 ;;; *FREE-VARS* translates from the names of variables referenced
77 ;;; globally to the LEAF structures for them. *FREE-FUNS* is like
78 ;;; *FREE-VARS*, only it deals with function names.
79 (defvar *free-vars*)
80 (defvar *free-funs*)
81 (declaim (type hash-table *free-vars* *free-funs*))
82
83 ;;; We use the same CONSTANT structure to represent all equal anonymous
84 ;;; constants. This hashtable translates from constants to the LEAFs that
85 ;;; represent them.
86 (defvar *constants*)
87 (declaim (type hash-table *constants*))
88
89 ;;; *ALLOW-INSTRUMENTING* controls whether we should allow the
90 ;;; insertion of instrumenting code (like a (CATCH ...)) around code
91 ;;; to allow the debugger RETURN and STEP commands to function (we
92 ;;; disallow it for internal stuff).
93 (defvar *allow-instrumenting*)
94
95 ;;; miscellaneous forward declarations
96 (defvar *code-segment*)
97 #!+sb-dyncount (defvar *collect-dynamic-statistics*)
98 (defvar *component-being-compiled*)
99 (defvar *compiler-error-context*)
100 (defvar *compiler-error-count*)
101 (defvar *compiler-warning-count*)
102 (defvar *compiler-style-warning-count*)
103 (defvar *compiler-note-count*)
104 (defvar *compiler-trace-output*)
105 (defvar *constraint-number*)
106 (defvar *count-vop-usages*)
107 (defvar *current-path*)
108 (defvar *current-component*)
109 (defvar *delayed-ir1-transforms*)
110 (defvar *handled-conditions*)
111 (defvar *disabled-package-locks*)
112 (defvar *policy*)
113 (defvar *dynamic-counts-tn*)
114 (defvar *elsewhere*)
115 (defvar *event-info*)
116 (defvar *event-note-threshold*)
117 (defvar *failure-p*)
118 (defvar *fixup-notes*)
119 (defvar *in-pack*)
120 (defvar *info-environment*)
121 (defvar *lexenv*)
122 (defvar *source-info*)
123 (defvar *trace-table*)
124 (defvar *undefined-warnings*)
125 (defvar *warnings-p*)
126
127 ;;; This lock is seized in the compiler, and related areas: the
128 ;;; compiler is not presently thread-safe
129 (defvar *big-compiler-lock*
130   (sb!thread:make-mutex :name "big compiler lock"))
131
132 (declaim (type fixnum *compiler-sset-counter*))
133 (defvar *compiler-sset-counter* 0)
134
135 ;;; unique ID for the next object created (to let us track object
136 ;;; identity even across GC, useful for understanding weird compiler
137 ;;; bugs where something is supposed to be unique but is instead
138 ;;; exists as duplicate objects)
139 #!+sb-show
140 (progn
141   (defvar *object-id-counter* 0)
142   (defun new-object-id ()
143     (prog1
144         *object-id-counter*
145       (incf *object-id-counter*))))
146 \f
147 ;;;; miscellaneous utilities
148
149 ;;; Delete any undefined warnings for NAME and KIND. This is for the
150 ;;; benefit of the compiler, but it's sometimes called from stuff like
151 ;;; type-defining code which isn't logically part of the compiler.
152 (declaim (ftype (function ((or symbol cons) keyword) (values))
153                 note-name-defined))
154 (defun note-name-defined (name kind)
155   ;; We do this BOUNDP check because this function can be called when
156   ;; not in a compilation unit (as when loading top level forms).
157   (when (boundp '*undefined-warnings*)
158     (setq *undefined-warnings*
159           (delete-if (lambda (x)
160                        (and (equal (undefined-warning-name x) name)
161                             (eq (undefined-warning-kind x) kind)))
162                      *undefined-warnings*)))
163   (values))
164
165 ;;; to be called when a variable is lexically bound
166 (declaim (ftype (function (symbol) (values)) note-lexical-binding))
167 (defun note-lexical-binding (symbol)
168     ;; This check is intended to protect us from getting silently
169     ;; burned when we define
170     ;;   foo.lisp:
171     ;;     (DEFVAR *FOO* -3)
172     ;;     (DEFUN FOO (X) (+ X *FOO*))
173     ;;   bar.lisp:
174     ;;     (DEFUN BAR (X)
175     ;;       (LET ((*FOO* X))
176     ;;         (FOO 14)))
177     ;; and then we happen to compile bar.lisp before foo.lisp.
178   (when (looks-like-name-of-special-var-p symbol)
179     ;; FIXME: should be COMPILER-STYLE-WARNING?
180     (style-warn "using the lexical binding of the symbol ~S, not the~@
181 dynamic binding, even though the symbol name follows the usual naming~@
182 convention (names like *FOO*) for special variables" symbol))
183   (values))
184
185 (defvar *debug-name-level* 6)
186
187 (defun debug-name (type thing)
188   (labels ((walk (x level)
189              (if (> *debug-name-level* (incf level))
190                  (typecase x
191                    (cons
192                     (cons (walk (car x) level) (walk (cdr x) level)))
193                    ((or symbol number string)
194                     x)
195                    (t
196                     (list 'of-type (type-of x))))
197                  "#<...>")))
198     ;; FIXME: It might be nice to put markers in the tree instead of
199     ;; this #<...> business, so that they would evantually be printed
200     ;; without the quotes.
201     (let ((name (list type (walk thing 0))))
202       (when (legal-fun-name-p name)
203         (bug "~S is a legal function name, and cannot be used as a ~
204               debug name." name))
205       name)))