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