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 `(defconstant ,constant-name ,index)
106 `(export ',constant-name)
109 (classes classes (cdr classes)))
113 (def!constant kludge-nondeterministic-catch-block-size 7)
115 (!define-storage-classes
117 ;; Non-immediate contstants in the constant pool
120 ;; ZERO and NULL are in registers.
121 (zero immediate-constant)
122 (null immediate-constant)
123 (fp-single-zero immediate-constant)
124 (fp-double-zero immediate-constant)
126 ;; Anything else that can be an immediate.
127 (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 :constant-scs (zero immediate)
147 :alternate-scs (control-stack))
149 ;; Pointer descriptor objects. Must be seen by GC.
150 (descriptor-reg registers
151 :locations #.descriptor-regs
152 :constant-scs (constant null immediate)
154 :alternate-scs (control-stack))
156 ;; The non-descriptor stacks.
157 (signed-stack non-descriptor-stack) ; (signed-byte 32)
158 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
159 (character-stack non-descriptor-stack) ; non-descriptor characters.
160 (sap-stack non-descriptor-stack) ; System area pointers.
161 (single-stack non-descriptor-stack) ; single-floats
162 (double-stack non-descriptor-stack
163 :element-size 2 :alignment 2) ; double floats.
164 (complex-single-stack non-descriptor-stack :element-size 2)
165 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
168 ;; **** Things that can go in the integer registers.
170 ;; Non-Descriptor characters
171 (character-reg registers
172 :locations #.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 :constant-scs (immediate)
182 :alternate-scs (sap-stack))
184 ;; Non-Descriptor (signed or unsigned) numbers.
185 (signed-reg registers
186 :locations #.non-descriptor-regs
187 :constant-scs (zero immediate)
189 :alternate-scs (signed-stack))
190 (unsigned-reg registers
191 :locations #.non-descriptor-regs
192 :constant-scs (zero immediate)
194 :alternate-scs (unsigned-stack))
196 ;; Random objects that must not be seen by GC. Used only as temporaries.
197 (non-descriptor-reg registers
198 :locations #.non-descriptor-regs)
200 ;; Pointers to the interior of objects. Used only as an temporary.
201 (interior-reg registers
202 :locations (#.lip-offset))
205 ;; **** Things that can go in the floating point registers.
207 ;; Non-Descriptor single-floats.
208 (single-reg float-registers
209 :locations #.(loop for i from 4 to 31 collect i)
210 :constant-scs (fp-single-zero)
212 :alternate-scs (single-stack))
214 ;; Non-Descriptor double-floats.
215 (double-reg float-registers
216 :locations #.(loop for i from 4 to 31 collect i)
217 :constant-scs (fp-double-zero)
219 :alternate-scs (double-stack))
221 (complex-single-reg float-registers
222 :locations #.(loop for i from 4 to 30 by 2 collect i)
226 :alternate-scs (complex-single-stack))
228 (complex-double-reg float-registers
229 :locations #.(loop for i from 4 to 30 by 2 collect i)
233 :alternate-scs (complex-double-stack))
235 ;; A catch or unwind block.
236 (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size))
239 ;;;; Make some random tns for important registers.
241 (macrolet ((defregtn (name sc)
242 (let ((offset-sym (symbolicate name "-OFFSET"))
243 (tn-sym (symbolicate name "-TN")))
244 `(defparameter ,tn-sym
245 (make-random-tn :kind :normal
246 :sc (sc-or-lose ',sc)
247 :offset ,offset-sym)))))
249 ;; These, we access by foo-TN only
251 (defregtn zero any-reg)
252 (defregtn null descriptor-reg)
253 (defregtn code descriptor-reg)
254 (defregtn alloc any-reg)
255 (defregtn bsp any-reg)
256 (defregtn csp any-reg)
257 (defregtn cfp any-reg)
258 (defregtn nsp any-reg)
260 ;; These alias regular locations, so we have to make sure we don't bypass
261 ;; the register allocator when using them.
262 (defregtn nargs any-reg)
263 (defregtn ocfp any-reg)
264 (defregtn lip interior-reg))
266 ;; And some floating point values.
267 (defparameter fp-single-zero-tn
268 (make-random-tn :kind :normal
269 :sc (sc-or-lose 'single-reg)
271 (defparameter fp-double-zero-tn
272 (make-random-tn :kind :normal
273 :sc (sc-or-lose 'double-reg)
277 ;;; If VALUE can be represented as an immediate constant, then return
278 ;;; the appropriate SC number, otherwise return NIL.
279 (!def-vm-support-routine immediate-constant-sc (value)
282 (sc-number-or-lose 'zero))
284 (sc-number-or-lose 'null))
285 ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
286 system-area-pointer character)
287 (sc-number-or-lose 'immediate))
289 (if (static-symbol-p value)
290 (sc-number-or-lose 'immediate)
294 (sc-number-or-lose 'fp-single-zero)
298 (sc-number-or-lose 'fp-double-zero)
302 ;;;; Function Call Parameters
304 ;;; The SC numbers for register and stack arguments/return values.
306 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
307 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
308 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
310 (eval-when (:compile-toplevel :load-toplevel :execute)
312 ;;; Offsets of special stack frame locations
313 (defconstant ocfp-save-offset 0)
314 (defconstant lra-save-offset 1)
315 (defconstant nfp-save-offset 2)
317 ;;; The number of arguments/return values passed in registers.
319 (defconstant register-arg-count 6)
321 ;;; Names to use for the argument registers.
323 (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal)
328 ;;; A list of TN's describing the register arguments.
330 (defparameter register-arg-tns
331 (mapcar #'(lambda (n)
332 (make-random-tn :kind :normal
333 :sc (sc-or-lose 'descriptor-reg)
335 *register-arg-offsets*))
337 ;;; This is used by the debugger.
338 (defconstant single-value-return-byte-offset 4)
340 ;;; This function is called by debug output routines that want a pretty name
341 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
342 (!def-vm-support-routine location-print-name (tn)
343 (declare (type tn tn))
344 (let ((sb (sb-name (sc-sb (tn-sc tn))))
345 (offset (tn-offset tn)))
347 (registers (or (svref *register-names* offset)
348 (format nil "R~D" offset)))
349 (float-registers (format nil "F~D" offset))
350 (control-stack (format nil "CS~D" offset))
351 (non-descriptor-stack (format nil "NS~D" offset))
352 (constant (format nil "Const~D" offset))
353 (immediate-constant "Immed"))))
355 (!def-vm-support-routine combination-implementation-style (node)
356 (declare (type sb!c::combination node) (ignore node))
357 (values :default nil))