1 ;;;; miscellaneous VM definition noise for the Sparc
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 ;;;; Define 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 (defconstant ,offset-sym ,offset)
23 (setf (svref *register-names* ,offset-sym)
24 ,(symbol-name name)))))
26 (defregset (name &rest regs)
27 `(eval-when (:compile-toplevel :load-toplevel :execute)
29 (list ,@(mapcar (lambda (name)
30 (symbolicate name "-OFFSET"))
32 ;; "c.f. src/runtime/sparc-lispregs.h
34 ;; Globals. These are difficult to extract from a sigcontext.
36 (defreg alloc 1) ; %g1
41 ;; %g6 and %g7 are supposed to be reserved for the system.
43 ;; Outs. These get clobbered when we call into C.
51 (defreg nargs 15) ; %o7
53 ;; Locals. These are preserved when we call into C.
60 (defreg ocfp 22) ; %l6
63 ;; Ins. These are preserved just like locals.
64 (defreg cname 24) ; %i0
65 (defreg lexenv 25) ; %i1
68 (defreg cfunc 28) ; %i4
69 (defreg code 29) ; %i5
70 ;; we can't touch reg 30 if we ever want to return
73 (defregset non-descriptor-regs
74 nl0 nl1 nl2 nl3 nl4 nl5 cfunc nargs nfp)
76 (defregset descriptor-regs
77 a0 a1 a2 a3 a4 a5 ocfp lra cname lexenv l0)
79 (defregset *register-arg-offsets*
82 ;;;; SB and SC definition:
84 (define-storage-base registers :finite :size 32)
85 (define-storage-base float-registers :finite :size 64)
86 (define-storage-base control-stack :unbounded :size 8)
87 (define-storage-base non-descriptor-stack :unbounded :size 0)
88 (define-storage-base constant :non-packed)
89 (define-storage-base immediate-constant :non-packed)
91 ;;; Handy macro so we don't have to keep changing all the numbers whenever
92 ;;; we insert a new storage class.
94 ;;; FIXME: This macro is not needed in the runtime target.
95 (defmacro define-storage-classes (&rest classes)
96 (do ((forms (list 'progn)
97 (let* ((class (car classes))
99 (constant-name (intern (concatenate 'simple-string
102 (list* `(define-storage-class ,sc-name ,index
104 `(defconstant ,constant-name ,index)
105 ;; (The CMU CL version of this macro did
106 ;; `(EXPORT ',CONSTANT-NAME)
107 ;; here, but in SBCL we try to have package
108 ;; structure described statically in one
109 ;; master source file, instead of building it
110 ;; dynamically by letting all the system code
111 ;; modify it as the system boots.)
114 (classes classes (cdr classes)))
118 ;;; see comment in ../x86/vm.lisp. The value of 7 was taken from
119 ;;; vm:catch-block-size in a cmucl that I happened to have around
120 ;;; and seems to be working so far -dan
122 ;;; arbitrarily taken for alpha, too. - Christophe
123 (defconstant sb!vm::kludge-nondeterministic-catch-block-size 7)
125 (define-storage-classes
127 ;; Non-immediate contstants in the constant pool
130 ;; ZERO and NULL are in registers.
131 (zero immediate-constant)
132 (null immediate-constant)
134 ;; Anything else that can be an immediate.
135 (immediate immediate-constant)
140 ;; The control stack. (Scanned by GC)
141 (control-stack control-stack)
143 ;; The non-descriptor stacks.
144 (signed-stack non-descriptor-stack) ; (signed-byte 32)
145 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
146 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
147 (sap-stack non-descriptor-stack) ; System area pointers.
148 (single-stack non-descriptor-stack) ; single-floats
149 (double-stack non-descriptor-stack
150 :element-size 2 :alignment 2) ; double floats.
152 (long-stack non-descriptor-stack :element-size 4 :alignment 4) ; long floats.
153 ;; complex-single-floats
154 (complex-single-stack non-descriptor-stack :element-size 2)
155 ;; complex-double-floats.
156 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
158 ;; complex-long-floats.
159 (complex-long-stack non-descriptor-stack :element-size 8 :alignment 4)
162 ;; **** Things that can go in the integer registers.
164 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
165 ;; bad will happen if they are. (fixnums, characters, header values, etc).
168 :locations #.(append non-descriptor-regs descriptor-regs)
169 :constant-scs (zero immediate)
171 :alternate-scs (control-stack))
173 ;; Pointer descriptor objects. Must be seen by GC.
174 (descriptor-reg registers
175 :locations #.descriptor-regs
176 :constant-scs (constant null immediate)
178 :alternate-scs (control-stack))
180 ;; Non-Descriptor characters
181 (base-char-reg registers
182 :locations #.non-descriptor-regs
183 :constant-scs (immediate)
185 :alternate-scs (base-char-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 0 to 31 collect i)
220 :reserve-locations (28 29 30 31)
223 :alternate-scs (single-stack))
225 ;; Non-Descriptor double-floats.
226 (double-reg float-registers
227 :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
229 :element-size 2 :alignment 2
230 :reserve-locations (28 30)
233 :alternate-scs (double-stack))
235 ;; Non-Descriptor double-floats.
237 (long-reg float-registers
238 :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
240 :element-size 4 :alignment 4
241 :reserve-locations (28)
244 :alternate-scs (long-stack))
246 (complex-single-reg float-registers
247 :locations #.(loop for i from 0 to 31 by 2 collect i)
248 :element-size 2 :alignment 2
249 :reserve-locations (28 30)
252 :alternate-scs (complex-single-stack))
254 (complex-double-reg float-registers
255 :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
257 :element-size 4 :alignment 4
258 :reserve-locations (28)
261 :alternate-scs (complex-double-stack))
264 (complex-long-reg float-registers
265 :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
267 :element-size 8 :alignment 8
270 :alternate-scs (complex-long-stack))
273 ;; A catch or unwind block.
274 (catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size))
278 ;;;; Make some random tns for important registers.
280 (macrolet ((defregtn (name sc)
281 (let ((offset-sym (symbolicate name "-OFFSET"))
282 (tn-sym (symbolicate name "-TN")))
283 `(defparameter ,tn-sym
284 (make-random-tn :kind :normal
285 :sc (sc-or-lose ',sc)
286 :offset ,offset-sym)))))
287 (defregtn zero any-reg)
288 (defregtn null descriptor-reg)
289 (defregtn code descriptor-reg)
290 (defregtn alloc any-reg)
292 (defregtn nargs any-reg)
293 (defregtn bsp any-reg)
294 (defregtn csp any-reg)
295 (defregtn cfp any-reg)
296 (defregtn ocfp any-reg)
297 (defregtn nsp any-reg))
301 ;;; If value can be represented as an immediate constant, then return the
302 ;;; appropriate SC number, otherwise return NIL.
303 (!def-vm-support-routine immediate-constant-sc (value)
306 (sc-number-or-lose 'zero))
308 (sc-number-or-lose 'null))
309 ((or fixnum system-area-pointer character)
310 (sc-number-or-lose 'immediate))
312 (if (static-symbol-p value)
313 (sc-number-or-lose 'immediate)
317 ;;;; function call parameters
319 ;;; the SC numbers for register and stack arguments/return values.
320 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
321 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
322 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
324 (eval-when (:compile-toplevel :load-toplevel :execute)
326 ;; offsets of special stack frame locations
327 (defconstant ocfp-save-offset 0)
328 (defconstant lra-save-offset 1)
329 (defconstant nfp-save-offset 2)
331 ;; the number of arguments/return values passed in registers.
333 (defconstant register-arg-count 6)
335 ;; names to use for the argument registers.
337 (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5))
338 ); eval-when (:compile-toplevel :load-toplevel :execute)
341 ;;; a list of TN's describing the register arguments.
342 (defparameter *register-arg-tns*
344 (make-random-tn :kind :normal
345 :sc (sc-or-lose 'descriptor-reg)
347 *register-arg-offsets*))
349 ;;; This is used by the debugger.
350 (defconstant single-value-return-byte-offset 8)
353 ;;; This function is called by debug output routines that want a
354 ;;; pretty name for a TN's location. It returns a thing that can be
355 ;;; printed with PRINC.
356 (!def-vm-support-routine location-print-name (tn)
357 (declare (type tn tn)) ; FIXME: commented out on alpha
358 (let ((sb (sb-name (sc-sb (tn-sc tn))))
359 (offset (tn-offset tn)))
361 (registers (or (svref *register-names* offset)
362 (format nil "R~D" offset)))
363 (float-registers (format nil "F~D" offset))
364 (control-stack (format nil "CS~D" offset))
365 (non-descriptor-stack (format nil "NS~D" offset))
366 (constant (format nil "Const~D" offset))
367 (immediate-constant "Immed"))))
370 ;;; The loader uses this to convert alien names to the form they
371 ;;; occure in the symbol table (for example, prepending an
372 ;;; underscore). On the SPARC, we don't prepend an underscore.
373 (defun extern-alien-name (name)
374 (declare (type simple-base-string name))
375 (concatenate 'string #+nil "_" name))