From cc1f30efe1c7438bfe6a413f16145ba2d63f7fe2 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Wed, 27 Sep 2000 13:25:20 +0000 Subject: [PATCH] cleanup related to RAW's port of RUN-PROGRAM: comment fixes resurrected SB-UNIX:UNIX-DUP, SB-UNIX:UNIX-IOCTL, and SB-UNIX:UNIX-PIPE from old cmucl-2.4.8 sources (They'd been deleted before 'cause nothing used them, but now RUN-PROGRAM uses them.) wrote simple regression test for RUN-PROGRAM fixed dumb bug in QUIT :UNIX-STATUS (which had been exercised by RUN-PROGRAM regression test) made the "--noprint" option bind *LOAD-VERBOSE* to NIL (to help write friendly-to-Unix-pipeline test programs, to help write regression tests) --- NEWS | 9 ++++---- doc/sbcl.1 | 8 +++---- src/code/cold-init.lisp | 2 +- src/code/run-program.lisp | 52 +++++++++++++++++++++---------------------- src/code/toplevel.lisp | 34 ++++++++++++++-------------- src/code/unix.lisp | 35 ++++++++++++++++++++++++++--- src/compiler/x86/parms.lisp | 16 +++++++++++++ tests/run-program.test.sh | 31 ++++++++++++++++++++++++++ tests/run-tests.sh | 2 +- 9 files changed, 132 insertions(+), 57 deletions(-) create mode 100644 tests/run-program.test.sh diff --git a/NEWS b/NEWS index 241d001..413be43 100644 --- a/NEWS +++ b/NEWS @@ -489,11 +489,10 @@ changes in sbcl-0.6.8 relative to sbcl-0.6.7: O(M*N*N) time when any of the sequence arguments were LISTs.) * The QUIT :UNIX-CODE keyword argument has been renamed to QUIT :UNIX-STATUS. (The old name still works, but is deprecated.) -* Raymond Wiker's port of CMU CL's RUN-PROGRAM has been added. - ?? What about the undefined symbols in run-program.lisp? - SB-UNIX:UNIX-DUP - SB-UNIX:UNIX-IOCTL - SB-UNIX:UNIX-PIPE +* Raymond Wiker's patches to port RUN-PROGRAM from CMU CL to SBCL + have been added. +* Raymond Wiker's patches to port dynamic loading from Linux to + FreeBSD have been added. ?? The debugger now flushes standard output streams before it begins its output ("debugger invoked" and so forth). ?? FINISH-OUTPUT now works better than it did before. (It used to diff --git a/doc/sbcl.1 b/doc/sbcl.1 index 2d05d29..7af037b 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -63,8 +63,8 @@ run a nonstandard toplevel which does not accept the standard toplevel options. .TP 3 .B --noinform Suppress the printing of any banner or other informational message at -startup. (Combined with the --noprint toplevel option, this makes it -straightforward to write Lisp "scripts" which work as Unix pipes.) +startup. (This makes it easier to write Lisp programs which work in +Unix pipelines. See also the "--noinform" option.) .PP In the future, runtime options may be added to control behavior such @@ -101,8 +101,8 @@ in the order they appear on the command line. When ordinarily the toplevel "read-eval-print loop" would be executed, execute a "read-eval loop" instead, i.e. don't print a prompt and don't echo results. (Combined with the --noinform -runtime option, this makes it straightforward to write Lisp -"scripts" which work as Unix pipe utilities.) +runtime option, this makes it easier to write Lisp +"scripts" which work in Unix pipelines.) .TP 3 .B --noprogrammer Ordinarily the system initializes *DEBUG-IO* to *TERMINAL-IO*. diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index f50db9e..f01cb59 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -282,7 +282,7 @@ instead (which is another name for the same thing).")) (if recklessly-p (sb!unix:unix-exit unix-status) - (throw '%end-of-the-world unix-code))) + (throw '%end-of-the-world unix-status))) ;;;; initialization functions diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index d704435..0d1f594 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -333,11 +333,11 @@ (stdout sb-c-call:int) (stderr sb-c-call:int)) -;;; RUN-PROGRAM uses fork and execve to run a different program. -;;; Strange stuff happens to keep the unix state of the world +;;; RUN-PROGRAM uses fork() and execve() to run a different program. +;;; Strange stuff happens to keep the Unix state of the world ;;; coherent. ;;; -;;; The child process needs to get it's input from somewhere, and send +;;; The child process needs to get its input from somewhere, and send ;;; its output (both standard and error) to somewhere. We have to do ;;; different things depending on where these somewheres really are. ;;; @@ -348,8 +348,8 @@ ;;; this stream after the child is up and running to free any ;;; storage used in the parent. ;;; -- NIL: Same as "file", but use "/dev/null" as the file. -;;; -- :STREAM: Use unix-pipe to create two descriptors. Use -;;; sb-sys:make-fd-stream to create the output stream on the +;;; -- :STREAM: Use Unix pipe() to create two descriptors. Use +;;; SB-SYS:MAKE-FD-STREAM to create the output stream on the ;;; writeable descriptor, and pass the readable descriptor to ;;; the child. The parent must close the readable descriptor for ;;; EOF to be passed up correctly. @@ -383,56 +383,56 @@ Common Lisp Users Manual for details about the PROCESS structure. The keyword arguments have the following meanings: - :env - + :ENV An A-LIST mapping keyword environment variables to simple-string values. - :wait - + :WAIT If non-NIL (default), wait until the created process finishes. If NIL, continue running Lisp until the program finishes. - :pty - + :PTY Either T, NIL, or a stream. Unless NIL, the subprocess is established under a PTY. If :pty is a stream, all output to this pty is sent to this stream, otherwise the PROCESS-PTY slot is filled in with a stream connected to pty that can read output and write input. - :input - + :INPUT Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard input for the current process is inherited. If NIL, /dev/null is used. If a pathname, the file so specified is used. If a stream, all the input is read from that stream and send to the subprocess. If :STREAM, the PROCESS-INPUT slot is filled in with a stream that sends its output to the process. Defaults to NIL. - :if-input-does-not-exist (when :input is the name of a file) - + :IF-INPUT-DOES-NOT-EXIST (when :INPUT is the name of a file) can be one of: - :error - generate an error. - :create - create an empty file. - nil (default) - return nil from run-program. - :output - + :ERROR to generate an error + :CREATE to create an empty file + NIL (the default) to return NIL from RUN-PROGRAM + :OUTPUT Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard output for the current process is inherited. If NIL, /dev/null is used. If a pathname, the file so specified is used. If a stream, all the output from the process is written to this stream. If :STREAM, the PROCESS-OUTPUT slot is filled in with a stream that can be read to get the output. Defaults to NIL. - :if-output-exists (when :input is the name of a file) - + :IF-OUTPUT-EXISTS (when :OUTPUT is the name of a file) can be one of: - :error (default) - generates an error if the file already exists. - :supersede - output from the program supersedes the file. - :append - output from the program is appended to the file. - nil - run-program returns nil without doing anything. - :error and :if-error-exists - - Same as :output and :if-output-exists, except that :error can also be - specified as :output in which case all error output is routed to the + :ERROR (the default) to generate an error + :SUPERSEDE to supersede the file with output from the program + :APPEND to append output from the program to the file + NIL to return NIL from RUN-PROGRAM, without doing anything + :ERROR and :IF-ERROR-EXISTS + Same as :OUTPUT and :IF-OUTPUT-EXISTS, except that :ERROR can also be + specified as :OUTPUT in which case all error output is routed to the same place as normal output. - :status-hook - + :STATUS-HOOK This is a function the system calls whenever the status of the process changes. The function takes the process as an argument." - ;; Make sure the interrupt handler is installed. + ;; Make sure that the interrupt handler is installed. (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler) - ;; Make sure all the args are okay. + ;; Make sure that all the args are okay. (unless (every #'simple-string-p args) (error "All arguments to program must be simple strings: ~S" args)) - ;; Pre-pend the program to the argument list. + ;; Prepend the program to the argument list. (push (namestring program) args) ;; Clear various specials used by GET-DESCRIPTOR-FOR to communicate ;; cleanup info. Also, establish proc at this level so we can diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index c2f4a89..583ef95 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -411,26 +411,26 @@ (unless (load userinit-truename) (error "~S was not successfully loaded." userinit-truename)) (flush-standard-output-streams)) - (/show0 "loaded USERINIT-TRUENAME"))) + (/show0 "loaded USERINIT-TRUENAME")) - ;; Handle --eval options. - (/show0 "handling --eval options in TOPLEVEL") - (dolist (eval (reverse evals)) - (/show0 "handling one --eval option in TOPLEVEL") - (eval eval) - (flush-standard-output-streams)) + ;; Handle --eval options. + (/show0 "handling --eval options in TOPLEVEL") + (dolist (eval (reverse evals)) + (/show0 "handling one --eval option in TOPLEVEL") + (eval eval) + (flush-standard-output-streams)) - ;; Handle stream binding controlled by --noprogrammer option. - ;; - ;; FIXME: When we do actually implement this, shouldn't it go - ;; earlier in the sequence, so that its stream bindings will - ;; affect the behavior of init files and --eval options? - (/show0 "handling --noprogrammer option in TOPLEVEL") - (when noprogrammer - (warn "stub: --noprogrammer option unimplemented")) ; FIXME + ;; Handle stream binding controlled by --noprogrammer option. + ;; + ;; FIXME: When we do actually implement this, shouldn't it go + ;; earlier in the sequence, so that its stream bindings will + ;; affect the behavior of init files and --eval options? + (/show0 "handling --noprogrammer option in TOPLEVEL") + (when noprogrammer + (warn "stub: --noprogrammer option unimplemented")) ; FIXME - (/show0 "falling into TOPLEVEL-REPL from TOPLEVEL") - (toplevel-repl noprint))) + (/show0 "falling into TOPLEVEL-REPL from TOPLEVEL") + (toplevel-repl noprint)))) ;;; read-eval-print loop for the default system toplevel (defun toplevel-repl (noprint) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index ce25a36..d7a66d0 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -543,6 +543,19 @@ (addr (deref ptr offset))) len)) +(defun unix-pipe () + #!+sb-doc + "Unix-pipe sets up a unix-piping mechanism consisting of + an input pipe and an output pipe. Unix-Pipe returns two + values: if no error occurred the first value is the pipe + to be read from and the second is can be written to. If + an error occurred the first value is NIL and the second + the unix error code." + (with-alien ((fds (array int 2))) + (syscall ("pipe" (* int)) + (values (deref fds 0) (deref fds 1)) + (cast fds (* int))))) + ;;; UNIX-CHDIR accepts a directory name and makes that the ;;; current working directory. (defun unix-chdir (path) @@ -566,6 +579,14 @@ (cast buf (* char))))) (cast buf c-string)))) +(defun unix-dup (fd) + #!+sb-doc + "Unix-dup duplicates an existing file descriptor (given as the + argument) and returns it. If FD is not a valid file descriptor, NIL + and an error number are returned." + (declare (type unix-fd fd)) + (int-syscall ("dup" int) fd)) + ;;; UNIX-EXIT terminates a program. (defun unix-exit (&optional (code 0)) #!+sb-doc @@ -639,9 +660,6 @@ (cast buf c-string) (cast buf (* char)) 256))) -;;; Unix-fsync writes the core-image of the file described by "fd" to -;;; permanent storage (i.e. disk). - (defun unix-fsync (fd) #!+sb-doc "Unix-fsync writes the core image of the file described by @@ -649,6 +667,17 @@ (declare (type unix-fd fd)) (void-syscall ("fsync" int) fd)) +;;;; sys/ioctl.h + +(defun unix-ioctl (fd cmd arg) + #!+sb-doc + "Unix-ioctl performs a variety of operations on open i/o + descriptors. See the UNIX Programmer's Manual for more + information." + (declare (type unix-fd fd) + (type (unsigned-byte 32) cmd)) + (void-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg)) + ;;;; sys/resource.h ;;; FIXME: All we seem to need is the RUSAGE_SELF version of this. diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 29b4dfe..bc0a177 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -115,6 +115,22 @@ ;;; where to put the different spaces ;;; ;;; FIXME: Couldn't/shouldn't these be DEFCONSTANT instead of DEFPARAMETER? +;;; +;;; FIXME: Since SBCL has a different way of distinguishing between target +;;; and host than the old CMU CL code used, the "TARGET-" prefix is +;;; redundant. Perhaps each *TARGET-FOO* should become *FOO*, probably +;;; at the same time that we unscrew the kludgy way that constants are +;;; duplicated between this file and runtime/x86-validate.h. +;;; +;;; Note: Mostly these values are black magic, inherited from CMU CL +;;; without any documentation. However, there have been a few changes +;;; since the fork: +;;; * The non-Linux *TARGET-STATIC-SPACE-START* value was bumped up +;;; from #x28000000 to #x30000000 when non-Linux ld.so dynamic linking +;;; support was added for FreeBSD ca. 20000910. This was to keep from +;;; stomping on an address range that the dynamic libraries want to use. +;;; (They want to use this address range even if we try to reserve it +;;; with a call to validate() as the first operation in main().) #!-linux (defparameter *target-read-only-space-start* #x10000000) #!-linux (defparameter *target-static-space-start* ;; FIXME: was #x28000000 until RAW's RUN-PROGRAM diff --git a/tests/run-program.test.sh b/tests/run-program.test.sh new file mode 100644 index 0000000..a1a36e7 --- /dev/null +++ b/tests/run-program.test.sh @@ -0,0 +1,31 @@ +#!/bin/sh + +# tests related to SB-EXT:RUN-PROGRAM + +sbcl --noinform --noprint --sysinit /dev/null --userinit /dev/null < error in function SB-IMPL::%ENUMERATE-SEARCH-LIST: +# Undefined search list: path +# +# (SB-EXT:RUN-PROGRAM "/bin/uname" '("-a") :OUTPUT :STREAM) +# doesn't return a STREAM (the way doc string claims) + +# success convention +exit 104 diff --git a/tests/run-tests.sh b/tests/run-tests.sh index 7c7da12..de63a75 100644 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -3,7 +3,7 @@ # Run the regression tests in this directory. # how we invoke SBCL -sbcl=${1:-sbcl --noprint --noprogrammer} +sbcl=${1:-sbcl --noinform --noprint --noprogrammer} # "Ten four" is the closest numerical slang I can find to "OK", so # it's the return value we expect from a successful test. -- 1.7.10.4