Fix parameterization in global.scm.

diff --git a/src/6001/make.scm b/src/6001/make.scm
index 64fb569053401c1699360b152aae723f2d34ed4b..8cd6fe0b2782d52a29e199abfabe1577ac7a8ae7 100644 (file)
--- 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 7720991150bb40c122957b686971d73a18a34926..b7427f8472e3083d271cca5478e6a86d70d78ee9 100644 (file)
--- 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 9194b52cb238112d0d66ca5409798c6ca68ab552..9cbc7ad1a782b3662d45a488751c182a7ffc25f5 100644 (file)
--- 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 5440a2e98528309515a4d94e8ca307fc573a82f9..1c20d2b6ffd9aa29a1dfdbf8069ff807caab91c3 100644 (file)
--- 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