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 backend-info-environment
backend-instruction-formats backend-instruction-flavors
backend-special-arg-types
;; The various backends need to call these support routines
make-stack-pointer-tn primitive-type primitive-type-of))
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
(eval-when (compile eval load)
(defconstant vm-support-routines
'(;; From VM.LISP
immediate-constant-sc
location-print-name
;; From PRIMTYPE.LISP
primitive-type-of
primitive-type
;; From C-CALL.LISP
make-call-out-nsp-tn
make-call-out-argument-tns
make-call-out-result-tn
;; From CALL.LISP
standard-argument-location
make-return-pc-passing-location
make-old-fp-passing-location
make-old-fp-save-location
make-return-pc-save-location
make-argument-count-location
make-nfp-tn
make-stack-pointer-tn
make-number-stack-pointer-tn
make-unknown-values-locations
select-component-format
;; From NLX.LISP
make-nlx-sp-tn
make-dynamic-state-tns
;; From SUPPORT.LISP
generate-call-sequence
generate-return-sequence))
); eval-when
(unless (member (intern (string name) (find-package "C"))
vm-support-routines)
(let ((local-name (symbolicate (backend-name *target-backend*) "-" name)))
`(progn
(defun ,local-name ,ll ,@body)
(setf (,(intern (concatenate 'simple-string "BACKEND-" (string name))
(find-package "C"))
*target-backend*)
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
#',local-name))))
;;;; 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)
;; The backend specific aspects of the info environment.
(info-environment nil :type list)
;; Support for the assembler.
(instruction-formats (make-hash-table :test #'eq) :type hash-table)
(instruction-flavors (make-hash-table :test #'equal) :type hash-table)
(special-arg-types (make-hash-table :test #'eq) :type hash-table)
`(,slot nil :type (or null function)))
(sort (copy-list vm-support-routines)
#'string<
:key #'symbol-name)))
(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.")
;;;; Generate the stubs.
(macrolet
((frob ()
`(progn
,@(mapcar
#'(lambda (name)
`(defun ,name (&rest args)
(apply (or (,(symbolicate "BACKEND-" name) *backend*)
(error "Machine specific support routine ~S ~
undefined for ~S"
',name *backend*))
args)))
vm-support-routines))))
(frob))