build-all-cores.sh

   1 #!/bin/sh
   2 ./run-sbcl.sh --noprint --disable-debugger $* <<\EOF
   3 (defvar *configs-to-build* (cdr *posix-argv*))
   4
   5 (defparameter *jobs*
   6   (max 1
   7        #+unix
   8        (floor (sb-alien:alien-funcall
   9                (sb-alien:extern-alien "sysconf"
  10                                       (function sb-alien:long sb-alien:int))
  11                sb-unix::sc-nprocessors-onln)
  12               2)))
  13
  14 (let ((first (car *configs-to-build*)))
  15   (if (and (stringp first)
  16            (>= (length first) 2)
  17            (string= first "-j" :end1 2))
  18       ;; allow "-jN" as two args
  19       (cond ((= (length first) 2)
  20              (pop *configs-to-build*)
  21              (setq *jobs* (parse-integer (pop *configs-to-build*))))
  22             ((digit-char-p (char first 2)) ; or "-jN" as one arg
  23              (setq *jobs* (parse-integer first :start 2))
  24              (pop *configs-to-build*))
  25             (t
  26              (error "-j requires a number")))))
  27
  28 (when (> *jobs* 1) (format t "~&Using up to ~D job~:P~%" *jobs*))
  29
  30 ;;; I should probably have a way to add a fixed set of features in
  31 ;;; for an architecture, such as :LITTLE-ENDIAN for x86{-64}.
  32 ;;; This list is: arch-name and ((configuation-name feature ...) ...)
  33 (defparameter *all-configurations*
  34   '(("arm"    ("arm" :little-endian :largefile))
  35     ("arm64"  ("arm64" :little-endian :sb-thread)
  36               ("arm64-darwin" :darwin :bsd :unix :mach-o :little-endian :sb-thread :darwin-jit)
  37               ("arm64-reloc"  :little-endian :sb-thread :relocatable-static-space))
  38     ("mips"   ("mips" :largefile :little-endian))
  39     ("ppc"    ("ppc" :big-endian)
  40               ("ppc-thread" :big-endian :sb-thread))
  41     ("ppc64"  ("ppc64" :ppc64 :big-endian)) ; sb-thread is the default and required
  42     ("riscv"  ("riscv" :64-bit :little-endian :sb-thread))
  43     ("sparc"  ("sparc" :big-endian)
  44               ("sparc-sunos" :big-endian :unix :sunos :elf))
  45     ("x86"    ("x86" :little-endian :largefile (not :sb-eval) :sb-fasteval)
  46               ("x86-ascii" :little-endian :largefile (not :sb-unicode))
  47               ("x86-thread" :little-endian :largefile :sb-thread)
  48               ("x86-linux" :little-endian :largefile :sb-thread :linux :unix :elf :sb-thread))
  49     ("x86-64" ("x86-64" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256)
  50               ("x86-64-linux" :linux :unix :elf :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256
  51                               (not :sb-eval) :sb-fasteval)
  52               ("x86-64-darwin" :darwin :bsd :unix :mach-o :little-endian :avx2 :gencgc
  53                                :sb-simd-pack :sb-simd-pack-256)
  54               ("x86-64-imm" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256
  55                             :immobile-space)
  56               ("x86-64-permgen" :little-endian :avx2 :gencgc :sb-simd-pack :sb-simd-pack-256
  57                                 :permgen))))
  58
  59 (setq sb-ext:*evaluator-mode* :compile)
  60 (defun interpolate (string substitutions)
  61   (sb-int:collect ((fragments))
  62     (let ((start 0))
  63       (loop
  64        (let ((p (position #\{ string :start start)))
  65          (unless p
  66            (fragments (subseq string start))
  67            (return (apply #'concatenate 'string (fragments))))
  68          (fragments (subseq string start p))
  69          (let* ((end (the (not null) (position #\} string :start (1+ p))))
  70                 (var (subseq string (1+ p) end))
  71                 (pair (assoc var substitutions :test #'string=)))
  72            (fragments (the string (cdr pair)))
  73            (setq start (1+ end))))))))
  74
  75 (defun add-os-features (arch features)
  76   (if (intersection '(:unix :win32) features)
  77       features
  78       (let* ((arch-symbol (sb-int:keywordicate (string-upcase arch)))
  79              (os-features (case arch-symbol
  80                             ((:x86 :x86-64) '(:win32 :sb-thread :sb-safepoint))
  81                             (t '(:unix :linux :elf)))))
  82         (append os-features features))))
  83
  84 ;;; TODO: dependencies for each target based on build-order.lisp-expr
  85 (let
  86   ((new
  87     (with-output-to-string (makefile)
  88       (format makefile
  89           "SBCL=src/runtime/sbcl
  90 ARGS=--core output/sbcl.core --noinform --disable-debugger --noprint --no-userinit --no-sysinit
  91 SCRIPT1=crossbuild-runner/pass-1.lisp
  92 SCRIPT2=crossbuild-runner/pass-2.lisp
  93 DEPS1=crossbuild-runner/pass-1.lisp src/cold/build-order.lisp-expr~%")
  94   (dolist (arch+configs *all-configurations*)
  95     (dolist (config (cdr arch+configs))
  96       (destructuring-bind (config-name . features) config
  97         (setq features (add-os-features (car arch+configs) features))
  98         (format makefile
  99                 (interpolate
 100                  "~%obj/xbuild/{cfg}/xc.core: $(DEPS1)
 101         $(SBCL) $(ARGS) {cfg} {arch} \"{feat}\" < $(SCRIPT1)
 102 obj/xbuild/{cfg}.core: obj/xbuild/{cfg}/xc.core
 103         $(SBCL) $(ARGS) {cfg} < $(SCRIPT2)~%"
 104                  `(("cfg" . ,config-name)
 105                    ("arch" . ,(car arch+configs))
 106                    ;; features string can't contain a #\newline
 107                    ("feat" . ,(write-to-string features :pretty nil))))))))))
 108    (existing (with-open-file (stream "crossbuild-runner/Makefile")
 109                (let ((a (make-array (file-length stream) :element-type 'character)))
 110                  (read-sequence a stream)
 111                  a))))
 112  (unless (string= new existing)
 113     (with-open-file (stream "crossbuild-runner/Makefile" :direction :output :if-exists :supersede)
 114       (write-string new stream))
 115     (format t "~&Rewrote Makefile~%")))
 116
 117 (defun corefiles ()
 118   (mapcar (lambda (x) (format nil "obj/xbuild/~A.core" x))
 119           (or *configs-to-build*
 120               (mapcan (lambda (x) (mapcar 'car (cdr x)))
 121                       *all-configurations*))))
 122
 123 (ensure-directories-exist "obj/xbuild/")
 124 ;; if it's just one target this could exec() instead
 125 (defvar *process*
 126   (run-program "make"
 127                `(,(format nil "-j~D" *jobs*)
 128                  "-k"
 129                  "-fcrossbuild-runner/Makefile"
 130                  ,@(corefiles))
 131                :output t :error t
 132                :search t))
 133 (when (= (process-exit-code *process*) 0)
 134   (load "src/cold/shared" :verbose t)
 135   (load "validate-float.lisp")
 136   (dolist (pathname (directory "obj/xbuild/**/xfloat-math.lisp-expr"))
 137     (check-float-file pathname))
 138   (dolist (nbits '(30 61 63))
 139     (let* ((filename (format nil "xperfecthash~D.lisp-expr" nbits))
 140            (sources (directory (format nil "obj/xbuild/*/from-xc/~A" filename))))
 141       (when sources
 142         (funcall (intern "UPDATE-PERFECT-HASHFUNS" "SB-COLD")
 143                  sources filename))))
 144   (format t "~&Success~%"))
 145 (sb-ext:exit :code (sb-ext:process-exit-code *process*))
 146 EOF