>From 370e0ff5008dc997f19ea7a01032cadfea0c1bef Mon Sep 17 00:00:00 2001 From: Evan Hanson
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).