contrib/scriptoids

   1 From sbcl-devel-admin@lists.sourceforge.net Sun Jul 16 12:10:07 2000
   2 Received: from localhost (IDENT:newman@localhost.localdomain [127.0.0.1])
   3         by rootless.localdomain (8.9.3/8.9.3) with ESMTP id MAA07245
   4         for <newman@localhost>; Sun, 16 Jul 2000 12:10:05 -0500 (CDT)
   5 Received: from mail.airmail.net
   6         by localhost with POP3 (fetchmail-5.1.1)
   7         for newman@localhost (single-drop); Sun, 16 Jul 2000 12:10:06 -0500 (CDT)
   8 Received: from lists.sourceforge.net from [198.186.203.35] by mail.airmail.net
   9         (/\##/\ Smail3.1.30.16 #30.438) with esmtp for <william.newman@airmail.net> sender: <sbcl-devel-admin@lists.sourceforge.net>
  10         id <mn/13DanY-000GXOn@mail.airmail.net>; Sat, 15 Jul 2000 17:52:40 -0500 (CDT)
  11 Received: from mail1.sourceforge.net (localhost [127.0.0.1])
  12         by lists.sourceforge.net (8.9.3/8.9.3) with ESMTP id PAA03497;
  13         Sat, 15 Jul 2000 15:52:33 -0700
  14 Received: from tninkpad.telent.net (detached.demon.co.uk [194.222.13.128])
  15         by lists.sourceforge.net (8.9.3/8.9.3) with ESMTP id PAA03477
  16         for <sbcl-devel@lists.sourceforge.net>; Sat, 15 Jul 2000 15:52:28 -0700
  17 Received: from dan by tninkpad.telent.net with local (Exim 3.12 #1 (Debian))
  18         id 13Daly-0002eu-00; Sat, 15 Jul 2000 23:51:02 +0100
  19 To: sbcl-devel@lists.sourceforge.net
  20 From: Daniel Barlow <dan@telent.net>
  21 Date: 15 Jul 2000 23:51:02 +0100
  22 Message-ID: <87og3zvwh5.fsf@tninkpad.telent.net>
  23 User-Agent: Gnus/5.0803 (Gnus v5.8.3) Emacs/20.7
  24 MIME-Version: 1.0
  25 Content-Type: multipart/mixed; boundary="=-=-="
  26 Subject: [Sbcl-devel] LINK-SYSTEM - "How big is a `hello world' program in SBCL?"
  27 Sender: sbcl-devel-admin@lists.sourceforge.net
  28 Errors-To: sbcl-devel-admin@lists.sourceforge.net
  29 X-Mailman-Version: 1.1
  30 Precedence: bulk
  31 List-Id:  <sbcl-devel.lists.sourceforge.net>
  32 X-BeenThere: sbcl-devel@lists.sourceforge.net
  33 X-Airmail-Delivered: Sat, 15 Jul 2000 17:52:40 -0500 (CDT)
  34 X-Airmail-Spooled:   Sat, 15 Jul 2000 17:52:40 -0500 (CDT)
  35 Status: RO
  36 Content-Length: 8179
  37 Lines: 80
  38
  39 --=-=-=
  40
  41
  42 1103 bytes.  :-)
  43
  44 The problem I wanted to solve here is that of making sbcl programs
  45 that run from the command line and look superficially like normal unix
  46 executables (in, say, the same way as shell scripts or Perl programs
  47 do).  The programs in question are expected to run on a system with
  48 sbcl installed (there's a core file, and a runtime, etc) but have to
  49 share the same core file and not each dump their own.  Disk may be
  50 cheap but it's not _that_ cheap ...
  51
  52 This is achieved using shell #! magic and concatenation of fasl files.
  53
  54 STANDALONEIZE-FILE, given a collection of x86f files, makes a single
  55 file that can be run from the shell prompt.  The file consists of
  56 the concatenation of all the x86f files, appended to #! magic which
  57 invokes sbcl on them.
  58
  59 LINK-SYSTEM operates with mk-defsystem (get it from CLOCC) to build a similar
  60 file from a system definition.  It currently breaks if the system has
  61 non-Lisp components (e.g. db-sockets, which loads .so objects)
  62
  63
  64 Here's how you use it:
  65
  66     :; cat hello.lisp
  67     (in-package :cl-user)
  68
  69     (format t "hello world ~%")
  70     (quit)
  71
  72     :; sbcl --noinform --core testcore.core --eval '(progn (compile-file "hello.lisp") (standaloneize:standaloneize-file "hello" "hello.x86f") (quit))'
  73     compiling "/home/dan/src/telent/lisploader/hello.lisp" (written 15 JUL 2000 10:27:45 PM):
  74
  75     byte compiling top-level form:
  76     byte compiling top-level form:
  77     byte compiling top-level form:
  78
  79     hello.x86f written
  80     compilation finished in 0:00:00
  81
  82     :; ls -l hello
  83     -rwxr-xr-x    1 dan      dan          1103 Jul 15 22:43 hello
  84
  85     :; time ./hello
  86     hello world
  87
  88     real    0m0.116s
  89     user    0m0.040s
  90     sys     0m0.060s
  91
  92 It also understands search paths ...
  93
  94     :; cp hello ~/bin
  95     :; type hello
  96     hello is /home/dan/bin/hello
  97     :; hello
  98     hello world
  99
 100 So how about that?  1k executables and 1/10th second startup times.
 101 It helps that I already have another instance of sbcl open, of course :-)
 102
 103 The whole thing is only about 5k, so I enclose it here as an
 104 attachment.  Build instructions are in the comment at the top.  You
 105 have to dump a core file with it compiled in, but the point is that
 106 you only have to do so once per sbcl, not once per application.
 107
 108 I hope this will (eventually, anyway) encourage use of SBCL by people
 109 wanting to solve "scripting" problems.  The unix shell may be ugly,
 110 but it's not going away any time soon, so it helps if we play nice
 111 with it.
 112
 113
 114 --=-=-=
 115 Content-Disposition: attachment; filename=heuristic-fasload.lisp
 116
 117 (eval-when (:compile-toplevel :load-toplevel)
 118   (defpackage "STANDALONEIZE"
 119     (:use :sb-alien :sb-c-call :common-lisp)
 120     (:export standaloneize-file)))
 121 (in-package :standaloneize)
 122
 123 ;;;; Functions useful for making sbcl do sensible stuff with #!
 124 ;;;; (STANDALONEIZE-FILE output-file input-files) gloms the input files
 125 ;;;; together and sticks shell magic on top.   FIND-AND-LOAD-FASL and its
 126 ;;;; supporting functions are called when the file is executed
 127
 128 ;;;; How to use it.  Compile this file.  Load it into a fresh SBCL image.
 129 ;;;; Dump a core file.  Use that core file.
 130
 131 (defun find-fasl-in-stream (stream)
 132    "Search forwards in STREAM for a line starting with the value of sb-c:*fasl-header-string-start-string*.  Leave the stream at the offset of the start of that line, and return the offset"
 133   (let ((fasl-cookie sb-c:*fasl-header-string-start-string*))
 134     (loop for position = (file-position stream)
 135           for text = (read-line stream)
 136           ;;do (format t "~A ~A ~A ~%" position text fasl-cookie)
 137           if (and text
 138                     (>= (length (the simple-string text))
 139                         (length fasl-cookie))
 140                     (string= text fasl-cookie :end1 (length fasl-cookie)))
 141           return (progn (file-position stream position) position))))
 142
 143
 144 ;;; This courtesy of Pierre Mai in comp.lang.lisp 08 Jan 1999 00:51:44 +0100
 145 ;;; Message-ID: <87lnjebq0f.fsf@orion.dent.isdn.cs.tu-berlin.de>
 146
 147 (defun split (string &optional max (ws '(#\Space #\Tab)))
 148   "Split `string' along whitespace as defined by the sequence `ws'.
 149 The whitespace is elided from the result.  The whole string will be
 150 split, unless `max' is a non-negative integer, in which case the
 151 string will be split into `max' tokens at most, the last one
 152 containing the whole rest of the given `string', if any."
 153   (flet ((is-ws (char) (find char ws)))
 154     (loop for start = (position-if-not #'is-ws string)
 155           then (position-if-not #'is-ws string :start index)
 156           for index = (and start
 157                            (if (and max (= (1+ word-count) max))
 158                                nil
 159                              (position-if #'is-ws string :start start)))
 160           while start
 161           collect (subseq string start index)
 162           count 1 into word-count
 163           while index)))
 164
 165 (defun find-name-on-path (name)
 166   (let* ((search-string (or (sb-ext:posix-getenv "PATH")
 167                             ":/bin:/usr/bin"))
 168          (search-list (split search-string nil '(#\:))))
 169     (or
 170      (loop for p in search-list
 171            for directory = (merge-pathnames (make-pathname :directory p))
 172            if (probe-file (merge-pathnames name directory))
 173            return (merge-pathnames name directory))
 174      name)))
 175
 176 (defun find-and-load-fasl (name)
 177   "Attempt to find and load a FASL file from NAME.  FASL data in the file may be preceded by any number of lines of arbitrary text.  If NAME contains no directory portion, it is searched for on the system path in a manner similar to that of execvp(3)"
 178   (let ((path
 179          (if (pathname-directory name)
 180              name
 181            (find-name-on-path name))))
 182     (with-open-file (i path :direction :input)
 183       (find-fasl-in-stream i)
 184       (sb-impl::fasload i nil nil))))
 185
 186 ;;;; and now some functions for more easily creating these scuffed fasl files
 187
 188 (defun copy-stream (from to)
 189   "Copy into TO from FROM until end of file, without translating or otherwise mauling anything"
 190   (let ((buf (make-array 4096 :element-type (stream-element-type from)
 191                          :initial-element #\Space)))
 192     (do ((pos (read-sequence buf from)  (read-sequence buf from)))
 193         ((= 0 pos) nil)
 194       (write-sequence buf to :end pos))))
 195
 196 (defparameter *standalone-magic*
 197   "#!/bin/sh
 198 exec /usr/local/bin/sbcl --core testcore.core --noinform --noprint  --eval \"(standaloneize::find-and-load-fasl \\\"$0\\\")\" $*
 199 "
 200   "This text is prepended to the output file created by STANDALONEIZE-FILE")
 201
 202 ;;; this syscall seems to have been removed from SBCL.
 203 (def-alien-routine chmod int (path c-string) (mode int))
 204
 205 (defun standaloneize-file (output-filename &rest objects)
 206   "Make a standalone executable(sic) called OUTPUT-FILENAME out of OBJECTS, through the magic of hash bang."
 207   (with-open-file (out output-filename :direction :output)
 208     (write-sequence *standalone-magic* out)
 209     (dolist (obj objects)
 210       (with-open-file (in obj)
 211         (copy-stream in out))))
 212   (chmod (namestring output-filename) #o755))
 213
 214 ;;;; Another way of doing it would be to create a "link" operation for
 215 ;;;; systems defined with mk-defsystem -
 216
 217 #+mk-defsystem
 218 (defun print-binary-file-operation (component force)
 219   "Spit the binary file associated with COMPONENT to *STANDARD-OUTPUT*"
 220   (with-open-file (i (compile-file-pathname
 221                       (make::component-pathname component :binary))
 222                      :direction :input)
 223     (copy-stream i *standard-output*))
 224   nil)
 225
 226 #+mk-defsystem
 227 (defun link-system (system output-file)
 228   "Create a single executable file from all the files in SYSTEM"
 229   (make::component-operation 'print-binary 'print-binary-file-operation)
 230   (with-open-file (o output-file :direction :output
 231                      :if-exists :rename)
 232     (write-sequence *standalone-magic* o)
 233     (let ((*standard-output* o))
 234       (make::operate-on-system  system 'print-binary))))
 235
 236
 237 --=-=-=
 238
 239
 240
 241 -dan
 242
 243 --
 244   http://ww.telent.net/cliki/ - CLiki: CL/Unix free software link farm
 245
 246 --=-=-=--
 247
 248 _______________________________________________
 249 Sbcl-devel mailing list
 250 Sbcl-devel@lists.sourceforge.net
 251 http://lists.sourceforge.net/mailman/listinfo/sbcl-devel
 252