From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Thu, 13 Nov 2014 22:22:03 +0000 (-0700)
Subject: Fluidize hook/exit and hook/quit.  Add hook/%exit for Edwin.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~116
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=462e2cd6afb955571aa30c48c733a24cf207d530;p=mit-scheme.git

Fluidize hook/exit and hook/quit.  Add hook/%exit for Edwin.

Replace the fluid-let in src/edwin/intmod.scm with let-fluids.  The
fluid-let kludge in SMP worlds causes Edwin to hang when killed.
---

diff --git a/src/6001/make.scm b/src/6001/make.scm
index 607ea7487..df8a2b909 100644
--- a/src/6001/make.scm
+++ b/src/6001/make.scm
@@ -45,8 +45,11 @@ USA.
 (set! (access write-result:undefined-value-is-special?
 	      (->environment '(RUNTIME USER-INTERFACE)))
       #f)
-(set! hook/exit (lambda (integer) integer (warn "EXIT has been disabled.")))
-(set! hook/quit (lambda () (warn "QUIT has been disabled.")))
+(set-fluid! hook/exit (lambda (integer) integer
+			      (warn "EXIT has been disabled.")))
+(set-fluid! hook/%exit (lambda (integer) integer
+			       (warn "%EXIT has been disabled.")))
+(set-fluid! hook/quit (lambda () (warn "QUIT has been disabled.")))
 
 (let ((edwin-env (->environment '(EDWIN)))
       (student-env (->environment '(STUDENT))))
diff --git a/src/edwin/intmod.scm b/src/edwin/intmod.scm
index 64d15114c..62ca54d1d 100644
--- a/src/edwin/intmod.scm
+++ b/src/edwin/intmod.scm
@@ -122,8 +122,9 @@ evaluated in the specified inferior REPL buffer."
 				    (detach-thread thread)
 				    thread))))
 	(attach-buffer-interface-port! buffer port)
-	(fluid-let ((%exit inferior-repl/%exit)
-		    (quit inferior-repl/quit))
+	(let-fluids hook/%exit inferior-repl/%exit
+		    hook/quit inferior-repl/quit
+	 (lambda ()
 	  (dynamic-wind
 	   (lambda () unspecific)
 	   (lambda ()
@@ -137,7 +138,7 @@ evaluated in the specified inferior REPL buffer."
 	   (lambda ()
 	     (signal-thread-event editor-thread
 	       (lambda ()
-		 (unwind-inferior-repl-buffer buffer))))))))))
+		 (unwind-inferior-repl-buffer buffer)))))))))))
 
 (define (make-init-message message)
   (if message
diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index 019b2851f..5790243a0 100644
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -94,6 +94,9 @@ USA.
 	  ((#x00020100 #x0004030000020100) #f)
 	  (else (error "Unable to determine endianness of host."))))
   (add-secondary-gc-daemon! clean-obarray)
+  (set! hook/exit (make-fluid default/exit))
+  (set! hook/%exit (make-fluid default/%exit))
+  (set! hook/quit (make-fluid default/quit))
   ;; Kludge until the next released version, to avoid a bootstrapping
   ;; failure.
   (set! ephemeron-type (microcode-type 'EPHEMERON))
@@ -205,15 +208,19 @@ USA.
 	  (wait-loop)))))
 
 (define (exit #!optional integer)
-  (hook/exit (if (default-object? integer) #f integer)))
+  ((fluid hook/exit) (if (default-object? integer) #f integer)))
 
 (define (default/exit integer)
   (if (prompt-for-confirmation "Kill Scheme")
       (%exit integer)))
 
-(define hook/exit default/exit)
+(define hook/exit)
+(define hook/%exit)
 
 (define (%exit #!optional integer)
+  ((fluid hook/%exit) integer))
+
+(define (default/%exit #!optional integer)
   (event-distributor/invoke! event:before-exit)
   (if (or (default-object? integer)
 	  (not integer))
@@ -221,14 +228,14 @@ USA.
       ((ucode-primitive exit-with-value 1) integer)))
 
 (define (quit)
-  (hook/quit))
+  ((fluid hook/quit)))
 
 (define (%quit)
   (with-absolutely-no-interrupts (ucode-primitive halt))
   unspecific)
 
 (define default/quit %quit)
-(define hook/quit default/quit)
+(define hook/quit)
 
 (define user-initial-environment
   (*make-environment system-global-environment
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 072c505d5..e3c817e87 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -446,6 +446,7 @@ USA.
 	  hook-in-list?
 	  hook-list?
 	  hook/exit
+	  hook/%exit
 	  hook/quit
 	  hook/scode-eval
 	  host-big-endian?