f50443b8faaea4e11967b3ba30fb451126fe47ed
[sbcl.git] / src / compiler / sparc / vm.lisp
1 ;;;; miscellaneous VM definition noise for the Sparc
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13
14 ;;;; Additional constants
15
16 ;;; NUMBER-STACK-DISPLACEMENT
17 ;;;
18 ;;; The number of bytes reserved above the number stack pointer.  These
19 ;;; slots are required by architecture for a place to spill register windows.
20 ;;;
21 ;;; FIXME: Where is this used?
22 (def!constant number-stack-displacement
23   (* 16 n-word-bytes))
24
25 ;;;; Define the registers
26
27 (eval-when (:compile-toplevel :load-toplevel :execute)
28   (defvar *register-names* (make-array 32 :initial-element nil)))
29
30 (macrolet ((defreg (name offset)
31                (let ((offset-sym (symbolicate name "-OFFSET")))
32                  `(eval-when (:compile-toplevel :load-toplevel :execute)
33                    (def!constant ,offset-sym ,offset)
34                    (setf (svref *register-names* ,offset-sym)
35                         ,(symbol-name name)))))
36
37            (defregset (name &rest regs)
38                 `(eval-when (:compile-toplevel :load-toplevel :execute)
39                   (defparameter ,name
40                     (list ,@(mapcar (lambda (name)
41                                       (symbolicate name "-OFFSET"))
42                                     regs))))))
43   ;; c.f. src/runtime/sparc-lispregs.h
44
45   ;; Globals.  These are difficult to extract from a sigcontext.
46   (defreg zero 0)                               ; %g0
47   (defreg alloc 1)                              ; %g1
48   (defreg null 2)                               ; %g2
49   (defreg csp 3)                                ; %g3
50   (defreg cfp 4)                                ; %g4
51   (defreg bsp 5)                                ; %g5
52   ;; %g6 and %g7 are supposed to be reserved for the system.
53
54   ;; Outs.  These get clobbered when we call into C.
55   (defreg nl0 8)                                ; %o0
56   (defreg nl1 9)                                ; %o1
57   (defreg nl2 10)                               ; %o2
58   (defreg nl3 11)                               ; %o3
59   (defreg nl4 12)                               ; %o4
60   (defreg nl5 13)                               ; %o5
61   (defreg nsp 14)                               ; %o6
62   (defreg nargs 15)                             ; %o7
63
64   ;; Locals.  These are preserved when we call into C.
65   (defreg a0 16)                                ; %l0
66   (defreg a1 17)                                ; %l1
67   (defreg a2 18)                                ; %l2
68   (defreg a3 19)                                ; %l3
69   (defreg a4 20)                                ; %l4
70   (defreg a5 21)                                ; %l5
71   (defreg ocfp 22)                              ; %l6
72   (defreg lra 23)                               ; %l7
73
74   ;; Ins.  These are preserved just like locals.
75   (defreg cname 24)                             ; %i0
76   (defreg lexenv 25)                            ; %i1
77   (defreg l0 26)                                ; %i2
78   (defreg nfp 27)                               ; %i3
79   (defreg cfunc 28)                             ; %i4
80   (defreg code 29)                              ; %i5
81   ;; we can't touch reg 30 if we ever want to return
82   (defreg lip 31)                               ; %i7
83
84   (defregset non-descriptor-regs
85       nl0 nl1 nl2 nl3 nl4 nl5 cfunc nargs nfp)
86
87   (defregset descriptor-regs
88       a0 a1 a2 a3 a4 a5 ocfp lra cname lexenv l0)
89
90   (defregset *register-arg-offsets*
91       a0 a1 a2 a3 a4 a5))
92 \f
93 ;;;; SB and SC definition
94
95 (define-storage-base registers :finite :size 32)
96 (define-storage-base float-registers :finite :size 64)
97 (define-storage-base control-stack :unbounded :size 8)
98 (define-storage-base non-descriptor-stack :unbounded :size 0)
99 (define-storage-base constant :non-packed)
100 (define-storage-base immediate-constant :non-packed)
101
102 ;;; handy macro so we don't have to keep changing all the numbers
103 ;;; whenever we insert a new storage class
104 (defmacro !define-storage-classes (&rest classes)
105   (do ((forms (list 'progn)
106               (let* ((class (car classes))
107                      (sc-name (car class))
108                      (constant-name (intern (concatenate 'simple-string
109                                                          (string sc-name)
110                                                          "-SC-NUMBER"))))
111                 (list* `(define-storage-class ,sc-name ,index
112                           ,@(cdr class))
113                        `(def!constant ,constant-name ,index)
114                        ;; (The CMU CL version of this macro did
115                        ;;   `(EXPORT ',CONSTANT-NAME)
116                        ;; here, but in SBCL we try to have package
117                        ;; structure described statically in one
118                        ;; master source file, instead of building it
119                        ;; dynamically by letting all the system code
120                        ;; modify it as the system boots.)
121                        forms)))
122        (index 0 (1+ index))
123        (classes classes (cdr classes)))
124       ((null classes)
125        (nreverse forms))))
126
127 ;;; see comment in ../x86/vm.lisp.  The value of 7 was taken from
128 ;;; vm:catch-block-size in a cmucl that I happened to have around
129 ;;; and seems to be working so far    -dan
130 ;;;
131 ;;; arbitrarily taken for alpha, too. - Christophe
132 (def!constant kludge-nondeterministic-catch-block-size 6)
133
134 (!define-storage-classes
135
136   ;; non-immediate constants in the constant pool
137   (constant constant)
138
139   ;; ZERO and NULL are in registers.
140   (zero immediate-constant)
141   (null immediate-constant)
142
143   ;; Anything else that can be an immediate.
144   (immediate immediate-constant)
145
146   ;;
147   ;; the stacks
148   ;;
149
150   ;; The control stack.  (Scanned by GC)
151   (control-stack control-stack)
152
153   ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
154   ;; is small and therefore the error trap information is smaller.
155   ;; Moving them up here from their previous place down below saves
156   ;; ~250K in core file size.  --njf, 2006-01-27
157
158   ;; Immediate descriptor objects.  Don't have to be seen by GC, but nothing
159   ;; bad will happen if they are.  (fixnums, characters, header values, etc).
160   (any-reg
161    registers
162    :locations #.(append non-descriptor-regs descriptor-regs)
163    :constant-scs (zero immediate)
164    :save-p t
165    :alternate-scs (control-stack))
166
167   ;; Pointer descriptor objects.  Must be seen by GC.
168   (descriptor-reg registers
169    :locations #.descriptor-regs
170    :constant-scs (constant null immediate)
171    :save-p t
172    :alternate-scs (control-stack))
173
174   ;; The non-descriptor stacks.
175   (signed-stack non-descriptor-stack) ; (signed-byte 32)
176   (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
177   (character-stack non-descriptor-stack) ; non-descriptor characters.
178   (sap-stack non-descriptor-stack) ; System area pointers.
179   (single-stack non-descriptor-stack) ; single-floats
180   (double-stack non-descriptor-stack
181                 :element-size 2 :alignment 2) ; double floats.
182   #!+long-float
183   (long-stack non-descriptor-stack :element-size 4 :alignment 4) ; long floats.
184   ;; complex-single-floats
185   (complex-single-stack non-descriptor-stack :element-size 2)
186   ;; complex-double-floats.
187   (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
188   #!+long-float
189   ;; complex-long-floats.
190   (complex-long-stack non-descriptor-stack :element-size 8 :alignment 4)
191
192
193   ;; **** Things that can go in the integer registers.
194
195   ;; Non-Descriptor characters
196   (character-reg registers
197    :locations #.non-descriptor-regs
198    :constant-scs (immediate)
199    :save-p t
200    :alternate-scs (character-stack))
201
202   ;; Non-Descriptor SAP's (arbitrary pointers into address space)
203   (sap-reg registers
204    :locations #.non-descriptor-regs
205    :constant-scs (immediate)
206    :save-p t
207    :alternate-scs (sap-stack))
208
209   ;; Non-Descriptor (signed or unsigned) numbers.
210   (signed-reg registers
211    :locations #.non-descriptor-regs
212    :constant-scs (zero immediate)
213    :save-p t
214    :alternate-scs (signed-stack))
215   (unsigned-reg registers
216    :locations #.non-descriptor-regs
217    :constant-scs (zero immediate)
218    :save-p t
219    :alternate-scs (unsigned-stack))
220
221   ;; Random objects that must not be seen by GC.  Used only as temporaries.
222   (non-descriptor-reg registers
223    :locations #.non-descriptor-regs)
224
225   ;; Pointers to the interior of objects.  Used only as an temporary.
226   (interior-reg registers
227    :locations (#.lip-offset))
228
229
230   ;; **** Things that can go in the floating point registers.
231
232   ;; Non-Descriptor single-floats.
233   (single-reg float-registers
234    :locations #.(loop for i from 0 to 31 collect i)
235    :reserve-locations (28 29 30 31)
236    :constant-scs ()
237    :save-p t
238    :alternate-scs (single-stack))
239
240   ;; Non-Descriptor double-floats.
241   (double-reg float-registers
242    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
243                       by 2 collect i)
244    :element-size 2 :alignment 2
245    :reserve-locations (28 30)
246    :constant-scs ()
247    :save-p t
248    :alternate-scs (double-stack))
249
250   ;; Non-Descriptor double-floats.
251   #!+long-float
252   (long-reg float-registers
253    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
254                       by 4 collect i)
255    :element-size 4 :alignment 4
256    :reserve-locations (28)
257    :constant-scs ()
258    :save-p t
259    :alternate-scs (long-stack))
260
261   (complex-single-reg float-registers
262    :locations #.(loop for i from 0 to 31 by 2 collect i)
263    :element-size 2 :alignment 2
264    :reserve-locations (28 30)
265    :constant-scs ()
266    :save-p t
267    :alternate-scs (complex-single-stack))
268
269   (complex-double-reg float-registers
270    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
271                       by 4 collect i)
272    :element-size 4 :alignment 4
273    :reserve-locations (28)
274    :constant-scs ()
275    :save-p t
276    :alternate-scs (complex-double-stack))
277
278   #!+long-float
279   (complex-long-reg float-registers
280    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
281                       by 8 collect i)
282    :element-size 8 :alignment 8
283    :constant-scs ()
284    :save-p t
285    :alternate-scs (complex-long-stack))
286
287
288   ;; A catch or unwind block.
289   (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size))
290 \f
291 ;;;; Make some miscellaneous TNs for important registers.
292 (macrolet ((defregtn (name sc)
293                (let ((offset-sym (symbolicate name "-OFFSET"))
294                      (tn-sym (symbolicate name "-TN")))
295                  `(defparameter ,tn-sym
296                    (make-random-tn :kind :normal
297                     :sc (sc-or-lose ',sc)
298                     :offset ,offset-sym)))))
299   (defregtn zero any-reg)
300   (defregtn null descriptor-reg)
301   (defregtn code descriptor-reg)
302   (defregtn lip descriptor-reg)
303   (defregtn alloc any-reg)
304
305   (defregtn nargs any-reg)
306   (defregtn bsp any-reg)
307   (defregtn csp any-reg)
308   (defregtn cfp any-reg)
309   (defregtn ocfp any-reg)
310   (defregtn nsp any-reg))
311 \f
312 ;;; If VALUE can be represented as an immediate constant, then return the
313 ;;; appropriate SC number, otherwise return NIL.
314 (defun immediate-constant-sc (value)
315   (typecase value
316     ((integer 0 0)
317      (sc-number-or-lose 'zero))
318     (null
319      (sc-number-or-lose 'null))
320     ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
321          character)
322      (sc-number-or-lose 'immediate))
323     (symbol
324      (if (static-symbol-p value)
325          (sc-number-or-lose 'immediate)
326          nil))))
327
328 (defun boxed-immediate-sc-p (sc)
329   (or (eql sc (sc-number-or-lose 'zero))
330       (eql sc (sc-number-or-lose 'null))
331       (eql sc (sc-number-or-lose 'immediate))))
332 \f
333 ;;;; function call parameters
334
335 ;;; the SC numbers for register and stack arguments/return values.
336 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
337 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
338 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
339
340 (eval-when (:compile-toplevel :load-toplevel :execute)
341
342   ;; offsets of special stack frame locations
343   (def!constant ocfp-save-offset 0)
344   (def!constant lra-save-offset 1)
345   (def!constant nfp-save-offset 2)
346
347   ;; the number of arguments/return values passed in registers.
348   (def!constant register-arg-count 6)
349
350   ;; names to use for the argument registers.
351   (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5))
352 ) ; EVAL-WHEN
353
354
355 ;;; a list of TN's describing the register arguments
356 (defparameter *register-arg-tns*
357   (mapcar (lambda (n)
358             (make-random-tn :kind :normal
359                               :sc (sc-or-lose 'descriptor-reg)
360                               :offset n))
361           *register-arg-offsets*))
362
363 ;;; This is used by the debugger.
364 (def!constant single-value-return-byte-offset 8)
365 \f
366 ;;; This function is called by debug output routines that want a
367 ;;; pretty name for a TN's location. It returns a thing that can be
368 ;;; printed with PRINC.
369 (defun location-print-name (tn)
370   (declare (type tn tn)) ; FIXME: commented out on alpha
371   (let ((sb (sb-name (sc-sb (tn-sc tn))))
372         (offset (tn-offset tn)))
373     (ecase sb
374       (registers (or (svref *register-names* offset)
375                      (format nil "R~D" offset)))
376       (float-registers (format nil "F~D" offset))
377       (control-stack (format nil "CS~D" offset))
378       (non-descriptor-stack (format nil "NS~D" offset))
379       (constant (format nil "Const~D" offset))
380       (immediate-constant "Immed"))))
381
382 (defun combination-implementation-style (node)
383   (declare (type sb!c::combination node) (ignore node))
384   (values :default nil))
385
386 (defun primitive-type-indirect-cell-type (ptype)
387   (declare (ignore ptype))
388   nil)