src/compiler/mips/vm.lisp

   1 ;;;; miscellaneous VM definition noise for MIPS
   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 \f
  15 ;;;; Registers
  16
  17 (eval-when (:compile-toplevel :load-toplevel :execute)
  18   (defvar *register-names* (make-array 32 :initial-element nil)))
  19
  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
  26            (defregset (name &rest regs)
  27                `(eval-when (:compile-toplevel :load-toplevel :execute)
  28                  (defparameter ,name
  29                    (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs))))))
  30   ;; Wired zero register.
  31   (defreg zero 0) ; NULL
  32   ;; Reserved for assembler use.
  33   (defreg nl3 1) ; untagged temporary 3
  34   ;; C return registers.
  35   (defreg cfunc 2) ; FF function address, wastes a register
  36   (defreg nl4 3) ; PA flag
  37   ;; C argument registers.
  38   (defreg nl0 4) ; untagged temporary 0
  39   (defreg nl1 5) ; untagged temporary 1
  40   (defreg nl2 6) ; untagged temporary 2
  41   (defreg nargs 7) ; number of function arguments
  42   ;; C unsaved temporaries.
  43   (defreg a0 8) ; function arg 0
  44   (defreg a1 9) ; function arg 1
  45   (defreg a2 10) ; function arg 2
  46   (defreg a3 11) ; function arg 3
  47   (defreg a4 12) ; function arg 4
  48   (defreg a5 13) ; function arg 5
  49   (defreg fdefn 14) ; ?
  50   (defreg lexenv 15) ; wastes a register
  51   ;; C saved registers.
  52   (defreg nfp 16) ; non-lisp frame pointer
  53   (defreg ocfp 17) ; caller's control frame pointer
  54   (defreg lra 18) ; tagged Lisp return address
  55   (defreg l0 19) ; tagged temporary 0
  56   (defreg null 20) ; NIL
  57   (defreg bsp 21) ; binding stack pointer
  58   (defreg cfp 22) ; control frame pointer
  59   (defreg csp 23) ; control stack pointer
  60   ;; More C unsaved temporaries.
  61   (defreg l1 24) ; tagged temporary 1
  62   (defreg alloc 25) ; ALLOC pointer
  63   ;; 26 and 27 are used by the system kernel.
  64   ;; 28 is the global pointer of our C runtime, and used for
  65   ;; jump/branch relaxation in Lisp.
  66   (defreg nsp 29) ; number (native) stack pointer
  67   ;; C frame pointer, or additional saved register.
  68   (defreg code 30) ; current function object
  69   ;; Return link register.
  70   (defreg lip 31) ; Lisp interior pointer
  71
  72   (defregset non-descriptor-regs
  73       nl0 nl1 nl2 nl3 nl4 cfunc nargs)
  74
  75   (defregset descriptor-regs
  76       a0 a1 a2 a3 a4 a5 fdefn lexenv nfp ocfp lra l0 l1)
  77
  78   (defregset *register-arg-offsets*
  79       a0 a1 a2 a3 a4 a5)
  80
  81   (defregset reserve-descriptor-regs
  82       fdefn lexenv)
  83
  84   (defregset reserve-non-descriptor-regs
  85       nl4 cfunc))
  86
  87 \f
  88 ;;;; SB and SC definition:
  89
  90 (define-storage-base registers :finite :size 32)
  91 (define-storage-base float-registers :finite :size 32)
  92 (define-storage-base control-stack :unbounded :size 8)
  93 (define-storage-base non-descriptor-stack :unbounded :size 0)
  94 (define-storage-base constant :non-packed)
  95 (define-storage-base immediate-constant :non-packed)
  96
  97 ;;;
  98 ;;; Handy macro so we don't have to keep changing all the numbers whenever
  99 ;;; we insert a new storage class.
 100 ;;;
 101 (defmacro !define-storage-classes (&rest classes)
 102   (do ((forms (list 'progn)
 103               (let* ((class (car classes))
 104                      (sc-name (car class))
 105                      (constant-name (intern (concatenate 'simple-string
 106                                                          (string sc-name)
 107                                                          "-SC-NUMBER"))))
 108                 (list* `(define-storage-class ,sc-name ,index
 109                           ,@(cdr class))
 110                        `(def!constant ,constant-name ,index)
 111                        `(export ',constant-name)
 112                        forms)))
 113        (index 0 (1+ index))
 114        (classes classes (cdr classes)))
 115       ((null classes)
 116        (nreverse forms))))
 117
 118 (def!constant kludge-nondeterministic-catch-block-size 7)
 119
 120 (!define-storage-classes
 121
 122   ;; Non-immediate constants in the constant pool
 123   (constant constant)
 124
 125   ;; Immediate constant.
 126   (null immediate-constant)
 127   (zero immediate-constant)
 128   (immediate immediate-constant)
 129
 130   ;; **** The stacks.
 131
 132   ;; The control stack.  (Scanned by GC)
 133   (control-stack control-stack)
 134
 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
 139
 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).
 142   (any-reg
 143    registers
 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)
 148    :save-p t
 149    :alternate-scs (control-stack))
 150
 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)
 156    :save-p t
 157    :alternate-scs (control-stack))
 158
 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-floats
 168   (complex-single-stack non-descriptor-stack :element-size 2)
 169   ;; complex-double-floats.
 170   (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
 171
 172
 173   ;; **** Things that can go in the integer registers.
 174
 175   ;; Non-Descriptor characters
 176   (character-reg registers
 177    :locations #.non-descriptor-regs
 178    :reserve-locations #.reserve-non-descriptor-regs
 179    :constant-scs (immediate)
 180    :save-p t
 181    :alternate-scs (character-stack))
 182
 183   ;; Non-Descriptor SAP's (arbitrary pointers into address space)
 184   (sap-reg registers
 185    :locations #.non-descriptor-regs
 186    :reserve-locations #.reserve-non-descriptor-regs
 187    :constant-scs (immediate)
 188    :save-p t
 189    :alternate-scs (sap-stack))
 190
 191   ;; Non-Descriptor (signed or unsigned) numbers.
 192   (signed-reg registers
 193    :locations #.non-descriptor-regs
 194    :reserve-locations #.reserve-non-descriptor-regs
 195    :constant-scs (zero immediate)
 196    :save-p t
 197    :alternate-scs (signed-stack))
 198   (unsigned-reg registers
 199    :locations #.non-descriptor-regs
 200    :reserve-locations #.reserve-non-descriptor-regs
 201    :constant-scs (zero immediate)
 202    :save-p t
 203    :alternate-scs (unsigned-stack))
 204
 205   ;; Random objects that must not be seen by GC.  Used only as temporaries.
 206   (non-descriptor-reg registers
 207    :locations #.non-descriptor-regs)
 208
 209   ;; Pointers to the interior of objects.  Used only as an temporary.
 210   (interior-reg registers
 211    :locations (#.lip-offset))
 212
 213
 214   ;; **** Things that can go in the floating point registers.
 215
 216   ;; Non-Descriptor single-floats.
 217   (single-reg float-registers
 218    :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
 219    :reserve-locations (26 28 30)
 220    :constant-scs ()
 221    :save-p t
 222    :alternate-scs (single-stack))
 223
 224   ;; Non-Descriptor double-floats.
 225   (double-reg float-registers
 226    :locations (0 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30)
 227    :reserve-locations (26 28 30)
 228    ;; Note: we don't bother with the element size, 'cause nothing can be
 229    ;; allocated in the odd fp regs anyway.
 230    :constant-scs ()
 231    :save-p t
 232    :alternate-scs (double-stack))
 233
 234   (complex-single-reg float-registers
 235    :locations (0 4 8 12 16 20 24 28)
 236    :element-size 4
 237    :reserve-locations (24 28)
 238    :constant-scs ()
 239    :save-p t
 240    :alternate-scs (complex-single-stack))
 241
 242   (complex-double-reg float-registers
 243    :locations (0 4 8 12 16 20 24 28)
 244    :element-size 4
 245    :reserve-locations (24 28)
 246    :constant-scs ()
 247    :save-p t
 248    :alternate-scs (complex-double-stack))
 249
 250   ;; A catch or unwind block.
 251   (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)
 252
 253   ;; floating point numbers temporarily stuck in integer registers for c-call
 254   (single-int-carg-reg registers
 255                   :locations (4 5 6 7)
 256                   :alternate-scs ()
 257                   :constant-scs ())
 258   (double-int-carg-reg registers
 259                   :locations (4 6)
 260                   :constant-scs ()
 261                   :alternate-scs ()
 262                   :alignment 2          ;is this needed?
 263                   :element-size 2))
 264
 265
 266
 267 \f
 268 ;;;; Random TNs for interesting registers
 269
 270 (macrolet ((defregtn (name sc)
 271                (let ((offset-sym (symbolicate name "-OFFSET"))
 272                      (tn-sym (symbolicate name "-TN")))
 273                  `(defparameter ,tn-sym
 274                    (make-random-tn :kind :normal
 275                     :sc (sc-or-lose ',sc)
 276                     :offset ,offset-sym)))))
 277   (defregtn zero any-reg)
 278   (defregtn nargs any-reg)
 279
 280   (defregtn fdefn descriptor-reg)
 281   (defregtn lexenv descriptor-reg)
 282
 283   (defregtn nfp any-reg)
 284   (defregtn ocfp any-reg)
 285
 286   (defregtn null descriptor-reg)
 287
 288   (defregtn bsp any-reg)
 289   (defregtn cfp any-reg)
 290   (defregtn csp any-reg)
 291   (defregtn alloc any-reg)
 292   (defregtn nsp any-reg)
 293
 294   (defregtn code descriptor-reg)
 295   (defregtn lip interior-reg))
 296 \f
 297 ;;; If VALUE can be represented as an immediate constant, then return the
 298 ;;; appropriate SC number, otherwise return NIL.
 299 (!def-vm-support-routine immediate-constant-sc (value)
 300   (typecase value
 301     ((integer 0 0)
 302      (sc-number-or-lose 'zero))
 303     (null
 304      (sc-number-or-lose 'null))
 305     (symbol
 306      (if (static-symbol-p value)
 307          (sc-number-or-lose 'immediate)
 308          nil))
 309     ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
 310          character)
 311      (sc-number-or-lose 'immediate))
 312     (system-area-pointer
 313      (sc-number-or-lose 'immediate))
 314     (character
 315      (sc-number-or-lose 'immediate))))
 316
 317 \f
 318 ;;;; Function Call Parameters
 319
 320 ;;; The SC numbers for register and stack arguments/return values.
 321 ;;;
 322 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
 323 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
 324 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
 325
 326 (eval-when (:compile-toplevel :load-toplevel :execute)
 327
 328 ;;; Offsets of special stack frame locations
 329 (def!constant ocfp-save-offset 0)
 330 (def!constant lra-save-offset 1)
 331 (def!constant nfp-save-offset 2)
 332
 333 ;;; The number of arguments/return values passed in registers.
 334 ;;;
 335 (def!constant register-arg-count 6)
 336
 337 ;;; The offsets within the register-arg SC that we pass values in, first
 338 ;;; value first.
 339 ;;;
 340
 341 ;;; Names to use for the argument registers.
 342 ;;;
 343 (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal)
 344
 345 ) ; EVAL-WHEN
 346
 347
 348 ;;; A list of TN's describing the register arguments.
 349 ;;;
 350 (defparameter *register-arg-tns*
 351   (mapcar #'(lambda (n)
 352               (make-random-tn :kind :normal
 353                               :sc (sc-or-lose 'descriptor-reg)
 354                               :offset n))
 355           *register-arg-offsets*))
 356
 357 ;;; This is used by the debugger.
 358 (def!constant single-value-return-byte-offset 8)
 359 \f
 360 ;;; This function is called by debug output routines that want a pretty name
 361 ;;; for a TN's location.  It returns a thing that can be printed with PRINC.
 362 (!def-vm-support-routine location-print-name (tn)
 363   (declare (type tn tn))
 364   (let ((sb (sb-name (sc-sb (tn-sc tn))))
 365         (offset (tn-offset tn)))
 366     (ecase sb
 367       (registers (or (svref *register-names* offset)
 368                      (format nil "R~D" offset)))
 369       (float-registers (format nil "F~D" offset))
 370       (control-stack (format nil "CS~D" offset))
 371       (non-descriptor-stack (format nil "NS~D" offset))
 372       (constant (format nil "Const~D" offset))
 373       (immediate-constant "Immed"))))
 374
 375 (!def-vm-support-routine combination-implementation-style (node)
 376   (declare (type sb!c::combination node) (ignore node))
 377   (values :default nil))