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