| 1 | ### -*-sh-*- |
| 2 | ### |
| 3 | ### Auxiliary script for dumping ECL |
| 4 | ### |
| 5 | ### (c) 2020 Mark Wooding |
| 6 | ### |
| 7 | |
| 8 | ###----- Licensing notice --------------------------------------------------- |
| 9 | ### |
| 10 | ### This file is part of Runlisp, a tool for invoking Common Lisp scripts. |
| 11 | ### |
| 12 | ### Runlisp is free software: you can redistribute it and/or modify it |
| 13 | ### under the terms of the GNU General Public License as published by the |
| 14 | ### Free Software Foundation; either version 3 of the License, or (at your |
| 15 | ### option) any later version. |
| 16 | ### |
| 17 | ### Runlisp is distributed in the hope that it will be useful, but WITHOUT |
| 18 | ### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
| 19 | ### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
| 20 | ### for more details. |
| 21 | ### |
| 22 | ### You should have received a copy of the GNU General Public License |
| 23 | ### along with Runlisp. If not, see <https://www.gnu.org/licenses/>. |
| 24 | |
| 25 | set -e |
| 26 | |
| 27 | case $# in 4) ;; *) echo >&2 "usage: $0 IMAGE ECL ECLOPT TMP"; exit 2 ;; esac |
| 28 | image=$1 ecl=$2 eclopt=$3 tmp=$4 |
| 29 | |
| 30 | run () { echo "$*"; "$@"; } |
| 31 | |
| 32 | ## Start by compiling a copy of ASDF. |
| 33 | cat >"$tmp/ecl-build.lisp" <<EOF |
| 34 | (require "asdf") |
| 35 | |
| 36 | (defparameter *asdf* (asdf:find-system "asdf")) |
| 37 | |
| 38 | (defun right-here (pathname pattern) |
| 39 | (declare (ignore pattern)) |
| 40 | (merge-pathnames |
| 41 | (make-pathname :name (concatenate 'string |
| 42 | (string-downcase |
| 43 | (lisp-implementation-type)) |
| 44 | "-" |
| 45 | (pathname-name pathname)) |
| 46 | :type nil |
| 47 | :version nil |
| 48 | :defaults *default-pathname-defaults*) |
| 49 | pathname)) |
| 50 | (asdf:initialize-output-translations '(:output-translations |
| 51 | ((#p"/" :**/ :*.*.*) |
| 52 | (:function right-here)) |
| 53 | :ignore-inherited-configuration)) |
| 54 | |
| 55 | (asdf:operate 'asdf:lib-op *asdf*) |
| 56 | (si:quit 0) |
| 57 | EOF |
| 58 | (cd "$tmp" && run "$ecl" ${eclopt}norc ${eclopt}load "ecl-build.lisp") |
| 59 | |
| 60 | ## And now compile our driver code. |
| 61 | cat >"$tmp/ecl-run.lisp" <<EOF |
| 62 | (cl:defpackage #:runlisp |
| 63 | (:use #:common-lisp)) |
| 64 | (cl:in-package #:runlisp) |
| 65 | |
| 66 | (defun main () |
| 67 | $ignore_shebang_rune |
| 68 | (asdf:register-immutable-system "asdf") |
| 69 | (let ((pkg (find-package "COMMON-LISP-USER"))) |
| 70 | (with-package-iterator (next pkg :internal) |
| 71 | (loop (multiple-value-bind (anyp sym how) (next) |
| 72 | (declare (ignore how)) |
| 73 | (unless anyp (return)) |
| 74 | (unintern sym pkg))))) |
| 75 | $set_script_feature_rune |
| 76 | (let ((winning t) (script nil) (marker nil) |
| 77 | (prog (file-namestring (si:argv 0))) (i 1) (argc (si:argc))) |
| 78 | (labels ((lose (msg &rest args) |
| 79 | (format *error-output* "~&~A: ~?~%" prog msg args) |
| 80 | (setf winning nil)) |
| 81 | (quit (rc) |
| 82 | (si:quit rc)) |
| 83 | (usage (stream) |
| 84 | (format stream "~&usage: ~A -s SCRIPT -- ARGS~%" |
| 85 | prog)) |
| 86 | (getarg () |
| 87 | (and (< i argc) (prog1 (si:argv i) (incf i))))) |
| 88 | (loop (let ((arg (getarg))) |
| 89 | (cond ((null arg) (return)) |
| 90 | ((string= arg "--") (setf marker t) (return)) |
| 91 | ((string= arg "-s") (setf script (getarg))) |
| 92 | ((string= arg "-h") (usage *standard-output*) (quit 0)) |
| 93 | (t (lose "unrecognized option \`~A'" arg))))) |
| 94 | (unless script (lose "nothing to do")) |
| 95 | (unless marker (lose "unexpected end of options (missing \`--'?)")) |
| 96 | (unless winning (usage *error-output*) (quit 255)) |
| 97 | (handler-case |
| 98 | (let ((*package* (find-package "COMMON-LISP-USER"))) |
| 99 | (load script :verbose nil :print nil)) |
| 100 | (error (err) |
| 101 | (format *error-output* "~&~A (uncaught error): ~A~%" prog err) |
| 102 | (quit 255))) |
| 103 | (quit 0)))) |
| 104 | (main) |
| 105 | EOF |
| 106 | (cd "$tmp" && run "$ecl" ${eclopt}norc ${eclopt}load "ecl-asdf.fas" \ |
| 107 | -s -o "ecl-run.o" ${eclopt}compile "ecl-run.lisp") |
| 108 | |
| 109 | ## Finally link everything together. |
| 110 | run "$ecl" ${eclopt}norc -o "$image"\ |
| 111 | ${eclopt}link "$tmp/ecl-asdf.o" "$tmp/ecl-run.o" |
| 112 | |
| 113 | ###----- That's all, folks -------------------------------------------------- |