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