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.
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.
13 ;;;; This software is part of the SBCL system. See the README file for
14 ;;;; more information.
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.
24 ;;;; miscellaneous backend properties
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*))
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).
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*))
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
42 (defvar *backend-sc-numbers* (make-array sc-number-limit :initial-element nil))
43 (declaim (type sc-vector *backend-sc-numbers*))
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*))
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*))
53 ;;; hashtables mapping from SC and SB names to the corresponding structures
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
68 *backend-meta-sc-names*
69 *backend-meta-sb-names*))
72 ;;; like *SC-NUMBERS*, but updated at meta-compile time
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*))
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*))
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*))
93 ;;; meta-compile time translation from names to primitive types
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*))
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)
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*))
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*))
118 ;;; the backend-specific aspects of the info environment
119 (defvar *backend-info-environment* nil)
120 (declaim (type list *backend-info-environment*))
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*))
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*))
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*))
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*))
148 ;;;; VM support routines
150 ;;; FIXME: Do we need this kind of indirection for the VM support
151 ;;; routines any more?
153 ;;; forward declaration
154 (defvar *backend-support-routines*)
156 (macrolet ((def-vm-support-routines (&rest routines)
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)))
166 `(defun ,name (&rest args)
167 (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-"
169 *backend-support-routines*)
170 (error "machine-specific support ~S ~
176 (def-vm-support-routines
179 immediate-constant-sc
182 ;; from primtype.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
197 make-stack-pointer-tn
198 make-number-stack-pointer-tn
199 make-unknown-values-locations
200 select-component-format
204 make-dynamic-state-tns
205 make-nlx-entry-argument-start-location
208 generate-call-sequence
209 generate-return-sequence
211 ;; for use with scheduler
215 (defprinter (vm-support-routines))
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)))
223 (defun ,local-name ,ll ,@body)
224 (setf (,(intern (concatenate 'simple-string
225 "VM-SUPPORT-ROUTINES-"
227 (find-package "SB!C"))
228 *backend-support-routines*)
231 ;;; the VM support routines
232 (defvar *backend-support-routines* (make-vm-support-routines))
233 (declaim (type vm-support-routines *backend-support-routines*))