Wed Aug 11 10:56:14 BST 2010 rmcilroy@microsoft.com * Checkpoint GHC on Barrelfish work Now at the stage where we can build and run a helloword Haskell application on Barrelfish. Mon Aug 9 13:43:09 BST 2010 rmcilroy@microsoft.com * missing files from previous checkpoint of barrelfish port Mon Aug 9 10:49:44 BST 2010 rmcilroy@microsoft.com * Checkpoint barrelfish compatability changes Thu Jul 29 14:55:54 BST 2010 rmcilroy@microsoft.com * Changes to get ghc building against Barrelfish diff -rN -u old-base/base.cabal new-base/base.cabal --- old-base/base.cabal 2010-08-11 16:02:20.000000000 +0100 +++ new-base/base.cabal 2010-08-11 16:02:20.000000000 +0100 @@ -204,6 +204,7 @@ cbits/inputReady.c cbits/selectUtils.c cbits/primFloat.c + cbits/BFishUtils.c include-dirs: include includes: HsBase.h install-includes: HsBase.h HsBaseConfig.h WCsubst.h consUtils.h Typeable.h diff -rN -u old-base/cbits/BFishUtils.c new-base/cbits/BFishUtils.c --- old-base/cbits/BFishUtils.c 1970-01-01 01:00:00.000000000 +0100 +++ new-base/cbits/BFishUtils.c 2010-08-11 16:02:20.000000000 +0100 @@ -0,0 +1,17 @@ +/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2006 + + Useful Barrelfish bits + ------------------------------------------------------------------------- */ + +#include "HsBase.h" + +#ifdef barrelfish_HOST_OS + +HsWord64 getUSecOfDay(void) +{ + printf("NYI getUSecOfDay\n"); + return 0; +} + +#endif diff -rN -u old-base/cbits/iconv.c new-base/cbits/iconv.c --- old-base/cbits/iconv.c 2010-08-11 16:02:20.000000000 +0100 +++ new-base/cbits/iconv.c 2010-08-11 16:02:20.000000000 +0100 @@ -1,4 +1,4 @@ -#ifndef __MINGW32__ +#if !defined(__MINGW32__) && !defined(BARRELFISH) #include #include diff -rN -u old-base/cbits/inputReady.c new-base/cbits/inputReady.c --- old-base/cbits/inputReady.c 2010-08-11 16:02:20.000000000 +0100 +++ new-base/cbits/inputReady.c 2010-08-11 16:02:20.000000000 +0100 @@ -16,6 +16,11 @@ int fdReady(int fd, int write, int msecs, int isSock) { + +#ifdef BARRELFISH + return 1; // Currently just return 1, look into this in the future +#else + if #if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) ( isSock ) { @@ -165,4 +170,5 @@ } } #endif +#endif } diff -rN -u old-base/cbits/PrelIOUtils.c new-base/cbits/PrelIOUtils.c --- old-base/cbits/PrelIOUtils.c 2010-08-11 16:02:20.000000000 +0100 +++ new-base/cbits/PrelIOUtils.c 2010-08-11 16:02:20.000000000 +0100 @@ -30,7 +30,7 @@ # include #endif -#if !defined(mingw32_HOST_OS) +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) const char* localeEncoding(void) { #if defined(HAVE_LIBCHARSET) diff -rN -u old-base/cbits/WCsubst.c new-base/cbits/WCsubst.c --- old-base/cbits/WCsubst.c 2010-08-11 16:02:20.000000000 +0100 +++ new-base/cbits/WCsubst.c 2010-08-11 16:02:20.000000000 +0100 @@ -4066,10 +4066,14 @@ int numblocks, int unichar) { +#ifdef BARRELFISH + return NULL; +#else struct _charblock_ key={unichar,1,(void *)0}; struct _charblock_ *cb=bsearch(&key,blocks,numblocks,sizeof(key),blkcmp); if(cb==(void *)0) return &nullrule; return cb->rule; +#endif } diff -rN -u old-base/config.sub new-base/config.sub --- old-base/config.sub 2010-08-11 16:02:20.000000000 +0100 +++ new-base/config.sub 2010-08-11 16:02:20.000000000 +0100 @@ -4,7 +4,7 @@ # 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, # Inc. -timestamp='2006-07-02' +timestamp='2010-08-10' # This file is (in principle) common to ALL GNU software. # The presence of a machine in this file suggests that SOME GNU software @@ -1344,6 +1344,9 @@ -zvmoe) os=-zvmoe ;; + -barrelfish) + os=-barrelfish + ;; -none) ;; *) diff -rN -u old-base/configure.ac new-base/configure.ac --- old-base/configure.ac 2010-08-11 16:02:20.000000000 +0100 +++ new-base/configure.ac 2010-08-11 16:02:20.000000000 +0100 @@ -52,45 +52,45 @@ AC_SUBST(ICONV_LIB_DIRS) # map standard C types and ISO types to Haskell types -FPTOOLS_CHECK_HTYPE(char) -FPTOOLS_CHECK_HTYPE(signed char) -FPTOOLS_CHECK_HTYPE(unsigned char) -FPTOOLS_CHECK_HTYPE(short) -FPTOOLS_CHECK_HTYPE(unsigned short) -FPTOOLS_CHECK_HTYPE(int) -FPTOOLS_CHECK_HTYPE(unsigned int) -FPTOOLS_CHECK_HTYPE(long) -FPTOOLS_CHECK_HTYPE(unsigned long) +FPTOOLS_CHECK_HTYPE(char, , Int8) +FPTOOLS_CHECK_HTYPE(signed char, , Int8) +FPTOOLS_CHECK_HTYPE(unsigned char, , Word8) +FPTOOLS_CHECK_HTYPE(short, , Int16) +FPTOOLS_CHECK_HTYPE(unsigned short, , Word16) +FPTOOLS_CHECK_HTYPE(int, , Int32) +FPTOOLS_CHECK_HTYPE(unsigned int, , Word32) +FPTOOLS_CHECK_HTYPE(long, , Int64) +FPTOOLS_CHECK_HTYPE(unsigned long, , Word64) if test "$ac_cv_type_long_long" = yes; then -FPTOOLS_CHECK_HTYPE(long long) -FPTOOLS_CHECK_HTYPE(unsigned long long) +FPTOOLS_CHECK_HTYPE(long long, , Int64) +FPTOOLS_CHECK_HTYPE(unsigned long long, , Word64) fi -FPTOOLS_CHECK_HTYPE(float) -FPTOOLS_CHECK_HTYPE(double) -FPTOOLS_CHECK_HTYPE(ptrdiff_t) -FPTOOLS_CHECK_HTYPE(size_t) -FPTOOLS_CHECK_HTYPE(wchar_t) +FPTOOLS_CHECK_HTYPE(float, , Float) +FPTOOLS_CHECK_HTYPE(double, , Double) +FPTOOLS_CHECK_HTYPE(ptrdiff_t, , Int64) +FPTOOLS_CHECK_HTYPE(size_t, , Word64) +FPTOOLS_CHECK_HTYPE(wchar_t, , Int32) # Int32 is a HACK for non-ISO C compilers -FPTOOLS_CHECK_HTYPE(sig_atomic_t, Int32) -FPTOOLS_CHECK_HTYPE(clock_t) -FPTOOLS_CHECK_HTYPE(time_t) -FPTOOLS_CHECK_HTYPE(dev_t, Word32) -FPTOOLS_CHECK_HTYPE(ino_t) -FPTOOLS_CHECK_HTYPE(mode_t) -FPTOOLS_CHECK_HTYPE(off_t) -FPTOOLS_CHECK_HTYPE(pid_t) -FPTOOLS_CHECK_HTYPE(gid_t) -FPTOOLS_CHECK_HTYPE(uid_t) -FPTOOLS_CHECK_HTYPE(cc_t) -FPTOOLS_CHECK_HTYPE(speed_t) +FPTOOLS_CHECK_HTYPE(sig_atomic_t, Int32, Int32) +FPTOOLS_CHECK_HTYPE(clock_t, , Int64) +FPTOOLS_CHECK_HTYPE(time_t, , Int64) +FPTOOLS_CHECK_HTYPE(dev_t, Word32, Int64) +FPTOOLS_CHECK_HTYPE(ino_t, , Int64) +FPTOOLS_CHECK_HTYPE(mode_t, , Int32) +FPTOOLS_CHECK_HTYPE(off_t, , Word64) +FPTOOLS_CHECK_HTYPE(pid_t, , Word32) +FPTOOLS_CHECK_HTYPE(gid_t, , Word32) +FPTOOLS_CHECK_HTYPE(uid_t, , Word32) +FPTOOLS_CHECK_HTYPE(cc_t, , Word32) +FPTOOLS_CHECK_HTYPE(speed_t, , Word32) FPTOOLS_CHECK_HTYPE(tcflag_t) -FPTOOLS_CHECK_HTYPE(nlink_t) -FPTOOLS_CHECK_HTYPE(ssize_t) +FPTOOLS_CHECK_HTYPE(nlink_t, , Word32) +FPTOOLS_CHECK_HTYPE(ssize_t, , Word32) FPTOOLS_CHECK_HTYPE(rlim_t) FPTOOLS_CHECK_HTYPE(wint_t) -FPTOOLS_CHECK_HTYPE(intptr_t) -FPTOOLS_CHECK_HTYPE(uintptr_t) +FPTOOLS_CHECK_HTYPE(intptr_t, , Int64) +FPTOOLS_CHECK_HTYPE(uintptr_t, , Word64) # Workaround for OSes that don't have intmax_t and uintmax_t, e.g. OpenBSD. if test "$ac_cv_type_long_long" = yes; then fptools_cv_default_htype_intmax=$fptools_cv_htype_long_long @@ -99,8 +99,8 @@ fptools_cv_default_htype_intmax=$fptools_cv_htype_long fptools_cv_default_htype_uintmax=$fptools_cv_htype_unsigned_long fi -FPTOOLS_CHECK_HTYPE(intmax_t, $fptools_cv_default_htype_intmax) -FPTOOLS_CHECK_HTYPE(uintmax_t, $fptools_cv_default_htype_uintmax) +FPTOOLS_CHECK_HTYPE(intmax_t, $fptools_cv_default_htype_intmax, Int64) +FPTOOLS_CHECK_HTYPE(uintmax_t, $fptools_cv_default_htype_uintmax, Word64) # test errno values FP_CHECK_CONSTS([E2BIG EACCES EADDRINUSE EADDRNOTAVAIL EADV EAFNOSUPPORT EAGAIN EALREADY EBADF EBADMSG EBADRPC EBUSY ECHILD ECOMM ECONNABORTED ECONNREFUSED ECONNRESET EDEADLK EDESTADDRREQ EDIRTY EDOM EDQUOT EEXIST EFAULT EFBIG EFTYPE EHOSTDOWN EHOSTUNREACH EIDRM EILSEQ EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR ELOOP EMFILE EMLINK EMSGSIZE EMULTIHOP ENAMETOOLONG ENETDOWN ENETRESET ENETUNREACH ENFILE ENOBUFS ENODATA ENODEV ENOENT ENOEXEC ENOLCK ENOLINK ENOMEM ENOMSG ENONET ENOPROTOOPT ENOSPC ENOSR ENOSTR ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK ENOTTY ENXIO EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM EPROCUNAVAIL EPROGMISMATCH EPROGUNAVAIL EPROTO EPROTONOSUPPORT EPROTOTYPE ERANGE EREMCHG EREMOTE EROFS ERPCMISMATCH ERREMOTE ESHUTDOWN ESOCKTNOSUPPORT ESPIPE ESRCH ESRMNT ESTALE ETIME ETIMEDOUT ETOOMANYREFS ETXTBSY EUSERS EWOULDBLOCK EXDEV ENOCIGAR], [#include @@ -121,13 +121,18 @@ # to give prototype text. FP_SEARCH_LIBS_PROTO(iconv, [ +#ifndef BARRELFISH #include #include +#endif ], - [iconv_t cd; + [#ifndef BARRELFISH + iconv_t cd; cd = iconv_open("", ""); iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd);], + iconv_close(cd); + #endif + ], iconv, [EXTRA_LIBS="$EXTRA_LIBS $ac_lib"], [case `uname -s` in diff -rN -u old-base/GHC/Conc.lhs new-base/GHC/Conc.lhs --- old-base/GHC/Conc.lhs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/GHC/Conc.lhs 2010-08-11 16:02:20.000000000 +0100 @@ -80,12 +80,15 @@ , asyncWriteBA -- :: Int -> Int -> Int -> Int -> MutableByteArray# RealWorld -> IO (Int, Int) #endif -#ifndef mingw32_HOST_OS - , Signal, HandlerFun, setHandler, runHandlers +#if !defined(mingw32_HOST_OS) + , Signal +#endif +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) + , HandlerFun, setHandler, runHandlers #endif , ensureIOManagerIsRunning -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) , syncIOManager #endif @@ -101,24 +104,24 @@ ) where import System.Posix.Types -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) import System.Posix.Internals #endif import Foreign import Foreign.C -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(barrelfish_HOST_OS) import Data.Typeable #endif -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) import Data.Dynamic #endif import Control.Monad import Data.Maybe import GHC.Base -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) import GHC.Debug #endif import {-# SOURCE #-} GHC.IO.Handle ( hFlush ) @@ -130,15 +133,15 @@ import GHC.MVar import GHC.Num ( Num(..) ) import GHC.Real ( fromIntegral ) -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) import GHC.IOArray import GHC.Arr ( inRange ) #endif -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(barrelfish_HOST_OS) import GHC.Real ( div ) import GHC.Ptr #endif -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(barrelfish_HOST_OS) import GHC.Read ( Read ) import GHC.Enum ( Enum ) #endif @@ -696,7 +699,7 @@ -- given file descriptor (GHC only). threadWaitRead :: Fd -> IO () threadWaitRead fd -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) | threaded = waitForReadEvent fd #endif | otherwise = IO $ \s -> @@ -708,7 +711,7 @@ -- given file descriptor (GHC only). threadWaitWrite :: Fd -> IO () threadWaitWrite fd -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) | threaded = waitForWriteEvent fd #endif | otherwise = IO $ \s -> @@ -780,7 +783,7 @@ -- around the scheduler loop. Furthermore, the scheduler can be simplified -- by not having to check for completed IO requests. -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) data IOReq = Read {-# UNPACK #-} !Fd {-# UNPACK #-} !(MVar ()) | Write {-# UNPACK #-} !Fd {-# UNPACK #-} !(MVar ()) @@ -790,7 +793,7 @@ = Delay {-# UNPACK #-} !USecs {-# UNPACK #-} !(MVar ()) | DelaySTM {-# UNPACK #-} !USecs {-# UNPACK #-} !(TVar Bool) -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) {-# NOINLINE pendingEvents #-} pendingEvents :: IORef [IOReq] pendingEvents = unsafePerformIO $ do @@ -1010,6 +1013,20 @@ foreign import stdcall "WaitForSingleObject" c_WaitForSingleObject :: HANDLE -> DWORD -> IO DWORD +#elif defined(barrelfish_HOST_OS) +-- ---------------------------------------------------------------------------- +-- Barrelfish IO manager thread + +ioManager :: IO () +ioManager = do + return () + +wakeupIOManager :: IO () +wakeupIOManager = do + return () + +type Signal = CInt + #else -- ---------------------------------------------------------------------------- -- Unix IO manager thread, using select() diff -rN -u old-base/GHC/IO/Encoding/CodePage.hs new-base/GHC/IO/Encoding/CodePage.hs --- old-base/GHC/IO/Encoding/CodePage.hs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/GHC/IO/Encoding/CodePage.hs 2010-08-11 16:02:20.000000000 +0100 @@ -1,6 +1,6 @@ {-# LANGUAGE BangPatterns #-} module GHC.IO.Encoding.CodePage( -#if !defined(mingw32_HOST_OS) +#if !defined(mingw32_HOST_OS) ) where #else codePageEncoding, diff -rN -u old-base/GHC/IO/Encoding/Iconv.hs new-base/GHC/IO/Encoding/Iconv.hs --- old-base/GHC/IO/Encoding/Iconv.hs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/GHC/IO/Encoding/Iconv.hs 2010-08-11 16:02:20.000000000 +0100 @@ -15,7 +15,7 @@ -- #hide module GHC.IO.Encoding.Iconv ( -#if !defined(mingw32_HOST_OS) +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) mkTextEncoding, latin1, utf8, @@ -28,7 +28,7 @@ #include "MachDeps.h" #include "HsBaseConfig.h" -#if !defined(mingw32_HOST_OS) +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) import Foreign import Foreign.C diff -rN -u old-base/GHC/IO/Encoding.hs new-base/GHC/IO/Encoding.hs --- old-base/GHC/IO/Encoding.hs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/GHC/IO/Encoding.hs 2010-08-11 16:02:20.000000000 +0100 @@ -39,7 +39,7 @@ import qualified GHC.IO.Encoding.UTF16 as UTF16 import qualified GHC.IO.Encoding.UTF32 as UTF32 -#if defined(mingw32_HOST_OS) +#if defined(mingw32_HOST_OS) || defined(barrelfish_HOST_OS) import Data.Maybe import GHC.IO.Exception #endif @@ -96,7 +96,9 @@ -- | The Unicode encoding of the current locale localeEncoding :: TextEncoding -#if !defined(mingw32_HOST_OS) +#if defined(barrelfish_HOST_OS) +localeEncoding = UTF8.utf8 +#elif !defined(mingw32_HOST_OS) localeEncoding = Iconv.localeEncoding #else localeEncoding = CodePage.localeEncoding @@ -129,7 +131,11 @@ -- @CP@; for example, @\"CP1250\"@. -- mkTextEncoding :: String -> IO TextEncoding -#if !defined(mingw32_HOST_OS) +#if defined(barrelfish_HOST_OS) +mkTextEncoding e = ioException + (IOError Nothing NoSuchThing "mkTextEncoding" + ("unknown encoding:" ++ e) Nothing Nothing) +#elif !defined(mingw32_HOST_OS) mkTextEncoding = Iconv.mkTextEncoding #else mkTextEncoding "UTF-8" = return utf8 diff -rN -u old-base/GHC/IO/FD.hs new-base/GHC/IO/FD.hs --- old-base/GHC/IO/FD.hs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/GHC/IO/FD.hs 2010-08-11 16:02:20.000000000 +0100 @@ -224,7 +224,7 @@ ioException (IOError Nothing InappropriateType "openFile" "is a directory" Nothing Nothing) -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) -- regular files need to be locked RegularFile -> do -- On Windows we use explicit exclusion via sopen() to implement @@ -289,7 +289,7 @@ c_close (fdFD fd) release :: FD -> IO () -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(barrelfish_HOST_OS) release _ = return () #else release fd = do _ <- unlockFile (fdFD fd) @@ -614,7 +614,7 @@ -- ----------------------------------------------------------------------------- -- Locking/unlocking -#ifndef mingw32_HOST_OS +#if !defined(mingw32_HOST_OS) && !defined(barrelfish_HOST_OS) foreign import ccall unsafe "lockFile" lockFile :: CInt -> CDev -> CIno -> CInt -> IO CInt diff -rN -u old-base/GHC/TopHandler.lhs new-base/GHC/TopHandler.lhs --- old-base/GHC/TopHandler.lhs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/GHC/TopHandler.lhs 2010-08-11 16:02:20.000000000 +0100 @@ -67,7 +67,10 @@ topHandler install_interrupt_handler :: IO () -> IO () -#ifdef mingw32_HOST_OS +#ifdef barrelfish_HOST_OS +install_interrupt_handler handler = do + return () +#elif defined(mingw32_HOST_OS) install_interrupt_handler handler = do _ <- GHC.ConsoleHandler.installHandler $ Catch $ \event -> @@ -188,7 +191,7 @@ exitInterrupted :: IO a exitInterrupted = -#ifdef mingw32_HOST_OS +#if defined(mingw32_HOST_OS) || defined(barrelfish_HOST_OS) safeExit 252 #else -- we must exit via the default action for SIGINT, so that the diff -rN -u old-base/include/HsBase.h new-base/include/HsBase.h --- old-base/include/HsBase.h 2010-08-11 16:02:20.000000000 +0100 +++ new-base/include/HsBase.h 2010-08-11 16:02:20.000000000 +0100 @@ -9,6 +9,7 @@ #ifndef __HSBASE_H__ #define __HSBASE_H__ + #ifdef __NHC__ # include "Nhc98BaseConfig.h" #else @@ -170,18 +171,25 @@ INLINE int __hscore_get_errno(void) { return errno; } INLINE void __hscore_set_errno(int e) { errno = e; } -#if !defined(_MSC_VER) +#ifdef barrelfish_HOST_OS +INLINE int __hscore_s_isreg(mode_t m) { return 0; } +INLINE int __hscore_s_isdir(mode_t m) { return 0; } +INLINE int __hscore_s_isfifo(mode_t m) { return 0; } +INLINE int __hscore_s_isblk(mode_t m) { return 0; } +INLINE int __hscore_s_ischr(mode_t m) { return 0; } +INLINE int __hscore_s_issock(mode_t m) { return 0; } +#elif !defined(_MSC_VER) INLINE int __hscore_s_isreg(mode_t m) { return S_ISREG(m); } INLINE int __hscore_s_isdir(mode_t m) { return S_ISDIR(m); } INLINE int __hscore_s_isfifo(mode_t m) { return S_ISFIFO(m); } INLINE int __hscore_s_isblk(mode_t m) { return S_ISBLK(m); } INLINE int __hscore_s_ischr(mode_t m) { return S_ISCHR(m); } -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) INLINE int __hscore_s_issock(mode_t m) { return S_ISSOCK(m); } #endif #endif -#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) +#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) && !defined(barrelfish_HOST_OS) INLINE int __hscore_sigemptyset( sigset_t *set ) { return sigemptyset(set); } @@ -389,7 +397,7 @@ INLINE time_t __hscore_st_mtime ( struct_stat* st ) { return st->st_mtime; } INLINE stsize_t __hscore_st_size ( struct_stat* st ) { return st->st_size; } -#if !defined(_MSC_VER) +#if !defined(_MSC_VER) INLINE mode_t __hscore_st_mode ( struct_stat* st ) { return st->st_mode; } INLINE dev_t __hscore_st_dev ( struct_stat* st ) { return st->st_dev; } INLINE ino_t __hscore_st_ino ( struct_stat* st ) { return st->st_ino; } @@ -447,7 +455,7 @@ } #endif -#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) +#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) && !defined(barrelfish_HOST_OS) INLINE HsInt __hscore_sizeof_sigset_t( void ) { @@ -532,7 +540,7 @@ #endif } -#ifndef __MINGW32__ +#if !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) INLINE size_t __hscore_sizeof_siginfo_t (void) { return sizeof(siginfo_t); @@ -585,6 +593,11 @@ INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); } +#ifdef barrelfish_HOST_OS +INLINE int __hscore_open(char *file, int how, mode_t mode) { + return open(file,how); +} +#else #ifdef __MINGW32__ INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) { if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND)) @@ -599,6 +612,7 @@ return open(file,how,mode); } #endif +#endif // These are wrapped because on some OSs (eg. Linux) they are // macros which redirect to the 64-bit-off_t versions when large file @@ -616,7 +630,7 @@ // select-related stuff -#if !defined(__MINGW32__) +#if !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) INLINE int hsFD_SETSIZE(void) { return FD_SETSIZE; } INLINE int hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); } INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); } @@ -624,14 +638,22 @@ extern void hsFD_ZERO(fd_set *fds); #endif +#if defined(barrelfish_HOST_OS) +INLINE int __hscore_select(int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timeval *timeout) { + printf("NYI __hscore_select"); + return -1; +} +#else INLINE int __hscore_select(int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timeval *timeout) { return (select(nfds,readfds,writefds,exceptfds,timeout)); } +#endif // gettimeofday()-related -#if !defined(__MINGW32__) +#if !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) INLINE HsInt sizeofTimeVal(void) { return sizeof(struct timeval); } @@ -654,8 +676,15 @@ /* ToDo: write a feature test that doesn't assume 'environ' to * be in scope at link-time. */ +#ifdef barrelfish_HOST_OS +INLINE char **__hscore_environ() { + printf("environ NYI\n"); + return NULL; +} +#else extern char** environ; INLINE char **__hscore_environ() { return environ; } +#endif /* lossless conversions between pointers and integral types */ INLINE void * __hscore_from_uintptr(uintptr_t n) { return (void *)n; } @@ -666,7 +695,7 @@ void errorBelch2(const char*s, char *t); void debugBelch2(const char*s, char *t); -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) INLINE int fcntl_read(int fd, int cmd) { return fcntl(fd, cmd); diff -rN -u old-base/System/CPUTime.hsc new-base/System/CPUTime.hsc --- old-base/System/CPUTime.hsc 2010-08-11 16:02:20.000000000 +0100 +++ new-base/System/CPUTime.hsc 2010-08-11 16:02:20.000000000 +0100 @@ -19,6 +19,7 @@ ) where import Prelude +import GHC.IO.Exception import Data.Ratio @@ -89,7 +90,7 @@ -- -- Avoid the problem by resorting to times() instead. -- -#if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS +#if defined(HAVE_GETRUSAGE) && ! irix_HOST_OS && ! solaris2_HOST_OS && ! barrelfish_HOST_OS allocaBytes (#const sizeof(struct rusage)) $ \ p_rusage -> do throwErrnoIfMinus1_ "getrusage" $ getrusage (#const RUSAGE_SELF) p_rusage @@ -106,7 +107,7 @@ type CRUsage = () foreign import ccall unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt #else -# if defined(HAVE_TIMES) +# if defined(HAVE_TIMES) && ! barrelfish_HOST_OS allocaBytes (#const sizeof(struct tms)) $ \ p_tms -> do _ <- times p_tms u_ticks <- (#peek struct tms,tms_utime) p_tms :: IO CClock @@ -120,7 +121,7 @@ ioException (IOError Nothing UnsupportedOperation "getCPUTime" "can't get CPU time" - Nothing) + Nothing Nothing) # endif #endif @@ -170,11 +171,12 @@ #ifdef __GLASGOW_HASKELL__ clockTicks :: Int -clockTicks = -#if defined(CLK_TCK) - (#const CLK_TCK) +#ifdef barrelfish_HOST_OS +clockTicks = 60 +#elif defined(CLK_TCK) +clockTicks = (#const CLK_TCK) #else - unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral) +clockTicks = unsafePerformIO (sysconf (#const _SC_CLK_TCK) >>= return . fromIntegral) foreign import ccall unsafe sysconf :: CInt -> IO CLong #endif #endif /* __GLASGOW_HASKELL__ */ diff -rN -u old-base/System/Posix/Internals.hs new-base/System/Posix/Internals.hs --- old-base/System/Posix/Internals.hs 2010-08-11 16:02:20.000000000 +0100 +++ new-base/System/Posix/Internals.hs 2010-08-11 16:02:20.000000000 +0100 @@ -147,7 +147,7 @@ #endif fdGetMode :: FD -> IO IOMode -#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) || defined(barrelfish_HOST_OS) fdGetMode _ = do -- We don't have a way of finding out which flags are set on FDs -- on Windows, so make a handle that thinks that anything goes. @@ -181,7 +181,7 @@ -- --------------------------------------------------------------------------- -- Terminal-related stuff -#if defined(HTYPE_TCFLAG_T) +#if defined(HTYPE_TCFLAG_T) setEcho :: FD -> Bool -> IO () setEcho fd on = do @@ -261,6 +261,21 @@ set_saved_termios :: CInt -> (Ptr CTermios) -> IO () #endif +#elif defined(barrelfish_HOST_OS) + +setCooked :: FD -> Bool -> IO () +setCooked fd cooked = do + return () + + +setEcho :: FD -> Bool -> IO () +setEcho fd on = do + return () + +getEcho :: FD -> IO Bool +getEcho fd = do + return True + #else -- 'raw' mode for Win32 means turn off 'line input' (=> buffering and @@ -317,7 +332,7 @@ -- Turning on non-blocking for a file descriptor setNonBlockingFD :: FD -> Bool -> IO () -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) setNonBlockingFD fd set = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" (c_fcntl_read fd const_f_getfl) @@ -339,7 +354,7 @@ -- ----------------------------------------------------------------------------- -- Set close-on-exec for a file descriptor -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) setCloseOnExec :: FD -> IO () setCloseOnExec fd = do throwErrnoIfMinus1_ "setCloseOnExec" $ @@ -420,7 +435,7 @@ foreign import ccall unsafe "HsBase.h getpid" c_getpid :: IO CPid -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) foreign import ccall unsafe "HsBase.h fcntl_read" c_fcntl_read :: CInt -> CInt -> IO CInt @@ -529,7 +544,7 @@ #endif s_issock :: CMode -> Bool -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) && !defined(barrelfish_HOST_OS) s_issock cmode = c_s_issock cmode /= 0 foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt #else