Newer
Older
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
;;;; Copyright (c) 1990, Giuseppe Attardi.
;;;; Copyright (c) 2010-2013, Jean-Claude Beaudoin.
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; See file '../../Copyright' for full details.
;;;; CMPDEF Definitions
(si::reopen-package "CL")
(defpackage "COMPILER"
;;(:nicknames "COMPILER")
(:use "FFI" "CL")
(:export "*COMPILER-BREAK-ENABLE*"
"*COMPILE-PRINT*"
"*COMPILE-VERBOSE*"
"BUILD-BUNDLE"
"BUILD-FASL"
"BUILD-PROGRAM"
"BUILD-STATIC-LIBRARY"
"BUILD-SHARED-LIBRARY"
"COMPILER-WARNING"
"COMPILER-STYLE-WARNING"
"COMPILER-NOTE"
"COMPILER-MESSAGE"
"COMPILER-ERROR"
"COMPILER-FATAL-ERROR"
"COMPILER-INTERNAL-ERROR"
"COMPILER-UNDEFINED-VARIABLE"
"COMPILER-MESSAGE-FILE"
"COMPILER-MESSAGE-FILE-END-POSITION"
"COMPILER-MESSAGE-FORM"
"*SUPPRESS-COMPILER-WARNINGS*"
"*SUPPRESS-COMPILER-NOTES*"
"*SUPPRESS-COMPILER-MESSAGES*")
(:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP" "MACRO" "COMPILER-LET"))
(in-package "COMPILER")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; COMPILER STRUCTURES
;;;
;;;
;;; REF OBJECT
;;;
;;; Base object for functions, variables and statements. We use it to
;;; keep track of references to objects, how many times the object is
;;; referenced, by whom, and whether the references cross some closure
;;; boundaries.
;;;
(defstruct (ref (:print-object print-ref))
name ;;; Identifier of reference.
(ref 0 :type fixnum) ;;; Number of references.
ref-ccb ;;; Cross closure reference.
;;; During Pass1, T or NIL.
;;; During Pass2, the index into the closure env
ref-clb ;;; Cross local function reference.
;;; During Pass1, T or NIL.
;;; During Pass2, the lex-address for the
;;; block id, or NIL.
read-nodes ;;; Nodes (c1forms) in which the reference occurs
)
(deftype OBJECT () `(not (or fixnum character float)))
(defstruct (var (:include ref) (:constructor %make-var) (:print-object print-var))
; name ;;; Variable name.
; (ref 0 :type fixnum)
;;; Number of references to the variable (-1 means IGNORE).
; ref-ccb ;;; Cross closure reference: T or NIL.
; ref-clb ;;; Cross local function reference: T or NIL.
; read-nodes ;;; Nodes (c1forms) in which the reference occurs
set-nodes ;;; Nodes in which the variable is modified
kind ;;; One of LEXICAL, CLOSURE, SPECIAL, GLOBAL, :OBJECT, :FIXNUM,
;;; :CHAR, :DOUBLE, :FLOAT, or REPLACED (used for
;;; LET variables).
(function *current-function*)
;;; For local variables, in which function it was created.
;;; For global variables, it doesn't have a meaning.
(functions-setting nil)
(functions-reading nil)
;;; Functions in which the variable has been modified or read.
(loc 'OBJECT) ;;; During Pass 1: indicates whether the variable can
;;; be allocated on the call-stack: OBJECT means
;;; the variable is declared as OBJECT, and CLB means
;;; the variable is referenced across Level Boundary and thus
;;; cannot be allocated on the C stack. Note that OBJECT is
;;; set during variable binding and CLB is set when the
;;; variable is used later, and therefore CLB may supersede
;;; OBJECT.
;;; During Pass 2:
;;; For REPLACED: the actual location of the variable.
;;; For :FIXNUM, :CHAR, :FLOAT, :DOUBLE, :OBJECT:
;;; the cvar for the C variable that holds the value.
;;; For LEXICAL or CLOSURE: the frame-relative address for
;;; the variable in the form of a cons '(lex-levl . lex-ndx)
;;; lex-levl is the level of lexical environment
;;; lex-ndx is the index within the array for this env.
;;; For SPECIAL and GLOBAL: the vv-index for variable name.
(type t) ;;; Type of the variable.
(index -1) ;;; position in *vars*.
(ignorable nil)
(cloc nil) ;;; Closure location. Replacement for "loc". Temporary! JCB
(extent nil) ;;; Either NIL (for indefinite) or DYNAMIC. JCB
)
;;; A function may be compiled into a CFUN, CCLOSURE or CCLOSURE+LISP_CLOSURE
;;; Here are examples of function FOO for the 3 cases:
;;; 1. (flet ((foo () (bar))) (foo)) CFUN
;;; 2. (flet ((foo () (bar))) #'foo) CFUN+LISP_CFUN
;;; 3. (flet ((foo () x)) #'(lambda () (foo))) CCLOSURE
;;; 4. (flet ((foo () x)) #'foo) CCLOSURE+LISP_CLOSURE
;;; A function can be referred across a ccb without being a closure, e.g:
;;; (flet ((foo () (bar))) #'(lambda () (foo)))
;;; [the lambda also need not be a closure]
;;; and it can be a closure without being referred across ccb, e.g.:
;;; (flet ((foo () x)) #'foo) [ is this a mistake in local-function-ref?]
;;; Here instead the lambda must be a closure, but no closure is needed for foo
;;; (flet ((foo () x)) #'(lambda () (foo)))
;;; So we use two separate fields: ref-ccb and closure.
;;; A CCLOSURE must be created for a function when:
;;; 1. it appears within a FUNCTION construct and
;;; 2. it uses some ccb references (directly or indirectly).
;;; ref-ccb corresponds to the first condition, i.e. function is referred
;;; across CCB. It is computed during Pass 1. A value of 'RETURNED means
;;; that it is immediately within FUNCTION.
;;; closure corresponds to second condition and is computed in Pass 2 by
;;; looking at the info-referred-vars and info-local-referred of its body.
;;; A LISP_CFUN or LISP_CLOSURE must be created when the function is returned.
;;; The LISP funob may then be referred locally or across LB or CB:
;;; (flet ((foo (z) (bar z))) (list #'foo)))
;;; (flet ((foo (z) z)) (flet ((bar () #'foo)) (bar)))
;;; (flet ((foo (z) (bar z))) #'(lambda () #'foo)))
;;; therefore we need field funob.
(defstruct (fun (:include ref))
; name ;;; Function name.
; (ref 0 :type fixnum) ;;; Number of references.
;;; During Pass1, T or NIL.
;;; During Pass2, the vs-address for the
;;; function closure, or NIL.
; ref-ccb ;;; Cross closure reference.
;;; During Pass1, T or NIL, depending on whether a
;;; function object will be built.
;;; During Pass2, the vs-address for the function
;;; closure, or NIL.
; ref-clb ;;; Unused.
; read-nodes ;;; Nodes (c1forms) in which the reference occurs
cfun ;;; The cfun for the function.
(level 0) ;;; Level of lexical nesting for a function.
(env 0) ;;; Size of env of closure.
(closure-levels nil) ;;; List of sizes, one for each closure level, in reverse order.
(global nil) ;;; Global lisp function.
(exported nil) ;;; Its C name can be seen outside the module.
(no-entry nil) ;;; NIL if declared as C-LOCAL. Then we create no
;;; function object and the C function is called
;;; directly. Deprecated! JCB
(shares-with nil) ;;; Deprecated! JCB
;;;
closure ;;; During Pass2, T if env is used inside the function
var ;;; the variable holding the funob
description ;;; Text for the object, in case NAME == NIL.
lambda ;;; Lambda c1-form for this function.
(minarg 0) ;;; Min. number arguments that the function receives.
(maxarg call-arguments-limit)
;;; Max. number arguments that the function receives.
(parent *current-function*)
;;; Parent function, NIL if global. (Not quite: NIL if toplevel. JCB)
(local-vars nil) ;;; List of local variables created here.
(referred-vars nil) ;;; List of external variables referenced here.
(referred-funs nil) ;;; List of external functions called in this one.
;;; We only register direct calls, not calls via object.
(child-funs nil) ;;; List of local functions defined here.
(debug 0) ;;; Debug quality
(file *compile-file-truename*)
;;; Source file or NIL
(file-end-position *compile-file-end-position*)
;;; Top-level form number in source file
(global-fun-refs nil) ;;; Vector of function references (extensible). JCB
;;; each element is (symbol . loc)
(lex-local-p nil) ;;; T if fun is lexically local (flet/labels). JCB
(lex-local-funs nil) ;;; Set of lexically local functions defined inside this fun. JCB
(name-loc nil) ;;; vv-location of name at load time. JCB
(block-index nil) ;;; Index of this fun object in Cblock. JCB
)
(defmacro fun-closure-depth (fun)
`(length (fun-closure-levels ,fun)))
(defstruct (blk (:include ref))
; name ;;; Block name.
; (ref 0 :type fixnum) ;;; Number of references.
; ref-ccb ;;; Cross closure reference.
;;; During Pass1, T or NIL.
;;; During Pass2, the ccb-lex for the
;;; block id, or NIL.
; ref-clb ;;; Cross local function reference.
;;; During Pass1, T or NIL.
;;; During Pass2, the lex-address for the
;;; block id, or NIL.
; read-nodes ;;; Nodes (c1forms) in which the reference occurs
exit ;;; Where to return. A label.
destination ;;; Where the value of the block to go.
var ;;; Variable containing the block ID.
(type 'NIL) ;;; Estimated type.
)
(defstruct (tag (:include ref))
; name ;;; Tag name.
; (ref 0 :type fixnum) ;;; Number of references.
; ref-ccb ;;; Cross closure reference.
;;; During Pass1, T or NIL.
; ref-clb ;;; Cross local function reference.
;;; During Pass1, T or NIL.
; read-nodes ;;; Nodes (c1forms) in which the reference occurs
label ;;; Where to jump: a label.
unwind-exit ;;; Where to unwind-no-exit.
var ;;; Variable containing frame ID.
index ;;; An integer denoting the label.
)
(defstruct (info)
(local-vars nil) ;;; List of var-objects created directly in the form.
(type t) ;;; Type of the form.
(sp-change nil) ;;; Whether execution of the form may change
;;; the value of a special variable.
(volatile nil) ;;; whether there is a possible setjmp. Beppe
)
(defstruct (inline-info)
arg-rep-types ;;; List of representation types for the arguments
return-rep-type ;;; Representation type for the output
arg-types ;;; List of lisp types for the arguments
return-type ;;; Lisp type for the output
exact-return-type ;;; Only use this expansion when the output is
;;; declared to have a subtype of RETURN-TYPE
expansion ;;; C template containing the expansion
one-liner ;;; Whether the expansion spans more than one line
)
;;;
;;; VARIABLES
;;;
;;; --cmpinline.lsp--
;;;
;;; Empty info struct
;;;
(defvar *info* (make-info))
(defvar *inline-functions* nil)
(defvar *inline-blocks* 0)
;;; *inline-functions* holds:
;;; (...( function-name . inline-info )...)
;;;
;;; *inline-blocks* holds the number of C blocks opened for declaring
;;; temporaries for intermediate results of the evaluation of inlined
;;; function calls.
;;; --cmputil.lsp--
;;;
;;; Variables and constants for error handling
;;;
(defvar *current-form* '|compiler preprocess|)
(defvar *original-current-form* '|compiler preprocess|)
(defvar *compile-file-end-position* -1)
(defvar *first-error* t)
(defconstant *cmperr-tag* (cons nil nil))
(defvar *active-handlers* nil)
(defvar *active-protection* nil)
(defvar *pending-actions* nil)
(defvar *compiler-conditions* '()
"This variable determines whether conditions are printed or just accumulated.")
(defvar *compile-print* nil
"This variable controls whether the compiler displays messages about
each form it processes. The default value is NIL.")
(defvar *compile-verbose* nil
"This variable controls whether the compiler should display messages about its
progress. The default value is T.")
(defvar *suppress-compiler-messages* ;;nil
'compiler:compiler-note
;;'(or c:compiler-note c:compiler-warning)
"A type denoting which compiler messages and conditions are _not_ displayed.")
(defvar *suppress-compiler-notes* t)
(defvar *suppress-compiler-warnings* nil)
(defvar *compiler-in-use* nil)
(defvar *compiler-input*)
(defvar *compiler-output1*)
(defvar *compiler-output2*)
;;; --cmpcbk.lsp--
;;;
;;; List of callbacks to be generated
;;;
(defvar *callbacks* nil)
;;; --cmpcall.lsp--
;;;
;;; Whether to use linking calls.
;;;
;;(defvar *compile-to-linking-call* t) ;; unused! JCB
(defvar *compiler-declared-globals*)
;;; --cmpenv.lsp--
;;;
;;; These default settings are equivalent to (optimize (speed 2) (space 0) (safety 3))
;;;
(defvar *safety* 2)
(defvar *speed* 3)
(defvar *space* 0)
(defvar *debug* 2)
(defconstant *default-optimize-settings*
`(optimize (safety ,*safety*) (speed ,*speed*) (space ,*space*) (debug ,*debug*)))
;;; Emit automatic CHECK-TYPE forms for function arguments in lambda forms.
(defvar *automatic-check-type-in-lambda* t)
;;;
;;; Compiled code uses the following kinds of variables:
;;; 1. Vi, declared explicitely, either unboxed or not (*lcl*, next-lcl)
;;; 2. Ti, declared collectively, of type object, may be reused (*temp*, next-temp)
;;; 4. lexi[j], for lexical variables in local functions
;;; 5. CLVi, for lexical variables in closures
(defvar *lcl* 0) ; number of local variables
(defvar *temp* 0) ; number of temporary variables
(defvar *max-temp* 0) ; maximum *temp* reached
(defvar *level* 0) ; nesting level for local functions
(defvar *lex* 0) ; number of lexical variables in local functions
(defvar *max-lex* 0) ; maximum *lex* reached
(defvar *env* 0) ; number of variables in current form
(defvar *max-env* 0) ; maximum *env* in whole function
(defvar *env-lvl* 0) ; number of levels of environments
(defvar *aux-closure* nil) ; stack allocated closure needed for indirect calls
(defvar *closure-levels* nil) ; list of sizes, one per closure level, in reverse order JCB
(defvar *closure-block-id* 0) ; JCB
(defvar *cenv0-used* nil) ; A flag, JCB
(defvar *global-fun-refs* nil) ; Vector of function references (extensible). JCB
; each element is (symbol . loc)
(defvar *next-cmacro* 0) ; holds the last cmacro number used.
(defvar *next-cfun* 0) ; holds the last cfun used.
(defvar *debug-fun* 0) ; Level of debugging of functions
;;;
;;; *tail-recursion-info* holds NIL, if tail recursion is impossible.
;;; If possible, *tail-recursion-info* holds
;; ( c1-lambda-form required-arg .... required-arg ),
;;; where each required-arg is a var-object.
;;;
(defvar *tail-recursion-info* nil)
;;;
;;; *function-declarations* holds :
;; (... ( { function-name | fun-object } arg-types return-type ) ...)
;;; Function declarations for global functions are ASSOCed by function names,
;;; whereas those for local functions are ASSOCed by function objects.
;;;
;;; The valid argment type declaration is:
;; ( {type}* [ &optional {type}* ] [ &rest type ] [ &key {type}* ] )
;;; though &optional, &rest, and &key return types are simply ignored.
;;;
(defvar *function-declarations* nil)
(defvar *allow-c-local-declaration* t)
(defvar *notinline* nil)
;;; --cmpexit.lsp--
;;;
;;; *last-label* holds the label# of the last used label.
;;; *exit* holds an 'exit', which is
;; ( label# . ref-flag ) or one of RETURNs (i.e. RETURN, RETURN-FIXNUM,
;; RETURN-CHARACTER, RETURN-DOUBLE-FLOAT, RETURN-SINGLE-FLOAT, or
;; RETURN-OBJECT).
;;; *unwind-exit* holds a list consisting of:
;; ( label# . ref-flag ), one of RETURNs, TAIL-RECURSION-MARK, FRAME,
;; JUMP, BDS-BIND (each pushed for a single special binding), or a
;; LCL (which holds the bind stack pointer used to unbind).
;;;
(defvar *last-label* 0)
(defvar *exit*)
(defvar *unwind-exit*)
(defvar *current-function* nil) ;; bound in pass 1 by c1compile-function.
(defvar *written-function* nil) ;; bound in pass 3 by t3local-fun. JCB
(defun written-function-cname ()
(if *written-function* (fun-cfun *written-function*) "MKCL__TOPLEVEL_"))
(defvar *cmp-env* (cons nil nil)
"The compiler environment consists of a pair or cons of two
lists, one containing variable records, the other one macro and
function recors:
variable-record = (:block block-name) |
(:tag ({tag-name}*)) |
(:function function-name) |
(var-name {:special | nil} bound-p) |
(symbol si::symbol-macro macro-function) |
CB | LB | UNWIND-PROTECT
macro-record = (function-name function) |
(macro-name si::macro macro-function)
CB | LB | UNWIND-PROTECT
A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A
MACRO-FUNCTION is a function that provides us with the expansion
for that local macro or symbol macro. BOUND-P is true when the
variable has been bound by an enclosing form, while it is NIL if
the variable-record corresponds just to a special declaration.
CB, LB and UNWIND-PROTECT are only used by the C compiler and
they denote closure, lexical environment and unwind-protect
boundaries. Note that compared with the bytecode compiler, these
records contain an additional variable, block, tag or function
object at the end.")
;;; --cmplog.lsp--
;;;
;;; Destination of output of different forms. See cmploc.lsp for types
;;; of destinations.
;;;
(defvar *destination*)
;;; --cmpmain.lsp--
;;;
;;; Do we debug the compiler? Then we need files not to be deleted.
(defvar *delete-compiler-internal-files* t)
(defvar *files-to-be-deleted-on-shutdown* '())
(defvar *compiler-break-enable* nil) ;; set this to true if you want to invoke the debugger on compiler's internal errors.
(defvar *debug-compiler* nil)
;;; This is copied into each .h file generated.
(defvar *cmpinclude* "<mkcl/mkcl-cmp.h>")
(defvar *cc* (or #+(or mingw32 mingw64)
(let ((cc-path #P"@MKCL_CC@"))
(if (pathname-directory cc-path)
cc-path
(probe-file (make-pathname :name (pathname-name cc-path) :defaults (si:self-truename)))))
"@MKCL_CC@")
"This variable controls how the C compiler is invoked by MKCL.
The default value is \"@MKCL_CC@\".
One can set the variable appropriately adding for instance flags which the
C compiler may need to exploit special hardware features (e.g. a floating point
coprocessor).")
(defvar *ld* (or #+(or mingw32 mingw64)
(let ((cc-path #P"@MKCL_CC@"))
(if (pathname-directory cc-path)
cc-path
(probe-file (make-pathname :name (pathname-name cc-path) :defaults (si:self-truename)))))
"@MKCL_CC@")
"This variable controls the linker which is used by MKCL.")
(defvar *ar* (or #+(or mingw32 mingw64) (probe-file (make-pathname :name "ar" :defaults (si:self-truename)))
"ar")
"This variable controls the library archiver which is used by MKCL.")
(defvar *ranlib* (or #+(or mingw32 mingw64) (probe-file (make-pathname :name "ranlib" :defaults (si:self-truename)))
"ranlib")
"This variable controls the library conditioner which is used by MKCL.")
(defvar *cc-flags* "@CPPFLAGS@ @CFLAGS@ @MKCL_CFLAGS@ ")
(defvar *cc-optimize* #-msvc ""
#+msvc "@CFLAGS_OPTIMIZE@")
(defvar *ld-format* #-msvc "\"~A\" -o \"~A\" ~A ~{\"~A\" ~} ~A ~@?"
#+msvc "\"~A\" -Fe\"~A\" ~A ~{\"~A\" ~} ~A ~@?")
(defvar *cc-format* #-msvc "\"~A\" ~A ~:[~*~;~A~] \"-I~A\" -c \"~A\" -o \"~A\""
#+msvc "\"~A\" ~A ~:[~*~;~A~] -I\"~A\" -w -c \"~A\" -Fo\"~A\"")
(defvar *support-libraries* (mkcl:split-string "@LIBRARIES@" #\space))
(defvar *mkcl-shared-libs* (list (mkcl:bstr+ "@SHAREDPREFIX@mkcl_" (si:mkcl-version) ".@SHAREDEXT@")))
(defvar *mkcl-static-libs* (list* "libmkcltop.a" "liblsp.a" "libmkclmin.a" *support-libraries*))
(defvar *external-ld-flags* "@LDFLAGS@ @TCP_LIBS@ @LIBS@ ")
(defvar *shared-ld-flags* "@SHARED_LDFLAGS@")
(defvar *bundle-ld-flags* "@BUNDLE_LDFLAGS@")
(defvar *program-ld-flags*
#+linux "-rdynamic -Wl,--enable-new-dtags -Wl,-rpath,$ORIGIN/../lib"
#-linux "")
(defvar +shared-library-prefix+ "@SHAREDPREFIX@")
(defvar +shared-library-extension+ "@SHAREDEXT@")
(defvar +shared-library-format+ "@SHAREDPREFIX@~a.@SHAREDEXT@")
(defvar +static-library-prefix+ "@LIBPREFIX@")
(defvar +static-library-extension+ "@LIBEXT@")
(defvar +static-library-format+ "@LIBPREFIX@~a.@LIBEXT@")
(defvar +object-file-extension+ "@OBJEXT@")
(defvar +executable-file-extension+ "@EXEEXT@")
(defvar +executable-file-format+ "~a@EXEEXT@")
(defconstant *mkcl-default-include-directory* (pathname @includedir\@))
(defconstant *mkcl-default-library-directory* (pathname @libdir\@))
(defvar *mkcl-include-directory* nil)
(defvar *mkcl-library-directory* nil)
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
(defvar *disassemble-bindings* nil)
;;;
;;; Compiler program and flags.
;;;
;;; --cmptop.lsp--
;;;
(defvar *compiler-phase* nil)
(defvar *volatile*)
(defvar *setjmps* 0)
(defvar *compile-toplevel* T
"Holds NIL or T depending on whether we are compiling a toplevel form.")
(defvar *clines-string-list* '()
"List of strings containing C/C++ statements which are directly inserted
in the translated C/C++ file. Notice that it is unspecified where these
lines are inserted, but the order is preserved")
(defvar *compile-time-too* nil)
(defvar *not-compile-time* nil)
(defvar *permanent-data* nil) ; detemines whether we use *permanent-objects*
; or *temporary-objects*
(defvar *permanent-objects* nil) ; holds { ( object (VV vv-index) ) }*
(defvar *temporary-objects* nil) ; holds { ( object (VV vv-index) ) }*
(defvar *data-storage-frozen* nil) ;; if T then *permanent-objects* and
;; *temporary-objects* cannot be changed anymore.
(defvar *load-objects* nil) ; hash with association object -> vv-location
(defvar *load-time-values* nil) ; holds { ( vv-index form ) }*,
;;; where each vv-index should be given an object before
;;; defining the current function during loading process.
(defvar *use-static-constants-p* nil) ; T/NIL flag to determine whether one may
; generate lisp constant values as C structs
(defvar *static-constants* nil) ; constants that can be built as C values
; holds { ( object c-variable constant ) }*
;(defvar *compiler-constants* nil) ; a vector with all constants ;; replaced by si:*compiler-constants*. JCB
; only used in COMPILE
(defvar *proclaim-fixed-args* nil) ; proclaim automatically functions
; with fixed number of arguments.
; watch out for multiple values.
(defvar *global-var-objects* nil) ; var objects for global/special vars
(defvar *global-vars* nil) ; variables declared special
(defvar *global-funs* nil) ; holds { fun }*
(defvar *global-cfuns-array* nil) ; holds { fun }*
(defvar *lex-local-funs* nil) ; holds { fun }* ;; JCB
(defvar *linking-calls* nil) ; holds { ( global-fun-name fun symbol c-fun-name var-name ) }*
(defvar *local-funs* nil) ; holds { fun }*
(defvar *top-level-forms* nil) ; holds { top-level-form }*
(defvar *make-forms* nil) ; holds { top-level-form }*
;;;
;;; top-level-form:
;;; ( 'DEFUN' fun-name cfun lambda-expr doc-vv sp )
;;; | ( 'DEFMACRO' macro-name cfun lambda-expr doc-vv sp )
;;; | ( 'ORDINARY' expr )
;;; | ( 'DECLARE' var-name-vv )
;;; | ( 'DEFVAR' var-name-vv expr doc-vv )
;;; | ( 'CLINES' string* )
;;; | ( 'LOAD-TIME-VALUE' vv )
(defvar *reservations* nil)
(defvar *reservation-cmacro* nil)
;;; *reservations* holds (... ( cmacro . value ) ...).
;;; *reservation-cmacro* holds the cmacro current used as vs reservation.
(defvar *self-destructing-fasl* '()
"A value T means that, when a FASL module is being unloaded (for
instance during garbage collection), the associated file will be
deleted. We need this for #'COMPILE because windows DLLs cannot
be deleted if they have been opened with LoadLibrary.")
(defvar *undefined-vars* nil)
(defvar *compiler-floating-point-exclusion-set* '(floating-point-inexact
floating-point-invalid-operation
floating-point-underflow
floating-point-overflow
division-by-zero))
(defconstant keyword-package (find-package "KEYWORD"))