Atomic write-to-temporary/rename-to-permanent so liarc is ^Cable.

diff --git a/src/compiler/machines/C/ctop.scm b/src/compiler/machines/C/ctop.scm
index 52603108c156f69bc1903b12a81b586860a2b199..fae70e10fe049bc4157fc175283d49bd0ef79b7b 100644 (file)
--- 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