1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
2 ;;; ---------------------------------------------------------------------------
3 ;;; Title: CMUCL dependent stuff + fixups
4 ;;; Created: 1999-05-25 22:32
5 ;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
6 ;;; License: GPL (See file COPYING for details).
7 ;;; ---------------------------------------------------------------------------
8 ;;; (c) copyright 1999 by Gilbert Baumann
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 2 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software
22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 (export 'glisp
::read-byte-sequence
:glisp
)
25 (export 'glisp
::read-char-sequence
:glisp
)
26 (export 'glisp
::run-unix-shell-command
:glisp
)
28 (export 'glisp
::getenv
:glisp
)
30 (defun glisp::read-byte-sequence
(&rest ap
)
31 (apply #'read-sequence ap
))
33 (defun glisp::read-char-sequence
(&rest ap
)
34 (apply #'read-sequence ap
))
36 (defun glisp::read-byte-sequence
(sequence input
&key
(start 0) (end (length sequence
)))
39 (cond ((= i end
) (return i
)))
40 (setq c
(read-byte input nil
:eof
))
41 (cond ((eql c
:eof
) (return i
)))
42 (setf (aref sequence i
) c
)
45 (defun glisp::read-byte-sequence
(sequence input
&key
(start 0) (end (length sequence
)))
46 (let ((r (read-sequence sequence input
:start start
:end end
)))
47 (cond ((and (= r start
) (> end start
))
48 (let ((byte (read-byte input nil
:eof
)))
52 (setf (aref sequence start
) byte
)
55 (glisp::read-byte-sequence sequence input
:start start
:end end
)
61 (defun glisp::read-char-sequence
(sequence input
&key
(start 0) (end (length sequence
)))
64 (cond ((= i end
) (return i
)))
65 (setq c
(read-byte input nil
:eof
))
66 (cond ((eql c
:eof
) (return i
)))
67 (setf (aref sequence i
) c
)
71 (defmacro glisp
::with-timeout
((&rest ignore
) &body body
)
72 (declare (ignore ignore
))
76 (defun glisp::open-inet-socket
(hostname port
)
77 (let ((fd (extensions:connect-to-inet-socket hostname port
)))
79 (sys:make-fd-stream fd
82 :element-type
'(unsigned-byte 8)
83 :name
(format nil
"Network connection to ~A:~D" hostname port
))
86 (defun glisp::g
/make-string
(length &rest options
)
87 (apply #'make-array length
:element-type
'base-char options
))
91 RUN-PROGRAM is an external symbol in the EXTENSIONS package.
92 Function
: #<Function RUN-PROGRAM
{12E7B79
}>
94 (program args
&key
(env *environment-list
*) (wait t
) pty input
95 if-input-does-not-exist output
(if-output-exists :error
) (error :output
)
96 (if-error-exists :error
) status-hook
)
97 Function documentation
:
98 Run-program creates a new process and runs the unix progam in the
99 file specified by the simple-string program. Args are the standard
100 arguments that can be passed to a Unix program
, for no arguments
101 use NIL
(which means just the name of the program is passed as arg
0).
103 Run program will either return NIL or a PROCESS structure. See the CMU
104 Common Lisp Users Manual for details about the PROCESS structure.
106 The keyword arguments have the following meanings
:
108 An A-LIST mapping keyword environment variables to simple-string
111 If non-NIL
(default), wait until the created process finishes. If
112 NIL
, continue running Lisp until the program finishes.
114 Either T
, NIL
, or a stream. Unless NIL
, the subprocess is established
115 under a PTY. If
:pty is a stream
, all output to this pty is sent to
116 this stream
, otherwise the PROCESS-PTY slot is filled in with a stream
117 connected to pty that can read output and write input.
119 Either T
, NIL
, a pathname
, a stream
, or
:STREAM. If T
, the standard
120 input for the current process is inherited. If NIL
, /dev
/null
121 is used. If a pathname
, the file so specified is used. If a stream
,
122 all the input is read from that stream and send to the subprocess. If
123 :STREAM
, the PROCESS-INPUT slot is filled in with a stream that sends
124 its output to the process. Defaults to NIL.
125 :if-input-does-not-exist
(when :input is the name of a file
) -
127 :error - generate an error.
128 :create - create an empty file.
129 nil
(default) - return nil from run-program.
131 Either T
, NIL
, a pathname
, a stream
, or
:STREAM. If T
, the standard
132 output for the current process is inherited. If NIL
, /dev
/null
133 is used. If a pathname
, the file so specified is used. If a stream
,
134 all the output from the process is written to this stream. If
135 :STREAM
, the PROCESS-OUTPUT slot is filled in with a stream that can
136 be read to get the output. Defaults to NIL.
137 :if-output-exists
(when :input is the name of a file
) -
139 :error
(default) - generates an error if the file already exists.
140 :supersede - output from the program supersedes the file.
141 :append - output from the program is appended to the file.
142 nil - run-program returns nil without doing anything.
143 :error and
:if-error-exists -
144 Same as
:output and
:if-output-exists
, except that
:error can also be
145 specified as
:output in which case all error output is routed to the
146 same place as normal output.
148 This is a function the system calls whenever the status of the
149 process changes. The function takes the process as an argument.
150 Its defined argument types are
:
151 (T T
&KEY
(:ENV T
) (:WAIT T
) (:PTY T
) (:INPUT T
) (:IF-INPUT-DOES-NOT-EXIST T
)
152 (:OUTPUT T
) (:IF-OUTPUT-EXISTS T
) (:ERROR T
) (:IF-ERROR-EXISTS T
)
155 (OR EXTENSIONS
::PROCESS NULL
)
156 On Wednesday
, 7/1/98 12:48:51 pm
[-
1] it was compiled from
:
157 target
:code
/run-program.lisp
158 Created
: Saturday
, 6/20/98 07:13:08 pm
[-
1]
159 Comment
: $Header
: /home
/david
/closure-cvs
/cvsroot
/closure
/src
/glisp
/Attic
/dep-cmucl-dtc.lisp
,v
1.1.1.1 2002-
07-
22 02:27:22 gilbert Exp $
162 ;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))
164 (defun glisp:run-unix-shell-command
(command)
165 (ext:process-exit-code
(ext:run-program
"/bin/sh" (list "-c" command
) :wait t
:input nil
:output nil
)))
167 (defmacro glisp
::defsubst
(name args
&body body
)
169 (declaim (inline ,name
))
170 (defun ,name
,args .
,body
)))
175 (export 'glisp
::mp
/process-yield
:glisp
)
176 (export 'glisp
::mp
/process-wait
:glisp
)
177 (export 'glisp
::mp
/process-run-function
:glisp
)
178 (export 'glisp
::mp
/make-lock
:glisp
)
179 (export 'glisp
::mp
/current-process
:glisp
)
180 (export 'glisp
::mp
/process-kill
:glisp
)
182 (defun glisp::mp
/make-lock
(&key name
)
183 (pthread::make-lock name
))
185 (defmacro glisp
::mp
/with-lock
((lock) &body body
)
186 `(pthread::with-lock-held
(,lock
)
189 (defun glisp::mp
/process-yield
(&optional process-to-run
)
190 (declare (ignore process-to-run
))
191 (PTHREAD:SCHED-YIELD
))
193 (defun glisp::mp
/process-wait
(whostate predicate
)
195 ((funcall predicate
))
198 (defun glisp::mp
/process-run-function
(name fun
&rest args
)
199 (pthread::thread-create
204 (defun glisp::mp
/current-process
()
207 (defun glisp::mp
/process-kill
(process)
208 (warn "*** Define GLISP:MP/PROCESS-KILL for CMUCL."))
210 (defun glisp::getenv
(string)
211 (cdr (assoc string ext
:*environment-list
* :test
#'string-equal
)))