It seems that `cl-launch' doesn't set CL_LAUNCH_FILE when doing `-X',
which is rather inconvenient. Stuff using `mdw.sys-base' wins because
(massive cheat) ASDF systems are loaded before the program name is
stripped off the front of the argument list; we don't get that luxury
here. So `*load-pathname*' will have to do; take `pathname-name' to
strip away the unpleasant realities of FASL-caching.
Of course, if we're dumping images then CL_LAUNCH_FILE is set properly.
<sigh>
(iterate-fringe (parse-tree b))))))))
#+cl-launch
(iterate-fringe (parse-tree b))))))))
#+cl-launch
-(defun launch ()
- (flet ((bail (format args)
- (format *error-output* "~A: ~?~%"
- (cl-launch:getenv "CL_LAUNCH_FILE") format args)
- (cl-launch:quit 1)))
- (handler-case
- (main cl-launch:*arguments*)
- (simple-error (err)
- (bail (simple-condition-format-control err)
- (simple-condition-format-arguments err)))
- (error (err)
- (bail "~A" err)))))
+(progn
+ (defparameter *program-name*
+ (pathname-name (or (cl-launch:getenv "CL_LAUNCH_FILE")
+ (namestring *load-pathname*)
+ "<unknown>")))
+ (defun launch ()
+ (flet ((bail (format args)
+ (format *error-output* "~A: ~?~%" *program-name* format args)
+ (cl-launch:quit 1)))
+ (handler-case
+ (main cl-launch:*arguments*)
+ (simple-error (err)
+ (bail (simple-condition-format-control err)
+ (simple-condition-format-arguments err)))
+ (error (err)
+ (bail "~A" err))))))
;;;----- That's all, folks --------------------------------------------------
;;;----- That's all, folks --------------------------------------------------