>From 370e0ff5008dc997f19ea7a01032cadfea0c1bef Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Tue, 28 May 2013 22:47:57 +1200
Subject: [PATCH 1/2] add R7RS support for exit and emergency-exit

This allows exit to accept an arbitrary object as its argument (if the object is an
integer, it is used as the process' exit status directly; otherwise, the exit
status follows the usual Scheme rules (#f is 1 to indicate an abnormal exit,
everything else is 0)).

It also causes exit to run all finalizers and pending dynamic-wind after-thunks
before exiting, and adds the emergency-exit procedure which does not.
---
 library.scm         |   21 ++++++++++++---------
 manual/Parameters   |    7 ++++---
 manual/Unit library |   19 +++++++++++++++----
 3 files changed, 31 insertions(+), 16 deletions(-)

diff --git a/library.scm b/library.scm
index 68165d9..b12bd66 100644
--- a/library.scm
+++ b/library.scm
@@ -152,11 +152,19 @@ EOF
 
 ;;; System routines:
 
-(define (exit #!optional (code 0)) ((##sys#exit-handler) code))
+(define (exit #!optional (obj 0)) ((##sys#exit-handler) obj))
+(define (emergency-exit #!optional (obj 0)) (##sys#exit-runtime obj))
 (define (reset) ((##sys#reset-handler)))
 (define (##sys#quit-hook result) ((##sys#exit-handler) 0))
 (define (quit #!optional result) (##sys#quit-hook result))
 
+(define (##sys#exit-runtime obj)
+  (##core#inline
+   "C_exit_runtime"
+   (cond ((##sys#integer? obj) obj)
+	 ((##sys#eq? obj #f) 1)
+	 (else 0))))
+
 (define (##sys#error . args)
   (if (pair? args)
       (apply ##sys#signal-hook #:error args)
@@ -3935,15 +3943,10 @@ EOF
 
 (define exit-handler
   (make-parameter
-   (lambda code
+   (lambda (obj)
      (##sys#cleanup-before-exit)
-     (##core#inline
-      "C_exit_runtime"
-      (if (null? code)
-	  0
-	  (let ([code (car code)])
-	    (##sys#check-exact code)
-	    code) ) ) ) ) )
+     (##sys#dynamic-unwind '() (length ##sys#dynamic-winds))
+     (##sys#exit-runtime obj))))
 
 (define implicit-exit-handler
   (make-parameter
diff --git a/manual/Parameters b/manual/Parameters
index bf0e7d7..cb90d87 100644
--- a/manual/Parameters
+++ b/manual/Parameters
@@ -81,9 +81,10 @@ read-syntax (see {{set-read-syntax!}} for more information).
 
 <parameter>(exit-handler)</parameter>
 
-A procedure of a single optional argument. When {{exit}} is called,
-then this procedure will be invoked with the exit-code as argument. The
-default behavior is to terminate the program.
+A procedure of a single argument. When {{exit}} is called, this
+procedure is invoked with the object passed to {{exit}} as its argument.
+The default behavior is to run all pending finalizers and
+{{dynamic-wind}} thunks and terminate the program.
 
 
 === eval-handler
diff --git a/manual/Unit library b/manual/Unit library
index 1efb5bd..98dca79 100644
--- a/manual/Unit library	
+++ b/manual/Unit library	
@@ -451,12 +451,23 @@ the host-shell whether arguments are expanded ('globbed') or not.
 
 ==== exit
 
-<procedure>(exit [CODE])</procedure>
+<procedure>(exit [OBJECT])</procedure>
 
-Exit the running process and return exit-code, which defaults to 0
-(Invokes {{exit-handler}}).
+Exit the running process and return an exit-code representing the given
+{{OBJECT}}, which defaults to 0. If {{OBJECT}} is an integer, it is used
+as the exit-code for the process. If {{OBJECT}} is {{#f}}, the exit-code
+will be 1, and 0 in all other cases (invokes {{exit-handler}}).
 
-Note that pending {{dynamic-wind}} thunks are ''not'' invoked when exiting your program in this way.
+==== emergency-exit
+
+<procedure>(emergency-exit [OBJECT])</procedure>
+
+Exit the running process and return an exit-code representing the given
+{{OBJECT}} in the same manner as {{exit}}. Does not invoke
+{{exit-handler}}.
+
+Pending finalizers and {{dynamic-wind}} thunks are ''not'' invoked when
+exiting your program in this way.
 
 ==== build-platform
 
-- 
1.7.10.4