1 ;; Utility to "compile" a list of lsp files into a self-contained
2 ;; binary, which is an embedded newlisp binary with the same embedding
3 ;; script as binnl itself.
5 ;; Usage: -w binary ( member | -a archive | -A archive | -C dir )*
9 ;; The script processes the arguments from left to right to form then
10 ;; named binary with the named members appended.
12 ;; Use '-a archive' to make the nominated ar style archive members
13 ;; available subsequently for embedding.
15 ;; Use '-A archive' to embed all members of the nominated ar style
18 ;; Use '-C dir' to change source directory
20 ;; Use '-w' to overwrite an existing binary
22 ;; The first embedded member will be the "main script".
27 '(("-w" ?) ; write new file
28 ("-u" ? ?) ; unpack members to given directory
29 ("-t" ?) ; merely list packed members of
32 (load "main-args.lsp")
34 (define (compile-file M (D (read-file M)))
36 (write-line 2 (format "*** Cannot read %s .. aborting" M))
37 (when (and (archives M) (not (ends-with (archives M) ".a")))
38 (write-line 2 (format "*** (Archive filename %s must end with \".a\")"
41 (append-file BINARY (format "%s\n%d\n" M (length D)))
42 (append-file BINARY D))
44 (define (compile-ar A M)
45 (let ((MEMBERS (archive M)))
47 ;;(write-line 2 (format "including %s from %s" X M))
48 (when (= A "-A") (compile-file X))
51 (define (compile BINARY MEMBERS)
52 (unless (starts-with BINARY "/")
53 (setf BINARY (format "%s/%s" (real-path) BINARY)))
54 (write-file BINARY (0 archive:incore core)) ; includes the marker
55 (exec (format "chmod a+x %s" BINARY))
56 (let ((A nil) (C nil))
62 (true (if A (compile-ar A M)
63 C (unless (change-dir M)
64 (write-line 2 (string "** directory is " (real-path)))
65 (write-line 2 (string "Cannot change to " M))
73 (define (decompile BINARY DIR)
74 (let ((D (read-file BINARY)))
76 (let ((P (find (dup "x" 40) D)))
79 (while (regex "([^\n]+)\n([^\n]+)\n" D 0 P)
80 (let ((N $1) (S (int $2)) (L (length $0)))
82 (if DIR (write-file (string DIR "/" N) (P S D)) (println N))
85 ;; clear the compiler archive index, to be used for source archives
86 (dolist (M (map first (archives))) (archives M nil))
88 (when (or (!= 1 (length (clean null? OPTIONS)))
89 (!= 2 (length ((clean null? OPTIONS) 0))))
90 (write-line 2 "Please use one of -w -u or -t")
94 ((OPTIONS 0) (compile (OPTIONS 0 1 0) ARGS))
95 ((OPTIONS 1) (decompile (OPTIONS 1 1 0) (OPTIONS 1 1 1)))
96 ((OPTIONS 2) (decompile (OPTIONS 2 1 0) nil)))