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