(cl:in-package :sb-executable)
(defvar *stream-buffer-size* 8192)
-(defun copy-stream (from to)
+(defun copy-stream (from to &key (element-type (stream-element-type from) element-type-passed-p))
"Copy into TO from FROM until end of the input stream, in blocks of
-*stream-buffer-size*. The streams should have the same element type."
- (unless (subtypep (stream-element-type to) (stream-element-type from))
- (error "Incompatible streams ~A and ~A." from to))
+*stream-buffer-size*. The streams should have the same element type.
+
+The argument :element-type indicates the element type of the
+buffer used to copy data from FROM to TO.
+
+If one of the streams has an element type that is different from
+what (stream-element-type stream) reports, that is, if it was
+opened with :element-type :default, the argument :element-type is
+required in order to select the correct stream decoding/encoding
+strategy."
+ (unless (or element-type-passed-p
+ (subtypep (stream-element-type to) element-type))
+ (error "Incompatible streams ~A and ~A:" from to))
(let ((buf (make-array *stream-buffer-size*
- :element-type (stream-element-type from))))
+ :element-type element-type)))
(loop
- (let ((pos (read-sequence buf from)))
- (when (zerop pos) (return))
- (write-sequence buf to :end pos)))))
+ (let ((pos (read-sequence buf from)))
+ (when (zerop pos) (return))
+ (write-sequence buf to :end pos)))))
+
(defvar *exec-header*
"#!/bin/sh --
")
(defun make-executable (output-file fasls
- &key (runtime-flags '("--disable-debugger"
- "--userinit /dev/null"
- "--sysinit /dev/null"))
- initial-function)
+ &key (runtime-flags '("--disable-debugger"
+ "--no-userinit"
+ "--no-sysinit"))
+ initial-function)
"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"
- (with-open-file (out output-file :direction :output
- :element-type '(unsigned-byte 8))
+ (with-open-file (out output-file
+ :direction :output
+ :if-exists :supersede
+ :element-type '(unsigned-byte 8))
(write-sequence (map 'vector #'char-code
- (format nil *exec-header* runtime-flags
- (or initial-function 'values))) out)
+ (format nil *exec-header* runtime-flags
+ (or initial-function 'values))) out)
(dolist (input-file (if (listp fasls) fasls (list fasls)))
(with-open-file (in (merge-pathnames input-file
- (make-pathname :type "fasl"))
- :element-type '(unsigned-byte 8))
- (copy-stream in out))))
- (let* ((out-name (namestring output-file))
- (prot (elt (multiple-value-list (sb-unix:unix-stat out-name)) 3)))
- (sb-unix::void-syscall ("chmod" c-string int)
- out-name
- (logior prot
- (if (logand prot #o400) #o100)
- (if (logand prot #o40) #o10)
- (if (logand prot #o4) #o1)))))
-
-
\ No newline at end of file
+ (make-pathname :type "fasl"))
+ :element-type '(unsigned-byte 8))
+ (copy-stream in out))))
+ (let* (;; FIXME: use OUT as the pathname designator
+ (out-name (namestring (translate-logical-pathname output-file)))
+ (prot (elt (multiple-value-list (sb-unix:unix-stat out-name)) 3)))
+ #-win32
+ (if prot
+ (sb-unix::void-syscall ("chmod" c-string int)
+ out-name
+ (logior prot
+ (if (logand prot #o400) #o100)
+ (if (logand prot #o40) #o10)
+ (if (logand prot #o4) #o1)))
+ (error "stat() call failed"))))
+
+(provide 'sb-executable)