X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/blobdiff_plain/d6caa73bc6253f7a0461406a939865a207bad7c8..5a64d91b912d7794a9aa56ac781d04029a94a405:/sys-base.lisp diff --git a/sys-base.lisp b/sys-base.lisp index e973e90..359da3f 100644 --- a/sys-base.lisp +++ b/sys-base.lisp @@ -25,17 +25,37 @@ (defpackage #:runlisp (:use #:common-lisp) - (:export #:*lisp-interpreter* #:*command-line-strings* #:run) - #+cmu (:import-from #:ext #:*command-line-strings*)) -(defvar runlisp:*command-line-strings* '("")) - + (:export #:*raw-command-line* #:*command-line* #:exit) + #+clisp (:import-from #:ext #:exit)) (defpackage #:mdw.sys-base (:use #:common-lisp #:runlisp) - (:export #:exit #:hard-exit #:*program-name* #:*command-line-strings*) - (:import-from #:runlisp #:*lisp-interpreter* #:*command-line-strings*) - #+clisp (:import-from #:ext #:exit)) + (:export #:exit #:hard-exit #:*program-name* #:*command-line*) + (:import-from #:runlisp #:*raw-command-line* #:*command-line* #:exit)) (in-package #:mdw.sys-base) +(defvar *raw-command-line* + (or #+cmu ext:*command-line-strings* + #+sbcl sb-ext:*posix-argv* + #+ecl (loop from i below (ext:argc) collect (ext:argv i)) + #+clisp (coerce (ext:argv) 'list) + '("" "--" ""))) + +(defvar *command-line* + (or (cdr (member "--" *raw-command-line* :test #'string=)) + *raw-command-line*)) + +#-clisp +(unless (fboundp 'exit) + (defun exit (&optional (code 0)) + "Polite way to end a program." + #+(or cmu ecl) (ext:quit code) + #+sbcl (sb-ext:quit :unix-status code) + #-(or cmu ecl sbcl) + (progn + (unless (zerop code) + (format t "~&Exiting unsuccessfully with code ~D.~%" code)) + (abort)))) + (defun hard-exit (&optional (code 0)) "Stops the program immediately in its tracks. Does nothing else. Use after fork, for example, to avoid flushing buffers." @@ -44,20 +64,8 @@ #+sbcl (sb-ext:quit :unix-status code :recklessly-p t) #+(or clisp ecl) (ext:quit code)) -#-clisp -(defun exit (&optional (code 0)) - "Polite way to end a program. If running in an interactive Lisp, just - return to the top-level REPL." - (if (boundp '*lisp-interpreter*) - #+(or cmu ecl) (ext:quit code) - #+sbcl (sb-ext:quit :unix-status code) - (progn - (unless (zerop code) - (format t "~&Exiting unsuccessfully with code ~D.~%" code)) - (abort)))) - (defvar *program-name* - (pathname-name (car *command-line-strings*)) + (pathname-name (car *command-line*)) "A plausible guess at the program's name, stripped of strange extensions.") ;;;----- That's all, folks --------------------------------------------------