/[cmucl]/src/bootfiles/19e/boot-2008-05-cross-unicode-ppc.lisp
ViewVC logotype

Contents of /src/bootfiles/19e/boot-2008-05-cross-unicode-ppc.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Jun 11 16:03:56 2009 UTC (4 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, cross-sol-x86-base, sparc-tramp-assem-base, post-merge-intl-branch, snapshot-2010-12, snapshot-2010-11, cross-sol-x86-merged, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, intl-2-branch-base, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, release-20a-pre1, snapshot-2009-11, snapshot-2010-06, pre-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, intl-branch-working-2010-02-11-1000, portable-clx-import-2009-06-16, release-20b-pre1, release-20b-pre2, merged-unicode-utf16-extfmt-2009-06-11, unicode-string-buffer-base, cross-sparc-branch-base, intl-branch-base, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, sparc-tramp-assem-2010-07-19, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, portable-clx-base, snapshot-2010-08, snapshot-2009-08, release-20a-base, snapshot-2009-07, RELEASE_20b, RELEASE_20a, cross-sol-x86-2010-12-20, amd64-dd-start, intl-branch-2010-03-18-1300, snapshot-2009-12, HEAD
Branch point for: RELEASE-20A-BRANCH, portable-clx-branch, unicode-string-buffer-branch, cross-sol-x86-branch, cross-sparc-branch, sparc-tramp-assem-branch, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-2-branch, RELEASE-20B-BRANCH, intl-branch
Changes since 1.1: +227 -0 lines
Merge Unicode work to trunk.  From label
unicode-utf16-extfmt-2009-06-11.
1 ;;; Cross-compile script to add 16-bit strings for Unicode support.
2 ;;; Use as the cross-compile script for cross-build-world.sh.
3
4 (in-package :cl-user)
5
6 ;;; Rename the PPC package and backend so that new-backend does the
7 ;;; right thing.
8 (rename-package "PPC" "OLD-PPC" '("OLD-VM"))
9 (setf (c:backend-name c:*native-backend*) "OLD-PPC")
10
11 (c::new-backend "PPC"
12 ;; Features to add here
13 '(:ppc
14 :new-assembler
15 :conservative-float-type
16 :hash-new
17 :random-mt19937
18 :darwin :bsd
19 :cmu :cmu19 :cmu19e
20 :relative-package-names ; Relative package names from Allegro
21 :linkage-table
22 :modular-arith ; Modular arithmetic
23 :double-double ; Double-double floats
24 :gencgc ; Generational GC
25 )
26 ;; Features to remove from current *features* here
27 '(:x86-bootstrap :alpha :osf1 :mips :x86 :i486 :pentium :ppro
28 :propagate-fun-type :propagate-float-type :constrain-float-type
29 :openbsd :freebsd :glibc2 :linux :pentium :elf :mp
30 :stack-checking :heap-overflow-check
31 :cgc :long-float :new-random :small))
32
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 ;;; Things needed to cross-compile unicode changes.
35
36 (load "target:bootfiles/19e/boot-2008-05-cross-unicode-common.lisp")
37
38
39 ;; End changes for unicode
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41
42 ;;; Extern-alien-name for the new backend.
43 (in-package :vm)
44 (defun extern-alien-name (name)
45 (declare (type simple-string name))
46 (concatenate 'string "_" name))
47 (export 'extern-alien-name)
48 (export 'fixup-code-object)
49 (export 'sanctify-for-execution)
50
51 ;;; Compile the new backend.
52 (pushnew :bootstrap *features*)
53 (pushnew :building-cross-compiler *features*)
54 (load "target:tools/comcom")
55
56 ;;; Load the new backend.
57 (setf (search-list "c:")
58 '("target:compiler/"))
59 (setf (search-list "vm:")
60 '("c:ppc/" "c:generic/"))
61 (setf (search-list "assem:")
62 '("target:assembly/" "target:assembly/ppc/"))
63
64 ;; Load the backend of the compiler.
65
66 (in-package "C")
67
68 (load "vm:vm-macs")
69 (load "vm:parms")
70 (load "vm:objdef")
71 (load "vm:interr")
72 (load "assem:support")
73
74 (load "target:compiler/srctran")
75 (load "vm:vm-typetran")
76 (load "target:compiler/float-tran")
77 (load "target:compiler/saptran")
78
79 (load "vm:macros")
80 (load "vm:utils")
81
82 (load "vm:vm")
83 (load "vm:insts")
84 (load "vm:primtype")
85 (load "vm:move")
86 (load "vm:sap")
87 (load "vm:system")
88 (load "vm:char")
89 (load "vm:float")
90
91 (load "vm:memory")
92 (load "vm:static-fn")
93 (load "vm:arith")
94 (load "vm:cell")
95 (load "vm:subprim")
96 (load "vm:debug")
97 (load "vm:c-call")
98 (load "vm:print")
99 (load "vm:alloc")
100 (load "vm:call")
101 (load "vm:nlx")
102 (load "vm:values")
103 (load "vm:array")
104 (load "vm:pred")
105 (load "vm:type-vops")
106
107 (load "assem:assem-rtns")
108
109 (load "assem:array")
110 (load "assem:arith")
111 (load "assem:alloc")
112
113 (load "c:pseudo-vops")
114
115 (check-move-function-consistency)
116
117 (load "vm:new-genesis")
118
119 ;;; OK, the cross compiler backend is loaded.
120
121 (setf *features* (remove :building-cross-compiler *features*))
122
123 ;;; Info environment hacks.
124 (macrolet ((frob (&rest syms)
125 `(progn ,@(mapcar #'(lambda (sym)
126 `(defconstant ,sym
127 (symbol-value
128 (find-symbol ,(symbol-name sym)
129 :vm))))
130 syms))))
131 (frob OLD-PPC:BYTE-BITS OLD-PPC:WORD-BITS
132 #+long-float OLD-PPC:SIMPLE-ARRAY-LONG-FLOAT-TYPE
133 OLD-PPC:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE
134 OLD-PPC:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
135 #+long-float OLD-PPC:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE
136 OLD-PPC:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE
137 OLD-PPC:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
138 OLD-PPC:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE
139 OLD-PPC:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
140 OLD-PPC:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE
141 OLD-PPC:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE
142 OLD-PPC:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE
143 OLD-PPC:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE
144 OLD-PPC:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
145 OLD-PPC:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE
146 OLD-PPC:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
147 OLD-PPC:SIMPLE-BIT-VECTOR-TYPE
148 OLD-PPC:SIMPLE-STRING-TYPE OLD-PPC:SIMPLE-VECTOR-TYPE
149 OLD-PPC:SIMPLE-ARRAY-TYPE OLD-PPC:VECTOR-DATA-OFFSET
150 OLD-PPC:DOUBLE-FLOAT-EXPONENT-BYTE
151 OLD-PPC:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX
152 OLD-PPC:DOUBLE-FLOAT-SIGNIFICAND-BYTE
153 OLD-PPC:SINGLE-FLOAT-EXPONENT-BYTE
154 OLD-PPC:SINGLE-FLOAT-NORMAL-EXPONENT-MAX
155 OLD-PPC:SINGLE-FLOAT-SIGNIFICAND-BYTE
156 ))
157
158 ;; Modular arith hacks
159 (setf (fdefinition 'vm::ash-left-mod32) #'old-ppc::ash-left-mod32)
160 (setf (fdefinition 'vm::lognot-mod32) #'old-ppc::lognot-mod32)
161
162 ;; Fused multiply hack. Don't know why this is needed for a cross-compile
163 (setf (fdefinition 'vm::fused-multiply-add) #'old-ppc::fused-multiply-add)
164 (setf (fdefinition 'vm::fused-multiply-subtract) #'old-ppc::fused-multiply-subtract)
165 ;; end
166
167 (let ((function (symbol-function 'kernel:error-number-or-lose)))
168 (let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
169 (setf (symbol-function 'kernel:error-number-or-lose) function)
170 (setf (info function kind 'kernel:error-number-or-lose) :function)
171 (setf (info function where-from 'kernel:error-number-or-lose) :defined)))
172
173 (defun fix-class (name)
174 (let* ((new-value (find-class name))
175 (new-layout (kernel::%class-layout new-value))
176 (new-cell (kernel::find-class-cell name))
177 (*info-environment* (c:backend-info-environment c:*target-backend*)))
178 (remhash name kernel::*forward-referenced-layouts*)
179 (kernel::%note-type-defined name)
180 (setf (info type kind name) :instance)
181 (setf (info type class name) new-cell)
182 (setf (info type compiler-layout name) new-layout)
183 new-value))
184 (fix-class 'c::vop-parse)
185 (fix-class 'c::operand-parse)
186
187 #+random-mt19937
188 (declaim (notinline kernel:random-chunk))
189
190 (setf c:*backend* c:*target-backend*)
191
192 ;;; Extern-alien-name for the new backend.
193 (in-package :vm)
194 (defun extern-alien-name (name)
195 (declare (type simple-string name))
196 (concatenate 'string "_" name))
197 (export 'extern-alien-name)
198 (export 'fixup-code-object)
199 (export 'sanctify-for-execution)
200
201 (in-package :cl-user)
202
203 ;;; Don't load compiler parts from the target compilation
204
205 (defparameter *load-stuff* nil)
206
207 ;; hack, hack, hack: Make old-x86::any-reg the same as
208 ;; x86::any-reg as an SC. Do this by adding old-x86::any-reg
209 ;; to the hash table with the same value as x86::any-reg.
210
211 (let ((ht (c::backend-sc-names c::*target-backend*)))
212 (setf (gethash 'old-ppc::any-reg ht)
213 (gethash 'ppc::any-reg ht)))
214
215 ;; A hack for ppc. Make sure the vop, move-double-to-int-arg, is
216 ;; available in both the OLD-PPC and new PPC package. (I don't know
217 ;; why this is needed, but it seems to be.)
218 (let ((ht (c::backend-template-names c::*target-backend*)))
219 (dolist (syms '((old-ppc::move-double-to-int-arg
220 ppc::move-double-to-int-arg)
221 (old-ppc::move-single-to-int-arg
222 ppc::move-single-to-int-arg)))
223 (destructuring-bind (old new)
224 syms
225 (setf (gethash old
226 ht)
227 (gethash new ht)))))

  ViewVC Help
Powered by ViewVC 1.1.5