From c8f068d2e91316f9cf7021764672505b10ec0cff Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Wed, 24 May 2006 17:16:20 +0100 Subject: [PATCH] Fresh import. This stuff lets you write command-line tools in Lisp. --- Makefile | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ build.lisp | 58 +++++++++++++++++++++++++++++++++++ make-runlisp.lisp | 67 +++++++++++++++++++++++++++++++++++++++++ runlisp-helper.c | 37 +++++++++++++++++++++++ runlisp.lisp | 69 ++++++++++++++++++++++++++++++++++++++++++ test.lisp | 9 ++++++ 6 files changed, 330 insertions(+) create mode 100644 Makefile create mode 100644 build.lisp create mode 100644 make-runlisp.lisp create mode 100644 runlisp-helper.c create mode 100644 runlisp.lisp create mode 100644 test.lisp diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..50e8dc8 --- /dev/null +++ b/Makefile @@ -0,0 +1,90 @@ +### -*-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 -------------------------------------------------- diff --git a/build.lisp b/build.lisp new file mode 100644 index 0000000..c3aa2cb --- /dev/null +++ b/build.lisp @@ -0,0 +1,58 @@ +;;; -*-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 -------------------------------------------------- diff --git a/make-runlisp.lisp b/make-runlisp.lisp new file mode 100644 index 0000000..ae90abf --- /dev/null +++ b/make-runlisp.lisp @@ -0,0 +1,67 @@ +;;; -*-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 -------------------------------------------------- diff --git a/runlisp-helper.c b/runlisp-helper.c new file mode 100644 index 0000000..71e44a0 --- /dev/null +++ b/runlisp-helper.c @@ -0,0 +1,37 @@ +#include +#include +#include +#include + +#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); +} diff --git a/runlisp.lisp b/runlisp.lisp new file mode 100644 index 0000000..13b8031 --- /dev/null +++ b/runlisp.lisp @@ -0,0 +1,69 @@ +;;; -*-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 -------------------------------------------------- diff --git a/test.lisp b/test.lisp new file mode 100644 index 0000000..096e387 --- /dev/null +++ b/test.lisp @@ -0,0 +1,9 @@ +#! /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))) -- 2.11.0