/[cmucl]/src/compiler/backend.lisp
ViewVC logotype

Contents of /src/compiler/backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.36 - (show annotations)
Wed Nov 10 19:51:24 2010 UTC (3 years, 5 months ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, cross-sol-x86-merged, cross-sol-x86-base, snapshot-2010-12, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, cross-sol-x86-branch
Changes since 1.35: +9 -2 lines
Add new slots to the backend to hold the foreign linkage space start
and entry size.  Not yet used anywhere.

This change needs a cross-compile; use boot-2010-11-1-cross.lisp as
the cross-compile script.

compiler/backend.lisp:
o Add the two new slots to the backend.

compiler/dump.lisp:
o DUMP-DATA-MAYBE-BYTE-SWAPPING needs to handle (unicode) strings
o DUMP-DATA-MAYBE-BYTE-SWAPPING should not swap bytes of a string.
  Genesis will make that happen.

code/exports.lisp:
o Export BACKEND-FOREIGN-LINKAGE-SPACE-START and
  BACKEND-FOREIGN-LINKAGE-ENTRY-SIZE.

bootfiles/20b/boot-2010-11-1-cross.lisp:
o Cross-compile script for this change.
1 ;;; -*- Package: C; Log: C.Log -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;;
7 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/compiler/backend.lisp,v 1.36 2010/11/10 19:51:24 rtoy Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; This file isolates all the backend specific data so that we can compile
13 ;;; and use different backends.
14 ;;;
15 ;;; Written by William Lott.
16 ;;;
17 (in-package "C")
18 (intl:textdomain "cmucl")
19
20 (export '(*backend* *target-backend* *native-backend* backend
21 backend-name backend-version backend-fasl-file-type
22 backend-fasl-file-implementation backend-fasl-file-version
23 backend-register-save-penalty backend-byte-order
24 backend-any-primitive-type backend-info-environment
25 backend-instruction-formats backend-instruction-flavors
26 backend-assembler-resources backend-special-arg-types
27 backend-disassem-params backend-internal-errors
28 backend-assembler-params backend-page-size
29 backend-foreign-linkage-space-start
30 backend-foreign-linkage-entry-size
31
32 ;; The various backends need to call these support routines
33 def-vm-support-routine make-stack-pointer-tn primitive-type
34 primitive-type-of emit-nop location-number))
35
36
37 ;;;; VM support routine stuff.
38
39 (eval-when (compile eval)
40
41 (defmacro def-vm-support-routines (&rest routines)
42 `(progn
43 (eval-when (compile load eval)
44 (defparameter vm-support-routines ',routines))
45 (defstruct (vm-support-routines
46 (:print-function %print-vm-support-routines))
47 ,@(mapcar #'(lambda (routine)
48 `(,routine nil :type (or function null)))
49 routines))
50 ,@(mapcar
51 #'(lambda (name)
52 `(defun ,name (&rest args)
53 (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-" name)
54 (backend-support-routines *backend*))
55 (error (intl:gettext "Machine specific support routine ~S ~
56 undefined for ~S")
57 ',name *backend*))
58 args)))
59 routines)))
60
61 ); eval-when
62
63 (def-vm-support-routines
64 ;; From VM.LISP
65 immediate-constant-sc
66 location-print-name
67
68 ;; From PRIMTYPE.LISP
69 primitive-type-of
70 primitive-type
71
72 ;; From C-CALL.LISP
73 make-call-out-tns
74
75 ;; From CALL.LISP
76 standard-argument-location
77 make-return-pc-passing-location
78 make-old-fp-passing-location
79 make-old-fp-save-location
80 make-return-pc-save-location
81 make-argument-count-location
82 make-nfp-tn
83 make-stack-pointer-tn
84 make-number-stack-pointer-tn
85 make-unknown-values-locations
86 select-component-format
87
88 ;; From NLX.LISP
89 make-nlx-sp-tn
90 make-dynamic-state-tns
91 make-nlx-entry-argument-start-location
92
93 ;; From SUPPORT.LISP
94 generate-call-sequence
95 generate-return-sequence
96
97 ;; For use with scheduler.
98 emit-nop
99 location-number)
100
101 (defprinter vm-support-routines)
102
103 (defmacro def-vm-support-routine (name ll &body body)
104 (unless (member (intern (string name) (find-package "C"))
105 vm-support-routines)
106 (warn (intl:gettext "Unknown VM support routine: ~A") name))
107 (let ((local-name (symbolicate (backend-name *target-backend*) "-" name)))
108 `(progn
109 (defun ,local-name ,ll ,@body)
110 (setf (,(intern (concatenate 'simple-string
111 "VM-SUPPORT-ROUTINES-"
112 (string name))
113 (find-package "C"))
114 (backend-support-routines *target-backend*))
115 #',local-name))))
116
117
118
119 ;;;; The backend structure.
120
121 (defstruct (backend
122 (:print-function %print-backend))
123 ;; The name of this backend. Something like ``PMAX''
124 (name nil)
125
126 ;; The version string for this backend.
127 ;; Something like ``DECstation 3100/Mach 0.0''
128 (version nil)
129
130 ;; Information about fasl files for this backend.
131 (fasl-file-type nil)
132 (fasl-file-implementation nil)
133 (fasl-file-version nil)
134
135 ;; The VM support routines.
136 (support-routines (make-vm-support-routines) :type vm-support-routines)
137
138 ;; The number of references that a TN must have to offset the overhead of
139 ;; saving the TN across a call.
140 (register-save-penalty 0)
141
142 ;; The byte order of the target machine. Should either be :big-endian
143 ;; which has the MSB first (RT) or :little-endian which has the MSB last
144 ;; (VAX).
145 (byte-order nil :type (or null (member :little-endian :big-endian)))
146
147 ;; Translates from SC numbers to SC info structures. SC numbers are always
148 ;; used instead of names at run time, so changing this vector changes all the
149 ;; references.
150 (sc-numbers (make-array sc-number-limit :initial-element nil)
151 :type sc-vector)
152
153 ;; A list of all the SBs defined, so that we can easily iterate over them.
154 (sb-list () :type list)
155
156 ;; Translates from template names to template structures.
157 (template-names (make-hash-table :test #'eq) :type hash-table)
158
159 ;; Hashtable from SC and SB names the corresponding structures. The META
160 ;; versions are only used at meta-compile and load times, so the defining
161 ;; macros can change these at meta-compile time without breaking the
162 ;; compiler.
163 (sc-names (make-hash-table :test #'eq) :type hash-table)
164 (sb-names (make-hash-table :test #'eq) :type hash-table)
165 (meta-sc-names (make-hash-table :test #'eq) :type hash-table)
166 (meta-sb-names (make-hash-table :test #'eq) :type hash-table)
167
168 ;; Like *SC-Numbers*, but is updated at meta-compile time.
169 (meta-sc-numbers (make-array sc-number-limit :initial-element nil)
170 :type sc-vector)
171
172 ;; Translates from primitive type names to the corresponding primitive-type
173 ;; structure.
174 (primitive-type-names (make-hash-table :test #'eq) :type hash-table)
175
176 ;; Establishes a convenient handle on primitive type unions, or whatever.
177 ;; These names can only be used as the :arg-types or :result-types for VOPs
178 ;; and can map to anything else that can be used as :arg-types or
179 ;; :result-types (e.g. :or, :constant).
180 (primitive-type-aliases (make-hash-table :test #'eq) :type hash-table)
181
182 ;; Meta-compile time translation from names to primitive types.
183 (meta-primitive-type-names (make-hash-table :test #'eq) :type hash-table)
184
185 ;; The primitive type T is somewhat magical, in that it is the only
186 ;; primitive type that overlaps with other primitive types. An object
187 ;; of primitive-type T is in the canonical descriptor (boxed or pointer)
188 ;; representation.
189 ;;
190 ;; We stick the T primitive-type in a variable so that people who have to
191 ;; special-case it can get at it conveniently. This is done by the machine
192 ;; specific VM definition, since the DEF-PRIMITIVE-TYPE for T must specify
193 ;; the SCs that boxed objects can be allocated in.
194 (any-primitive-type nil :type (or null primitive-type))
195
196 ;; Hashtable translating from VOP names to the corresponding VOP-Parse
197 ;; structures. This information is only used at meta-compile time.
198 (parsed-vops (make-hash-table :test #'eq) :type hash-table)
199
200 ;; The backend specific aspects of the info environment.
201 (info-environment nil :type list)
202
203 ;; Support for the assembler.
204 (instruction-formats (make-hash-table :test #'eq) :type hash-table)
205 (instruction-flavors (make-hash-table :test #'equal) :type hash-table)
206 (special-arg-types (make-hash-table :test #'eq) :type hash-table)
207 (assembler-resources nil :type list)
208
209 ;; The backend specific features list, if any. During a compilation,
210 ;; *features* is bound to *features* - misfeatures + features.
211 (%features nil :type list)
212 (misfeatures nil :type list)
213
214 ;; Disassembler information.
215 (disassem-params nil :type t)
216
217 ;; Mappings between CTYPE structures and the corresponding predicate.
218 ;; The type->predicate mapping hash is an alist because there is no
219 ;; such thing as a type= hash table.
220 (predicate-types (make-hash-table :test #'eq) :type hash-table)
221 (type-predicates nil :type list)
222
223 ;; Vector of the internal errors defined for this backend, or NIL if
224 ;; they haven't been installed yet.
225 (internal-errors nil :type (or simple-vector null))
226
227 ;; Assembler parameters.
228 (assembler-params nil :type t)
229
230 ;; The maximum number of bytes per page on this system. Used by genesis.
231 (page-size 0 :type index)
232
233 ;; The foreign linkage space start and size
234
235 (foreign-linkage-space-start 0 :type (unsigned-byte 32))
236 (foreign-linkage-entry-size 0 :type index))
237
238
239 (defprinter backend
240 name)
241
242
243 (defvar *native-backend* (make-backend)
244 "The backend for the machine we are running on. Do not change this.")
245 (defvar *target-backend* *native-backend*
246 "The backend we are attempting to compile.")
247 (defvar *backend* *native-backend*
248 "The backend we are using to compile with.")
249
250
251
252 ;;;; Other utility functions for fiddling with the backend.
253
254 (export '(backend-features target-featurep backend-featurep native-featurep))
255
256 (defun backend-features (backend)
257 "Compute the *FEATURES* list to use with BACKEND."
258 (union (backend-%features backend)
259 (set-difference *features*
260 (backend-misfeatures backend))))
261
262 (defun target-featurep (feature)
263 "Same as EXT:FEATUREP, except use the features found in *TARGET-BACKEND*."
264 (let ((*features* (backend-features *target-backend*)))
265 (featurep feature)))
266
267 (defun backend-featurep (feature)
268 "Same as EXT:FEATUREP, except use the features found in *BACKEND*."
269 (let ((*features* (backend-features *backend*)))
270 (featurep feature)))
271
272 (defun native-featurep (feature)
273 "Same as EXT:FEATUREP, except use the features found in *NATIVE-BACKEND*."
274 (let ((*features* (backend-features *native-backend*)))
275 (featurep feature)))
276
277
278 ;;; NEW-BACKEND
279 ;;;
280 ;;; Utility for creating a new backend structure for use with cross
281 ;;; compilers.
282 ;;;
283 (defun new-backend (name features misfeatures)
284 ;; If VM names a different package, rename that package so that VM doesn't
285 ;; name it.
286 (let ((pkg (find-package "VM")))
287 (when pkg
288 (let ((pkg-name (package-name pkg)))
289 (unless (string= pkg-name name)
290 (rename-package pkg pkg-name
291 (remove "VM" (package-nicknames pkg)
292 :test #'string=))
293 (unuse-package pkg "C")))))
294 ;; Make sure VM names our package, creating it if necessary.
295 (let* ((pkg (or (find-package name)
296 (make-package name :nicknames '("VM"))))
297 (nicknames (package-nicknames pkg)))
298 (unless (member "VM" nicknames :test #'string=)
299 (rename-package pkg name (cons "VM" nicknames)))
300 ;; And make sure we are using the necessary packages.
301 (use-package '("C-CALL" "ALIEN-INTERNALS" "ALIEN" "BIGNUM" "UNIX"
302 "LISP" "KERNEL" "EXTENSIONS" "SYSTEM" "C" "NEW-ASSEM")
303 pkg))
304 ;; Make sure the native info env list is stored in *native-backend*
305 (unless (backend-info-environment *native-backend*)
306 (setf (backend-info-environment *native-backend*) *info-environment*))
307 ;; Cons up a backend structure, filling in the info-env and features slots.
308 (let ((backend (make-backend
309 :name name
310 :info-environment
311 (cons (make-info-environment
312 :name
313 (concatenate 'string name " backend"))
314 (remove-if #'(lambda (name)
315 (let ((len (length name)))
316 (and (> len 8)
317 (string= name " backend"
318 :start1 (- len 8)))))
319 *info-environment*
320 :key #'info-env-name))
321 :%features features
322 :misfeatures misfeatures)))
323 (setf *target-backend* backend)
324 (define-standard-type-predicates)
325 backend))

  ViewVC Help
Powered by ViewVC 1.1.5