/[cmucl]/src/code/commandline.lisp
ViewVC logotype

Contents of /src/code/commandline.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.27 - (hide annotations)
Tue May 31 13:26:40 2011 UTC (2 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: GIT-CONVERSION, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, HEAD
Changes since 1.26: +5 -1 lines
Add -unidata option to specify unidata.bin file.

This change requires a cross-compile.  Use boot-2011-04-01-cross.lisp
as the cross-compile script.

bootfiles/20b/boot-2011-04-01-cross.lisp:
o New cross-compile bootstrap file

lisp/lisp.c:
o Recognize -unidata option and setup *UNIDATA-PATH* appropriately.

code/commandline.lisp:
o Add defswitch for unidata so we don't get complaints about unknown
  switch.

code/unidata.lisp:
o Rename +UNIDATA-PATH+ to *UNIDATA-PATH*, since it's not a constant
  anymore.
o Update code to use new name.

code/print.lisp:
o Update code to use *UNIDATA-PATH*

compiler/sparc/parms.lisp:
o Add *UNIDATA-PATH* to list of static symbols.
o Add back in spare-9 and spare-8 static symbols since we need to do a
  cross-compile for this change anyway.

compiler/x86/parms.lisp:
o Add *UNIDATA-PATH* to list of static symbols.
o Reorder the static symbols in a more logical arrangment so that the
  spare symbols are at the end.

i18n/local/cmucl.pot:
o Update
1 ram 1.1 ;;; -*- Mode: Lisp; Package: Extensions; Log: code.log -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.2 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;;
7     (ext:file-comment
8 rtoy 1.27 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/commandline.lisp,v 1.27 2011/05/31 13:26:40 rtoy Exp $")
9 ram 1.2 ;;;
10 ram 1.1 ;;; **********************************************************************
11     ;;;
12     ;;; Stuff to eat the command line passed to us from the shell.
13     ;;; Written by Bill Chiles.
14     ;;;
15    
16     (in-package "EXTENSIONS")
17 rtoy 1.18
18     (intl:textdomain "cmucl")
19    
20 rtoy 1.17 (export '(*command-line-application-arguments* *command-line-words* *command-line-switches*
21 ram 1.1 *command-switch-demons* *command-line-utility-name*
22 phg 1.4 *command-line-strings* *batch-mode*
23     cmd-switch-string command-line-switch-p
24 ram 1.1 cmd-switch-name cmd-switch-value cmd-switch-words command-line-switch
25     defswitch cmd-switch-arg get-command-line-switch))
26    
27 rtoy 1.17 (defvar *command-line-application-arguments* ()
28 rtoy 1.19 "A list of all the command line arguments after --")
29 rtoy 1.17
30 ram 1.1 (defvar *command-line-switches* ()
31 rtoy 1.19 "A list of cmd-switch's representing the arguments used to invoke
32 ram 1.1 this process.")
33    
34     (defvar *command-line-utility-name* ""
35 rtoy 1.19 "The string name that was used to invoke this process.")
36 ram 1.1
37     (defvar *command-line-words* ()
38 rtoy 1.19 "A list of words between the utility name and the first switch.")
39 ram 1.1
40     (defvar *command-line-strings* ()
41 rtoy 1.19 "A list of strings obtained from the command line that invoked this process.")
42 ram 1.1
43     (defvar *command-switch-demons* ()
44 rtoy 1.19 "An Alist of (\"argument-name\" . demon-function)")
45 ram 1.1
46 phg 1.4 (defvar *batch-mode* nil
47 rtoy 1.19 "When True runs lisp with its input coming from standard-input.
48 rtoy 1.22 If an error is detected returns error code 1, otherwise 0.")
49 ram 1.1
50     (defstruct (command-line-switch (:conc-name cmd-switch-)
51     (:constructor make-cmd-switch
52     (name value words))
53     (:print-function print-command-line-switch))
54     name ;the name of the switch
55     value ;the value of that switch
56     words ;random words dangling between switches assigned to the
57     ;preceeding switch
58     )
59    
60     (defun print-command-line-switch (object stream n)
61     (declare (ignore n))
62     (write-string "#<Command Line Switch " stream)
63     (prin1 (cmd-switch-name object) stream)
64     (let ((value (cmd-switch-value object))
65     (words (cmd-switch-words object)))
66     (when (or value words) (write-string " -- " stream)
67     (when value (prin1 value stream))
68     (when words (prin1 words stream))))
69     (write-string ">" stream))
70    
71    
72    
73     ;;;; Processing the command strings.
74    
75     (defun process-command-strings ()
76     (setq *command-line-words* nil)
77     (setq *command-line-switches* nil)
78     (let ((cmd-strings lisp::lisp-command-line-list)
79     str)
80     (declare (special lisp::lisp-command-line-list))
81     ;; Set some initial variables.
82     ;;
83     (setf *command-line-strings* (copy-list lisp::lisp-command-line-list))
84     (setf *command-line-utility-name* (pop cmd-strings))
85     (setq str (pop cmd-strings))
86     ;; Set initial command line words.
87     ;;
88     (loop
89     (unless str (return nil))
90     (unless (zerop (length (the simple-string str)))
91     (when (char= (schar str 0) #\-)
92     (setq *command-line-words* (reverse *command-line-words*))
93     (return nil))
94     (push str *command-line-words*))
95     (setq str (pop cmd-strings)))
96 rtoy 1.26
97     (when (string= str "--")
98     ;; Handle the special case where -- is the first option. The
99     ;; code below interprets that incorrectly and I (rtoy) don't
100     ;; want to mess with that, so just set up
101     ;; *command-line-application-arguments* and return.
102     (setf *command-line-application-arguments* cmd-strings)
103     (return-from process-command-strings nil))
104    
105 ram 1.1 ;; Set command line switches.
106     ;;
107     (loop
108     (unless str
109     (return (setf *command-line-switches*
110     (nreverse *command-line-switches*))))
111     (let* ((position (position #\= (the simple-string str) :test #'char=))
112     (switch (subseq (the simple-string str) 1 position))
113     (value (if position
114     (subseq (the simple-string str) (1+ position)
115     (length (the simple-string str))))))
116     (setq str (pop cmd-strings))
117 phg 1.4 ;; Set this switch's words until the next switch.
118 ram 1.1 ;;
119     (let (word-list)
120     (loop
121     (unless str
122     (push (make-cmd-switch switch value (nreverse word-list))
123     *command-line-switches*)
124     (return nil))
125 rtoy 1.17
126 ram 1.1 (unless (zerop (length (the simple-string str)))
127     (when (char= #\- (schar str 0))
128     (push (make-cmd-switch switch value (nreverse word-list))
129     *command-line-switches*)
130 rtoy 1.17 (when (and (= (length str) 2)
131     (char= #\- (schar str 1)))
132     ;; Gather up everything after --, and exit.
133     (setf *command-line-application-arguments* cmd-strings)
134     (setf str nil))
135 ram 1.1 (return nil))
136     (push str word-list))
137     (setq str (pop cmd-strings))))))))
138    
139     (defun get-command-line-switch (sname)
140 rtoy 1.22 "Accepts the name of a switch as a string and returns the value of
141     the switch. If no value was specified, then any following words are
142     returned. If there are no following words, then t is returned. If
143     the switch was not specified, then nil is returned."
144 ram 1.1 (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname))
145     (switch (find name *command-line-switches*
146     :test #'string-equal
147     :key #'cmd-switch-name)))
148     (when switch
149     (or (cmd-switch-value switch)
150     (cmd-switch-words switch)
151     T))))
152    
153    
154    
155     ;;;; Defining Switches and invoking demons.
156    
157     (defvar *complain-about-illegal-switches* t
158 rtoy 1.22 "When set, invoking switch demons complains about illegal switches
159     that have not been defined with DEFSWITCH.")
160 ram 1.1
161 rtoy 1.21 ;;; This is a list of lists consisting of the legal switch names,
162     ;;; switch description, and argument description. The description and
163     ;;; argument description can be NIL. (Should probably do something
164     ;;; better, but this is good enough for the little bit of processing
165     ;;; that we need.) DEFSWITCH sets this, and INVOKE-SWITCH-DEMONS
166     ;;; makes sure all the switches it sees are on this list.
167 ram 1.1 ;;;
168     (defvar *legal-cmd-line-switches* nil)
169    
170     ;;; INVOKE-SWITCH-DEMONS cdrs down the list of *command-line-switches*. For
171     ;;; each switch, it checks to see if there is a switch demon with the same
172     ;;; name. If there is, then that demon is called as a function on the switch.
173     ;;;
174     (defun invoke-switch-demons (&optional (switches *command-line-switches*)
175     (demons *command-switch-demons*))
176 rtoy 1.21 (flet ((invoke-demon (switch)
177     (let* ((name (cmd-switch-name switch))
178     (demon (cdr (assoc name demons :test #'string-equal))))
179     (cond (demon (funcall demon switch))
180     ((or (member name *legal-cmd-line-switches* :test #'string-equal :key #'car)
181     (not *complain-about-illegal-switches*)))
182     (t (warn (intl:gettext "~S is an illegal switch") switch)))
183     (lisp::finish-standard-output-streams))))
184     ;; We want to process -help (or --help) first, if it's given.
185     ;; Since we're asking for help, we don't want to process any of
186     ;; the other switches.
187     (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string-equal)
188     (find "-help" switches :key #'cmd-switch-name :test #'string-equal))))
189     (if maybe-help
190     (invoke-demon maybe-help)
191     (dolist (switch switches t)
192     (invoke-demon switch))))))
193 ram 1.1
194 rtoy 1.21 (defmacro defswitch (name &optional function docstring arg-name)
195 rtoy 1.22 "Associates function with the switch name in
196     *command-switch-demons*. Name is a simple-string that does not
197     begin with a hyphen, unless the switch name really does begin with
198     one. Function is optional, but defining the switch is necessary to
199     keep invoking switch demons from complaining about illegal switches.
200     This can be inhibited with *complain-about-illegal-switches*.
201    
202     The optional arguments, arg-name and docstring, are used by -help to
203     describe the switch. Arg-name is a string naming the argument (if
204     any) for the switch. Docstring describe the switch."
205 ram 1.1 (let ((gname (gensym))
206     (gfunction (gensym)))
207 rtoy 1.23 (when docstring
208     (intl::note-translatable intl::*default-domain* docstring))
209     (when arg-name
210     (intl::note-translatable intl::*default-domain* arg-name))
211 ram 1.1 `(let ((,gname ,name)
212     (,gfunction ,function))
213     (check-type ,gname simple-string)
214 rtoy 1.20 (check-type ,gfunction (or symbol function) (intl:gettext "a symbol or function"))
215 rtoy 1.23 (push (list ,gname ,docstring ,arg-name) *legal-cmd-line-switches*)
216 ram 1.1 (when ,gfunction
217     (push (cons ,gname ,gfunction) *command-switch-demons*)))))
218    
219    
220     (defun eval-switch-demon (switch)
221 dtc 1.7 (let ((cmds (cmd-switch-arg switch)))
222     (do ((length (length cmds))
223     (start 0))
224     ((>= start length))
225     (multiple-value-bind (form next)
226     (read-from-string cmds nil nil :start start)
227     (eval form)
228     (lisp::finish-standard-output-streams)
229     (setf start next)))))
230 rtoy 1.21
231     ;; Docstrings should have lines longer than 72 characters so that we
232     ;; can print out the docstrings nicely on one line for help.
233     ;; | <-- char 72
234     (defswitch "eval" #'eval-switch-demon
235     "Evaluate the specified Lisp expression during the start up
236     sequence. the value of the form will not be printed unless it is
237     wrapped in a form that does output."
238     "expression")
239 ram 1.1
240     (defun load-switch-demon (switch)
241     (load (cmd-switch-arg switch)))
242 rtoy 1.21
243     (defswitch "load" #'load-switch-demon
244     "Loads the specified file into Lisp before entering Lisp's
245     read-eval-print loop."
246     "filename")
247 ram 1.1
248     (defun cmd-switch-arg (switch)
249     (or (cmd-switch-value switch)
250     (car (cmd-switch-words switch))
251     (car *command-line-words*)))
252    
253 rtoy 1.21 (defswitch "core" nil
254     "Specifies the suspended Lisp image ('core' file) to start up"
255     "corefile")
256    
257     (defswitch "init" nil
258     "Specifies the name of a file containing user customizations that is
259     to be loaded each time Lisp starts up (default ~/init or
260     ~/.cmucl-init.lisp). The loader loads any existing compiled binary
261     or the lisp source if none."
262     "filename")
263    
264     (defswitch "noinit" nil
265     "Suppresses loading of the init file and also prevents -edit from
266     loading the Hemlock init file.")
267    
268     (defswitch "nositeinit" nil
269     "Suppresses loading of the site-init site specific initialization
270     file.")
271    
272     (defswitch "hinit" nil
273     "Specifies the name of the Hemlock init file (default ~/hemlock-init
274     or ~/.hemlock-init), which is loaded only when Hemlock is started."
275     "filename")
276    
277     (defswitch "batch" nil
278     "Causes Lisp to run in batch mode where all input is directed from
279     standard-input. A unix return code of 0 is returned upon
280     encountering an EOF, while any unhandled error condition will cause
281     an immediate exit with a return code of 1, instead of entering the
282     debugger.")
283    
284     (defswitch "dynamic-space-size" nil
285     "Specifies the number of megabytes that should be allocated to the
286     heap. If not specified, a platform- specific default is used. The
287     actual maximum allowed heap size is platform-specific."
288     "megabytes")
289    
290     (defswitch "lib" nil
291     "A colon-separated list of directories to be used for the library:
292     search-list."
293     "libpath")
294    
295     (defswitch "quiet" nil
296     "Causes Lisp to start up silently, disabling printing of the herald
297     and causing most unnecessary noise, like GC messages,load messages,
298     etc. to be suppressed.")
299    
300     (defswitch "debug-lisp-search" nil
301     "Enables printing of messages indication how CMUCL is searching for
302     its default core file.")
303    
304 rtoy 1.27 (defswitch "unidata" nil
305     "Specify the unidata.bin file to be used."
306     "filename")
307    
308 rtoy 1.16 #+x86
309 rtoy 1.25 (intl:with-textdomain ("cmucl" "cmucl-x86-vm")
310 rtoy 1.21 (defswitch "fpu" nil
311     "Specifies what kind of floating-point support should be used on x86
312     systems. If 'x87', Lisp will use the x87 floating-point unit; if
313     'sse2', Lisp uses SSE2 floating-point unit. The default is
314     'auto',which causes Lisp to check to see if SSE2 is available. If
315     so, then SSE2 is used. If the SSE2 core file cannot be found,Lisp
316     will fallback to the x87 core, which can run on any machine."
317 rtoy 1.25 "mode"))
318 rtoy 1.21
319     (defun help-switch-demon (switch)
320     (declare (ignore switch))
321 rtoy 1.24 (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*)
322 rtoy 1.21 (dolist (s (sort *legal-cmd-line-switches* #'string<
323     :key #'car))
324     (destructuring-bind (name doc arg)
325     s
326 rtoy 1.24 (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg)))
327 rtoy 1.21 ;; Poor man's formatting of the help string
328 rtoy 1.23 (with-input-from-string (stream (intl:gettext doc))
329 rtoy 1.21 (loop for line = (read-line stream nil nil)
330     while line
331     do (format t "~8T~A~%" line)))))
332     (ext:quit))
333    
334     (defswitch "help" #'help-switch-demon
335     "Print out the command line options and exit")
336    
337     (defswitch "-help" #'help-switch-demon
338     "Same as -help.")

  ViewVC Help
Powered by ViewVC 1.1.5