source: release/1.4/source/level-1/l1-init.lisp @ 13535

Last change on this file since 13535 was 13535, checked in by rme, 10 years ago

Merge r13529 through r13532 (special-case divisor of -1 in %fixnum-truncate)
from trunk to 1.4 branch. Fixes ticket:666.

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