source: trunk/source/level-1/l1-init.lisp @ 12763

Last change on this file since 12763 was 12664, checked in by gz, 10 years ago

Change *SAVE-SOURCE-LOCATIONS* default from :NO-TEXT to T. Leave *CCL-SAVE-SOURCE-LOCATIONS* as :NO-TEXT by default, but set it to T in SET-DEVELOPMENT-ENVIRONMENT.

The reasoning is this: :no-text only makes sense for files that don't change. For files that change, it's worse than useless. For files that don't change, it works just fine and saves space. For most users, the ccl sources are read-only, so :no-text is fine for building ccl. Users who modify ccl sources should do (set-development-environment) in their init files to set up the best environment for doing so.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.1 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel :execute :load-toplevel)
20
21(defconstant most-positive-short-float (make-short-float-from-fixnums (1- (ash 1 23)) 254 0))
22(defconstant most-negative-short-float (make-short-float-from-fixnums (1- (ash 1 23)) 254 -1))
23(defconstant most-positive-single-float (make-short-float-from-fixnums (1- (ash 1 23)) 254 0))
24(defconstant most-negative-single-float (make-short-float-from-fixnums (1- (ash 1 23)) 254 -1))
25
26
27(defconstant least-positive-short-float (make-short-float-from-fixnums 1 0 0))
28(defconstant least-negative-short-float (make-short-float-from-fixnums 1 0 -1))
29(defconstant least-positive-single-float (make-short-float-from-fixnums 1 0 0))
30(defconstant least-negative-single-float (make-short-float-from-fixnums 1 0 -1))
31
32(defconstant short-float-epsilon (make-short-float-from-fixnums 1 103 0))
33(defconstant short-float-negative-epsilon (make-short-float-from-fixnums 1 102 0))
34(defconstant single-float-epsilon (make-short-float-from-fixnums 1 103 0))
35(defconstant single-float-negative-epsilon (make-short-float-from-fixnums 1 102 0))
36
37(defconstant least-positive-normalized-short-float (make-short-float-from-fixnums 1 1 0))
38(defconstant least-negative-normalized-short-float (make-short-float-from-fixnums 1 1 -1))
39(defconstant least-positive-normalized-single-float (make-short-float-from-fixnums 1 1 0))
40(defconstant least-negative-normalized-single-float (make-short-float-from-fixnums 1 1 -1))
41
42(let ((bigfloat (make-float-from-fixnums #x1ffffff #xfffffff #x7fe 0)))
43  ; do it this way if you want to be able to compile before reading floats works 
44  (defconstant most-positive-double-float bigfloat)
45  (defconstant most-positive-long-float bigfloat)
46  )
47
48(let ((littleposfloat (make-float-from-fixnums 0 1 0 0 )))
49  (defconstant least-positive-double-float littleposfloat)
50  (defconstant least-positive-long-float littleposfloat)
51  )
52
53(let ((littlenegfloat (make-float-from-fixnums 0 1 0 -1))) 
54  (defconstant least-negative-double-float littlenegfloat)
55  (defconstant least-negative-long-float littlenegfloat)
56  )
57
58(let ((bignegfloat (make-float-from-fixnums #x1ffffff #xfffffff #x7fe -1)))
59  (defconstant most-negative-double-float bignegfloat)
60  (defconstant most-negative-long-float bignegfloat)
61  )
62
63(let ((eps (make-float-from-fixnums #x1000000 1 #x3ca 0))) ;was wrong
64  (defconstant double-float-epsilon eps)
65  (defconstant long-float-epsilon eps)
66  )
67
68(let ((eps- (make-float-from-fixnums #x1000000 1 #x3c9 1)))
69  (defconstant double-float-negative-epsilon eps-)
70  (defconstant long-float-negative-epsilon eps-)
71  )
72
73(let ((norm (make-float-from-fixnums 0 0 1 0)))
74  (defconstant least-positive-normalized-double-float norm)
75  (defconstant least-positive-normalized-long-float norm)
76  )
77
78(let ((norm- (make-float-from-fixnums 0 0 1 -1)))
79  (defconstant least-negative-normalized-double-float norm-)
80  (defconstant least-negative-normalized-long-float norm-)
81  )
82
83(defconstant pi (make-float-from-fixnums #x921fb5 #x4442d18 #x400 0))
84
85)
86
87
88
89(defconstant boole-clr 0
90  "Boole function op, makes BOOLE return 0.")
91(defconstant boole-set 1
92  "Boole function op, makes BOOLE return -1.")
93(defconstant boole-1 2
94  "Boole function op, makes BOOLE return integer1.")
95(defconstant boole-2 3
96  "Boole function op, makes BOOLE return integer2.")
97(defconstant boole-c1 4
98  "Boole function op, makes BOOLE return complement of integer1.")
99(defconstant boole-c2 5
100  "Boole function op, makes BOOLE return complement of integer2.")
101(defconstant boole-and 6
102  "Boole function op, makes BOOLE return logand of integer1 and integer2.")
103(defconstant boole-ior 7
104  "Boole function op, makes BOOLE return logior of integer1 and integer2.")
105(defconstant boole-xor 8
106  "Boole function op, makes BOOLE return logxor of integer1 and integer2.")
107(defconstant boole-eqv 9
108  "Boole function op, makes BOOLE return logeqv of integer1 and integer2.")
109(defconstant boole-nand 10
110  "Boole function op, makes BOOLE return log nand of integer1 and integer2.")
111(defconstant boole-nor 11
112  "Boole function op, makes BOOLE return lognor of integer1 and integer2.")
113(defconstant boole-andc1 12
114  "Boole function op, makes BOOLE return logandc1 of integer1 and integer2.")
115(defconstant boole-andc2 13
116  "Boole function op, makes BOOLE return logandc2 of integer1 and integer2.")
117(defconstant boole-orc1 14
118  "Boole function op, makes BOOLE return logorc1 of integer1 and integer2.")
119(defconstant boole-orc2 15
120  "Boole function op, makes BOOLE return logorc2 of integer1 and integer2.")
121
122
123
124(defconstant internal-time-units-per-second #+64-bit-target 1000000 #-64-bit-target 1000
125  "The number of internal time units that fit into a second. See
126  GET-INTERNAL-REAL-TIME and GET-INTERNAL-RUN-TIME.")
127
128(defconstant char-code-limit #.(arch::target-char-code-limit
129                                (backend-target-arch *target-backend*))
130  "the upper exclusive bound on values produced by CHAR-CODE")
131
132(defconstant array-rank-limit (floor #x8000 target::node-size)
133  "the exclusive upper bound on the rank of an array")
134(defconstant multiple-values-limit 200
135  "The exclusive upper bound on the number of multiple VALUES that you can
136  return.")
137(defconstant lambda-parameters-limit (floor #x8000 target::node-size)
138  "The exclusive upper bound on the number of parameters which may be specifed
139  in a given lambda list. This is actually the limit on required and &OPTIONAL
140  parameters. With &KEY and &AUX you can get more.")
141(defconstant call-arguments-limit (floor #x8000 target::node-size)
142  "The exclusive upper bound on the number of arguments which may be passed
143  to a function, including &REST args."
144)
145
146; Currently, vectors can be at most (expt 2 22) bytes, and
147; the largest element (double-float or long-float) is 8 bytes:
148#| to get largest element size...
149(apply #'max (mapcar #'(lambda (type)
150                         (%vect-byte-size (make-array 1 :element-type type)))
151                     *cl-types*))
152|#
153
154(defconstant array-dimension-limit array-total-size-limit
155  "the exclusive upper bound on any given dimension of an array")
156
157(defconstant most-positive-fixnum target::target-most-positive-fixnum
158  "the fixnum closest in value to positive infinity")
159(defconstant most-negative-fixnum target::target-most-negative-fixnum
160  "the fixnum closest in value to negative infinity")
161
162
163(defconstant lambda-list-keywords 
164  '(&OPTIONAL &REST &AUX &KEY &ALLOW-OTHER-KEYS &BODY &ENVIRONMENT &WHOLE)
165  "symbols which are magical in a lambda list")
166
167(defstatic *type-system-initialized* nil)
168
169(defparameter %toplevel-catch% ':toplevel)
170
171(defvar *read-default-float-format* 'single-float)
172
173(defvar *read-suppress* nil
174  "Suppress most interpreting in the reader when T.")
175
176(defvar *read-base* 10.
177  "the radix that Lisp reads numbers in")
178
179
180(defparameter *warn-if-redefine-kernel* nil
181  "When true, attempts to redefine (via DEFUN or DEFMETHOD) functions and
182methods that are marked as being predefined signal continuable errors.")
183
184(defvar *next-screen-context-lines* 2 "Number of lines to show of old screen
185  after a scroll-up or scroll-down.")
186
187(defparameter *compiling-file* nil 
188  "Name of outermost file being compiled or NIL if not compiling a file.")
189
190(defvar *eval-fn-name* nil)
191
192
193(defvar *compile-definitions* t
194  "When non-NIL and the evaluator's lexical environment contains no
195  lexical entities, causes FUNCTION and NFUNCTION forms to be compiled.")
196#|
197(defvar *fast-eval* ()
198  "If non-nil, compile-and-call any forms which would be expensive to evaluate.")
199|#
200(defvar *declaration-handlers* ())
201
202
203(defvar *lisp-system-pointer-functions* nil)
204(defvar *lisp-user-pointer-functions* nil)
205(defvar *lisp-cleanup-functions* nil)   ; list of (0-arg) functions to call before quitting Lisp
206(defvar *lisp-startup-functions* nil)   ; list of funs to call after startup.
207(defvar %lisp-system-fixups% nil)
208
209
210(setf (*%saved-method-var%*) nil)
211
212; The GC expects these to be NIL or a function of no args
213(defvar *pre-gc-hook* nil)
214(defvar *post-gc-hook* nil)
215
216; These are used by add-gc-hook, delete-gc-hook
217(defvar *pre-gc-hook-list* nil)
218(defvar *post-gc-hook-list* nil)
219
220(defvar *backtrace-dialogs* nil)
221;(defvar *stepper-running* nil)
222(defparameter *last-mouse-down-time* 0)
223(defparameter *last-mouse-down-position* 0)
224
225(defvar %handlers% ())
226
227
228#|
229(defvar %restarts% (list (list (%cons-restart 'abort
230                                              #'(lambda (&rest ignore)
231                                                  (declare (ignore ignore))
232                                                  (throw :toplevel nil))
233                                              "Restart the toplevel loop."
234                                              nil
235                                              nil))))
236|#
237
238(defvar %restarts% nil)
239
240(defvar ccl::*kernel-restarts* nil)
241(defvar *condition-restarts* nil "explicit mapping between c & r")
242(declaim (list %handlers% %restarts% ccl::*kernel-restarts* *condition-restarts*))
243
244
245
246
247(defparameter *%periodic-tasks%* nil)
248(defparameter *dribble-stream* nil)
249
250(defconstant *keyword-package* *keyword-package*)
251(defconstant *common-lisp-package* *common-lisp-package*)
252(defconstant *ccl-package* *ccl-package*)
253
254(defparameter *load-print* nil "the default for the :PRINT argument to LOAD")
255(defparameter *loading-files* nil)
256(defparameter *break-level* 0)
257(defparameter *last-break-level* 0)
258(defparameter *warn-if-redefine* nil)
259(defvar *record-source-file*)           ; set in l1-utils.
260(defparameter *level-1-loaded* nil)     ; set t by l1-boot
261(defparameter *save-definitions* nil)
262(defparameter *save-local-symbols* t)
263(defparameter *save-source-locations* T
264  "Controls whether source location information is saved, both for definitions (names) and
265in function objects.
266
267If NIL we don't store any source locations (other than the filename if *record-source-file* is non-NIL).
268
269If T we store as much source location information as we have available.
270
271If :NO-TEXT we don't store a copy of the original source text.  This is a space optimization useful
272for compiling files that are not expected to change.")
273
274(defparameter *record-pc-mapping* t "True to record pc -> source mapping (but only if
275*save-source-locations* is also true)")
276
277(defvar *modules* nil
278  "This is a list of module names that have been loaded into Lisp so far.
279   The names are case sensitive strings.  It is used by PROVIDE and REQUIRE.")
280
281
282
283
284
285(defparameter *eof-value* (cons nil nil))
286
287(defvar *gc-event-status-bits*)         ; also initialized by kernel
288
289(defparameter *top-listener* nil)
290
291
292
293
294
295
296
297(defvar *listener-indent* nil)
298
299(defparameter *autoload-lisp-package* nil)   ; Make 'em suffer
300(defparameter *apropos-case-sensitive-p* nil)
301
302(defloadvar *total-gc-microseconds* (let* ((timeval-size
303                                            #.(%foreign-type-or-record-size
304                                               :timeval :bytes))
305                                           (p (malloc (* 5 timeval-size))))
306                                      (#_memset p 0 (* 5 timeval-size))
307                                      p))
308
309
310(defloadvar *total-bytes-freed* (let* ((p (malloc 8)))
311                                  (setf (%get-long p 0) 0
312                                        (%get-long p 4) 0)
313                                  p))
314
315
316
317(defvar *terminal-character-encoding-name* nil
318  "NIL (implying :ISO-8859-1), or a keyword which names a defined
319character encoding to be used for *TERMINAL-IO* and other predefined
320initial streams.  The value of *TERMINAL-CHARACTER-ENCODING-NAME*
321persists across calls to SAVE-APPLICATION; it can be specified via
322the command-line argument --terminal-encoding (-K)")
323
324
325(defconstant +null-ptr+ (%null-ptr))
326
327;;; end of L1-init.lisp
328
Note: See TracBrowser for help on using the repository browser.