Use new primitive `directory-close' to guarantee that the
authorChris Hanson <org/chris-hanson/cph>
Fri, 4 Aug 1989 02:14:09 +0000 (02:14 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 4 Aug 1989 02:14:09 +0000 (02:14 +0000)
directory-reader is correctly cleaned up when aborted.

v7/src/runtime/unxdir.scm

index d5c3165ead1607c8a7b42be402d3224f809a0588..0ab544065be82f0f67b0eda1a5c0df799a79e6e4 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxdir.scm,v 14.3 1988/10/21 22:21:28 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxdir.scm,v 14.4 1989/08/04 02:14:09 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -72,14 +72,20 @@ MIT in each case. |#
                                          (pathname-type instance))))))))))))
 
 (define (generate-directory-pathnames pathname)
-  (let loop
-      ((name ((ucode-primitive open-directory) (pathname->string pathname)))
-       (result '()))
-    (if name
-       (loop ((ucode-primitive directory-read))
-             (cons (merge-pathnames pathname (string->pathname name))
-                   result))
-       (reverse! result))))
+  (dynamic-wind
+   (lambda () unspecific)
+   (lambda ()
+     (let loop
+        ((name
+          ((ucode-primitive open-directory 1) (pathname->string pathname)))
+         (result '()))
+       (if name
+          (loop ((ucode-primitive directory-read 0))
+                (cons (merge-pathnames (string->pathname name) pathname)
+                      result))
+          result)))
+   (ucode-primitive directory-close 0)))
+
 (define (extract-greatest-versions pathnames)
   (let ((name-alist '()))
     (for-each (lambda (pathname)