Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv15409/src/glisp

Added Files: dep-scl.lisp Removed Files: dep-cmucl-dtc.lisp Log Message: Based on the assumption that (and cmucl pthread) is actually code for Scieneer CL, rename dep-cmucl-dtc to dep-scl.

--- /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp 2006/12/31 13:11:44 NONE +++ /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp 2006/12/31 13:11:44 1.1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*- ;;; --------------------------------------------------------------------------- ;;; Title: [Originally CMUCL dependent stuff + fixups], probably for SCL ;;; Created: 1999-05-25 22:32 ;;; Author: Gilbert Baumann gilbert@base-engineering.com ;;; License: MIT style (see below) ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1999 by Gilbert Baumann

;;; Permission is hereby granted, free of charge, to any person obtaining ;;; a copy of this software and associated documentation files (the ;;; "Software"), to deal in the Software without restriction, including ;;; without limitation the rights to use, copy, modify, merge, publish, ;;; distribute, sublicense, and/or sell copies of the Software, and to ;;; permit persons to whom the Software is furnished to do so, subject to ;;; the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be ;;; included in all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. ;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY ;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, ;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

(export 'glisp::read-byte-sequence :glisp) (export 'glisp::read-char-sequence :glisp) (export 'glisp::run-unix-shell-command :glisp)

(export 'glisp::getenv :glisp)

(defun glisp::read-byte-sequence (&rest ap) (apply #'read-sequence ap))

(defun glisp::read-char-sequence (&rest ap) (apply #'read-sequence ap))

(defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence))) (let (c (i start)) (loop (cond ((= i end) (return i))) (setq c (read-byte input nil :eof)) (cond ((eql c :eof) (return i))) (setf (aref sequence i) c) (incf i) )))

(defun glisp::read-byte-sequence (sequence input &key (start 0) (end (length sequence))) (let ((r (read-sequence sequence input :start start :end end))) (cond ((and (= r start) (> end start)) (let ((byte (read-byte input nil :eof))) (cond ((eq byte :eof) r) (t (setf (aref sequence start) byte) (incf start) (if (> end start) (glisp::read-byte-sequence sequence input :start start :end end) start))))) (t r))))

#|| (defun glisp::read-char-sequence (sequence input &key (start 0) (end (length sequence))) (let (c (i start)) (loop (cond ((= i end) (return i))) (setq c (read-byte input nil :eof)) (cond ((eql c :eof) (return i))) (setf (aref sequence i) c) (incf i) ))) ||#

(defmacro glisp::with-timeout ((&rest ignore) &body body) (declare (ignore ignore)) `(progn ,@body))

(defun glisp::open-inet-socket (hostname port) (let ((fd (extensions:connect-to-inet-socket hostname port))) (values (sys:make-fd-stream fd :input t :output t :element-type '(unsigned-byte 8) :name (format nil "Network connection to ~A:~D" hostname port)) :byte)))

(defun glisp::g/make-string (length &rest options) (apply #'make-array length :element-type 'base-char options))

#||

RUN-PROGRAM is an external symbol in the EXTENSIONS package. Function: #<Function RUN-PROGRAM {12E7B79}> Function arguments: (program args &key (env *environment-list*) (wait t) pty input if-input-does-not-exist output (if-output-exists :error) (error :output) (if-error-exists :error) status-hook) Function documentation: Run-program creates a new process and runs the unix progam in the file specified by the simple-string program. Args are the standard arguments that can be passed to a Unix program, for no arguments use NIL (which means just the name of the program is passed as arg 0).

Run program will either return NIL or a PROCESS structure. See the CMU Common Lisp Users Manual for details about the PROCESS structure.

The keyword arguments have the following meanings: :env - An A-LIST mapping keyword environment variables to simple-string values. :wait - If non-NIL (default), wait until the created process finishes. If NIL, continue running Lisp until the program finishes. :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 - 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) - can be one of: :error - generate an error. :create - create an empty file. nil (default) - 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) - 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 same place as normal output. :status-hook - This is a function the system calls whenever the status of the process changes. The function takes the process as an argument. Its defined argument types are: (T T &KEY (:ENV T) (:WAIT T) (:PTY T) (:INPUT T) (:IF-INPUT-DOES-NOT-EXIST T) (:OUTPUT T) (:IF-OUTPUT-EXISTS T) (:ERROR T) (:IF-ERROR-EXISTS T) (:STATUS-HOOK T)) Its result type is: (OR EXTENSIONS::PROCESS NULL) On Wednesday, 7/1/98 12:48:51 pm [-1] it was compiled from: target:code/run-program.lisp Created: Saturday, 6/20/98 07:13:08 pm [-1] Comment: $Header: /project/closure/cvsroot/closure/src/glisp/dep-scl.lisp,v 1.1 2006/12/31 13:11:44 dlichteblau Exp $ ||#

;; (process-exit-code (run-program "/bin/sh" (list "-c" "ls") :wait t :input nil :output nil))

(defun glisp:run-unix-shell-command (command) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil)))

;;; MP

(export 'glisp::mp/process-yield :glisp) (export 'glisp::mp/process-wait :glisp) (export 'glisp::mp/process-run-function :glisp) (export 'glisp::mp/make-lock :glisp) (export 'glisp::mp/current-process :glisp) (export 'glisp::mp/process-kill :glisp)

(defun glisp::mp/make-lock (&key name) (pthread::make-lock name))

(defmacro glisp::mp/with-lock ((lock) &body body) `(pthread::with-lock-held (,lock) ,@body))

(defun glisp::mp/process-yield (&optional process-to-run) (declare (ignore process-to-run)) (PTHREAD:SCHED-YIELD))

(defun glisp::mp/process-wait (whostate predicate) (do () ((funcall predicate)) (sleep .1)))

(defun glisp::mp/process-run-function (name fun &rest args) (pthread::thread-create (lambda () (apply fun args)) :name name))

(defun glisp::mp/current-process () 'blah)

(defun glisp::mp/process-kill (process) (warn "*** Define GLISP:MP/PROCESS-KILL for CMUCL."))

(defun glisp::getenv (string) (cdr (assoc string ext:*environment-list* :test #'string-equal)))