1 ;;;; miscellaneous VM definition noise for the PPC
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.
15 ;;;; Define the registers
17 (eval-when (:compile-toplevel :load-toplevel :execute)
18 (defvar *register-names* (make-array 32 :initial-element nil)))
20 (macrolet ((defreg (name offset)
21 (let ((offset-sym (symbolicate name "-OFFSET")))
22 `(eval-when (:compile-toplevel :load-toplevel :execute)
23 (def!constant ,offset-sym ,offset)
24 (setf (svref *register-names* ,offset-sym) ,(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")) regs))))))
34 (defreg rtoc 2) ; May be "NULL" someday.
42 (defreg fdefn 10) ; was nl7
44 ;; FIXME: some kind of comment here would be nice.
46 ;; FIXME II: this also reveals the need to autogenerate lispregs.h
47 #!+darwin (defreg cfunc 12)
48 #!-darwin (defreg nfp 12)
49 #!+darwin (defreg nfp 13)
50 #!-darwin (defreg cfunc 13)
70 (defregset non-descriptor-regs
71 nl0 nl1 nl2 nl3 nl4 nl5 nl6 #+nil nl7 cfunc nargs nfp)
73 (defregset descriptor-regs
74 fdefn a0 a1 a2 a3 ocfp lra cname lexenv l0 l1 l2 )
77 (defregset *register-arg-offsets* a0 a1 a2 a3)
78 (defparameter register-arg-names '(a0 a1 a2 a3)))
82 ;;;; SB and SC definition:
84 (define-storage-base registers :finite :size 32)
85 (define-storage-base float-registers :finite :size 32)
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)
92 ;;; Handy macro so we don't have to keep changing all the numbers whenever
93 ;;; we insert a new storage class.
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 `(def!constant ,constant-name ,index)
107 (classes classes (cdr classes)))
111 (def!constant kludge-nondeterministic-catch-block-size 7)
113 (define-storage-classes
115 ;; Non-immediate contstants in the constant pool
118 ;; ZERO and NULL are in registers.
119 (zero immediate-constant)
120 (null immediate-constant)
122 ;; Anything else that can be an immediate.
123 (immediate immediate-constant)
128 ;; The control stack. (Scanned by GC)
129 (control-stack control-stack)
131 ;; The non-descriptor stacks.
132 (signed-stack non-descriptor-stack) ; (signed-byte 32)
133 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
134 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
135 (sap-stack non-descriptor-stack) ; System area pointers.
136 (single-stack non-descriptor-stack) ; single-floats
137 (double-stack non-descriptor-stack
138 :element-size 2 :alignment 2) ; double floats.
139 (complex-single-stack non-descriptor-stack :element-size 2)
140 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
143 ;; **** Things that can go in the integer registers.
145 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
146 ;; bad will happen if they are. (fixnums, characters, header values, etc).
149 :locations #.(append non-descriptor-regs descriptor-regs)
150 :constant-scs (zero immediate)
152 :alternate-scs (control-stack))
154 ;; Pointer descriptor objects. Must be seen by GC.
155 (descriptor-reg registers
156 :locations #.descriptor-regs
157 :constant-scs (constant null immediate)
159 :alternate-scs (control-stack))
161 ;; Non-Descriptor characters
162 (base-char-reg registers
163 :locations #.non-descriptor-regs
164 :constant-scs (immediate)
166 :alternate-scs (base-char-stack))
168 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
170 :locations #.non-descriptor-regs
171 :constant-scs (immediate)
173 :alternate-scs (sap-stack))
175 ;; Non-Descriptor (signed or unsigned) numbers.
176 (signed-reg registers
177 :locations #.non-descriptor-regs
178 :constant-scs (zero immediate)
180 :alternate-scs (signed-stack))
181 (unsigned-reg registers
182 :locations #.non-descriptor-regs
183 :constant-scs (zero immediate)
185 :alternate-scs (unsigned-stack))
187 ;; Random objects that must not be seen by GC. Used only as temporaries.
188 (non-descriptor-reg registers
189 :locations #.non-descriptor-regs)
191 ;; Pointers to the interior of objects. Used only as a temporary.
192 (interior-reg registers
193 :locations (#.lip-offset))
196 ;; **** Things that can go in the floating point registers.
198 ;; Non-Descriptor single-floats.
199 (single-reg float-registers
200 :locations #.(loop for i from 0 to 31 collect i)
201 ;; ### Note: We really should have every location listed, but then we
202 ;; would have to make load-tns work with element-sizes other than 1.
205 :alternate-scs (single-stack))
207 ;; Non-Descriptor double-floats.
208 (double-reg float-registers
209 :locations #.(loop for i from 0 to 31 collect i)
210 ;; ### Note: load-tns don't work with an element-size other than 1.
211 ;; :element-size 2 :alignment 2
214 :alternate-scs (double-stack))
216 (complex-single-reg float-registers
217 :locations #.(loop for i from 0 to 30 by 2 collect i)
221 :alternate-scs (complex-single-stack))
223 (complex-double-reg float-registers
224 :locations #.(loop for i from 0 to 30 by 2 collect i)
228 :alternate-scs (complex-double-stack))
230 ;; A catch or unwind block.
231 (catch-block control-stack
232 :element-size kludge-nondeterministic-catch-block-size))
234 ;;;; Make some random tns for important registers.
236 (macrolet ((defregtn (name sc)
237 (let ((offset-sym (symbolicate name "-OFFSET"))
238 (tn-sym (symbolicate name "-TN")))
239 `(defparameter ,tn-sym
240 (make-random-tn :kind :normal
241 :sc (sc-or-lose ',sc)
242 :offset ,offset-sym)))))
244 (defregtn zero any-reg)
245 (defregtn lip interior-reg)
246 (defregtn null descriptor-reg)
247 (defregtn code descriptor-reg)
248 (defregtn alloc any-reg)
250 (defregtn nargs any-reg)
251 (defregtn bsp any-reg)
252 (defregtn csp any-reg)
253 (defregtn cfp any-reg)
254 (defregtn ocfp any-reg)
255 (defregtn nsp any-reg))
257 ;;; If VALUE can be represented as an immediate constant, then return the
258 ;;; appropriate SC number, otherwise return NIL.
259 (!def-vm-support-routine immediate-constant-sc (value)
262 (sc-number-or-lose 'zero))
264 (sc-number-or-lose 'null))
265 ((or fixnum system-area-pointer character)
266 (sc-number-or-lose 'immediate))
268 (if (static-symbol-p value)
269 (sc-number-or-lose 'immediate)
272 ;;;; function call parameters
274 ;;; the SC numbers for register and stack arguments/return values
275 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
276 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
277 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
279 (eval-when (:compile-toplevel :load-toplevel :execute)
281 ;;; offsets of special stack frame locations
282 (def!constant ocfp-save-offset 0)
283 (def!constant lra-save-offset 1)
284 (def!constant nfp-save-offset 2)
286 ;;; the number of arguments/return values passed in registers
287 (def!constant register-arg-count 4)
289 ;;; names to use for the argument registers
295 ;;; A list of TN's describing the register arguments.
297 (defparameter *register-arg-tns*
298 (mapcar #'(lambda (n)
299 (make-random-tn :kind :normal
300 :sc (sc-or-lose 'descriptor-reg)
302 *register-arg-offsets*))
304 (export 'single-value-return-byte-offset)
306 ;;; This is used by the debugger.
307 (def!constant single-value-return-byte-offset 8)
309 ;;; This function is called by debug output routines that want a pretty name
310 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
311 (!def-vm-support-routine location-print-name (tn)
312 (declare (type tn tn))
313 (let ((sb (sb-name (sc-sb (tn-sc tn))))
314 (offset (tn-offset tn)))
316 (registers (or (svref *register-names* offset)
317 (format nil "R~D" offset)))
318 (float-registers (format nil "F~D" offset))
319 (control-stack (format nil "CS~D" offset))
320 (non-descriptor-stack (format nil "NS~D" offset))
321 (constant (format nil "Const~D" offset))
322 (immediate-constant "Immed"))))
324 ;;; The loader uses this to convert alien names to the form they
325 ;;; occur in the symbol table. This is ELF, so do nothing.
327 (defun extern-alien-name (name)
328 (declare (type simple-base-string name))
329 ;; Darwin is non-ELF, and needs a _ prefix
330 #!+darwin (concatenate 'string "_" name)
331 ;; The other (ELF) ports currently don't need any prefix