1 ;;; Set up the cross-compiler.
2 (setf *print-level
* 5 *print-length
* 5)
3 (load "src/cold/shared.lisp")
6 ;;; FIXME: these prefixes look like non-pathnamy ways of defining a
7 ;;; relative pathname. Investigate whether they can be made relative
9 (setf *host-obj-prefix
* "obj/from-host/"
10 *target-obj-prefix
* "obj/from-xc/")
11 (load "src/cold/set-up-cold-packages.lisp")
12 (load "src/cold/defun-load-or-cload-xcompiler.lisp")
13 (load-or-cload-xcompiler #'host-load-stem
)
14 ;;; Set up the perfect hash generator for the target's value of N-FIXNUM-BITS.
15 (preload-perfect-hash-generator (perfect-hash-generator-journal :input
))
17 ;; Supress function/macro redefinition warnings under clisp.
18 #+clisp
(setf custom
:*suppress-check-redefinition
* t
)
20 ;; Avoid natively compiling new code under ecl
21 #+ecl
(ext:install-bytecodes-compiler
)
23 (defun copy-file-from-file (new old
)
24 (with-open-file (output new
:direction
:output
:if-exists
:supersede
25 :if-does-not-exist
:create
)
26 (with-open-file (input old
)
27 (loop (let ((line (read-line input nil
)))
28 (if line
(write-line line output
) (return new
)))))))
30 ;;; Run the cross-compiler to produce cold fasl files.
31 (setq sb-c
::*track-full-called-fnames
* :minimal
) ; Change this as desired
32 (setq sb-c
::*static-vop-usage-counts
* (make-hash-table))
33 (defvar *emitted-full-calls
*)
40 ;; Even the host may get STYLE-WARNINGS from e.g. cross-compiling
41 ;; macro definitions. FIXME: This is duplicate code from make-host-1
42 (handler-bind ((style-warning
45 (setq style-warnp
'style-warning
)))
49 (setq warnp
'warning
))))
50 (sb-xc:with-compilation-unit
()
51 (load "src/cold/compile-cold-sbcl.lisp")
52 (setf *emitted-full-calls
*
53 (sb-c::cu-emitted-full-calls sb-c
::*compilation-unit
*))
54 (let ((cache (math-journal-pathname :output
)))
55 (when (probe-file cache
)
56 (copy-file-from-file "output/xfloat-math.lisp-expr" cache
)
57 (format t
"~&Math journal: replaced from ~S~%" cache
)))
58 ;; Enforce absence of unexpected forward-references to warm loaded code.
59 ;; Looking into a hidden detail of this compiler seems fair game.
60 (when sb-c
::*undefined-warnings
*
62 (dolist (warning sb-c
::*undefined-warnings
*)
63 (case (sb-c::undefined-warning-kind warning
)
64 (:variable
(setf variables t
))
65 (:type
(setf types t
))
66 (:function
(setf functions t
)))))))
67 ;; Exit the compilation unit so that the summary is printed. Then complain.
69 (cerror "Proceed anyway"
70 "Undefined ~:[~;variables~] ~:[~;types~]~
71 ~:[~;functions (incomplete SB-COLD::*UNDEFINED-FUN-ALLOWLIST*?)~]"
72 variables types functions
))
73 (when (and (or warnp style-warnp
) *fail-on-warnings
* (not (target-featurep :win32
)))
74 (cerror "Proceed anyway"
75 "make-host-2 stopped due to unexpected ~A raised from the host." (or warnp style-warnp
))))
77 #-clisp
; DO-ALL-SYMBOLS seems to kill CLISP at random
79 (when (and (sb-int:info
:function
:inlinep s
)
80 (eq (sb-int:info
:function
:where-from s
) :assumed
))
81 (error "INLINE declaration for an undefined function: ~S?" s
)))
83 (with-open-file (output "output/cold-vop-usage.txt"
84 :direction
:output
:if-exists
:supersede
)
85 (sb-int:dohash
((name vop
) sb-c
::*backend-parsed-vops
*)
86 (declare (ignore vop
))
87 (format output
"~7d ~s~%"
88 (gethash name sb-c
::*static-vop-usage-counts
* 0)
89 ;; change SB-XC symbols back to their normal counterpart
90 (if (string= (cl:package-name
(cl:symbol-package name
)) "SB-XC")
91 (find-symbol (string name
) "COMMON-LISP")
94 (when sb-c
::*track-full-called-fnames
*
95 (let (possibly-suspicious likely-suspicious
)
96 (sb-int:dohash
((name cell
) *emitted-full-calls
*)
97 (let* ((inlinep (eq (sb-int:info
:function
:inlinep name
) 'inline
))
98 (source-xform (sb-int:info
:function
:source-transform name
))
99 (info (sb-int:info
:function
:info name
)))
103 (and info
(sb-c::fun-info-templates info
))
104 (sb-int:info
:function
:compiler-macro-function name
)))
106 ;; A full call to an inline function almost always indicates
107 ;; an out-of-order definition. If not an inline function,
108 ;; the call could be due to an inapplicable transformation.
109 (push (list name cell
) likely-suspicious
))
110 ;; structure constructors aren't inlined by default,
111 ;; though we have a source-xform.
112 ((and (listp source-xform
) (eq :constructor
(cdr source-xform
))))
114 (push (list name cell
) possibly-suspicious
))))))
115 (flet ((show (label list
)
117 (format t
"~%~A suspicious calls:~:{~%~4d ~S~@{~% ~S~}~}~%"
119 (mapcar (lambda (x) (list* (ash (cadr x
) -
2) (car x
) (cddr x
)))
120 (sort list
#'> :key
#'cadr
))))))
121 ;; Called inlines not in the presence of a declaration to the contrary
122 ;; indicate that perhaps the function definition appeared too late.
123 (show "Likely" likely-suspicious
) ; "quite likely" an error
124 ;; Failed transforms are considered not quite as suspicious
125 ;; because it could either be too late, or that the transform failed.
126 (show "Possibly" possibly-suspicious
)) ; _potentially_ an error
127 ;; As each platform's build becomes warning-free,
128 ;; it should be added to the list here to prevent regresssions.
129 ;; But oops! apparently this check started failing a long time ago
130 ;; but because it was done in the wrong place, the check failed to fail.
132 (when (and likely-suspicious
133 (target-featurep '(:and
(:or
:x86
:x86-64
) (:or
:linux
:darwin
))))
134 (warn "Expected zero inlinining failures"))))
136 ;; After cross-compiling, show me a list of types that checkgen
137 ;; would have liked to use primitive traps for but couldn't.
139 (let ((l (sb-impl::%hash-table-alist sb-c
::*checkgen-used-types
*)))
140 (format t
"~&Types needed by checkgen: ('+' = has internal error number)~%")
141 (setq l
(sort l
#'> :key
#'cadr
))
142 (loop for
(type-spec .
(count . interr-p
)) in l
143 do
(format t
"~:[ ~;+~] ~5D ~S~%" interr-p count type-spec
))
144 (format t
"~&Error numbers not used by checkgen:~%")
145 (loop for
(spec symbol
) across sb-c
:+backend-internal-errors
+
146 when
(and (not (stringp spec
))
147 (not (gethash spec sb-c
::*checkgen-used-types
*)))
148 do
(format t
" ~S~%" spec
)))
150 ;; Print some information about how well the type operator caches performed
151 (when sb-impl
::*profile-hash-cache
*
152 (sb-impl::show-hash-cache-statistics
))
156 Seek Hit
(%
) Evict
(%
) Size full
157 23698219 18382256 ( 77.6%
) 5313915 ( 22.4%
) 2048 100.0% TYPE
=-CACHE
158 23528751 23416735 ( 99.5%
) 46242 ( 0.2%
) 1024 20.1% VALUES-SPECIFIER-TYPE-CACHE
159 16755212 13072420 ( 78.0%
) 3681768 ( 22.0%
) 1024 100.0% CSUBTYPEP-CACHE
160 9913114 8374965 ( 84.5%
) 1537893 ( 15.5%
) 256 100.0% MAKE-VALUES-TYPE-CACHED-CACHE
161 7718160 4702069 ( 60.9%
) 3675019 ( 47.6%
) 512 100.0% TYPE-INTERSECTION2-CACHE
162 5184706 1626512 ( 31.4%
) 3557973 ( 68.6%
) 256 86.3% %TYPE-INTERSECTION-CACHE
163 5156044 3986450 ( 77.3%
) 1169338 ( 22.7%
) 256 100.0% VALUES-SUBTYPEP-CACHE
164 4550163 2969409 ( 65.3%
) 1580498 ( 34.7%
) 256 100.0% VALUES-TYPE-INTERSECTION-CACHE
165 3544211 2607658 ( 73.6%
) 936300 ( 26.4%
) 256 98.8% %TYPE-UNION-CACHE
166 2545070 2110741 ( 82.9%
) 433817 ( 17.0%
) 512 100.0% PRIMITIVE-TYPE-AUX-CACHE
167 2164841 1112785 ( 51.4%
) 1706097 ( 78.8%
) 256 100.0% TYPE-UNION2-CACHE
168 1568022 1467575 ( 93.6%
) 100191 ( 6.4%
) 256 100.0% TYPE-SINGLETON-P-CACHE
169 779941 703208 ( 90.2%
) 76477 ( 9.8%
) 256 100.0% %COERCE-TO-VALUES-CACHE
170 618605 448427 ( 72.5%
) 169922 ( 27.5%
) 256 100.0% VALUES-TYPE-UNION-CACHE
171 145805 29403 ( 20.2%
) 116206 ( 79.7%
) 256 76.6% %%MAKE-UNION-TYPE-CACHED-CACHE
172 118634 76203 ( 64.2%
) 42188 ( 35.6%
) 256 94.9% %%MAKE-ARRAY-TYPE-CACHED-CACHE
173 12319 12167 ( 98.8%
) 47 ( 0.4%
) 128 82.0% WEAKEN-TYPE-CACHE
174 10416 9492 ( 91.1%
) 668 ( 6.4%
) 256 100.0% TYPE-NEGATION-CACHE
177 ;;; Let's check that the type system was reasonably sane. (It's easy
178 ;;; to spend a long time wandering around confused trying to debug
179 ;;; cold init if it wasn't.)
180 (load "tests/type.after-xc.lisp")
182 ;;; If you're experimenting with the system under a cross-compilation
183 ;;; host which supports CMU-CL-style SAVE-LISP, this can be a good
184 ;;; time to run it. The resulting core isn't used in the normal build,
185 ;;; but can be handy for experimenting with the system. (See slam.sh
187 ;;; FIXME: can we just always do this for supported hosts, and remove the choice?
188 (cond #+sbcl
(t (host-sb-ext:save-lisp-and-die
"output/after-xc.core"))
189 ((member :sb-after-xc-core sb-xc
:*features
*)
190 #+cmu
(ext:save-lisp
"output/after-xc.core" :load-init-file nil
)
191 #+openmcl
(ccl::save-application
"output/after-xc.core")
192 #+clisp
(ext:saveinitmem
"output/after-xc.core")))
