+;; This code is intended for an embedded binary with an "archive" of
+;; files appended to it. The appended archive is marked by a array of
+;; 40 "x", and consists by archive elements the format of
+;; "pathname\nsize\nbytes[size]".
+;;
+;; When there is an in-core archive, then the first member will be
+;; invoked as "main script".
+;;
+;; archives:archives is a hashmap for loadable files
+;; core:core is the running binary file
+;; archive:main is the name of the first on-core member
+;; archive:incore is the byte position into core for the archive
+
+(new Tree 'archives)
+
+(define core:core (read-file (main-args 0)))
+
+(context 'archive)
+
+(setf main nil)
+
+(constant 'AR "/usr/bin/ar")
+
+(define (archive:archive PATH)
+ ;;(write-line 2 (string (list 'archive PATH)))
+ (map (fn (F) (archives F PATH) F)
+ (exec (format "%s t %s" AR PATH))))
+
+(define (get-ar PATH MEMBER)
+ ;;(write-line 2 (string (list 'get-ar PATH MEMBER)))
+ (let ((I (pipe)) (O (pipe)) (DATA "") (ALL "")
+ (SUB (fn (I O)
+ (close (I 1)) (close (O 0)) (close 0)
+ (process (format "%s p %s %s" AR PATH MEMBER) (I 0) (O 1)))))
+ (fork (SUB I O))
+ (close (O 1)) (close (I 0)) (close (I 1))
+ (while (> (or (read (O 0) DATA 1000000) 0)) (extend ALL DATA))
+ (close (I 0))
+ ALL))
+
+(define (get PATH MEMBER)
+ (if (list? PATH) ((PATH 0) (PATH 1) core)
+ (ends-with PATH ".a") (get-ar PATH MEMBER)))
+
+;; Discover and load an in-core archive by means of a marker row of 40
+;; "x", and then a series of pathname\nsize\nbytes[size] members.
+(if (find (dup "x" 40) core nil 391704)
+ (let ((P (+ $it 41))) ; skip marker and newline
+ (constant 'incore P)
+ (while (regex "([^\n]+)\n([^\n]+)\n" core 0 P)
+ (let ((N $1) (S (int $2)) (L (length $0)))
+ (inc P L)
+ (unless main (setf main N))
+ (archives N (list P S))
+ (inc P S))))
+ (write-line 2 (string "not packed")))
+
+(context MAIN)
+
+(constant
+ 'load
+ (letex (LOAD load)
+ (fn () (if (archives (args 0))
+ (eval-string (archive:get $it (args 0)) MAIN)
+ (LOAD (args 0)))))
+ 'read-file
+ (letex (READ-FILE read-file)
+ (fn ()
+ (if (archives (args 0)) (archive:get $it (args 0))
+ (READ-FILE (args 0)))))
+ 'file?
+ (letex (FILE? file?)
+ (fn () (if (archives (args 0)) true (FILE? (args 0)))))
+ )
+
+(when archive:main (load archive:main) (exit 0))