source: trunk/source/compiler/arch.lisp @ 8578

Last change on this file since 8578 was 8578, checked in by gb, 12 years ago

Add constants for tcr interrupts, suspend/resume UUOs. (Mostly
PPC-specific.)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 9.4 KB
Line 
1;;;-*- Mode: Lisp; Package: (ARCH :use CL) -*-
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(defpackage "ARCH"
18  (:use "CL"))
19
20(in-package "ARCH")
21
22
23
24(eval-when (:compile-toplevel :load-toplevel :execute)
25
26
27
28(defconstant tcr-flag-bit-foreign 0)
29(defconstant tcr-flag-bit-awaiting-preset 1)
30(defconstant tcr-flag-bit-alt-suspend 2)
31(defconstant tcr-flag-bit-propagate-exception 3)
32(defconstant tcr-flag-bit-suspend-ack-pending 4)
33(defconstant tcr-flag-bit-pending-exception 5)
34(defconstant tcr-flag-bit-foreign-exception 6)
35(defconstant tcr-flag-bit-pending-suspend 7)       
36
37
38
39)
40
41(defmacro make-vheader (element-count subtag)
42  `(logior ,subtag (ash ,element-count 8)))
43
44
45
46;;; Error numbers, as used in UU0s and such.
47;;; These match constants defined in the kernel sources.
48(defconstant error-reg-regnum 0)        ; "real" error number is in RB field of UU0.
49                                        ; Currently only used for :errchk in emulated traps
50                                        ; The errchk macro should expand into a check-trap-error vinsn, too.
51(defconstant error-udf 1)               ; Undefined function (reported by symbol-function)
52(defconstant error-udf-call 2)          ; Attempt to call undefined function
53(defconstant error-throw-tag-missing 3)
54(defconstant error-alloc-failed 4)      ; can't allocate (largish) vector
55(defconstant error-stack-overflow 5)    ; some stack overflowed.
56(defconstant error-excised-function-call 6)     ; excised function was called.
57(defconstant error-too-many-values 7)   ; too many values returned
58(defconstant error-cant-take-car 8)
59(defconstant error-cant-take-cdr 9)
60(defconstant error-propagate-suspend 10)
61(defconstant error-interrupt 11)
62(defconstant error-suspend 12)
63(defconstant error-suspend-all 13)
64(defconstant error-resume 14)
65(defconstant error-resume-all 15)
66(defconstant error-cant-call 17)        ; Attempt to funcall something that is not a symbol or function.
67(eval-when (:compile-toplevel :load-toplevel :execute)
68  (defconstant error-type-error 128)
69)
70
71(defconstant error-fpu-exception-double 1024)   ; FPU exception, binary double-float op
72(defconstant error-fpu-exception-single 1025)
73
74(defconstant error-memory-full 2048)
75
76;; These are now supposed to match (mod ERROR-TYPE-ERROR) the %type-error-typespecs%
77;; array that %err-disp looks at.
78(ccl::defenum (:start  error-type-error :prefix "ERROR-OBJECT-NOT-")
79  array
80  bignum
81  fixnum
82  character
83  integer
84  list
85  number
86  sequence
87  simple-string
88  simple-vector
89  string
90  symbol
91  macptr
92  real
93  cons
94  unsigned-byte
95  radix
96  float 
97  rational
98  ratio
99  short-float
100  double-float
101  complex
102  vector
103  simple-base-string
104  function
105  unsigned-byte-16
106  unsigned-byte-8
107  unsigned-byte-32
108  signed-byte-32
109  signed-byte-16
110  signed-byte-8
111  base-char
112  bit
113  unsigned-byte-24
114  unsigned-byte-64
115  signed-byte-64
116  unsigned-byte-56
117  simple-array-double-float-2d
118  simple-array-single-float-2d
119  mod-char-code-limit
120  array-2d
121  array-3d
122  array-t
123  array-bit
124  array-s8
125  array-u8
126  array-s16
127  array-u16
128  array-s32
129  array-u32
130  array-s64
131  array-u64
132  array-fixnum
133  array-single-float
134  array-double-float
135  array-char
136  array-t-2d
137  array-bit-2d
138  array-s8-2d
139  array-u8-2d
140  array-s16-2d
141  array-u16-2d
142  array-s32-2d
143  array-u32-2d
144  array-s64-2d
145  array-u64-2d
146  array-fixnum-2d
147  array-single-float-2d
148  array-double-float-2d
149  array-char-2d
150  simple-array-t-2d
151  simple-array-bit-2d
152  simple-array-s8-2d
153  simple-array-u8-2d
154  simple-array-s16-2d
155  simple-array-u16-2d
156  simple-array-s32-2d
157  simple-array-u32-2d
158  simple-array-s64-2d
159  simple-array-u64-2d
160  simple-array-fixnum-2d
161  simple-array-char-2d
162  array-t-3d
163  array-bit-3d
164  array-s8-3d
165  array-u8-3d
166  array-s16-3d
167  array-u16-3d
168  array-s32-3d
169  array-u32-3d
170  array-s64-3d
171  array-u64-3d
172  array-fixnum-3d
173  array-single-float-3d
174  array-double-float-3d
175  array-char-3d
176  simple-array-t-3d
177  simple-array-bit-3d
178  simple-array-s8-3d
179  simple-array-u8-3d
180  simple-array-s16-3d
181  simple-array-u16-3d
182  simple-array-s32-3d
183  simple-array-u32-3d
184  simple-array-s64-3d
185  simple-array-u64-3d
186  simple-array-fixnum-3d
187  simple-array-single-float-3d
188  simple-array-double-float-3d
189  simple-array-char-3d
190
191  ;; Sentinel
192  unused-max-type-error
193  )
194
195(assert (<= error-object-not-unused-max-type-error (* 2 error-type-error)))
196
197
198
199
200
201(defun builtin-function-name-offset (name)
202  (and name (position name ccl::%builtin-functions% :test #'eq)))
203
204(ccl::defenum ()
205  storage-class-lisp                    ; General lisp objects
206  storage-class-imm                     ; Fixnums, chars, NIL: not relocatable
207  storage-class-wordptr                 ; "Raw" (fixnum-tagged) pointers to stack,etc
208  storage-class-u8                      ; Unsigned, untagged, 8-bit objects
209  storage-class-s8                      ; Signed, untagged, 8-bit objects
210  storage-class-u16                     ; Unsigned, untagged, 16-bit objects
211  storage-class-s16                     ; Signed, untagged, 16-bit objects
212  storage-class-u32                     ; Unsigned, untagged, 8-bit objects
213  storage-class-s32                     ; Signed, untagged, 8-bit objects
214  storage-class-address                 ; "raw" (untagged) 32-bit addresses.
215  storage-class-single-float            ; 32-bit single-float objects
216  storage-class-double-float            ; 64-bit double-float objects
217  storage-class-pc                      ; pointer to/into code vector
218  storage-class-locative                ; pointer to/into node-misc object
219  storage-class-crf                     ; condition register field
220  storage-class-crbit                   ; condition register bit: 0-31
221  storage-class-crfbit                  ; bit within condition register field : 0-3
222  storage-class-u64                     ; (unsigned-byte 64)
223  storage-class-s64                     ; (signed-byte 64)
224)
225
226
227(defvar *known-target-archs* ())
228
229(defstruct (target-arch (:conc-name target-)
230                        (:constructor %make-target-arch))
231  (name nil)
232  (lisp-node-size 0)
233  (nil-value 0)
234  (fixnum-shift 0)
235  (most-positive-fixnum 0)
236  (most-negative-fixnum 0)
237  (misc-data-offset 0)
238  (misc-dfloat-offset 0)
239  (nbits-in-word 0)
240  (ntagbits 0)
241  (nlisptagbits 0)
242  (uvector-subtags 0)
243  (max-64-bit-constant-index 0)
244  (max-32-bit-constant-index 0)
245  (max-16-bit-constant-index 0)
246  (max-8-bit-constant-index 0)
247  (max-1-bit-constant-index 0)
248  (word-shift 0)
249  (code-vector-prefix ())
250  (gvector-types ())
251  (1-bit-ivector-types ())
252  (8-bit-ivector-types ())
253  (16-bit-ivector-types ())
254  (32-bit-ivector-types ())
255  (64-bit-ivector-types ())
256  (array-type-name-from-ctype-function ())
257  (package-name ())
258  (t-offset ())
259  (array-data-size-function ())
260  (numeric-type-name-to-typecode-function ())
261  (subprims-base ())
262  (subprims-shift ())
263  (subprims-table ())
264  (primitive->subprims ())
265  (unbound-marker-value ())
266  (slot-unbound-marker-value ())
267  (fixnum-tag 0)
268  (single-float-tag nil)
269  (single-float-tag-is-subtag nil)
270  (double-float-tag nil)
271  (cons-tag nil)
272  (null-tag nil)
273  (symbol-tag nil)
274  (symbol-tag-is-subtag nil)
275  (function-tag nil)
276  (function-tag-is-subtag nil)
277  (big-endian t)
278  (target-macros (make-hash-table :test #'eq))
279  (misc-subtag-offset 0)
280  (car-offset 0)
281  (cdr-offset 0)
282  (subtag-char 0)
283  (charcode-shift 0)
284  (fulltagmask 0)
285  (fulltag-misc 0)
286  (char-code-limit nil))
287 
288
289 
290 
291 
292(defun make-target-arch (&rest keys)
293  (declare (dynamic-extent keys))
294  (let* ((arch (apply #'%make-target-arch keys))
295         (tail (member (target-name arch) *known-target-archs*
296                       :key #'target-name
297                       :test #'eq)))
298    (if tail
299      (rplaca tail arch)
300      (push arch *known-target-archs*))
301    arch))
302
303(defun find-target-arch (name)
304  (car (member name *known-target-archs*
305               :key #'target-name
306               :test #'eq)))
307
308(defun target-arch-macros (arch-name)
309  (let* ((arch (or (find-target-arch arch-name)
310                   (error "unknown arch: ~s" arch-name))))
311    (target-target-macros arch)))
312
313(defmacro defarchmacro (arch-name name arglist &body body &environment env)
314  (let* ((lambda-form (ccl::parse-macro-1 name arglist body env)))
315    `(progn
316      (setf (gethash ',name (target-arch-macros ',arch-name))
317       (ccl::nfunction ,name ,lambda-form))
318      ',name)))
319
320(defun arch-macro-function (arch-name name)
321  (gethash name (target-arch-macros arch-name)))
322   
323
324
325;;; GC related operations
326(defconstant gc-trap-function-immediate-gc -1)
327(defconstant gc-trap-function-gc 0)
328(defconstant gc-trap-function-purify 1)
329(defconstant gc-trap-function-impurify 2)
330(defconstant gc-trap-function-save-application 8)
331(defconstant gc-trap-function-get-lisp-heap-threshold 16)
332(defconstant gc-trap-function-set-lisp-heap-threshold 17)
333(defconstant gc-trap-function-use-lisp-heap-threshold 18)
334(defconstant gc-trap-function-egc-control 32)
335(defconstant gc-trap-function-configure-egc 64)
336(defconstant gc-trap-function-set-hons-area-size 128)
337(defconstant gc-trap-function-freeze 129)
338(defconstant gc-trap-function-thaw 130)
339
340
341
342(provide "ARCH")
Note: See TracBrowser for help on using the repository browser.