make-genesis-2.lisp

   1 (load "src/cold/shared.lisp")
   2 (in-package "SB-COLD")
   3 (setf *host-obj-prefix* "obj/from-host/"
   4       *target-obj-prefix* "obj/from-xc/")
   5 (load "src/cold/set-up-cold-packages.lisp")
   6 (load "src/cold/defun-load-or-cload-xcompiler.lisp")
   7 (load-or-cload-xcompiler #'host-load-stem)
   8 (load "tools-for-build/corefile.lisp" :verbose nil)
   9 (host-cload-stem "src/compiler/generic/genesis" nil)
  10
  11 (let (object-file-names foptrace-file-names)
  12   (do-stems-and-flags (stem flags 2)
  13     (unless (member :not-target flags)
  14       (push (stem-object-path stem flags :target-compile)
  15             object-file-names)
  16       (when (member :foptrace-file flags)
  17         (push (stem-object-path stem flags :target-compile)
  18               foptrace-file-names))))
  19   (setf object-file-names (nreverse object-file-names))
  20   (genesis :object-file-names object-file-names
  21            :foptrace-file-names foptrace-file-names
  22            :defstruct-descriptions (find-bootstrap-file "output/defstructs.lisp-expr" t)
  23            :tls-init (read-from-file "output/tls-init.lisp-expr" :build-dependent t)
  24            :c-header-dir-name "output/genesis-2"
  25            :core-file-name "output/cold-sbcl.core"
  26            ;; The map file is not needed by the system, but can be
  27            ;; very handy when debugging cold init problems.
  28            :map-file-name "output/cold-sbcl.map"))
  29
  30 (when sb-c::*track-full-called-fnames*
  31   (let (possibly-suspicious likely-suspicious)
  32     (sb-int:dohash ((name cell) sb-c::*emitted-full-calls*)
  33        (let* ((inlinep (eq (sb-int:info :function :inlinep name) 'inline))
  34               (source-xform (sb-int:info :function :source-transform name))
  35               (info (sb-int:info :function :info name)))
  36          (when (and cell
  37                     (or inlinep
  38                         source-xform
  39                         (and info (sb-c::fun-info-templates info))
  40                         (sb-int:info :function :compiler-macro-function name)))
  41              (cond (inlinep
  42                     ;; A full call to an inline function almost always indicates
  43                     ;; an out-of-order definition. If not an inline function,
  44                     ;; the call could be due to an inapplicable transformation.
  45                     (push (list name cell) likely-suspicious))
  46                    ;; structure constructors aren't inlined by default,
  47                    ;; though we have a source-xform.
  48                    ((and (listp source-xform) (eq :constructor (cdr source-xform))))
  49                    (t
  50                     (push (list name cell) possibly-suspicious))))))
  51     (flet ((show (label list)
  52              (when list
  53                (format t "~%~A suspicious calls:~:{~%~4d ~S~@{~%     ~S~}~}~%"
  54                        label
  55                        (mapcar (lambda (x) (list* (ash (cadr x) -2) (car x) (cddr x)))
  56                                (sort list #'> :key #'cadr))))))
  57       ;; Called inlines not in the presence of a declaration to the contrary
  58       ;; indicate that perhaps the function definition appeared too late.
  59       (show "Likely" likely-suspicious)
  60       ;; Failed transforms are considered not quite as suspicious
  61       ;; because it could either be too late, or that the transform failed.
  62       (show "Possibly" possibly-suspicious))
  63     ;; As each platform's build becomes warning-free,
  64     ;; it should be added to the list here to prevent regresssions.
  65     (when (and likely-suspicious
  66                (target-featurep '(:and (:or :x86 :x86-64) (:or :linux :darwin))))
  67       (warn "Expected zero inlinining failures"))))
  68
  69 #+cmu (ext:quit)
  70 #+clisp (ext:quit)
  71 #+abcl (ext:quit)