From 685668da028d8c9f595b812009802756262d99ab Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 1 Mar 1991 01:06:31 +0000 Subject: [PATCH] * New subprocess design requires microcode 11.63 or later. * New procedures `make-pipe', `weak-delq!'. * Procedures for constructing generic I/O ports and for manipulating I/O channels are now exported to the global environment. * Automatically close input channels when EOF is encountered. --- v7/src/runtime/io.scm | 42 +++-- v7/src/runtime/list.scm | 26 ++- v7/src/runtime/process.scm | 326 ++++++++++++++++++++++++------------- v7/src/runtime/runtime.pkg | 142 ++++++++++------ v8/src/runtime/runtime.pkg | 142 ++++++++++------ 5 files changed, 445 insertions(+), 233 deletions(-) diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm index 2fa21d908..07010f221 100644 --- a/v7/src/runtime/io.scm +++ b/v7/src/runtime/io.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.17 1991/02/15 18:06:02 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.18 1991/03/01 01:06:03 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -282,6 +282,13 @@ MIT in each case. |# (define (file-set-position channel position) ((ucode-primitive file-set-position 2) (channel-descriptor channel) position)) + +(define (make-pipe) + (without-interrupts + (lambda () + (let ((pipe ((ucode-primitive make-pipe 0)))) + (values (make-channel (car pipe)) + (make-channel (cdr pipe))))))) ;;;; Terminal Primitives @@ -520,6 +527,7 @@ MIT in each case. |# (channel false read-only true) string start-index + ;; END-INDEX is zero iff CHANNEL is closed. end-index) (define (make-input-buffer channel buffer-size) @@ -539,12 +547,12 @@ MIT in each case. |# (define (input-buffer/set-size buffer buffer-size) ;; 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)) + (if (not (fix:= (input-buffer/end-index buffer) 0)) + (let ((buffer-size (if (fix:> buffer-size 1) buffer-size 1))) + (set-input-buffer/string! buffer (make-string buffer-size)) + (set-input-buffer/start-index! buffer buffer-size) + (set-input-buffer/end-index! buffer buffer-size) + buffer-size))) (define (input-buffer/flush buffer) (set-input-buffer/start-index! buffer (input-buffer/end-index buffer))) @@ -594,7 +602,9 @@ MIT in each case. |# (if end-index (begin (set-input-buffer/start-index! buffer 0) - (set-input-buffer/end-index! buffer end-index))) + (set-input-buffer/end-index! buffer end-index) + (if (fix:= end-index 0) + (channel-close (input-buffer/channel buffer))))) end-index)) (define-integrable (input-buffer/fill* buffer) @@ -717,11 +727,11 @@ MIT in each case. |# (input-buffer/end-index buffer)))) (define (input-buffer/set-buffer-contents buffer contents) - (let ((string (input-buffer/string buffer))) - (let ((current-size (string-length string)) - (contents-size (string-length contents))) - (if (fix:> contents-size current-size) - (input-buffer/set-size buffer contents-size)) - (substring-move-left! contents 0 contents-size string 0) - (set-input-buffer/start-index! buffer 0) - (set-input-buffer/end-index! buffer contents-size)))) \ No newline at end of file + (let ((contents-size (string-length contents))) + (if (fix:> contents-size 0) + (let ((string (input-buffer/string buffer))) + (if (fix:> contents-size (string-length string)) + (input-buffer/set-size buffer contents-size)) + (substring-move-left! contents 0 contents-size string 0) + (set-input-buffer/start-index! buffer 0) + (set-input-buffer/end-index! buffer contents-size))))) \ No newline at end of file diff --git a/v7/src/runtime/list.scm b/v7/src/runtime/list.scm index ef969a9f3..5d4608dc8 100644 --- a/v7/src/runtime/list.scm +++ b/v7/src/runtime/list.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/list.scm,v 14.12 1990/02/14 01:56:12 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/list.scm,v 14.13 1991/03/01 01:06:17 cph Exp $ -Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology +Copyright (c) 1988-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -226,6 +226,28 @@ MIT in each case. |# weak-list (loop (system-pair-cdr weak-list))))))) +(define (weak-delq! item items) + (letrec ((trim-initial-segment + (lambda (items) + (if (weak-pair? items) + (if (or (eq? item (system-pair-car items)) + (eq? false (system-pair-car items))) + (trim-initial-segment (system-pair-cdr items)) + (begin + (locate-initial-segment items (system-pair-cdr items)) + items)) + items))) + (locate-initial-segment + (lambda (last this) + (if (weak-pair? this) + (if (or (eq? item (system-pair-car this)) + (eq? false (system-pair-car this))) + (set-cdr! last + (trim-initial-segment (system-pair-cdr this))) + (locate-initial-segment this (system-pair-cdr this))) + this)))) + (trim-initial-segment items))) + (define (weak-list->list weak-list) (if (weak-pair? weak-list) (let ((car (system-pair-car weak-list))) diff --git a/v7/src/runtime/process.scm b/v7/src/runtime/process.scm index 90f6a991e..4858ea2e3 100644 --- a/v7/src/runtime/process.scm +++ b/v7/src/runtime/process.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/process.scm,v 1.5 1991/02/15 18:06:38 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/process.scm,v 1.6 1991/03/01 01:06:22 cph Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -37,71 +37,6 @@ MIT in each case. |# (declare (usual-integrations)) -(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:wrong-type-argument ctty-type false '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) - -(define (subprocess-list) - (list-copy subprocesses)) - (define subprocesses) (define scheme-subprocess-environment) @@ -113,55 +48,220 @@ MIT in each case. |# (set! subprocesses '()) (set! scheme-subprocess-environment ((ucode-primitive scheme-environment 0))) unspecific) + +(define (subprocess-list) + (list-copy subprocesses)) + +(define-structure (subprocess + (constructor %make-subprocess) + (conc-name subprocess-)) + index + pty-master + (id false read-only true) + input-channel + output-channel + %input-port + %output-port) + +(define (subprocess-input-port process) + (without-interrupts + (lambda () + (or (subprocess-%input-port process) + (let ((channel (subprocess-input-channel process))) + (and channel + (let ((input-port (make-generic-input-port channel 512)) + (output-port (subprocess-%output-port process))) + (set-subprocess-%input-port! process input-port) + (if output-port + (set-input-port/associated-port! input-port output-port)) + input-port))))))) + +(define (subprocess-output-port process) + (without-interrupts + (lambda () + (or (subprocess-%output-port process) + (let ((channel (subprocess-output-channel process))) + (and channel + (let ((output-port (make-generic-output-port channel 512)) + (input-port (subprocess-%input-port process))) + (set-subprocess-%output-port! process output-port) + (if input-port + (set-output-port/associated-port! output-port + input-port)) + output-port))))))) + +(define (make-subprocess filename arguments environment + ctty stdin stdout stderr + pty-master input-channel output-channel) + (let ((index + (let ((ctty-allowed? (string? ctty))) + (define-integrable (convert-stdio-arg stdio) + (cond ((not stdio) false) + ((eq? stdio 'INHERIT) -1) + ((and ctty-allowed? (eq? stdio 'CTTY)) -2) + ((channel? stdio) (channel-descriptor stdio)) + (else + (error:wrong-type-argument stdio "process I/O channel" + 'MAKE-SUBPROCESS)))) + ((ucode-primitive make-subprocess 7) + filename arguments environment + (cond ((eq? ctty 'BACKGROUND) -1) + ((eq? ctty 'FOREGROUND) -2) + ((or (not ctty) (string? ctty)) ctty) + (else + (error:wrong-type-argument ctty + "process controlling terminal" + 'MAKE-SUBPROCESS))) + (convert-stdio-arg stdin) + (convert-stdio-arg stdout) + (convert-stdio-arg stderr))))) + (let ((process + (%make-subprocess index + pty-master + ((ucode-primitive process-id 1) index) + input-channel + output-channel + false + false))) + (set! subprocesses (cons process subprocesses)) + (if (eq? ctty 'FOREGROUND) + (do ((status + ((ucode-primitive process-status 1) index) + ((ucode-primitive process-continue-foreground 1) index))) + ((not (fix:= status 0))))) + process))) + +(define (subprocess-delete process) + (without-interrupts + (lambda () + (if (subprocess-index process) + (begin + ;; `process-delete' will signal an error if the process is + ;; running or stopped. + ((ucode-primitive process-delete 1) (subprocess-index process)) + (set! subprocesses (delq! process subprocesses)) + (set-subprocess-index! process false) + (cond ((subprocess-input-port process) + => (lambda (input-port) + (set-subprocess-%input-port! process false) + (set-subprocess-input-channel! process false) + (close-input-port input-port))) + ((subprocess-input-channel process) + => (lambda (input-channel) + (set-subprocess-input-channel! process false) + (channel-close input-channel)))) + (cond ((subprocess-output-port process) + => (lambda (output-port) + (set-subprocess-%output-port! process false) + (set-subprocess-output-channel! process false) + (close-output-port output-port))) + ((subprocess-output-channel process) + => (lambda (output-channel) + (set-subprocess-output-channel! process false) + (channel-close output-channel)))) + (cond ((subprocess-pty-master process) + => (lambda (pty-master) + (set-subprocess-pty-master! process false) + (channel-close pty-master))))))))) (define (subprocess-status process) + (convert-subprocess-status + process + ((ucode-primitive process-status 1) (subprocess-index process)))) + +(define (subprocess-wait 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? + (let loop () + (let ((status ((ucode-primitive process-wait 1) index))) + (case status + ((0) (loop)) + (else (convert-subprocess-status process status))))))) + +(define (subprocess-continue-foreground process) + (let ((index (subprocess-index process))) + (let loop () + (let ((status ((ucode-primitive process-continue-foreground 1) index))) + (case status + ((0) (loop)) + (else (convert-subprocess-status process status))))))) + +(define (convert-subprocess-status process status) + (let ((get-reason + (lambda (status) + (cons status + ((ucode-primitive process-reason 1) + (subprocess-index process)))))) + (case status + ((0) 'RUNNING) + ((1) (get-reason 'STOPPED)) + ((2) (get-reason 'EXITED)) + ((3) (get-reason 'SIGNALLED)) + (else (error "Illegal process status:" status))))) + +(define (subprocess-job-control-status process) + (let ((n + ((ucode-primitive process-job-control-status 1) + (subprocess-index process)))) + (case n + ((0) 'NO-CTTY) + ((1) 'UNRELATED-CTTY) + ((2) 'NO-JOB-CONTROL) + ((3) 'JOB-CONTROL) + (else (error "Illegal process job-control status:" n))))) + +(define-integrable subprocess-job-control-available? (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 +(define (subprocess-continue-background process) + ((ucode-primitive process-continue-background 1) (subprocess-index process))) + +(define (subprocess-signal process signal) + ((ucode-primitive process-signal 2) (subprocess-index process) signal)) + +(define (subprocess-kill process) + ((ucode-primitive process-kill 1) (subprocess-index process))) + +(define (subprocess-interrupt process) + ((ucode-primitive process-interrupt 1) (subprocess-index process))) + +(define (subprocess-quit process) + ((ucode-primitive process-quit 1) (subprocess-index process))) + +(define (subprocess-stop process) + ((ucode-primitive process-stop 1) (subprocess-index process))) + +(define (start-batch-subprocess filename arguments environment) + (make-subprocess filename arguments environment + false false false false + false false false)) + +(define (start-subprocess-in-background filename arguments environment) + (make-subprocess filename arguments environment + 'BACKGROUND 'INHERIT 'INHERIT 'INHERIT + false false false)) + +(define (run-subprocess-in-foreground filename arguments environment) + (make-subprocess filename arguments environment + 'FOREGROUND 'INHERIT 'INHERIT 'INHERIT + false false false)) + +(define (start-pipe-subprocess filename arguments environment) + (with-values make-pipe + (lambda (child-read parent-write) + (with-values make-pipe + (lambda (parent-read child-write) + (let ((process + (make-subprocess filename arguments environment + false child-read child-write child-write + false parent-read parent-write))) + (channel-close child-read) + (channel-close child-write) + process)))))) + +(define (start-pty-subprocess filename arguments environment) + (with-values open-pty-master + (lambda (master-channel master-name slave-name) + master-name + (make-subprocess filename arguments environment + slave-name 'CTTY 'CTTY 'CTTY + master-channel master-channel master-channel)))) \ No newline at end of file diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index d44b03a38..c23350ed4 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.90 1991/02/19 22:45:36 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.91 1991/03/01 01:06:31 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -53,8 +53,9 @@ MIT in each case. |# (else)) (file-case os-type ((unix) "unxpth" "unxprm") - ((vms) "vmspth") - (else "unkpth"))) + ;;((vms) "vmspth") + ;;(else "unkpth") + (else))) (define-package (package) ;; The information appearing here must be duplicated in the cold load @@ -443,7 +444,8 @@ MIT in each case. |# (define-package (runtime directory) (file-case os-type ((unix) "unxdir") - (else "unkdir")) + ;;(else "unkdir") + (else)) (parent ()) (export () directory-read) @@ -737,6 +739,9 @@ MIT in each case. |# (define-package (runtime generic-input) (files "genin") (parent ()) + (export () + make-generic-input-port + set-input-port/associated-port!) (export (runtime console-input) operation/buffer-size operation/buffered-chars @@ -758,17 +763,14 @@ MIT in each case. |# 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 () + make-generic-output-port + set-output-port/associated-port!) (export (runtime console-output) operation/buffer-size operation/buffered-chars @@ -783,12 +785,6 @@ MIT in each case. |# 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) @@ -1070,6 +1066,7 @@ MIT in each case. |# weak-car weak-cdr weak-cons + weak-delq! weak-list->list weak-memq weak-pair/car? @@ -1415,8 +1412,9 @@ MIT in each case. |# (define-package (runtime pathname-parser) (file-case os-type ((unix) "unxpar") - ((vms) "vmspar") - (else "unkpar")) + ;;((vms) "vmspar") + ;;(else "unkpar") + (else)) (parent (runtime pathname)) (export () pathname-as-directory) @@ -1426,8 +1424,9 @@ MIT in each case. |# (define-package (runtime pathname-unparser) (file-case os-type ((unix) "unxunp") - ((vms) "vmsunp") - (else "unkunp")) + ;;((vms) "vmsunp") + ;;(else "unkunp") + (else)) (parent (runtime pathname)) (export (runtime pathname) pathname-unparse @@ -1459,21 +1458,64 @@ MIT in each case. |# (files "io") (parent ()) (export () - close-all-open-files - copy-file) - (export (runtime socket) + channel-blocking + channel-blocking? channel-close - channel-descriptor - make-channel - with-channel-blocking) - (export (runtime subprocess) - make-channel + channel-nonblocking + channel-read + channel-read-block + channel-table + channel-type + channel-type=block-device? + channel-type=character-device? + channel-type=directory? + channel-type=file? + channel-type=pty-master? + channel-type=terminal? + channel-type=unknown? + channel-write + channel-write-block + channel-write-char-block + channel-write-string-block + channel? + close-all-open-files + copy-file + file-length + file-open-append-channel + file-open-input-channel + file-open-io-channel + file-open-output-channel + file-position + file-set-position + make-pipe + open-pty-master pty-master-continue pty-master-interrupt pty-master-kill pty-master-quit pty-master-send-signal - pty-master-stop) + pty-master-stop + terminal-cooked-input + terminal-cooked-input? + terminal-cooked-output + terminal-cooked-output? + terminal-drain-output + terminal-flush-input + terminal-flush-output + terminal-get-state + terminal-input-baud-rate + terminal-output-baud-rate + terminal-raw-input + terminal-raw-output + terminal-set-state + tty-input-channel + tty-output-channel + with-channel-blocking) + (export (runtime socket) + channel-descriptor + make-channel) + (export (runtime subprocess) + channel-descriptor) (export (runtime generic-input) bind-port-for-errors input-buffer/buffered-chars @@ -1503,18 +1545,13 @@ MIT in each case. |# output-buffer/write-string-block) (export (runtime file-input) bind-port-for-errors - 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) bind-port-for-errors - channel-type=file? input-buffer/buffer-contents input-buffer/buffered-chars input-buffer/channel @@ -1525,8 +1562,7 @@ MIT in each case. |# input-buffer/set-buffer-contents input-buffer/set-size input-buffer/size - make-input-buffer - tty-input-channel) + make-input-buffer) (export (runtime console-output) bind-port-for-errors make-output-buffer @@ -1535,15 +1571,7 @@ MIT in each case. |# 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 - terminal-cooked-output - terminal-get-state - terminal-raw-input - terminal-set-state) + output-buffer/write-string-block) (initialization (initialize-package!))) (define-package (runtime program-copier) @@ -1898,21 +1926,32 @@ MIT in each case. |# (parent ()) (export () make-subprocess - os-job-control? + run-subprocess-in-foreground scheme-subprocess-environment - subprocess-continue - subprocess-ctty-type + start-batch-subprocess + start-pipe-subprocess + start-pty-subprocess + start-subprocess-in-background + subprocess-continue-background + subprocess-continue-foreground subprocess-delete subprocess-id + subprocess-input-channel subprocess-input-port subprocess-interrupt + subprocess-job-control-available? + subprocess-job-control-status subprocess-kill subprocess-list + subprocess-output-channel subprocess-output-port + subprocess-pty-master subprocess-quit subprocess-signal subprocess-status - subprocess-stop) + subprocess-stop + subprocess-wait + subprocess?) (initialization (initialize-package!))) (define-package (runtime graphics) @@ -2172,8 +2211,9 @@ MIT in each case. |# (define-package (runtime working-directory) (file-case os-type ((unix) "unxcwd") - ((vms) "vmscwd") - (else "unkcwd")) + ;;((vms) "vmscwd") + ;;(else "unkcwd") + (else)) (files "wrkdir") (parent ()) (export () diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 56db058b1..ad478cd75 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.90 1991/02/19 22:45:36 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.91 1991/03/01 01:06:31 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -53,8 +53,9 @@ MIT in each case. |# (else)) (file-case os-type ((unix) "unxpth" "unxprm") - ((vms) "vmspth") - (else "unkpth"))) + ;;((vms) "vmspth") + ;;(else "unkpth") + (else))) (define-package (package) ;; The information appearing here must be duplicated in the cold load @@ -443,7 +444,8 @@ MIT in each case. |# (define-package (runtime directory) (file-case os-type ((unix) "unxdir") - (else "unkdir")) + ;;(else "unkdir") + (else)) (parent ()) (export () directory-read) @@ -737,6 +739,9 @@ MIT in each case. |# (define-package (runtime generic-input) (files "genin") (parent ()) + (export () + make-generic-input-port + set-input-port/associated-port!) (export (runtime console-input) operation/buffer-size operation/buffered-chars @@ -758,17 +763,14 @@ MIT in each case. |# 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 () + make-generic-output-port + set-output-port/associated-port!) (export (runtime console-output) operation/buffer-size operation/buffered-chars @@ -783,12 +785,6 @@ MIT in each case. |# 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) @@ -1070,6 +1066,7 @@ MIT in each case. |# weak-car weak-cdr weak-cons + weak-delq! weak-list->list weak-memq weak-pair/car? @@ -1415,8 +1412,9 @@ MIT in each case. |# (define-package (runtime pathname-parser) (file-case os-type ((unix) "unxpar") - ((vms) "vmspar") - (else "unkpar")) + ;;((vms) "vmspar") + ;;(else "unkpar") + (else)) (parent (runtime pathname)) (export () pathname-as-directory) @@ -1426,8 +1424,9 @@ MIT in each case. |# (define-package (runtime pathname-unparser) (file-case os-type ((unix) "unxunp") - ((vms) "vmsunp") - (else "unkunp")) + ;;((vms) "vmsunp") + ;;(else "unkunp") + (else)) (parent (runtime pathname)) (export (runtime pathname) pathname-unparse @@ -1459,21 +1458,64 @@ MIT in each case. |# (files "io") (parent ()) (export () - close-all-open-files - copy-file) - (export (runtime socket) + channel-blocking + channel-blocking? channel-close - channel-descriptor - make-channel - with-channel-blocking) - (export (runtime subprocess) - make-channel + channel-nonblocking + channel-read + channel-read-block + channel-table + channel-type + channel-type=block-device? + channel-type=character-device? + channel-type=directory? + channel-type=file? + channel-type=pty-master? + channel-type=terminal? + channel-type=unknown? + channel-write + channel-write-block + channel-write-char-block + channel-write-string-block + channel? + close-all-open-files + copy-file + file-length + file-open-append-channel + file-open-input-channel + file-open-io-channel + file-open-output-channel + file-position + file-set-position + make-pipe + open-pty-master pty-master-continue pty-master-interrupt pty-master-kill pty-master-quit pty-master-send-signal - pty-master-stop) + pty-master-stop + terminal-cooked-input + terminal-cooked-input? + terminal-cooked-output + terminal-cooked-output? + terminal-drain-output + terminal-flush-input + terminal-flush-output + terminal-get-state + terminal-input-baud-rate + terminal-output-baud-rate + terminal-raw-input + terminal-raw-output + terminal-set-state + tty-input-channel + tty-output-channel + with-channel-blocking) + (export (runtime socket) + channel-descriptor + make-channel) + (export (runtime subprocess) + channel-descriptor) (export (runtime generic-input) bind-port-for-errors input-buffer/buffered-chars @@ -1503,18 +1545,13 @@ MIT in each case. |# output-buffer/write-string-block) (export (runtime file-input) bind-port-for-errors - 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) bind-port-for-errors - channel-type=file? input-buffer/buffer-contents input-buffer/buffered-chars input-buffer/channel @@ -1525,8 +1562,7 @@ MIT in each case. |# input-buffer/set-buffer-contents input-buffer/set-size input-buffer/size - make-input-buffer - tty-input-channel) + make-input-buffer) (export (runtime console-output) bind-port-for-errors make-output-buffer @@ -1535,15 +1571,7 @@ MIT in each case. |# 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 - terminal-cooked-output - terminal-get-state - terminal-raw-input - terminal-set-state) + output-buffer/write-string-block) (initialization (initialize-package!))) (define-package (runtime program-copier) @@ -1898,21 +1926,32 @@ MIT in each case. |# (parent ()) (export () make-subprocess - os-job-control? + run-subprocess-in-foreground scheme-subprocess-environment - subprocess-continue - subprocess-ctty-type + start-batch-subprocess + start-pipe-subprocess + start-pty-subprocess + start-subprocess-in-background + subprocess-continue-background + subprocess-continue-foreground subprocess-delete subprocess-id + subprocess-input-channel subprocess-input-port subprocess-interrupt + subprocess-job-control-available? + subprocess-job-control-status subprocess-kill subprocess-list + subprocess-output-channel subprocess-output-port + subprocess-pty-master subprocess-quit subprocess-signal subprocess-status - subprocess-stop) + subprocess-stop + subprocess-wait + subprocess?) (initialization (initialize-package!))) (define-package (runtime graphics) @@ -2172,8 +2211,9 @@ MIT in each case. |# (define-package (runtime working-directory) (file-case os-type ((unix) "unxcwd") - ((vms) "vmscwd") - (else "unkcwd")) + ;;((vms) "vmscwd") + ;;(else "unkcwd") + (else)) (files "wrkdir") (parent ()) (export () -- 2.25.1