;;;----- Licensing notice ---------------------------------------------------
;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(cl:defpackage #:optparse
- (:use #:common-lisp #:cl-launch #:sod-utilities))
+ (:use #:common-lisp #:sod-utilities))
(cl:in-package #:optparse)
(defun exit (&optional (code 0) &key abrupt)
"End program, returning CODE to the caller."
(declare (type (unsigned-byte 32) code))
- #+sbcl (sb-ext:exit :code code :abort abrupt)
- #+cmu (if abrupt
- (unix::void-syscall ("_exit" c-call:int) code)
- (ext:quit code))
- #+clisp (funcall (if abrupt #'ext:quit #'ext:exit) code)
- #+ecl (ext:quit code)
-
- #-(or sbcl cmu clisp ecl)
- (progn
- (unless (zerop code)
- (format *error-output*
- "~&Exiting unsuccessfully with code ~D.~%" code))
- (abort)))
+ #.(car '(#+sbcl (sb-ext:exit :code code :abort abrupt)
+ #+cmu (if abrupt
+ (unix::void-syscall ("_exit" c-call:int) code)
+ (ext:quit code))
+ #+clisp (funcall (if abrupt #'ext:quit #'ext:exit) code)
+ #+ecl (ext:quit code)
+ (unless (zerop code)
+ (format *error-output*
+ "~&Exiting unsuccessfully with code ~D.~%" code))))
+ (abort))
(export '(*program-name* *command-line*))
(defvar *program-name* "<unknown>"
Set `*command-line*' and `*program-name*'."
(setf *command-line*
- (cons (or (getenv "CL_LAUNCH_FILE")
- #+sbcl (car sb-ext:*posix-argv*)
- #+cmu (car ext:*command-line-strings*)
- #+clisp (aref (ext:argv) 0)
- #+ecl (ext:argv 0)
- #-(or sbcl cmu clisp ecl) "sod")
- *arguments*)
-
- *program-name* (pathname-name (car *command-line*))))
+ (let ((uiop-package (find-package :uiop))
+ (cll-package (find-package :cl-launch)))
+ (cons (or (and uiop-package
+ (funcall (intern "ARGV0" uiop-package)))
+ (and cll-package
+ (some (intern "GETENV" cll-package)
+ (list "__CL_ARGV0" "CL_LAUNCH_FILE")))
+ #+sbcl (car sb-ext:*posix-argv*)
+ #+cmu (car ext:*command-line-strings*)
+ #+clisp (aref (ext:argv) 0)
+ #+ecl (ext:argv 0)
+ "sod")
+ (cond (uiop-package
+ (funcall (intern "COMMAND-LINE-ARGUMENTS"
+ uiop-package)))
+ (cll-package
+ (symbol-value (intern "*ARGUMENTS*" cll-package)))
+ (t #.(or (car '(#+sbcl (cdr sb-ext:*posix-argv*)
+ #+cmu (cdr ext:*command-line-strings*)
+ #+clisp (coerce (subseq (ext:argv) 8)
+ 'list)
+ #+ecl (loop for i from 1
+ below (ext:argc)
+ collect (ext:argv i))))
+ (error "Unsupported Lisp."))))))
+
+ *program-name* (pathname-name (car *command-line*))))
;;;--------------------------------------------------------------------------
;;; Fancy conditionals.