1 (cl:defpackage
:sb-executable
2 (:use
:cl
:sb-ext
:sb-alien
)
3 (:export
:make-executable
:copy-stream
)
4 ;; (what else should we be exporting?)
7 (cl:in-package
:sb-executable
)
9 (defvar *stream-buffer-size
* 8192)
10 (defun copy-stream (from to
)
11 "Copy into TO from FROM until end of the input stream, in blocks of
12 *stream-buffer-size*. The streams should have the same element type."
13 (unless (subtypep (stream-element-type to
) (stream-element-type from
))
14 (error "Incompatible streams ~A and ~A." from to
))
15 (let ((buf (make-array *stream-buffer-size
*
16 :element-type
(stream-element-type from
))))
18 (let ((pos (read-sequence buf from
)))
19 (when (zerop pos
) (return))
20 (write-sequence buf to
:end pos
)))))
24 exec sbcl --noinform ~{~A ~}--eval \"(with-open-file (i \\\"$0\\\" :element-type '(unsigned-byte 8)) (loop while (< ret 2) when (= (read-byte i) 10) count 1 into ret) (load i) (funcall (quote ~A)) (quit))\" --end-toplevel-options ${1+\"$@\"}
27 (defun make-executable (output-file fasls
28 &key
(runtime-flags '("--disable-debugger"
29 "--userinit /dev/null"
30 "--sysinit /dev/null"))
32 "Write an executable called OUTPUT-FILE which can be run from the shell, by 'linking' together code from FASLS. Actually works by concatenating them and prepending a #! header"
33 (with-open-file (out output-file
36 :element-type
'(unsigned-byte 8))
37 (write-sequence (map 'vector
#'char-code
38 (format nil
*exec-header
* runtime-flags
39 (or initial-function
'values
))) out
)
40 (dolist (input-file (if (listp fasls
) fasls
(list fasls
)))
41 (with-open-file (in (merge-pathnames input-file
42 (make-pathname :type
"fasl"))
43 :element-type
'(unsigned-byte 8))
44 (copy-stream in out
))))
45 (let* (;; FIXME: use OUT as the pathname designator
46 (out-name (namestring (translate-logical-pathname output-file
)))
47 (prot (elt (multiple-value-list (sb-unix:unix-stat out-name
)) 3)))
49 (sb-unix::void-syscall
("chmod" c-string int
)
52 (if (logand prot
#o400
) #o100
)
53 (if (logand prot
#o40
) #o10
)
54 (if (logand prot
#o4
) #o1
)))
55 (error "stat() call failed"))))
57 (provide 'sb-executable
)