src/compiler/x86/vm.lisp

   1 ;;;; miscellaneous VM definition noise for the x86
   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 ;;; the size of an INTEGER representation of a SYSTEM-AREA-POINTER, i.e.
  15 ;;; size of a native memory address
  16 (deftype sap-int-type () '(unsigned-byte 32))
  17 ;;; FIXME: This should just named be SAP-INT, not SAP-INT-TYPE. And
  18 ;;; grep for SAPINT in the code and replace it with SAP-INT as
  19 ;;; appropriate.
  20 \f
  21 ;;;; register specs
  22
  23 (eval-when (:compile-toplevel :load-toplevel :execute)
  24   (defvar *byte-register-names* (make-array 8 :initial-element nil))
  25   (defvar *word-register-names* (make-array 16 :initial-element nil))
  26   (defvar *dword-register-names* (make-array 16 :initial-element nil))
  27   (defvar *float-register-names* (make-array 8 :initial-element nil)))
  28
  29 (macrolet ((defreg (name offset size)
  30              (let ((offset-sym (symbolicate name "-OFFSET"))
  31                    (names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
  32                `(progn
  33                   (defconstant ,offset-sym ,offset)
  34                   (setf (svref ,names-vector ,offset-sym)
  35                         ,(symbol-name name)))))
  36            ;; FIXME: It looks to me as though DEFREGSET should also
  37            ;; define the related *FOO-REGISTER-NAMES* variable.
  38            (defregset (name &rest regs)
  39              `(eval-when (:compile-toplevel :load-toplevel :execute)
  40                 (defparameter ,name
  41                   (list ,@(mapcar (lambda (name)
  42                                     (symbolicate name "-OFFSET"))
  43                                   regs))))))
  44
  45   ;; byte registers
  46   ;;
  47   ;; Note: the encoding here is different than that used by the chip.
  48   ;; We use this encoding so that the compiler thinks that AX (and
  49   ;; EAX) overlap AL and AH instead of AL and CL.
  50   (defreg al 0 :byte)
  51   (defreg ah 1 :byte)
  52   (defreg cl 2 :byte)
  53   (defreg ch 3 :byte)
  54   (defreg dl 4 :byte)
  55   (defreg dh 5 :byte)
  56   (defreg bl 6 :byte)
  57   (defreg bh 7 :byte)
  58   (defregset *byte-regs* al ah cl ch dl dh bl bh)
  59
  60   ;; word registers
  61   (defreg ax 0 :word)
  62   (defreg cx 2 :word)
  63   (defreg dx 4 :word)
  64   (defreg bx 6 :word)
  65   (defreg sp 8 :word)
  66   (defreg bp 10 :word)
  67   (defreg si 12 :word)
  68   (defreg di 14 :word)
  69   (defregset *word-regs* ax cx dx bx si di)
  70
  71   ;; double word registers
  72   (defreg eax 0 :dword)
  73   (defreg ecx 2 :dword)
  74   (defreg edx 4 :dword)
  75   (defreg ebx 6 :dword)
  76   (defreg esp 8 :dword)
  77   (defreg ebp 10 :dword)
  78   (defreg esi 12 :dword)
  79   (defreg edi 14 :dword)
  80   (defregset *dword-regs* eax ecx edx ebx esi edi)
  81
  82   ;; floating point registers
  83   (defreg fr0 0 :float)
  84   (defreg fr1 1 :float)
  85   (defreg fr2 2 :float)
  86   (defreg fr3 3 :float)
  87   (defreg fr4 4 :float)
  88   (defreg fr5 5 :float)
  89   (defreg fr6 6 :float)
  90   (defreg fr7 7 :float)
  91   (defregset *float-regs* fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
  92
  93   ;; registers used to pass arguments
  94   ;;
  95   ;; the number of arguments/return values passed in registers
  96   (defconstant  register-arg-count 3)
  97   ;; names and offsets for registers used to pass arguments
  98   (eval-when (:compile-toplevel :load-toplevel :execute)
  99     (defparameter *register-arg-names* '(edx edi esi)))
 100   (defregset    *register-arg-offsets* edx edi esi))
 101 \f
 102 ;;;; SB definitions
 103
 104 ;;; Despite the fact that there are only 8 different registers, we consider
 105 ;;; them 16 in order to describe the overlap of byte registers. The only
 106 ;;; thing we need to represent is what registers overlap. Therefore, we
 107 ;;; consider bytes to take one unit, and words or dwords to take two. We
 108 ;;; don't need to tell the difference between words and dwords, because
 109 ;;; you can't put two words in a dword register.
 110 (define-storage-base registers :finite :size 16)
 111
 112 ;;; jrd changed this from size 1 to size 8. It doesn't seem to make much
 113 ;;; sense to use the 387's idea of a stack; 8 separate registers is easier
 114 ;;; to deal with.
 115 ;;; the old way:
 116 ;;;   (define-storage-base float-registers :finite :size 1)
 117 ;;; the new way:
 118 (define-storage-base float-registers :finite :size 8)
 119
 120 (define-storage-base stack :unbounded :size 8)
 121 (define-storage-base constant :non-packed)
 122 (define-storage-base immediate-constant :non-packed)
 123 (define-storage-base noise :unbounded :size 2)
 124 \f
 125 ;;;; SC definitions
 126
 127 ;;; a handy macro so we don't have to keep changing all the numbers whenever
 128 ;;; we insert a new storage class
 129 ;;;
 130 ;;; FIXME: This macro is not needed in the runtime target.
 131 (defmacro define-storage-classes (&rest classes)
 132   (collect ((forms))
 133     (let ((index 0))
 134       (dolist (class classes)
 135         (let* ((sc-name (car class))
 136                (constant-name (symbolicate sc-name "-SC-NUMBER")))
 137           (forms `(define-storage-class ,sc-name ,index
 138                     ,@(cdr class)))
 139           (forms `(defconstant ,constant-name ,index))
 140           (forms `(let ((sb!int::*rogue-export* "DEFINE-STORAGE-CLASSES"))
 141                     (export ',constant-name)))
 142           (incf index))))
 143     `(progn
 144        ,@(forms))))
 145
 146 ;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size
 147 ;;; of CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until
 148 ;;; later in the build process, and the calculation is entangled with
 149 ;;; code which has lots of predependencies, including dependencies on
 150 ;;; the prior call of DEFINE-STORAGE-CLASS. The proper way to
 151 ;;; unscramble this would be to untangle the code, so that the code
 152 ;;; which calculates the size of CATCH-BLOCK can be separated from the
 153 ;;; other lots-of-dependencies code, so that the code which calculates
 154 ;;; the size of CATCH-BLOCK can be executed early, so that this value
 155 ;;; is known properly at this point in compilation. However, that
 156 ;;; would be a lot of editing of code that I (WHN 19990131) can't test
 157 ;;; until the project is complete. So instead, I set the correct value
 158 ;;; by hand here (a sort of nondeterministic guess of the right
 159 ;;; answer:-) and add an assertion later, after the value is
 160 ;;; calculated, that the original guess was correct.
 161 ;;;
 162 ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
 163 ;;; has my gratitude.) (FIXME: Maybe this should be me..)
 164 (defconstant sb!vm::kludge-nondeterministic-catch-block-size 6)
 165
 166 (define-storage-classes
 167
 168   ;; non-immediate contstants in the constant pool
 169   (constant constant)
 170
 171   ;; some FP constants can be generated in the i387 silicon
 172   (fp-constant immediate-constant)
 173
 174   (immediate immediate-constant)
 175
 176   ;;
 177   ;; the stacks
 178   ;;
 179
 180   ;; the control stack
 181   (control-stack stack)                 ; may be pointers, scanned by GC
 182
 183   ;; the non-descriptor stacks
 184   (signed-stack stack)                  ; (signed-byte 32)
 185   (unsigned-stack stack)                ; (unsigned-byte 32)
 186   (base-char-stack stack)               ; non-descriptor characters.
 187   (sap-stack stack)                     ; System area pointers.
 188   (single-stack stack)                  ; single-floats
 189   (double-stack stack :element-size 2)  ; double-floats.
 190   #!+long-float
 191   (long-stack stack :element-size 3)    ; long-floats.
 192   (complex-single-stack stack :element-size 2)  ; complex-single-floats
 193   (complex-double-stack stack :element-size 4)  ; complex-double-floats
 194   #!+long-float
 195   (complex-long-stack stack :element-size 6)    ; complex-long-floats
 196
 197   ;;
 198   ;; magic SCs
 199   ;;
 200
 201   (ignore-me noise)
 202
 203   ;;
 204   ;; things that can go in the integer registers
 205   ;;
 206
 207   ;; On the X86, we don't have to distinguish between descriptor and
 208   ;; non-descriptor registers, because of the conservative GC.
 209   ;; Therefore, we use different scs only to distinguish between
 210   ;; descriptor and non-descriptor values and to specify size.
 211
 212   ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
 213   ;; bad will happen if they are. (fixnums, characters, header values, etc).
 214   (any-reg registers
 215            :locations #.*dword-regs*
 216            :element-size 2
 217 ;          :reserve-locations (#.eax-offset)
 218            :constant-scs (immediate)
 219            :save-p t
 220            :alternate-scs (control-stack))
 221
 222   ;; pointer descriptor objects -- must be seen by GC
 223   (descriptor-reg registers
 224                   :locations #.*dword-regs*
 225                   :element-size 2
 226 ;                 :reserve-locations (#.eax-offset)
 227                   :constant-scs (constant immediate)
 228                   :save-p t
 229                   :alternate-scs (control-stack))
 230
 231   ;; non-descriptor characters
 232   (base-char-reg registers
 233                  :locations #.*byte-regs*
 234                  :reserve-locations (#.ah-offset #.al-offset)
 235                  :constant-scs (immediate)
 236                  :save-p t
 237                  :alternate-scs (base-char-stack))
 238
 239   ;; non-descriptor SAPs (arbitrary pointers into address space)
 240   (sap-reg registers
 241            :locations #.*dword-regs*
 242            :element-size 2
 243 ;          :reserve-locations (#.eax-offset)
 244            :constant-scs (immediate)
 245            :save-p t
 246            :alternate-scs (sap-stack))
 247
 248   ;; non-descriptor (signed or unsigned) numbers
 249   (signed-reg registers
 250               :locations #.*dword-regs*
 251               :element-size 2
 252 ;             :reserve-locations (#.eax-offset)
 253               :constant-scs (immediate)
 254               :save-p t
 255               :alternate-scs (signed-stack))
 256   (unsigned-reg registers
 257                 :locations #.*dword-regs*
 258                 :element-size 2
 259 ;               :reserve-locations (#.eax-offset)
 260                 :constant-scs (immediate)
 261                 :save-p t
 262                 :alternate-scs (unsigned-stack))
 263
 264   ;; miscellaneous objects that must not be seen by GC. Used only as
 265   ;; temporaries.
 266   (word-reg registers
 267             :locations #.*word-regs*
 268             :element-size 2
 269 ;           :reserve-locations (#.ax-offset)
 270             )
 271   (byte-reg registers
 272             :locations #.*byte-regs*
 273 ;           :reserve-locations (#.al-offset #.ah-offset)
 274             )
 275
 276   ;; that can go in the floating point registers
 277
 278   ;; non-descriptor SINGLE-FLOATs
 279   (single-reg float-registers
 280               :locations (0 1 2 3 4 5 6 7)
 281               :constant-scs (fp-constant)
 282               :save-p t
 283               :alternate-scs (single-stack))
 284
 285   ;; non-descriptor DOUBLE-FLOATs
 286   (double-reg float-registers
 287               :locations (0 1 2 3 4 5 6 7)
 288               :constant-scs (fp-constant)
 289               :save-p t
 290               :alternate-scs (double-stack))
 291
 292   ;; non-descriptor LONG-FLOATs
 293   #!+long-float
 294   (long-reg float-registers
 295             :locations (0 1 2 3 4 5 6 7)
 296             :constant-scs (fp-constant)
 297             :save-p t
 298             :alternate-scs (long-stack))
 299
 300   (complex-single-reg float-registers
 301                       :locations (0 2 4 6)
 302                       :element-size 2
 303                       :constant-scs ()
 304                       :save-p t
 305                       :alternate-scs (complex-single-stack))
 306
 307   (complex-double-reg float-registers
 308                       :locations (0 2 4 6)
 309                       :element-size 2
 310                       :constant-scs ()
 311                       :save-p t
 312                       :alternate-scs (complex-double-stack))
 313
 314   #!+long-float
 315   (complex-long-reg float-registers
 316                     :locations (0 2 4 6)
 317                     :element-size 2
 318                     :constant-scs ()
 319                     :save-p t
 320                     :alternate-scs (complex-long-stack))
 321
 322   ;; a catch or unwind block
 323   (catch-block stack
 324                :element-size sb!vm::kludge-nondeterministic-catch-block-size))
 325
 326 (eval-when (:compile-toplevel :load-toplevel :execute)
 327 (defparameter *byte-sc-names* '(base-char-reg byte-reg base-char-stack))
 328 (defparameter *word-sc-names* '(word-reg))
 329 (defparameter *dword-sc-names*
 330   '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
 331     signed-stack unsigned-stack sap-stack single-stack constant))
 332 ;;; added by jrd. I guess the right thing to do is to treat floats
 333 ;;; as a separate size...
 334 ;;;
 335 ;;; These are used to (at least) determine operand size.
 336 (defparameter *float-sc-names* '(single-reg))
 337 (defparameter *double-sc-names* '(double-reg double-stack))
 338 ) ; EVAL-WHEN
 339 \f
 340 ;;;; miscellaneous TNs for the various registers
 341
 342 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names)
 343              (collect ((forms))
 344                       (dolist (reg-name reg-names)
 345                         (let ((tn-name (symbolicate reg-name "-TN"))
 346                               (offset-name (symbolicate reg-name "-OFFSET")))
 347                           ;; FIXME: It'd be good to have the special
 348                           ;; variables here be named with the *FOO*
 349                           ;; convention.
 350                           (forms `(defparameter ,tn-name
 351                                     (make-random-tn :kind :normal
 352                                                     :sc (sc-or-lose ',sc-name)
 353                                                     :offset
 354                                                     ,offset-name)))))
 355                       `(progn ,@(forms)))))
 356
 357   (def-misc-reg-tns unsigned-reg eax ebx ecx edx ebp esp edi esi)
 358   (def-misc-reg-tns word-reg ax bx cx dx bp sp di si)
 359   (def-misc-reg-tns byte-reg al ah bl bh cl ch dl dh)
 360   (def-misc-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7))
 361
 362 ;;; TNs for registers used to pass arguments
 363 (defparameter *register-arg-tns*
 364   (mapcar (lambda (register-arg-name)
 365             (symbol-value (symbolicate register-arg-name "-TN")))
 366           *register-arg-names*))
 367
 368 ;;; FIXME: doesn't seem to be used in SBCL
 369 #|
 370 ;;; added by pw
 371 (defparameter fp-constant-tn
 372   (make-random-tn :kind :normal
 373                   :sc (sc-or-lose 'fp-constant)
 374                   :offset 31))          ; Offset doesn't get used.
 375 |#
 376 \f
 377 ;;; IMMEDIATE-CONSTANT-SC
 378 ;;;
 379 ;;; If value can be represented as an immediate constant, then return
 380 ;;; the appropriate SC number, otherwise return NIL.
 381 (def-vm-support-routine immediate-constant-sc (value)
 382   (typecase value
 383     ((or fixnum #-sb-xc-host system-area-pointer character)
 384      (sc-number-or-lose 'immediate))
 385     (symbol
 386      (when (static-symbol-p value)
 387        (sc-number-or-lose 'immediate)))
 388     (single-float
 389      (when (or (eql value 0f0) (eql value 1f0))
 390        (sc-number-or-lose 'fp-constant)))
 391     (double-float
 392      (when (or (eql value 0d0) (eql value 1d0))
 393        (sc-number-or-lose 'fp-constant)))
 394     #!+long-float
 395     (long-float
 396      (when (or (eql value 0l0) (eql value 1l0)
 397                (eql value pi)
 398                (eql value (log 10l0 2l0))
 399                (eql value (log 2.718281828459045235360287471352662L0 2l0))
 400                (eql value (log 2l0 10l0))
 401                (eql value (log 2l0 2.718281828459045235360287471352662L0)))
 402        (sc-number-or-lose 'fp-constant)))))
 403 \f
 404 ;;;; miscellaneous function call parameters
 405
 406 ;;; offsets of special stack frame locations
 407 (defconstant ocfp-save-offset 0)
 408 (defconstant return-pc-save-offset 1)
 409 (defconstant code-save-offset 2)
 410
 411 ;;; FIXME: This is a bad comment (changed since when?) and there are others
 412 ;;; like it in this file. It'd be nice to clarify them. Failing that deleting
 413 ;;; them or flagging them with KLUDGE might be better than nothing.
 414 ;;;
 415 ;;; names of these things seem to have changed. these aliases by jrd
 416 (defconstant lra-save-offset return-pc-save-offset)
 417
 418 (defconstant cfp-offset ebp-offset)     ; pfw - needed by stuff in /code
 419                                         ; related to signal context stuff
 420
 421 ;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
 422 ;;;
 423 ;;; This is used by the debugger.
 424 (defconstant single-value-return-byte-offset 2)
 425 \f
 426 ;;; This function is called by debug output routines that want a pretty name
 427 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
 428 (def-vm-support-routine location-print-name (tn)
 429   (declare (type tn tn))
 430   (let* ((sc (tn-sc tn))
 431          (sb (sb-name (sc-sb sc)))
 432          (offset (tn-offset tn)))
 433     (ecase sb
 434       (registers
 435        (let* ((sc-name (sc-name sc))
 436               (name-vec (cond ((member sc-name *byte-sc-names*)
 437                                *byte-register-names*)
 438                               ((member sc-name *word-sc-names*)
 439                                *word-register-names*)
 440                               ((member sc-name *dword-sc-names*)
 441                                *dword-register-names*))))
 442          (or (and name-vec
 443                   (< -1 offset (length name-vec))
 444                   (svref name-vec offset))
 445              ;; FIXME: Shouldn't this be an ERROR?
 446              (format nil "<unknown reg: off=~D, sc=~A>" offset sc-name))))
 447       (float-registers (format nil "FR~D" offset))
 448       (stack (format nil "S~D" offset))
 449       (constant (format nil "Const~D" offset))
 450       (immediate-constant "Immed")
 451       (noise (symbol-name (sc-name sc))))))
 452 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
 453 \f
 454 ;;; The loader uses this to convert alien names to the form they need in
 455 ;;; the symbol table (for example, prepending an underscore).
 456 (defun extern-alien-name (name)
 457   (declare (type simple-string name))
 458   name)