This stuff lets you write command-line tools in Lisp.
--- /dev/null
+### -*-makefile-*-
+###
+### $Id$
+###
+### Makefile for runlisp
+###
+### (c) 2006 Straylight/Edgeware
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This program is free software; you can redistribute it and/or modify
+### it under the terms of the GNU General Public License as published by
+### the Free Software Foundation; either version 2 of the License, or
+### (at your option) any later version.
+###
+### This program is distributed in the hope that it will be useful,
+### but WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+### GNU General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+prefix = /usr/local
+bindir = /usr/local/bin
+libdir = /usr/local/lib/runlisp
+
+CC = gcc
+CFLAGS = -O2 -g -Wall -pedantic
+LDFLAGS =
+
+all: \
+ runlisp-cmucl runlisp-cmucl.core \
+ runlisp-ecl \
+ runlisp-clisp runlisp-clisp.mem
+
+runlisp-cmucl: runlisp-cmucl.o
+ $(CC) $(LDFLAGS) -o $@ $^
+
+runlisp-cmucl.o: runlisp-helper.c
+ $(CC) -c -o $@ \
+ -DCMUCL \
+ -DLISP=\"/usr/bin/cmucl\" \
+ -DCORE=\"$(libdir)/runlisp-cmucl.core\" \
+ $<
+
+runlisp-clisp.o: runlisp-helper.c
+ $(CC) -c -o $@ \
+ -DCLISP \
+ -DLISP=\"/usr/lib/clisp/full/lisp.run\" \
+ -DCORE=\"$(libdir)/runlisp-clisp.mem\" \
+ $<
+
+build-cmucl.stamp: build.lisp runlisp.lisp
+ cmucl -noinit -load "$<"
+
+build-ecl.stamp: build.lisp runlisp.lisp
+ ecl -load "$<"
+
+build-clisp.stamp: build.lisp runlisp.lisp
+ clisp "$<"
+
+runlisp-cmucl.core: make-runlisp.lisp build-cmucl.stamp
+ cmucl -noinit -load "$<"
+
+runlisp-ecl: make-runlisp.lisp runlisp.lisp build-ecl.stamp
+ ecl -load "$<"
+
+runlisp-clisp.mem: make-runlisp.lisp runlisp.lisp build-clisp.stamp
+ clisp "$<"
+
+install: all
+ install -d $(DISTDIR)$(bindir)
+ install -d $(DISTDIR)$(libdir)
+ install -m644 \
+ runlisp-clisp.mem runlisp-cmucl.core \
+ $(DISTDIR)$(libdir)
+ install -m755 \
+ runlisp-cmucl runlisp-ecl runlisp-clisp \
+ $(DISTDIR)$(bindir)
+
+clean:
+ rm -f *.stamp \
+ runlisp-ecl runlisp-cmucl runlisp-clisp \
+ *.x86f *.fas *.lib *.o \
+ *.core *.mem
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+;;; -*-lisp-*-
+;;;
+;;; $Id$
+;;;
+;;; Build necessary things
+;;;
+;;; (c) 2006 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(handler-case
+ (flet ((compile-if-necessary (name)
+ (let* ((name (pathname name))
+ (args #+ecl '(:system-p t :c-file t)
+ #-ecl nil)
+ (object #+ecl (merge-pathnames (make-pathname :type "o")
+ name)
+ #-ecl (apply #'compile-file-pathname name args)))
+ (unless (and (probe-file object)
+ (< (file-write-date name)
+ (file-write-date object)))
+ (format t ";;; Compiling ~A -> ~A~%" name object)
+ (apply #'compile-file name args))
+ (load object :verbose t))))
+ (let ((stamp (make-pathname :directory (list :relative)
+ :name (format nil "build-~A"
+ #+cmu "cmucl"
+ #+clisp "clisp"
+ #+ecl "ecl")
+ :type "stamp")))
+ (ignore-errors (delete-file stamp))
+ (compile-if-necessary "runlisp.lisp")
+ (with-open-file (dummy stamp
+ :direction :output
+ :if-exists :overwrite
+ :if-does-not-exist :create)
+ (declare (ignorable dummy)))))
+ (error (cond)
+ (format *error-output* "Build failure: ~A.~%" cond)
+ (ext:quit 1)))
+(ext:quit 0)
+
+;;;----- That's all, folks --------------------------------------------------
--- /dev/null
+;;; -*-lisp-*-
+;;;
+;;; Build a runlisp image
+;;;
+;;; (c) 2006 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+#-ecl (load "runlisp" :verbose t)
+#+ecl (defpackage #:runlisp (:export #:run))
+
+;;; Build core file for CMU CL.
+#+cmu
+(save-lisp "runlisp-cmucl.core"
+ :load-init-file nil
+ :site-init nil
+ :print-herald nil
+ :process-command-line nil
+ :batch-mode t
+ :init-function (lambda ()
+ (if (runlisp:run) 0 127)))
+
+;;; Build mem file for CLISP.
+#+clisp
+(saveinitmem "runlisp-clisp.mem")
+
+;;; Build standalone binary for ECL.
+#+ecl
+(let ((fasl-skel #p"/var/cache/common-lisp-controller/0/ecl/thing.o"))
+ (c:build-program "runlisp-ecl"
+ :lisp-files
+ (append '("runlisp.o")
+ (mapcan
+ (lambda (thing)
+ (let ((comp (car thing)))
+ (mapcar (lambda (file)
+ (merge-pathnames
+ (make-pathname
+ :directory (list :relative comp)
+ :name file)
+ fasl-skel))
+ (cdr thing))))
+ '((#1="common-lisp-controller" #1#)
+ ("asdf" "asdf")
+ (#1# "post-sysdef-install"))))
+ :init-name "init_runlisp_boot"
+ :epilogue-code '(ext:quit (if (runlisp:run) 0 127))))
+
+;;; If we're not dead, die.
+(ext:quit 0)
+
+;;;----- That's all, folks --------------------------------------------------
--- /dev/null
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+
+#if defined(CMUCL)
+# define ARGS 3
+#elif defined(CLISP)
+# define ARGS 7
+#else
+# error "Which Lisp?"
+#endif
+
+int main(int argc, char *argv[])
+{
+ char **args = malloc((ARGS + argc) * sizeof(*args));
+ char *core, *lisp;
+ if ((lisp = getenv("RUNLISP_LISP")) == 0) lisp = LISP;
+ if ((core = getenv("RUNLISP_CORE")) == 0) core = CORE;
+ if (!args) { perror("alloc"); exit(127); }
+ args[0] = lisp;
+#if defined(CMUCL)
+ args[1] = "-core";
+ args[2] = core;
+#elif defined(CLISP)
+ args[1] = "-M";
+ args[2] = core;
+ args[3] = "-x";
+ args[4] = "(ext:quit (if (runlisp:run) 0 127))";
+ args[5] = "-q";
+ args[6] = "--";
+#endif
+ memcpy(args + ARGS, argv + 1, argc * sizeof(*args));
+ execv(args[0], args);
+ perror(argv[1]);
+ exit(127);
+}
--- /dev/null
+;;; -*-lisp-*-
+;;;
+;;; Portable command-line tools in Lisp
+;;;
+;;; (c) 2006 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;;; Package.
+(defpackage #:runlisp
+ (:use #:common-lisp)
+ (:export #:*lisp-interpreter* #:*command-line-strings* #:run))
+(in-package #:runlisp)
+
+;;; Variables.
+(defvar *lisp-interpreter*)
+(defvar *command-line-strings*)
+
+;;; Ignore shebang lines.
+(set-dispatch-macro-character #\# #\!
+ (lambda (stream bang arg)
+ (declare (ignore bang arg))
+ (read-line stream)
+ (values)))
+
+;;; Shut up, you bastard.
+#+cmu (setf ext:*gc-verbose* nil)
+(setf *compile-verbose* nil
+ *load-verbose* nil
+ *load-print* nil)
+
+;;; Find command-line arguments and run the program.
+(defun run ()
+ #+cmu (let ((args lisp::lisp-command-line-list))
+ (setf *lisp-interpreter* (pop args))
+ (assert (string= (pop args) "-core"))
+ (pop args)
+ (setf *command-line-strings* args))
+ #+ecl (setf *lisp-interpreter* (ext:argv 0)
+ *command-line-strings* (loop for i from 1 below (ext:argc)
+ collect (ext:argv i)))
+ #+clisp (let ((args (coerce (ext:argv) 'list)))
+ (setf *lisp-interpreter* (car args)
+ *command-line-strings* (nthcdr 7 args)))
+ (let ((*package* (find-package "COMMON-LISP-USER"))
+ (prog (car *command-line-strings*)))
+ (handler-case
+ (progn (load prog) t)
+ (error (cond)
+ (format *error-output* "~&~A: ~A~%" (pathname-name prog) cond)
+ nil))))
+
+
+;;;----- That's all, folks --------------------------------------------------
--- /dev/null
+#! /bin/false
+
+(format t "Hello, world!~%")
+(format t "Arguments: ~S~%" runlisp:*command-line-strings*)
+(format t "cl-user symbols: ~S~%"
+ (loop for s being the present-symbols of "CL-USER"
+ collect s))
+(format t "Packages: ~S~%"
+ (loop for p in (list-all-packages) collect (package-name p)))
~mdw / runlisp / commitdiff