1 ;;;; miscellaneous VM definition noise for the Alpha
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; defining the registers
16 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
17 (defvar *register-names
* (make-array 32 :initial-element nil
)))
19 (macrolet ((defreg (name offset
)
20 (let ((offset-sym (symbolicate name
"-OFFSET")))
21 `(eval-when (:compile-toplevel
:load-toplevel
:execute
)
22 (def!constant
,offset-sym
,offset
)
23 (setf (svref *register-names
* ,offset-sym
)
24 ,(symbol-name name
)))))
25 (defregset (name &rest regs
)
26 `(eval-when (:compile-toplevel
:load-toplevel
:execute
)
28 (list ,@(mapcar (lambda (name)
29 (symbolicate name
"-OFFSET"))
31 ;; c.f. src/runtime/alpha-lispregs.h
68 ;; Assembler temp (at)
70 ;; Global pointer (gp)
77 (defregset non-descriptor-regs
78 nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc
)
80 (defregset descriptor-regs
81 fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2
)
83 (defregset *register-arg-offsets
*
85 (defparameter register-arg-names
'(a0 a1 a2 a3 a4 a5
)))
87 (define-storage-base registers
:finite
:size
32)
88 (define-storage-base float-registers
:finite
:size
64)
89 (define-storage-base control-stack
:unbounded
:size
8)
90 (define-storage-base non-descriptor-stack
:unbounded
:size
0)
91 (define-storage-base constant
:non-packed
)
92 (define-storage-base immediate-constant
:non-packed
)
94 ;;; a handy macro so we don't have to keep changing all the numbers
95 ;;; whenever we insert a new storage class.
97 (defmacro !define-storage-classes
(&rest classes
)
98 (do ((forms (list 'progn
)
99 (let* ((class (car classes
))
100 (sc-name (car class
))
101 (constant-name (intern (concatenate 'simple-string
104 (list* `(define-storage-class ,sc-name
,index
106 `(def!constant
,constant-name
,index
)
107 ;; (The CMU CL version of this macro did
108 ;; `(EXPORT ',CONSTANT-NAME)
109 ;; here, but in SBCL we try to have package
110 ;; structure described statically in one
111 ;; master source file, instead of building it
112 ;; dynamically by letting all the system code
113 ;; modify it as the system boots.)
116 (classes classes
(cdr classes
)))
120 (def!constant kludge-nondeterministic-catch-block-size
7)
122 (!define-storage-classes
124 ;; non-immediate constants in the constant pool
127 ;; ZERO and NULL are in registers.
128 (zero immediate-constant
)
129 (null immediate-constant
)
130 (fp-single-zero immediate-constant
)
131 (fp-double-zero immediate-constant
)
133 ;; Anything else that can be an immediate.
134 (immediate immediate-constant
)
139 ;; The control stack. (Scanned by GC)
140 (control-stack control-stack
)
142 ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
143 ;; is small and therefore the error trap information is smaller.
144 ;; Moving them up here from their previous place down below saves
145 ;; ~250K in core file size. --njf, 2006-01-27
147 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
148 ;; bad will happen if they are. (fixnums, characters, header values, etc).
151 :locations
#.
(append non-descriptor-regs descriptor-regs
)
152 :constant-scs
(zero immediate
)
154 :alternate-scs
(control-stack))
156 ;; Pointer descriptor objects. Must be seen by GC.
157 (descriptor-reg registers
158 :locations
#.descriptor-regs
159 :constant-scs
(constant null immediate
)
161 :alternate-scs
(control-stack))
163 ;; The non-descriptor stacks.
164 (signed-stack non-descriptor-stack
165 :element-size
2 :alignment
2) ; (signed-byte 64)
166 (unsigned-stack non-descriptor-stack
167 :element-size
2 :alignment
2) ; (unsigned-byte 64)
168 (character-stack non-descriptor-stack
) ; non-descriptor characters.
169 (sap-stack non-descriptor-stack
170 :element-size
2 :alignment
2) ; System area pointers.
171 (single-stack non-descriptor-stack
) ; single-floats
172 (double-stack non-descriptor-stack
173 :element-size
2 :alignment
2) ; double floats.
174 (complex-single-stack non-descriptor-stack
:element-size
2)
175 (complex-double-stack non-descriptor-stack
:element-size
4 :alignment
2)
178 ;; **** Things that can go in the integer registers.
180 ;; Non-Descriptor characters
181 (character-reg registers
182 :locations
#.non-descriptor-regs
183 :constant-scs
(immediate)
185 :alternate-scs
(character-stack))
187 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
189 :locations
#.non-descriptor-regs
190 :constant-scs
(immediate)
192 :alternate-scs
(sap-stack))
194 ;; Non-Descriptor (signed or unsigned) numbers.
195 (signed-reg registers
196 :locations
#.non-descriptor-regs
197 :constant-scs
(zero immediate
)
199 :alternate-scs
(signed-stack))
200 (unsigned-reg registers
201 :locations
#.non-descriptor-regs
202 :constant-scs
(zero immediate
)
204 :alternate-scs
(unsigned-stack))
206 ;; Random objects that must not be seen by GC. Used only as temporaries.
207 (non-descriptor-reg registers
208 :locations
#.non-descriptor-regs
)
210 ;; Pointers to the interior of objects. Used only as an temporary.
211 (interior-reg registers
212 :locations
(#.lip-offset
))
215 ;; **** Things that can go in the floating point registers.
217 ;; Non-Descriptor single-floats.
218 (single-reg float-registers
219 :locations
#.
(loop for i from
4 to
30 collect i
)
220 :constant-scs
(fp-single-zero)
222 :alternate-scs
(single-stack))
224 ;; Non-Descriptor double-floats.
225 (double-reg float-registers
226 :locations
#.
(loop for i from
4 to
30 collect i
)
227 :constant-scs
(fp-double-zero)
229 :alternate-scs
(double-stack))
231 (complex-single-reg float-registers
232 :locations
#.
(loop for i from
4 to
28 by
2 collect i
)
236 :alternate-scs
(complex-single-stack))
238 (complex-double-reg float-registers
239 :locations
#.
(loop for i from
4 to
28 by
2 collect i
)
243 :alternate-scs
(complex-double-stack))
245 ;; A catch or unwind block.
246 (catch-block control-stack
247 :element-size kludge-nondeterministic-catch-block-size
))
249 ;;; Make some random tns for important registers.
250 (macrolet ((defregtn (name sc
)
251 (let ((offset-sym (symbolicate name
"-OFFSET"))
252 (tn-sym (symbolicate name
"-TN")))
253 `(defparameter ,tn-sym
254 (make-random-tn :kind
:normal
255 :sc
(sc-or-lose ',sc
)
256 :offset
,offset-sym
)))))
258 ;; These, we access by foo-TN only
260 (defregtn zero any-reg
)
261 (defregtn null descriptor-reg
)
262 (defregtn code descriptor-reg
)
263 (defregtn alloc any-reg
)
264 (defregtn bsp any-reg
)
265 (defregtn csp any-reg
)
266 (defregtn cfp any-reg
)
267 (defregtn nsp any-reg
)
269 ;; These alias regular locations, so we have to make sure we don't bypass
270 ;; the register allocator when using them.
271 (defregtn nargs any-reg
)
272 (defregtn ocfp any-reg
)
273 (defregtn lip interior-reg
))
275 ;; and some floating point values..
276 (defparameter fp-single-zero-tn
277 (make-random-tn :kind
:normal
278 :sc
(sc-or-lose 'single-reg
)
280 (defparameter fp-double-zero-tn
281 (make-random-tn :kind
:normal
282 :sc
(sc-or-lose 'double-reg
)
285 ;;; If value can be represented as an immediate constant, then return
286 ;;; the appropriate SC number, otherwise return NIL.
287 (!def-vm-support-routine immediate-constant-sc
(value)
290 (sc-number-or-lose 'zero
))
292 (sc-number-or-lose 'null
))
293 ((or (integer #.sb
!xc
:most-negative-fixnum
#.sb
!xc
:most-positive-fixnum
)
294 system-area-pointer character
)
295 (sc-number-or-lose 'immediate
))
297 (if (static-symbol-p value
)
298 (sc-number-or-lose 'immediate
)
302 (sc-number-or-lose 'fp-single-zero
)
306 (sc-number-or-lose 'fp-double-zero
)
309 ;;;; function call parameters
311 ;;; the SC numbers for register and stack arguments/return values
312 (def!constant register-arg-scn
(meta-sc-number-or-lose 'descriptor-reg
))
313 (def!constant immediate-arg-scn
(meta-sc-number-or-lose 'any-reg
))
314 (def!constant control-stack-arg-scn
(meta-sc-number-or-lose 'control-stack
))
316 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
318 ;;; offsets of special stack frame locations
319 (def!constant ocfp-save-offset
0)
320 (def!constant lra-save-offset
1)
321 (def!constant nfp-save-offset
2)
323 ;;; the number of arguments/return values passed in registers
324 (def!constant register-arg-count
6)
326 ;;; (Names to use for the argument registers would go here, but there
331 ;;; a list of TN's describing the register arguments
332 (defparameter *register-arg-tns
*
334 (make-random-tn :kind
:normal
335 :sc
(sc-or-lose 'descriptor-reg
)
337 *register-arg-offsets
*))
339 ;;; This is used by the debugger.
340 (def!constant single-value-return-byte-offset
4)
342 ;;; This function is called by debug output routines that want a
343 ;;; pretty name for a TN's location. It returns a thing that can be
344 ;;; printed with PRINC.
345 (!def-vm-support-routine location-print-name
(tn)
346 ; (declare (type tn tn))
347 (let ((sb (sb-name (sc-sb (tn-sc tn
))))
348 (offset (tn-offset tn
)))
350 (registers (or (svref *register-names
* offset
)
351 (format nil
"R~D" offset
)))
352 (float-registers (format nil
"F~D" offset
))
353 (control-stack (format nil
"CS~D" offset
))
354 (non-descriptor-stack (format nil
"NS~D" offset
))
355 (constant (format nil
"Const~D" offset
))
356 (immediate-constant "Immed"))))
358 (!def-vm-support-routine combination-implementation-style
(node)
359 (declare (type sb
!c
::combination node
) (ignore node
))
360 (values :default nil
))