1 ;;;; miscellaneous VM definition noise for HPPA
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 ;;; FIXME: These want to turn into macrolets.
21 (macrolet ((defreg (name offset)
22 (let ((offset-sym (symbolicate name "-OFFSET")))
23 `(eval-when (:compile-toplevel :load-toplevel :execute)
24 (def!constant ,offset-sym ,offset)
25 (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))))))
33 ;; This gets trashed by the C call convention.
36 ;; These are the callee saves, so these registers are stay live over
54 ;; This is where the caller-saves registers start, but we don't
55 ;; really care because we need to clear the above after call-out to
56 ;; make sure no pointers into oldspace are kept around.
61 ;; These are the 4 C argument registers.
66 ;; The global Data Pointer. We just leave it alone, because we
69 ;; These two are use for C return values.
75 (defregset non-descriptor-regs
76 nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc)
78 (defregset descriptor-regs
79 fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2)
81 (defregset *register-arg-offsets*
85 (define-storage-base registers :finite :size 32)
86 (define-storage-base float-registers :finite :size 64)
87 (define-storage-base control-stack :unbounded :size 8)
88 (define-storage-base non-descriptor-stack :unbounded :size 0)
89 (define-storage-base constant :non-packed)
90 (define-storage-base immediate-constant :non-packed)
93 ;;; Handy macro so we don't have to keep changing all the numbers whenever
94 ;;; we insert a new storage class.
96 (defmacro !define-storage-classes (&rest classes)
97 (do ((forms (list 'progn)
98 (let* ((class (car classes))
100 (constant-name (intern (concatenate 'simple-string
103 (list* `(define-storage-class ,sc-name ,index
105 `(def!constant ,constant-name ,index)
108 (classes classes (cdr classes)))
112 (def!constant kludge-nondeterministic-catch-block-size 7)
114 (!define-storage-classes
116 ;; Non-immediate contstants in the constant pool
119 ;; ZERO and NULL are in registers.
120 (zero immediate-constant)
121 (null immediate-constant)
122 (fp-single-zero immediate-constant)
123 (fp-double-zero immediate-constant)
125 ;; Anything else that can be an immediate.
126 (immediate immediate-constant)
131 ;; The control stack. (Scanned by GC)
132 (control-stack control-stack)
134 ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
135 ;; is small and therefore the error trap information is smaller.
136 ;; Moving them up here from their previous place down below saves
137 ;; ~250K in core file size. --njf, 2006-01-27
139 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
140 ;; bad will happen if they are. (fixnums, characters, header values, etc).
143 :locations #.(append non-descriptor-regs descriptor-regs)
144 :constant-scs (zero immediate)
146 :alternate-scs (control-stack))
148 ;; Pointer descriptor objects. Must be seen by GC.
149 (descriptor-reg registers
150 :locations #.descriptor-regs
151 :constant-scs (constant null immediate)
153 :alternate-scs (control-stack))
155 ;; The non-descriptor stacks.
156 (signed-stack non-descriptor-stack) ; (signed-byte 32)
157 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
158 (character-stack non-descriptor-stack) ; non-descriptor characters.
159 (sap-stack non-descriptor-stack) ; System area pointers.
160 (single-stack non-descriptor-stack) ; single-floats
161 (double-stack non-descriptor-stack
162 :element-size 2 :alignment 2) ; double floats.
163 (complex-single-stack non-descriptor-stack :element-size 2)
164 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
167 ;; **** Things that can go in the integer registers.
169 ;; Non-Descriptor characters
170 (character-reg registers
171 :locations #.non-descriptor-regs
172 :constant-scs (immediate)
174 :alternate-scs (character-stack))
176 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
178 :locations #.non-descriptor-regs
179 :constant-scs (immediate)
181 :alternate-scs (sap-stack))
183 ;; Non-Descriptor (signed or unsigned) numbers.
184 (signed-reg registers
185 :locations #.non-descriptor-regs
186 :constant-scs (zero immediate)
188 :alternate-scs (signed-stack))
189 (unsigned-reg registers
190 :locations #.non-descriptor-regs
191 :constant-scs (zero immediate)
193 :alternate-scs (unsigned-stack))
195 ;; Random objects that must not be seen by GC. Used only as temporaries.
196 (non-descriptor-reg registers
197 :locations #.non-descriptor-regs)
199 ;; Pointers to the interior of objects. Used only as an temporary.
200 (interior-reg registers
201 :locations (#.lip-offset))
204 ;; **** Things that can go in the floating point registers.
206 ;; Non-Descriptor single-floats.
207 (single-reg float-registers
208 :locations #.(loop for i from 4 to 31 collect i)
209 :constant-scs (fp-single-zero)
211 :alternate-scs (single-stack))
213 ;; Non-Descriptor double-floats.
214 (double-reg float-registers
215 :locations #.(loop for i from 4 to 31 collect i)
216 :constant-scs (fp-double-zero)
218 :alternate-scs (double-stack))
220 (complex-single-reg float-registers
221 :locations #.(loop for i from 4 to 30 by 2 collect i)
225 :alternate-scs (complex-single-stack))
227 (complex-double-reg float-registers
228 :locations #.(loop for i from 4 to 30 by 2 collect i)
232 :alternate-scs (complex-double-stack))
234 ;; A catch or unwind block.
235 (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size))
238 ;;;; Make some random tns for important registers.
240 (macrolet ((defregtn (name sc)
241 (let ((offset-sym (symbolicate name "-OFFSET"))
242 (tn-sym (symbolicate name "-TN")))
243 `(defparameter ,tn-sym
244 (make-random-tn :kind :normal
245 :sc (sc-or-lose ',sc)
246 :offset ,offset-sym)))))
248 ;; These, we access by foo-TN only
250 (defregtn zero any-reg)
251 (defregtn null descriptor-reg)
252 (defregtn code descriptor-reg)
253 (defregtn alloc any-reg)
254 (defregtn bsp any-reg)
255 (defregtn csp any-reg)
256 (defregtn cfp any-reg)
257 (defregtn nsp any-reg)
259 ;; These alias regular locations, so we have to make sure we don't bypass
260 ;; the register allocator when using them.
261 (defregtn nargs any-reg)
262 (defregtn ocfp any-reg)
263 (defregtn lip interior-reg))
265 ;; And some floating point values.
266 (defparameter fp-single-zero-tn
267 (make-random-tn :kind :normal
268 :sc (sc-or-lose 'single-reg)
270 (defparameter fp-double-zero-tn
271 (make-random-tn :kind :normal
272 :sc (sc-or-lose 'double-reg)
276 ;;; If VALUE can be represented as an immediate constant, then return
277 ;;; the appropriate SC number, otherwise return NIL.
278 (!def-vm-support-routine immediate-constant-sc (value)
281 (sc-number-or-lose 'zero))
283 (sc-number-or-lose 'null))
284 ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
286 (sc-number-or-lose 'immediate))
288 (if (static-symbol-p value)
289 (sc-number-or-lose 'immediate)
293 (sc-number-or-lose 'fp-single-zero)
297 (sc-number-or-lose 'fp-double-zero)
301 ;;;; Function Call Parameters
303 ;;; The SC numbers for register and stack arguments/return values.
305 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
306 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
307 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
309 (eval-when (:compile-toplevel :load-toplevel :execute)
311 ;;; Offsets of special stack frame locations
312 (def!constant ocfp-save-offset 0)
313 (def!constant lra-save-offset 1)
314 (def!constant nfp-save-offset 2)
316 ;;; The number of arguments/return values passed in registers.
318 (def!constant register-arg-count 6)
320 ;;; Names to use for the argument registers.
322 (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal)
327 ;;; A list of TN's describing the register arguments.
329 (defparameter register-arg-tns
330 (mapcar #'(lambda (n)
331 (make-random-tn :kind :normal
332 :sc (sc-or-lose 'descriptor-reg)
334 *register-arg-offsets*))
336 ;;; This is used by the debugger.
337 (def!constant single-value-return-byte-offset 4)
339 ;;; This function is called by debug output routines that want a pretty name
340 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
341 (!def-vm-support-routine location-print-name (tn)
342 (declare (type tn tn))
343 (let ((sb (sb-name (sc-sb (tn-sc tn))))
344 (offset (tn-offset tn)))
346 (registers (or (svref *register-names* offset)
347 (format nil "R~D" offset)))
348 (float-registers (format nil "F~D" offset))
349 (control-stack (format nil "CS~D" offset))
350 (non-descriptor-stack (format nil "NS~D" offset))
351 (constant (format nil "Const~D" offset))
352 (immediate-constant "Immed"))))
354 (!def-vm-support-routine combination-implementation-style (node)
355 (declare (type sb!c::combination node) (ignore node))
356 (values :default nil))