Newer
Older
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; This file isolates all the backend specific data so that we can compile
;;; and use different backends.
;;;
;;; Written by William Lott.
;;;
(in-package "C")
(export '(def-vm-support-routine *backend* *target-backend* *native-backend*
backend-name backend-version backend-fasl-file-type
backend-fasl-file-implementation backend-fasl-file-version
backend-register-save-penalty backend-byte-order
backend-any-primitive-type
;; The various backends need to call these support routines
make-stack-pointer-tn primitive-type primitive-type-of))
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
;;;; VM support routine stuff.
(eval-when (compile load eval)
(defvar *vm-support-routines* nil))
(defmacro def-vm-support-routine (name ll &body body)
(unless (member (string name) *vm-support-routines*
:test #'string=)
(warn "Unknown VM support routine: ~A" name))
(let ((local-name (symbolicate (backend-name *backend*) "-" name)))
`(progn
(defun ,local-name ,ll ,@body)
(setf (,(intern (concatenate 'simple-string "BACKEND-" (string name))
(symbol-package 'foo))
*backend*)
#',local-name))))
(eval-when (compile eval)
(defmacro def-vm-support-routine-stub (name)
`(progn
#-bootstrap-backend
(defun ,name (&rest args)
(apply (or (,(symbolicate "BACKEND-" name) *backend*)
(error "Machine specific support routine ~S undefined for ~S"
',name *backend*))
args))
(eval-when (compile load eval)
(pushnew ,(string name) *vm-support-routines*
:test #'string=))))
); eval-when (compile eval)
;;; From VM.LISP
(def-vm-support-routine-stub immediate-constant-sc)
(def-vm-support-routine-stub location-print-name)
;;; From PRIMTYPE.LISP
(def-vm-support-routine-stub primitive-type-of)
(def-vm-support-routine-stub primitive-type)
;;; From C-CALL.LISP
(def-vm-support-routine-stub make-call-out-nsp-tn)
(def-vm-support-routine-stub make-call-out-argument-tns)
(def-vm-support-routine-stub make-call-out-result-tn)
;;; From CALL.LISP
(def-vm-support-routine-stub standard-argument-location)
(def-vm-support-routine-stub make-return-pc-passing-location)
(def-vm-support-routine-stub make-old-fp-passing-location)
(def-vm-support-routine-stub make-old-fp-save-location)
(def-vm-support-routine-stub make-return-pc-save-location)
(def-vm-support-routine-stub make-argument-count-location)
(def-vm-support-routine-stub make-nfp-tn)
(def-vm-support-routine-stub make-stack-pointer-tn)
(def-vm-support-routine-stub make-number-stack-pointer-tn)
(def-vm-support-routine-stub make-unknown-values-locations)
(def-vm-support-routine-stub select-component-format)
;;; From NLX.LISP
(def-vm-support-routine-stub make-nlx-sp-tn)
(def-vm-support-routine-stub make-dynamic-state-tns)
;;; From SUPPORT.LISP
(def-vm-support-routine-stub generate-call-sequence)
(def-vm-support-routine-stub generate-return-sequence)
;;;; The actual backend structure.
(defstruct (backend
(:print-function %print-backend))
;; The name of this backend. Something like ``PMAX''
(name nil)
;; The version string for this backend.
;; Something like ``DECstation 3100/Mach 0.0''
(version nil)
;; Information about fasl files for this backend.
(fasl-file-type nil)
(fasl-file-implementation nil)
(fasl-file-version nil)
;; The number of references that a TN must have to offset the overhead of
;; saving the TN across a call.
(register-save-penalty 0)
;; The byte order of the target machine. Should either be :big-endian
;; which has the MSB first (RT) or :little-endian which has the MSB last
;; (VAX).
(byte-order nil :type (or null (member :little-endian :big-endian)))
;; Translates from SC numbers to SC info structures. SC numbers are always
;; used instead of names at run time, so changing this vector changes all the
;; references.
(sc-numbers (make-array sc-number-limit) :type sc-vector)
;; A list of all the SBs defined, so that we can easily iterate over them.
(sb-list () :type list)
;; Translates from template names to template structures.
(template-names (make-hash-table :test #'eq) :type hash-table)
;; Hashtable from SC and SB names the corresponding structures. The META
;; versions are only used at meta-compile and load times, so the defining
;; macros can change these at meta-compile time without breaking the
;; compiler.
(sc-names (make-hash-table :test #'eq) :type hash-table)
(sb-names (make-hash-table :test #'eq) :type hash-table)
(meta-sc-names (make-hash-table :test #'eq) :type hash-table)
(meta-sb-names (make-hash-table :test #'eq) :type hash-table)
;; Like *SC-Numbers*, but is updated at meta-compile time.
(meta-sc-numbers (make-array sc-number-limit) :type sc-vector)
;; Translates from primitive type names to the corresponding primitive-type
;; structure.
(primitive-type-names (make-hash-table :test #'eq) :type hash-table)
;; Establishes a convenient handle on primitive type unions, or whatever.
;; These names can only be used as the :arg-types or :result-types for VOPs
;; and can map to anything else that can be used as :arg-types or
;; :result-types (e.g. :or, :constant).
(primitive-type-aliases (make-hash-table :test #'eq) :type hash-table)
;; Meta-compile time translation from names to primitive types.
(meta-primitive-type-names (make-hash-table :test #'eq) :type hash-table)
;; The primitive type T is somewhat magical, in that it is the only
;; primitive type that overlaps with other primitive types. An object
;; of primitive-type T is in the canonical descriptor (boxed or pointer)
;; representation.
;;
;; We stick the T primitive-type in a variable so that people who have to
;; special-case it can get at it conveniently. This is done by the machine
;; specific VM definition, since the DEF-PRIMITIVE-TYPE for T must specify
;; the SCs that boxed objects can be allocated in.
(any-primitive-type nil :type (or null primitive-type))
;; Hashtable translating from VOP names to the corresponding VOP-Parse
;; structures. This information is only used at meta-compile time.
(parsed-vops (make-hash-table :test #'eq) :type hash-table)
. #.(mapcar #'(lambda (slot)
`(,(intern slot) nil :type (or null function)))
(sort (copy-list *vm-support-routines*) #'string<)))
(defprinter backend
name)
(defvar *native-backend* (make-backend)
"The backend for the machine we are running on. Do not change this.")
(defvar *target-backend* *native-backend*
"The backend we are attempting to compile.")
(defvar *backend* *native-backend*
"The backend we are using to compile.")