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

Last change on this file since 1247 was 1247, checked in by gb, 15 years ago

ARRAY-TYPE-NAME-FROM-CTYPE-FUNCTION in arch struct, and PPC32 implementation.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.3 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  )
104
105
106
107
108
109(defun builtin-function-name-offset (name)
110  (and name (position name ccl::%builtin-functions% :test #'eq)))
111
112(ccl::defenum ()
113  storage-class-lisp                    ; General lisp objects
114  storage-class-imm                     ; Fixnums, chars, NIL: not relocatable
115  storage-class-wordptr                 ; "Raw" (fixnum-tagged) pointers to stack,etc
116  storage-class-u8                      ; Unsigned, untagged, 8-bit objects
117  storage-class-s8                      ; Signed, untagged, 8-bit objects
118  storage-class-u16                     ; Unsigned, untagged, 16-bit objects
119  storage-class-s16                     ; Signed, untagged, 16-bit objects
120  storage-class-u32                     ; Unsigned, untagged, 8-bit objects
121  storage-class-s32                     ; Signed, untagged, 8-bit objects
122  storage-class-address                 ; "raw" (untagged) 32-bit addresses.
123  storage-class-single-float            ; 32-bit single-float objects
124  storage-class-double-float            ; 64-bit double-float objects
125  storage-class-pc                      ; pointer to/into code vector
126  storage-class-locative                ; pointer to/into node-misc object
127  storage-class-crf                     ; condition register field
128  storage-class-crbit                   ; condition register bit: 0-31
129  storage-class-crfbit                  ; bit within condition register field : 0-3
130  storage-class-u64                     ; (unsigned-byte 64)
131  storage-class-s64                     ; (signed-byte 64)
132)
133
134;; For assembly/disassembly, at least on RISC platforms.
135(defstruct opcode 
136  (name (error "Opcode name must be present") :type (or string symbol))
137  (opcode 0 :type (unsigned-byte 32))
138  (majorop 0 :type (unsigned-byte 6))
139  (mask #xffffffff :type (unsigned-byte 32))
140  (flags 0 :type (unsigned-byte 32))
141  (operands () :type list)
142  (min-args 0 :type (unsigned-byte 3))
143  (max-args 0 :type (unsigned-byte 3))
144  (op-high 0 :type (unsigned-byte 16))
145  (op-low 0 :type (unsigned-byte 16))
146  (mask-high #xffff :type (unsigned-byte 16))
147  (mask-low #xffff :type (unsigned-byte 16))
148  (vinsn-operands () :type list)
149  (min-vinsn-args 0 :type fixnum)
150  (max-vinsn-args 0 :type fixnum))
151
152(defmethod print-object ((p opcode) stream)
153  (declare (ignore depth))
154  (print-unreadable-object (p stream :type t) 
155    (format stream "~a" (string (opcode-name p)))))
156
157(defmethod make-load-form ((p opcode) &optional env)
158  (make-load-form-saving-slots p :environment env))
159
160(defstruct operand
161  (index 0 :type unsigned-byte)
162  (width 0 :type (mod 32))
163  (offset 0 :type (mod 32))
164  (insert-function nil :type (or null symbol function))
165  (extract-function 'nil :type (or symbol function))
166  (flags 0 :type fixnum))
167
168(defmethod make-load-form ((o operand) &optional env)
169  (make-load-form-saving-slots o :environment env))
170
171(defconstant operand-optional 27)
172(defconstant operand-fake 28)
173
174(defstruct (target-arch (:conc-name target-))
175  (name nil)
176  (lisp-node-size 0)
177  (nil-value 0)
178  (fixnum-shift 0)
179  (most-positive-fixnum 0)
180  (most-negative-fixnum 0)
181  (misc-data-offset 0)
182  (misc-dfloat-offset 0)
183  (nbits-in-word 0)
184  (ntagbits 0)
185  (nlisptagbits 0)
186  (uvector-subtags 0)
187  (max-64-bit-constant-index 0)
188  (max-32-bit-constant-index 0)
189  (max-16-bit-constant-index 0)
190  (max-8-bit-constant-index 0)
191  (max-1-bit-constant-index 0)
192  (word-shift 0)
193  (code-vector-prefix ())
194  (gvector-types ())
195  (1-bit-ivector-types ())
196  (8-bit-ivector-types ())
197  (16-bit-ivector-types ())
198  (32-bit-ivector-types ())
199  (64-bit-ivector-types ())
200  (array-type-name-from-ctype-function ()))
201
202(ccl::provide "ARCH")
Note: See TracBrowser for help on using the repository browser.