X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=packnl.lsp;h=3e20f2b74f984e8874d82edbd36b01dabeee4c6d;hb=f7ce63a2e4c452dacf688640f0810a4cfe888ed8;hp=e49d9439dfeee2e420cc128fa32f0c388c7542a1;hpb=3dcbdf45070be29c4dec5217bcb141d8ee96ac47;p=rrq%2Fnewlisp%2Fpacknl.git

diff --git a/packnl.lsp b/packnl.lsp
index e49d943..3e20f2b 100644
--- a/packnl.lsp
+++ b/packnl.lsp
@@ -2,7 +2,9 @@
 ;; binary, which is an embedded newlisp binary with the same embedding
 ;; script as binnl itself.
 ;;
-;; Usage: [ -r ] binary ( -a archive | member )*
+;; Usage: -w binary ( member | -a archive | -A archive | -C dir )*
+;;        -t binary
+;;        -u binary directory
 ;;
 ;; The script processes the arguments from left to right to form then
 ;; named binary with the named members appended.
@@ -13,7 +15,9 @@
 ;; Use '-A archive' to embed all members of the nominated ar style
 ;; archive.
 ;;
-;; Use '-r' to overwrite an existing binary
+;; Use '-C dir' to change source directory
+;;
+;; Use '-w' to overwrite an existing binary
 
 ;; The first embedded member will be the "main script".
 ;;
@@ -29,26 +33,41 @@
 
 (define (compile-file M (D (read-file M)))
   (unless D
-    (write-line 2 (format "*** Mising %s .. aborting" M))
+    (write-line 2 (format "*** Cannot read %s .. aborting" M))
+    (when (and (archives M) (not (ends-with (archives M) ".a")))
+      (write-line 2 (format "*** (Archive filename %s must end with \".a\")"
+                            (archives M))))
     (exit 1))
   (append-file BINARY (format "%s\n%d\n" M (length D)))
   (append-file BINARY D))
 
 (define (compile-ar A M)
   (let ((MEMBERS (archive M)))
-    (if (= A "-A") (dolist (M MEMBERS) (compile-file M)))))
+    (dolist (X MEMBERS)
+      ;;(write-line 2 (format "including %s from %s" X M))
+      (when (= A "-A") (compile-file X))
+      )))
 
 (define (compile BINARY MEMBERS)
+  (unless (starts-with BINARY "/")
+    (setf BINARY (format "%s/%s" (real-path) BINARY)))
   (write-file BINARY (0 archive:incore core)) ; includes the marker
   (exec (format "chmod a+x %s" BINARY))
-  (let ((A nil))
+  (let ((A nil) (C nil))
     (dolist (M MEMBERS)
-      ;;(write-line 1 (string "[" M "]" (archives)))
       (case M
         ("-a" (setf A "-a"))
         ("-A" (setf A "-A"))
-        (true (if A (compile-ar A M) (compile-file M))
-              (setf A nil))))
+        ("-C" (setf C "-C"))
+        (true (if A (compile-ar A M)
+                C (unless (change-dir M)
+                    (write-line 2 (string "** directory is " (real-path)))
+                    (write-line 2 (string "Cannot change to " M))
+                    (exit 1))
+                (compile-file M))
+              (setf A nil)
+              (setf C nil)
+              )))
     ))
 
 (define (decompile BINARY DIR)
@@ -63,8 +82,7 @@
               (if DIR (write-file (string DIR "/" N) (P S D)) (println N))
               (inc P S))))))))
 
-;; clear the compiler index
-;; Drop the compile members from the index
+;; clear the compiler archive index, to be used for source archives
 (dolist (M (map first (archives))) (archives M nil))
 
 (when (or (!= 1 (length (clean null? OPTIONS)))