X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-executable%2Fsb-executable.lisp;h=77740e009065e705603c9f2bc2cdab578d434cc3;hb=f25039178959a9b302b3399dd04a4d7ba492674d;hp=ee0d3eda80b901a07f3c5b2843e5811f38077e24;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/contrib/sb-executable/sb-executable.lisp b/contrib/sb-executable/sb-executable.lisp index ee0d3ed..77740e0 100644 --- a/contrib/sb-executable/sb-executable.lisp +++ b/contrib/sb-executable/sb-executable.lisp @@ -7,27 +7,38 @@ (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 -- -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+\"$@\"} +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)) (exit))\" --end-toplevel-options ${1+\"$@\"} ") (defun make-executable (output-file fasls &key (runtime-flags '("--disable-debugger" - "--userinit /dev/null" - "--sysinit /dev/null")) + "--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 @@ -45,6 +56,7 @@ exec sbcl --noinform ~{~A ~}--eval \"(with-open-file (i \\\"$0\\\" :element-type (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