ghc/lib/haskell-1.3/LibPosixUtil.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 \section[LibPosixUtil]{Haskell 1.3 POSIX utilities}
   5
   6 \begin{code}
   7
   8 module LibPosixUtil (
   9     LibPosixUtil..,
  10
  11     _ByteArray,
  12     _MutableByteArray,
  13     _ST(..)
  14
  15     ) where
  16
  17 import PreludeGlaST
  18 import PS
  19
  20 \end{code}
  21
  22 First, all of the major Posix data types, to avoid any recursive dependencies
  23
  24 \begin{code}
  25
  26 type ByteCount = Int
  27 type Channel = 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
  38 \end{code}
  39
  40 Now some local fucntions that shouldn't go outside this library.
  41
  42 \begin{code}
  43
  44 -- Fail with a SystemError.  Normally, we do not try to re-interpret POSIX
  45 -- error numbers, so most routines in this file will only fail with SystemError.
  46 -- The only exceptions are (1) those routines where failure of some kind may be
  47 -- considered ``normal''...e.g. getpwnam() for a non-existent user, or (2) those
  48 -- routines which do not set errno.
  49
  50 syserr :: String -> IO a
  51 syserr = failWith . SystemError
  52
  53 -- Allocate a mutable array of characters with no indices.
  54
  55 allocChars :: Int -> _ST s (_MutableByteArray s ())
  56 allocChars (I# size#) (S# s#) =
  57     case newCharArray# size# s# of
  58       StateAndMutableByteArray# s2# barr# -> (_MutableByteArray bot barr#, S# s2#)
  59   where
  60     bot = error "allocChars{LibPosix}"
  61
  62 -- Allocate a mutable array of words with no indices
  63
  64 allocWords :: Int -> _ST s (_MutableByteArray s ())
  65 allocWords (I# size#) (S# s#) =
  66     case newIntArray# size# s# of
  67       StateAndMutableByteArray# s2# barr# -> (_MutableByteArray bot barr#, S# s2#)
  68   where
  69     bot = error "allocWords{LibPosix}"
  70
  71 -- Freeze these index-free mutable arrays
  72
  73 freeze :: _MutableByteArray s () -> _ST s (_ByteArray ())
  74 freeze (_MutableByteArray ixs arr#) (S# s#) =
  75     case unsafeFreezeByteArray# arr# s# of
  76       StateAndByteArray# s2# frozen# -> (_ByteArray ixs frozen#, S# s2#)
  77
  78 -- Copy a null-terminated string from outside the heap to
  79 -- Haskellized nonsense inside the heap
  80
  81 strcpy :: _Addr -> PrimIO String
  82 strcpy str
  83   | str == ``NULL'' = returnPrimIO ""
  84   | otherwise =
  85     _ccall_ strlen str                      `thenPrimIO` \ len ->
  86     _packCBytesST len str                   `thenStrictlyST` \ ps ->
  87     returnPrimIO (_unpackPS ps)
  88
  89 -- Turn a string list into a NULL-terminated vector of null-terminated strings
  90 -- No indices...I hate indices.  Death to Ix.
  91
  92 vectorize :: [String] -> PrimIO (_ByteArray ())
  93 vectorize xs =
  94     allocWords (len+1)                              `thenStrictlyST` \ arr ->
  95     fill arr 0 xs                                   `thenPrimIO` \ () ->
  96     freeze arr                                      `thenStrictlyST` \ frozen ->
  97     returnPrimIO frozen
  98
  99   where
 100     len :: Int
 101     len = length xs
 102
 103     fill :: _MutableByteArray _RealWorld () -> Int -> [String] -> PrimIO ()
 104     fill arr n [] =
 105         _casm_ ``((PP_)%0)[%1] = NULL;'' arr n
 106     fill arr n (x:xs) =
 107         _packBytesForCST x                          `thenStrictlyST` \ barr ->
 108         _casm_ ``((PP_)%0)[%1] = (P_)%2;'' arr n barr
 109                                                     `thenPrimIO` \ () ->
 110         fill arr (n+1) xs
 111
 112 -- Turn a NULL-terminated vector of null-terminated strings into a string list
 113
 114 unvectorize :: _Addr -> Int -> PrimIO [String]
 115 unvectorize ptr n
 116   | str == ``NULL'' = returnPrimIO []
 117   | otherwise =
 118         strcpy str                                  `thenPrimIO` \ x ->
 119         unvectorize ptr (n+1)                       `thenPrimIO` \ xs ->
 120         returnPrimIO (x : xs)
 121   where str = indexAddrOffAddr ptr n
 122
 123 \end{code}