|
|
1
|
;;; Cross-compile script to build a sparc core using x86 as the
|
|
|
2
|
;;; compiling system. This needs work!
|
|
|
3
|
|
|
|
4
|
(in-package :cl-user)
|
|
|
5
|
|
|
|
6
|
;;; Rename the X86 package and backend so that new-backend does the
|
|
|
7
|
;;; right thing.
|
|
|
8
|
(rename-package "X86" "OLD-X86" '("OLD-VM"))
|
|
|
9
|
(setf (c:backend-name c:*native-backend*) "OLD-X86")
|
|
|
10
|
|
|
|
11
|
(c::new-backend "SPARC"
|
|
|
12
|
;; Features to add here
|
|
|
13
|
'(:sparc
|
|
|
14
|
:sparc-v9 ; For Ultrasparc processors
|
|
|
15
|
:complex-fp-vops ; Some slightly faster FP vops on complex numbers
|
|
|
16
|
:linkage-table
|
|
|
17
|
:stack-checking ; Throw error if we run out of stack
|
|
|
18
|
:heap-overflow-check ; Throw error if we run out of
|
|
|
19
|
; heap (This requires gencgc!)
|
|
|
20
|
:gencgc ; Generational GC
|
|
|
21
|
:relative-package-names ; Relative package names from Allegro
|
|
|
22
|
:conservative-float-type
|
|
|
23
|
:hash-new
|
|
|
24
|
:random-mt19937 ; MT-19937 generator
|
|
|
25
|
:cmu ; Announce this is CMUCL
|
|
|
26
|
:cmu20 :cmu20b ; Current version identifier
|
|
|
27
|
:modular-arith ; Modular arithmetic
|
|
|
28
|
:double-double ; Double-double float support
|
|
|
29
|
:executable
|
|
|
30
|
|
|
|
31
|
:solaris
|
|
|
32
|
:svr4
|
|
|
33
|
:sun4
|
|
|
34
|
:sunos
|
|
|
35
|
:unix
|
|
|
36
|
)
|
|
|
37
|
;; Features to remove from current *features* here
|
|
|
38
|
'(:sparc-v8 :sparc-v7 ; Choose only one of :sparc-v7, :sparc-v8, :sparc-v9
|
|
|
39
|
;; Other architectures we aren't using. Particularly important
|
|
|
40
|
;; to get rid of sse2 and x87 so we don't accidentally try to
|
|
|
41
|
;; compile the x87/sse2 float support on sparc, which won't work.
|
|
|
42
|
:x86 :x86-bootstrap :sse2 :x87 :i486
|
|
|
43
|
:alpha :osf1 :mips
|
|
|
44
|
;; Really old stuff that should have been removed long ago.
|
|
|
45
|
:propagate-fun-type :propagate-float-type :constrain-float-type
|
|
|
46
|
;; Other OSes were not using
|
|
|
47
|
:openbsd :freebsd :glibc2 :linux :mach-o :darwin :bsd
|
|
|
48
|
|
|
|
49
|
:pentium
|
|
|
50
|
:long-float
|
|
|
51
|
:new-random
|
|
|
52
|
:small
|
|
|
53
|
:mp))
|
|
|
54
|
|
|
|
55
|
;;; Changes needed to bootstrap cross-compiling from x86 to sparc
|
|
|
56
|
|
|
|
57
|
;; Set up the linkage space stuff appropriately for sparc.
|
|
|
58
|
(setf (c::backend-foreign-linkage-space-start c::*target-backend*)
|
|
|
59
|
#x0f800000
|
|
|
60
|
(c::backend-foreign-linkage-entry-size c::*target-backend*)
|
|
|
61
|
16)
|
|
|
62
|
|
|
|
63
|
;; Get new fops so we can process fasls with big-endian unicode
|
|
|
64
|
;; strings on our little-endian compiling system.
|
|
|
65
|
#+unicode
|
|
|
66
|
(load "target:tools/cross-scripts/cross-unicode-big-endian.lisp")
|
|
|
67
|
|
|
|
68
|
;;; End changes needed to bootstrap cross-compiling from x86 to sparc
|
|
|
69
|
|
|
|
70
|
;;; Extern-alien-name for the new backend.
|
|
|
71
|
(in-package :vm)
|
|
|
72
|
(defun extern-alien-name (name)
|
|
|
73
|
(declare (type simple-string name))
|
|
|
74
|
;;(format t "extern-alien-name: ~S~%" name)
|
|
|
75
|
;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name))
|
|
|
76
|
name)
|
|
|
77
|
(export 'extern-alien-name)
|
|
|
78
|
#+(or)
|
|
|
79
|
(defun fixup-code-object (code offset fixup kind)
|
|
|
80
|
(declare (type index offset))
|
|
|
81
|
(unless (zerop (rem offset vm::word-bytes))
|
|
|
82
|
(error (intl:gettext "Unaligned instruction? offset=#x~X.") offset))
|
|
|
83
|
(system:without-gcing
|
|
|
84
|
(let ((sap (truly-the system-area-pointer
|
|
|
85
|
(%primitive c::code-instructions code))))
|
|
|
86
|
(ecase kind
|
|
|
87
|
(:call
|
|
|
88
|
(error (intl:gettext "Can't deal with CALL fixups, yet.")))
|
|
|
89
|
(:sethi
|
|
|
90
|
(setf (ldb (byte 22 0) (sap-ref-32 sap offset))
|
|
|
91
|
(ldb (byte 22 10) fixup)))
|
|
|
92
|
(:add
|
|
|
93
|
(setf (ldb (byte 10 0) (sap-ref-32 sap offset))
|
|
|
94
|
(ldb (byte 10 0) fixup)))))))
|
|
|
95
|
(export 'fixup-code-object)
|
|
|
96
|
#+(or)
|
|
|
97
|
(defun sanctify-for-execution (component)
|
|
|
98
|
(without-gcing
|
|
|
99
|
(alien-funcall (extern-alien "os_flush_icache"
|
|
|
100
|
(function void
|
|
|
101
|
system-area-pointer
|
|
|
102
|
unsigned-long))
|
|
|
103
|
(code-instructions component)
|
|
|
104
|
(* (code-header-ref component code-code-size-slot)
|
|
|
105
|
word-bytes)))
|
|
|
106
|
nil)
|
|
|
107
|
(export 'sanctify-for-execution)
|
|
|
108
|
|
|
|
109
|
;;; Compile the new backend.
|
|
|
110
|
(pushnew :bootstrap *features*)
|
|
|
111
|
(pushnew :building-cross-compiler *features*)
|
|
|
112
|
(load "target:tools/comcom")
|
|
|
113
|
|
|
|
114
|
;;; Load the new backend.
|
|
|
115
|
(setf (search-list "c:")
|
|
|
116
|
'("target:compiler/"))
|
|
|
117
|
(setf (search-list "vm:")
|
|
|
118
|
'("c:sparc/" "c:generic/"))
|
|
|
119
|
(setf (search-list "assem:")
|
|
|
120
|
'("target:assembly/" "target:assembly/sparc/"))
|
|
|
121
|
|
|
|
122
|
;; Load the backend of the compiler.
|
|
|
123
|
|
|
|
124
|
(in-package "C")
|
|
|
125
|
|
|
|
126
|
(load "vm:vm-macs")
|
|
|
127
|
(load "vm:parms")
|
|
|
128
|
(load "vm:objdef")
|
|
|
129
|
(load "vm:interr")
|
|
|
130
|
(load "assem:support")
|
|
|
131
|
|
|
|
132
|
(load "target:compiler/srctran")
|
|
|
133
|
(load "vm:vm-typetran")
|
|
|
134
|
(load "target:compiler/float-tran")
|
|
|
135
|
(load "target:compiler/saptran")
|
|
|
136
|
|
|
|
137
|
(load "vm:macros")
|
|
|
138
|
(load "vm:utils")
|
|
|
139
|
|
|
|
140
|
(load "vm:vm")
|
|
|
141
|
(load "vm:insts")
|
|
|
142
|
(load "vm:primtype")
|
|
|
143
|
(load "vm:move")
|
|
|
144
|
(load "vm:sap")
|
|
|
145
|
(load "vm:system")
|
|
|
146
|
(load "vm:char")
|
|
|
147
|
(load "vm:float")
|
|
|
148
|
|
|
|
149
|
(load "vm:memory")
|
|
|
150
|
(load "vm:static-fn")
|
|
|
151
|
(load "vm:arith")
|
|
|
152
|
(load "vm:cell")
|
|
|
153
|
(load "vm:subprim")
|
|
|
154
|
(load "vm:debug")
|
|
|
155
|
(load "vm:c-call")
|
|
|
156
|
(load "vm:print")
|
|
|
157
|
(load "vm:alloc")
|
|
|
158
|
(load "vm:call")
|
|
|
159
|
(load "vm:nlx")
|
|
|
160
|
(load "vm:values")
|
|
|
161
|
(load "vm:array")
|
|
|
162
|
(load "vm:pred")
|
|
|
163
|
(load "vm:type-vops")
|
|
|
164
|
|
|
|
165
|
(load "assem:assem-rtns")
|
|
|
166
|
|
|
|
167
|
(load "assem:array")
|
|
|
168
|
(load "assem:arith")
|
|
|
169
|
(load "assem:alloc")
|
|
|
170
|
|
|
|
171
|
(load "c:pseudo-vops")
|
|
|
172
|
|
|
|
173
|
(check-move-function-consistency)
|
|
|
174
|
|
|
|
175
|
(load "vm:new-genesis")
|
|
|
176
|
|
|
|
177
|
;;; OK, the cross compiler backend is loaded.
|
|
|
178
|
|
|
|
179
|
(setf *features* (remove :building-cross-compiler *features*))
|
|
|
180
|
|
|
|
181
|
;;; Info environment hacks.
|
|
|
182
|
(macrolet ((frob (&rest syms)
|
|
|
183
|
`(progn ,@(mapcar #'(lambda (sym)
|
|
|
184
|
`(defconstant ,sym
|
|
|
185
|
(symbol-value
|
|
|
186
|
(find-symbol ,(symbol-name sym)
|
|
|
187
|
:vm))))
|
|
|
188
|
syms))))
|
|
|
189
|
(frob OLD-VM:BYTE-BITS
|
|
|
190
|
OLD-VM:WORD-BITS
|
|
|
191
|
OLD-VM:CHAR-BITS
|
|
|
192
|
OLD-VM:CHAR-BYTES
|
|
|
193
|
OLD-VM:LOWTAG-BITS
|
|
|
194
|
#+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE
|
|
|
195
|
OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE
|
|
|
196
|
OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
|
|
|
197
|
#+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE
|
|
|
198
|
OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE
|
|
|
199
|
OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
|
|
|
200
|
OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE
|
|
|
201
|
OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
|
|
|
202
|
OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE
|
|
|
203
|
OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE
|
|
|
204
|
OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE
|
|
|
205
|
OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE
|
|
|
206
|
OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
|
|
|
207
|
OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE
|
|
|
208
|
OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
|
|
|
209
|
OLD-VM:SIMPLE-BIT-VECTOR-TYPE
|
|
|
210
|
OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE
|
|
|
211
|
OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET
|
|
|
212
|
OLD-VM:DOUBLE-FLOAT-DIGITS
|
|
|
213
|
old-vm:single-float-digits
|
|
|
214
|
OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE
|
|
|
215
|
OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX
|
|
|
216
|
OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE
|
|
|
217
|
OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE
|
|
|
218
|
OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX
|
|
|
219
|
OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE
|
|
|
220
|
)
|
|
|
221
|
#+double-double
|
|
|
222
|
(frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE
|
|
|
223
|
OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE)
|
|
|
224
|
)
|
|
|
225
|
|
|
|
226
|
(let ((function (symbol-function 'kernel:error-number-or-lose)))
|
|
|
227
|
(let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
|
|
|
228
|
(setf (symbol-function 'kernel:error-number-or-lose) function)
|
|
|
229
|
(setf (info function kind 'kernel:error-number-or-lose) :function)
|
|
|
230
|
(setf (info function where-from 'kernel:error-number-or-lose) :defined)))
|
|
|
231
|
|
|
|
232
|
(defun fix-class (name)
|
|
|
233
|
(let* ((new-value (find-class name))
|
|
|
234
|
(new-layout (kernel::%class-layout new-value))
|
|
|
235
|
(new-cell (kernel::find-class-cell name))
|
|
|
236
|
(*info-environment* (c:backend-info-environment c:*target-backend*)))
|
|
|
237
|
(remhash name kernel::*forward-referenced-layouts*)
|
|
|
238
|
(kernel::%note-type-defined name)
|
|
|
239
|
(setf (info type kind name) :instance)
|
|
|
240
|
(setf (info type class name) new-cell)
|
|
|
241
|
(setf (info type compiler-layout name) new-layout)
|
|
|
242
|
new-value))
|
|
|
243
|
(fix-class 'c::vop-parse)
|
|
|
244
|
(fix-class 'c::operand-parse)
|
|
|
245
|
|
|
|
246
|
#+random-mt19937
|
|
|
247
|
(declaim (notinline kernel:random-chunk))
|
|
|
248
|
|
|
|
249
|
(setf c:*backend* c:*target-backend*)
|
|
|
250
|
|
|
|
251
|
;;; Extern-alien-name for the new backend.
|
|
|
252
|
(in-package :vm)
|
|
|
253
|
(defun extern-alien-name (name)
|
|
|
254
|
(declare (type simple-string name))
|
|
|
255
|
;;(format t "extern-alien-name: ~S~%" name)
|
|
|
256
|
;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name))
|
|
|
257
|
name)
|
|
|
258
|
(export 'extern-alien-name)
|
|
|
259
|
#+(or)
|
|
|
260
|
(defun fixup-code-object (code offset fixup kind)
|
|
|
261
|
(declare (type index offset))
|
|
|
262
|
(unless (zerop (rem offset vm::word-bytes))
|
|
|
263
|
(error (intl:gettext "Unaligned instruction? offset=#x~X.") offset))
|
|
|
264
|
(system:without-gcing
|
|
|
265
|
(let ((sap (truly-the system-area-pointer
|
|
|
266
|
(%primitive c::code-instructions code))))
|
|
|
267
|
(ecase kind
|
|
|
268
|
(:call
|
|
|
269
|
(error (intl:gettext "Can't deal with CALL fixups, yet.")))
|
|
|
270
|
(:sethi
|
|
|
271
|
(setf (ldb (byte 22 0) (sap-ref-32 sap offset))
|
|
|
272
|
(ldb (byte 22 10) fixup)))
|
|
|
273
|
(:add
|
|
|
274
|
(setf (ldb (byte 10 0) (sap-ref-32 sap offset))
|
|
|
275
|
(ldb (byte 10 0) fixup)))))))
|
|
|
276
|
(export 'fixup-code-object)
|
|
|
277
|
#+(or)
|
|
|
278
|
(defun sanctify-for-execution (component)
|
|
|
279
|
(without-gcing
|
|
|
280
|
(alien-funcall (extern-alien "os_flush_icache"
|
|
|
281
|
(function void
|
|
|
282
|
system-area-pointer
|
|
|
283
|
unsigned-long))
|
|
|
284
|
(code-instructions component)
|
|
|
285
|
(* (code-header-ref component code-code-size-slot)
|
|
|
286
|
word-bytes)))
|
|
|
287
|
nil)
|
|
|
288
|
(export 'sanctify-for-execution)
|
|
|
289
|
|
|
|
290
|
(in-package :cl-user)
|
|
|
291
|
|
|
|
292
|
;;; Don't load compiler parts from the target compilation
|
|
|
293
|
|
|
|
294
|
(defparameter *load-stuff* nil)
|
|
|
295
|
|
|
|
296
|
;; hack, hack, hack: Make old-x86::any-reg the same as
|
|
|
297
|
;; x86::any-reg as an SC. Do this by adding old-x86::any-reg
|
|
|
298
|
;; to the hash table with the same value as x86::any-reg.
|
|
|
299
|
|
|
|
300
|
(let ((ht (c::backend-sc-names c::*target-backend*)))
|
|
|
301
|
(setf (gethash 'old-vm::any-reg ht)
|
|
|
302
|
(gethash 'vm::any-reg ht)))
|
|
|
303
|
|
|
|
304
|
|
|
|
305
|
;;(pushnew :debug *features*)
|