Создание исполняемых файлов в SBCL

Нам понадобится два файла.

Первый, это шелл-скрипт `lc' следующего содержания:

#!/bin/sh
sbcl --noinform            \
     --sysinit /dev/null   \
     --userinit /dev/null  \
     --load "compile.lisp" \
     $@

Второй, это файл `compile.lisp':

;;;; That is a wrapper file used in `lc' script when compiler build image for
;;;; file(s? at this time - just for one file that can require another files/systems).

;;;; It also possible to rebuild this program using this program again
;;;; (and don't use the shell script).

(defpackage   #:lc-user
  (:use       #:common-lisp
              #:sb-sys
              #:sb-ext)
  (:export    #:continue-if-only
              #:with-quit
              #:global-speed-extreme-optimize
              #:main
              #:@main
              #:program-name))

(in-package #:lc-user)

;;;; stuff that can be used in compiled file

(defmacro continue-if-only (thing error-string &rest error-arguments)
  `(unless ,thing
     (format *stderr* ,error-string ,@error-arguments)
     (quit)))

(defmacro with-quit (&body body)
  `(unwind-protect
       (progn ,@body)
     (quit)))

(defmacro global-speed-extreme-optimize (&optional (speed 3))
  `(proclaim '(optimize (speed ,speed)
                        (safety 0)
                        (debug 0)
                        (compilation-speed 0)
                        (space 0))))

;;;; default enrty point

(defmacro main (arguments early-forms &body body)
  `(defun @main ()
     ,@early-forms
     (destructuring-bind (program-name ,@arguments)
                         (mapcar #'read-from-string *posix-argv*)
       (declare (ignorable program-name))
       ,@body)))

;;;; compiling

(defparameter *usage-string*
  "Usage: lc [file] [:compile] [:load] [:gc] [:image].~%")

(let ((file (second *posix-argv*))
      (options (rest (rest *posix-argv*))))
  (continue-if-only file *usage-string*)
  (continue-if-only (probe-file file) "No such file ~A~%" file)
  (let (load-or-compile-p)
    (loop :for option :in options
          :do (ecase (read-from-string option)
                (:compile  (compile-file file)
                           (setf load-or-compile-p t))
                (:load     (load file)
                           (setf load-or-compile-p t))
                (:gc       (gc :full t))
                (:image    (continue-if-only (fboundp 'main)
                             "SUBJECT file must contain the MAIN function.~%")
                           (save-lisp-and-die (format nil "~A.bin" file)
                                              :purify t
                                              :executable t
                                              :toplevel '@main))))
    (continue-if-only load-or-compile-p *usage-string*)))

В качестве теста возьмём файл `pidigits.lisp' с http://shootout.alioth.debian.org/:

;; The Computer Language Shootout
;; http://shootout.alioth.debian.org/
;;
;; adapted from the Java and Python versions by Robert Brown 2006-10-06

(global-speed-extreme-optimize)

(defconstant +digits-per-line+ 10)
(deftype digit () '(integer 0 9))

(declaim (ftype (function () function) make-digit-generator)
         (inline make-digit-generator))
(defun make-digit-generator ()
  (let ((zq 1) (zr 0) (zt 1) (k 0) (4k+2 2) (2k+1 1))
    (declare (type integer zq zr zt)
             (type fixnum k 4k+2 2k+1))
    (flet ((extract (j)
             (the digit (floor (+ (* zq j) zr) zt)))
           (compose (aq ar at bq br bt)
             (setq zq (* aq bq)
                   zr (+ (* aq br) (* ar bt))
                   zt (* at bt))))
      #'(lambda ()
          (let ((y (extract 3)))
            (declare (type digit y))
            (loop :while (not (= y (extract 4)))
                  :do (compose zq zr zt (incf k) (incf 4k+2 4) (incf 2k+1 2))
                      (setf y (extract 3)))
            (compose 10 (* -10 y) 1 zq zr zt)
            y)))))

(main (digits)
    ()
  (let ((digits-printed 0)
        (next-digit (make-digit-generator)))
    (declare (type fixnum digits digits-printed)
             (type function next-digit))
    (loop :while (plusp digits)
          :do (if (>= digits +digits-per-line+)
                  (progn (loop :repeat +digits-per-line+
                               :do (format t "~d" (funcall next-digit)))
                         (incf digits-printed +digits-per-line+))
                  (progn (loop :repeat digits
                               :do (format t "~d" (funcall next-digit)))
                         (loop :repeat (- +digits-per-line+ digits)
                               :do (format t " "))
                         (incf digits-printed digits)))
              (format t "~a:~d~%" #\Tab digits-printed)
              (decf digits +digits-per-line+))))

И соберём независимый исполнимый файл для этой программы. Тут нужно заметить, digits в (main (digits) ...) это параметр с которым вызывается программа из коммандой строки.

  ./lc pidigits.lisp :load :image
  [undoing binding stack and other enclosing state... done]
  [saving current Lisp image into pidigits.lisp.bin:
  writing 3512 bytes from the read-only space at 0x01000000
  writing 2256 bytes from the static space at 0x01100000
  writing 27541504 bytes from the dynamic space at 0x09000000
  done]

Далее программа (размером ~27 mb, к сожалению) может быть перенесана на любой хост без поддержки CL (но с совсместимой ОС и архетектурой):

  ./pidigits.lisp.bin 100
  3141592653	:10
  5897932384	:20
  6264338327	:30
  9502884197	:40
  1693993751	:50
  0582097494	:60
  4592307816	:70
  4062862089	:80
  9862803482	:90
  5342117067	:100