changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra / autogen.lisp

changeset 288: 50329ab8865a
parent: 71ac00213ae3
child: acaa2f3cfbd4
author: Richard Westhaver <ellis@rwest.io>
date: Tue, 18 Jun 2024 14:45:11 -0400
permissions: -rw-r--r--
description: defaults 
     1 ;;; autogen.lisp --- Auto-generate CC Infrastructure
     2 
     3 ;; This script must be ran with a compliant CC lisp core image from a complian
     4 ;; CC lisp compiler. The easiest way to get started is by running the
     5 ;; 'bootstrap.sh' script first which will download these for you into the
     6 ;; local 'STASH' directory and run this script automatically.
     7 
     8 #|
     9 # download pre-compiled binaries and run autogen.lisp
    10 ./bootstrap.sh 
    11 
    12 # or run manually with local lisp runtime and core
    13 sbcl --core $LISP_HOME/user.core --script autogen.lisp \
    14 --eval "(infra/autogen:autogen)"
    15 |#
    16 
    17 ;;; Code:
    18 (in-package :std-user)
    19 
    20 (defpkg :infra/autogen
    21   (:use :cl :skel :log :std/named-readtables
    22         :dat/json :dat/sxp :net/fetch :net/util
    23         :cli/progress :cli/ansi :cli/ed :cli/prompt
    24         :cli/shell :std/hash-table :std/alien :std/macs
    25         :std/fmt)
    26   (:export :autogen))
    27 
    28 (in-package :infra/autogen)
    29 (in-readtable :shell)
    30 ;;; Vars
    31 (defparameter *profile* (uiop:read-file-forms
    32                          (if-let ((profile (sb-posix:getenv "INFRA_PROFILE")))
    33                            (probe-file profile)
    34                            (when-let ((default (probe-file "default.sxp")))
    35                              (sb-posix:setenv "INFRA_PROFILE" (namestring default) 1)
    36                              default))))
    37 (defparameter *host* (uiop:read-file-forms
    38                       (let ((hcfg (format nil "~a.sxp" (sb-unix:unix-gethostname))))
    39                         (unless (probe-file hcfg)
    40                           (print #0$./check.sh$#))
    41                         hcfg)))
    42 (defparameter *host-env* (let ((table (make-hash-table :test 'equal))
    43                                (keys (list "STASH" "STORE" "DIST" "PACKY_URL" "VC_URL" "INSTALL_PREFIX"
    44                                            "CC" "AR" "HG" "GIT" "LISP" "RUSTC" "LD" "SHELL" "DEV" "DEV_HOME"
    45                                            "DEV_ID" "WORKER" "WORKER_ID" "WORKER_HOME" "CARGO_HOME" "RUSTUP_HOME"
    46                                            "LISP_HOME" "INFRA_PROFILE" "LOG_LEVEL")))
    47                            (dolist (k keys table)
    48                              (setf (gethash k table) (sb-posix:getenv k)))))
    49 
    50 ;;; Utils
    51 (defun gethost (k) (getf *host* k))
    52 (defun getprofile (k) (getf *profile* k))
    53 
    54 (defun getenv (k) (gethash *host-env* k))
    55 
    56 (defun setenv (k v)
    57   (sb-posix:setenv k v 1)
    58   (setf (gethash k *host-env*) v))
    59 
    60 (defmacro setenv* (&rest forms)
    61   `(progn
    62      ,@(loop for (k v) on forms by #'cddr while v
    63              collect `(setenv ,k (or ,v "")))))
    64 
    65 (defmacro check-err (is-warn ctrl name)
    66   `(if ,is-warn
    67        (warn 'simple-warning 
    68              :format-control ,ctrl
    69              :format-arguments (list ,name))
    70        (error 'simple-program-error 
    71               :format-control ,ctrl
    72               :format-arguments (list ,name))))
    73 
    74 (defun check-shared-lib (name &optional warn)
    75   "Check for a shared library by loading it in the current session with dlopen.
    76 When WARN is non-nil, signal a warning instead of an error."
    77   (let ((lib-name (format nil "lib~a.so" name)))
    78     (if-let ((lib (ignore-errors (sb-alien:load-shared-object lib-name))))
    79       (unwind-protect t
    80         (sb-alien:unload-shared-object lib))
    81       (check-err warn "shared library missing: ~x" name))))
    82 
    83 (defun getpro-else (k else) (or (getprofile k) else))
    84 
    85 ;;; Config
    86 (defun init-profile ()
    87   (info! "initializing profile...")
    88   (let* ((cc (getpro-else :cc "clang"))
    89          (ld (getpro-else :ld "lld"))
    90          (install-prefix (getpro-else :install-prefix "/usr/local"))
    91          (stash (getpro-else :stash ".stash"))
    92          (store (getpro-else :store (namestring (merge-pathnames "share/store" stash))))
    93          (dist (getpro-else :dist (namestring (merge-pathnames "dist" store))))
    94          (lisp (getpro-else :lisp (lisp-implementation-type)))
    95          (lisp-version (getpro-else :lisp-version (lisp-implementation-version)))
    96          (log-level (getprofile :log-level))
    97          (lisp-home (getprofile :lisp-home))
    98          (quicklisp-home (getprofile :quicklisp-home))
    99          (rustc (getpro-else :rustc "rustc"))
   100          (rust-home (getprofile :rust-home))
   101          (rustup-home (getprofile :rustup-home))
   102          (cargo-home (getprofile :cargo-home))
   103          (features (getprofile :features)))
   104     (if-let ((stash (probe-file stash)))
   105       (setenv "STASH" (namestring stash))
   106       (error "STASH not found: ~A" stash))
   107     (if-let ((cc (cli:find-exe cc)))
   108       (setenv "CC" (namestring cc))
   109       (error "CC not found: ~A" cc))
   110     (setenv*
   111      "LD" ld
   112      "LISP" lisp
   113      "LISP_VERSION" lisp-version
   114      "LISP_HOME" lisp-home
   115      "QUICKLISP_HOME" quicklisp-home
   116      "RUSTC" rustc
   117      "RUST_HOME" rust-home
   118      "RUSTUP_HOME" rustup-home
   119      "CARGO_HOME" cargo-home
   120      "INSTALL_PREFIX" install-prefix
   121      "STORE" store
   122      "DIST" dist
   123      "LOG_LEVEL" (symbol-name log-level))
   124     (setq *log-level* log-level)
   125     ;; process features
   126     (loop for f in features
   127           do (progn
   128                (format t "checking host for feature dependencies: ~A~%" f)))))
   129 
   130 (defun init-host ()
   131   )
   132 
   133 ;;; Build
   134 (defun make-default ()
   135   (std/thread:wait-for-threads
   136    (list (sb-thread:make-thread (lambda () (sk-call* *skel-project* :repos)))))
   137   (vc:run-hg-command "clone" (list ".stash/src/core.hg" ".stash/src/core"))
   138   (vc:run-hg-command "clone" (list ".stash/src/home.hg" ".stash/src/home"))
   139   (vc:run-hg-command "clone" (list ".stash/src/etc.hg" ".stash/src/etc")))
   140 
   141 (defun make-pods ()
   142   (vc:run-hg-command "clone" (list ".stash/src/pod.hg" ".stash/src/pod"))
   143   (std/thread:wait-for-threads
   144    (list (sb-thread:make-thread (lambda () (sk-call* *skel-project* :archlinux :box)))
   145          (sb-thread:make-thread (lambda () (sk-call* *skel-project* :alpine :worker))))))
   146 
   147 (defun make-boxes ()
   148   (vc:run-hg-command "clone" (list ".stash/src/box.hg" ".stash/src/box")))
   149 
   150 (defun make-packy ()
   151   (sk-call* *skel-project* :packy-repos))
   152 
   153 (defun make-org ()
   154   (vc:run-hg-command "clone" (list ".stash/src/org.hg" ".stash/src/org")))
   155 
   156 (defun make-demo ()
   157   (vc:run-hg-command "clone" (list ".stash/src/demo.hg" ".stash/src/demo")))
   158 
   159 (defun autogen ()
   160   (info! (machine-version)
   161          "starting autogen...")
   162   (in-readtable :shell)
   163   (terpri)
   164   (init-profile)
   165   (init-host)
   166   (init-skel-vars)
   167   (setq *skel-project* (find-skelfile *default-pathname-defaults* :load t))
   168   (unless (probe-file #p".stash")
   169     (sk-call* *skel-project* :bootstrap))
   170   ;; print post-init info
   171   (format t "lisp: ~A ~A~%"(lisp-implementation-type) (lisp-implementation-version))
   172   (format t "core: ~A~%" sb-ext:*core-pathname*)
   173   (terpri)
   174   (println "host:")
   175   (loop for (k v) on *host* by 'cddr
   176         do (format t "  ~A = ~A~%" k v))
   177   (println "profile:")
   178   (loop for (k v) on *profile* by 'cddr
   179         do (format t "  ~A = ~A~%" k v))
   180   (println "env:")
   181   (loop for k being the hash-key
   182         using (hash-value v) of *host-env*
   183         do (format t "  ~A = ~A~%" k (or v "")))
   184   (let ((features (getprofile :features)))
   185     (std/thread:wait-for-threads
   186      (std:flatten
   187       (list
   188        (when (member :default features) (sb-thread:make-thread 'make-default :name "default"))
   189        (when (member :pod features) (sb-thread:make-thread 'make-pods :name "pod"))
   190        (when (member :box features) (sb-thread:make-thread 'make-boxes :name "box"))
   191        (when (member :org features) (sb-thread:make-thread 'make-pods :name "org"))
   192        (when (member :packy features) (sb-thread:make-thread 'make-packy :name "packy")))))))