From: Chris Hanson Date: Wed, 22 Jan 2003 18:44:04 +0000 (+0000) Subject: Use new I/O synchronization support in runtime system. X-Git-Tag: 20090517-FFI~2056 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e2a81035858db7689bf90858e34493be0346ebfd;p=mit-scheme.git Use new I/O synchronization support in runtime system. --- diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm index 7cd3f0d8d..fd5d90c98 100644 --- 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 2adcb567b..a73cd11a8 100644 --- 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 @@ (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 7bf116bd0..e34407574 100644 --- 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))))) (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 297dda430..a9898fd24 100644 --- 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 a7581e950..ace2927a5 100644 --- 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) (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 4afb6df3b..04edfa7f0 100644 --- 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 @@ (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))