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

Last change on this file since 16685 was 16685, checked in by rme, 4 years ago

Update copyright/license headers in files.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.4 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;; Copyright 1994-2009 Clozure Associates
4;;;
5;;; Licensed under the Apache License, Version 2.0 (the "License");
6;;; you may not use this file except in compliance with the License.
7;;; You may obtain a copy of the License at
8;;;
9;;;     http://www.apache.org/licenses/LICENSE-2.0
10;;;
11;;; Unless required by applicable law or agreed to in writing, software
12;;; distributed under the License is distributed on an "AS IS" BASIS,
13;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14;;; See the License for the specific language governing permissions and
15;;; limitations under the License.
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 #+ppc-target (floor #x8000 target::node-size)
142                                  #-ppc-target #x10000
143  "The exclusive upper bound on the number of arguments which may be passed
144  to a function, including &REST args."
145)
146
147; Currently, vectors can be at most (expt 2 22) bytes, and
148; the largest element (double-float or long-float) is 8 bytes:
149#| to get largest element size...
150(apply #'max (mapcar #'(lambda (type)
151                         (%vect-byte-size (make-array 1 :element-type type)))
152                     *cl-types*))
153|#
154
155(defconstant array-dimension-limit array-total-size-limit
156  "the exclusive upper bound on any given dimension of an array")
157
158(defconstant most-positive-fixnum target::target-most-positive-fixnum
159  "the fixnum closest in value to positive infinity")
160(defconstant most-negative-fixnum target::target-most-negative-fixnum
161  "the fixnum closest in value to negative infinity")
162
163(defstatic *least-positive-bignum* (1+ target::target-most-positive-fixnum)
164  "used internally; value should be treated as a constant")
165
166
167(defconstant lambda-list-keywords 
168  '(&OPTIONAL &REST &AUX &KEY &ALLOW-OTHER-KEYS &BODY &ENVIRONMENT &WHOLE)
169  "symbols which are magical in a lambda list")
170
171(defstatic *type-system-initialized* nil)
172
173(defparameter %toplevel-catch% ':toplevel)
174
175
176
177(defparameter *warn-if-redefine-kernel* nil
178  "When true, attempts to redefine (via DEFUN or DEFMETHOD) functions and
179methods that are marked as being predefined signal continuable errors.")
180
181(defvar *next-screen-context-lines* 2 "Number of lines to show of old screen
182  after a scroll-up or scroll-down.")
183
184(defparameter *compiling-file* nil 
185  "Name of outermost file being compiled or NIL if not compiling a file.")
186
187(defvar *eval-fn-name* nil)
188
189
190(defvar *compile-definitions* t
191  "When non-NIL and the evaluator's lexical environment contains no
192  lexical entities, causes FUNCTION and NFUNCTION forms to be compiled.")
193#|
194(defvar *fast-eval* ()
195  "If non-nil, compile-and-call any forms which would be expensive to evaluate.")
196|#
197(defvar *declaration-handlers* ())
198
199
200(defvar *lisp-system-pointer-functions* nil)
201(defvar *lisp-user-pointer-functions* nil)
202(defvar *lisp-cleanup-functions* nil)   ; list of (0-arg) functions to call before quitting Lisp
203(defvar *lisp-startup-functions* nil)   ; list of funs to call after startup.
204(defvar %lisp-system-fixups% nil)
205
206
207(setf (*%saved-method-var%*) nil)
208
209; The GC expects these to be NIL or a function of no args
210(defvar *pre-gc-hook* nil)
211(defvar *post-gc-hook* nil)
212
213; These are used by add-gc-hook, delete-gc-hook
214(defvar *pre-gc-hook-list* nil)
215(defvar *post-gc-hook-list* nil)
216
217(defvar *backtrace-dialogs* nil)
218;(defvar *stepper-running* nil)
219(defparameter *last-mouse-down-time* 0)
220(defparameter *last-mouse-down-position* 0)
221
222(defvar %handlers% ())
223
224
225#|
226(defvar %restarts% (list (list (%cons-restart 'abort
227                                              #'(lambda (&rest ignore)
228                                                  (declare (ignore ignore))
229                                                  (throw :toplevel nil))
230                                              "Restart the toplevel loop."
231                                              nil
232                                              nil))))
233|#
234
235(defvar %restarts% nil)
236
237(defvar ccl::*kernel-restarts* nil)
238(defvar *condition-restarts* nil "explicit mapping between c & r")
239(declaim (list %handlers% %restarts% ccl::*kernel-restarts* *condition-restarts*))
240
241
242
243
244(defparameter *%periodic-tasks%* nil)
245(defparameter *dribble-stream* nil)
246
247(defconstant *keyword-package* *keyword-package*)
248(defconstant *common-lisp-package* *common-lisp-package*)
249(defconstant *ccl-package* *ccl-package*)
250
251(defparameter *load-print* nil "the default for the :PRINT argument to LOAD")
252(defparameter *loading-files* nil)
253(defparameter *break-level* 0)
254(defparameter *last-break-level* 0)
255(defparameter *warn-if-redefine* nil)
256(defvar *record-source-file*)           ; set in l1-utils.
257(defparameter *level-1-loaded* nil)     ; set t by l1-boot
258(defparameter *save-definitions* nil)
259(defparameter *save-local-symbols* t)
260(defparameter *save-source-locations* T
261  "Controls whether source location information is saved, both for definitions (names) and
262in function objects.
263
264If NIL we don't store any source locations (other than the filename if *record-source-file* is non-NIL).
265
266If T we store as much source location information as we have available.
267
268If :NO-TEXT we don't store a copy of the original source text.  This is a space optimization useful
269for compiling files that are not expected to change.")
270
271(defparameter *record-pc-mapping* t "True to record pc -> source mapping (but only if
272*save-source-locations* is also true)")
273
274(defvar *modules* nil
275  "This is a list of module names that have been loaded into Lisp so far.
276   The names are case sensitive strings.  It is used by PROVIDE and REQUIRE.")
277
278
279
280
281
282(defparameter *eof-value* (cons nil nil))
283
284(defvar *gc-event-status-bits*)         ; also initialized by kernel
285
286(defparameter *top-listener* nil)
287
288
289
290
291
292
293
294(defvar *listener-indent* nil)
295
296(defparameter *autoload-lisp-package* nil)   ; Make 'em suffer
297(defparameter *apropos-case-sensitive-p* nil)
298
299(defloadvar *total-gc-microseconds* (let* ((timeval-size
300                                            #.(%foreign-type-or-record-size
301                                               :timeval :bytes))
302                                           (p (malloc (* 5 timeval-size))))
303                                      (#_memset p 0 (* 5 timeval-size))
304                                      p))
305
306
307(defloadvar *total-bytes-freed* (let* ((p (malloc 8)))
308                                  (setf (%get-long p 0) 0
309                                        (%get-long p 4) 0)
310                                  p))
311
312
313
314(defvar *terminal-character-encoding-name* :utf-8
315  "NIL (implying :ISO-8859-1), or a keyword which names a defined
316character encoding to be used for *TERMINAL-IO* and other predefined
317initial streams.  The value of *TERMINAL-CHARACTER-ENCODING-NAME*
318persists across calls to SAVE-APPLICATION; it can be specified via
319the command-line argument --terminal-encoding (-K)")
320
321
322(defconstant +null-ptr+ (%null-ptr))
323
324(defparameter *load-preserves-optimization-settings* nil
325  "When true, the effects of (PROCLAIM (OPTIMIZE ...)) - or the
326   load-time effects of (DECLAIM (OPTIMIZE ...)) - in files being
327   loaded do not persist after the containing file has been loaded.
328   When false, those effects persist until superseded.")
329
330;;; end of L1-init.lisp
331
Note: See TracBrowser for help on using the repository browser.