changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra / scripts/check.lisp

changeset 15: 17a70918610c
child: 3491c1d1815d
author: ellis <ellis@rwest.io>
date: Mon, 27 Nov 2023 22:33:13 -0500
permissions: -rwxr-xr-x
description: scripts 
     1 ;;; scripts/check.lisp --- check host features
     2 
     3 ;; This script runs some basic checks to ensure the host is ready for
     4 ;; bootstrapping.
     5 
     6 ;;; Code:
     7 (require 'asdf)
     8 (require 'sb-posix)
     9 (asdf:load-asd #P"~/dev/comp/core/lisp/std/std.asd")
    10 (asdf:load-system :std)
    11 
    12 (defpackage :infra/scripts/check
    13   (:use :cl :std :sb-alien)
    14   (:export :main
    15            :*results*))
    16 
    17 (in-package :infra/scripts/check)
    18 
    19 (defvar *results* (make-hash-table :size 32 :test 'equal))
    20 
    21 (defparameter *library-path* (ld-library-path-list))
    22 (defparameter *exec-path* (exec-path-list))
    23 
    24 (defun get-result (k) (gethash k *results*))
    25 
    26 (defun push-result (k &optional v) 
    27   (setf (gethash k *results*) v))
    28 
    29 (defun check-for-shared-lib (name)
    30   (if-let ((lib (ignore-errors (load-shared-object (format nil "lib~a.so" name)))))
    31     (prog1
    32         (push-result name lib)
    33       (unload-shared-object lib))
    34     (push-result name)))
    35 
    36 (defun check-for-bin (name)
    37   (push-result name))
    38 
    39 (defun check-for-src (name)
    40   (push-result name))
    41 
    42 (defun check-system ()
    43   (destructuring-bind (lisp version features)
    44       (my-lisp-implementation)
    45     (push-result "lisp" (list lisp version features)
    46     #-sbcl (push-result "lisp"))))
    47 
    48 (defun check-shell ()
    49   (push-result "shell" (sb-posix:getcwd)))
    50 
    51 (defun check-display ()
    52   (push-result "display"))
    53 
    54 (defun check-net ()
    55   (push-result "net"))
    56 
    57 (defun check-cpu ()
    58   (push-result "cpu"))
    59 
    60 (defmethod print-object ((object hash-table) stream)
    61   (format stream "#HOST-FEATURES{~{~{~%(~a . ~a)~}~^ ~}}"
    62           (loop for k being the hash-keys of *results*
    63                   using (hash-value v)
    64                 unless (null v) 
    65                   collect (list k v))))
    66 
    67 (defmain ()
    68   "Check the host for required features."
    69 
    70   (setq *library-path* (ld-library-path-list)
    71         *exec-path* (exec-path-list))
    72 
    73   (debug! (format nil "LD_LIBRARY_PATH: ~A~%" *library-path*))
    74   (debug! (format nil "PATH: ~A~%" *exec-path*))
    75   (check-system)
    76   (check-shell)
    77 
    78   (check-for-bin "sbcl")
    79   (check-for-bin "rustc")
    80   (check-for-bin "clang")
    81   (check-for-bin "gcc")
    82   (check-for-bin "emacs")
    83   ;; vcs
    84   (check-for-bin "hg")
    85   (check-for-bin "git")
    86   ;; virt
    87   (check-for-bin "podman")
    88 
    89   (check-for-src "core")
    90   ;; core dependencies
    91   (check-for-shared-lib "rocksdb")
    92   (check-for-shared-lib "uring")
    93   (check-for-shared-lib "btrfs")
    94   (check-for-shared-lib "btrfsutil")
    95   (check-for-shared-lib "tree-sitter")
    96   ;; extras
    97   (check-for-shared-lib "sbcl") ;; requires compiling sbcl as shared_lib
    98   (check-for-shared-lib "gtk-4")
    99   (check-for-shared-lib "blake3")
   100   (check-for-shared-lib "k")
   101   (check-for-shared-lib "cbqn")
   102   (print *results*)
   103   *results*)
   104 
   105 (main)