Coverage report: /home/ellis/comp/core/lib/cli/multi.lisp

KindCoveredAll%
expression014 0.0
branch00nil
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; multi.lisp --- Multi-entry Lisp Cores
2
 
3
 ;; Busybox-style Lisp binaries
4
 
5
 ;;; Commentary:
6
 
7
 ;; We have quite a few Lisp 'binaries' at this point, each of which
8
 ;; are quite bloated Lisp core images with tons of duplication.
9
 
10
 ;; This setup isn't ideal and while we can compress each individual
11
 ;; core, we are much better off if we can just share the same core
12
 ;; image and access multiple top-level entrypoints easily.
13
 
14
 ;; The problem of course is that we want to be able to execute the
15
 ;; single core the same as we would the individual bloated
16
 ;; binaries. To do this we have two options:
17
 
18
 ;; - build (non-lisp) trampoline programs which loads the
19
 ;;   (non-executable) core as a shared library, and calls
20
 ;;   foreign-symbols exposed from lisp.
21
 
22
 ;; - parse argv[0] and dispatch to the correct top-level
23
 ;;   function. Control argv[0] by symlinking to the executable core.
24
 
25
 ;; This package currently exposes an API for the latter.
26
 
27
 ;;; Code:
28
 (in-package :cli/multi)
29
 
30
 (defmacro define-multi-main (name default &rest mains)
31
   "Define a MAIN function for the current package which dispatches
32
   based on the value of '(ARG0)' at runtime to one of the pairs in
33
   MAINS.
34
 
35
 Each element of MAINS is a list of the form (NAME FUNCTION) where NAME
36
 is the filename of the symlink which will be handled by the associated
37
 main FUNCTION.
38
 
39
 When you save an executable lisp image with this function you should
40
 arrange for symlinks for each handled value of (ARG0) to be generated
41
 ."
42
   `(defun ,name ()
43
      (case (keywordicate (string-upcase (pathname-name (cli/clap/util:arg0))))
44
        ,@mains
45
        (t ,default))))
46
 
47
 (defun make-symlinks (src &optional directory &rest names)
48
   "Make a set of symlinks from SRC to NAMES.
49
 
50
 If DIRECTORY is non-nil each name in NAMES is considered relative to
51
 it."
52
   (when directory
53
     (setf names (mapcar (lambda (n) (merge-pathnames n directory)) names)))
54
   (dolist (n names)
55
     (sb-posix:symlink src n)))