Track updates to ghc/lib/std and hslibs.
-- 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
--
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
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
-- 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
--
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
-- 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
--
-- 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
-- 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]
-{-# 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
-- ---------------------------------------------------------------------------
-- 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
-- ---------------------------------------------------------------------------
-- stat()-related stuff
-type CStat = ()
-
fdFileSize :: Int -> IO Integer
fdFileSize fd =
allocaBytes (#const sizeof(struct stat)) $ \ 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 ()
#ifndef mingw32_TARGET_OS
-type Termios = ()
-
setEcho :: Int -> Bool -> IO ()
setEcho fd on = do
allocaBytes (#const sizeof(struct termios)) $ \p_tios -> do
-- 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
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
-- -----------------------------------------------------------------------------
-- 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
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
ByteArrayzh
MutableArrayzh
MutableByteArrayzh
-
sameMutableArrayzh
sameMutableByteArrayzh
-
newArrayzh
newByteArrayzh
+ newPinnedByteArrayzh
+ byteArrayContentszh
indexArrayzh
indexCharArrayzh
-- -----------------------------------------------------------------------------
--- $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
--
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 ()
# -----------------------------------------------------------------------------
-# $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 \
Data/Array \
Database \
Debug \
+ Debug/QuickCheck \
FileFormat \
Foreign \
Foreign/C \
System \
System/IO \
Text \
+ Text/PrettyPrint \
+ Text/Regex \
Text/Show
PKG=core
-- 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.
--
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"
-- 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.
--
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
-- 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.
--
-- 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
getEnv :: String -> IO String
getEnv name =
- withUnsafeCString name $ \s -> do
+ withCString name $ \s -> do
litstring <- c_getenv s
if litstring /= nullPtr
then peekCString litstring
"no environment variable" (Just name))
foreign import ccall "getenv" unsafe
- c_getenv :: UnsafeCString -> IO (Ptr CChar)
+ c_getenv :: CString -> IO (Ptr CChar)
-{-# 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
-- 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.
--
-- 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.
[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
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
-# $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
/*
* (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"
/*
/*
* (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"
{
/* -------------------- 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;
Package {
name = "core",
#ifdef INSTALLING
- import_dirs = [ "$libdir/imports/core" ]
+ import_dirs = [ "$libdir/imports" ]
#else
import_dirs = [ "$libdir/libraries/core" ],
#endif
/* -----------------------------------------------------------------------------
- * $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.
*
#ifdef HAVE_ERRNO_H
#include <errno.h>
#endif
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+#ifdef HAVE_DIRENT_H
+#include <dirent.h>
+#endif
+#ifdef HAVE_UTIME_H
+#include <utime.h>
+#endif
#if defined(HAVE_GETTIMEOFDAY)
# ifdef HAVE_SYS_TIME_H
# include <sys/time.h>
#include <vfork.h>
#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"
projects / haskell-directory.git / commitdiff