From b2cbf46c891bbac47f8e530a97065f316a21b9e3 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 25 Feb 1992 22:57:27 +0000 Subject: [PATCH] * Ports now have a mutex that can be used to implement cooperative locking of the port. Command loops use this mutex to guarantee that only one thread at a time uses the port. * The standard error handler notices when it is about to start a REPL on a port that is locked by a thread different from the signalling thread, transforms the error into a derived thread error, and signals the derived error to the locking thread. * The procedures KEYBOARD-INTERRUPT-THREAD and SET-KEYBOARD-INTERRUPT-THREAD! have been eliminated. Keyboard interrupts are sent to the locking thread of the console I/O port. * New procedure THREAD-MUTEX-OWNER returns the locking thread of a mutex, or #F indicating that the mutex is unlocked. * New procedure WITH-THREAD-MUTEX-LOCKED locks a mutex over a dynamic extent. If the calling thread already holds the lock, this procedure does not signal an error and does not unlock the mutex at the end of the extent. --- v7/src/runtime/error.scm | 47 ++++++++++++++++++--- v7/src/runtime/intrpt.scm | 50 +++++++++-------------- v7/src/runtime/make.scm | 6 +-- v7/src/runtime/port.scm | 12 ++++-- v7/src/runtime/rep.scm | 5 ++- v7/src/runtime/runtime.pkg | 14 ++++--- v7/src/runtime/thread.scm | 83 ++++++++++++++++++++++++++++---------- v7/src/runtime/version.scm | 4 +- v8/src/runtime/make.scm | 6 +-- v8/src/runtime/runtime.pkg | 14 ++++--- 10 files changed, 160 insertions(+), 81 deletions(-) diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm index 57c5dffe9..d918ddf35 100644 --- a/v7/src/runtime/error.scm +++ b/v7/src/runtime/error.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.29 1991/11/26 07:05:41 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.30 1992/02/25 22:54:36 cph Exp $ -Copyright (c) 1988-91 Massachusetts Institute of Technology +Copyright (c) 1988-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -510,7 +510,16 @@ MIT in each case. |# (if hook (fluid-let ((standard-error-hook false)) (hook condition)))) - (repl/start (push-repl 'INHERIT 'INHERIT condition '() "error>"))) + (let ((thread (current-thread)) + (owner (thread-mutex-owner (port/thread-mutex (nearest-cmdl/port))))) + (if (and owner (not (eq? thread owner))) + (begin + (signal-thread-event owner + (lambda () + (unblock-thread-events) + (error:derived-thread thread condition))) + (suspend-current-thread)) + (repl/start (push-repl 'INHERIT 'INHERIT condition '() "error>"))))) (define (standard-warning-handler condition) (let ((hook standard-warning-hook)) @@ -600,6 +609,7 @@ MIT in each case. |# (define condition-type:datum-out-of-range) (define condition-type:derived-file-error) (define condition-type:derived-port-error) +(define condition-type:derived-thread-error) (define condition-type:divide-by-zero) (define condition-type:error) (define condition-type:file-error) @@ -613,6 +623,7 @@ MIT in each case. |# (define condition-type:simple-condition) (define condition-type:simple-error) (define condition-type:simple-warning) +(define condition-type:thread-error) (define condition-type:unassigned-variable) (define condition-type:unbound-variable) (define condition-type:variable-error) @@ -631,6 +642,7 @@ MIT in each case. |# (define error:no-such-restart) (define error:derived-file) (define error:derived-port) +(define error:derived-thread) (define error:wrong-number-of-arguments) (define error:wrong-type-argument) (define error:wrong-type-datum) @@ -820,7 +832,8 @@ MIT in each case. |# (write-string "." port)))))) (set! condition-type:port-error (anonymous-error 'PORT-ERROR 'PORT)) (set! condition-type:file-error (anonymous-error 'FILE-ERROR 'FILENAME)) - (set! condition-type:cell-error (anonymous-error 'CELL-ERROR 'LOCATION))) + (set! condition-type:cell-error (anonymous-error 'CELL-ERROR 'LOCATION)) + (set! condition-type:thread-error (anonymous-error 'THREAD-ERROR 'THREAD))) (set! condition-type:derived-port-error (make-condition-type 'DERIVED-PORT-ERROR condition-type:port-error @@ -828,7 +841,7 @@ MIT in each case. |# (lambda (condition port) (write-string "The port " port) (write (access-condition condition 'PORT) port) - (write-string " received an error:" port) + (write-string " signalled an error:" port) (newline port) (write-condition-report (access-condition condition 'CONDITION) port)))) @@ -850,7 +863,7 @@ MIT in each case. |# (lambda (condition port) (write-string "The file " port) (write (access-condition condition 'FILENAME) port) - (write-string " received an error:" port) + (write-string " signalled an error:" port) (newline port) (write-condition-report (access-condition condition 'CONDITION) port)))) @@ -865,6 +878,28 @@ MIT in each case. |# (%condition/restarts condition) filename condition))))) + + (set! condition-type:derived-thread-error + (make-condition-type 'DERIVED-THREAD-ERROR condition-type:thread-error + '(CONDITION) + (lambda (condition port) + (write-string "The thread " port) + (write (access-condition condition 'THREAD) port) + (write-string " signalled an error:" port) + (newline port) + (write-condition-report (access-condition condition 'CONDITION) + port)))) + + (set! error:derived-thread + (let ((make-condition + (condition-constructor condition-type:derived-thread-error + '(THREAD CONDITION)))) + (lambda (thread condition) + (guarantee-condition condition 'ERROR:DERIVED-THREAD) + (error (make-condition (%condition/continuation condition) + (%condition/restarts condition) + thread + condition))))) (set! condition-type:file-operation-error (make-condition-type 'FILE-OPERATION-ERROR condition-type:file-error diff --git a/v7/src/runtime/intrpt.scm b/v7/src/runtime/intrpt.scm index d433430a0..108a9ca31 100644 --- a/v7/src/runtime/intrpt.scm +++ b/v7/src/runtime/intrpt.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/intrpt.scm,v 14.9 1992/02/08 15:08:27 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/intrpt.scm,v 14.10 1992/02/25 22:55:20 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -42,7 +42,6 @@ MIT in each case. |# (fixed-objects-vector-slot 'SYSTEM-INTERRUPT-VECTOR)) (set! index:termination-vector (fixed-objects-vector-slot 'MICROCODE-TERMINATIONS-PROCEDURES)) - (set! keyboard-thread false) (set! hook/clean-input/flush-typeahead false) (set! hook/clean-input/keep-typeahead false) (set! hook/^B-interrupt false) @@ -117,7 +116,6 @@ MIT in each case. |# ;;;; Keyboard Interrupts (define keyboard-interrupt-vector) -(define keyboard-thread) (define hook/clean-input/flush-typeahead) (define hook/clean-input/keep-typeahead) (define hook/^B-interrupt) @@ -125,17 +123,6 @@ MIT in each case. |# (define hook/^U-interrupt) (define hook/^X-interrupt) -(define (keyboard-interrupt-thread) - keyboard-thread) - -(define (set-keyboard-interrupt-thread! thread) - (if (not (or (not thread) (thread? thread))) - (error:wrong-type-argument thread - "thread or #f" - set-keyboard-interrupt-thread!)) - (set! keyboard-thread thread) - unspecific) - (define (external-interrupt-handler interrupt-code interrupt-mask) interrupt-code interrupt-mask (clear-interrupts! interrupt-bit/kbd) @@ -148,34 +135,37 @@ MIT in each case. |# (define (^B-interrupt-handler char) (if hook/^B-interrupt (hook/^B-interrupt)) - (if (and (or (not hook/clean-input/keep-typeahead) - (hook/clean-input/keep-typeahead char)) - keyboard-thread) - (signal-thread-event keyboard-thread cmdl-interrupt/breakpoint))) + (signal-interrupt hook/clean-input/keep-typeahead + char + cmdl-interrupt/breakpoint)) (define (^G-interrupt-handler char) (if hook/^G-interrupt (hook/^G-interrupt)) - (if (and (or (not hook/clean-input/flush-typeahead) - (hook/clean-input/flush-typeahead char)) - keyboard-thread) - (signal-thread-event keyboard-thread cmdl-interrupt/abort-top-level))) + (signal-interrupt hook/clean-input/flush-typeahead + char + cmdl-interrupt/abort-top-level)) (define (^U-interrupt-handler char) (if hook/^U-interrupt (hook/^U-interrupt)) - (if (and (or (not hook/clean-input/flush-typeahead) - (hook/clean-input/flush-typeahead char)) - keyboard-thread) - (signal-thread-event keyboard-thread cmdl-interrupt/abort-previous))) + (signal-interrupt hook/clean-input/flush-typeahead + char + cmdl-interrupt/abort-previous)) (define (^X-interrupt-handler char) (if hook/^X-interrupt (hook/^X-interrupt)) - (if (and (or (not hook/clean-input/flush-typeahead) - (hook/clean-input/flush-typeahead char)) - keyboard-thread) - (signal-thread-event keyboard-thread cmdl-interrupt/abort-nearest))) + (signal-interrupt hook/clean-input/flush-typeahead + char + cmdl-interrupt/abort-nearest)) + +(define (signal-interrupt hook/clean-input char interrupt) + (if (or (not hook/clean-input) + (hook/clean-input char)) + (let ((thread (thread-mutex-owner (port/thread-mutex console-i/o-port)))) + (if thread + (signal-thread-event thread interrupt))))) (define (install) (without-interrupts diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm index 8c830bd11..5a3f5eeb5 100644 --- a/v7/src/runtime/make.scm +++ b/v7/src/runtime/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.33 1992/02/08 15:08:31 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.34 1992/02/25 22:55:38 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -323,6 +323,8 @@ MIT in each case. |# ;; Condition System (RUNTIME ERROR-HANDLER) (RUNTIME MICROCODE-ERRORS) + ;; Threads + (RUNTIME THREAD) ;; I/O (RUNTIME GENERIC-I/O-PORT) (RUNTIME FILE-I/O-PORT) @@ -348,7 +350,6 @@ MIT in each case. |# (RUNTIME INTERRUPT-HANDLER) (RUNTIME GC-STATISTICS) (RUNTIME REP) - (RUNTIME THREAD) ;; Debugging (RUNTIME COMPILER-INFO) (RUNTIME ADVICE) @@ -400,6 +401,5 @@ MIT in each case. |# ) (package/add-child! system-global-package 'USER user-initial-environment) -(set-keyboard-interrupt-thread! (current-thread)) (start-thread-timer) (initial-top-level-repl) \ No newline at end of file diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm index 6a79d7a75..4465a236f 100644 --- a/v7/src/runtime/port.scm +++ b/v7/src/runtime/port.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/port.scm,v 1.2 1991/11/26 07:06:43 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/port.scm,v 1.3 1992/02/25 22:55:53 cph Exp $ -Copyright (c) 1991 Massachusetts Institute of Technology +Copyright (c) 1991-92 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -40,6 +40,7 @@ MIT in each case. |# (define port-rtd (make-record-type "port" '(STATE + THREAD-MUTEX OPERATION-NAMES CUSTOM-OPERATIONS ;; input operations: @@ -59,6 +60,7 @@ MIT in each case. |# (define port? (record-predicate port-rtd)) (define port/state (record-accessor port-rtd 'STATE)) (define set-port/state! (record-updater port-rtd 'STATE)) +(define port/thread-mutex (record-accessor port-rtd 'THREAD-MUTEX)) (define port/operation-names (record-accessor port-rtd 'OPERATION-NAMES)) (define set-port/operation-names! (record-updater port-rtd 'OPERATION-NAMES)) (define port/custom-operations (record-accessor port-rtd 'CUSTOM-OPERATIONS)) @@ -214,11 +216,13 @@ MIT in each case. |# (define make-port (let ((constructor - (record-constructor port-rtd - '(STATE OPERATION-NAMES CUSTOM-OPERATIONS)))) + (record-constructor + port-rtd + '(STATE THREAD-MUTEX OPERATION-NAMES CUSTOM-OPERATIONS)))) (lambda (operations state procedure-name input? output?) (let ((port (constructor state + (make-thread-mutex) '() (parse-operations-list operations procedure-name)))) (install-input-operations! port input?) diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index 96df33f16..63733fb05 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.23 1992/02/08 15:08:33 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/rep.scm,v 14.24 1992/02/25 22:56:08 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -140,7 +140,8 @@ MIT in each case. |# ((cmdl/driver cmdl) cmdl))))))))))))) (if operation (operation cmdl thunk) - (thunk)))) + (with-thread-mutex-locked (port/thread-mutex (cmdl/port cmdl)) + thunk)))) (define *nearest-cmdl*) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 760bdd3ed..c4048d59c 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.133 1992/02/08 15:08:35 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.134 1992/02/25 22:56:37 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -543,6 +543,7 @@ MIT in each case. |# condition-type:datum-out-of-range condition-type:derived-file-error condition-type:derived-port-error + condition-type:derived-thread-error condition-type:divide-by-zero condition-type:error condition-type:file-error @@ -556,6 +557,7 @@ MIT in each case. |# condition-type:simple-condition condition-type:simple-error condition-type:simple-warning + condition-type:thread-error condition-type:unassigned-variable condition-type:unbound-variable condition-type:variable-error @@ -581,6 +583,7 @@ MIT in each case. |# error:datum-out-of-range error:derived-file error:derived-port + error:derived-thread error:divide-by-zero error:file-operation error:no-such-restart @@ -918,6 +921,7 @@ MIT in each case. |# port/set-output-blocking-mode port/set-output-terminal-mode port/state + port/thread-mutex port/with-input-blocking-mode port/with-input-terminal-mode port/with-output-blocking-mode @@ -986,9 +990,6 @@ MIT in each case. |# (define-package (runtime interrupt-handler) (files "intrpt") (parent ()) - (export () - keyboard-interrupt-thread - set-keyboard-interrupt-thread!) (export (runtime emacs-interface) hook/^G-interrupt hook/clean-input/flush-typeahead) @@ -2303,9 +2304,10 @@ MIT in each case. |# (parent ()) (export () block-thread-events + condition-type:thread-dead condition-type:thread-deadlock condition-type:thread-detached - condition-type:thread-error + condition-type:thread-control-error create-thread current-thread detach-thread @@ -2322,12 +2324,14 @@ MIT in each case. |# suspend-current-thread thread-continuation thread-dead? + thread-mutex-owner thread-mutex? thread-timer-interval thread? try-lock-thread-mutex unblock-thread-events unlock-thread-mutex + with-thread-mutex-locked yield-current-thread) (export (runtime interrupt-handler) thread-timer-interrupt-handler) diff --git a/v7/src/runtime/thread.scm b/v7/src/runtime/thread.scm index 68b61248b..0e8fd671e 100644 --- a/v7/src/runtime/thread.scm +++ b/v7/src/runtime/thread.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/thread.scm,v 1.1 1992/02/08 15:32:58 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/thread.scm,v 1.2 1992/02/25 22:56:21 cph Exp $ Copyright (c) 1991-92 Massachusetts Institute of Technology @@ -407,7 +407,17 @@ MIT in each case. |# (waiting-threads (make-ring) read-only true) (owner false)) +(define-integrable (guarantee-thread-mutex mutex procedure) + (declare (integrate-operator thread-mutex?)) + (if (not (thread-mutex? mutex)) + (error:wrong-type-argument mutex "thread-mutex" procedure))) + +(define (thread-mutex-owner mutex) + (guarantee-thread-mutex mutex thread-mutex-owner) + (thread-mutex/owner mutex)) + (define (lock-thread-mutex mutex) + (guarantee-thread-mutex mutex lock-thread-mutex) (without-interrupts (lambda () (let ((thread (current-thread)) @@ -418,12 +428,15 @@ MIT in each case. |# (signal-thread-deadlock thread "lock thread mutex" lock-thread-mutex mutex)) (else - (ring/enqueue (thread-mutex/waiting-threads mutex) thread) - (do () - ((eq? thread (thread-mutex/owner mutex))) - (suspend-current-thread)))))))) + (%lock-thread-mutex mutex thread))))))) + +(define-integrable (%lock-thread-mutex mutex thread) + (ring/enqueue (thread-mutex/waiting-threads mutex) thread) + (do () ((eq? thread (thread-mutex/owner mutex))) + (suspend-current-thread))) (define (try-lock-thread-mutex mutex) + (guarantee-thread-mutex mutex try-lock-thread-mutex) (without-interrupts (lambda () (and (not (thread-mutex/owner mutex)) @@ -432,14 +445,39 @@ MIT in each case. |# true))))) (define (unlock-thread-mutex mutex) + (guarantee-thread-mutex mutex unlock-thread-mutex) (without-interrupts (lambda () (if (not (eq? (thread-mutex/owner mutex) (current-thread))) (error "Don't own mutex:" mutex)) - (let ((thread (ring/dequeue (thread-mutex/waiting-threads mutex) false))) - (set-thread-mutex/owner! mutex thread) - (if thread - (signal-thread-event thread false)))))) + (%unlock-thread-mutex mutex)))) + +(define-integrable (%unlock-thread-mutex mutex) + (let ((thread (ring/dequeue (thread-mutex/waiting-threads mutex) false))) + (set-thread-mutex/owner! mutex thread) + (if thread + (signal-thread-event thread false)))) + +(define (with-thread-mutex-locked mutex thunk) + (guarantee-thread-mutex mutex lock-thread-mutex) + (let ((thread (current-thread)) + (grabbed-lock?)) + (dynamic-wind + (lambda () + (let ((owner (thread-mutex/owner mutex))) + (if (eq? owner thread) + (begin + (set! grabbed-lock? false) + unspecific) + (begin + (set! grabbed-lock? true) + (if owner + (%lock-thread-mutex mutex thread) + (set-thread-mutex/owner! mutex thread)))))) + thunk + (lambda () + (if (and grabbed-lock? (eq? (thread-mutex/owner mutex) thread)) + (%unlock-thread-mutex mutex)))))) ;;;; Circular Rings @@ -479,8 +517,8 @@ MIT in each case. |# ;;;; Error Conditions -(define condition-type:thread-error) -(define thread-error/thread) +(define condition-type:thread-control-error) +(define thread-control-error/thread) (define condition-type:thread-deadlock) (define signal-thread-deadlock) (define thread-deadlock/description) @@ -493,18 +531,19 @@ MIT in each case. |# (define thread-dead/verb) (define (initialize-error-conditions!) - (set! condition-type:thread-error - (make-condition-type 'THREAD-ERROR condition-type:control-error + (set! condition-type:thread-control-error + (make-condition-type 'THREAD-CONTROL-ERROR condition-type:control-error '(THREAD) (lambda (condition port) (write-string "Anonymous error associated with " port) - (write (thread-error/thread condition) port) + (write (thread-control-error/thread condition) port) (write-string "." port)))) - (set! thread-error/thread - (condition-accessor condition-type:thread-error 'THREAD)) + (set! thread-control-error/thread + (condition-accessor condition-type:thread-control-error 'THREAD)) (set! condition-type:thread-deadlock - (make-condition-type 'THREAD-DEADLOCK condition-type:thread-error + (make-condition-type 'THREAD-DEADLOCK + condition-type:thread-control-error '(DESCRIPTION OPERATOR OPERAND) (lambda (condition port) (write-string "Deadlock detected while trying to " port) @@ -524,10 +563,12 @@ MIT in each case. |# (condition-accessor condition-type:thread-deadlock 'OPERAND)) (set! condition-type:thread-detached - (make-condition-type 'THREAD-DETACHED condition-type:thread-error '() + (make-condition-type 'THREAD-DETACHED + condition-type:thread-control-error + '() (lambda (condition port) (write-string "Attempt to join detached thread: " port) - (write-string (thread-error/thread condition) port) + (write-string (thread-control-error/thread condition) port) (write-string "." port)))) (set! signal-thread-detached (condition-signaller condition-type:thread-detached @@ -535,13 +576,13 @@ MIT in each case. |# standard-error-handler)) (set! condition-type:thread-dead - (make-condition-type 'THREAD-DEAD condition-type:thread-error + (make-condition-type 'THREAD-DEAD condition-type:thread-control-error '(VERB OPERATOR OPERANDS) (lambda (condition port) (write-string "Unable to " port) (write-string (thread-dead/verb condition) port) (write-string " thread " port) - (write-string (thread-error/thread condition) port) + (write-string (thread-control-error/thread condition) port) (write-string "because it is dead." port)))) (set! signal-thread-dead (let ((signaller diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 42694877e..022ba19b9 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.146 1992/02/08 15:08:45 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.147 1992/02/25 22:57:27 cph Exp $ Copyright (c) 1988-92 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 146)) + (add-identification! "Runtime" 14 147)) (define microcode-system) diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm index 7fa71ab90..d8b9f97cd 100644 --- a/v8/src/runtime/make.scm +++ b/v8/src/runtime/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.33 1992/02/08 15:08:31 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.34 1992/02/25 22:55:38 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -323,6 +323,8 @@ MIT in each case. |# ;; Condition System (RUNTIME ERROR-HANDLER) (RUNTIME MICROCODE-ERRORS) + ;; Threads + (RUNTIME THREAD) ;; I/O (RUNTIME GENERIC-I/O-PORT) (RUNTIME FILE-I/O-PORT) @@ -348,7 +350,6 @@ MIT in each case. |# (RUNTIME INTERRUPT-HANDLER) (RUNTIME GC-STATISTICS) (RUNTIME REP) - (RUNTIME THREAD) ;; Debugging (RUNTIME COMPILER-INFO) (RUNTIME ADVICE) @@ -400,6 +401,5 @@ MIT in each case. |# ) (package/add-child! system-global-package 'USER user-initial-environment) -(set-keyboard-interrupt-thread! (current-thread)) (start-thread-timer) (initial-top-level-repl) \ No newline at end of file diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 7b0fafafc..76f27f7df 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.133 1992/02/08 15:08:35 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.134 1992/02/25 22:56:37 cph Exp $ Copyright (c) 1988-92 Massachusetts Institute of Technology @@ -543,6 +543,7 @@ MIT in each case. |# condition-type:datum-out-of-range condition-type:derived-file-error condition-type:derived-port-error + condition-type:derived-thread-error condition-type:divide-by-zero condition-type:error condition-type:file-error @@ -556,6 +557,7 @@ MIT in each case. |# condition-type:simple-condition condition-type:simple-error condition-type:simple-warning + condition-type:thread-error condition-type:unassigned-variable condition-type:unbound-variable condition-type:variable-error @@ -581,6 +583,7 @@ MIT in each case. |# error:datum-out-of-range error:derived-file error:derived-port + error:derived-thread error:divide-by-zero error:file-operation error:no-such-restart @@ -918,6 +921,7 @@ MIT in each case. |# port/set-output-blocking-mode port/set-output-terminal-mode port/state + port/thread-mutex port/with-input-blocking-mode port/with-input-terminal-mode port/with-output-blocking-mode @@ -986,9 +990,6 @@ MIT in each case. |# (define-package (runtime interrupt-handler) (files "intrpt") (parent ()) - (export () - keyboard-interrupt-thread - set-keyboard-interrupt-thread!) (export (runtime emacs-interface) hook/^G-interrupt hook/clean-input/flush-typeahead) @@ -2303,9 +2304,10 @@ MIT in each case. |# (parent ()) (export () block-thread-events + condition-type:thread-dead condition-type:thread-deadlock condition-type:thread-detached - condition-type:thread-error + condition-type:thread-control-error create-thread current-thread detach-thread @@ -2322,12 +2324,14 @@ MIT in each case. |# suspend-current-thread thread-continuation thread-dead? + thread-mutex-owner thread-mutex? thread-timer-interval thread? try-lock-thread-mutex unblock-thread-events unlock-thread-mutex + with-thread-mutex-locked yield-current-thread) (export (runtime interrupt-handler) thread-timer-interrupt-handler) -- 2.25.1