From 4f6c2bf1e7ac38d8e4b62d95ca05aa428e2187bf Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Wed, 9 Jan 2019 03:46:15 +0000 Subject: [PATCH] Atomic write-to-temporary/rename-to-permanent so liarc is ^Cable. --- src/compiler/machines/C/ctop.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/src/compiler/machines/C/ctop.scm b/src/compiler/machines/C/ctop.scm index 52603108c..fae70e10f 100644 --- a/src/compiler/machines/C/ctop.scm +++ b/src/compiler/machines/C/ctop.scm @@ -36,7 +36,7 @@ USA. (define (compiler-file-output compiler-output pathname) (let ((code (cdr (vector-ref compiler-output 1)))) - (call-with-output-file pathname + (call-with-temporary-output-file pathname (directory-pathname pathname) (lambda (port) (c:write-group code port))) (if compiler:invoke-c-compiler? @@ -44,6 +44,21 @@ USA. (pathname-new-type pathname "o") (pathname-new-type pathname (c-output-extension)))))) +(define (call-with-temporary-output-file pathname directory receiver) + (let ((temporary (temporary-file-pathname directory)) + (done? #f)) + (dynamic-wind + (lambda () + (if done? + (error "Re-entry into temporary file creation is not allowed."))) + (lambda () + (let ((result (call-with-output-file temporary receiver))) + (rename-file temporary pathname) + result)) + (lambda () + (set! done? #t) + (deallocate-temporary-file temporary))))) + (define (compile-data-from-file object pathname) pathname ;ignore (let ((result -- 2.25.1