From a8725074f41efdef6d57f52e3ca9fa8c00c9e879 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 27 Oct 1993 23:29:18 +0000 Subject: [PATCH] Implement mechanism to deregister inferior threads, and call it from the appropriate places. If this isn't done it's too easy to hold on to a pointer to the thread, which prevents the thread from being reclaimed by the GC. --- v7/src/edwin/editor.scm | 11 ++++++- v7/src/edwin/intmod.scm | 22 +++++++------ v7/src/edwin/notify.scm | 72 +++++++++++++++++++++++------------------ 3 files changed, 63 insertions(+), 42 deletions(-) diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm index b35a15f99..e3ad79a50 100644 --- a/v7/src/edwin/editor.scm +++ b/v7/src/edwin/editor.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: editor.scm,v 1.232 1993/10/26 00:37:58 cph Exp $ +;;; $Id: editor.scm,v 1.233 1993/10/27 23:29:05 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology ;;; @@ -483,6 +483,15 @@ This does not affect editor errors or evaluation errors." inferior-threads)) flags)) +(define (deregister-inferior-thread! flags) + (let loop ((threads inferior-threads)) + (if (pair? threads) + (if (eq? flags (system-pair-cdr (car threads))) + (begin + (system-pair-set-car! (car threads) #f) + (system-pair-set-cdr! (car threads) #f)) + (loop (cdr threads)))))) + (define (inferior-thread-output! flags) (without-interrupts (lambda () (inferior-thread-output!/unsafe flags)))) diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm index 1936c2a1b..4ba247937 100644 --- a/v7/src/edwin/intmod.scm +++ b/v7/src/edwin/intmod.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: intmod.scm,v 1.75 1993/10/27 23:01:46 cph Exp $ +;;; $Id: intmod.scm,v 1.76 1993/10/27 23:29:11 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology ;;; @@ -242,15 +242,17 @@ REPL uses current evaluation environment." (define (unwind-inferior-repl-buffer buffer) (without-interrupts (lambda () - (buffer-remove! buffer 'INTERFACE-PORT) - (if (memq buffer repl-buffers) - (begin - (if (eq? buffer (global-run-light-buffer)) - (set-global-run-light! #f)) - (set! repl-buffers (delq! buffer repl-buffers)) - (let ((buffer (global-run-light-buffer))) - (if buffer - (set-global-run-light! (local-run-light buffer))))))))) + (let ((port (buffer-interface-port buffer))) + (if port + (begin + (deregister-inferior-thread! (port/output-registration port)) + (if (eq? buffer (global-run-light-buffer)) + (set-global-run-light! #f)) + (set! repl-buffers (delq! buffer repl-buffers)) + (let ((buffer (global-run-light-buffer))) + (if buffer + (set-global-run-light! (local-run-light buffer)))) + (buffer-remove! buffer 'INTERFACE-PORT))))))) (define (set-run-light! buffer run?) (let ((value (if run? "eval" "listen"))) diff --git a/v7/src/edwin/notify.scm b/v7/src/edwin/notify.scm index 5dbaabb03..0d7e6b815 100644 --- a/v7/src/edwin/notify.scm +++ b/v7/src/edwin/notify.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: notify.scm,v 1.11 1993/08/10 06:50:48 cph Exp $ +;;; $Id: notify.scm,v 1.12 1993/10/27 23:29:18 cph Exp $ ;;; ;;; Copyright (c) 1992-93 Massachusetts Institute of Technology ;;; @@ -48,7 +48,7 @@ (define-variable notify-show-time "If true, the notifier displays the current time." - true + #t boolean?) (define (notifier:time) @@ -65,7 +65,7 @@ (define-variable notify-show-date "If true, the notifier displays the current date." - false + #f boolean?) (define (notifier:date) @@ -81,13 +81,13 @@ (define-variable notify-show-load "If true, the notifier displays the load average." - false + #f boolean?) (define (notifier:load-average) (let ((temporary-buffer (temporary-buffer "*uptime*"))) (let ((start (buffer-start temporary-buffer))) - (shell-command false start false false "uptime") + (shell-command #f start #f #f "uptime") (let ((result (if (re-search-forward ".*load average:[ ]*\\([0-9.]*\\)," @@ -101,7 +101,7 @@ (define-variable notify-show-mail "If true, the notifier displays your mail status." - true + #t boolean?) (define-variable notify-mail-present @@ -140,6 +140,23 @@ Ignored if notify-show-mail is false." (list (cons (ref-variable-object notify-show-date) notifier:date) (cons (ref-variable-object notify-show-time) notifier:time) (cons (ref-variable-object notify-show-load) notifier:load-average))) + +(define (update-notify-string! string) + (set-variable! notify-string + (if (or (string-null? (ref-variable global-mode-string)) + (string-null? string)) + string + (string-append " " string))) + (global-window-modeline-event!)) + +(define-variable notify-string + "This is an internal variable. Don't change it." + "" + string?) + +(define mail-notify-hook-installed? #f) +(define current-notifier-thread #f) +(define notifier-thread-registration #f) (define-command run-notifier "Run the notifier. @@ -157,14 +174,14 @@ which can show various things including time, load average, and mail status." (if (ref-variable notify-show-mail) (ref-variable notify-mail-not-present) "")))) - (set! mail-notify-hook-installed? true) + (set! mail-notify-hook-installed? #t) unspecific)) ((ref-command kill-notifier)) (let ((thread (create-thread editor-thread-root-continuation (lambda () - (do () (false) + (do () (#f) (inferior-thread-output! notifier-thread-registration) (sleep-current-thread (* 1000 (ref-variable notify-interval)))))))) @@ -189,32 +206,25 @@ which can show various things including time, load average, and mail status." (ref-variable notify-show-mail)) (notifier:mail-present) "")) - true) + #t) (define-command kill-notifier "Kill the current notifier, if any." () (lambda () - (if (and current-notifier-thread - (not (thread-dead? current-notifier-thread))) - (signal-thread-event current-notifier-thread - (lambda () (exit-current-thread unspecific)))) + (without-interrupts + (lambda () + (if current-notifier-thread + (begin + (if (not (thread-dead? current-notifier-thread)) + (signal-thread-event current-notifier-thread + (lambda () + (exit-current-thread unspecific)))) + (set! current-notifier-thread #f))) + (if notifier-thread-registration + (begin + (deregister-inferior-thread! notifier-thread-registration) + (set! notifier-thread-registration #f))) + unspecific)) (set-variable! global-mode-string "") - (update-notify-string! ""))) - -(define (update-notify-string! string) - (set-variable! notify-string - (if (or (string-null? (ref-variable global-mode-string)) - (string-null? string)) - string - (string-append " " string))) - (global-window-modeline-event!)) - -(define-variable notify-string - "This is an internal variable. Don't change it." - "" - string?) - -(define mail-notify-hook-installed? false) -(define current-notifier-thread false) -(define notifier-thread-registration) \ No newline at end of file + (update-notify-string! ""))) \ No newline at end of file -- 2.25.1