diff options
Diffstat (limited to 'ghc/lib/std/cbits')
| -rw-r--r-- | ghc/lib/std/cbits/CTypes.h | 352 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/createDirectory.c | 63 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/directoryAux.c | 128 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/getCurrentDirectory.c | 47 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/getDirectoryContents.c | 125 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/progargs.c | 6 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/removeDirectory.c | 56 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/removeFile.c | 46 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/renameDirectory.c | 48 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/renameFile.c | 84 | ||||
| -rw-r--r-- | ghc/lib/std/cbits/setCurrentDirectory.c | 24 |
11 files changed, 355 insertions, 624 deletions
diff --git a/ghc/lib/std/cbits/CTypes.h b/ghc/lib/std/cbits/CTypes.h new file mode 100644 index 0000000000..00f9ba8ba3 --- /dev/null +++ b/ghc/lib/std/cbits/CTypes.h @@ -0,0 +1,352 @@ +/* ----------------------------------------------------------------------------- + * $Id: CTypes.h,v 1.1 2001/01/11 17:25:58 simonmar Exp $ + * + * Dirty CPP hackery for CTypes/CTypesISO + * + * (c) The FFI task force, 2000 + * -------------------------------------------------------------------------- */ + +#include "MachDeps.h" + +/* As long as there is no automatic derivation of classes for newtypes we resort + to extremely dirty cpp-hackery. :-P Some care has to be taken when the + macros below are modified, otherwise the layout rule will bite you. */ + +/* A hacked version for GHC follows the Haskell 98 version... */ +#ifndef __GLASGOW_HASKELL__ + +#define NUMERIC_TYPE(T,C,S,B) \ +newtype T = T B deriving (Eq, Ord) ; \ +INSTANCE_NUM(T) ; \ +INSTANCE_READ(T) ; \ +INSTANCE_SHOW(T) ; \ +INSTANCE_ENUM(T) ; \ +INSTANCE_TYPEABLE(T,C,S) ; + +#define INTEGRAL_TYPE(T,C,S,B) \ +NUMERIC_TYPE(T,C,S,B) ; \ +INSTANCE_BOUNDED(T) ; \ +INSTANCE_REAL(T) ; \ +INSTANCE_INTEGRAL(T) ; \ +INSTANCE_BITS(T) + +#define FLOATING_TYPE(T,C,S,B) \ +NUMERIC_TYPE(T,C,S,B) ; \ +INSTANCE_REAL(T) ; \ +INSTANCE_FRACTIONAL(T) ; \ +INSTANCE_FLOATING(T) ; \ +INSTANCE_REALFRAC(T) ; \ +INSTANCE_REALFLOAT(T) + +#define INSTANCE_READ(T) \ +instance Read T where { \ + readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) } + +#define INSTANCE_SHOW(T) \ +instance Show T where { \ + showsPrec p (T x) = showsPrec p x } + +#define INSTANCE_NUM(T) \ +instance Num T where { \ + (T i) + (T j) = T (i + j) ; \ + (T i) - (T j) = T (i - j) ; \ + (T i) * (T j) = T (i * j) ; \ + negate (T i) = T (negate i) ; \ + abs (T i) = T (abs i) ; \ + signum (T i) = T (signum i) ; \ + fromInteger x = T (fromInteger x) } + +#define INSTANCE_TYPEABLE(T,C,S) \ +C :: TyCon ; \ +C = mkTyCon S ; \ +instance Typeable T where { \ + typeOf _ = mkAppTy C [] } + +#define INSTANCE_STORABLE(T) \ +instance Storable T where { \ + sizeOf (T x) = sizeOf x ; \ + alignment (T x) = alignment x ; \ + peekElemOff a i = liftM T (peekElemOff a i) ; \ + pokeElemOff a i (T x) = pokeElemOff a i x } + +#define INSTANCE_BOUNDED(T) \ +instance Bounded T where { \ + minBound = T minBound ; \ + maxBound = T maxBound } + +#define INSTANCE_ENUM(T) \ +instance Enum T where { \ + succ (T i) = T (succ i) ; \ + pred (T i) = T (pred i) ; \ + toEnum x = T (toEnum x) ; \ + fromEnum (T i) = fromEnum i ; \ + enumFrom (T i) = fakeMap T (enumFrom i) ; \ + enumFromThen (T i) (T j) = fakeMap T (enumFromThen i j) ; \ + enumFromTo (T i) (T j) = fakeMap T (enumFromTo i j) ; \ + enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) } + +#define INSTANCE_REAL(T) \ +instance Real T where { \ + toRational (T i) = toRational i } + +#define INSTANCE_INTEGRAL(T) \ +instance Integral T where { \ + (T i) `quot` (T j) = T (i `quot` j) ; \ + (T i) `rem` (T j) = T (i `rem` j) ; \ + (T i) `div` (T j) = T (i `div` j) ; \ + (T i) `mod` (T j) = T (i `mod` j) ; \ + (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \ + (T i) `divMod` (T j) = let (d,m) = i `divMod` j in (T d, T m) ; \ + toInteger (T i) = toInteger i ; \ + toInt (T i) = toInt i } + +#define INSTANCE_BITS(T) \ +instance Bits T where { \ + (T x) .&. (T y) = T (x .&. y) ; \ + (T x) .|. (T y) = T (x .|. y) ; \ + (T x) `xor` (T y) = T (x `xor` y) ; \ + complement (T x) = T (complement x) ; \ + shift (T x) n = T (shift x n) ; \ + rotate (T x) n = T (rotate x n) ; \ + bit n = T (bit n) ; \ + setBit (T x) n = T (setBit x n) ; \ + clearBit (T x) n = T (clearBit x n) ; \ + complementBit (T x) n = T (complementBit x n) ; \ + testBit (T x) n = testBit x n ; \ + bitSize (T x) = bitSize x ; \ + isSigned (T x) = isSigned x } + +#define INSTANCE_FRACTIONAL(T) \ +instance Fractional T where { \ + (T x) / (T y) = T (x / y) ; \ + recip (T x) = T (recip x) ; \ + fromRational r = T (fromRational r) } + +#define INSTANCE_FLOATING(T) \ +instance Floating T where { \ + pi = pi ; \ + exp (T x) = T (exp x) ; \ + log (T x) = T (log x) ; \ + sqrt (T x) = T (sqrt x) ; \ + (T x) ** (T y) = T (x ** y) ; \ + (T x) `logBase` (T y) = T (x `logBase` y) ; \ + sin (T x) = T (sin x) ; \ + cos (T x) = T (cos x) ; \ + tan (T x) = T (tan x) ; \ + asin (T x) = T (asin x) ; \ + acos (T x) = T (acos x) ; \ + atan (T x) = T (atan x) ; \ + sinh (T x) = T (sinh x) ; \ + cosh (T x) = T (cosh x) ; \ + tanh (T x) = T (tanh x) ; \ + asinh (T x) = T (asinh x) ; \ + acosh (T x) = T (acosh x) ; \ + atanh (T x) = T (atanh x) } + +#define INSTANCE_REALFRAC(T) \ +instance RealFrac T where { \ + properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \ + truncate (T x) = truncate x ; \ + round (T x) = round x ; \ + ceiling (T x) = ceiling x ; \ + floor (T x) = floor x } + +#define INSTANCE_REALFLOAT(T) \ +instance RealFloat T where { \ + floatRadix (T x) = floatRadix x ; \ + floatDigits (T x) = floatDigits x ; \ + floatRange (T x) = floatRange x ; \ + decodeFloat (T x) = decodeFloat x ; \ + encodeFloat m n = T (encodeFloat m n) ; \ + exponent (T x) = exponent x ; \ + significand (T x) = T (significand x) ; \ + scaleFloat n (T x) = T (scaleFloat n x) ; \ + isNaN (T x) = isNaN x ; \ + isInfinite (T x) = isInfinite x ; \ + isDenormalized (T x) = isDenormalized x ; \ + isNegativeZero (T x) = isNegativeZero x ; \ + isIEEE (T x) = isIEEE x ; \ + (T x) `atan2` (T y) = T (x `atan2` y) } + +#else /* __GLASGOW_HASKELL__ */ + +/* On GHC, we just cast the type of each method to the underlying + * type. This means that GHC only needs to generate the dictionary + * for each instance, rather than a new function for each method (the + * simplifier currently isn't clever enough to reduce a method that + * simply deconstructs a newtype and calls the underlying method into + * an indirection to the underlying method, so that's what we're doing + * here). + */ + +#define NUMERIC_TYPE(T,C,S,B) \ +newtype T = T B ; \ +INSTANCE_EQ(T,B) ; \ +INSTANCE_ORD(T,B) ; \ +INSTANCE_NUM(T,B) ; \ +INSTANCE_READ(T,B) ; \ +INSTANCE_SHOW(T,B) ; \ +INSTANCE_ENUM(T,B) + +#define INTEGRAL_TYPE(T,C,S,B) \ +NUMERIC_TYPE(T,C,S,B) ; \ +INSTANCE_BOUNDED(T,B) ; \ +INSTANCE_REAL(T,B) ; \ +INSTANCE_INTEGRAL(T,B) ; \ +INSTANCE_BITS(T,B) + +#define FLOATING_TYPE(T,C,S,B) \ +NUMERIC_TYPE(T,C,S,B) ; \ +INSTANCE_REAL(T,B) ; \ +INSTANCE_FRACTIONAL(T,B) ; \ +INSTANCE_FLOATING(T,B) ; \ +INSTANCE_REALFRAC(T) ; \ +INSTANCE_REALFLOAT(T,B) + +#define INSTANCE_EQ(T,B) \ +instance Eq T where { \ + (==) = unsafeCoerce# ((==) :: B -> B -> Bool); \ + (/=) = unsafeCoerce# ((/=) :: B -> B -> Bool); } + +#define INSTANCE_ORD(T,B) \ +instance Ord T where { \ + compare = unsafeCoerce# (compare :: B -> B -> Ordering); \ + (<) = unsafeCoerce# ((<) :: B -> B -> Bool); \ + (<=) = unsafeCoerce# ((<=) :: B -> B -> Bool); \ + (>=) = unsafeCoerce# ((>=) :: B -> B -> Bool); \ + (>) = unsafeCoerce# ((>) :: B -> B -> Bool); \ + max = unsafeCoerce# (max :: B -> B -> B); \ + min = unsafeCoerce# (min :: B -> B -> B); } + +#define INSTANCE_READ(T,B) \ +instance Read T where { \ + readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \ + readList = unsafeCoerce# (readList :: ReadS [B]); } + +#define INSTANCE_SHOW(T,B) \ +instance Show T where { \ + showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \ + show = unsafeCoerce# (show :: B -> String); \ + showList = unsafeCoerce# (showList :: [B] -> ShowS); } + +#define INSTANCE_NUM(T,B) \ +instance Num T where { \ + (+) = unsafeCoerce# ((+) :: B -> B -> B); \ + (-) = unsafeCoerce# ((-) :: B -> B -> B); \ + (*) = unsafeCoerce# ((*) :: B -> B -> B); \ + negate = unsafeCoerce# (negate :: B -> B); \ + abs = unsafeCoerce# (abs :: B -> B); \ + signum = unsafeCoerce# (signum :: B -> B); \ + fromInteger = unsafeCoerce# (fromInteger :: Integer -> B); \ + fromInt = unsafeCoerce# (fromInt :: Int -> B) } + +#define INSTANCE_STORABLE(T,B) \ +instance Storable T where { \ + sizeOf = unsafeCoerce# (sizeOf :: B -> Int); \ + alignment = unsafeCoerce# (alignment :: B -> Int); \ + peekElemOff = unsafeCoerce# (peekElemOff :: Ptr B -> Int -> IO B); \ + pokeElemOff = unsafeCoerce# (pokeElemOff :: Ptr B -> Int -> B -> IO B); } + +#define INSTANCE_BOUNDED(T,B) \ +instance Bounded T where { \ + minBound = T minBound ; \ + maxBound = T maxBound } + +#define INSTANCE_ENUM(T,B) \ +instance Enum T where { \ + succ = unsafeCoerce# (succ :: B -> B); \ + pred = unsafeCoerce# (pred :: B -> B); \ + toEnum = unsafeCoerce# (toEnum :: Int -> B); \ + fromEnum = unsafeCoerce# (fromEnum :: B -> Int); \ + enumFrom = unsafeCoerce# (enumFrom :: B -> [B]); \ + enumFromThen = unsafeCoerce# (enumFromThen :: B -> B -> [B]); \ + enumFromTo = unsafeCoerce# (enumFromTo :: B -> B -> [B]); \ + enumFromThenTo = unsafeCoerce# (enumFromThenTo :: B -> B -> B -> [B]);} + +#define INSTANCE_REAL(T,B) \ +instance Real T where { \ + toRational = unsafeCoerce# (toRational :: B -> Rational) } + +#define INSTANCE_INTEGRAL(T,B) \ +instance Integral T where { \ + quot = unsafeCoerce# (quot:: B -> B -> B); \ + rem = unsafeCoerce# (rem:: B -> B -> B); \ + div = unsafeCoerce# (div:: B -> B -> B); \ + mod = unsafeCoerce# (mod:: B -> B -> B); \ + quotRem = unsafeCoerce# (quotRem:: B -> B -> (B,B)); \ + divMod = unsafeCoerce# (divMod:: B -> B -> (B,B)); \ + toInteger = unsafeCoerce# (toInteger:: B -> Integer); \ + toInt = unsafeCoerce# (toInt:: B -> Int); } + +#define INSTANCE_BITS(T,B) \ +instance Bits T where { \ + (.&.) = unsafeCoerce# ((.&.) :: B -> B -> B); \ + (.|.) = unsafeCoerce# ((.|.) :: B -> B -> B); \ + xor = unsafeCoerce# (xor:: B -> B -> B); \ + complement = unsafeCoerce# (complement:: B -> B); \ + shift = unsafeCoerce# (shift:: B -> Int -> B); \ + rotate = unsafeCoerce# (rotate:: B -> Int -> B); \ + bit = unsafeCoerce# (bit:: Int -> B); \ + setBit = unsafeCoerce# (setBit:: B -> Int -> B); \ + clearBit = unsafeCoerce# (clearBit:: B -> Int -> B); \ + complementBit = unsafeCoerce# (complementBit:: B -> Int -> B); \ + testBit = unsafeCoerce# (testBit:: B -> Int -> Bool); \ + bitSize = unsafeCoerce# (bitSize:: B -> Int); \ + isSigned = unsafeCoerce# (isSigned:: B -> Bool); } + +#define INSTANCE_FRACTIONAL(T,B) \ +instance Fractional T where { \ + (/) = unsafeCoerce# ((/) :: B -> B -> B); \ + recip = unsafeCoerce# (recip :: B -> B); \ + fromRational = unsafeCoerce# (fromRational :: Rational -> B); } + +#define INSTANCE_FLOATING(T,B) \ +instance Floating T where { \ + pi = unsafeCoerce# (pi :: B); \ + exp = unsafeCoerce# (exp :: B -> B); \ + log = unsafeCoerce# (log :: B -> B); \ + sqrt = unsafeCoerce# (sqrt :: B -> B); \ + (**) = unsafeCoerce# ((**) :: B -> B -> B); \ + logBase = unsafeCoerce# (logBase :: B -> B -> B); \ + sin = unsafeCoerce# (sin :: B -> B); \ + cos = unsafeCoerce# (cos :: B -> B); \ + tan = unsafeCoerce# (tan :: B -> B); \ + asin = unsafeCoerce# (asin :: B -> B); \ + acos = unsafeCoerce# (acos :: B -> B); \ + atan = unsafeCoerce# (atan :: B -> B); \ + sinh = unsafeCoerce# (sinh :: B -> B); \ + cosh = unsafeCoerce# (cosh :: B -> B); \ + tanh = unsafeCoerce# (tanh :: B -> B); \ + asinh = unsafeCoerce# (asinh :: B -> B); \ + acosh = unsafeCoerce# (acosh :: B -> B); \ + atanh = unsafeCoerce# (atanh :: B -> B); } + +/* The coerce trick doesn't work for RealFrac, these methods are + * polymorphic and overloaded. + */ +#define INSTANCE_REALFRAC(T) \ +instance RealFrac T where { \ + properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \ + truncate (T x) = truncate x ; \ + round (T x) = round x ; \ + ceiling (T x) = ceiling x ; \ + floor (T x) = floor x } + +#define INSTANCE_REALFLOAT(T,B) \ +instance RealFloat T where { \ + floatRadix = unsafeCoerce# (floatRadix :: B -> Integer); \ + floatDigits = unsafeCoerce# (floatDigits :: B -> Int); \ + floatRange = unsafeCoerce# (floatRange :: B -> (Int,Int)); \ + decodeFloat = unsafeCoerce# (decodeFloat :: B -> (Integer,Int)); \ + encodeFloat = unsafeCoerce# (encodeFloat :: Integer -> Int -> B); \ + exponent = unsafeCoerce# (exponent :: B -> Int); \ + significand = unsafeCoerce# (significand :: B -> B); \ + scaleFloat = unsafeCoerce# (scaleFloat :: Int -> B -> B); \ + isNaN = unsafeCoerce# (isNaN :: B -> Bool); \ + isInfinite = unsafeCoerce# (isInfinite :: B -> Bool); \ + isDenormalized = unsafeCoerce# (isDenormalized :: B -> Bool); \ + isNegativeZero = unsafeCoerce# (isNegativeZero :: B -> Bool); \ + isIEEE = unsafeCoerce# (isIEEE :: B -> Bool); \ + atan2 = unsafeCoerce# (atan2 :: B -> B -> B); } + +#endif /* __GLASGOW_HASKELL__ */ diff --git a/ghc/lib/std/cbits/createDirectory.c b/ghc/lib/std/cbits/createDirectory.c deleted file mode 100644 index 389a293b63..0000000000 --- a/ghc/lib/std/cbits/createDirectory.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: createDirectory.c,v 1.4 1999/03/01 09:03:37 sof Exp $ - * - * createDirectory Runtime Support} - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -#if defined(mingw32_TARGET_OS) -#define mkDir(nm,p) mkdir(nm) -#else -#define mkDir(nm,p) mkdir(nm,p) -#endif - -StgInt -createDirectory(path) -StgByteArray path; -{ - int rc; - struct stat sb; - - while((rc = mkDir(path, 0777)) != 0) { - if (errno != EINTR) { - cvtErrno(); - switch (ghc_errno) { - default: - stdErrno(); - break; - case GHC_ENOENT: - case GHC_ENOTDIR: - ghc_errtype = ERR_NOSUCHTHING; - ghc_errstr = "no path to directory"; - break; - case GHC_EEXIST: - if (stat(path, &sb) != 0) { - ghc_errtype = ERR_OTHERERROR; - ghc_errstr = "cannot stat existing file"; - } - if (S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_ALREADYEXISTS; - ghc_errstr = "directory already exists"; - } else { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "file already exists"; - } - break; - } - return -1; - } - } - return 0; -} diff --git a/ghc/lib/std/cbits/directoryAux.c b/ghc/lib/std/cbits/directoryAux.c deleted file mode 100644 index 1aa52aca6f..0000000000 --- a/ghc/lib/std/cbits/directoryAux.c +++ /dev/null @@ -1,128 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1998 - * - * $Id: directoryAux.c,v 1.3 2000/08/24 10:27:01 simonmar Exp $ - * - * Support functions for manipulating directories - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -#ifdef HAVE_DIRENT_H -#include <dirent.h> -#endif - -StgAddr -openDir__(StgByteArray path) -{ - struct stat sb; - DIR *dir; - - /* Check for an actual directory */ - while (stat(path, &sb) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return NULL; - } - } - if (!S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "not a directory"; - return NULL; - } - - while ((dir = opendir(path)) == NULL) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return NULL; - } - } - return dir; -} - -StgAddr -readDir__(StgAddr dir) - -{ - struct dirent *d; - while ((d = readdir((DIR*)dir)) == NULL) { - if (errno == 0) { - (void) closedir((DIR*)dir); - return NULL; - } else if (errno != EINTR) { - cvtErrno(); - stdErrno(); - (void) closedir((DIR*)dir); - return NULL; - } - errno = 0; - } - return d; -} - -StgAddr -get_dirent_d_name(StgAddr d) -{ - return ((struct dirent*)d)->d_name; -} - -StgInt sizeof_stat( void ) { return sizeof(struct stat); } - -StgInt prim_stat(StgAddr x, StgAddr y) -{ - return stat((char*)x, (struct stat*)y); -} - - -StgWord -get_stat_st_mode (StgAddr x) -{ - return ((struct stat *)x)->st_mode; -} - - -StgInt64 -get_stat_st_mtime(StgAddr x) -{ - return ((struct stat *)x)->st_mtime; -} - -void -set_stat_st_mtime(StgByteArray p, StgByteArray x) -{ - ((unsigned long *)p)[0] = ((struct stat *)x)->st_mtime; - return; -} - -StgWord const_S_IRUSR( void ) { return S_IRUSR; } -StgWord const_S_IWUSR( void ) { return S_IWUSR; } -StgWord const_S_IXUSR( void ) { return S_IXUSR; } - -StgInt -prim_S_ISDIR( StgWord x ) -{ - return S_ISDIR(x); -} - -StgInt -prim_S_ISREG( StgWord x ) -{ - return S_ISREG(x); -} - - -StgWord const_R_OK( void ) { return R_OK; } -StgWord const_W_OK( void ) { return W_OK; } -StgWord const_X_OK( void ) { return X_OK; } -StgWord const_F_OK( void ) { return F_OK; } diff --git a/ghc/lib/std/cbits/getCurrentDirectory.c b/ghc/lib/std/cbits/getCurrentDirectory.c deleted file mode 100644 index a5271dd149..0000000000 --- a/ghc/lib/std/cbits/getCurrentDirectory.c +++ /dev/null @@ -1,47 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: getCurrentDirectory.c,v 1.3 1998/12/02 13:27:39 simonm Exp $ - * - * getCurrentDirectory Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#ifndef PATH_MAX -#ifdef MAXPATHLEN -#define PATH_MAX MAXPATHLEN -#else -#define PATH_MAX 1024 -#endif -#endif - -StgAddr -getCurrentDirectory(void) -{ - char *pwd; - int alloc; - - alloc = PATH_MAX; - if ((pwd = malloc(alloc)) == NULL) { - ghc_errtype = ERR_RESOURCEEXHAUSTED; - ghc_errstr = "not enough virtual memory"; - return NULL; - } - while (getcwd(pwd, alloc) == NULL) { - if (errno == ERANGE) { - alloc += PATH_MAX; - if ((pwd = realloc(pwd, alloc)) == NULL) { - ghc_errtype = ERR_RESOURCEEXHAUSTED; - ghc_errstr = "not enough virtual memory"; - return NULL; - } - } else if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return NULL; - } - } - return (StgAddr) pwd; -} diff --git a/ghc/lib/std/cbits/getDirectoryContents.c b/ghc/lib/std/cbits/getDirectoryContents.c deleted file mode 100644 index c4a2b7e7f4..0000000000 --- a/ghc/lib/std/cbits/getDirectoryContents.c +++ /dev/null @@ -1,125 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: getDirectoryContents.c,v 1.3 1998/12/02 13:27:40 simonm Exp $ - * - * getDirectoryContents Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -#ifdef HAVE_DIRENT_H -#include <dirent.h> -#endif - -#ifndef LINK_MAX -#define LINK_MAX 1024 -#endif - -/* For cleanup of partial answer on error */ - -static void -freeEntries(char **entries, int count) -{ - int i; - - for (i = 0; i < count; i++) - free(entries[i]); - free(entries); -} - -/* - * Our caller expects a malloc'ed array of malloc'ed string pointers. - * To ensure consistency when mixing this with other directory - * operations, we collect the entire list in one atomic operation, - * rather than reading the directory lazily. - */ -StgAddr -getDirectoryContents(path) -StgByteArray path; -{ - struct stat sb; - DIR *dir; - struct dirent *d; - char **entries; - int alloc, count, len; - - /* Check for an actual directory */ - while (stat(path, &sb) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return NULL; - } - } - if (!S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "not a directory"; - return NULL; - } - - alloc = LINK_MAX; - if ((entries = (char **) malloc(alloc * sizeof(char *))) == NULL) { - ghc_errtype = ERR_RESOURCEEXHAUSTED; - ghc_errstr = "not enough virtual memory"; - return NULL; - } - - while ((dir = opendir(path)) == NULL) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - free(entries); - return NULL; - } - } - - count = 0; - for (;;) { - errno = 0; /* unchanged by readdir on EOF */ - while ((d = readdir(dir)) == NULL) { - if (errno == 0) { - entries[count] = NULL; - (void) closedir(dir); - return (StgAddr) entries; - } else if (errno != EINTR) { - cvtErrno(); - stdErrno(); - freeEntries(entries, count); - (void) closedir(dir); - return NULL; - } - errno = 0; - } - len = strlen(d->d_name); - if ((entries[count] = malloc(len+1)) == NULL) { - ghc_errtype = ERR_RESOURCEEXHAUSTED; - ghc_errstr = "not enough virtual memory"; - freeEntries(entries, count); - (void) closedir(dir); - return NULL; - } - strcpy(entries[count], d->d_name); - /* Terminate the sucker */ - *(entries[count] + len) = 0; - if (++count == alloc) { - alloc += LINK_MAX; - if ((entries = (char **) realloc(entries, alloc * sizeof(char *))) == NULL) { - ghc_errtype = ERR_RESOURCEEXHAUSTED; - ghc_errstr = "not enough virtual memory"; - freeEntries(entries, count); - (void) closedir(dir); - return NULL; - } - } - } -} diff --git a/ghc/lib/std/cbits/progargs.c b/ghc/lib/std/cbits/progargs.c index 30d89aa3c5..b0ee172fdf 100644 --- a/ghc/lib/std/cbits/progargs.c +++ b/ghc/lib/std/cbits/progargs.c @@ -1,7 +1,7 @@ /* * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 * - * $Id: progargs.c,v 1.3 2000/03/14 01:52:25 sof Exp $ + * $Id: progargs.c,v 1.4 2001/01/11 17:25:58 simonmar Exp $ * * System.getArgs Runtime Support */ @@ -9,13 +9,13 @@ #include "Rts.h" #include "stgio.h" -StgAddr +HsAddr get_prog_argv(void) { return prog_argv; } -StgInt +HsInt get_prog_argc() { return prog_argc; diff --git a/ghc/lib/std/cbits/removeDirectory.c b/ghc/lib/std/cbits/removeDirectory.c deleted file mode 100644 index 21864a3873..0000000000 --- a/ghc/lib/std/cbits/removeDirectory.c +++ /dev/null @@ -1,56 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: removeDirectory.c,v 1.3 1998/12/02 13:27:47 simonm Exp $ - * - * removeDirectory Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -StgInt -removeDirectory(path) -StgByteArray path; -{ - struct stat sb; - - /* Check for an actual directory */ - while (stat(path, &sb) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - if (!S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "not a directory"; - return -1; - } - while (rmdir(path) != 0) { - if (errno != EINTR) { - cvtErrno(); - switch (ghc_errno) { - default: - stdErrno(); - break; - case GHC_ENOTEMPTY: - case GHC_EEXIST: - ghc_errtype = ERR_UNSATISFIEDCONSTRAINTS; - ghc_errstr = "directory not empty"; - break; - } - return -1; - } - } - return 0; -} diff --git a/ghc/lib/std/cbits/removeFile.c b/ghc/lib/std/cbits/removeFile.c deleted file mode 100644 index 22e9a7b9c8..0000000000 --- a/ghc/lib/std/cbits/removeFile.c +++ /dev/null @@ -1,46 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: removeFile.c,v 1.4 2000/04/06 10:33:07 rrt Exp $ - * - * removeFile Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -StgInt -removeFile(StgByteArray path) -{ - struct stat sb; - - /* Check for a non-directory */ - while (stat(path, &sb) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - if (S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "file is a directory"; - return -1; - } - while (unlink(path) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - return 0; -} diff --git a/ghc/lib/std/cbits/renameDirectory.c b/ghc/lib/std/cbits/renameDirectory.c deleted file mode 100644 index 68b1560bde..0000000000 --- a/ghc/lib/std/cbits/renameDirectory.c +++ /dev/null @@ -1,48 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: renameDirectory.c,v 1.3 1998/12/02 13:27:50 simonm Exp $ - * - * renameDirectory Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -StgInt -renameDirectory(opath, npath) -StgByteArray opath; -StgByteArray npath; -{ - struct stat sb; - - /* Check for an actual directory */ - while (stat(opath, &sb) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - if (!S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "not a directory"; - return -1; - } - while(rename(opath, npath) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - return 0; -} diff --git a/ghc/lib/std/cbits/renameFile.c b/ghc/lib/std/cbits/renameFile.c deleted file mode 100644 index 2126849a63..0000000000 --- a/ghc/lib/std/cbits/renameFile.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: renameFile.c,v 1.8 2000/04/06 10:33:06 rrt Exp $ - * - * renameFile Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -#ifdef HAVE_SYS_TYPES_H -#include <sys/types.h> -#endif - -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif - -#ifdef HAVE_FCNTL_H -#include <fcntl.h> -#endif - - -StgInt -renameFile(StgByteArray opath, StgByteArray npath) -{ - struct stat sb; - - /* Check for a non-directory source */ - while (stat(opath, &sb) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - if (S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "file is a directory"; - return -1; - } - - /* Check for a non-directory destination */ - while (stat(npath, &sb) != 0 && errno != ENOENT) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - - if (errno != ENOENT) { - if (S_ISDIR(sb.st_mode)) { - ghc_errtype = ERR_INAPPROPRIATETYPE; - ghc_errstr = "file is a directory"; - return -1; - } - while (chmod(npath, S_IWUSR) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - while (unlink(npath) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - } - - while(rename(opath, npath) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - - return 0; -} diff --git a/ghc/lib/std/cbits/setCurrentDirectory.c b/ghc/lib/std/cbits/setCurrentDirectory.c deleted file mode 100644 index 9c86cd75c0..0000000000 --- a/ghc/lib/std/cbits/setCurrentDirectory.c +++ /dev/null @@ -1,24 +0,0 @@ -/* - * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 - * - * $Id: setCurrentDirectory.c,v 1.3 1998/12/02 13:27:56 simonm Exp $ - * - * setCurrentDirectory Runtime Support - */ - -#include "Rts.h" -#include "stgio.h" - -StgInt -setCurrentDirectory(path) -StgByteArray path; -{ - while (chdir(path) != 0) { - if (errno != EINTR) { - cvtErrno(); - stdErrno(); - return -1; - } - } - return 0; -} |