* Reimplement subprocess abstraction to match new microcode support.
* Implement socket abstraction.
* Create new "generic channel" input and output ports. These share
operations with file and console ports.
* Add `buffer-size' and `set-buffer-size' operations to file and
console input ports.
* Add `eof?' operation to file input port.
* Add `channel' operation to file input and output ports.
* Change input and output buffer abstractions to permit a buffer-size
of zero. Input buffer treats this the same as a buffer size of one,
since at least one character of buffering is needed to implement the
peek-char operation.
* Change the peek-char and read-char input port operations to return
an EOF object at end of file, or #F if no characters are available
and the input port is set to non-blocking mode. This is an
incompatible change.
* Change the read-string input port operation to return an EOF object
at end of file. This is an incompatible change.
* Change the read-string and discard-chars input-port operations to
for their input channels into blocking mode.
* Add new channel types: TCP-SERVER-SOCKET and DIRECTORY.
* Change the file-opening code to signal a range error if an attempt
is made to open a channel of type DIRECTORY or UNKNOWN.
* Remove error check from `open-pty-master'; the primitive now takes
care of this.
* Add new operations on PTY masters: pty-master-kill, pty-master-stop,
pty-master-continue, pty-master-interrupt, and pty-master-quit.
* Change the input-buffer abstraction to handle non-blocking channels
correctly.
* Use new microcode primitive `file-mod-time-indirect' to implement
`file-modification-time'.
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 14.9 1990/11/02 02:06:16 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 14.10 1990/11/09 08:43:53 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
(map car operations))))))))
(define (default-operation/read-string port delimiters)
- (list->string
- (let ((peek-char (input-port/operation/peek-char port))
- (read-char (input-port/operation/read-char port)))
- (let loop ()
- (if (char-set-member? delimiters (peek-char port))
- '()
- (let ((char (read-char port)))
- (cons char (loop))))))))
+ (let ((peek-char (input-port/operation/peek-char port))
+ (discard-char (input-port/operation/discard-char port)))
+ (let ((peek-char (let loop () (or (peek-char port) (loop)))))
+ (let ((char (peek-char)))
+ (if (eof-object? char)
+ char
+ (list->string
+ (let loop ((char char))
+ (if (or (eof-object? char)
+ (char-set-member? delimiters char))
+ '()
+ (begin
+ (discard-char port)
+ (cons char (loop (peek-char))))))))))))
(define (default-operation/discard-chars port delimiters)
(let ((peek-char (input-port/operation/peek-char port))
(discard-char (input-port/operation/discard-char port)))
(let loop ()
- (if (not (char-set-member? delimiters (peek-char port)))
- (begin (discard-char port)
- (loop))))))
+ (let ((char
+ (let loop ()
+ (or (peek-char port)
+ (loop)))))
+ (if (not (or (eof-object? char)
+ (char-set-member? delimiters char)))
+ (begin
+ (discard-char port)
+ (loop)))))))
\f
(define (input-port/char-ready? port interval)
((input-port/operation/char-ready? port) port interval))
\f
;;;; Input Procedures
-;;; **** The INTERVAL option for this operation works only for the
-;;; console port. Only Edwin uses this option.
-
(define (char-ready? #!optional port interval)
- (let ((port
- (if (default-object? port)
- (current-input-port)
- (guarantee-input-port port)))
- (interval
- (if (default-object? interval)
- 0
- (begin
- (if (not (exact-nonnegative-integer? interval))
- (error "interval must be exact nonnegative integer"
- interval))
- interval))))
- (input-port/char-ready? port interval)))
+ (input-port/char-ready? (if (default-object? port)
+ (current-input-port)
+ (guarantee-input-port port))
+ (if (default-object? interval)
+ 0
+ (begin
+ (if (not (exact-nonnegative-integer? interval))
+ (error:illegal-datum interval
+ 'CHAR-READY?))
+ interval))))
(define (peek-char #!optional port)
(let ((port
(if (default-object? port)
(current-input-port)
(guarantee-input-port port))))
- (or (input-port/peek-char port)
- eof-object)))
+ (let loop ()
+ (or (input-port/peek-char port)
+ (loop)))))
(define (read-char #!optional port)
(let ((port
(if (default-object? port)
(current-input-port)
(guarantee-input-port port))))
- (or (input-port/read-char port)
- eof-object)))
+ (let loop ()
+ (or (input-port/read-char port)
+ (loop)))))
(define (read-char-no-hang #!optional port)
(let ((port
(if (default-object? port)
(current-input-port)
(guarantee-input-port port))))
- (and (input-port/char-ready? port 0)
- (or (input-port/read-char port)
- eof-object))))
+ (if (input-port/char-ready? port 0)
+ (input-port/read-char port)
+ (let ((eof? (input-port/custom-operation port 'EOF?)))
+ (and eof?
+ (eof? port)
+ eof-object)))))
(define (read-string delimiters #!optional port)
- (let ((port
- (if (default-object? port)
- (current-input-port)
- (guarantee-input-port port))))
- (or (input-port/read-string port delimiters)
- eof-object)))
+ (input-port/read-string (if (default-object? port)
+ (current-input-port)
+ (guarantee-input-port port))
+ delimiters))
(define (read #!optional port parser-table)
(let ((port
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.10 1990/11/02 02:06:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.11 1990/11/09 08:43:59 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
(let ((type ((ucode-primitive channel-type 1) descriptor))
(types
'#(#F FILE PIPE FIFO TERMINAL PTY-MASTER
- UNIX-STREAM-SOCKET TCP-STREAM-SOCKET)))
+ UNIX-STREAM-SOCKET TCP-STREAM-SOCKET
+ TCP-SERVER-SOCKET DIRECTORY)))
(and (< type (vector-length types))
(vector-ref types type))))))
(with-absolutely-no-interrupts
(loop (cdr channels)))))
(make-channel descriptor)))
+(define-integrable (channel-type=unknown? channel)
+ (false? (channel-type channel)))
+
(define-integrable (channel-type=file? channel)
(eq? 'FILE (channel-type channel)))
(define-integrable (channel-type=pty-master? channel)
(eq? 'PTY-MASTER (channel-type channel)))
+
+(define-integrable (channel-type=directory? channel)
+ (eq? 'DIRECTORY (channel-type channel)))
\f
(define (channel-close channel)
;; This is locked from interrupts, but GC can occur since the
\f
;;;; File Primitives
+(define (file-open primitive filename)
+ (let ((channel
+ (without-interrupts (lambda () (make-channel (primitive filename))))))
+ (if (or (channel-type=directory? channel)
+ (channel-type=unknown? channel))
+ (begin
+ (channel-close channel)
+ (error:datum-out-of-range filename primitive)))
+ channel))
+
(define (file-open-input-channel filename)
- (without-interrupts
- (lambda ()
- (make-channel ((ucode-primitive file-open-input-channel 1) filename)))))
+ (file-open (ucode-primitive file-open-input-channel 1) filename))
(define (file-open-output-channel filename)
((ucode-primitive file-remove-link 1) filename)
- (without-interrupts
- (lambda ()
- (make-channel ((ucode-primitive file-open-output-channel 1) filename)))))
+ (file-open (ucode-primitive file-open-output-channel 1) filename))
(define (file-open-io-channel filename)
- (without-interrupts
- (lambda ()
- (make-channel ((ucode-primitive file-open-io-channel 1) filename)))))
+ (file-open (ucode-primitive file-open-io-channel 1) filename))
(define (file-open-append-channel filename)
- (without-interrupts
- (lambda ()
- (make-channel ((ucode-primitive file-open-append-channel 1) filename)))))
-
-(define (tty-input-channel)
- (without-interrupts
- (lambda ()
- (make-channel ((ucode-primitive tty-input-channel 0))))))
-
-(define (tty-output-channel)
- (without-interrupts
- (lambda ()
- (make-channel ((ucode-primitive tty-output-channel 0))))))
+ (file-open (ucode-primitive file-open-append-channel 1) filename))
(define (file-length channel)
((ucode-primitive file-length-new 1) (channel-descriptor channel)))
\f
;;;; Terminal Primitives
+(define (tty-input-channel)
+ (without-interrupts
+ (lambda ()
+ (make-channel ((ucode-primitive tty-input-channel 0))))))
+
+(define (tty-output-channel)
+ (without-interrupts
+ (lambda ()
+ (make-channel ((ucode-primitive tty-output-channel 0))))))
+
(define (terminal-get-state channel)
((ucode-primitive terminal-get-state 1) (channel-descriptor channel)))
(without-interrupts
(lambda ()
(let ((result ((ucode-primitive open-pty-master 0))))
- (if (not result)
- (error "unable to open pty master"))
(values (make-channel (vector-ref result 0))
(vector-ref result 1)
(vector-ref result 2))))))
(define (pty-master-send-signal channel signal)
((ucode-primitive pty-master-send-signal 2) (channel-descriptor channel)
signal))
+
+(define (pty-master-kill channel)
+ ((ucode-primitive pty-master-kill 1) (channel-descriptor channel)))
+
+(define (pty-master-stop channel)
+ ((ucode-primitive pty-master-stop 1) (channel-descriptor channel)))
+
+(define (pty-master-continue channel)
+ ((ucode-primitive pty-master-continue 1) (channel-descriptor channel)))
+
+(define (pty-master-interrupt channel)
+ ((ucode-primitive pty-master-interrupt 1) (channel-descriptor channel)))
+
+(define (pty-master-quit channel)
+ ((ucode-primitive pty-master-quit 1) (channel-descriptor channel)))
\f
;;;; File Copying
string
position)
-(define-integrable (make-output-buffer channel buffer-size)
- (%make-output-buffer channel (make-string buffer-size) 0))
+(define (make-output-buffer channel buffer-size)
+ (%make-output-buffer channel
+ (and (fix:> buffer-size 0) (make-string buffer-size))
+ 0))
(define (output-buffer/close buffer)
(output-buffer/drain-block buffer)
(channel-close (output-buffer/channel buffer)))
(define (output-buffer/size buffer)
- (string-length (output-buffer/string buffer)))
+ (let ((string (output-buffer/string buffer)))
+ (if string
+ (string-length string)
+ 0)))
(define (output-buffer/set-size buffer buffer-size)
- (if (> (output-buffer/position buffer) buffer-size)
- (let loop () (if (>= (output-buffer/drain buffer) buffer-size) (loop))))
- (let ((position (output-buffer/position buffer))
- (string (make-string buffer-size)))
- (substring-move-left! (output-buffer/string buffer) 0 position string 0)
- (set-output-buffer/string! buffer string)
- (if (= position buffer-size) (output-buffer/drain buffer))))
+ (output-buffer/drain-block buffer)
+ (set-output-buffer/string! buffer
+ (and (fix:> buffer-size 0)
+ (make-string buffer-size))))
(define output-buffer/buffered-chars
output-buffer/position)
(define (output-buffer/drain buffer)
- (let ((position (output-buffer/position buffer)))
- (if (zero? position)
+ (let ((string (output-buffer/string buffer))
+ (position (output-buffer/position buffer)))
+ (if (or (not string) (zero? position))
0
- (let ((channel (output-buffer/channel buffer))
- (string (output-buffer/string buffer)))
- (let ((n (channel-write channel string 0 position)))
- (cond ((or (not n) (zero? n)) position)
- ((< n position)
- (let ((position* (- position n)))
- (substring-move-left! string n position string 0)
- (set-output-buffer/position! buffer position*)
- position*))
- (else
- (set-output-buffer/position! buffer 0)
- 0)))))))
+ (let ((n
+ (channel-write (output-buffer/channel buffer)
+ string 0 position)))
+ (cond ((or (not n) (fix:= n 0))
+ position)
+ ((< n position)
+ (let ((position* (fix:- position n)))
+ (substring-move-left! string n position string 0)
+ (set-output-buffer/position! buffer position*)
+ position*))
+ (else
+ (set-output-buffer/position! buffer 0)
+ 0))))))
(define (output-buffer/flush buffer)
(set-output-buffer/position! buffer 0))
\f
(define (output-buffer/write-substring buffer string start end)
- (if (= start end)
- 0
- (let loop ((start start) (n-left (- end start)) (n-previous 0))
- (let ((string* (output-buffer/string buffer))
- (position (output-buffer/position buffer)))
- (let ((length (string-length string*))
- (position* (+ position n-left)))
- (cond ((<= position* length)
- (substring-move-left! string start end string* position)
- (set-output-buffer/position! buffer position*)
- (if (= position* length) (output-buffer/drain buffer))
- (+ n-previous n-left))
- ((< position length)
- (let ((room (- length position)))
- (let ((end (+ start room))
- (n-previous (+ n-previous room)))
- (substring-move-left! string start end string* position)
- (set-output-buffer/position! buffer length)
- (if (< (output-buffer/drain buffer) length)
- (loop end (- n-left room) n-previous)
- n-previous))))
- (else
- (if (< (output-buffer/drain buffer) length)
- (loop start n-left n-previous)
- n-previous))))))))
-
-(define (output-buffer/write-char buffer char)
- (let* ((string (output-buffer/string buffer))
- (length (string-length string)))
- (and (or (< (output-buffer/position buffer) length)
- (< (output-buffer/drain buffer) length))
- (let ((position (output-buffer/position buffer)))
- (string-set! string position char)
- (let ((position (1+ position)))
- (set-output-buffer/position! buffer position)
- (if (= position length) (output-buffer/drain buffer))
- true)))))
+ (cond ((fix:= start end)
+ 0)
+ ((not (output-buffer/string buffer))
+ (or (channel-write (output-buffer/channel buffer) string start end)
+ 0))
+ (else
+ (let loop ((start start) (n-left (fix:- end start)) (n-previous 0))
+ (let ((string* (output-buffer/string buffer))
+ (position (output-buffer/position buffer)))
+ (let ((length (string-length string*))
+ (position* (fix:+ position n-left)))
+ (cond ((fix:<= position* length)
+ (substring-move-left! string start end string* position)
+ (set-output-buffer/position! buffer position*)
+ (if (fix:= position* length)
+ (output-buffer/drain buffer))
+ (fix:+ n-previous n-left))
+ ((fix:< position length)
+ (let ((room (fix:- length position)))
+ (let ((end (fix:+ start room))
+ (n-previous (fix:+ n-previous room)))
+ (substring-move-left! string start end
+ string* position)
+ (set-output-buffer/position! buffer length)
+ (if (fix:< (output-buffer/drain buffer) length)
+ (loop end (fix:- n-left room) n-previous)
+ n-previous))))
+ (else
+ (if (fix:< (output-buffer/drain buffer) length)
+ (loop start n-left n-previous)
+ n-previous)))))))))
(define (output-buffer/drain-block buffer)
(let loop ()
- (if (not (zero? (output-buffer/drain buffer)))
+ (if (not (fix:= (output-buffer/drain buffer) 0))
(loop))))
-(define (output-buffer/write-string-block buffer string)
- (output-buffer/write-substring-block buffer string 0 (string-length string)))
-
(define (output-buffer/write-substring-block buffer string start end)
- (let loop ((start start) (n-left (- end start)))
- (let ((n (output-buffer/write-substring buffer string start end)))
- (if (< n n-left)
- (loop (+ start n) (- n-left n))))))
+ (do ((start start
+ (fix:+ start
+ (output-buffer/write-substring buffer string start end))))
+ ((fix:>= start end))))
(define (output-buffer/write-char-block buffer char)
- (let loop ()
- (if (not (output-buffer/write-char buffer char))
- (loop))))
+ (output-buffer/write-substring-block buffer (string char) 0 1))
+
+(define (output-buffer/write-string-block buffer string)
+ (output-buffer/write-substring-block buffer string 0 (string-length string)))
\f
;;;; Buffered Input
end-index)
(define (make-input-buffer channel buffer-size)
- (%make-input-buffer channel
- (make-string buffer-size)
- buffer-size
- buffer-size))
+ (let ((buffer-size (if (fix:> buffer-size 1) buffer-size 1)))
+ (%make-input-buffer channel
+ (make-string buffer-size)
+ buffer-size
+ buffer-size)))
(define (input-buffer/close buffer)
(set-input-buffer/end-index! buffer 0)
(string-length (input-buffer/string buffer)))
(define (input-buffer/set-size buffer buffer-size)
- ;; If the buffer's contents will not fit with the new size, the
- ;; oldest part of it is discarded.
- (let ((start-index (input-buffer/start-index buffer))
- (end-index (input-buffer/end-index buffer))
- (string (make-string buffer-size)))
- (substring-move-left! (input-buffer/string buffer)
- (max start-index (- end-index buffer-size))
- end-index
- string
- 0)
- (set-input-buffer/string! buffer string)
- (set-input-buffer/start-index! buffer 0)
- (set-input-buffer/end-index! buffer (- end-index start-index))))
+ ;; Returns the actual buffer size, which may be different from the arg.
+ ;; Discards any buffered characters.
+ (let ((buffer-size (if (fix:> buffer-size 1) buffer-size 1)))
+ (set-input-buffer/string! buffer (make-string buffer-size))
+ (let ((index (if (fix:= (input-buffer/end-index buffer) 0) 0 buffer-size)))
+ (set-input-buffer/start-index! buffer index)
+ (set-input-buffer/end-index! buffer index))
+ buffer-size))
(define (input-buffer/flush buffer)
- (let ((end-index (input-buffer/end-index buffer)))
- (if (< (input-buffer/start-index buffer) end-index)
- (set-input-buffer/start-index! buffer end-index))))
+ (set-input-buffer/start-index! buffer (input-buffer/end-index buffer)))
(define (input-buffer/buffered-chars buffer)
- (- (input-buffer/end-index buffer) (input-buffer/start-index buffer)))
+ (fix:- (input-buffer/end-index buffer) (input-buffer/start-index buffer)))
(define (input-buffer/chars-remaining buffer)
(let ((channel (input-buffer/channel buffer)))
(and (channel-type=file? channel)
- (let ((n (- (file-length channel) (file-position channel))))
- (and (not (negative? n))
- (+ (input-buffer/buffered-chars buffer) n))))))
+ (let ((n (fix:- (file-length channel) (file-position channel))))
+ (and (fix:>= n 0)
+ (fix:+ (input-buffer/buffered-chars buffer) n))))))
(define (input-buffer/char-ready? buffer interval)
- (let ((fill
- (if (positive? interval)
- (lambda ()
- (let ((timeout (+ (real-time-clock) interval)))
- (let loop ()
- (cond ((input-buffer/fill buffer) true)
- ((< (real-time-clock) timeout) (loop))
- (else false)))))
- (lambda ()
- (input-buffer/fill buffer)))))
- (char-ready? buffer
- (lambda (buffer)
- (let ((channel (input-buffer/channel buffer)))
- (case (channel-blocking? channel)
- ((#F) (fill))
- ((#T) (with-channel-blocking channel false fill))
- (else false)))))))
+ (char-ready? buffer
+ (lambda (buffer)
+ (with-channel-blocking (input-buffer/channel buffer) false
+ (lambda ()
+ (if (positive? interval)
+ (let ((timeout (+ (real-time-clock) interval)))
+ (let loop ()
+ (let ((n (input-buffer/fill buffer)))
+ (if n
+ (fix:> n 0)
+ (and (< (real-time-clock) timeout)
+ (loop))))))
+ (input-buffer/fill* buffer)))))))
(define (char-ready? buffer fill)
(let ((end-index (input-buffer/end-index buffer)))
- (cond ((< (input-buffer/start-index buffer) end-index) true)
- ((zero? (input-buffer/end-index buffer)) false)
+ (cond ((fix:= (input-buffer/end-index buffer) 0) false)
+ ((fix:< (input-buffer/start-index buffer) end-index) true)
(else (fill buffer)))))
+
+(define (input-buffer/eof? buffer)
+ ;; This returns true iff it knows that it is at EOF.
+ ;; If BUFFER is non-blocking with no input available, it returns false.
+ (and (not (input-buffer/char-ready? buffer 0))
+ (fix:= (input-buffer/end-index buffer) 0)))
\f
(define (input-buffer/fill buffer)
(let ((end-index
(let ((string (input-buffer/string buffer)))
(channel-read (input-buffer/channel buffer)
string 0 (string-length string)))))
- (and end-index
- (begin
- (set-input-buffer/start-index! buffer 0)
- (set-input-buffer/end-index! buffer end-index)
- (not (zero? end-index))))))
+ (if end-index
+ (begin
+ (set-input-buffer/start-index! buffer 0)
+ (set-input-buffer/end-index! buffer end-index)))
+ end-index))
+
+(define-integrable (input-buffer/fill* buffer)
+ (let ((n (input-buffer/fill buffer)))
+ (and n (fix:> n 0))))
(define (input-buffer/read-char buffer)
(let ((start-index (input-buffer/start-index buffer))
(end-index (input-buffer/end-index buffer)))
- (if (< start-index end-index)
- (begin
- (set-input-buffer/start-index! buffer (1+ start-index))
- (string-ref (input-buffer/string buffer) start-index))
- (and (not (zero? end-index))
- (input-buffer/fill buffer)
- (begin
- (set-input-buffer/start-index! buffer 1)
- (string-ref (input-buffer/string buffer) 0))))))
+ (cond ((fix:< start-index end-index)
+ (set-input-buffer/start-index! buffer (fix:+ start-index 1))
+ (string-ref (input-buffer/string buffer) start-index))
+ ((fix:= end-index 0)
+ eof-object)
+ (else
+ (let ((n (input-buffer/fill buffer)))
+ (cond ((not n) false)
+ ((fix:= n 0) eof-object)
+ (else
+ (set-input-buffer/start-index! buffer 1)
+ (string-ref (input-buffer/string buffer) 0))))))))
(define (input-buffer/peek-char buffer)
(let ((start-index (input-buffer/start-index buffer))
(end-index (input-buffer/end-index buffer)))
- (if (< start-index end-index)
- (string-ref (input-buffer/string buffer) start-index)
- (and (not (zero? end-index))
- (input-buffer/fill buffer)
- (string-ref (input-buffer/string buffer) 0)))))
+ (cond ((fix:< start-index end-index)
+ (string-ref (input-buffer/string buffer) start-index))
+ ((fix:= end-index 0)
+ eof-object)
+ (else
+ (let ((n (input-buffer/fill buffer)))
+ (cond ((not n) false)
+ ((fix:= n 0) eof-object)
+ (else (string-ref (input-buffer/string buffer) 0))))))))
(define (input-buffer/discard-char buffer)
(let ((start-index (input-buffer/start-index buffer)))
- (if (< start-index (input-buffer/end-index buffer))
- (set-input-buffer/start-index! buffer (1+ start-index)))))
+ (if (fix:< start-index (input-buffer/end-index buffer))
+ (set-input-buffer/start-index! buffer (fix:+ start-index 1)))))
(define (input-buffer/read-substring buffer string start end)
(let ((start-index (input-buffer/start-index buffer))
(end-index (input-buffer/end-index buffer)))
- (cond ((< start-index end-index)
+ (cond ((fix:< start-index end-index)
(let ((string* (input-buffer/string buffer))
- (available (- end-index start-index))
- (needed (- end start)))
- (if (>= available needed)
+ (available (fix:- end-index start-index))
+ (needed (fix:- end start)))
+ (if (fix:>= available needed)
(begin
- (let ((end-index (+ start-index needed)))
+ (let ((end-index (fix:+ start-index needed)))
(substring-move-left! string* start-index end-index
string start)
(set-input-buffer/start-index! buffer end-index))
(substring-move-left! string* start-index end-index
string start)
(set-input-buffer/start-index! buffer end-index)
- (+ available
- (or (channel-read (input-buffer/channel buffer)
- string
- (+ start available)
- end)
- 0))))))
- ((zero? end-index)
+ (fix:+ available
+ (or (channel-read (input-buffer/channel buffer)
+ string
+ (fix:+ start available)
+ end)
+ 0))))))
+ ((fix:= end-index 0)
0)
(else
(channel-read (input-buffer/channel buffer) string start end)))))
\f
(define (input-buffer/read-until-delimiter buffer delimiters)
- (and (char-ready? buffer input-buffer/fill)
- (let ((string (input-buffer/string buffer)))
- (let loop ()
- (let ((start-index (input-buffer/start-index buffer))
- (end-index (input-buffer/end-index buffer)))
- (let ((delimiter-index
- (substring-find-next-char-in-set string
- start-index
- end-index
- delimiters)))
- (if delimiter-index
- (let ((head (substring string start-index delimiter-index)))
- (set-input-buffer/start-index! buffer delimiter-index)
- head)
- (let ((head (substring string start-index end-index)))
- (set-input-buffer/start-index! buffer end-index)
- (if (input-buffer/fill buffer)
- (string-append head (loop))
- head)))))))))
+ (with-channel-blocking (input-buffer/channel buffer) true
+ (lambda ()
+ (if (char-ready? buffer input-buffer/fill*)
+ (let ((string (input-buffer/string buffer)))
+ (let loop ()
+ (let ((start-index (input-buffer/start-index buffer))
+ (end-index (input-buffer/end-index buffer)))
+ (let ((delimiter-index
+ (substring-find-next-char-in-set string
+ start-index
+ end-index
+ delimiters)))
+ (if delimiter-index
+ (let ((head
+ (substring string start-index delimiter-index)))
+ (set-input-buffer/start-index! buffer delimiter-index)
+ head)
+ (let ((head (substring string start-index end-index)))
+ (set-input-buffer/start-index! buffer end-index)
+ (if (input-buffer/fill* buffer)
+ (string-append head (loop))
+ head)))))))
+ eof-object))))
(define (input-buffer/discard-until-delimiter buffer delimiters)
- (if (char-ready? buffer input-buffer/fill)
- (let ((string (input-buffer/string buffer)))
- (let loop ()
- (let ((end-index (input-buffer/end-index buffer)))
- (let ((delimiter-index
- (substring-find-next-char-in-set
- string
- (input-buffer/start-index buffer)
- end-index
- delimiters)))
- (if delimiter-index
- (set-input-buffer/start-index! buffer delimiter-index)
- (begin
- (set-input-buffer/start-index! buffer end-index)
- (if (input-buffer/fill buffer)
- (loop))))))))))
\ No newline at end of file
+ (with-channel-blocking (input-buffer/channel buffer) true
+ (lambda ()
+ (if (char-ready? buffer input-buffer/fill*)
+ (let ((string (input-buffer/string buffer)))
+ (let loop ()
+ (let ((end-index (input-buffer/end-index buffer)))
+ (let ((delimiter-index
+ (substring-find-next-char-in-set
+ string
+ (input-buffer/start-index buffer)
+ end-index
+ delimiters)))
+ (if delimiter-index
+ (set-input-buffer/start-index! buffer delimiter-index)
+ (begin
+ (set-input-buffer/start-index! buffer end-index)
+ (if (input-buffer/fill* buffer)
+ (loop))))))))))))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.23 1990/07/20 01:20:52 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.24 1990/11/09 08:44:06 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
(RUNTIME CONSOLE-INPUT)
(RUNTIME CONSOLE-OUTPUT)
(RUNTIME TRANSCRIPT)
+ (RUNTIME GENERIC-INPUT)
+ (RUNTIME GENERIC-OUTPUT)
(RUNTIME FILE-INPUT)
(RUNTIME FILE-OUTPUT)
(RUNTIME STRING-INPUT)
(RUNTIME)
(RUNTIME X-GRAPHICS)
(RUNTIME STARBASE-GRAPHICS)
+ (RUNTIME SUBPROCESS)
;; Emacs -- last because it grabs the kitchen sink.
(RUNTIME EMACS-INTERFACE)))
\f
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 14.12 1990/10/10 06:30:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 14.13 1990/11/09 08:44:12 cph Rel $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
(define (within-parser port parser-table thunk)
(fluid-let
((*parser-input-port* port)
- (*parser-peek-char* (input-port/operation/peek-char port))
- (*parser-discard-char* (input-port/operation/discard-char port))
- (*parser-read-char* (input-port/operation/read-char port))
- (*parser-read-string* (input-port/operation/read-string port))
- (*parser-discard-chars* (input-port/operation/discard-chars port))
(*parser-parse-object-table* (parser-table/parse-object parser-table))
(*parser-collect-list-table* (parser-table/collect-list parser-table))
(*parser-parse-object-special-table*
;;;; Character Operations
(define *parser-input-port*)
-(define *parser-peek-char*)
-(define *parser-discard-char*)
-(define *parser-read-char*)
-(define *parser-read-string*)
-(define *parser-discard-chars*)
-(define-integrable (peek-char)
- (or (peek-char/eof-ok)
- (parse-error/end-of-file)))
+(define (peek-char)
+ (let ((char (peek-char/eof-ok)))
+ (if (eof-object? char)
+ (parse-error/end-of-file))
+ char))
-(define-integrable (peek-char/eof-ok)
- (*parser-peek-char* *parser-input-port*))
+(define (peek-char/eof-ok)
+ (let loop ()
+ (or (input-port/peek-char *parser-input-port*)
+ (loop))))
-(define-integrable (read-char)
- (or (read-char/eof-ok)
- (parse-error/end-of-file)))
+(define (read-char)
+ (let ((char (read-char/eof-ok)))
+ (if (eof-object? char)
+ (parse-error/end-of-file))
+ char))
-(define-integrable (read-char/eof-ok)
- (*parser-read-char* *parser-input-port*))
+(define (read-char/eof-ok)
+ (let loop ()
+ (or (input-port/read-char *parser-input-port*)
+ (loop))))
(define-integrable (discard-char)
- (*parser-discard-char* *parser-input-port*))
+ (input-port/discard-char *parser-input-port*))
(define-integrable (read-string delimiters)
- (*parser-read-string* *parser-input-port* delimiters))
+ (input-port/read-string *parser-input-port* delimiters))
(define-integrable (discard-chars delimiters)
- (*parser-discard-chars* *parser-input-port* delimiters))
+ (input-port/discard-chars *parser-input-port* delimiters))
(define (parse-error/end-of-file)
(parse-error "end of file"))
(define-integrable (parse-object/dispatch)
(let ((char (peek-char/eof-ok)))
- (if char
+ (if (eof-object? char)
+ char
((vector-ref *parser-parse-object-table*
- (or (char-ascii? char) (parse-error/non-ascii))))
- (make-eof-object *parser-input-port*))))
+ (or (char-ascii? char) (parse-error/non-ascii)))))))
(define-integrable (collect-list/dispatch)
((vector-ref *parser-collect-list-table* (peek-ascii))))
(if (char=? #\# (peek-char))
(discard-char)
(loop))
- (begin (if (char=? #\| (peek-char))
- (begin (discard-char)
- (loop)))
- (loop)))))
+ (begin
+ (if (char=? #\| (peek-char))
+ (begin
+ (discard-char)
+ (loop)))
+ (loop)))))
\f
;;;; Quoting
(define (parse-object/unquote)
(discard-char)
(if (char=? #\@ (peek-char))
- (begin (discard-char)
- (list 'UNQUOTE-SPLICING (parse-object/dispatch)))
+ (begin
+ (discard-char)
+ (list 'UNQUOTE-SPLICING (parse-object/dispatch)))
(list 'UNQUOTE (parse-object/dispatch))))
(define (parse-object/string-quote)
(else
(let ((string (read-string char-set/char-delimiters)))
(if (let ((char (peek-char/eof-ok)))
- (and char
+ (and (not (eof-object? char))
(char=? #\- char)))
- (begin (discard-char)
- (string-append string "-" (loop)))
+ (begin
+ (discard-char)
+ (string-append string "-" (loop)))
string))))))))
\f
;;;; Constants
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/process.scm,v 1.3 1990/03/24 19:14:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/process.scm,v 1.4 1990/11/09 08:44:17 cph Rel $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
promotional, or sales literature without prior written consent from
MIT in each case. |#
-;;;; Subprocess support
-;;; package: (runtime subprocesses)
+;;;; Subprocess Support
+;;; package: (runtime subprocess)
(declare (usual-integrations))
\f
-(define (initialize-package!)
+(define-structure (subprocess
+ (constructor %make-subprocess)
+ (conc-name subprocess-))
+ (index false read-only true)
+ (ctty-type false read-only true)
+ (pty false read-only true)
+ (id false read-only true)
+ (synchronous? false read-only true)
+ ;; Input to the subprocess; an OUTPUT port.
+ (input-port false read-only true)
+ ;; Output from the subprocess; an INPUT port.
+ (output-port false read-only true))
+
+(define (make-subprocess filename arguments environment ctty-type)
+ (let ((index
+ ((ucode-primitive make-subprocess 4)
+ filename
+ arguments
+ environment
+ (case ctty-type
+ ((none) 0)
+ ((inherited) 1)
+ ((pipe) 2)
+ ((pty) 3)
+ (else (error:illegal-datum ctty-type 'MAKE-SUBPROCESS))))))
+ (let ((input-channel
+ (without-interrupts
+ (lambda ()
+ (make-channel ((ucode-primitive process-input 1) index)))))
+ (output-channel
+ (without-interrupts
+ (lambda ()
+ (make-channel ((ucode-primitive process-output 1) index)))))
+ (ctty-type
+ (let ((type ((ucode-primitive process-ctty-type 1) index))
+ (types '#(NONE INHERITED PIPE PTY)))
+ (and (< type (vector-length types))
+ (vector-ref types type)))))
+ (let ((input-port (make-generic-output-port input-channel 512))
+ (output-port (make-generic-input-port output-channel 512)))
+ (set-input-port/associated-port! input-port output-port)
+ (set-output-port/associated-port! output-port input-port)
+ (let ((process
+ (%make-subprocess
+ index
+ ctty-type
+ (and (eq? ctty-type 'PTY) input-channel)
+ ((ucode-primitive process-id 1) index)
+ ((ucode-primitive process-synchronous? 1) index)
+ input-port
+ output-port)))
+ (set! subprocesses (cons process subprocesses))
+ process)))))
+
+(define (subprocess-delete process)
+ (close-output-port (subprocess-input-port process))
+ (close-input-port (subprocess-output-port process))
+ ((ucode-primitive process-delete 1) (subprocess-index process))
+ (set! subprocesses (delq! process subprocesses))
unspecific)
-(let-syntax
- ((define-special-primitives
- (macro names
- `(DEFINE-PRIMITIVES
- ,@(map (lambda (name)
- (let ((name (car name))
- (arity (cadr name)))
- (list (symbol-append 'prim- name)
- name
- arity)))
- names)))))
- (define-special-primitives
- (create-process 1)
- (process-get-pid 1)
- (process-get-input-channel 1)
- (process-get-output-channel 1)
- (process-get-status-flags 1)
- (process-char-ready? 2)))
-
-(let-syntax
- ((define-process-primitives
- (macro names
- `(BEGIN ,@(map (lambda (name)
- `(BEGIN
- (DEFINE (,name PROCESS)
- (,(symbol-append 'prim- name)
- (PROCESS/MICROCODE-PROCESS PROCESS)))))
- names)))))
- (define-process-primitives
- process-get-pid
- process-get-input-channel
- process-get-output-channel
- process-get-status-flags))
-
-(define-structure (process
- (conc-name process/)
- (constructor make-process
- (command-string microcode-process)))
- (command-string false read-only true) ;original command
- (microcode-process false read-only true) ;index into microcode
- ;process table
- (to-port false) ;port to write to process
- (from-port false) ;port to read from process
- )
-
-(define (create-process command-string)
- (let* ((prim-process ((ucode-primitive create-process 1) command-string))
- (process (make-process command-string prim-process)))
- (set-process/to-port! process (open-process-output process))
- (set-process/from-port! process (open-process-input process))
- process))
-
-(define (kill-process process)
- ((ucode-primitive kill-process 1) (process/microcode-process process)))
-
-(define (delete-process process)
- (close-output-port (process/to-port process))
- (kill-process process))
\ No newline at end of file
+(define (subprocess-list)
+ (list-copy subprocesses))
+
+(define subprocesses)
+(define scheme-subprocess-environment)
+
+(define (initialize-package!)
+ (reset-package!)
+ (add-event-receiver! event:after-restore reset-package!))
+
+(define (reset-package!)
+ (set! subprocesses '())
+ (set! scheme-subprocess-environment ((ucode-primitive scheme-environment 0)))
+ unspecific)
+\f
+(define (subprocess-status process)
+ (let ((index (subprocess-index process)))
+ (let ((status
+ (let ((status ((ucode-primitive process-status 1) index))
+ (statuses '#(RUNNING STOPPED EXITED SIGNALLED UNSTARTED)))
+ (and (< status (vector-length statuses))
+ (vector-ref statuses status)))))
+ (if (or (eq? status 'STOPPED)
+ (eq? status 'EXITED)
+ (eq? status 'SIGNALLED))
+ (cons status ((ucode-primitive process-reason 1) index))
+ status))))
+
+(define-integrable os-job-control?
+ (ucode-primitive os-job-control? 0))
+
+(define (subprocess-signal process signal to-process-group?)
+ (let ((pty (and to-process-group? (subprocess-pty process))))
+ (if (not pty)
+ ((ucode-primitive process-signal 2) (subprocess-index process) signal)
+ (pty-master-send-signal pty signal))))
+
+(define (subprocess-kill process to-process-group?)
+ (let ((pty (and to-process-group? (subprocess-pty process))))
+ (if (not pty)
+ ((ucode-primitive process-kill 1) (subprocess-index process))
+ (pty-master-kill pty))))
+
+(define (subprocess-stop process to-process-group?)
+ (let ((pty (and to-process-group? (subprocess-pty process))))
+ (if (not pty)
+ ((ucode-primitive process-stop 1) (subprocess-index process))
+ (pty-master-stop pty))))
+
+(define (subprocess-continue process to-process-group?)
+ (let ((pty (and to-process-group? (subprocess-pty process))))
+ (if (not pty)
+ ((ucode-primitive process-continue 1) (subprocess-index process))
+ (pty-master-continue pty))))
+
+(define (subprocess-interrupt process to-process-group?)
+ (let ((pty (and to-process-group? (subprocess-pty process))))
+ (if (not pty)
+ ((ucode-primitive process-interrupt 1) (subprocess-index process))
+ (pty-master-interrupt pty))))
+
+(define (subprocess-quit process to-process-group?)
+ (let ((pty (and to-process-group? (subprocess-pty process))))
+ (if (not pty)
+ ((ucode-primitive process-quit 1) (subprocess-index process))
+ (pty-master-quit pty))))
\ No newline at end of file
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.82 1990/11/02 02:06:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.83 1990/11/09 08:44:23 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
hook/record-statistic!)
(initialization (initialize-package!)))
+(define-package (runtime generic-input)
+ (files "genin")
+ (parent ())
+ (export (runtime console-input)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/char-ready?
+ operation/set-buffer-size)
+ (export (runtime file-input)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/char-ready?
+ operation/chars-remaining
+ operation/close
+ operation/discard-char
+ operation/discard-chars
+ operation/eof?
+ operation/peek-char
+ operation/read-char
+ operation/read-chars
+ operation/read-string
+ operation/set-buffer-size)
+ (export (runtime socket)
+ make-generic-input-port
+ set-input-port/associated-port!)
+ (export (runtime subprocess)
+ make-generic-input-port
+ set-input-port/associated-port!)
+ (initialization (initialize-package!)))
+
+(define-package (runtime generic-output)
+ (files "genout")
+ (parent ())
+ (export (runtime console-output)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/set-buffer-size)
+ (export (runtime file-output)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/close
+ operation/flush-output
+ operation/set-buffer-size
+ operation/write-char
+ operation/write-string)
+ (export (runtime socket)
+ make-generic-output-port
+ set-output-port/associated-port!)
+ (export (runtime subprocess)
+ make-generic-output-port
+ set-output-port/associated-port!)
+ (initialization (initialize-package!)))
+
(define-package (runtime gensym)
(files "gensym")
(parent ())
set-input-port/state!
with-input-from-file
with-input-from-port)
+ (export (runtime primitive-io)
+ eof-object)
(initialization (initialize-package!)))
(define-package (runtime interrupt-handler)
(export ()
close-all-open-files
copy-file)
- (export (runtime file-input)
- file-length
- file-open-input-channel
+ (export (runtime socket)
+ channel-close
+ channel-descriptor
+ make-channel
+ with-channel-blocking)
+ (export (runtime subprocess)
+ make-channel
+ pty-master-continue
+ pty-master-interrupt
+ pty-master-kill
+ pty-master-quit
+ pty-master-send-signal
+ pty-master-stop)
+ (export (runtime generic-input)
input-buffer/buffered-chars
input-buffer/channel
input-buffer/char-ready?
input-buffer/close
input-buffer/discard-char
input-buffer/discard-until-delimiter
+ input-buffer/eof?
input-buffer/peek-char
input-buffer/read-char
input-buffer/read-substring
input-buffer/read-until-delimiter
+ input-buffer/set-size
+ input-buffer/size
make-input-buffer)
- (export (runtime file-output)
- channel-close
- channel-write-char-block
- channel-write-string-block
- file-open-append-channel
- file-open-output-channel
+ (export (runtime generic-output)
make-output-buffer
output-buffer/buffered-chars
+ output-buffer/channel
output-buffer/close
output-buffer/drain-block
output-buffer/set-size
output-buffer/size
- output-buffer/write-char-block
output-buffer/write-string-block)
- (export (runtime console-output)
- channel-write-char-block
- channel-write-string-block
- make-output-buffer
- output-buffer/buffered-chars
- output-buffer/drain-block
- output-buffer/set-size
- output-buffer/size
- output-buffer/write-char-block
- output-buffer/write-string-block
- tty-output-channel)
+ (export (runtime file-input)
+ file-length
+ file-open-input-channel
+ input-buffer/chars-remaining
+ input-buffer/read-substring
+ make-input-buffer)
+ (export (runtime file-output)
+ file-open-append-channel
+ file-open-output-channel
+ make-output-buffer)
(export (runtime console-input)
channel-type=file?
input-buffer/buffered-chars
input-buffer/channel
input-buffer/char-ready?
+ input-buffer/eof?
input-buffer/peek-char
input-buffer/read-char
+ input-buffer/set-size
+ input-buffer/size
make-input-buffer
tty-input-channel)
+ (export (runtime console-output)
+ make-output-buffer
+ output-buffer/buffered-chars
+ output-buffer/channel
+ output-buffer/drain-block
+ output-buffer/set-size
+ output-buffer/size
+ output-buffer/write-string-block
+ tty-output-channel)
(export (runtime rep)
channel-type=terminal?
terminal-cooked-input
scode-walker?)
(initialization (initialize-package!)))
+(define-package (runtime socket)
+ (files "socket")
+ (parent ())
+ (export ()
+ open-tcp-server-socket
+ open-tcp-stream-socket
+ open-unix-stream-socket
+ tcp-server-connection-accept))
+
+(define-package (runtime subprocess)
+ (files "process")
+ (parent ())
+ (export ()
+ make-subprocess
+ os-job-control?
+ scheme-subprocess-environment
+ subprocess-continue
+ subprocess-ctty-type
+ subprocess-delete
+ subprocess-id
+ subprocess-input-port
+ subprocess-interrupt
+ subprocess-kill
+ subprocess-list
+ subprocess-output-port
+ subprocess-quit
+ subprocess-signal
+ subprocess-status
+ subprocess-stop)
+ (initialization (initialize-package!)))
+
(define-package (runtime graphics)
(files "graphics")
(parent ())
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strnin.scm,v 14.2 1988/06/13 11:51:51 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/strnin.scm,v 14.3 1990/11/09 08:44:34 cph Rel $
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(< (input-port/start port) (input-port/end port)))
(define (operation/peek-char port)
- (and (< (input-port/start port) (input-port/end port))
- (string-ref (input-port/string port) (input-port/start port))))
+ (if (< (input-port/start port) (input-port/end port))
+ (string-ref (input-port/string port) (input-port/start port))
+ (make-eof-object port)))
(define (operation/discard-char port)
(set-input-port/start! port (1+ (input-port/start port))))
(define (operation/read-char port)
(let ((start (input-port/start port)))
- (and (< start (input-port/end port))
- (begin (set-input-port/start! port (1+ start))
- (string-ref (input-port/string port) start)))))
+ (if (< start (input-port/end port))
+ (begin
+ (set-input-port/start! port (1+ start))
+ (string-ref (input-port/string port) start))
+ (make-eof-object port))))
(define (operation/read-string port delimiters)
(let ((start (input-port/start port))
(end (input-port/end port)))
- (and (< start end)
- (let ((string (input-port/string port)))
- (let ((index
- (or (substring-find-next-char-in-set string
- start
- end
- delimiters)
- end)))
- (set-input-port/start! port index)
- (substring string start index))))))
+ (if (< start end)
+ (let ((string (input-port/string port)))
+ (let ((index
+ (or (substring-find-next-char-in-set string
+ start
+ end
+ delimiters)
+ end)))
+ (set-input-port/start! port index)
+ (substring string start index)))
+ (make-eof-object port))))
(define (operation/discard-chars port delimiters)
(let ((start (input-port/start port))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxprm.scm,v 1.8 1990/04/04 18:51:37 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxprm.scm,v 1.9 1990/11/09 08:44:51 cph Rel $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
(inode-number false read-only true))
(define (file-modification-time filename)
- (let ((attributes (file-attributes-indirect filename)))
- (and attributes
- (file-attributes/modification-time attributes))))
+ ((ucode-primitive file-mod-time-indirect 1)
+ (pathname->string (pathname->absolute-pathname (->pathname filename)))))
\f
(define (get-environment-variable name)
(or ((ucode-primitive get-environment-variable) name)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.100 1990/11/02 02:07:08 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.101 1990/11/09 08:44:55 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
'()))
(add-system! microcode-system)
(add-event-receiver! event:after-restore snarf-microcode-version!)
- (add-identification! "Runtime" 14 100))
+ (add-identification! "Runtime" 14 101))
(define microcode-system)
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.23 1990/07/20 01:20:52 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.24 1990/11/09 08:44:06 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
(RUNTIME CONSOLE-INPUT)
(RUNTIME CONSOLE-OUTPUT)
(RUNTIME TRANSCRIPT)
+ (RUNTIME GENERIC-INPUT)
+ (RUNTIME GENERIC-OUTPUT)
(RUNTIME FILE-INPUT)
(RUNTIME FILE-OUTPUT)
(RUNTIME STRING-INPUT)
(RUNTIME)
(RUNTIME X-GRAPHICS)
(RUNTIME STARBASE-GRAPHICS)
+ (RUNTIME SUBPROCESS)
;; Emacs -- last because it grabs the kitchen sink.
(RUNTIME EMACS-INTERFACE)))
\f
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.82 1990/11/02 02:06:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.83 1990/11/09 08:44:23 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
hook/record-statistic!)
(initialization (initialize-package!)))
+(define-package (runtime generic-input)
+ (files "genin")
+ (parent ())
+ (export (runtime console-input)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/char-ready?
+ operation/set-buffer-size)
+ (export (runtime file-input)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/char-ready?
+ operation/chars-remaining
+ operation/close
+ operation/discard-char
+ operation/discard-chars
+ operation/eof?
+ operation/peek-char
+ operation/read-char
+ operation/read-chars
+ operation/read-string
+ operation/set-buffer-size)
+ (export (runtime socket)
+ make-generic-input-port
+ set-input-port/associated-port!)
+ (export (runtime subprocess)
+ make-generic-input-port
+ set-input-port/associated-port!)
+ (initialization (initialize-package!)))
+
+(define-package (runtime generic-output)
+ (files "genout")
+ (parent ())
+ (export (runtime console-output)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/set-buffer-size)
+ (export (runtime file-output)
+ operation/buffer-size
+ operation/buffered-chars
+ operation/channel
+ operation/close
+ operation/flush-output
+ operation/set-buffer-size
+ operation/write-char
+ operation/write-string)
+ (export (runtime socket)
+ make-generic-output-port
+ set-output-port/associated-port!)
+ (export (runtime subprocess)
+ make-generic-output-port
+ set-output-port/associated-port!)
+ (initialization (initialize-package!)))
+
(define-package (runtime gensym)
(files "gensym")
(parent ())
set-input-port/state!
with-input-from-file
with-input-from-port)
+ (export (runtime primitive-io)
+ eof-object)
(initialization (initialize-package!)))
(define-package (runtime interrupt-handler)
(export ()
close-all-open-files
copy-file)
- (export (runtime file-input)
- file-length
- file-open-input-channel
+ (export (runtime socket)
+ channel-close
+ channel-descriptor
+ make-channel
+ with-channel-blocking)
+ (export (runtime subprocess)
+ make-channel
+ pty-master-continue
+ pty-master-interrupt
+ pty-master-kill
+ pty-master-quit
+ pty-master-send-signal
+ pty-master-stop)
+ (export (runtime generic-input)
input-buffer/buffered-chars
input-buffer/channel
input-buffer/char-ready?
input-buffer/close
input-buffer/discard-char
input-buffer/discard-until-delimiter
+ input-buffer/eof?
input-buffer/peek-char
input-buffer/read-char
input-buffer/read-substring
input-buffer/read-until-delimiter
+ input-buffer/set-size
+ input-buffer/size
make-input-buffer)
- (export (runtime file-output)
- channel-close
- channel-write-char-block
- channel-write-string-block
- file-open-append-channel
- file-open-output-channel
+ (export (runtime generic-output)
make-output-buffer
output-buffer/buffered-chars
+ output-buffer/channel
output-buffer/close
output-buffer/drain-block
output-buffer/set-size
output-buffer/size
- output-buffer/write-char-block
output-buffer/write-string-block)
- (export (runtime console-output)
- channel-write-char-block
- channel-write-string-block
- make-output-buffer
- output-buffer/buffered-chars
- output-buffer/drain-block
- output-buffer/set-size
- output-buffer/size
- output-buffer/write-char-block
- output-buffer/write-string-block
- tty-output-channel)
+ (export (runtime file-input)
+ file-length
+ file-open-input-channel
+ input-buffer/chars-remaining
+ input-buffer/read-substring
+ make-input-buffer)
+ (export (runtime file-output)
+ file-open-append-channel
+ file-open-output-channel
+ make-output-buffer)
(export (runtime console-input)
channel-type=file?
input-buffer/buffered-chars
input-buffer/channel
input-buffer/char-ready?
+ input-buffer/eof?
input-buffer/peek-char
input-buffer/read-char
+ input-buffer/set-size
+ input-buffer/size
make-input-buffer
tty-input-channel)
+ (export (runtime console-output)
+ make-output-buffer
+ output-buffer/buffered-chars
+ output-buffer/channel
+ output-buffer/drain-block
+ output-buffer/set-size
+ output-buffer/size
+ output-buffer/write-string-block
+ tty-output-channel)
(export (runtime rep)
channel-type=terminal?
terminal-cooked-input
scode-walker?)
(initialization (initialize-package!)))
+(define-package (runtime socket)
+ (files "socket")
+ (parent ())
+ (export ()
+ open-tcp-server-socket
+ open-tcp-stream-socket
+ open-unix-stream-socket
+ tcp-server-connection-accept))
+
+(define-package (runtime subprocess)
+ (files "process")
+ (parent ())
+ (export ()
+ make-subprocess
+ os-job-control?
+ scheme-subprocess-environment
+ subprocess-continue
+ subprocess-ctty-type
+ subprocess-delete
+ subprocess-id
+ subprocess-input-port
+ subprocess-interrupt
+ subprocess-kill
+ subprocess-list
+ subprocess-output-port
+ subprocess-quit
+ subprocess-signal
+ subprocess-status
+ subprocess-stop)
+ (initialization (initialize-package!)))
+
(define-package (runtime graphics)
(files "graphics")
(parent ())
projects / mit-scheme.git / commitdiff