make-host-1.lisp

   1 (progn
   2   (load "src/cold/shared.lisp")
   3   (let ((*print-pretty* nil)
   4         (*print-length* nil))
   5     (dolist (thing '(("SB-XC" "*FEATURES*")
   6                      ("SB-COLD" "BACKEND-SUBFEATURES")))
   7       (let* ((sym (intern (cadr thing) (car thing)))
   8              (val (symbol-value sym)))
   9         (when val
  10           (format t "~&target ~S = ~S~%" sym  val))))))
  11 (in-package "SB-COLD")
  12 #+sbcl
  13 (declaim (sb-ext:muffle-conditions
  14           sb-ext:compiler-note
  15           (satisfies optional+key-style-warning-p)))
  16 (progn
  17   (setf *host-obj-prefix* (if (boundp 'cl-user::*sbcl-host-obj-prefix*)
  18                               (symbol-value 'cl-user::*sbcl-host-obj-prefix*)
  19                               "obj/from-host/"))
  20   (load "src/cold/set-up-cold-packages.lisp")
  21   (load "src/cold/defun-load-or-cload-xcompiler.lisp")
  22
  23   ;; Supress function/macro redefinition warnings under clisp.
  24   #+clisp (setf custom:*suppress-check-redefinition* t)
  25
  26   (defmacro maybe-with-compilation-unit (&body forms)
  27     ;; A compilation-unit seems to kill the compile. I'm not sure if it's
  28     ;; running out of memory or what. I don't care to find out,
  29     ;; but it's most definitely the cause of the breakage.
  30     #+clisp `(progn ,@forms)
  31
  32     #+sbcl
  33     ;; Watch for deferred warnings under SBCL.
  34     ;; UNDEFINED-VARIABLE does not cause COMPILE-FILE to return warnings-p
  35     ;; unless outside a compilation unit. You find out about it only upon
  36     ;; exit of SUMMARIZE-COMPILATION-UNIT. So we set up a handler for that.
  37     `(let (warnp style-warnp)
  38        (handler-bind ((style-warning
  39                        ;; Any unmuffled STYLE-WARNING should fail
  40                        ;; These would typically be from undefined functions,
  41                        ;; or optional-and-key when that was visible.
  42                        (lambda (c)
  43                          (signal c) ; won't do SETQ if MUFFLE-WARNING is invoked
  44                          (setq style-warnp 'style-warning)))
  45                       (simple-warning
  46                         (lambda (c)
  47                           (declare (ignore c))
  48                           (setq warnp 'warning))))
  49          (with-compilation-unit () ,@forms))
  50        (when (and (string>= (cl:lisp-implementation-version) "2")
  51                   (or warnp style-warnp) *fail-on-warnings*)
  52          (cerror "Proceed anyway"
  53                  "make-host-1 stopped due to unexpected ~A." (or warnp style-warnp))))
  54
  55     #-(or clisp sbcl) `(with-compilation-unit () ,@forms)))
  56
  57 ;;; Return T if we can skip rebuild of unicode data when re-running make-host-1.
  58 (defun outputs-up-to-date (inputs outputs)
  59   (let ((min-output-stamp))
  60     (dolist (name outputs)
  61       (unless (probe-file name)
  62         (return-from outputs-up-to-date nil))
  63       (let ((time (file-write-date name)))
  64         (when (or (null min-output-stamp) (< time min-output-stamp))
  65           (setq min-output-stamp time))))
  66     (> min-output-stamp
  67        (reduce #'max inputs :key #'file-write-date))))
  68
  69 (defvar *ucd-inputs*)
  70 (defvar *ucd-outputs*)
  71
  72 ;;; Build the unicode database now. It depends on nothing in the cross-compiler
  73 ;;; (and let's keep it that way). This code is slow to run, so compile it.
  74 (multiple-value-bind (inputs outputs)
  75     (with-open-file (stream "src/cold/ucd-filespecs.lisp-expr")
  76       (values (read stream) (read stream)))
  77   (unless (outputs-up-to-date inputs outputs)
  78     (format t "~&; Building Unicode data~%")
  79     (ensure-directories-exist "output/ucd/")
  80     (let ((*ucd-inputs* (make-hash-table :test 'equal))
  81           (*ucd-outputs* (make-hash-table :test 'equal)))
  82       (dolist (input inputs)
  83         (setf (gethash input *ucd-inputs*) 'unused))
  84       (dolist (output outputs)
  85         (setf (gethash output *ucd-outputs*) 'unmade))
  86       (let ((object (apply #'compile-file "tools-for-build/ucd.lisp"
  87                            ;; ECL creates its compiled files beside
  88                            ;; the truename of a source; that's bad
  89                            ;; when we're in a build tree of symlinks.
  90                            #+ecl
  91                            (list
  92                             :output-file
  93                             (compile-file-pathname "tools-for-build/ucd.lisp"))
  94                            #-ecl
  95                            ())))
  96         (setf (gethash "tools-for-build/ucd.lisp" *ucd-inputs*) 'used)
  97         (load object :verbose t)
  98         (delete-file object))
  99       (dolist (s '(sb-cold::slurp-ucd sb-cold::slurp-proplist sb-cold::output))
 100         (funcall s))
 101       (let (unused-inputs extra-inputs unused-outputs extra-outputs)
 102         (maphash (lambda (k v) (when (eql v 'unused) (push k unused-inputs))) *ucd-inputs*)
 103         (maphash (lambda (k v) (when (and (eql v 'used) (not (member k inputs :test 'equal)))
 104                                  (push k extra-inputs)))
 105                  *ucd-inputs*)
 106         (maphash (lambda (k v) (when (eql v 'unmade) (push k unused-outputs))) *ucd-outputs*)
 107         (maphash (lambda (k v) (when (and (eql v 'made) (not (member k outputs :test 'equal)))
 108                                  (push k extra-outputs)))
 109                  *ucd-outputs*)
 110         (unless (and (null unused-inputs) (null extra-inputs)
 111                      (null unused-outputs) (null extra-outputs))
 112           (error "~&~@[Unused ucd inputs: ~A~%~]~
 113                   ~@[Extra ucd inputs: ~A~%~]~
 114                   ~@[Uncreated ucd outputs: ~A~%~]~
 115                   ~@[Extra ucd outputs: ~A~%~]"
 116                  unused-inputs extra-inputs
 117                  unused-outputs extra-outputs))))))
 118
 119 ;;; I don't know the best combination of OPTIMIZE qualities to produce a correct
 120 ;;; and reasonably fast cross-compiler in ECL. At over half an hour to complete
 121 ;;; make-host-{1,2}, I don't really want to waste any more time finding out.
 122 ;;; These settings work, while the defaults do not.
 123 #+ecl (proclaim '(optimize (safety 2) (debug 2)))
 124
 125 (maybe-with-compilation-unit
 126   ;; If make-host-1 is parallelized, it will produce host fasls without loading
 127   ;; them. The host will have interpreted definitions of most everything,
 128   ;; which is OK because writing out the C headers is not compute-intensive.
 129   (load-or-cload-xcompiler #'host-cload-stem)
 130  ;; propagate structure offset and other information to the C runtime
 131  ;; support code.
 132  (load "tools-for-build/corefile.lisp" :verbose nil)
 133  (host-cload-stem "src/compiler/generic/genesis" nil)
 134 ) ; END with-compilation-unit
 135
 136 (unless (member :crossbuild-test sb-xc:*features*)
 137   (sb-cold:genesis :c-header-dir-name "src/runtime/genesis"))