[project @ 2002-01-04 10:56:09 by sof]

getDirectoryContents: use the re-entrant readdir_r() to get at directory
entries, if available.

diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs
index b1d8ef2..00234a3 100644 (file)
--- a/ghc/lib/std/Directory.lhs
+++ b/ghc/lib/std/Directory.lhs
@@ -334,21 +334,24 @@ The path refers to an existing non-directory object.
 \begin{code}
 getDirectoryContents :: FilePath -> IO [FilePath]
 getDirectoryContents path = do
-   p <- withCString path $ \s ->
+   alloca $ \ ptr_dEnt -> do
+    p <- withCString path $ \s ->
          throwErrnoIfNullRetry "getDirectoryContents" (opendir s)
-   loop p
+    loop ptr_dEnt p
   where
-    loop :: Ptr CDir -> IO [String]
-    loop dir = do
+    loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]
+    loop ptr_dEnt dir = do
       resetErrno
-      p <- readdir dir
-      if (p /= nullPtr)
+      r <- readdir dir ptr_dEnt
+      if (r == 0) 
         then do
-                entry   <- (d_name p >>= peekCString)
-                entries <- loop dir
+                dEnt    <- peek ptr_dEnt
+                entry   <- (d_name dEnt >>= peekCString)
+                freeDirEnt dEnt
+                entries <- loop ptr_dEnt dir
                 return (entry:entries)
         else do errno <- getErrno
-                if (errno == eINTR) then loop dir else do
+                if (errno == eINTR) then loop ptr_dEnt dir else do
                 throwErrnoIfMinus1_ "getDirectoryContents" $ closedir dir
                 let (Errno eo) = errno
                 if (eo == end_of_dir)
@@ -548,12 +551,14 @@ foreign import ccall unsafe unlink   :: CString -> IO CInt
 foreign import ccall unsafe rename   :: CString -> CString -> IO CInt
                     
 foreign import ccall unsafe opendir  :: CString  -> IO (Ptr CDir)
-foreign import ccall unsafe readdir  :: Ptr CDir -> IO (Ptr CDirent)
 foreign import ccall unsafe closedir :: Ptr CDir -> IO CInt
 
 foreign import ccall unsafe stat     :: CString -> Ptr CStat -> IO CInt
 
 foreign import ccall "prel_lstat" unsafe lstat :: CString -> Ptr CStat -> IO CInt
+foreign import ccall "prel_readdir" unsafe readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
+foreign import ccall "prel_free_dirent" unsafe freeDirEnt  :: Ptr CDirent -> IO ()
+
 
 type CDirent = ()
 

diff --git a/ghc/lib/std/cbits/dirUtils.c b/ghc/lib/std/cbits/dirUtils.c
index 3076b83..c61d730 100644 (file)
--- a/ghc/lib/std/cbits/dirUtils.c
+++ b/ghc/lib/std/cbits/dirUtils.c
@@ -69,3 +69,58 @@ HsInt prel_end_of_dir()
 #endif  
 }
 
+/*
+ * read an entry from the directory stream; opt for the
+ * re-entrant friendly way of doing this, if available.
+ */
+HsInt
+prel_readdir(HsAddr dirPtr, HsAddr pDirEnt)
+{
+#if HAVE_READDIR_R
+  struct dirent* p;
+  struct dirent* r;
+  int res;
+  static unsigned int nm_max = -1;
+  
+  if ((struct dirent**)pDirEnt == NULL) {
+    return -1;
+  }
+  if (nm_max == -1) {
+#ifdef NAME_MAX
+    nm_max = NAME_MAX;
+#else
+    char* res;
+    nm_max = pathconf(res, _PC_NAME_MAX);
+    if (nm_max == -1) { nm_max = 256; }
+#endif
+  }
+  p = (struct dirent*)malloc(sizeof(struct dirent) + nm_max);
+  res = readdir_r((DIR*)dirPtr, p, (struct dirent**)pDirEnt);
+  if (res != 0) {
+    *pDirEnt = NULL;
+    free(p);
+  }
+  return res;
+#else
+  struct dirent **pDirE = (struct dirent**)pDirEnt;
+
+  if (pDirE == NULL) {
+    return -1;
+  }
+
+  *pDirE = readdir((DIR*)dirPtr);
+  if (*pDirE == NULL) {
+    return -1;
+  } else {
+    return 0;
+  }  
+#endif
+}
+
+void
+prel_free_dirent(HsAddr dEnt)
+{
+#if HAVE_READDIR_R
+  free(dEnt);
+#endif
+}

diff --git a/ghc/lib/std/cbits/dirUtils.h b/ghc/lib/std/cbits/dirUtils.h
index 187523a..4d24f3c 100644 (file)
--- a/ghc/lib/std/cbits/dirUtils.h
+++ b/ghc/lib/std/cbits/dirUtils.h
@@ -36,4 +36,6 @@ extern HsAddr prel_d_name(struct dirent* d);
 
 extern HsInt prel_end_of_dir();
 
+extern HsInt prel_readdir(HsAddr dirPtr, HsAddr pDirEnt);
+extern void  prel_free_dirent(HsAddr dEnt);
 #endif /* __DIRUTILS_H__ */