X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FPosix%2FInternals.hs;h=25fe8c787ca703bd55662a5e6ca1e8b5d223d7c1;hb=aaf764b3ad8b1816d68b5f27299eac125f08e1a5;hp=989a08283e37f455b7acc5b8eeaa691dcf08c5af;hpb=b11688bf41f91552292f069375f5e970ec0bab2b;p=ghc-base.git

diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index 989a082..25fe8c7 100644
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -21,7 +21,8 @@
 -- #hide
 module System.Posix.Internals where
 
-#include "config.h"
+#include "ghcconfig.h"
+#include "HsBaseConfig.h"
 
 import Control.Monad
 import System.Posix.Types
@@ -44,7 +45,7 @@ import System.IO
 #ifdef __HUGS__
 import Hugs.Prelude (IOException(..), IOErrorType(..))
 
-{-# CBITS PrelIOUtils.c dirUtils.c consUtils.c #-}
+{-# CFILES cbits/PrelIOUtils.c cbits/dirUtils.c cbits/consUtils.c #-}
 ioException = ioError
 #endif
 
@@ -118,18 +119,6 @@ statGetType p_stat = do
 ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
 			"unknown file type" Nothing
 
--- It isn't clear whether ftruncate is POSIX or not (I've read several
--- manpages and they seem to conflict), so we truncate using open/2.
-fileTruncate :: FilePath -> IO ()
-fileTruncate file = do
-  let flags = o_WRONLY .|. o_TRUNC
-  withCString file $ \file_cstr -> do
-    fd <- fromIntegral `liftM`
-	    throwErrnoIfMinus1Retry "fileTruncate"
- 	        (c_open file_cstr (fromIntegral flags) 0o666)
-    c_close fd
-  return ()
-
 #if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
 closeFd :: Bool -> CInt -> IO CInt
 closeFd isStream fd 
@@ -143,6 +132,7 @@ foreign import stdcall unsafe "HsBase.h closesocket"
 fdGetMode :: Int -> IO IOMode
 fdGetMode fd = do
 #if defined(mingw32_TARGET_OS) || defined(__MINGW32__)
+    -- XXX: this code is *BROKEN*, _setmode only deals with O_TEXT/O_BINARY
     flags1 <- throwErrnoIfMinus1Retry "fdGetMode" 
                 (c__setmode (fromIntegral fd) (fromIntegral o_WRONLY))
     flags  <- throwErrnoIfMinus1Retry "fdGetMode" 
@@ -377,7 +367,7 @@ foreign import ccall unsafe "HsBase.h rewinddir"
 foreign import ccall unsafe "HsBase.h rmdir"
    c_rmdir :: CString -> IO CInt
 
-foreign import ccall unsafe "HsBase.h stat"
+foreign import ccall unsafe "HsBase.h __hscore_stat"
    c_stat :: CString -> Ptr CStat -> IO CInt
 
 foreign import ccall unsafe "HsBase.h umask"
@@ -386,9 +376,15 @@ foreign import ccall unsafe "HsBase.h umask"
 foreign import ccall unsafe "HsBase.h write" 
    c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize
 
+foreign import ccall unsafe "HsBase.h __hscore_ftruncate"
+   c_ftruncate :: CInt -> COff -> IO CInt
+
 foreign import ccall unsafe "HsBase.h unlink"
    c_unlink :: CString -> IO CInt
 
+foreign import ccall unsafe "HsBase.h getpid"
+   c_getpid :: IO CPid
+
 #if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
 foreign import ccall unsafe "HsBase.h fcntl"
    c_fcntl_read  :: CInt -> CInt -> IO CInt
@@ -402,9 +398,6 @@ foreign import ccall unsafe "HsBase.h fcntl"
 foreign import ccall unsafe "HsBase.h fork"
    c_fork :: IO CPid 
 
-foreign import ccall unsafe "HsBase.h getpid"
-   c_getpid :: IO CPid
-
 foreign import ccall unsafe "HsBase.h link"
    c_link :: CString -> CString -> IO CInt