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 607ea748708e7cc99dcaa9cb2f31f34bd9cfa7fa..df8a2b90930bd79cc41792b30475e09cab03166d 100644 (file)
--- 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 64d15114c07f3f4ac9524ab2c48acd903091278e..62ca54d1def2c36b71b18869781a444561919d57 100644 (file)
--- 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 019b2851f834e0fd06d83e0041c5fd1e0f7628e6..5790243a07f2a2039f4c747af604db3de25cdcdd 100644 (file)
--- 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 072c505d5b4a36367db198a66da9eef94990e7b6..e3c817e87d9d033c080871d48210049a259739fe 100644 (file)
--- 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?