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 (!define-storage-classes
 128
 129   ;; non-immediate constants in the constant pool
 130   (constant constant)
 131
 132   ;; ZERO and NULL are in registers.
 133   (zero immediate-constant)
 134   (null immediate-constant)
 135
 136   ;; Anything else that can be an immediate.
 137   (immediate immediate-constant)
 138
 139   ;;
 140   ;; the stacks
 141   ;;
 142
 143   ;; The control stack.  (Scanned by GC)
 144   (control-stack control-stack)
 145
 146   ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
 147   ;; is small and therefore the error trap information is smaller.
 148   ;; Moving them up here from their previous place down below saves
 149   ;; ~250K in core file size.  --njf, 2006-01-27
 150
 151   ;; Immediate descriptor objects.  Don't have to be seen by GC, but nothing
 152   ;; bad will happen if they are.  (fixnums, characters, header values, etc).
 153   (any-reg
 154    registers
 155    :locations #.(append non-descriptor-regs descriptor-regs)
 156    :constant-scs (zero immediate)
 157    :save-p t
 158    :alternate-scs (control-stack))
 159
 160   ;; Pointer descriptor objects.  Must be seen by GC.
 161   (descriptor-reg registers
 162    :locations #.descriptor-regs
 163    :constant-scs (constant null immediate)
 164    :save-p t
 165    :alternate-scs (control-stack))
 166
 167   ;; The non-descriptor stacks.
 168   (signed-stack non-descriptor-stack) ; (signed-byte 32)
 169   (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
 170   (character-stack non-descriptor-stack) ; non-descriptor characters.
 171   (sap-stack non-descriptor-stack) ; System area pointers.
 172   (single-stack non-descriptor-stack) ; single-floats
 173   (double-stack non-descriptor-stack
 174                 :element-size 2 :alignment 2) ; double floats.
 175   #!+long-float
 176   (long-stack non-descriptor-stack :element-size 4 :alignment 4) ; long floats.
 177   ;; complex-single-floats
 178   (complex-single-stack non-descriptor-stack :element-size 2)
 179   ;; complex-double-floats.
 180   (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
 181   #!+long-float
 182   ;; complex-long-floats.
 183   (complex-long-stack non-descriptor-stack :element-size 8 :alignment 4)
 184
 185
 186   ;; **** Things that can go in the integer registers.
 187
 188   ;; Non-Descriptor characters
 189   (character-reg registers
 190    :locations #.non-descriptor-regs
 191    :constant-scs (immediate)
 192    :save-p t
 193    :alternate-scs (character-stack))
 194
 195   ;; Non-Descriptor SAP's (arbitrary pointers into address space)
 196   (sap-reg registers
 197    :locations #.non-descriptor-regs
 198    :constant-scs (immediate)
 199    :save-p t
 200    :alternate-scs (sap-stack))
 201
 202   ;; Non-Descriptor (signed or unsigned) numbers.
 203   (signed-reg registers
 204    :locations #.non-descriptor-regs
 205    :constant-scs (zero immediate)
 206    :save-p t
 207    :alternate-scs (signed-stack))
 208   (unsigned-reg registers
 209    :locations #.non-descriptor-regs
 210    :constant-scs (zero immediate)
 211    :save-p t
 212    :alternate-scs (unsigned-stack))
 213
 214   ;; Random objects that must not be seen by GC.  Used only as temporaries.
 215   (non-descriptor-reg registers
 216    :locations #.non-descriptor-regs)
 217
 218   ;; Pointers to the interior of objects.  Used only as an temporary.
 219   (interior-reg registers
 220    :locations (#.lip-offset))
 221
 222
 223   ;; **** Things that can go in the floating point registers.
 224
 225   ;; Non-Descriptor single-floats.
 226   (single-reg float-registers
 227    :locations #.(loop for i from 0 to 31 collect i)
 228    :reserve-locations (28 29 30 31)
 229    :constant-scs ()
 230    :save-p t
 231    :alternate-scs (single-stack))
 232
 233   ;; Non-Descriptor double-floats.
 234   (double-reg float-registers
 235    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
 236                       by 2 collect i)
 237    :element-size 2 :alignment 2
 238    :reserve-locations (28 30)
 239    :constant-scs ()
 240    :save-p t
 241    :alternate-scs (double-stack))
 242
 243   ;; Non-Descriptor double-floats.
 244   #!+long-float
 245   (long-reg float-registers
 246    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
 247                       by 4 collect i)
 248    :element-size 4 :alignment 4
 249    :reserve-locations (28)
 250    :constant-scs ()
 251    :save-p t
 252    :alternate-scs (long-stack))
 253
 254   (complex-single-reg float-registers
 255    :locations #.(loop for i from 0 to 31 by 2 collect i)
 256    :element-size 2 :alignment 2
 257    :reserve-locations (28 30)
 258    :constant-scs ()
 259    :save-p t
 260    :alternate-scs (complex-single-stack))
 261
 262   (complex-double-reg float-registers
 263    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
 264                       by 4 collect i)
 265    :element-size 4 :alignment 4
 266    :reserve-locations (28)
 267    :constant-scs ()
 268    :save-p t
 269    :alternate-scs (complex-double-stack))
 270
 271   #!+long-float
 272   (complex-long-reg float-registers
 273    :locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
 274                       by 8 collect i)
 275    :element-size 8 :alignment 8
 276    :constant-scs ()
 277    :save-p t
 278    :alternate-scs (complex-long-stack))
 279
 280
 281   (catch-block control-stack :element-size catch-block-size)
 282   (unwind-block control-stack :element-size unwind-block-size))
 283 \f
 284 ;;;; Make some miscellaneous TNs for important registers.
 285 (macrolet ((defregtn (name sc)
 286                (let ((offset-sym (symbolicate name "-OFFSET"))
 287                      (tn-sym (symbolicate name "-TN")))
 288                  `(defparameter ,tn-sym
 289                    (make-random-tn :kind :normal
 290                     :sc (sc-or-lose ',sc)
 291                     :offset ,offset-sym)))))
 292   (defregtn zero any-reg)
 293   (defregtn null descriptor-reg)
 294   (defregtn code descriptor-reg)
 295   (defregtn lip descriptor-reg)
 296   (defregtn alloc any-reg)
 297
 298   (defregtn nargs any-reg)
 299   (defregtn bsp any-reg)
 300   (defregtn csp any-reg)
 301   (defregtn cfp any-reg)
 302   (defregtn ocfp any-reg)
 303   (defregtn nsp any-reg))
 304 \f
 305 ;;; If VALUE can be represented as an immediate constant, then return the
 306 ;;; appropriate SC number, otherwise return NIL.
 307 (defun immediate-constant-sc (value)
 308   (typecase value
 309     ((integer 0 0)
 310      (sc-number-or-lose 'zero))
 311     (null
 312      (sc-number-or-lose 'null))
 313     ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
 314          character)
 315      (sc-number-or-lose 'immediate))
 316     (symbol
 317      (if (static-symbol-p value)
 318          (sc-number-or-lose 'immediate)
 319          nil))))
 320
 321 (defun boxed-immediate-sc-p (sc)
 322   (or (eql sc (sc-number-or-lose 'zero))
 323       (eql sc (sc-number-or-lose 'null))
 324       (eql sc (sc-number-or-lose 'immediate))))
 325 \f
 326 ;;;; function call parameters
 327
 328 ;;; the SC numbers for register and stack arguments/return values.
 329 (def!constant immediate-arg-scn (sc-number-or-lose 'any-reg))
 330 (def!constant control-stack-arg-scn (sc-number-or-lose 'control-stack))
 331
 332 (eval-when (:compile-toplevel :load-toplevel :execute)
 333
 334   ;; offsets of special stack frame locations
 335   (def!constant ocfp-save-offset 0)
 336   (def!constant lra-save-offset 1)
 337   (def!constant nfp-save-offset 2)
 338
 339   ;; the number of arguments/return values passed in registers.
 340   (def!constant register-arg-count 6)
 341
 342   ;; names to use for the argument registers.
 343   (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5))
 344 ) ; EVAL-WHEN
 345
 346
 347 ;;; a list of TN's describing the register arguments
 348 (defparameter *register-arg-tns*
 349   (mapcar (lambda (n)
 350             (make-random-tn :kind :normal
 351                               :sc (sc-or-lose 'descriptor-reg)
 352                               :offset n))
 353           *register-arg-offsets*))
 354
 355 ;;; This is used by the debugger.
 356 (def!constant single-value-return-byte-offset 8)
 357 \f
 358 ;;; This function is called by debug output routines that want a
 359 ;;; pretty name for a TN's location. It returns a thing that can be
 360 ;;; printed with PRINC.
 361 (defun location-print-name (tn)
 362   (declare (type tn tn)) ; FIXME: commented out on alpha
 363   (let ((sb (sb-name (sc-sb (tn-sc tn))))
 364         (offset (tn-offset tn)))
 365     (ecase sb
 366       (registers (or (svref *register-names* offset)
 367                      (format nil "R~D" offset)))
 368       (float-registers (format nil "F~D" offset))
 369       (control-stack (format nil "CS~D" offset))
 370       (non-descriptor-stack (format nil "NS~D" offset))
 371       (constant (format nil "Const~D" offset))
 372       (immediate-constant "Immed"))))
 373
 374 (defun combination-implementation-style (node)
 375   (declare (type sb!c::combination node) (ignore node))
 376   (values :default nil))
 377
 378 (defun primitive-type-indirect-cell-type (ptype)
 379   (declare (ignore ptype))
 380   nil)