mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-16 06:12:25 -08:00
New routines for processing command line options
This commit is contained in:
jjgarcia
parent
bd6e9940f2
commit
c3f436f2e3
4 changed files with 132 additions and 91 deletions
|
|
@ -11,6 +11,14 @@ ECL 0.9h
|
|||
- New hash routine, similar to SBCL's one, faster and leading to fewer
|
||||
collisions between similar strings.
|
||||
|
||||
* Visible changes:
|
||||
|
||||
- The code for handling command line options has been redesigned. Now multiple
|
||||
-compile options are allowed; the -o/-c/-h/-data options have to come before
|
||||
the associated -compile; we introduce a new -rc option to force loading
|
||||
initialization files; errors during initialization are intercepted and cause
|
||||
ECL to abort.
|
||||
|
||||
;;; Local Variables: ***
|
||||
;;; mode:text ***
|
||||
;;; fill-column:79 ***
|
||||
|
|
|
|||
120
src/lsp/cmdline.lsp
Normal file
120
src/lsp/cmdline.lsp
Normal file
|
|
@ -0,0 +1,120 @@
|
|||
;;;; command-line.lsp -- command line processing
|
||||
;;;;
|
||||
;;;; Copyright (c) 2005, Juan Jose Garcia-Ripoll
|
||||
;;;;
|
||||
;;;; This program is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Library General Public
|
||||
;;;; License as published by the Free Software Foundation; either
|
||||
;;;; version 2 of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; See file '../Copyright' for full details.
|
||||
;;;;
|
||||
|
||||
(in-package "SYSTEM")
|
||||
|
||||
(export '(*lisp-init-file-list* command-args))
|
||||
|
||||
(defvar *lisp-init-file-list* '("~/.ecl" "~/.eclrc")
|
||||
"List of files automatically loaded when ECL is invoked.")
|
||||
|
||||
(defun command-args ()
|
||||
"Returns the command line arguments as list"
|
||||
(loop for i from 0 below (argc)
|
||||
collect (argv i)))
|
||||
|
||||
(defun help-message (stream)
|
||||
"Prints a help message about command line arguments of ECL"
|
||||
(princ "
|
||||
Usage: ecl [-? | --help]
|
||||
[-dir dir] [-load file] [-shell file] [-eval expr] [-rc | -norc]
|
||||
[[-o ofile] [-c [cfile]] [-h [hfile]] [-data [datafile]] [-s] [-q]
|
||||
-compile file]
|
||||
|
||||
"
|
||||
stream))
|
||||
|
||||
(defun command-arg-error (str &rest fmt-args)
|
||||
;; Format an error message and quit
|
||||
(declare (si::c-local))
|
||||
(apply #'format *error-output* str fmt-args)
|
||||
(help-message *error-output*)
|
||||
(quit 1))
|
||||
|
||||
(defconstant +command-arg-rules+
|
||||
'(("--help" 0 #0=(progn (help-message *standard-output*) (quit)))
|
||||
("-?" 0 #0#)
|
||||
("-eval" 1 (eval (read-from-string 1)))
|
||||
("-shell" 1 (progn (setq quit 0) (load 1 :verbose nil)))
|
||||
("-load" 1 (load 1 :verbose verbose))
|
||||
("-dir" 1 (setf (logical-pathname-translations "SYS")
|
||||
`(("**;*.*" ,(merge-pathnames "**/*.*" (truename 1))))))
|
||||
("-compile" 1
|
||||
(progn
|
||||
(setq quit
|
||||
(if (nth-value 3
|
||||
(compile-file 1 :output-file output-file :c-file c-file
|
||||
:h-file h-file :data-file data-file
|
||||
:verbose verbose :system-p system-p))
|
||||
1
|
||||
0)
|
||||
output-file t
|
||||
c-file nil
|
||||
h-file nil
|
||||
data-file nil
|
||||
system-p nil)))
|
||||
("-o" 1 (setq output-file 1))
|
||||
("-c" 1 (setq c-file 1))
|
||||
("-h" 1 (setq h-file 1))
|
||||
("-data" 1 (setq data-file 1))
|
||||
("-q" 0 (setq verbose nil))
|
||||
("-s" 1 (setq system-p t))))
|
||||
|
||||
(defun produce-init-code (option-list)
|
||||
(declare (si::c-local))
|
||||
(do* ((commands '())
|
||||
(loadrc t))
|
||||
((null option-list)
|
||||
(values `(let ((output-file t)
|
||||
(c-file nil)
|
||||
(h-file nil)
|
||||
(data-file nil)
|
||||
(verbose t)
|
||||
(system-p nil)
|
||||
(quit nil))
|
||||
,@(nreverse commands)
|
||||
(when quit (quit 0)))
|
||||
loadrc))
|
||||
(let* ((option (pop option-list))
|
||||
(rule (assoc option +command-arg-rules+ :test #'string=)))
|
||||
(cond ((string= option "-rc")
|
||||
(setq loadrc t))
|
||||
((string= option "-norc")
|
||||
(setq loadrc nil))
|
||||
((string= option "--")
|
||||
(setf option-list nil))
|
||||
((null rule)
|
||||
(command-arg-error "Unknown command line option ~A.~%" option))
|
||||
(t
|
||||
(let ((pattern (third rule)))
|
||||
(unless (zerop (second rule))
|
||||
(when (null option-list)
|
||||
(command-arg-error
|
||||
"Missing argument after command line option ~A.~%"
|
||||
option))
|
||||
(nsubst (pop option-list) 1 pattern))
|
||||
(push pattern commands)))))))
|
||||
|
||||
(defun process-command-args (&optional (args (rest (command-args))))
|
||||
(multiple-value-bind (commands loadrc)
|
||||
(produce-init-code args)
|
||||
(handler-case
|
||||
(progn
|
||||
(when loadrc
|
||||
(dolist (file *lisp-init-file-list*)
|
||||
(when (load file :if-does-not-exist nil :search-list nil :verbose nil)
|
||||
(return))))
|
||||
(eval commands))
|
||||
(error (c)
|
||||
(format *error-output*
|
||||
"An error occurred during initialization:~%~A.~%" c)
|
||||
(quit 1)))))
|
||||
|
|
@ -38,6 +38,7 @@
|
|||
"src:lsp;tk-init.lsp"
|
||||
"build:lsp;config.lsp"
|
||||
"src:lsp;module.lsp"
|
||||
"src:lsp;cmdline.lsp"
|
||||
"src:lsp;top.lsp"
|
||||
#+threads
|
||||
"src:lsp;mp.lsp"
|
||||
|
|
|
|||
|
|
@ -19,10 +19,7 @@
|
|||
(in-package "SYSTEM")
|
||||
|
||||
(export '(*break-readtable* *break-on-warnings* *break-enable*
|
||||
*lisp-init-file-list* *tpl-evalhook*))
|
||||
|
||||
(defvar *lisp-init-file-list* '("~/.ecl" "~/.eclrc")
|
||||
"List of files automatically loaded when ECL is invoked.")
|
||||
*tpl-evalhook*))
|
||||
|
||||
(defvar *quit-tag* (cons nil nil))
|
||||
(defvar *quit-tags* nil)
|
||||
|
|
@ -335,91 +332,6 @@ value of this variable is non-NIL.")
|
|||
)
|
||||
)
|
||||
|
||||
(eval-when (compile eval)
|
||||
(defmacro notinline (form)
|
||||
`(locally (declare (notinline ,(car form)))
|
||||
,form)))
|
||||
|
||||
(defun process-command-args (&aux (load-rc t) (commands nil) (quit nil))
|
||||
#-ecl-min
|
||||
(do ((load-rc t)
|
||||
(commands nil)
|
||||
(quit nil)
|
||||
(stop-processing nil)
|
||||
(i 1 (1+ i))
|
||||
(argc (argc)))
|
||||
((or (>= i argc)
|
||||
stop-processing)
|
||||
(when load-rc
|
||||
(dolist (file *lisp-init-file-list*)
|
||||
(when (load file :if-does-not-exist nil :search-list nil :verbose nil)
|
||||
(return))))
|
||||
(eval `(progn ,@(nreverse commands)))
|
||||
(when quit (quit))
|
||||
)
|
||||
(labels
|
||||
((get-argument (n k default)
|
||||
(do ((j (1+ n) (1+ j))
|
||||
(argc (argc)))
|
||||
((>= j argc) default)
|
||||
(when (string= k (argv j))
|
||||
(incf j)
|
||||
(return
|
||||
(or (= j argc)
|
||||
(eql (schar (argv j) 0) #\-)
|
||||
(let ((arg (argv j)))
|
||||
(if (string-equal "nil" arg)
|
||||
NIL
|
||||
(or (string-equal "t" arg) arg))))))))
|
||||
(help-message (stream)
|
||||
(princ "Usage: ecl [-? | --help]
|
||||
[-dir dir] [-load file] [-shell file] [-eval expr] [-norc]
|
||||
[-compile file [-o ofile] [-c [cfile]] [-h [hfile]]
|
||||
[-data [datafile]] [-s] [-q]]
|
||||
"
|
||||
stream))
|
||||
(pop-arg (option)
|
||||
(when (= (incf i) argc)
|
||||
(format *error-output* "Missing argument to command line option ~A.~%" option)
|
||||
(help-message *error-output*)
|
||||
(quit 1))
|
||||
(argv i)))
|
||||
(let ((option (argv i)))
|
||||
(cond
|
||||
((string= "-dir" option)
|
||||
(setf (logical-pathname-translations "SYS")
|
||||
`(("**;*.*" ,(merge-pathnames "**/*.*" (truename (pop-arg "-dir")))))))
|
||||
((string= "-compile" option)
|
||||
(if (nth-value 3
|
||||
(compile-file
|
||||
(pop-arg "-compile")
|
||||
:output-file (get-argument i "-o" T)
|
||||
:c-file (get-argument i "-c" NIL)
|
||||
:h-file (get-argument i "-h" NIL)
|
||||
:data-file (get-argument i "-data" NIL)
|
||||
:verbose (not (get-argument i "-q" NIL))
|
||||
:system-p (get-argument i "-s" NIL)))
|
||||
(quit 1)
|
||||
(quit 0)))
|
||||
((string= "-load" option)
|
||||
(push `(load ,(pop-arg "-load") :verbose t) commands))
|
||||
((string= "-shell" option)
|
||||
(push `(load ,(pop-arg "-shell") :verbose nil) commands)
|
||||
(setf quit t load-rc nil))
|
||||
((string= "-eval" option)
|
||||
(push (read-from-string (pop-arg "-eval")) commands))
|
||||
((string= "-norc" option)
|
||||
(setf load-rc nil))
|
||||
((or (string= "-?" option) (string= "--help" option))
|
||||
(help-message t)
|
||||
(quit 0))
|
||||
((string= "--" option)
|
||||
(setq stop-processing t))
|
||||
(t
|
||||
(format *error-output* "Unknown command line option ~A.~%" option)
|
||||
(help-message *error-output*)
|
||||
(quit 1)))))))
|
||||
|
||||
(defvar *lisp-initialized* nil)
|
||||
|
||||
(defun top-level ()
|
||||
|
|
@ -436,7 +348,7 @@ file. When the saved image is invoked, it will start the redefined top-level."
|
|||
(catch *quit-tag*
|
||||
(let ((*break-enable* nil))
|
||||
;; process command arguments
|
||||
(notinline (process-command-args))))
|
||||
(process-command-args)))
|
||||
|
||||
(format t "ECL (Embeddable Common-Lisp) ~A" (lisp-implementation-version))
|
||||
(format t "~%Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya~@
|
||||
|
|
@ -484,7 +396,7 @@ file. When the saved image is invoked, it will start the redefined top-level."
|
|||
(reset-stack-limits))
|
||||
(when (catch *quit-tag*
|
||||
(tpl-prompt)
|
||||
(setq - (notinline (tpl-read)))
|
||||
(setq - (locally (declare (notinline tpl-read)) (tpl-read)))
|
||||
(setq values
|
||||
(multiple-value-list
|
||||
(eval-with-env - *break-env*)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue