projects
/
rrq
/
newlisp
/
packnl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Revised method for re-reading the executable as data.
[rrq/newlisp/packnl.git]
/
incore.lsp
diff --git
a/incore.lsp
b/incore.lsp
index 8f24187ef6b449daeaf2f27e404c40c80ed4aef4..658972a367292a3334169cc30d98507e80a189f8 100644
(file)
--- a/
incore.lsp
+++ b/
incore.lsp
@@
-22,14
+22,18
@@
;; This is a hashmap of loaded files
(new Tree 'archives)
;; This is a hashmap of loaded files
(new Tree 'archives)
-;; A copy of the executable
-(define core:core (read-file "/proc/self/exe"))
+;; A copy of the executable (file descriptor 3)
+(define core:core
+ (letn ((FD 3) (SZ (seek FD)) (BUFFER (dup "" SZ)))
+ (seek FD 0) (read FD BUFFER SZ) BUFFER))
+(map delete '(FD SZ BUFFER GNU GNU))
(context 'archive)
(context 'archive)
-
(setf main nil)
(setf main nil)
-
-(constant 'AR "/usr/bin/ar" 'TAR "/bin/tar" 'FILE "/usr/bin/file")
+(constant
+ 'AR "/usr/bin/ar"
+ 'TAR (exists file? '("/bin/tar" "/usr/bin/tar"))
+ 'FILE "/usr/bin/file" )
(define (tar-able PATH)
(when (file? FILE)
(define (tar-able PATH)
(when (file? FILE)
@@
-47,7
+51,7
@@
)))
;; Read a member of an external archive
)))
;; Read a member of an external archive
-(define (get-std
in
CMD)
+(define (get-std
out
CMD)
(let ((I (pipe)) (O (pipe)) (DATA "") (ALL "")
(SUB (fn (I O)
(map close (list (I 1) (O 0) 0))
(let ((I (pipe)) (O (pipe)) (DATA "") (ALL "")
(SUB (fn (I O)
(map close (list (I 1) (O 0) 0))
@@
-64,13
+68,13
@@
(define (get PATH MEMBER)
(if (list? PATH) ((PATH 0) (PATH 1) core)
(directory? PATH) (read-file (format "%s/%s" PATH MEMBER))
(define (get PATH MEMBER)
(if (list? PATH) ((PATH 0) (PATH 1) core)
(directory? PATH) (read-file (format "%s/%s" PATH MEMBER))
- (ends-with PATH ".a") (get-std
in
(format "%s p %s %s" AR PATH MEMBER))
- (tar-able PATH) (get-std
in
(format "%s xOf %s %s" TAR PATH MEMBER))
+ (ends-with PATH ".a") (get-std
out
(format "%s p %s %s" AR PATH MEMBER))
+ (tar-able PATH) (get-std
out
(format "%s xOf %s %s" TAR 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.
))
;; 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 3
91704
)
+(if (find (dup "x" 40) core nil 3
00000
)
(let ((P (+ $it 41))) ; skip marker and newline
(constant 'incore P)
(while (regex "([^\n]+)\n([^\n]+)\n" core 0 P)
(let ((P (+ $it 41))) ; skip marker and newline
(constant 'incore P)
(while (regex "([^\n]+)\n([^\n]+)\n" core 0 P)
@@
-85,17
+89,17
@@
(constant
'load
(constant
'load
- (letex ((LOAD load) (CTX '(
or (and (1 (args)) (args 1)
) MAIN)))
+ (letex ((LOAD load) (CTX '(
if (1 (args)) (args 1
) MAIN)))
(fn () (if (archives (args 0))
(eval-string (archive:get $it (args 0)) CTX)
(fn () (if (archives (args 0))
(eval-string (archive:get $it (args 0)) CTX)
- (LOAD (args 0)
CTX
))))
+ (LOAD (args 0)
(eval CTX)
))))
'read-file
'read-file
- (letex (
READ-FILE read-file
)
+ (letex (
(READ-FILE read-file) (CTX '(if (1 (args)) (args 1) MAIN))
)
(fn ()
(fn ()
- (if (archives (args 0)) (archive:get $it (args 0))
+ (if (archives (args 0)) (archive:get $it (args 0)
CTX
)
(READ-FILE (args 0)))))
'file?
(READ-FILE (args 0)))))
'file?
- (letex (
FILE? file?
)
+ (letex (
(FILE? file?)
)
(fn () (if (archives (args 0)) true (FILE? (args 0)))))
)
(fn () (if (archives (args 0)) true (FILE? (args 0)))))
)