From 70e5aa14a367cd8197b5821be284dec05476dbab Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Fri, 13 Oct 2023 16:37:39 +1100 Subject: [PATCH 1/5] Unwind before exit --- lib/scheme/process-context.sld | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/lib/scheme/process-context.sld b/lib/scheme/process-context.sld index 3639b596..4e61d7eb 100644 --- a/lib/scheme/process-context.sld +++ b/lib/scheme/process-context.sld @@ -1,9 +1,18 @@ (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 (rename (only (chibi win32 process-win32) exit) (exit emergency-exit)))) + (else (import (rename (only (chibi process) exit) (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))) + + (begin + (define unwind #f) + + ((call/cc + (lambda (continuation) + (set! unwind continuation) + (lambda () #f)))) + + (define (exit . rest) + (unwind (lambda () (apply emergency-exit rest)))))) From 77dc8c352406d1c5acca5160f5a060ea1cf6a1d0 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Fri, 13 Oct 2023 17:19:36 +1100 Subject: [PATCH 2/5] Refactor --- lib/scheme/process-context.sld | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/scheme/process-context.sld b/lib/scheme/process-context.sld index 4e61d7eb..afb8401b 100644 --- a/lib/scheme/process-context.sld +++ b/lib/scheme/process-context.sld @@ -1,18 +1,20 @@ (define-library (scheme process-context) - (import (chibi) (srfi 98)) - (cond-expand (windows (import (rename (only (chibi win32 process-win32) exit) (exit emergency-exit)))) - (else (import (rename (only (chibi process) exit) (exit emergency-exit))))) + (import (chibi) (only (scheme base) call/cc) (srfi 98)) + (cond-expand (windows (import (rename (chibi win32 process-win32) (exit emergency-exit)))) + (else (import (prefix (chibi process) process-)))) (export get-environment-variable get-environment-variables command-line exit emergency-exit) - (begin + (begin (define unwind #f) ((call/cc - (lambda (continuation) - (set! unwind continuation) + (lambda (cont) + (set! unwind cont) (lambda () #f)))) + (define emergency-exit process-exit) + (define (exit . rest) (unwind (lambda () (apply emergency-exit rest)))))) From f41a61f74853630cd8a29bc69245a71f60992a94 Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Fri, 13 Oct 2023 17:21:11 +1100 Subject: [PATCH 3/5] Fix windows import --- lib/scheme/process-context.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/scheme/process-context.sld b/lib/scheme/process-context.sld index afb8401b..8e15a628 100644 --- a/lib/scheme/process-context.sld +++ b/lib/scheme/process-context.sld @@ -1,8 +1,8 @@ (define-library (scheme process-context) (import (chibi) (only (scheme base) call/cc) (srfi 98)) - (cond-expand (windows (import (rename (chibi win32 process-win32) (exit emergency-exit)))) - (else (import (prefix (chibi process) process-)))) + (cond-expand (windows (import (prefix (only (chibi win32 process-win32) exit) process-))) + (else (import (prefix (only (chibi process) exit) process-)))) (export get-environment-variable get-environment-variables command-line exit emergency-exit) From 0673eae46d9c9a4b116dd776544abf9dc239132a Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Sun, 26 May 2024 13:06:58 +0900 Subject: [PATCH 4/5] Fix --- lib/chibi/process.scm | 13 +++++++++++-- lib/chibi/process.sld | 5 +++-- lib/chibi/win32/process-win32.scm | 12 +++++++++++- lib/chibi/win32/process-win32.sld | 4 ++-- lib/scheme/process-context.sld | 21 ++++----------------- 5 files changed, 31 insertions(+), 24 deletions(-) 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..044faa6d 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! 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 8e15a628..6666bce1 100644 --- a/lib/scheme/process-context.sld +++ b/lib/scheme/process-context.sld @@ -1,20 +1,7 @@ (define-library (scheme process-context) - (import (chibi) (only (scheme base) call/cc) (srfi 98)) - (cond-expand (windows (import (prefix (only (chibi win32 process-win32) exit) process-))) - (else (import (prefix (only (chibi process) exit) process-)))) + (import (chibi) (srfi 98)) + (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) - - (begin - (define unwind #f) - - ((call/cc - (lambda (cont) - (set! unwind cont) - (lambda () #f)))) - - (define emergency-exit process-exit) - - (define (exit . rest) - (unwind (lambda () (apply emergency-exit rest)))))) + command-line exit emergency-exit)) From 587f739f76df908930f0be146fae4280f2514cef Mon Sep 17 00:00:00 2001 From: Yota Toyama Date: Sun, 26 May 2024 13:10:28 +0900 Subject: [PATCH 5/5] Import call/cc --- lib/chibi/process.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/chibi/process.sld b/lib/chibi/process.sld index 044faa6d..535e8010 100644 --- a/lib/chibi/process.sld +++ b/lib/chibi/process.sld @@ -18,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"))