src/compiler/arm/vm.lisp

   1 ;;;; miscellaneous VM definition noise for the ARM
   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 ;;;; register specs
  16
  17 (eval-when (:compile-toplevel :load-toplevel :execute)
  18   (defvar *register-names* (make-array 16 :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)
  30                                       (symbolicate name "-OFFSET")) regs))))))
  31
  32   (defreg r0 0)
  33   (defreg r1 1)
  34   (defreg r2 2)
  35   (defreg lexenv 3)
  36   (defreg nl2 4)
  37   (defreg code 5)
  38   (defreg nl3 6)
  39   (defreg ocfp 7)
  40   (defreg r8 8)
  41   (defreg nfp 9)
  42   (defreg null 10)
  43   (defreg cfp 11)
  44   (defreg nargs 12)
  45   (defreg csp 13)
  46   (defreg lr 14)
  47   (defreg pc 15) ;; Yes, the program counter.
  48
  49   (defregset system-regs
  50       null cfp csp lr pc code)
  51
  52   (defregset descriptor-regs
  53       r0 r1 r2 lexenv r8)
  54
  55   (defregset non-descriptor-regs
  56       ocfp nfp nargs nl2 nl3)
  57
  58   ;; registers used to pass arguments
  59   ;;
  60   ;; the number of arguments/return values passed in registers
  61   (def!constant  register-arg-count 3)
  62   ;; names and offsets for registers used to pass arguments
  63   (defregset *register-arg-offsets*  r0 r1 r2)
  64   (defparameter *register-arg-names* '(r0 r1 r2)))
  65
  66 \f
  67 ;;;; SB and SC definition:
  68
  69 (define-storage-base registers :finite :size 16)
  70 (define-storage-base control-stack :unbounded :size 8)
  71 (define-storage-base non-descriptor-stack :unbounded :size 0)
  72 (define-storage-base constant :non-packed)
  73 (define-storage-base immediate-constant :non-packed)
  74 #!+arm-vfp
  75 (define-storage-base float-registers :finite :size 32)
  76 ;; NOTE: If you fix the following, please to so with its own feature
  77 ;; conditional, and also adjust the definitions of the
  78 ;; {,COMPLEX-}{SINGLE,DOUBLE}-REG SCs below.
  79 #!-arm-vfp
  80 (error "Don't know how many float registers for non-VFP systems")
  81
  82 ;;;
  83 ;;; Handy macro so we don't have to keep changing all the numbers whenever
  84 ;;; we insert a new storage class.
  85 ;;;
  86 (defmacro define-storage-classes (&rest classes)
  87   (do ((forms (list 'progn)
  88               (let* ((class (car classes))
  89                      (sc-name (car class))
  90                      (constant-name (intern (concatenate 'simple-string
  91                                                          (string sc-name)
  92                                                          "-SC-NUMBER"))))
  93                 (list* `(define-storage-class ,sc-name ,index
  94                           ,@(cdr class))
  95                        `(def!constant ,constant-name ,index)
  96                        forms)))
  97        (index 0 (1+ index))
  98        (classes classes (cdr classes)))
  99       ((null classes)
 100        (nreverse forms))))
 101
 102 (def!constant kludge-nondeterministic-catch-block-size 6)
 103
 104 (define-storage-classes
 105
 106   ;; Non-immediate contstants in the constant pool
 107   (constant constant)
 108
 109   ;; NULL is in a register.
 110   (null immediate-constant)
 111
 112   ;; Anything else that can be an immediate.
 113   (immediate immediate-constant)
 114
 115
 116   ;; **** The stacks.
 117
 118   ;; The control stack.  (Scanned by GC)
 119   (control-stack control-stack)
 120
 121   ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER
 122   ;; is small and therefore the error trap information is smaller.
 123   ;; Moving them up here from their previous place down below saves
 124   ;; ~250K in core file size.  --njf, 2006-01-27
 125
 126   ;; Immediate descriptor objects.  Don't have to be seen by GC, but nothing
 127   ;; bad will happen if they are.  (fixnums, characters, header values, etc).
 128   (any-reg
 129    registers
 130    :locations #.(append non-descriptor-regs descriptor-regs)
 131    :constant-scs (immediate)
 132    :save-p t
 133    :alternate-scs (control-stack))
 134
 135   ;; Pointer descriptor objects.  Must be seen by GC.
 136   (descriptor-reg registers
 137    :locations #.descriptor-regs
 138    :constant-scs (constant null immediate)
 139    :save-p t
 140    :alternate-scs (control-stack))
 141
 142   ;; The non-descriptor stacks.
 143   (signed-stack non-descriptor-stack) ; (signed-byte 32)
 144   (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
 145   (character-stack non-descriptor-stack) ; non-descriptor characters.
 146   (sap-stack non-descriptor-stack) ; System area pointers.
 147   (single-stack non-descriptor-stack) ; single-floats
 148   (double-stack non-descriptor-stack
 149                 :element-size 2 :alignment 2) ; double floats.
 150   (complex-single-stack non-descriptor-stack :element-size 2)
 151   (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
 152
 153   ;; **** Things that can go in the integer registers.
 154
 155   ;; Non-Descriptor characters
 156   (character-reg registers
 157    :locations #.non-descriptor-regs
 158    :constant-scs (immediate)
 159    :save-p t
 160    :alternate-scs (character-stack))
 161
 162   ;; Non-Descriptor SAP's (arbitrary pointers into address space)
 163   (sap-reg registers
 164    :locations #.non-descriptor-regs
 165    :constant-scs (immediate)
 166    :save-p t
 167    :alternate-scs (sap-stack))
 168
 169   ;; Non-Descriptor (signed or unsigned) numbers.
 170   (signed-reg registers
 171    :locations #.non-descriptor-regs
 172    :constant-scs (immediate)
 173    :save-p t
 174    :alternate-scs (signed-stack))
 175   (unsigned-reg registers
 176    :locations #.non-descriptor-regs
 177    :constant-scs (immediate)
 178    :save-p t
 179    :alternate-scs (unsigned-stack))
 180
 181   ;; Random objects that must not be seen by GC.  Used only as temporaries.
 182   (non-descriptor-reg registers
 183    :locations #.non-descriptor-regs)
 184
 185   ;; Pointers to the interior of objects.  Used only as a temporary.
 186   (interior-reg registers
 187    :locations (#.lr-offset))
 188
 189   ;; **** Things that can go in the floating point registers.
 190
 191   ;; Non-Descriptor single-floats.
 192   (single-reg float-registers
 193    :locations #.(loop for i below 32 collect i)
 194    :constant-scs ()
 195    :save-p t
 196    :alternate-scs (single-stack))
 197
 198   ;; Non-Descriptor double-floats.
 199   (double-reg float-registers
 200    :locations #.(loop for i below 32 by 2 collect i)
 201    :element-size 2
 202    :constant-scs ()
 203    :save-p t
 204    :alternate-scs (double-stack))
 205
 206   (complex-single-reg float-registers
 207    :locations #.(loop for i from 0 below 32 by 2 collect i)
 208    :element-size 2
 209    :constant-scs ()
 210    :save-p t
 211    :alternate-scs (complex-single-stack))
 212
 213   (complex-double-reg float-registers
 214    :locations #.(loop for i from 0 below 32 by 4 collect i)
 215    :element-size 4
 216    :constant-scs ()
 217    :save-p t
 218    :alternate-scs (complex-double-stack))
 219
 220   ;; A catch or unwind block.
 221   (catch-block control-stack
 222                :element-size kludge-nondeterministic-catch-block-size))
 223 \f
 224 ;;;; Make some random tns for important registers.
 225
 226 (macrolet ((defregtn (name sc)
 227                (let ((offset-sym (symbolicate name "-OFFSET"))
 228                      (tn-sym (symbolicate name "-TN")))
 229                  `(defparameter ,tn-sym
 230                    (make-random-tn :kind :normal
 231                     :sc (sc-or-lose ',sc)
 232                     :offset ,offset-sym)))))
 233
 234   (defregtn null descriptor-reg)
 235   (defregtn code descriptor-reg)
 236
 237   (defregtn nargs any-reg)
 238   (defregtn ocfp any-reg)
 239   (defregtn csp any-reg)
 240   (defregtn cfp any-reg)
 241   (defregtn lr interior-reg)
 242   (defregtn pc any-reg))
 243 \f
 244 ;;; If VALUE can be represented as an immediate constant, then return the
 245 ;;; appropriate SC number, otherwise return NIL.
 246 (defun immediate-constant-sc (value)
 247   (typecase value
 248     (null
 249      (sc-number-or-lose 'null))
 250     ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
 251          character)
 252      (sc-number-or-lose 'immediate))
 253     (symbol
 254      (if (static-symbol-p value)
 255          (sc-number-or-lose 'immediate)
 256          nil))))
 257
 258 (defun boxed-immediate-sc-p (sc)
 259   (or (eql sc (sc-number-or-lose 'null))
 260       (eql sc (sc-number-or-lose 'immediate))))
 261 \f
 262 ;;;; function call parameters
 263
 264 ;;; the SC numbers for register and stack arguments/return values
 265 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
 266 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
 267 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
 268
 269 ;;; offsets of special stack frame locations
 270 (def!constant ocfp-save-offset 0)
 271 (def!constant lra-save-offset 1)
 272 (def!constant nfp-save-offset 2)
 273
 274 ;;; This is used by the debugger.
 275 ;;; < nyef> Ah, right. So, SINGLE-VALUE-RETURN-BYTE-OFFSET doesn't apply to x86oids or ARM.
 276 (def!constant single-value-return-byte-offset 0)
 277
 278
 279 ;;; A list of TN's describing the register arguments.
 280 ;;;
 281 (defparameter *register-arg-tns*
 282   (mapcar #'(lambda (n)
 283               (make-random-tn :kind :normal
 284                               :sc (sc-or-lose 'descriptor-reg)
 285                               :offset n))
 286           *register-arg-offsets*))
 287 \f
 288 ;;; This function is called by debug output routines that want a pretty name
 289 ;;; for a TN's location.  It returns a thing that can be printed with PRINC.
 290 (defun location-print-name (tn)
 291   (declare (type tn tn))
 292   (let ((sb (sb-name (sc-sb (tn-sc tn))))
 293         (offset (tn-offset tn)))
 294     (ecase sb
 295       (registers (or (svref *register-names* offset)
 296                      (format nil "R~D" offset)))
 297       (control-stack (format nil "CS~D" offset))
 298       (non-descriptor-stack (format nil "NS~D" offset))
 299       (constant (format nil "Const~D" offset))
 300       (immediate-constant "Immed")
 301       (float-registers (format nil "F~D" offset)))))
 302
 303 (defun combination-implementation-style (node)
 304   (declare (type sb!c::combination node) (ignore node))
 305   (values :default nil))
 306
 307 (defun primitive-type-indirect-cell-type (ptype)
 308   (declare (ignore ptype))
 309   nil)