ghc/lib/posix/PosixUtil.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
   3 %
   4 \section[PosixUtil]{Haskell 1.3 POSIX utilities}
   5
   6 \begin{code}
   7 module PosixUtil where
   8
   9 import ST
  10 import PrelST   -- ST representation
  11 import PrelIOBase  -- IOError representation
  12 import Addr
  13 import Foreign
  14 import CCall
  15 import PrelBase
  16 import MutableArray
  17 import ByteArray
  18 import Array
  19 import PackedString     ( packCBytesST, psToByteArrayST, unpackPS )
  20 import Ix
  21 import PrelArr          (StateAndMutableByteArray#(..), StateAndByteArray#(..))
  22 \end{code}
  23
  24 First, all of the major Posix data types, to avoid any recursive dependencies
  25
  26 \begin{code}
  27 type ByteCount          = Int
  28 type ClockTick          = Int
  29 type EpochTime          = Int
  30 type FileOffset         = Int
  31 type GroupID            = Int
  32 type Limit              = Int
  33 type LinkCount          = Int
  34 type ProcessID          = Int
  35 type ProcessGroupID     = ProcessID
  36 type UserID             = Int
  37 data Fd                 = FD# Int#
  38 instance CCallable   Fd
  39 instance CReturnable Fd
  40
  41 instance Eq Fd where
  42   (FD# x#) == (FD# y#) = x# ==# y#
  43
  44 -- use with care.
  45 intToFd :: Int -> Fd
  46 intToFd (I# fd#) = FD# fd#
  47
  48 fdToInt :: Fd -> Int
  49 fdToInt (FD# x#) = I# x#
  50 \end{code}
  51
  52 Now some local functions that shouldn't go outside this library.
  53
  54 Fail with a SystemError.  Normally, we do not try to re-interpret
  55 POSIX error numbers, so most routines in this file will only fail
  56 with SystemError.  The only exceptions are (1) those routines where
  57 failure of some kind may be considered ``normal''...e.g. getpwnam()
  58 for a non-existent user, or (2) those routines which do not set
  59 errno.
  60
  61 \begin{code}
  62 syserr :: String -> IO a
  63 syserr str = fail (IOError Nothing     -- ToDo: better
  64                            SystemError
  65                            str)
  66
  67 -- Allocate a mutable array of characters with no indices.
  68
  69 allocChars :: Int -> IO (MutableByteArray RealWorld ())
  70 allocChars (I# size#) = IO $ \ s# ->
  71     case newCharArray# size# s# of
  72       StateAndMutableByteArray# s2# barr# ->
  73         IOok s2# (MutableByteArray bot barr#)
  74   where
  75     bot = error "PosixUtil.allocChars"
  76
  77 -- Allocate a mutable array of words with no indices
  78
  79 allocWords :: Int -> IO (MutableByteArray RealWorld ())
  80 allocWords (I# size#) = IO $ \ s# ->
  81     case newIntArray# size# s# of
  82       StateAndMutableByteArray# s2# barr# ->
  83         IOok s2# (MutableByteArray bot barr#)
  84   where
  85     bot = error "PosixUtil.allocWords"
  86
  87 -- Freeze these index-free mutable arrays
  88
  89 freeze :: MutableByteArray RealWorld () -> IO (ByteArray ())
  90 freeze (MutableByteArray ixs arr#) = IO $ \ s# ->
  91     case unsafeFreezeByteArray# arr# s# of
  92       StateAndByteArray# s2# frozen# ->
  93         IOok s2# (ByteArray ixs frozen#)
  94
  95 -- Copy a null-terminated string from outside the heap to
  96 -- Haskellized nonsense inside the heap
  97
  98 strcpy :: Addr -> IO String
  99 strcpy str
 100   | str == ``NULL'' = return ""
 101   | otherwise =
 102     _ccall_ strlen str              >>= \ len ->
 103     stToIO (packCBytesST len str)   >>= \ ps ->
 104     return (unpackPS ps)
 105
 106 -- Turn a string list into a NULL-terminated vector of null-terminated
 107 -- strings No indices...I hate indices.  Death to Ix.
 108
 109 vectorize :: [String] -> IO (ByteArray ())
 110 vectorize xs = do
 111   arr <- allocWords (len + 1)
 112   fill arr 0 xs
 113   freeze arr
 114  where
 115     len :: Int
 116     len = length xs
 117
 118     fill :: MutableByteArray RealWorld () -> Int -> [String] -> IO ()
 119     fill arr n [] =
 120         _casm_ ``((PP_)%0)[%1] = NULL;'' arr n
 121     fill arr n (x:xs) =
 122         stToIO (psToByteArrayST x)          >>= \ barr ->
 123         _casm_ ``((PP_)%0)[%1] = (P_)%2;'' arr n barr
 124                                             >>= \ () ->
 125         fill arr (n+1) xs
 126
 127 -- Turn a NULL-terminated vector of null-terminated strings into a string list
 128
 129 unvectorize :: Addr -> Int -> IO [String]
 130 unvectorize ptr n
 131   | str == ``NULL'' = return []
 132   | otherwise =
 133         strcpy str                          >>= \ x ->
 134         unvectorize ptr (n+1)               >>= \ xs ->
 135         return (x : xs)
 136   where
 137     str = indexAddrOffAddr ptr n
 138
 139 -- common templates for system calls
 140
 141 nonzero_error :: IO Int -> String -> IO ()
 142 nonzero_error io err = do
 143     rc <- io
 144     if rc == 0
 145        then return ()
 146        else syserr err
 147
 148 minusone_error :: IO Int -> String -> IO ()
 149 minusone_error io err = do
 150     rc <- io
 151     if rc /= -1
 152        then return ()
 153        else syserr err
 154
 155 -- IO versions of a few ST functions.
 156
 157 psToByteArrayIO = stToIO . psToByteArrayST
 158
 159 \end{code}