contrib/sb-executable/sb-executable.lisp

   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?)
   5   )
   6
   7 (cl:in-package :sb-executable)
   8
   9 (defvar *stream-buffer-size* 8192)
  10 (defun copy-stream (from to &key (element-type (stream-element-type from) element-type-passed-p))
  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
  14 The argument :element-type indicates the element type of the
  15 buffer used to copy data from FROM to TO.
  16
  17 If one of the streams has an element type that is different from
  18 what (stream-element-type stream) reports, that is, if it was
  19 opened with :element-type :default, the argument :element-type is
  20 required in order to select the correct stream decoding/encoding
  21 strategy."
  22   (unless (or element-type-passed-p
  23               (subtypep (stream-element-type to) element-type))
  24     (error "Incompatible streams ~A and ~A:" from to))
  25   (let ((buf (make-array *stream-buffer-size*
  26                          :element-type element-type)))
  27     (loop
  28       (let ((pos (read-sequence buf from)))
  29         (when (zerop pos) (return))
  30         (write-sequence buf to :end pos)))))
  31
  32
  33 (defvar *exec-header*
  34   "#!/bin/sh --
  35 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+\"$@\"}
  36 ")
  37
  38 (defun make-executable (output-file fasls
  39                         &key (runtime-flags '("--disable-debugger"
  40                                               "--no-userinit"
  41                                               "--no-sysinit"))
  42                         initial-function)
  43   "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"
  44   (with-open-file (out output-file
  45                        :direction :output
  46                        :if-exists :supersede
  47                        :element-type '(unsigned-byte 8))
  48     (write-sequence (map 'vector #'char-code
  49                          (format nil *exec-header* runtime-flags
  50                                  (or initial-function 'values))) out)
  51     (dolist (input-file (if (listp fasls) fasls (list fasls)))
  52       (with-open-file (in (merge-pathnames input-file
  53                                            (make-pathname :type "fasl"))
  54                           :element-type '(unsigned-byte 8))
  55         (copy-stream in out))))
  56   (let* (;; FIXME: use OUT as the pathname designator
  57          (out-name (namestring (translate-logical-pathname output-file)))
  58          (prot (elt (multiple-value-list (sb-unix:unix-stat out-name)) 3)))
  59     #-win32
  60     (if prot
  61         (sb-unix::void-syscall ("chmod" c-string int)
  62                                out-name
  63                                (logior prot
  64                                        (if (logand prot #o400) #o100)
  65                                        (if (logand prot  #o40)  #o10)
  66                                        (if (logand prot   #o4)   #o1)))
  67         (error "stat() call failed"))))
  68
  69 (provide 'sb-executable)