From: sof <unknown>
Date: Fri, 4 Jan 2002 10:56:10 +0000 (+0000)
Subject: [project @ 2002-01-04 10:56:09 by sof]
X-Git-Tag: Approximately_9120_patches~323
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0479b0cfbb0d8b526693dc6906ca19a585eb264f;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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__ */