diff --git a/lib/chibi/process.scm b/lib/chibi/process.scm index 3268cb3a..05a1065b 100644 --- a/lib/chibi/process.scm +++ b/lib/chibi/process.scm @@ -1,20 +1,29 @@ +(define unwind #f) + +((call/cc + (lambda (k) + (set! unwind k) + (lambda () #f)))) (cond-expand (plan9 - (define (exit . o) + (define (emergency-exit . o) (%exit (if (pair? o) (if (string? (car o)) (car o) (if (eq? #t (car o)) "" "chibi error")) "")))) (else - (define (exit . o) + (define (emergency-exit . o) (%exit (if (pair? o) (if (integer? (car o)) (inexact->exact (car o)) (if (eq? #t (car o)) 0 1)) 0))))) +(define (exit . o) + (unwind (lambda () (apply emergency-exit o)))) + (cond-expand (bsd (define (process-command-line pid) diff --git a/lib/chibi/process.sld b/lib/chibi/process.sld index b4970a45..535e8010 100644 --- a/lib/chibi/process.sld +++ b/lib/chibi/process.sld @@ -1,7 +1,8 @@ (define-library (chibi process) - (export exit sleep alarm %fork fork kill execute waitpid system system? - process-command-line process-running? + (export exit emergency-exit sleep alarm + %fork fork kill execute waitpid system system? + process-command-line process-running? set-signal-action! make-signal-set signal-set? signal-set-contains? signal-set-fill! signal-set-add! signal-set-delete! @@ -17,7 +18,7 @@ call-with-process-io process->bytevector process->string process->sexp process->string-list process->output+error process->output+error+status) - (import (chibi) (chibi io) (chibi string) (chibi filesystem)) + (import (chibi) (chibi io) (chibi string) (chibi filesystem) (only (scheme base) call/cc)) (cond-expand (threads (import (srfi 18) (srfi 151))) (else #f)) (cond-expand ((not windows) (include-shared "process"))) (include "process.scm")) diff --git a/lib/chibi/win32/process-win32.scm b/lib/chibi/win32/process-win32.scm index 802c5cb4..a03c81ab 100644 --- a/lib/chibi/win32/process-win32.scm +++ b/lib/chibi/win32/process-win32.scm @@ -1,7 +1,17 @@ -(define (exit . code?) +(define unwind #f) + +((call/cc + (lambda (k) + (set! unwind k) + (lambda () #f)))) + +(define (emergency-exit . code?) (%exit (if (pair? code?) (let ((c (car code?))) (cond ((integer? c) c) ((eq? #t c) 0) (else 1))) 0))) + +(define (exit . o) + (unwind (lambda () (apply emergency-exit o)))) diff --git a/lib/chibi/win32/process-win32.sld b/lib/chibi/win32/process-win32.sld index 49cb57a4..11badb63 100644 --- a/lib/chibi/win32/process-win32.sld +++ b/lib/chibi/win32/process-win32.sld @@ -1,9 +1,9 @@ (define-library (chibi win32 process-win32) (import (scheme base)) - (export exit) + (export exit emergency-exit) (cond-expand (windows (include-shared "process-win32") (include "process-win32.scm")) (else - (import (only (chibi process) exit))))) + (import (only (chibi process) exit emergency-exit))))) diff --git a/lib/scheme/process-context.sld b/lib/scheme/process-context.sld index 3639b596..6666bce1 100644 --- a/lib/scheme/process-context.sld +++ b/lib/scheme/process-context.sld @@ -1,9 +1,7 @@ (define-library (scheme process-context) (import (chibi) (srfi 98)) - (cond-expand (windows (import (only (chibi win32 process-win32) exit))) - (else (import (only (chibi process) exit)))) + (cond-expand (windows (import (only (chibi win32 process-win32) exit emergency-exit))) + (else (import (only (chibi process) exit emergency-exit)))) (export get-environment-variable get-environment-variables - command-line exit emergency-exit) - ;; TODO: Make exit unwind and finalize properly. - (begin (define emergency-exit exit))) + command-line exit emergency-exit))