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 `(def!constant
,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 ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
136 ;; is small and therefore the error trap information is smaller.
137 ;; Moving them up here from their previous place down below saves
138 ;; ~250K in core file size. --njf, 2006-01-27
140 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
141 ;; bad will happen if they are. (fixnums, characters, header values, etc).
144 :locations
#.
(append non-descriptor-regs descriptor-regs
)
145 :reserve-locations
#.
(append reserve-non-descriptor-regs
146 reserve-descriptor-regs
)
147 :constant-scs
(constant zero immediate
)
149 :alternate-scs
(control-stack))
151 ;; Pointer descriptor objects. Must be seen by GC.
152 (descriptor-reg registers
153 :locations
#.descriptor-regs
154 :reserve-locations
#.reserve-descriptor-regs
155 :constant-scs
(constant null immediate
)
157 :alternate-scs
(control-stack))
159 ;; The non-descriptor stacks.
160 (signed-stack non-descriptor-stack
) ; (signed-byte 32)
161 (unsigned-stack non-descriptor-stack
) ; (unsigned-byte 32)
162 (character-stack non-descriptor-stack
) ; non-descriptor characters.
163 (sap-stack non-descriptor-stack
) ; System area pointers.
164 (single-stack non-descriptor-stack
) ; single-floats
165 (double-stack non-descriptor-stack
166 :element-size
2 :alignment
2) ; double floats.
167 ;; complex-single-floats
168 (complex-single-stack non-descriptor-stack
:element-size
2)
169 ;; complex-double-floats.
170 (complex-double-stack non-descriptor-stack
:element-size
4 :alignment
2)
173 ;; **** Things that can go in the integer registers.
175 ;; Non-Descriptor characters
176 (character-reg registers
177 :locations
#.non-descriptor-regs
178 :reserve-locations
#.reserve-non-descriptor-regs
179 :constant-scs
(immediate)
181 :alternate-scs
(character-stack))
183 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
185 :locations
#.non-descriptor-regs
186 :reserve-locations
#.reserve-non-descriptor-regs
187 :constant-scs
(immediate)
189 :alternate-scs
(sap-stack))
191 ;; Non-Descriptor (signed or unsigned) numbers.
192 (signed-reg registers
193 :locations
#.non-descriptor-regs
194 :reserve-locations
#.reserve-non-descriptor-regs
195 :constant-scs
(zero immediate
)
197 :alternate-scs
(signed-stack))
198 (unsigned-reg registers
199 :locations
#.non-descriptor-regs
200 :reserve-locations
#.reserve-non-descriptor-regs
201 :constant-scs
(zero immediate
)
203 :alternate-scs
(unsigned-stack))
205 ;; Random objects that must not be seen by GC. Used only as temporaries.
206 (non-descriptor-reg registers
207 :locations
#.non-descriptor-regs
)
209 ;; Pointers to the interior of objects. Used only as an temporary.
210 (interior-reg registers
211 :locations
(#.lip-offset
))
214 ;; **** Things that can go in the floating point registers.
216 ;; Non-Descriptor single-floats.
217 (single-reg float-registers
218 :locations
(0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
219 :reserve-locations
(26 28 30)
222 :alternate-scs
(single-stack))
224 ;; Non-Descriptor double-floats.
225 (double-reg float-registers
226 :locations
(0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
227 :reserve-locations
(26 28 30)
228 ;; Note: we don't bother with the element size, 'cause nothing can be
229 ;; allocated in the odd fp regs anyway.
232 :alternate-scs
(double-stack))
234 (complex-single-reg float-registers
235 :locations
(0 4 8 12 16 20 24 28)
237 :reserve-locations
(24 28)
240 :alternate-scs
(complex-single-stack))
242 (complex-double-reg float-registers
243 :locations
(0 4 8 12 16 20 24 28)
245 :reserve-locations
(24 28)
248 :alternate-scs
(complex-double-stack))
250 ;; A catch or unwind block.
251 (catch-block control-stack
:element-size kludge-nondeterministic-catch-block-size
)
253 ;; floating point numbers temporarily stuck in integer registers for c-call
254 (single-int-carg-reg registers
258 (double-int-carg-reg registers
262 :alignment
2 ;is this needed?
268 ;;;; Random TNs for interesting registers
270 (macrolet ((defregtn (name sc
)
271 (let ((offset-sym (symbolicate name
"-OFFSET"))
272 (tn-sym (symbolicate name
"-TN")))
273 `(defparameter ,tn-sym
274 (make-random-tn :kind
:normal
275 :sc
(sc-or-lose ',sc
)
276 :offset
,offset-sym
)))))
277 (defregtn zero any-reg
)
278 (defregtn nargs any-reg
)
280 (defregtn fdefn descriptor-reg
)
281 (defregtn lexenv descriptor-reg
)
283 (defregtn nfp any-reg
)
284 (defregtn ocfp any-reg
)
286 (defregtn null descriptor-reg
)
288 (defregtn bsp any-reg
)
289 (defregtn cfp any-reg
)
290 (defregtn csp any-reg
)
291 (defregtn alloc any-reg
)
292 (defregtn nsp any-reg
)
294 (defregtn code descriptor-reg
)
295 (defregtn lip interior-reg
))
297 ;;; If VALUE can be represented as an immediate constant, then return the
298 ;;; appropriate SC number, otherwise return NIL.
299 (!def-vm-support-routine immediate-constant-sc
(value)
302 (sc-number-or-lose 'zero
))
304 (sc-number-or-lose 'null
))
306 (if (static-symbol-p value
)
307 (sc-number-or-lose 'immediate
)
309 ((or (integer #.sb
!xc
:most-negative-fixnum
#.sb
!xc
:most-positive-fixnum
)
311 (sc-number-or-lose 'immediate
))
313 (sc-number-or-lose 'immediate
))
315 (sc-number-or-lose 'immediate
))))
318 ;;;; Function Call Parameters
320 ;;; The SC numbers for register and stack arguments/return values.
322 (def!constant register-arg-scn
(meta-sc-number-or-lose 'descriptor-reg
))
323 (def!constant immediate-arg-scn
(meta-sc-number-or-lose 'any-reg
))
324 (def!constant control-stack-arg-scn
(meta-sc-number-or-lose 'control-stack
))
326 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
328 ;;; Offsets of special stack frame locations
329 (def!constant ocfp-save-offset
0)
330 (def!constant lra-save-offset
1)
331 (def!constant nfp-save-offset
2)
333 ;;; The number of arguments/return values passed in registers.
335 (def!constant register-arg-count
6)
337 ;;; The offsets within the register-arg SC that we pass values in, first
341 ;;; Names to use for the argument registers.
343 (defconstant-eqx register-arg-names
'(a0 a1 a2 a3 a4 a5
) #'equal
)
348 ;;; A list of TN's describing the register arguments.
350 (defparameter *register-arg-tns
*
351 (mapcar #'(lambda (n)
352 (make-random-tn :kind
:normal
353 :sc
(sc-or-lose 'descriptor-reg
)
355 *register-arg-offsets
*))
357 ;;; This is used by the debugger.
358 (def!constant single-value-return-byte-offset
8)
360 ;;; This function is called by debug output routines that want a pretty name
361 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
362 (!def-vm-support-routine location-print-name
(tn)
363 (declare (type tn tn
))
364 (let ((sb (sb-name (sc-sb (tn-sc tn
))))
365 (offset (tn-offset tn
)))
367 (registers (or (svref *register-names
* offset
)
368 (format nil
"R~D" offset
)))
369 (float-registers (format nil
"F~D" offset
))
370 (control-stack (format nil
"CS~D" offset
))
371 (non-descriptor-stack (format nil
"NS~D" offset
))
372 (constant (format nil
"Const~D" offset
))
373 (immediate-constant "Immed"))))
375 (!def-vm-support-routine combination-implementation-style
(node)
376 (declare (type sb
!c
::combination node
) (ignore node
))
377 (values :default nil
))