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