From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 11 Mar 1991 23:48:20 +0000 (+0000)
Subject: Add new procedures for microcode 11.67: `channel-register',
X-Git-Tag: 20090517-FFI~10860
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e3b7901b525bcd8a4e4f2ccf7b521d1606c3c25d;p=mit-scheme.git

Add new procedures for microcode 11.67: `channel-register',
`channel-unregister', `channel-registered?',
`channel-select-then-read', and `subprocess-global-status-tick'.
---

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 5ed9885a6..1024ae053 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.21 1991/03/10 22:42:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/io.scm,v 14.22 1991/03/11 23:48:00 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -200,6 +200,10 @@ MIT in each case. |#
 	(ucode-primitive channel-close 1)
 	(ucode-primitive channel-nonblocking 1)
 	(ucode-primitive channel-read 4)
+	(ucode-primitive channel-register 1)
+	(ucode-primitive channel-registered? 1)
+	(ucode-primitive channel-select-then-read 4)
+	(ucode-primitive channel-unregister 1)
 	(ucode-primitive channel-write 4)
 	(ucode-primitive file-length-new 1)
 	(ucode-primitive file-position 1)
@@ -279,6 +283,19 @@ MIT in each case. |#
 		     (channel-nonblocking channel)))))))
       (thunk)))
 
+(define (channel-registered? channel)
+  ((ucode-primitive channel-registered? 1) (channel-descriptor channel)))
+
+(define (channel-register channel)
+  ((ucode-primitive channel-register 1) (channel-descriptor channel)))
+
+(define (channel-unregister channel)
+  ((ucode-primitive channel-unregister 1) (channel-descriptor channel)))
+
+(define (channel-select-then-read channel buffer start end)
+  ((ucode-primitive channel-select-then-read 4) (channel-descriptor channel)
+						buffer start end))
+
 (define (channel-table)
   (fluid-let ((traversing? true))
     (without-interrupts
diff --git a/v7/src/runtime/process.scm b/v7/src/runtime/process.scm
index 609294b91..58e06d5cd 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.9 1991/03/09 21:33:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/process.scm,v 1.10 1991/03/11 23:48:06 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -39,6 +39,7 @@ MIT in each case. |#
 
 (define subprocesses)
 (define scheme-subprocess-environment)
+(define global-status-tick)
 
 (define (initialize-package!)
   (reset-package!)
@@ -47,6 +48,7 @@ MIT in each case. |#
 (define (reset-package!)
   (set! subprocesses '())
   (set! scheme-subprocess-environment ((ucode-primitive scheme-environment 0)))
+  (set! global-status-tick (cons false false))
   unspecific)
 
 (define (subprocess-list)
@@ -226,6 +228,15 @@ MIT in each case. |#
 	(set-subprocess-%status-tick! process tick)
 	tick)))
 
+(define (subprocess-global-status-tick)
+  (without-interrupts
+   (lambda ()
+     (if ((ucode-primitive process-status-sync-all 0))
+	 (let ((tick (cons false false)))
+	   (set! global-status-tick tick)
+	   tick)
+	 global-status-tick))))
+
 (define (convert-subprocess-status status)
   (case status
     ((0) 'RUNNING)
@@ -233,7 +244,7 @@ MIT in each case. |#
     ((2) 'EXITED)
     ((3) 'SIGNALLED)
     (else (error "Illegal process status:" status))))
-
+
 (define (subprocess-job-control-status process)
   (let ((n
 	 ((ucode-primitive process-job-control-status 1)
@@ -265,7 +276,7 @@ MIT in each case. |#
 
 (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
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index edf17dfde..a589e3fa0 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.97 1991/03/10 22:42:32 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.98 1991/03/11 23:48:12 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -1466,6 +1466,10 @@ MIT in each case. |#
 	  channel-port
 	  channel-read
 	  channel-read-block
+	  channel-register
+	  channel-registered?
+	  channel-select-then-read
+	  channel-unregister
 	  channel-table
 	  channel-type
 	  channel-type=block-device?
@@ -1947,6 +1951,7 @@ MIT in each case. |#
 	  subprocess-exit-reason
 	  subprocess-filename
 	  subprocess-get
+	  subprocess-global-status-tick
 	  subprocess-id
 	  subprocess-input-channel
 	  subprocess-input-port
diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 3cbd4eb15..19214384d 100644
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.111 1991/03/10 22:43:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.112 1991/03/11 23:48:20 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
 		     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 111))
+  (add-identification! "Runtime" 14 112))
 
 (define microcode-system)
 
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index b5f7c5840..1db325435 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.97 1991/03/10 22:42:32 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.98 1991/03/11 23:48:12 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -1466,6 +1466,10 @@ MIT in each case. |#
 	  channel-port
 	  channel-read
 	  channel-read-block
+	  channel-register
+	  channel-registered?
+	  channel-select-then-read
+	  channel-unregister
 	  channel-table
 	  channel-type
 	  channel-type=block-device?
@@ -1947,6 +1951,7 @@ MIT in each case. |#
 	  subprocess-exit-reason
 	  subprocess-filename
 	  subprocess-get
+	  subprocess-global-status-tick
 	  subprocess-id
 	  subprocess-input-channel
 	  subprocess-input-port