/[cmucl]/src/bootfiles/19e/boot-2008-09-sse2.lisp
ViewVC logotype

Contents of /src/bootfiles/19e/boot-2008-09-sse2.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Wed Nov 12 15:04:23 2008 UTC (5 years, 5 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, merged-unicode-utf16-extfmt-2009-06-11, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, release-19f-pre1, snapshot-2008-12, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, label-2009-03-16, release-19f-base, merge-sse2-packed, merge-with-19f, intl-branch-working-2010-02-11-1000, RELEASE_20b, RELEASE_19f, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, label-2009-03-25, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, portable-clx-import-2009-06-16, cross-sparc-branch-base, intl-branch-base, portable-clx-base, snapshot-2009-08, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, HEAD
Branch point for: RELEASE-19F-BRANCH, portable-clx-branch, cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, unicode-utf16-branch, cross-sol-x86-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.1: +212 -0 lines
Merge in SSE2 changes from sse2-packed-branch (tag
sse2-packed-2008-11-12).
1 ;; Bootstrap file for cross-compiling SSE2 support for x86.
2
3 (in-package :cl-user)
4
5 ;;; Rename the X86 package and backend so that new-backend does the
6 ;;; right thing.
7 (rename-package "X86" "OLD-X86" '("OLD-VM"))
8 (setf (c:backend-name c:*native-backend*) "OLD-X86")
9
10 (c::new-backend "X86"
11 ;; Features to add here. These are just examples. You may not
12 ;; need to list anything here. We list them here anyway as a
13 ;; record of typical features for all x86 ports.
14 '(:x86 :i486 :pentium
15 :stack-checking ; Catches stack overflow
16 :heap-overflow-check ; Catches heap overflows
17 :relative-package-names ; relative package names
18 :mp ; multiprocessing
19 :gencgc ; Generational GC
20 :conservative-float-type
21 :hash-new
22 :random-mt19937
23 :cmu :cmu19 :cmu19e ; Version features
24 :double-double ; double-double float support
25 :sse2 ; SSE2 support
26 :complex-fp-vops ; VOPs for complex arithmetic
27 )
28 ;; Features to remove from current *features* here. Normally don't
29 ;; need to list anything here unless you are trying to remove a
30 ;; feature.
31 '(:x86-bootstrap
32 ;; :alpha :osf1 :mips
33 :propagate-fun-type :propagate-float-type :constrain-float-type
34 ;; :openbsd :freebsd :glibc2 :linux
35 :long-float :new-random :small))
36
37 ;;; Compile the new backend.
38 (pushnew :bootstrap *features*)
39 (pushnew :building-cross-compiler *features*)
40 (pushnew :sse2 *features*)
41 (pushnew :complex-fp-vops *features*)
42 (load "target:tools/comcom")
43
44 ;;; Load the new backend.
45 (setf (search-list "c:")
46 '("target:compiler/"))
47 (setf (search-list "vm:")
48 '("c:x86/" "c:generic/"))
49 (setf (search-list "assem:")
50 '("target:assembly/" "target:assembly/x86/"))
51
52 ;; Load the backend of the compiler.
53
54 ;; Why do it explicitly this way? Why not use loadbackend.lisp?
55
56 (in-package "C")
57
58 (load "vm:vm-macs")
59 (load "vm:parms")
60 (load "vm:objdef")
61 (load "vm:interr")
62 (load "assem:support")
63
64 (load "target:compiler/srctran")
65 (load "vm:vm-typetran")
66 (load "target:compiler/float-tran")
67 (load "target:compiler/saptran")
68
69 (load "vm:macros")
70 (load "vm:utils")
71
72 (load "vm:vm")
73 (load "vm:insts")
74 (load "vm:primtype")
75 (load "vm:move")
76 (load "vm:sap")
77 (when (target-featurep :sse2)
78 (load "vm:sse2-sap"))
79
80 (load "vm:system")
81 (load "vm:char")
82 (if (target-featurep :sse2)
83 (load "vm:float-sse2")
84 (load "vm:float"))
85
86 (load "vm:memory")
87 (load "vm:static-fn")
88 (load "vm:arith")
89 (load "vm:cell")
90 (load "vm:subprim")
91 (load "vm:debug")
92 (load "vm:c-call")
93 (when (target-featurep :sse2)
94 (load "vm:sse2-c-call"))
95 (load "vm:print")
96 (load "vm:alloc")
97 (load "vm:call")
98 (load "vm:nlx")
99 (load "vm:values")
100 ;; These need to be loaded before array because array wants to use
101 ;; some vops as templates.
102 (load (if (target-featurep :sse2)
103 "vm:sse2-array"
104 "vm:x87-array"))
105 (load "vm:array")
106 (load "vm:pred")
107 (load "vm:type-vops")
108
109 (load "assem:assem-rtns")
110
111 (load "assem:array")
112 (load "assem:arith")
113 (load "assem:alloc")
114
115 (load "c:pseudo-vops")
116
117 (check-move-function-consistency)
118
119 (load "vm:new-genesis")
120
121 ;;; OK, the cross compiler backend is loaded.
122
123 (setf *features* (remove :building-cross-compiler *features*))
124
125 ;;; Info environment hacks.
126 (macrolet ((frob (&rest syms)
127 `(progn ,@(mapcar #'(lambda (sym)
128 `(defconstant ,sym
129 (symbol-value
130 (find-symbol ,(symbol-name sym)
131 :vm))))
132 syms))))
133 (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS
134 #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE
135 OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE
136 OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
137 #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE
138 OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE
139 OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
140 OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE
141 OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
142 OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE
143 OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE
144 OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE
145 OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE
146 OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
147 OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE
148 OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
149 OLD-VM:SIMPLE-BIT-VECTOR-TYPE
150 OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE
151 OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET
152 OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE
153 OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX
154 OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE
155 OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE
156 OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX
157 OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE
158 )
159 #+double-double
160 (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE
161 OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE))
162
163 ;; Modular arith hacks
164 (setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32)
165 (setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32)
166 ;; End arith hacks
167
168 (let ((function (symbol-function 'kernel:error-number-or-lose)))
169 (let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
170 (setf (symbol-function 'kernel:error-number-or-lose) function)
171 (setf (info function kind 'kernel:error-number-or-lose) :function)
172 (setf (info function where-from 'kernel:error-number-or-lose) :defined)))
173
174 (defun fix-class (name)
175 (let* ((new-value (find-class name))
176 (new-layout (kernel::%class-layout new-value))
177 (new-cell (kernel::find-class-cell name))
178 (*info-environment* (c:backend-info-environment c:*target-backend*)))
179 (remhash name kernel::*forward-referenced-layouts*)
180 (kernel::%note-type-defined name)
181 (setf (info type kind name) :instance)
182 (setf (info type class name) new-cell)
183 (setf (info type compiler-layout name) new-layout)
184 new-value))
185 (fix-class 'c::vop-parse)
186 (fix-class 'c::operand-parse)
187
188 #+random-mt19937
189 (declaim (notinline kernel:random-chunk))
190
191 (setf c:*backend* c:*target-backend*)
192
193 ;;; Extern-alien-name for the new backend.
194 (in-package :vm)
195 (defun extern-alien-name (name)
196 (declare (type simple-string name))
197 name)
198 (export 'extern-alien-name)
199 (export 'fixup-code-object)
200 (export 'sanctify-for-execution)
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-vm::any-reg the same as
208 ;; x86::any-reg as an SC. Do this by adding old-vm::any-reg
209 ;; to the hash table with the same value as x86::any-reg.
210 (let ((ht (c::backend-sc-names c::*target-backend*)))
211 (setf (gethash 'old-vm::any-reg ht)
212 (gethash 'vm::any-reg ht)))

  ViewVC Help
Powered by ViewVC 1.1.5