From 08635e124f4fc777f5226f0e6a3e8816398fc11d Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 27 Feb 2016 22:21:48 -0800
Subject: [PATCH] Fix parameterization in global.scm.

---
 src/6001/make.scm       |  6 +++---
 src/edwin/intmod.scm    |  4 ++--
 src/runtime/global.scm  | 39 +++++++++++++++++++++++++++++----------
 src/runtime/runtime.pkg |  3 +++
 4 files changed, 37 insertions(+), 15 deletions(-)

diff --git a/src/6001/make.scm b/src/6001/make.scm
index 64fb56905..8cd6fe0b2 100644
--- a/src/6001/make.scm
+++ b/src/6001/make.scm
@@ -45,15 +45,15 @@ USA.
 (set! (access write-result:undefined-value-is-special?
 	      (->environment '(RUNTIME USER-INTERFACE)))
       #f)
-(hook/exit
+(param:exit-hook
  (lambda (integer)
    integer
    (warn "EXIT has been disabled.")))
-(hook/%exit
+(param:%exit-hook
  (lambda (integer)
    integer
    (warn "%EXIT has been disabled.")))
-(hook/quit
+(param:quit-hook
  (lambda ()
    (warn "QUIT has been disabled.")))
 
diff --git a/src/edwin/intmod.scm b/src/edwin/intmod.scm
index 772099115..b7427f847 100644
--- a/src/edwin/intmod.scm
+++ b/src/edwin/intmod.scm
@@ -122,8 +122,8 @@ evaluated in the specified inferior REPL buffer."
 				    (detach-thread thread)
 				    thread))))
 	(attach-buffer-interface-port! buffer port)
-	(parameterize* (list (cons hook/%exit inferior-repl/%exit)
-			     (cons hook/quit inferior-repl/quit))
+	(parameterize* (list (cons param:%exit-hook inferior-repl/%exit)
+			     (cons param:quit-hook inferior-repl/quit))
 	  (lambda ()
 	    (dynamic-wind
 	     (lambda () unspecific)
diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index 9194b52cb..9cbc7ad1a 100644
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -94,9 +94,9 @@ USA.
 	  ((#x00020100 #x0004030000020100) #f)
 	  (else (error "Unable to determine endianness of host."))))
   (add-secondary-gc-daemon! clean-obarray)
-  (set! hook/exit (make-parameter default/exit))
-  (set! hook/%exit (make-parameter default/%exit))
-  (set! hook/quit (make-parameter default/quit))
+  (set! param:exit-hook (make-settable-parameter default/exit))
+  (set! param:%exit-hook (make-settable-parameter default/%exit))
+  (set! param:quit-hook (make-settable-parameter default/quit))
   ;; Kludge until the next released version, to avoid a bootstrapping
   ;; failure.
   (set! ephemeron-type (microcode-type 'EPHEMERON))
@@ -207,18 +207,38 @@ USA.
       (if (< (real-time-clock) end)
 	  (wait-loop)))))
 
+(define hook/exit #!default)
+(define hook/%exit #!default)
+(define hook/quit #!default)
+
+(define param:exit-hook)
+(define param:%exit-hook)
+(define param:quit-hook)
+
+(define (get-exit-hook)
+  (if (default-object? hook/exit)
+      (param:exit-hook)
+      hook/exit))
+
+(define (get-%exit-hook)
+  (if (default-object? hook/%exit)
+      (param:%exit-hook)
+      hook/%exit))
+
+(define (get-quit-hook)
+  (if (default-object? hook/quit)
+      (param:quit-hook)
+      hook/quit))
+
 (define (exit #!optional integer)
-  ((hook/exit) (if (default-object? integer) #f integer)))
+  ((get-exit-hook) (if (default-object? integer) #f integer)))
 
 (define (default/exit integer)
   (if (prompt-for-confirmation "Kill Scheme")
       (%exit integer)))
 
-(define hook/exit)
-(define hook/%exit)
-
 (define (%exit #!optional integer)
-  ((hook/%exit) integer))
+  ((get-%exit-hook) integer))
 
 (define (default/%exit #!optional integer)
   (event-distributor/invoke! event:before-exit)
@@ -228,14 +248,13 @@ USA.
       ((ucode-primitive exit-with-value 1) integer)))
 
 (define (quit)
-  ((hook/quit)))
+  ((get-quit-hook)))
 
 (define (%quit)
   (with-absolutely-no-interrupts (ucode-primitive halt))
   unspecific)
 
 (define default/quit %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 5440a2e98..1c20d2b6f 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -499,6 +499,9 @@ USA.
 	  object-type
 	  object-type?
 	  pa
+	  param:%exit-hook
+	  param:exit-hook
+	  param:quit-hook
 	  pointer-type-code?
 	  primitive-procedure-arity
 	  primitive-procedure-documentation
-- 
2.25.1