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.

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index b35a15f99409505582e59594d1647e08d2056e8d..e3ad79a50e668c65209f3cff91bd07bf2b2d5abc 100644 (file)
--- 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 1936c2a1bcc34b6c1766f6e6511a187d34d54311..4ba247937bc4e679d239e9acc974cfcd098a7b37 100644 (file)
--- 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 5dbaabb035b4d00cf34c25ab229615bfff8a51f0..0d7e6b81509952532d6f6ee1015392f58a899c56 100644 (file)
--- 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 @@
 \f
 (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 @@
 \f
 (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)
 \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