1 ;; This code is intended for an embedded binary with an "archive" of
2 ;; files appended to it. The appended archive is marked by a array of
3 ;; 40 "x", and consists by archive elements the format of
4 ;; "pathname\nsize\nbytes[size]".
6 ;; When there is an in-core archive, then the first member will be
7 ;; invoked as "main script".
9 ;; archives:archives is a hashmap for loadable files
10 ;; core:core is the running binary file
12 ;; The "archive" context holds utility code.
13 ;; archive:main is the name of the first in-core member.
14 ;; archive:incore is the byte position into core for the archive.
16 ;; Use (archives member pathname) to register that the file "member"
17 ;; should be looked up in the ar style archive of the given pathname.
19 ;; Use (archive pathname) to register all members of the nominated ar
24 (define core:core (read-file "/proc/self/exe"))
30 (constant 'AR "/usr/bin/ar")
32 (define (archive:archive PATH)
33 ;;(write-line 2 (string (list 'archive PATH)))
34 (map (fn (F) (archives F PATH) F)
35 (exec (format "%s t %s" AR PATH))))
37 (define (get-ar PATH MEMBER)
38 ;;(write-line 2 (string (list 'get-ar PATH MEMBER)))
39 (let ((I (pipe)) (O (pipe)) (DATA "") (ALL "")
41 (close (I 1)) (close (O 0)) (close 0)
42 (process (format "%s p %s %s" AR PATH MEMBER) (I 0) (O 1)))))
44 (close (O 1)) (close (I 0)) (close (I 1))
45 (while (> (or (read (O 0) DATA 1000000) 0)) (extend ALL DATA))
49 (define (get PATH MEMBER)
50 (if (list? PATH) ((PATH 0) (PATH 1) core)
51 (ends-with PATH ".a") (get-ar PATH MEMBER)))
53 ;; Discover and load an in-core archive by means of a marker row of 40
54 ;; "x", and then a series of pathname\nsize\nbytes[size] members.
55 (if (find (dup "x" 40) core nil 391704)
56 (let ((P (+ $it 41))) ; skip marker and newline
58 (while (regex "([^\n]+)\n([^\n]+)\n" core 0 P)
59 (let ((N $1) (S (int $2)) (L (length $0)))
61 (unless main (setf main N))
62 (archives N (list P S))
64 (write-line 2 (string "not packed")))
71 (fn () (if (archives (args 0))
72 (eval-string (archive:get $it (args 0)) MAIN)
75 (letex (READ-FILE read-file)
77 (if (archives (args 0)) (archive:get $it (args 0))
78 (READ-FILE (args 0)))))
81 (fn () (if (archives (args 0)) true (FILE? (args 0)))))
84 (when archive:main (load archive:main) (exit 0))