/[cmucl]/src/bootfiles/19c/boot-2006-06-1-cross-dd-x86.lisp
ViewVC logotype

Contents of /src/bootfiles/19c/boot-2006-06-1-cross-dd-x86.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Fri Jun 30 18:41:21 2006 UTC (7 years, 9 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, merged-unicode-utf16-extfmt-2009-06-11, unicode-utf16-extfmt-2009-03-27, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2007-01, snapshot-2007-02, release-19e, release-19d, GIT-CONVERSION, unicode-utf16-sync-2008-12, cross-sol-x86-merged, label-2009-03-16, release-19f-base, merge-sse2-packed, merge-with-19f, intl-branch-working-2010-02-11-1000, unicode-snapshot-2009-05, unicode-snapshot-2009-06, unicode-utf16-sync-2008-07, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, RELEASE_20b, snapshot-2008-04, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, release-19d-base, release-19e-pre1, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, label-2009-03-25, cross-sol-x86-2010-12-20, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, sse2-merge-with-2008-11, sse2-merge-with-2008-10, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, cross-sparc-branch-base, release-19e-base, intl-branch-base, unicode-utf16-base, portable-clx-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-07, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, 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-19d-branch, sse2-packed-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.1: +223 -0 lines
This large checkin merges the double-double float support to HEAD.
The merge is from the tag "double-double-irrat-end".  The
double-double branch is now obsolete.

The code should build without double-double support (tested on sparc)
as well as build with double-double support (tested also on sparc).
1 (in-package :cl-user)
2
3 ;;; Rename the X86 package and backend so that new-backend does the
4 ;;; right thing.
5 (rename-package "X86" "OLD-X86")
6 (setf (c:backend-name c:*native-backend*) "OLD-X86")
7
8 (c::new-backend "X86"
9 ;; Features to add here
10 '(:x86 :i486 :pentium
11 :stack-checking
12 :heap-overflow-check
13 :relative-package-names
14 :mp
15 :gencgc
16 :conservative-float-type
17 :hash-new :random-mt19937
18 :linux :glibc2 :glibc2.1
19 :cmu :cmu19 :cmu19c
20 :double-double ; double-double-float
21 )
22 ;; Features to remove from current *features* here
23 '(:x86-bootstrap :alpha :osf1 :mips
24 :propagate-fun-type :propagate-float-type :constrain-float-type
25 :openbsd :freebsd :glibc2 :linux
26 :long-float :new-random :small))
27
28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;;; Things needed to cross-compile double-double changes.
30 (in-package "KERNEL")
31
32 (eval-when (compile load eval)
33 (c:defknown double-double-float-p (t)
34 boolean
35 (c:movable c:foldable c:flushable))
36 )
37
38 (eval-when (compile load eval)
39 (handler-bind ((error (lambda (c)
40 (declare (ignore c))
41 (invoke-restart 'continue))))
42 (defconstant type-test-ordering
43 '(fixnum single-float double-float integer #+long-float long-float
44 double-double-float bignum
45 complex ratio))
46 ))
47
48 (eval-when (compile load eval)
49 (handler-bind ((error (lambda (c)
50 (declare (ignore c))
51 (invoke-restart 'continue))))
52 (defconstant float-formats
53 '(double-double-float long-float double-float single-float short-float))))
54
55 (in-package "LISP")
56 (define-fop (fop-double-double-float 67)
57 (prepare-for-fast-read-byte *fasl-file*
58 (prog1
59 (let ((hi-lo (fast-read-u-integer 4))
60 (hi-hi (fast-read-s-integer 4))
61 (lo-lo (fast-read-u-integer 4))
62 (lo-hi (fast-read-s-integer 4)))
63 (kernel::make-double-double-float
64 (make-double-float hi-hi hi-lo)
65 (make-double-float lo-hi lo-lo)))
66 (done-with-fast-read-byte))))
67
68 ;; End changes for double-double
69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70 (in-package :cl-user)
71
72 ;;; Compile the new backend.
73 (pushnew :bootstrap *features*)
74 (pushnew :building-cross-compiler *features*)
75 (load "target:tools/comcom")
76
77 ;;; Load the new backend.
78 (setf (search-list "c:")
79 '("target:compiler/"))
80 (setf (search-list "vm:")
81 '("c:x86/" "c:generic/"))
82 (setf (search-list "assem:")
83 '("target:assembly/" "target:assembly/x86/"))
84
85 ;; Load the backend of the compiler.
86
87 (in-package "C")
88
89 (load "vm:vm-macs")
90 (load "vm:parms")
91 (load "vm:objdef")
92 (load "vm:interr")
93 (load "assem:support")
94
95 (load "target:compiler/srctran")
96 (load "vm:vm-typetran")
97 (load "target:compiler/float-tran")
98 (load "target:compiler/saptran")
99
100 (load "vm:macros")
101 (load "vm:utils")
102
103 (load "vm:vm")
104 (load "vm:insts")
105 (load "vm:primtype")
106 (load "vm:move")
107 (load "vm:sap")
108 (load "vm:system")
109 (load "vm:char")
110 (load "vm:float")
111
112 (load "vm:memory")
113 (load "vm:static-fn")
114 (load "vm:arith")
115 (load "vm:cell")
116 (load "vm:subprim")
117 (load "vm:debug")
118 (load "vm:c-call")
119 (load "vm:print")
120 (load "vm:alloc")
121 (load "vm:call")
122 (load "vm:nlx")
123 (load "vm:values")
124 (load "vm:array")
125 (load "vm:pred")
126 (load "vm:type-vops")
127
128 (load "assem:assem-rtns")
129
130 (load "assem:array")
131 (load "assem:arith")
132 (load "assem:alloc")
133
134 (load "c:pseudo-vops")
135
136 (check-move-function-consistency)
137
138 (load "vm:new-genesis")
139
140 ;;; OK, the cross compiler backend is loaded.
141
142 (setf *features* (remove :building-cross-compiler *features*))
143
144 ;;; Info environment hacks.
145 (macrolet ((frob (&rest syms)
146 `(progn ,@(mapcar #'(lambda (sym)
147 `(handler-bind ((error #'(lambda (c)
148 (declare (ignore c))
149 (invoke-restart 'kernel::continue))))
150 (defconstant ,sym
151 (symbol-value
152 (find-symbol ,(symbol-name sym)
153 :vm)))))
154 syms))))
155 (frob OLD-X86:BYTE-BITS OLD-X86:WORD-BITS
156 #+long-float OLD-X86:SIMPLE-ARRAY-LONG-FLOAT-TYPE
157 OLD-X86:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE
158 OLD-X86:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
159 #+long-float OLD-X86:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE
160 OLD-X86:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE
161 OLD-X86:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
162 OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE
163 OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
164 OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE
165 OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE
166 OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE
167 OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE
168 OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
169 OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE
170 OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
171 OLD-X86:SIMPLE-BIT-VECTOR-TYPE
172 OLD-X86:SIMPLE-STRING-TYPE OLD-X86:SIMPLE-VECTOR-TYPE
173 OLD-X86:SIMPLE-ARRAY-TYPE OLD-X86:VECTOR-DATA-OFFSET
174 ))
175
176 (let ((function (symbol-function 'kernel:error-number-or-lose)))
177 (let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
178 (setf (symbol-function 'kernel:error-number-or-lose) function)
179 (setf (info function kind 'kernel:error-number-or-lose) :function)
180 (setf (info function where-from 'kernel:error-number-or-lose) :defined)))
181
182 (defun fix-class (name)
183 (let* ((new-value (find-class name))
184 (new-layout (kernel::%class-layout new-value))
185 (new-cell (kernel::find-class-cell name))
186 (*info-environment* (c:backend-info-environment c:*target-backend*)))
187 (remhash name kernel::*forward-referenced-layouts*)
188 (kernel::%note-type-defined name)
189 (setf (info type kind name) :instance)
190 (setf (info type class name) new-cell)
191 (setf (info type compiler-layout name) new-layout)
192 new-value))
193 (fix-class 'c::vop-parse)
194 (fix-class 'c::operand-parse)
195
196 #+random-mt19937
197 (declaim (notinline kernel:random-chunk))
198
199 (setf c:*backend* c:*target-backend*)
200
201 ;;; Extern-alien-name for the new backend.
202 (in-package :vm)
203 (defun extern-alien-name (name)
204 (declare (type simple-string name))
205 #+(and bsd (not elf))
206 (concatenate 'string "_" name)
207 #-(and bsd (not elf))
208 name)
209 (export 'extern-alien-name)
210 (export 'fixup-code-object)
211 (export 'sanctify-for-execution)
212 (in-package :cl-user)
213
214 ;;; Don't load compiler parts from the target compilation
215
216 (defparameter *load-stuff* nil)
217
218 ;; hack, hack, hack: Make old-x86::any-reg the same as
219 ;; x86::any-reg as an SC. Do this by adding old-x86::any-reg
220 ;; to the hash table with the same value as x86::any-reg.
221 (let ((ht (c::backend-sc-names c::*target-backend*)))
222 (setf (gethash 'old-x86::any-reg ht)
223 (gethash 'x86::any-reg ht)))

  ViewVC Help
Powered by ViewVC 1.1.5