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: [ -r ] binary ( -a archive | member )*
7 ;; The script processes the arguments from left to right to form then
8 ;; named binary with the named members appended.
10 ;; Use '-a archive' to make the nominated ar style archive members
11 ;; available subsequently for embedding.
13 ;; Use '-A archive' to embed all members of the nominated ar style
16 ;; Use '-r' to overwrite an existing binary
18 ;; The first embedded member will be the "main script".
23 '(("-w" ?) ; write new file
24 ("-u" ? ?) ; unpack members to given directory
25 ("-t" ?) ; merely list packed members of
28 (load "main-args.lsp")
30 (define (compile-file M (D (read-file M)))
32 (write-line 2 (format "*** Mising %s .. aborting" M))
34 (append-file BINARY (format "%s\n%d\n" M (length D)))
35 (append-file BINARY D))
37 (define (compile-ar A M)
38 (let ((MEMBERS (archive M)))
39 (if (= A "-A") (dolist (M MEMBERS) (compile-file M)))))
41 (define (compile BINARY MEMBERS)
42 (write-file BINARY (0 archive:incore core)) ; includes the marker
43 (exec (format "chmod a+x %s" BINARY))
46 ;;(write-line 1 (string "[" M "]" (archives)))
50 (true (if A (compile-ar A M) (compile-file M))
54 (define (decompile BINARY DIR)
55 (let ((D (read-file BINARY)))
57 (let ((P (find (dup "x" 40) D)))
60 (while (regex "([^\n]+)\n([^\n]+)\n" D 0 P)
61 (let ((N $1) (S (int $2)) (L (length $0)))
63 (if DIR (write-file (string DIR "/" N) (P S D)) (println N))
66 ;; clear the compiler index
67 ;; Drop the compile members from the index
68 (dolist (M (map first (archives))) (archives M nil))
70 (when (or (!= 1 (length (clean null? OPTIONS)))
71 (!= 2 (length ((clean null? OPTIONS) 0))))
72 (write-line 2 "Please use one of -w -u or -t")
76 ((OPTIONS 0) (compile (OPTIONS 0 1 0) ARGS))
77 ((OPTIONS 1) (decompile (OPTIONS 1 1 0) (OPTIONS 1 1 1)))
78 ((OPTIONS 2) (decompile (OPTIONS 2 1 0) nil)))