src/compiler/backend.lisp

   1 ;;;; This file contains backend-specific data. The original intent, in
   2 ;;;; CMU CL, was to allow compilation using different backends, as a
   3 ;;;; way of mutating a running CMU CL into a hybrid system which could
   4 ;;;; emit code for a different architecture. In SBCL, this is not
   5 ;;;; needed, since we have a cross-compiler which runs as an ordinary
   6 ;;;; Lisp program under SBCL or other Lisps. However, it still seems
   7 ;;;; reasonable to have all backendish things here in a single file.
   8 ;;;;
   9 ;;;; FIXME: Perhaps someday the vmdef.lisp and/or meta-vmdef.lisp stuff can
  10 ;;;; merged into this file, and/or the metaness can go away or at least be
  11 ;;;; radically simplified.
  12
  13 ;;;; This software is part of the SBCL system. See the README file for
  14 ;;;; more information.
  15 ;;;;
  16 ;;;; This software is derived from the CMU CL system, which was
  17 ;;;; written at Carnegie Mellon University and released into the
  18 ;;;; public domain. The software is in the public domain and is
  19 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  20 ;;;; files for more information.
  21
  22 (in-package "SB!C")
  23 \f
  24 ;;;; miscellaneous backend properties
  25
  26 ;;; the number of references that a TN must have to offset the
  27 ;;; overhead of saving the TN across a call
  28 (defvar *backend-register-save-penalty* 0)
  29 (declaim (type index *backend-register-save-penalty*))
  30
  31 ;;; the byte order of the target machine. :BIG-ENDIAN has the MSB first (e.g.
  32 ;;; IBM RT), :LITTLE-ENDIAN has the MSB last (e.g. DEC VAX).
  33 ;;;
  34 ;;; KLUDGE: In a sort of pun, this is also used as the value of
  35 ;;; BACKEND-BYTE-FASL-FILE-IMPLEMENTATION. -- WHN 20000302
  36 (defvar *backend-byte-order* nil)
  37 (declaim (type (member nil :little-endian :big-endian) *backend-byte-order*))
  38
  39 ;;; translation from SC numbers to SC info structures. SC numbers are always
  40 ;;; used instead of names at run time, so changing this vector changes all the
  41 ;;; references.
  42 (defvar *backend-sc-numbers* (make-array sc-number-limit :initial-element nil))
  43 (declaim (type sc-vector *backend-sc-numbers*))
  44
  45 ;;; a list of all the SBs defined, so that we can easily iterate over them
  46 (defvar *backend-sb-list* ())
  47 (declaim (type list *backend-sb-list*))
  48
  49 ;;; translation from template names to template structures
  50 (defvar *backend-template-names* (make-hash-table :test 'eq))
  51 (declaim (type hash-table *backend-template-names*))
  52
  53 ;;; hashtables mapping from SC and SB names to the corresponding structures
  54 ;;;
  55 ;;; CMU CL comment:
  56 ;;;   The META versions are only used at meta-compile and load times,
  57 ;;;   so the defining macros can change these at meta-compile time
  58 ;;;   without breaking the compiler.
  59 ;;; FIXME: Couldn't the META versions go away in SBCL now that we don't
  60 ;;; have to worry about metacompiling and breaking the compiler?
  61 (defvar *backend-sc-names* (make-hash-table :test 'eq))
  62 (defvar *backend-sb-names* (make-hash-table :test 'eq))
  63 (defvar *backend-meta-sc-names* (make-hash-table :test 'eq))
  64 (defvar *backend-meta-sb-names* (make-hash-table :test 'eq))
  65 (declaim (type hash-table
  66                *backend-sc-names*
  67                *backend-sb-names*
  68                *backend-meta-sc-names*
  69                *backend-meta-sb-names*))
  70
  71
  72 ;;; like *SC-NUMBERS*, but updated at meta-compile time
  73 ;;;
  74 ;;; FIXME: As per *BACKEND-META-SC-NAMES* and *BACKEND-META-SB-NAMES*,
  75 ;;; couldn't we get rid of this in SBCL?
  76 (defvar *backend-meta-sc-numbers*
  77   (make-array sc-number-limit :initial-element nil))
  78 (declaim (type sc-vector *backend-meta-sc-numbers*))
  79
  80 ;;; translations from primitive type names to the corresponding
  81 ;;; primitive-type structure.
  82 (defvar *backend-primitive-type-names*
  83   (make-hash-table :test 'eq))
  84 (declaim (type hash-table *backend-primitive-type-names*))
  85
  86 ;;; This establishes a convenient handle on primitive type unions, or
  87 ;;; whatever. These names can only be used as the :ARG-TYPES or
  88 ;;; :RESULT-TYPES for VOPs and can map to anything else that can be
  89 ;;; used as :ARG-TYPES or :RESULT-TYPES (e.g. :OR, :CONSTANT).
  90 (defvar *backend-primitive-type-aliases* (make-hash-table :test 'eq))
  91 (declaim (type hash-table *backend-primitive-type-aliases*))
  92
  93 ;;; meta-compile time translation from names to primitive types
  94 ;;;
  95 ;;; FIXME: As per *BACKEND-META-SC-NAMES* and *BACKEND-META-SB-NAMES*,
  96 ;;; couldn't we get rid of this in SBCL?
  97 (defvar *backend-meta-primitive-type-names* (make-hash-table :test 'eq))
  98 (declaim (type hash-table *meta-primitive-type-names*))
  99
 100 ;;; The primitive type T is somewhat magical, in that it is the only
 101 ;;; primitive type that overlaps with other primitive types. An object
 102 ;;; of primitive-type T is in the canonical descriptor (boxed or pointer)
 103 ;;; representation.
 104 ;;;
 105 ;;; The T primitive-type is kept in this variable so that people who
 106 ;;; have to special-case it can get at it conveniently. This variable
 107 ;;; has to be set by the machine-specific VM definition, since the
 108 ;;; !DEF-PRIMITIVE-TYPE for T must specify the SCs that boxed objects
 109 ;;; can be allocated in.
 110 (defvar *backend-t-primitive-type*)
 111 (declaim (type primitive-type *backend-t-primitive-type*))
 112
 113 ;;; a hashtable translating from VOP names to the corresponding VOP-Parse
 114 ;;; structures. This information is only used at meta-compile time.
 115 (defvar *backend-parsed-vops* (make-hash-table :test 'eq))
 116 (declaim (type hash-table *backend-parsed-vops*))
 117
 118 ;;; the backend-specific aspects of the info environment
 119 (defvar *backend-info-environment* nil)
 120 (declaim (type list *backend-info-environment*))
 121
 122 ;;; support for the assembler
 123 (defvar *backend-instruction-formats* (make-hash-table :test 'eq))
 124 (defvar *backend-instruction-flavors* (make-hash-table :test 'equal))
 125 (defvar *backend-special-arg-types* (make-hash-table :test 'eq))
 126 (declaim (type hash-table
 127                *backend-instruction-formats*
 128                *backend-instruction-flavors*
 129                *backend-special-arg-types*))
 130
 131 ;;; mappings between CTYPE structures and the corresponding predicate.
 132 ;;; The type->predicate mapping is implemented as an alist because
 133 ;;; there is no such thing as a TYPE= hash table.
 134 (defvar *backend-predicate-types* (make-hash-table :test 'eq))
 135 (defvar *backend-type-predicates* nil)
 136 (declaim (type hash-table *backend-predicate-types*))
 137 (declaim (type list *backend-type-predicates*))
 138
 139 ;;; a vector of the internal errors defined for this backend, or NIL if
 140 ;;; they haven't been installed yet
 141 (defvar *backend-internal-errors* nil)
 142 (declaim (type (or simple-vector null) *backend-internal-errors*))
 143
 144 ;;; the maximum number of bytes per page on this system (used by GENESIS)
 145 (defvar *backend-page-size* 0)
 146 (declaim (type index *backend-page-size*))
 147 \f
 148 ;;;; VM support routines
 149
 150 ;;; FIXME: Do we need this kind of indirection for the VM support
 151 ;;; routines any more?
 152
 153 ;;; forward declaration
 154 (defvar *backend-support-routines*)
 155
 156 (macrolet ((def-vm-support-routines (&rest routines)
 157              `(progn
 158                 (eval-when (:compile-toplevel :load-toplevel :execute)
 159                   (defparameter *vm-support-routines* ',routines))
 160                 (defstruct (vm-support-routines (:copier nil))
 161                   ,@(mapcar #'(lambda (routine)
 162                                 `(,routine nil :type (or function null)))
 163                             routines))
 164                 ,@(mapcar
 165                    #'(lambda (name)
 166                        `(defun ,name (&rest args)
 167                           (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-"
 168                                                     name)
 169                                       *backend-support-routines*)
 170                                      (error "machine-specific support ~S ~
 171                                             routine undefined"
 172                                             ',name))
 173                                  args)))
 174                    routines))))
 175
 176   (def-vm-support-routines
 177
 178     ;; from vm.lisp
 179     immediate-constant-sc
 180     location-print-name
 181
 182     ;; from primtype.lisp
 183     primitive-type-of
 184     primitive-type
 185
 186     ;; from c-call.lisp
 187     make-call-out-tns
 188
 189     ;; from call.lisp
 190     standard-argument-location
 191     make-return-pc-passing-location
 192     make-old-fp-passing-location
 193     make-old-fp-save-location
 194     make-return-pc-save-location
 195     make-argument-count-location
 196     make-nfp-tn
 197     make-stack-pointer-tn
 198     make-number-stack-pointer-tn
 199     make-unknown-values-locations
 200     select-component-format
 201
 202     ;; from nlx.lisp
 203     make-nlx-sp-tn
 204     make-dynamic-state-tns
 205     make-nlx-entry-argument-start-location
 206
 207     ;; from support.lisp
 208     generate-call-sequence
 209     generate-return-sequence
 210
 211     ;; for use with scheduler
 212     emit-nop
 213     location-number))
 214
 215 (defprinter (vm-support-routines))
 216
 217 (defmacro !def-vm-support-routine (name ll &body body)
 218   (unless (member (intern (string name) (find-package "SB!C"))
 219                   *vm-support-routines*)
 220     (warn "unknown VM support routine: ~A" name))
 221   (let ((local-name (symbolicate "IMPL-OF-VM-SUPPORT-ROUTINE-" name)))
 222     `(progn
 223        (defun ,local-name ,ll ,@body)
 224        (setf (,(intern (concatenate 'simple-string
 225                                     "VM-SUPPORT-ROUTINES-"
 226                                     (string name))
 227                        (find-package "SB!C"))
 228               *backend-support-routines*)
 229              #',local-name))))
 230
 231 ;;; the VM support routines
 232 (defvar *backend-support-routines* (make-vm-support-routines))
 233 (declaim (type vm-support-routines *backend-support-routines*))