Регистрация | Войти
Lisp — программируемый язык программирования

Создание исполняемых файлов в 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
@2009-2013 lisper.ru