;;; 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) ;;; Set up the perfect hash generator for the target's value of N-FIXNUM-BITS. (preload-perfect-hash-generator (perfect-hash-generator-journal :input)) ;; 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) (defun copy-file-from-file (new old) (with-open-file (output new :direction :output :if-exists :supersede :if-does-not-exist :create) (with-open-file (input old) (loop (let ((line (read-line input nil))) (if line (write-line line output) (return new))))))) ;;; 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)) (defvar *emitted-full-calls*) (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") (setf *emitted-full-calls* (sb-c::cu-emitted-full-calls sb-c::*compilation-unit*)) (let ((cache (math-journal-pathname :output))) (when (probe-file cache) (copy-file-from-file "output/xfloat-math.lisp-expr" cache) (format t "~&Math journal: replaced from ~S~%" cache))) ;; 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*) (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)))) (when sb-c::*track-full-called-fnames* (let (possibly-suspicious likely-suspicious) (sb-int:dohash ((name cell) *emitted-full-calls*) (let* ((inlinep (eq (sb-int:info :function :inlinep name) 'inline)) (source-xform (sb-int:info :function :source-transform name)) (info (sb-int:info :function :info name))) (when (and cell ;; Do not report if all calls were expressly ;; NOTINLINE. If CELL is odd (i.e. there were full ;; calls without NOTINLINE), then the number of ;; full calls reported includes those expressly ;; NOTINLINE. See SB-C::EMITTED-FULL-CALL-COUNT. (oddp cell) (or inlinep source-xform (and info (sb-c::fun-info-templates info)) (sb-int:info :function :compiler-macro-function name))) (cond (inlinep ;; A full call to an inline function almost always indicates ;; an out-of-order definition. If not an inline function, ;; the call could be due to an inapplicable transformation. (push (list name cell) likely-suspicious)) ;; structure constructors aren't inlined by default, ;; though we have a source-xform. ((and (listp source-xform) (eq :constructor (cdr source-xform)))) (t (push (list name cell) possibly-suspicious)))))) (flet ((show (label list) (when list (format t "~%~A suspicious calls:~:{~%~4d ~S~@{~% ~S~}~}~%" label (mapcar (lambda (x) (list* (ash (cadr x) -2) (car x) (cddr x))) (sort list #'> :key #'cadr)))))) ;; Called inlines not in the presence of a declaration to the contrary ;; indicate that perhaps the function definition appeared too late. (show "Likely" likely-suspicious) ; "quite likely" an error ;; Failed transforms are considered not quite as suspicious ;; because it could either be too late, or that the transform failed. (show "Possibly" possibly-suspicious)) ; _potentially_ an error ;; As each platform's build becomes warning-free, ;; it should be added to the list here to prevent regresssions. ;; But oops! apparently this check started failing a long time ago ;; but because it was done in the wrong place, the check failed to fail. #+nil (when (and likely-suspicious (target-featurep '(:and (:or :x86 :x86-64) (:or :linux :darwin)))) (warn "Expected zero inlinining failures")))) ;; 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")))