-
Notifications
You must be signed in to change notification settings - Fork 0
/
make-host-2.lisp
133 lines (124 loc) · 6.44 KB
/
make-host-2.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
;;; Set up the cross-compiler.
(setf *print-level* 5 *print-length* 5)
(load "src/cold/shared.lisp")
(in-package "SB-COLD")
;;; FIXME: these prefixes look like non-pathnamy ways of defining a
;;; relative pathname. Investigate whether they can be made relative
;;; pathnames.
(setf *host-obj-prefix* "obj/from-host/"
*target-obj-prefix* "obj/from-xc/")
(load "src/cold/set-up-cold-packages.lisp")
(load "src/cold/defun-load-or-cload-xcompiler.lisp")
(load-or-cload-xcompiler #'host-load-stem)
;; Supress function/macro redefinition warnings under clisp.
#+clisp (setf custom:*suppress-check-redefinition* t)
;; Avoid natively compiling new code under ecl
#+ecl (ext:install-bytecodes-compiler)
;;; Run the cross-compiler to produce cold fasl files.
(setq sb-c::*track-full-called-fnames* :minimal) ; Change this as desired
(setq sb-c::*static-vop-usage-counts* (make-hash-table))
(let (fail
variables
functions
types
warnp
style-warnp)
;; Even the host may get STYLE-WARNINGS from e.g. cross-compiling
;; macro definitions. FIXME: This is duplicate code from make-host-1
(handler-bind ((style-warning
(lambda (c)
(signal c)
(setq style-warnp 'style-warning)))
(simple-warning
(lambda (c)
(declare (ignore c))
(setq warnp 'warning))))
(sb-xc:with-compilation-unit ()
(load "src/cold/compile-cold-sbcl.lisp")
;; Enforce absence of unexpected forward-references to warm loaded code.
;; Looking into a hidden detail of this compiler seems fair game.
(when sb-c::*undefined-warnings*
(setf fail t)
(dolist (warning sb-c::*undefined-warnings*)
(case (sb-c::undefined-warning-kind warning)
(:variable (setf variables t))
(:type (setf types t))
(:function (setf functions t)))))))
;; Exit the compilation unit so that the summary is printed. Then complain.
(when fail
(cerror "Proceed anyway"
"Undefined ~:[~;variables~] ~:[~;types~]~
~:[~;functions (incomplete SB-COLD::*UNDEFINED-FUN-ALLOWLIST*?)~]"
variables types functions))
(when (and (or warnp style-warnp) *fail-on-warnings* (not (target-featurep :win32)))
(cerror "Proceed anyway"
"make-host-2 stopped due to unexpected ~A raised from the host." (or warnp style-warnp))))
#-clisp ; DO-ALL-SYMBOLS seems to kill CLISP at random
(do-all-symbols (s)
(when (and (sb-int:info :function :inlinep s)
(eq (sb-int:info :function :where-from s) :assumed))
(error "INLINE declaration for an undefined function: ~S?" s)))
(with-open-file (output "output/cold-vop-usage.txt"
:direction :output :if-exists :supersede)
(sb-int:dohash ((name vop) sb-c::*backend-parsed-vops*)
(declare (ignore vop))
(format output "~7d ~s~%"
(gethash name sb-c::*static-vop-usage-counts* 0)
;; change SB-XC symbols back to their normal counterpart
(if (string= (cl:package-name (cl:symbol-package name)) "SB-XC")
(find-symbol (string name) "COMMON-LISP")
name))))
;; After cross-compiling, show me a list of types that checkgen
;; would have liked to use primitive traps for but couldn't.
#+nil
(let ((l (sb-impl::%hash-table-alist sb-c::*checkgen-used-types*)))
(format t "~&Types needed by checkgen: ('+' = has internal error number)~%")
(setq l (sort l #'> :key #'cadr))
(loop for (type-spec . (count . interr-p)) in l
do (format t "~:[ ~;+~] ~5D ~S~%" interr-p count type-spec))
(format t "~&Error numbers not used by checkgen:~%")
(loop for (spec symbol) across sb-c:+backend-internal-errors+
when (and (not (stringp spec))
(not (gethash spec sb-c::*checkgen-used-types*)))
do (format t " ~S~%" spec)))
;; Print some information about how well the type operator caches performed
(when sb-impl::*profile-hash-cache*
(sb-impl::show-hash-cache-statistics))
#|
Sample output
-------------
Seek Hit (%) Evict (%) Size full
23698219 18382256 ( 77.6%) 5313915 ( 22.4%) 2048 100.0% TYPE=-CACHE
23528751 23416735 ( 99.5%) 46242 ( 0.2%) 1024 20.1% VALUES-SPECIFIER-TYPE-CACHE
16755212 13072420 ( 78.0%) 3681768 ( 22.0%) 1024 100.0% CSUBTYPEP-CACHE
9913114 8374965 ( 84.5%) 1537893 ( 15.5%) 256 100.0% MAKE-VALUES-TYPE-CACHED-CACHE
7718160 4702069 ( 60.9%) 3675019 ( 47.6%) 512 100.0% TYPE-INTERSECTION2-CACHE
5184706 1626512 ( 31.4%) 3557973 ( 68.6%) 256 86.3% %TYPE-INTERSECTION-CACHE
5156044 3986450 ( 77.3%) 1169338 ( 22.7%) 256 100.0% VALUES-SUBTYPEP-CACHE
4550163 2969409 ( 65.3%) 1580498 ( 34.7%) 256 100.0% VALUES-TYPE-INTERSECTION-CACHE
3544211 2607658 ( 73.6%) 936300 ( 26.4%) 256 98.8% %TYPE-UNION-CACHE
2545070 2110741 ( 82.9%) 433817 ( 17.0%) 512 100.0% PRIMITIVE-TYPE-AUX-CACHE
2164841 1112785 ( 51.4%) 1706097 ( 78.8%) 256 100.0% TYPE-UNION2-CACHE
1568022 1467575 ( 93.6%) 100191 ( 6.4%) 256 100.0% TYPE-SINGLETON-P-CACHE
779941 703208 ( 90.2%) 76477 ( 9.8%) 256 100.0% %COERCE-TO-VALUES-CACHE
618605 448427 ( 72.5%) 169922 ( 27.5%) 256 100.0% VALUES-TYPE-UNION-CACHE
145805 29403 ( 20.2%) 116206 ( 79.7%) 256 76.6% %%MAKE-UNION-TYPE-CACHED-CACHE
118634 76203 ( 64.2%) 42188 ( 35.6%) 256 94.9% %%MAKE-ARRAY-TYPE-CACHED-CACHE
12319 12167 ( 98.8%) 47 ( 0.4%) 128 82.0% WEAKEN-TYPE-CACHE
10416 9492 ( 91.1%) 668 ( 6.4%) 256 100.0% TYPE-NEGATION-CACHE
|#
;;; Let's check that the type system was reasonably sane. (It's easy
;;; to spend a long time wandering around confused trying to debug
;;; cold init if it wasn't.)
(load "tests/type.after-xc.lisp")
;;; If you're experimenting with the system under a cross-compilation
;;; host which supports CMU-CL-style SAVE-LISP, this can be a good
;;; time to run it. The resulting core isn't used in the normal build,
;;; but can be handy for experimenting with the system. (See slam.sh
;;; for an example.)
;;; FIXME: can we just always do this for supported hosts, and remove the choice?
(cond #+sbcl (t (host-sb-ext:save-lisp-and-die "output/after-xc.core"))
((member :sb-after-xc-core sb-xc:*features*)
#+cmu (ext:save-lisp "output/after-xc.core" :load-init-file nil)
#+openmcl (ccl::save-application "output/after-xc.core")
#+clisp (ext:saveinitmem "output/after-xc.core")))