From 3d39b8130899c46c9c96b941fddb4e4784e860dc Mon Sep 17 00:00:00 2001 From: simonmar Date: Fri, 17 Aug 2001 12:50:35 +0000 Subject: [PATCH] [project @ 2001-08-17 12:50:34 by simonmar] Track updates to ghc/lib/std and hslibs. --- Foreign/C/String.hs | 23 +---- Foreign/Marshal/Alloc.hs | 21 ++++- Foreign/Marshal/Array.hs | 15 +++- GHC/Posix.hsc | 213 ++++++++++++++++++++++++++++++++-------------- GHC/Prim.hi-boot | 4 +- GHC/TopHandler.lhs | 6 +- Makefile | 11 ++- System/CPUTime.hsc | 6 +- System/Cmd.hsc | 6 +- System/Environment.hs | 34 +++++--- System/Time.hsc | 5 +- Text/Regex/Posix.hsc | 6 +- cbits/Makefile | 6 +- cbits/inputReady.c | 9 +- cbits/system.c | 32 +------ core.conf.in | 2 +- include/HsCore.h | 20 ++++- 17 files changed, 250 insertions(+), 169 deletions(-) diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs index 000bd2f..cea82e2 100644 --- a/Foreign/C/String.hs +++ b/Foreign/C/String.hs @@ -9,7 +9,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: String.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $ +-- $Id: String.hs,v 1.3 2001/08/17 12:50:34 simonmar Exp $ -- -- Utilities for primitive marshaling -- @@ -40,14 +40,6 @@ module Foreign.C.String ( -- representation of strings in C castCharToCChar, -- :: Char -> CChar castCCharToChar, -- :: CChar -> Char - -- UnsafeCString: these might be more efficient than CStrings when - -- passing the string to an "unsafe" foreign import. NOTE: this - -- feature might be removed in favour of a more general approach in - -- the future. - -- - UnsafeCString, -- abstract - withUnsafeCString, -- :: String -> (UnsafeCString -> IO a) -> IO a - ) where import Foreign.Marshal.Array @@ -164,16 +156,3 @@ castCCharToChar ch = unsafeChr (fromIntegral (fromIntegral ch :: Word8)) castCharToCChar :: Char -> CChar castCharToCChar ch = fromIntegral (ord ch) - - --- unsafe CStrings --- --------------- - -withUnsafeCString :: String -> (UnsafeCString -> IO a) -> IO a -#if __GLASGOW_HASKELL__ -newtype UnsafeCString = UnsafeCString (ByteArray Int) -withUnsafeCString s f = f (UnsafeCString (packString s)) -#else -newtype UnsafeCString = UnsafeCString (Ptr CChar) -withUnsafeCString s f = withCString s (\p -> f (UnsafeCString p)) -#endif diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs index eddfff6..ce5f1c3 100644 --- a/Foreign/Marshal/Alloc.hs +++ b/Foreign/Marshal/Alloc.hs @@ -9,7 +9,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: Alloc.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $ +-- $Id: Alloc.hs,v 1.3 2001/08/17 12:50:34 simonmar Exp $ -- -- Marshalling support: basic routines for memory allocation -- @@ -30,14 +30,16 @@ module Foreign.Marshal.Alloc ( import Data.Maybe import Foreign.Ptr ( Ptr, nullPtr ) import Foreign.C.TypesISO ( CSize ) +import Foreign.Storable ( Storable(sizeOf) ) #ifdef __GLASGOW_HASKELL__ -import GHC.Exception ( bracket ) -import GHC.Storable ( Storable(sizeOf) ) +import GHC.Exception ( bracket ) import GHC.IOBase import GHC.Real +import GHC.Ptr import GHC.Err import GHC.Base +import GHC.Prim #endif @@ -75,8 +77,21 @@ alloca = doAlloca undefined -- this function; in other words, in `allocaBytes n f' the allocated storage -- must not be used after `f' returns -- +#ifdef __GLASGOW_HASKELL__ +allocaBytes :: Int -> (Ptr a -> IO b) -> IO b +allocaBytes (I# size) action = IO $ \ s -> + case newPinnedByteArray# size s of { (# s, mbarr# #) -> + case unsafeFreezeByteArray# mbarr# s of { (# s, barr# #) -> + let addr = Ptr (byteArrayContents# barr#) in + case action addr of { IO action -> + case action s of { (# s, r #) -> + case touch# barr# s of { s -> + (# s, r #) + }}}}} +#else allocaBytes :: Int -> (Ptr a -> IO b) -> IO b allocaBytes size = bracket (mallocBytes size) free +#endif -- adjust a malloc'ed storage area to the given size -- diff --git a/Foreign/Marshal/Array.hs b/Foreign/Marshal/Array.hs index b6b14d6..c660ba1 100644 --- a/Foreign/Marshal/Array.hs +++ b/Foreign/Marshal/Array.hs @@ -9,7 +9,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: Array.hs,v 1.2 2001/07/03 11:37:50 simonmar Exp $ +-- $Id: Array.hs,v 1.3 2001/08/17 12:50:34 simonmar Exp $ -- -- Marshalling support: routines allocating, storing, and retrieving Haskell -- lists that are represented as arrays in the foreign language @@ -126,11 +126,18 @@ reallocArray0 ptr size = reallocArray ptr (size + 1) -- marshalling -- ----------- --- convert an array of given length into a Haskell list +-- convert an array of given length into a Haskell list. This version +-- traverses the array backwards using an accumulating parameter, +-- which uses constant stack space. The previous version using mapM +-- needed linear stack space. -- peekArray :: Storable a => Int -> Ptr a -> IO [a] -peekArray size ptr = mapM (peekElemOff ptr) [0..size-1] - +peekArray size ptr | size <= 0 = return [] + | otherwise = f (size-1) [] + where + f 0 acc = do e <- peekElemOff ptr 0; return (e:acc) + f n acc = do e <- peekElemOff ptr n; f (n-1) (e:acc) + -- convert an array terminated by the given end marker into a Haskell list -- peekArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO [a] diff --git a/GHC/Posix.hsc b/GHC/Posix.hsc index 1b754a8..819beea 100644 --- a/GHC/Posix.hsc +++ b/GHC/Posix.hsc @@ -1,15 +1,18 @@ -{-# OPTIONS -fno-implicit-prelude -optc-DNON_POSIX_SOURCE #-} +{-# OPTIONS -fno-implicit-prelude #-} -- --------------------------------------------------------------------------- --- $Id: Posix.hsc,v 1.2 2001/07/31 12:48:13 simonmar Exp $ +-- $Id: Posix.hsc,v 1.3 2001/08/17 12:50:34 simonmar Exp $ -- -- POSIX support layer for the standard libraries -- --- NON_POSIX_SOURCE needed for the following features: +-- Non-posix compliant in order to support the following features: -- * S_ISSOCK (no sockets in POSIX) module GHC.Posix where +-- See above comment for non-Posixness reasons. +-- #include "PosixSource.h" + #include "HsCore.h" import Control.Monad @@ -28,8 +31,20 @@ import GHC.IOBase -- --------------------------------------------------------------------------- -- Types -data CDir = CDir -type CSigset = () +type CDir = () +type CDirent = () +type CFLock = () +type CGroup = () +type CLconv = () +type CPasswd = () +type CSigaction = () +type CSigset = () +type CStat = () +type CTermios = () +type CTm = () +type CTms = () +type CUtimbuf = () +type CUtsname = () type CDev = #type dev_t type CIno = #type ino_t @@ -52,8 +67,6 @@ type CTcflag = #type tcflag_t -- --------------------------------------------------------------------------- -- stat()-related stuff -type CStat = () - fdFileSize :: Int -> IO Integer fdFileSize fd = allocaBytes (#const sizeof(struct stat)) $ \ p_stat -> do @@ -96,23 +109,6 @@ statGetType p_stat = do ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType" "unknown file type" Nothing -foreign import "s_isreg_wrap" s_isreg :: CMode -> Bool -#def inline int s_isreg_wrap(m) { return S_ISREG(m); } - -foreign import "s_isdir_wrap" s_isdir :: CMode -> Bool -#def inline int s_isdir_wrap(m) { return S_ISDIR(m); } - -foreign import "s_isfifo_wrap" s_isfifo :: CMode -> Bool -#def inline int s_isfifo_wrap(m) { return S_ISFIFO(m); } - -#ifndef mingw32_TARGET_OS -foreign import "s_issock_wrap" s_issock :: CMode -> Bool -#def inline int s_issock_wrap(m) { return S_ISSOCK(m); } -#else -s_issock :: CMode -> Bool -s_issock cmode = False -#endif - -- It isn't clear whether ftruncate is POSIX or not (I've read several -- manpages and they seem to conflict), so we truncate using open/2. fileTruncate :: FilePath -> IO () @@ -133,8 +129,6 @@ fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool #ifndef mingw32_TARGET_OS -type Termios = () - setEcho :: Int -> Bool -> IO () setEcho fd on = do allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do @@ -182,7 +176,7 @@ setCooked fd cooked = -- wrapper which temporarily blocks SIGTTOU around the call, making it -- transparent. -tcSetAttr :: FD -> CInt -> Ptr Termios -> IO () +tcSetAttr :: FD -> CInt -> Ptr CTermios -> IO () tcSetAttr fd options p_tios = do allocaBytes (#const sizeof(sigset_t)) $ \ p_sigset -> do allocaBytes (#const sizeof(sigset_t)) $ \ p_old_sigset -> do @@ -214,9 +208,9 @@ getEcho fd = return False setNonBlockingFD fd = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" - (fcntl_read (fromIntegral fd) (#const F_GETFL)) + (c_fcntl_read (fromIntegral fd) (#const F_GETFL)) throwErrnoIfMinus1Retry "setNonBlockingFD" - (fcntl_write (fromIntegral fd) + (c_fcntl_write (fromIntegral fd) (#const F_SETFL) (flags .|. #const O_NONBLOCK)) #else @@ -228,20 +222,6 @@ setNonBlockingFD fd = return () -- ----------------------------------------------------------------------------- -- foreign imports -foreign import "stat" unsafe - c_stat :: CString -> Ptr CStat -> IO CInt - -foreign import "fstat" unsafe - c_fstat :: CInt -> Ptr CStat -> IO CInt - -#ifdef HAVE_LSTAT -foreign import "lstat" unsafe - c_lstat :: CString -> Ptr CStat -> IO CInt -#endif - -foreign import "open" unsafe - c_open :: CString -> CInt -> CMode -> IO CInt - -- POSIX flags only: o_RDONLY = (#const O_RDONLY) :: CInt o_WRONLY = (#const O_WRONLY) :: CInt @@ -263,49 +243,152 @@ o_NONBLOCK = (#const O_NONBLOCK) :: CInt o_BINARY = (#const O_BINARY) :: CInt #endif -foreign import "isatty" unsafe - c_isatty :: CInt -> IO CInt +foreign import ccall "access" unsafe + c_access :: CString -> CMode -> IO CInt + +foreign import ccall "chmod" unsafe + c_chmod :: CString -> CMode -> IO CInt + +foreign import ccall "chdir" unsafe + c_chdir :: CString -> IO CInt + +foreign import ccall "chown" unsafe + c_chown :: CString -> CUid -> CGid -> IO CInt -foreign import "close" unsafe +foreign import ccall "close" unsafe c_close :: CInt -> IO CInt -foreign import "lseek" unsafe +foreign import ccall "closedir" unsafe + c_closedir :: Ptr CDir -> IO CInt + +foreign import ccall "creat" unsafe + c_creat :: CString -> CMode -> IO CInt + +foreign import ccall "dup" unsafe + c_dup :: CInt -> IO CInt + +foreign import ccall "dup2" unsafe + c_dup2 :: CInt -> CInt -> IO CInt + +foreign import ccall "fpathconf" unsafe + c_fpathconf :: CInt -> CInt -> IO CLong + +foreign import ccall "fstat" unsafe + c_fstat :: CInt -> Ptr CStat -> IO CInt + +foreign import ccall "getcwd" unsafe + c_getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar) + +foreign import ccall "isatty" unsafe + c_isatty :: CInt -> IO CInt + +foreign import ccall "link" unsafe + c_link :: CString -> CString -> IO CInt + +foreign import ccall "lseek" unsafe c_lseek :: CInt -> COff -> CInt -> IO COff -foreign import "write" unsafe - c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize +#ifdef HAVE_LSTAT +foreign import ccall "lstat" unsafe + c_lstat :: CString -> Ptr CStat -> IO CInt +#endif + +foreign import ccall "open" unsafe + c_open :: CString -> CInt -> CMode -> IO CInt -foreign import "read" unsafe +foreign import ccall "opendir" unsafe + c_opendir :: CString -> IO (Ptr CDir) + +foreign import ccall "mkdir" unsafe +#if defined(mingw32_TARGET_OS) + c_mkdir :: CString -> IO CInt +#else + c_mkdir :: CString -> CMode -> IO CInt +#endif + +foreign import ccall "mkfifo" unsafe + c_mkfifo :: CString -> CMode -> IO CInt + +foreign import ccall "pathconf" unsafe + c_pathconf :: CString -> CInt -> IO CLong + +foreign import ccall "pipe" unsafe + c_pipe :: Ptr CInt -> IO CInt + +foreign import ccall "read" unsafe c_read :: CInt -> Ptr CChar -> CSize -> IO CSsize +foreign import ccall "readdir" unsafe + c_readdir :: Ptr CDir -> IO (Ptr CDirent) + +foreign import ccall "rename" unsafe + c_rename :: CString -> CString -> IO CInt + +foreign import ccall "rewinddir" unsafe + c_rewinddir :: Ptr CDir -> IO () + +foreign import ccall "rmdir" unsafe + c_rmdir :: CString -> IO CInt + +foreign import ccall "stat" unsafe + c_stat :: CString -> Ptr CStat -> IO CInt + +foreign import ccall "umask" unsafe + c_umask :: CMode -> IO CMode + +foreign import ccall "utime" unsafe + c_utime :: CString -> Ptr CUtimbuf -> IO CMode + +foreign import ccall "write" unsafe + c_write :: CInt -> Ptr CChar -> CSize -> IO CSsize + #ifndef mingw32_TARGET_OS -foreign import "fcntl" unsafe - fcntl_read :: CInt -> CInt -> IO CInt +foreign import ccall "fcntl" unsafe + c_fcntl_read :: CInt -> CInt -> IO CInt -foreign import "fcntl" unsafe - fcntl_write :: CInt -> CInt -> CInt -> IO CInt +foreign import ccall "fcntl" unsafe + c_fcntl_write :: CInt -> CInt -> CInt -> IO CInt -foreign import "fork" unsafe - fork :: IO CPid +foreign import ccall "fcntl" unsafe + c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt -foreign import "sigemptyset" unsafe +foreign import ccall "fork" unsafe + c_fork :: IO CPid + +foreign import ccall "sigemptyset" unsafe c_sigemptyset :: Ptr CSigset -> IO () -foreign import "sigaddset" unsafe +foreign import ccall "sigaddset" unsafe c_sigaddset :: Ptr CSigset -> CInt -> IO () -foreign import "sigprocmask" unsafe +foreign import ccall "sigprocmask" unsafe c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO () -foreign import "tcgetattr" unsafe - c_tcgetattr :: CInt -> Ptr Termios -> IO CInt +foreign import ccall "tcgetattr" unsafe + c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt + +foreign import ccall "tcsetattr" unsafe + c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt -foreign import "tcsetattr" unsafe - c_tcsetattr :: CInt -> CInt -> Ptr Termios -> IO CInt +foreign import ccall "uname" unsafe + c_uname :: Ptr CUtsname -> IO CInt -foreign import "unlink" unsafe +foreign import ccall "unlink" unsafe c_unlink :: CString -> IO CInt -foreign import "waitpid" unsafe +foreign import ccall "waitpid" unsafe c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid #endif + +foreign import "s_isreg_wrap" unsafe s_isreg :: CMode -> Bool +foreign import "s_ischr_wrap" unsafe s_ischr :: CMode -> Bool +foreign import "s_isblk_wrap" unsafe s_isblk :: CMode -> Bool +foreign import "s_isdir_wrap" unsafe s_isdir :: CMode -> Bool +foreign import "s_isfifo_wrap" unsafe s_isfifo :: CMode -> Bool + +#ifndef mingw32_TARGET_OS +foreign import "s_issock_wrap" s_issock :: CMode -> Bool +#else +s_issock :: CMode -> Bool +s_issock cmode = False +#endif diff --git a/GHC/Prim.hi-boot b/GHC/Prim.hi-boot index 8543eb8..2b7d8bb 100644 --- a/GHC/Prim.hi-boot +++ b/GHC/Prim.hi-boot @@ -223,12 +223,12 @@ __export GHCziPrim ByteArrayzh MutableArrayzh MutableByteArrayzh - sameMutableArrayzh sameMutableByteArrayzh - newArrayzh newByteArrayzh + newPinnedByteArrayzh + byteArrayContentszh indexArrayzh indexCharArrayzh diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs index bcad168..344a856 100644 --- a/GHC/TopHandler.lhs +++ b/GHC/TopHandler.lhs @@ -1,5 +1,5 @@ -- ----------------------------------------------------------------------------- --- $Id: TopHandler.lhs,v 1.2 2001/07/31 12:51:37 simonmar Exp $ +-- $Id: TopHandler.lhs,v 1.3 2001/08/17 12:50:34 simonmar Exp $ -- -- (c) The University of Glasgow, 2001 -- @@ -69,7 +69,11 @@ reportError bombOut str = do then stg_exit 1 else return () +#ifndef ILX foreign label "ErrorHdrHook" errorHdrHook :: Ptr () +#else +foreign import "ErrorHdrHook" errorHdrHook :: Ptr () +#endif foreign import ccall "writeErrString__" unsafe writeErrString :: Ptr () -> CString -> Int -> IO () diff --git a/Makefile b/Makefile index 00f0d21..26e1dd2 100644 --- a/Makefile +++ b/Makefile @@ -1,16 +1,12 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.4 2001/07/31 16:41:32 simonmar Exp $ +# $Id: Makefile,v 1.5 2001/08/17 12:50:34 simonmar Exp $ TOP=.. include $(TOP)/mk/boilerplate.mk # ----------------------------------------------------------------------------- -ifeq "$(way)" "" -SUBDIRS = cbits -else -SUBDIRS= -endif +SUBDIRS = cbits include ALL_DIRS = \ Control \ @@ -21,6 +17,7 @@ ALL_DIRS = \ Data/Array \ Database \ Debug \ + Debug/QuickCheck \ FileFormat \ Foreign \ Foreign/C \ @@ -33,6 +30,8 @@ ALL_DIRS = \ System \ System/IO \ Text \ + Text/PrettyPrint \ + Text/Regex \ Text/Show PKG=core diff --git a/System/CPUTime.hsc b/System/CPUTime.hsc index 1323d91..e868757 100644 --- a/System/CPUTime.hsc +++ b/System/CPUTime.hsc @@ -8,7 +8,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: CPUTime.hsc,v 1.3 2001/07/31 12:50:18 simonmar Exp $ +-- $Id: CPUTime.hsc,v 1.4 2001/08/17 12:50:34 simonmar Exp $ -- -- The standard CPUTime library. -- @@ -73,10 +73,10 @@ foreign import unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt u_ticks <- (#peek struct tms,tms_utime) p_tms :: IO CClock s_ticks <- (#peek struct tms,tms_stime) p_tms :: IO CClock return (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000) - `div` clockTicks) + `div` fromIntegral clockTicks) type CTms = () -foreign import unsafe times :: Ptr CTms -> CClock +foreign import unsafe times :: Ptr CTms -> IO CClock # else ioException (IOError Nothing UnsupportedOperation "getCPUTime" diff --git a/System/Cmd.hsc b/System/Cmd.hsc index 2deb48c..215e427 100644 --- a/System/Cmd.hsc +++ b/System/Cmd.hsc @@ -8,7 +8,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: Cmd.hsc,v 1.1 2001/06/28 14:15:04 simonmar Exp $ +-- $Id: Cmd.hsc,v 1.2 2001/08/17 12:50:34 simonmar Exp $ -- -- Executing a command. -- @@ -46,10 +46,10 @@ import GHC.IOBase system :: String -> IO ExitCode system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing) system cmd = - withUnsafeCString cmd $ \s -> do + withCString cmd $ \s -> do status <- throwErrnoIfMinus1 "system" (primSystem s) case status of 0 -> return ExitSuccess n -> return (ExitFailure n) -foreign import ccall "systemCmd" unsafe primSystem :: UnsafeCString -> IO Int +foreign import ccall "systemCmd" unsafe primSystem :: CString -> IO Int diff --git a/System/Environment.hs b/System/Environment.hs index d2b0d38..c0fe1f9 100644 --- a/System/Environment.hs +++ b/System/Environment.hs @@ -8,7 +8,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: Environment.hs,v 1.1 2001/06/28 14:15:04 simonmar Exp $ +-- $Id: Environment.hs,v 1.2 2001/08/17 12:50:34 simonmar Exp $ -- -- Miscellaneous information about the system environment. -- @@ -37,22 +37,28 @@ import GHC.IOBase -- line arguments (not including the program name). getArgs :: IO [String] -getArgs = do - argv <- peek prog_argv_label - argc <- peek prog_argc_label - peekArray (fromIntegral argc - 1) (advancePtr argv 1) >>= mapM peekCString - -foreign label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar)) -foreign label "prog_argc" prog_argc_label :: Ptr CInt +getArgs = + alloca $ \ p_argc -> + alloca $ \ p_argv -> do + getProgArgv p_argc p_argv + p <- peek p_argc + argv <- peek p_argv + peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString + + +foreign import "getProgArgv" getProgArgv :: Ptr Int -> Ptr (Ptr CString) -> IO () -- Computation `getProgName' returns the name of the program -- as it was invoked. getProgName :: IO String -getProgName = do - argv <- peek prog_argv_label - unpackProgName argv - +getProgName = + alloca $ \ p_argc -> + alloca $ \ p_argv -> do + getProgArgv p_argc p_argv + argv <- peek p_argv + unpackProgName argv + unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0] unpackProgName argv = do s <- peekElemOff argv 0 >>= peekCString @@ -72,7 +78,7 @@ unpackProgName argv = do getEnv :: String -> IO String getEnv name = - withUnsafeCString name $ \s -> do + withCString name $ \s -> do litstring <- c_getenv s if litstring /= nullPtr then peekCString litstring @@ -80,4 +86,4 @@ getEnv name = "no environment variable" (Just name)) foreign import ccall "getenv" unsafe - c_getenv :: UnsafeCString -> IO (Ptr CChar) + c_getenv :: CString -> IO (Ptr CChar) diff --git a/System/Time.hsc b/System/Time.hsc index a732b5a..45cb695 100644 --- a/System/Time.hsc +++ b/System/Time.hsc @@ -1,6 +1,3 @@ -{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} --- JRS 010117: we had to say NON_POSIX_SOURCE to get the resulting .hc --- to compile on sparc-solaris. Blargh. ----------------------------------------------------------------------------- -- -- Module : System.Time @@ -11,7 +8,7 @@ -- Stability : provisional -- Portability : portable -- --- $Id: Time.hsc,v 1.4 2001/07/31 13:06:09 simonmar Exp $ +-- $Id: Time.hsc,v 1.5 2001/08/17 12:50:34 simonmar Exp $ -- -- The standard Time library. -- diff --git a/Text/Regex/Posix.hsc b/Text/Regex/Posix.hsc index 2b2dc9b..5f9e5f0 100644 --- a/Text/Regex/Posix.hsc +++ b/Text/Regex/Posix.hsc @@ -8,7 +8,7 @@ -- Stability : experimental -- Portability : non-portable (only on platforms that provide POSIX regexps) -- --- $Id: Posix.hsc,v 1.1 2001/08/02 11:20:50 simonmar Exp $ +-- $Id: Posix.hsc,v 1.2 2001/08/17 12:50:35 simonmar Exp $ -- -- Interface to the POSIX regular expression library. -- ToDo: detect regex library with configure. @@ -71,7 +71,7 @@ regexec :: Regex -- pattern [String])) -- subexpression matches regexec (Regex regex_fptr) str = do - withUnsafeCString str $ \cstr -> do + withCString str $ \cstr -> do nsub <- withForeignPtr regex_fptr $ \p -> (#peek regex_t, re_nsub) p let nsub_int = fromIntegral (nsub :: CSize) allocaBytes ((1 + nsub_int) * (#const sizeof(regmatch_t))) $ \p_match -> do @@ -151,5 +151,5 @@ foreign import "regfree" unsafe c_regfree :: Ptr CRegex -> IO () foreign import "regexec" unsafe - c_regexec :: ForeignPtr CRegex -> UnsafeCString -> CSize + c_regexec :: ForeignPtr CRegex -> CString -> CSize -> Ptr CRegMatch -> CInt -> IO CInt diff --git a/cbits/Makefile b/cbits/Makefile index ba63727..6593040 100644 --- a/cbits/Makefile +++ b/cbits/Makefile @@ -1,12 +1,12 @@ -# $Id: Makefile,v 1.2 2001/07/31 11:51:09 simonmar Exp $ +# $Id: Makefile,v 1.3 2001/08/17 12:50:34 simonmar Exp $ -TOP = ../../.. +TOP = ../.. include $(TOP)/mk/boilerplate.mk PACKAGE = core IS_CBITS_LIB = YES -SRC_CC_OPTS += -Wall -DCOMPILING_STDLIB -I../include -I../../../ghc/includes -I../../../ghc/rts +SRC_CC_OPTS += -Wall -DCOMPILING_STDLIB -I../include -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) ifeq "$(ILXized)" "YES" DLLized = YES diff --git a/cbits/inputReady.c b/cbits/inputReady.c index f928dfa..79a605a 100644 --- a/cbits/inputReady.c +++ b/cbits/inputReady.c @@ -1,16 +1,13 @@ /* * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 * - * $Id: inputReady.c,v 1.2 2001/07/31 11:51:09 simonmar Exp $ + * $Id: inputReady.c,v 1.3 2001/08/17 12:50:34 simonmar Exp $ * * hReady Runtime Support */ -/* select and supporting types is not */ -#ifndef _AIX -#define NON_POSIX_SOURCE -#endif - +/* select and supporting types is not Posix */ +/* #include "PosixSource.h" */ #include "HsCore.h" /* diff --git a/cbits/system.c b/cbits/system.c index 0873885..805094f 100644 --- a/cbits/system.c +++ b/cbits/system.c @@ -1,13 +1,13 @@ /* * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998 * - * $Id: system.c,v 1.2 2001/07/31 11:51:09 simonmar Exp $ + * $Id: system.c,v 1.3 2001/08/17 12:50:34 simonmar Exp $ * * system Runtime Support */ /* The itimer stuff in this module is non-posix */ -#define NON_POSIX_SOURCE +// #include "PosixSource.h" #include "HsCore.h" @@ -20,32 +20,8 @@ systemCmd(HsAddr cmd) { /* -------------------- WINDOWS VERSION --------------------- */ #if defined(mingw32_TARGET_OS) - STARTUPINFO sInfo; - PROCESS_INFORMATION pInfo; - DWORD retCode; - - sInfo.cb = sizeof(STARTUPINFO); - sInfo.lpReserved = NULL; - sInfo.lpReserved2 = NULL; - sInfo.cbReserved2 = 0; - sInfo.lpDesktop = NULL; - sInfo.lpTitle = NULL; - sInfo.dwFlags = 0; - - if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo)) - /* The 'TRUE' says that the created process should share - handles with the current process. This is vital to ensure - that error messages sent to stderr actually appear on the screen. - Since we are going to wait for the process to terminate anyway, - there is no problem with such sharing. */ - - return -1; - WaitForSingleObject(pInfo.hProcess, INFINITE); - if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) return -1; - CloseHandle(pInfo.hProcess); - CloseHandle(pInfo.hThread); - return retCode; - + if (system(cmd) < 0) return -1; + return 0; #else /* -------------------- UNIX VERSION --------------------- */ int pid; diff --git a/core.conf.in b/core.conf.in index 04553e5..00fcca4 100644 --- a/core.conf.in +++ b/core.conf.in @@ -3,7 +3,7 @@ Package { name = "core", #ifdef INSTALLING - import_dirs = [ "$libdir/imports/core" ] + import_dirs = [ "$libdir/imports" ] #else import_dirs = [ "$libdir/libraries/core" ], #endif diff --git a/include/HsCore.h b/include/HsCore.h index 1bce351..2947a3a 100644 --- a/include/HsCore.h +++ b/include/HsCore.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: HsCore.h,v 1.1 2001/06/28 14:15:04 simonmar Exp $ + * $Id: HsCore.h,v 1.2 2001/08/17 12:50:34 simonmar Exp $ * * Definitions for package `core' which are visible in Haskell land. * @@ -31,6 +31,15 @@ #ifdef HAVE_ERRNO_H #include #endif +#ifdef HAVE_STRING_H +#include +#endif +#ifdef HAVE_DIRENT_H +#include +#endif +#ifdef HAVE_UTIME_H +#include +#endif #if defined(HAVE_GETTIMEOFDAY) # ifdef HAVE_SYS_TIME_H # include @@ -74,6 +83,15 @@ #include #endif +extern inline int s_isreg_wrap(m) { return S_ISREG(m); } +extern inline int s_isdir_wrap(m) { return S_ISDIR(m); } +extern inline int s_isfifo_wrap(m) { return S_ISFIFO(m); } +extern inline int s_isblk_wrap(m) { return S_ISBLK(m); } +extern inline int s_ischr_wrap(m) { return S_ISCHR(m); } +#ifdef S_ISSOCK +extern inline int s_issock_wrap(m) { return S_ISSOCK(m); } +#endif + #include "lockFile.h" #include "HsFFI.h" -- 1.7.10.4