1 ;;;; miscellaneous VM definition noise for MIPS
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.
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) (symbolicate name "-OFFSET")) regs))))))
30 ;; Wired zero register.
31 (defreg zero 0) ; NULL
32 ;; Reserved for assembler use.
33 (defreg nl3 1) ; untagged temporary 3
34 ;; C return registers.
35 (defreg cfunc 2) ; FF function address, wastes a register
36 (defreg nl4 3) ; PA flag
37 ;; C argument registers.
38 (defreg nl0 4) ; untagged temporary 0
39 (defreg nl1 5) ; untagged temporary 1
40 (defreg nl2 6) ; untagged temporary 2
41 (defreg nargs 7) ; number of function arguments
42 ;; C unsaved temporaries.
43 (defreg a0 8) ; function arg 0
44 (defreg a1 9) ; function arg 1
45 (defreg a2 10) ; function arg 2
46 (defreg a3 11) ; function arg 3
47 (defreg a4 12) ; function arg 4
48 (defreg a5 13) ; function arg 5
50 (defreg lexenv 15) ; wastes a register
52 (defreg nfp 16) ; non-lisp frame pointer
53 (defreg ocfp 17) ; caller's control frame pointer
54 (defreg lra 18) ; tagged Lisp return address
55 (defreg l0 19) ; tagged temporary 0
56 (defreg null 20) ; NIL
57 (defreg bsp 21) ; binding stack pointer
58 (defreg cfp 22) ; control frame pointer
59 (defreg csp 23) ; control stack pointer
60 ;; More C unsaved temporaries.
61 (defreg l1 24) ; tagged temporary 1
62 (defreg alloc 25) ; ALLOC pointer
63 ;; 26 and 27 are used by the system kernel.
64 ;; 28 is the global pointer of our C runtime, and used for
65 ;; jump/branch relaxation in Lisp.
66 (defreg nsp 29) ; number (native) stack pointer
67 ;; C frame pointer, or additional saved register.
68 (defreg code 30) ; current function object
69 ;; Return link register.
70 (defreg lip 31) ; Lisp interior pointer
72 (defregset non-descriptor-regs
73 nl0 nl1 nl2 nl3 nl4 cfunc nargs)
75 (defregset descriptor-regs
76 a0 a1 a2 a3 a4 a5 fdefn lexenv nfp ocfp lra l0 l1)
78 (defregset *register-arg-offsets*
81 (defregset reserve-descriptor-regs
84 (defregset reserve-non-descriptor-regs
88 ;;;; SB and SC definition:
90 (define-storage-base registers :finite :size 32)
91 (define-storage-base float-registers :finite :size 32)
92 (define-storage-base control-stack :unbounded :size 8)
93 (define-storage-base non-descriptor-stack :unbounded :size 0)
94 (define-storage-base constant :non-packed)
95 (define-storage-base immediate-constant :non-packed)
98 ;;; Handy macro so we don't have to keep changing all the numbers whenever
99 ;;; we insert a new storage class.
101 (defmacro !define-storage-classes (&rest classes)
102 (do ((forms (list 'progn)
103 (let* ((class (car classes))
104 (sc-name (car class))
105 (constant-name (intern (concatenate 'simple-string
108 (list* `(define-storage-class ,sc-name ,index
110 `(defconstant ,constant-name ,index)
111 `(export ',constant-name)
114 (classes classes (cdr classes)))
118 (def!constant kludge-nondeterministic-catch-block-size 7)
120 (!define-storage-classes
122 ;; Non-immediate constants in the constant pool
125 ;; Immediate constant.
126 (null immediate-constant)
127 (zero immediate-constant)
128 (immediate immediate-constant)
132 ;; The control stack. (Scanned by GC)
133 (control-stack control-stack)
135 ;; The non-descriptor stacks.
136 (signed-stack non-descriptor-stack) ; (signed-byte 32)
137 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
138 (character-stack non-descriptor-stack) ; non-descriptor characters.
139 (sap-stack non-descriptor-stack) ; System area pointers.
140 (single-stack non-descriptor-stack) ; single-floats
141 (double-stack non-descriptor-stack :element-size 2) ; double floats.
142 ;; complex-single-floats
143 (complex-single-stack non-descriptor-stack :element-size 2)
144 ;; complex-double-floats.
145 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
148 ;; **** Things that can go in the integer registers.
150 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
151 ;; bad will happen if they are. (fixnums, characters, header values, etc).
154 :locations #.(append non-descriptor-regs descriptor-regs)
155 :reserve-locations #.(append reserve-non-descriptor-regs
156 reserve-descriptor-regs)
157 :constant-scs (constant zero immediate)
159 :alternate-scs (control-stack))
161 ;; Pointer descriptor objects. Must be seen by GC.
162 (descriptor-reg registers
163 :locations #.descriptor-regs
164 :reserve-locations #.reserve-descriptor-regs
165 :constant-scs (constant null immediate)
167 :alternate-scs (control-stack))
169 ;; Non-Descriptor characters
170 (character-reg registers
171 :locations #.non-descriptor-regs
172 :reserve-locations #.reserve-non-descriptor-regs
173 :constant-scs (immediate)
175 :alternate-scs (character-stack))
177 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
179 :locations #.non-descriptor-regs
180 :reserve-locations #.reserve-non-descriptor-regs
181 :constant-scs (immediate)
183 :alternate-scs (sap-stack))
185 ;; Non-Descriptor (signed or unsigned) numbers.
186 (signed-reg registers
187 :locations #.non-descriptor-regs
188 :reserve-locations #.reserve-non-descriptor-regs
189 :constant-scs (zero immediate)
191 :alternate-scs (signed-stack))
192 (unsigned-reg registers
193 :locations #.non-descriptor-regs
194 :reserve-locations #.reserve-non-descriptor-regs
195 :constant-scs (zero immediate)
197 :alternate-scs (unsigned-stack))
199 ;; Random objects that must not be seen by GC. Used only as temporaries.
200 (non-descriptor-reg registers
201 :locations #.non-descriptor-regs)
203 ;; Pointers to the interior of objects. Used only as an temporary.
204 (interior-reg registers
205 :locations (#.lip-offset))
208 ;; **** Things that can go in the floating point registers.
210 ;; Non-Descriptor single-floats.
211 (single-reg float-registers
212 :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
213 :reserve-locations (26 28 30)
216 :alternate-scs (single-stack))
218 ;; Non-Descriptor double-floats.
219 (double-reg float-registers
220 :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
221 :reserve-locations (26 28 30)
222 ;; Note: we don't bother with the element size, 'cause nothing can be
223 ;; allocated in the odd fp regs anyway.
226 :alternate-scs (double-stack))
228 (complex-single-reg float-registers
229 :locations (0 4 8 12 16 20 24 28)
231 :reserve-locations (24 28)
234 :alternate-scs (complex-single-stack))
236 (complex-double-reg float-registers
237 :locations (0 4 8 12 16 20 24 28)
239 :reserve-locations (24 28)
242 :alternate-scs (complex-double-stack))
244 ;; A catch or unwind block.
245 (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)
247 ;; floating point numbers temporarily stuck in integer registers for c-call
248 (single-int-carg-reg registers
252 (double-int-carg-reg registers
256 :alignment 2 ;is this needed?
262 ;;;; Random TNs for interesting registers
264 (macrolet ((defregtn (name sc)
265 (let ((offset-sym (symbolicate name "-OFFSET"))
266 (tn-sym (symbolicate name "-TN")))
267 `(defparameter ,tn-sym
268 (make-random-tn :kind :normal
269 :sc (sc-or-lose ',sc)
270 :offset ,offset-sym)))))
271 (defregtn zero any-reg)
272 (defregtn nargs any-reg)
274 (defregtn fdefn descriptor-reg)
275 (defregtn lexenv descriptor-reg)
277 (defregtn nfp any-reg)
278 (defregtn ocfp any-reg)
280 (defregtn null descriptor-reg)
282 (defregtn bsp any-reg)
283 (defregtn cfp any-reg)
284 (defregtn csp any-reg)
285 (defregtn alloc any-reg)
286 (defregtn nsp any-reg)
288 (defregtn code descriptor-reg)
289 (defregtn lip interior-reg))
291 ;;; If VALUE can be represented as an immediate constant, then return the
292 ;;; appropriate SC number, otherwise return NIL.
293 (!def-vm-support-routine immediate-constant-sc (value)
296 (sc-number-or-lose 'zero))
298 (sc-number-or-lose 'null))
300 (if (static-symbol-p value)
301 (sc-number-or-lose 'immediate)
303 ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
304 system-area-pointer character)
305 (sc-number-or-lose 'immediate))
307 (sc-number-or-lose 'immediate))
309 (sc-number-or-lose 'immediate))))
312 ;;;; Function Call Parameters
314 ;;; The SC numbers for register and stack arguments/return values.
316 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
317 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
318 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
320 (eval-when (:compile-toplevel :load-toplevel :execute)
322 ;;; Offsets of special stack frame locations
323 (defconstant ocfp-save-offset 0)
324 (defconstant lra-save-offset 1)
325 (defconstant nfp-save-offset 2)
327 ;;; The number of arguments/return values passed in registers.
329 (defconstant register-arg-count 6)
331 ;;; The offsets within the register-arg SC that we pass values in, first
335 ;;; Names to use for the argument registers.
337 (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal)
342 ;;; A list of TN's describing the register arguments.
344 (defparameter *register-arg-tns*
345 (mapcar #'(lambda (n)
346 (make-random-tn :kind :normal
347 :sc (sc-or-lose 'descriptor-reg)
349 *register-arg-offsets*))
351 ;;; This is used by the debugger.
352 (defconstant single-value-return-byte-offset 8)
354 ;;; This function is called by debug output routines that want a pretty name
355 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
356 (!def-vm-support-routine location-print-name (tn)
357 (declare (type tn tn))
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"))))