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.
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
)))))
25 (defregset (name &rest regs
)
26 `(eval-when (:compile-toplevel
:load-toplevel
:execute
)
28 (list ,@(mapcar #'(lambda (name) (symbolicate name
"-OFFSET")) regs
))))))
31 ;; This gets trashed by the C call convention.
32 (defreg nfp
1) ;; and saved by lisp before calling C
34 ;; These are the callee saves, so these registers are stay live over
52 ;; This is where the caller-saves registers start, but we don't
53 ;; really care because we need to clear the above after call-out to
54 ;; make sure no pointers into oldspace are kept around.
59 ;; These are the 4 C argument registers.
64 ;; The global Data Pointer. We just leave it alone, because we
67 ;; These two are use for C return values.
73 (defregset non-descriptor-regs
74 nl0 nl1 nl2 nl3 nl4 nl5 cfunc nargs nfp
)
76 (defregset descriptor-regs
77 a0 a1 a2 a3 a4 a5 fdefn lexenv ocfp lra l0 l1 l2
)
79 (defregset *register-arg-offsets
*
82 (defregset reserve-descriptor-regs
85 (defregset reserve-non-descriptor-regs
88 (define-storage-base registers
:finite
:size
32)
89 (define-storage-base float-registers
:finite
:size
64)
90 (define-storage-base control-stack
:unbounded
:size
8)
91 (define-storage-base non-descriptor-stack
:unbounded
:size
0)
92 (define-storage-base constant
:non-packed
)
93 (define-storage-base immediate-constant
:non-packed
)
96 ;;; Handy macro so we don't have to keep changing all the numbers whenever
97 ;;; we insert a new storage class.
98 ;;; FIXME-lav: move this into arch-generic-helpers.lisp and rip out from arches
99 (defmacro !define-storage-classes
(&rest classes
)
100 (do ((forms (list 'progn
)
101 (let* ((class (car classes
))
102 (sc-name (car class
))
103 (constant-name (intern (concatenate 'simple-string
106 (list* `(define-storage-class ,sc-name
,index
108 `(def!constant
,constant-name
,index
)
111 (classes classes
(cdr classes
)))
115 (!define-storage-classes
117 ;; Non-immediate constants 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 :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-stack non-descriptor-stack
:element-size
2)
168 (complex-double-stack non-descriptor-stack
:element-size
4 :alignment
2)
170 ;; **** Things that can go in the integer registers.
172 ;; Non-Descriptor characters
173 (character-reg registers
174 :locations
#.non-descriptor-regs
175 :reserve-locations
#.reserve-non-descriptor-regs
176 :constant-scs
(immediate)
178 :alternate-scs
(character-stack))
180 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
182 :locations
#.non-descriptor-regs
183 :reserve-locations
#.reserve-non-descriptor-regs
184 :constant-scs
(immediate)
186 :alternate-scs
(sap-stack))
188 ;; Non-Descriptor (signed or unsigned) numbers.
189 (signed-reg registers
190 :locations
#.non-descriptor-regs
191 :reserve-locations
#.reserve-non-descriptor-regs
192 :constant-scs
(zero immediate
)
194 :alternate-scs
(signed-stack))
195 (unsigned-reg registers
196 :locations
#.non-descriptor-regs
197 :reserve-locations
#.reserve-non-descriptor-regs
198 :constant-scs
(zero immediate
)
200 :alternate-scs
(unsigned-stack))
202 ;; Random objects that must not be seen by GC. Used only as temporaries.
203 (non-descriptor-reg registers
204 :locations
#.non-descriptor-regs
)
206 ;; Pointers to the interior of objects. Used only as an temporary.
207 (interior-reg registers
208 :locations
(#.lip-offset
))
211 ;; **** Things that can go in the floating point registers.
213 ;; Non-Descriptor single-floats.
214 (single-reg float-registers
215 :locations
#.
(loop for i from
4 to
31 collect i
)
216 :constant-scs
(fp-single-zero)
218 :alternate-scs
(single-stack))
220 ;; Non-Descriptor double-floats.
221 (double-reg float-registers
222 :locations
#.
(loop for i from
4 to
31 collect i
)
223 :constant-scs
(fp-double-zero)
225 :alternate-scs
(double-stack))
227 (complex-single-reg float-registers
228 :locations
#.
(loop for i from
4 to
30 by
2 collect i
)
232 :alternate-scs
(complex-single-stack))
234 (complex-double-reg float-registers
235 :locations
#.
(loop for i from
4 to
30 by
2 collect i
)
239 :alternate-scs
(complex-double-stack))
241 (catch-block control-stack
:element-size catch-block-size
)
242 (unwind-block control-stack
:element-size unwind-block-size
)
244 ;; floating point numbers temporarily stuck in integer registers for c-call
245 (single-int-carg-reg registers
246 :locations
(26 25 24 23)
249 (double-int-carg-reg registers
253 ; :alignment 2 ;is this needed?
258 ;;;; Make some random tns for important registers.
260 ;;; how can we address reg L0 through L0-offset when it is not
261 ;;; defined here ? do all registers have an -offset and this is
264 ;;; FIXME-lav: move this into arch-generic-helpers
265 (macrolet ((defregtn (name sc
)
266 (let ((offset-sym (symbolicate name
"-OFFSET"))
267 (tn-sym (symbolicate name
"-TN")))
268 `(defparameter ,tn-sym
269 (make-random-tn :kind
:normal
270 :sc
(sc-or-lose ',sc
)
271 :offset
,offset-sym
)))))
273 ;; These, we access by foo-TN only
275 (defregtn zero any-reg
)
276 (defregtn nargs any-reg
)
277 ;; FIXME-lav: 20080820: not a fix, but fdefn and lexenv is used in assembly-rtns
278 (defregtn fdefn descriptor-reg
) ; FIXME-lav, not used
279 (defregtn lexenv descriptor-reg
) ; FIXME-lav, not used
281 (defregtn nfp descriptor-reg
) ; why not descriptor-reg ?
282 (defregtn ocfp any-reg
) ; why not descriptor-reg ?
284 (defregtn null descriptor-reg
)
286 (defregtn bsp any-reg
)
287 (defregtn cfp any-reg
)
288 (defregtn csp any-reg
)
289 (defregtn alloc any-reg
)
290 (defregtn nsp any-reg
)
292 (defregtn code descriptor-reg
)
293 (defregtn lip interior-reg
))
295 ;; And some floating point values.
296 (defparameter fp-single-zero-tn
297 (make-random-tn :kind
:normal
298 :sc
(sc-or-lose 'single-reg
)
300 (defparameter fp-double-zero-tn
301 (make-random-tn :kind
:normal
302 :sc
(sc-or-lose 'double-reg
)
306 ;;; If VALUE can be represented as an immediate constant, then return
307 ;;; the appropriate SC number, otherwise return NIL.
308 (defun immediate-constant-sc (value)
311 (sc-number-or-lose 'zero
))
313 (sc-number-or-lose 'null
))
314 ((or (integer #.sb
!xc
:most-negative-fixnum
#.sb
!xc
:most-positive-fixnum
)
315 system-area-pointer character
)
316 (sc-number-or-lose 'immediate
))
318 (if (static-symbol-p value
)
319 (sc-number-or-lose 'immediate
)
323 (sc-number-or-lose 'fp-single-zero
)
327 (sc-number-or-lose 'fp-double-zero
)
330 (defun boxed-immediate-sc-p (sc)
331 (or (eql sc
(sc-number-or-lose 'zero
))
332 (eql sc
(sc-number-or-lose 'null
))
333 (eql sc
(sc-number-or-lose 'immediate
))))
335 ;;;; Function Call Parameters
337 ;;; The SC numbers for register and stack arguments/return values.
339 (def!constant immediate-arg-scn
(sc-number-or-lose 'any-reg
))
340 (def!constant control-stack-arg-scn
(sc-number-or-lose 'control-stack
))
342 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
344 ;;; Offsets of special stack frame locations
345 (def!constant ocfp-save-offset
0)
346 (def!constant lra-save-offset
1)
347 (def!constant nfp-save-offset
2)
349 ;;; The number of arguments/return values passed in registers.
351 (def!constant register-arg-count
6)
353 ;;; Names to use for the argument registers.
355 (defconstant-eqx register-arg-names
'(a0 a1 a2 a3 a4 a5
) #'equal
)
360 ;;; A list of TN's describing the register arguments.
362 (defparameter *register-arg-tns
*
364 (make-random-tn :kind
:normal
365 :sc
(sc-or-lose 'descriptor-reg
)
367 *register-arg-offsets
*))
369 ;;; This is used by the debugger.
370 (def!constant single-value-return-byte-offset
4)
372 ;;; This function is called by debug output routines that want a pretty name
373 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
374 (defun location-print-name (tn)
375 (declare (type tn tn
))
376 (let ((sb (sb-name (sc-sb (tn-sc tn
))))
377 (offset (tn-offset tn
)))
379 (registers (or (svref *register-names
* offset
)
380 (format nil
"R~D" offset
)))
381 (float-registers (format nil
"F~D" offset
))
382 (control-stack (format nil
"CS~D" offset
))
383 (non-descriptor-stack (format nil
"NS~D" offset
))
384 (constant (format nil
"Const~D" offset
))
385 (immediate-constant "Immed"))))
387 (defun combination-implementation-style (node)
388 (declare (type sb
!c
::combination node
) (ignore node
))
389 (values :default nil
))
391 (defun primitive-type-indirect-cell-type (ptype)
392 (declare (ignore ptype
))