Use new I/O synchronization support in runtime system.

diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index 7cd3f0d8d2c23e0e1a32f3c9e0af2c9a706cf5e0..fd5d90c987dac00b575ba34ec3311fca87b70c4a 100644 (file)
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 3.116 2002/11/20 19:46:00 cph Exp $
+$Id: make.scm,v 3.117 2003/01/22 18:43:32 cph Exp $
 
-Copyright (c) 1989-2002 Massachusetts Institute of Technology
+Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology
+Copyright 1995,2000,2001,2002,2003 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -38,4 +39,4 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
        (load-package-set "edwin"
         `((alternate-package-loader
            . ,(load "edwin.bld" system-global-environment))))))))
-(add-identification! "Edwin" 3 113)
\ No newline at end of file
+(add-identification! "Edwin" 3 114)
\ No newline at end of file

diff --git a/v7/src/edwin/os2term.scm b/v7/src/edwin/os2term.scm
index 2adcb567b968f3fb2f5c0e2d5fd048221cfbac61..a73cd11a84c6eeba6346c1fa39e844078448adf9 100644 (file)
--- a/v7/src/edwin/os2term.scm
+++ b/v7/src/edwin/os2term.scm
@@ -1,25 +1,26 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: os2term.scm,v 1.23 2002/11/20 19:46:01 cph Exp $
-;;;
-;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: os2term.scm,v 1.24 2003/01/22 18:43:39 cph Exp $
+
+Copyright 1994,1995,1996,1997,2000,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
 
 ;;;; OS/2 Presentation Manager Interface
 ;;; Package: (edwin screen os2-screen)
@@ -92,7 +93,7 @@
                  (lambda ()
                    (receiver (lambda (thunk) (thunk)) '()))
                  (lambda ()
-                   (deregister-input-thread-event previewer-registration)))))
+                   (deregister-io-thread-event previewer-registration)))))
 
 (define (with-os2-interrupts-enabled thunk)
   (with-signal-interrupts #t thunk))
@@ -728,8 +729,9 @@
                 event:process-status)
                (else
                 (let ((flag
-                       (test-for-input-on-descriptor event-descriptor
-                                                     block?)))
+                       (test-for-io-on-descriptor event-descriptor
+                                                  block?
+                                                  'READ)))
                   (set-interrupt-enables! interrupt-mask)
                   (case flag
                     ((#F) #f)
@@ -743,10 +745,12 @@
 \f
 (define (preview-event-stream)
   (set! previewer-registration
-       (permanently-register-input-thread-event
+       (permanently-register-io-thread-event
         event-descriptor
+        'READ
         (current-thread)
-        (lambda ()
+        (lambda (mode)
+          mode
           (if (not reading-event?)
               (let ((event (os2win-get-event event-descriptor #f)))
                 (if event

diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index 7bf116bd06c95f9b44570d6e10a2fee56183464c..e3440757423e5939e99ca7211c9f9f3dfbb73258 100644 (file)
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: process.scm,v 1.63 2003/01/10 20:24:40 cph Exp $
+$Id: process.scm,v 1.64 2003/01/22 18:43:45 cph Exp $
 
 Copyright 1991,1992,1993,1996,1997,1999 Massachusetts Institute of Technology
 Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology
@@ -132,7 +132,7 @@ Initialized from the SHELL environment variable."
     (if registration
        (begin
          (set-process-input-registration! process #f)
-         (deregister-input-thread-event registration)))))
+         (deregister-io-thread-event registration)))))
 \f
 (define (start-process name buffer environment program . arguments)
   (let ((make-subprocess
@@ -218,10 +218,12 @@ Initialized from the SHELL environment variable."
 (define (register-process-input process channel)
   (set-process-input-registration!
    process
-   (permanently-register-input-thread-event
+   (permanently-register-io-thread-event
     (channel-descriptor-for-select channel)
+    'READ
     (current-thread)
-    (lambda ()
+    (lambda (mode)
+      mode
       (let ((queue process-input-queue))
        (if (not (memq process (car queue)))
            (let ((tail (list process)))

diff --git a/v7/src/edwin/tterm.scm b/v7/src/edwin/tterm.scm
index 297dda4305ecf915d8357626fbd63266989b4158..a9898fd246e930c4dd9ba1a68a13df434b46c9b3 100644 (file)
--- a/v7/src/edwin/tterm.scm
+++ b/v7/src/edwin/tterm.scm
@@ -1,8 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: tterm.scm,v 1.35 2002/11/20 19:46:04 cph Exp $
+$Id: tterm.scm,v 1.36 2003/01/22 18:43:51 cph Exp $
 
-Copyright (c) 1990-1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1990,1991,1993,1994,1998,1999 Massachusetts Institute of Technology
+Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
 This file is part of MIT Scheme.
 
@@ -249,9 +250,10 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
                        ((not have-select?)
                         (and block? (read-event block?)))
                        (else
-                        (case (test-for-input-on-descriptor
+                        (case (test-for-io-on-descriptor
                                (channel-descriptor-for-select channel)
-                               block?)
+                               block?
+                               'READ)
                           ((#F) #f)
                           ((PROCESS-STATUS-CHANGE) event:process-status)
                           ((INTERRUPT) (loop))

diff --git a/v7/src/edwin/win32.scm b/v7/src/edwin/win32.scm
index a7581e95066f6eae2cc5ca9467c65deaf882587c..ace2927a59835580146eae05855aef5defbd26f8 100644 (file)
--- a/v7/src/edwin/win32.scm
+++ b/v7/src/edwin/win32.scm
@@ -1,28 +1,30 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: win32.scm,v 1.16 2002/11/20 19:46:04 cph Exp $
-;;;
-;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
-
-;;;;Win32 Terminal
-;;; package (edwin screen win32)
+#| -*-Scheme-*-
+
+$Id: win32.scm,v 1.17 2003/01/22 18:43:57 cph Exp $
+
+Copyright 1994,1995,1996,1997,1999,2000 Massachusetts Institute of Technology
+Copyright 2002,2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
+
+;;;; Win32 Terminal
+;;; package: (edwin screen win32)
 \f
 (declare (usual-integrations))
 
@@ -331,7 +333,7 @@
     (dynamic-wind
      (lambda () (preview-event-stream))
      (lambda () (receiver (lambda (thunk) (thunk)) '()))
-     (lambda () (deregister-input-thread-event previewer-registration)))))
+     (lambda () (deregister-io-thread-event previewer-registration)))))
 
 (define (with-win32-interrupts-enabled thunk)
   (with-signal-interrupts #t thunk))
@@ -450,10 +452,10 @@
                 event:process-status)
                (else
                 (let ((flag
-                       (test-for-input-on-descriptor
+                       (test-for-io-on-descriptor
                         ;; console-channel-descriptor here
                         ;; means "input from message queue".
-                        console-channel-descriptor block?)))
+                        console-channel-descriptor block? 'READ)))
                   (set-interrupt-enables! mask)
                   (case flag
                     ((#F) #f)
@@ -475,10 +477,12 @@
 
 (define (preview-event-stream)
   (set! previewer-registration
-       (permanently-register-input-thread-event
+       (permanently-register-io-thread-event
         console-channel-descriptor
+        'READ
         (current-thread)
-        (lambda ()
+        (lambda (mode)
+          mode
           (if (not reading-event?)
               (let ((event (read-event-2)))
                 (if event

diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 4afb6df3b104bc80809a26f4fc7da2e11f517fa8..04edfa7f01fb11cc06f8160d0873f8f11957b893 100644 (file)
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,25 +1,28 @@
-;;; -*-Scheme-*-
-;;;
-;;; $Id: xterm.scm,v 1.70 2002/11/20 19:46:05 cph Exp $
-;;;
-;;; Copyright (c) 1989-2002 Massachusetts Institute of Technology
-;;;
-;;; This file is part of MIT Scheme.
-;;;
-;;; MIT Scheme is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation; either version 2 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; MIT Scheme is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with MIT Scheme; if not, write to the Free Software
-;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;;; 02111-1307, USA.
+#| -*-Scheme-*-
+
+$Id: xterm.scm,v 1.71 2003/01/22 18:44:04 cph Exp $
+
+Copyright 1989,1990,1991,1992,1993,1995 Massachusetts Institute of Technology
+Copyright 1996,1998,1999,2000,2001,2002 Massachusetts Institute of Technology
+Copyright 2003 Massachusetts Institute of Technology
+
+This file is part of MIT Scheme.
+
+MIT Scheme is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2 of the License, or (at your
+option) any later version.
+
+MIT Scheme is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with MIT Scheme; if not, write to the Free Software Foundation,
+Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+|#
 
 ;;;; X Terminal
 ;;; Package: (edwin x-screen)
@@ -556,9 +559,10 @@
                 event:process-status)
                (else
                 (let ((flag
-                       (test-for-input-on-descriptor
+                       (test-for-io-on-descriptor
                         (x-display-descriptor display)
-                        block?)))
+                        block?
+                        'READ)))
                   (set-interrupt-enables! interrupt-mask)
                   (case flag
                     ((#F) #f)
@@ -568,10 +572,12 @@
 \f
 (define (preview-event-stream)
   (set! previewer-registration
-       (permanently-register-input-thread-event
+       (permanently-register-io-thread-event
         (x-display-descriptor x-display-data)
+        'READ
         (current-thread)
-        (lambda ()
+        (lambda (mode)
+          mode
           (if (not reading-event?)
               (let ((event (x-display-process-events x-display-data 2)))
                 (if event
@@ -1312,7 +1318,7 @@ Otherwise, it is copied from the primary selection."
      preview-event-stream
      (lambda () (receiver (lambda (thunk) (thunk)) '()))
      (lambda ()
-       (deregister-input-thread-event previewer-registration)))))
+       (deregister-io-thread-event previewer-registration)))))
 
 (define (with-x-interrupts-enabled thunk)
   (with-signal-interrupts #t thunk))