From 82db18e4c12e1ed76736ee67dc365cdaebeef7d7 Mon Sep 17 00:00:00 2001
From: rrt <unknown>
Date: Thu, 14 Jun 2001 16:41:46 +0000
Subject: [PATCH] [project @ 2001-06-14 16:41:46 by rrt] Add getExecDir to
 return current directory of executable on Windows (to find
 config information).

---
 ghc/compiler/main/SysTools.lhs |   16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index 945ae44..876d210 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -64,6 +64,8 @@ import System		( ExitCode(..) )
 
 #if !defined(mingw32_TARGET_OS)
 import qualified Posix
+#else
+import Ptr              ( nullPtr )
 #endif
 
 #include "HsVersions.h"
@@ -601,14 +603,22 @@ slash s1 s2 = s1 ++ ('/' : s2)
 #endif
 
 -----------------------------------------------------------------------------
--- Convert filepath into MSDOS form.
--- 
 -- Define	myGetProcessId :: IO Int
 
 #ifdef mingw32_TARGET_OS
-foreign import "_getpid" getProcessID :: IO Int 
+foreign import "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
+foreign import stdcall "GetCurrentDirectoryA" getCurrentDirectory :: Int32 -> CString -> IO Int32
+getExecDir :: IO (Maybe String)
+getExecDir = do len <- getCurrentDirectory 0 nullPtr
+		buf <- mallocArray (fromIntegral len)
+		ret <- getCurrentDirectory len buf
+		if ret == 0 then return Nothing
+		            else do s <- peekCString buf
+				    destructArray (fromIntegral len) buf
+				    return (Just s)
 #else
 getProcessID :: IO Int
 getProcessID = Posix.getProcessID
+getExecDir :: IO (Maybe String) = do return Nothing
 #endif
 \end{code}
-- 
1.7.10.4