source: trunk/ccl/compiler/arch.lisp @ 3223

Last change on this file since 3223 was 3223, checked in by gb, 14 years ago

More slots for arch-specific type info.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.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
31
32
33)
34
35(defmacro make-vheader (element-count subtag)
36  `(logior ,subtag (ash ,element-count 8)))
37
38
39
40;; Error numbers, as used in UU0s and such.
41;; These match "ccl:pmcl;errors.h" & "ccl:pmcl;errors.s"
42
43(defconstant error-reg-regnum 0)        ; "real" error number is in RB field of UU0.
44                                        ; Currently only used for :errchk in emulated traps
45                                        ; The errchk macro should expand into a check-trap-error vinsn, too.
46(defconstant error-udf 1)               ; Undefined function (reported by symbol-function)
47(defconstant error-udf-call 2)          ; Attempt to call undefined function
48(defconstant error-throw-tag-missing 3)
49(defconstant error-alloc-failed 4)      ; can't allocate (largish) vector
50(defconstant error-stack-overflow 5)    ; some stack overflowed.
51(defconstant error-excised-function-call 6)     ; excised function was called.
52(defconstant error-too-many-values 7)   ; too many values returned
53(defconstant error-cant-take-car 8)
54(defconstant error-cant-take-cdr 9)
55(defconstant error-cant-call 17)        ; Attempt to funcall something that is not a symbol or function.
56(eval-when (:compile-toplevel :load-toplevel :execute)
57  (defconstant error-type-error 64)
58)
59
60(defconstant error-fpu-exception-double 1024)   ; FPU exception, binary double-float op
61(defconstant error-fpu-exception-single 1025)
62
63(defconstant error-memory-full 2048)
64
65;; These are now supposed to match (mod 64) the %type-error-typespecs%
66;; array that %err-disp looks at.
67(ccl::defenum (:start  error-type-error :prefix "ERROR-OBJECT-NOT-")
68  array
69  bignum
70  fixnum
71  character
72  integer
73  list
74  number
75  sequence
76  simple-string
77  simple-vector
78  string
79  symbol
80  macptr
81  real
82  cons
83  unsigned-byte
84  radix
85  float 
86  rational
87  ratio
88  short-float
89  double-float
90  complex
91  vector
92  simple-base-string
93  function
94  unsigned-byte-16
95  unsigned-byte-8
96  unsigned-byte-32
97  signed-byte-32
98  signed-byte-16
99  signed-byte-8
100  base-char
101  bit
102  unsigned-byte-24
103  unsigned-byte-64
104  signed-byte-64
105  unsigned-byte-56
106  )
107
108
109
110
111
112(defun builtin-function-name-offset (name)
113  (and name (position name ccl::%builtin-functions% :test #'eq)))
114
115(ccl::defenum ()
116  storage-class-lisp                    ; General lisp objects
117  storage-class-imm                     ; Fixnums, chars, NIL: not relocatable
118  storage-class-wordptr                 ; "Raw" (fixnum-tagged) pointers to stack,etc
119  storage-class-u8                      ; Unsigned, untagged, 8-bit objects
120  storage-class-s8                      ; Signed, untagged, 8-bit objects
121  storage-class-u16                     ; Unsigned, untagged, 16-bit objects
122  storage-class-s16                     ; Signed, untagged, 16-bit objects
123  storage-class-u32                     ; Unsigned, untagged, 8-bit objects
124  storage-class-s32                     ; Signed, untagged, 8-bit objects
125  storage-class-address                 ; "raw" (untagged) 32-bit addresses.
126  storage-class-single-float            ; 32-bit single-float objects
127  storage-class-double-float            ; 64-bit double-float objects
128  storage-class-pc                      ; pointer to/into code vector
129  storage-class-locative                ; pointer to/into node-misc object
130  storage-class-crf                     ; condition register field
131  storage-class-crbit                   ; condition register bit: 0-31
132  storage-class-crfbit                  ; bit within condition register field : 0-3
133  storage-class-u64                     ; (unsigned-byte 64)
134  storage-class-s64                     ; (signed-byte 64)
135)
136
137;; For assembly/disassembly, at least on RISC platforms.
138(defstruct opcode 
139  (name (error "Opcode name must be present") :type (or string symbol))
140  (opcode 0 :type (unsigned-byte 32))
141  (majorop 0 :type (unsigned-byte 6))
142  (mask #xffffffff :type (unsigned-byte 32))
143  (flags 0 :type (unsigned-byte 32))
144  (operands () :type list)
145  (min-args 0 :type (unsigned-byte 3))
146  (max-args 0 :type (unsigned-byte 3))
147  (op-high 0 :type (unsigned-byte 16))
148  (op-low 0 :type (unsigned-byte 16))
149  (mask-high #xffff :type (unsigned-byte 16))
150  (mask-low #xffff :type (unsigned-byte 16))
151  (vinsn-operands () :type list)
152  (min-vinsn-args 0 :type fixnum)
153  (max-vinsn-args 0 :type fixnum))
154
155(defmethod print-object ((p opcode) stream)
156  (declare (ignore depth))
157  (print-unreadable-object (p stream :type t) 
158    (format stream "~a" (string (opcode-name p)))))
159
160(defmethod make-load-form ((p opcode) &optional env)
161  (make-load-form-saving-slots p :environment env))
162
163(defstruct operand
164  (index 0 :type unsigned-byte)
165  (width 0 :type (mod 32))
166  (offset 0 :type (mod 32))
167  (insert-function nil :type (or null symbol function))
168  (extract-function 'nil :type (or symbol function))
169  (flags 0 :type fixnum))
170
171(defmethod make-load-form ((o operand) &optional env)
172  (make-load-form-saving-slots o :environment env))
173
174(defconstant operand-optional 27)
175(defconstant operand-fake 28)
176
177(defstruct (target-arch (:conc-name target-))
178  (name nil)
179  (lisp-node-size 0)
180  (nil-value 0)
181  (fixnum-shift 0)
182  (most-positive-fixnum 0)
183  (most-negative-fixnum 0)
184  (misc-data-offset 0)
185  (misc-dfloat-offset 0)
186  (nbits-in-word 0)
187  (ntagbits 0)
188  (nlisptagbits 0)
189  (uvector-subtags 0)
190  (max-64-bit-constant-index 0)
191  (max-32-bit-constant-index 0)
192  (max-16-bit-constant-index 0)
193  (max-8-bit-constant-index 0)
194  (max-1-bit-constant-index 0)
195  (word-shift 0)
196  (code-vector-prefix ())
197  (gvector-types ())
198  (1-bit-ivector-types ())
199  (8-bit-ivector-types ())
200  (16-bit-ivector-types ())
201  (32-bit-ivector-types ())
202  (64-bit-ivector-types ())
203  (array-type-name-from-ctype-function ())
204  (package-name ())
205  (t-offset ())
206  (array-data-size-function ())
207  (numeric-type-name-to-typecode-function ())
208  (subprims-base ())
209  (subprims-shift ())
210  (subprims-table ())
211  (primitive->subprims ())
212  (unbound-marker-value ())
213  (slot-unbound-marker-value ())
214  (fixnum-tag 0)
215  (single-float-tag nil)
216  (single-float-tag-is-subtag nil)
217  (double-float-tag nil)
218  (cons-tag nil)
219  (null-tag nil)
220  (symbol-tag nil)
221  (symbol-tag-is-subtag nil)
222  (function-tag nil)
223  (function-tag-is-subtag nil))
224 
225
226
227;;; GC related operations
228(defconstant gc-trap-function-immediate-gc -1)
229(defconstant gc-trap-function-gc 0)
230(defconstant gc-trap-function-purify 1)
231(defconstant gc-trap-function-impurify 2)
232(defconstant gc-trap-function-save-application 8)
233(defconstant gc-trap-function-get-lisp-heap-threshold 16)
234(defconstant gc-trap-function-set-lisp-heap-threshold 17)
235(defconstant gc-trap-function-use-lisp-heap-threshold 18)
236(defconstant gc-trap-function-egc-control 32)
237(defconstant gc-trap-function-configure-egc 64)
238(defconstant gc-trap-function-set-hons-area-size 128)
239
240
241(provide "ARCH")
Note: See TracBrowser for help on using the repository browser.