rewrite ensure-writable-dir to not be racy

* module/system/base/compile.scm (ensure-writable-dir): Rewrite to not
  be racy.

module/system/base/compile.scm

@@ -68,16 +68,27 @@
       x
       (lookup-language x)))
 
-;; Throws an exception if `dir' is not writable. The double-stat is OK,
+;; Throws an exception if `dir' is not writable.  The mkdir occurs
-;; as this is only used during compilation.
+;; before the check, so that we avoid races (possibly due to parallel
+;; compilation).
+;;
 (define (ensure-writable-dir dir)
-  (if (file-exists? dir)
+  (catch 'system-error
-      (if (access? dir W_OK)
+    (lambda ()
-          #t
+      (mkdir dir))
-          (error "directory not writable" dir))
+    (lambda (k subr fmt args rest)
-      (begin
+      (let ((errno (and (pair? rest) (car rest))))
+        (cond
+         ((eqv? errno EEXIST)
+          (let ((st (stat dir)))
+            (if (or (not (eq? (stat:type st) 'directory))
+                    (not (access? dir W_OK)))
+                (error "directory not writable" dir))))
+         ((eqv? errno ENOENT)
           (ensure-writable-dir (dirname dir))
-        (mkdir dir))))
+          (ensure-writable-dir dir))
+         (else
+          (throw k subr fmt args rest)))))))
 
 ;;; This function is among the trickiest I've ever written. I tried many
 ;;; variants. In the end, simple is best, of course.