base: avoid using unsupported posix functionality on wasm32

This base patch avoids using unsupported posix functionality on
wasm32.

6 files changed, 104 insertions, 4 deletions

diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs
index 84139d4839..f2c83c4203 100644
--- a/libraries/base/Foreign/C/Types.hs
+++ b/libraries/base/Foreign/C/Types.hs
@@ -21,6 +21,8 @@
 --
 -----------------------------------------------------------------------------
 
+#include <ghcplatform.h>
+
 module Foreign.C.Types
         ( -- * Representations of C types
           -- $ctypes
@@ -176,9 +178,16 @@ INTEGRAL_TYPE(CSize,"size_t",HTYPE_SIZE_T)
 -- | Haskell type representing the C @wchar_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
 INTEGRAL_TYPE(CWchar,"wchar_t",HTYPE_WCHAR_T)
+
+#if defined(HTYPE_SIG_ATOMIC_T)
 -- | Haskell type representing the C @sig_atomic_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
+-- See Note [Lack of signals on wasm32-wasi].
 INTEGRAL_TYPE(CSigAtomic,"sig_atomic_t",HTYPE_SIG_ATOMIC_T)
+#else
+newtype CSigAtomic = CSigAtomic Int32
+    deriving newtype (Read, Show, ARITHMETIC_CLASSES, INTEGRAL_CLASSES, Ix)
+#endif
 
 -- | Haskell type representing the C @clock_t@ type.
 -- /(The concrete types of "Foreign.C.Types#platform" are platform-specific.)/
@@ -259,4 +268,3 @@ representing a C type @t@:
   corresponding bitwise operation in C on @t@.
 
 -}
-
diff --git a/libraries/base/GHC/Event/Control.hs b/libraries/base/GHC/Event/Control.hs
index 9054da4f22..d80e054182 100644
--- a/libraries/base/GHC/Event/Control.hs
+++ b/libraries/base/GHC/Event/Control.hs
@@ -26,6 +26,7 @@ module GHC.Event.Control
     , setNonBlockingFD
     ) where
 
+#include <ghcplatform.h>
 #include "EventConfig.h"
 
 import GHC.Base
@@ -145,6 +146,10 @@ io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8
 io_MANAGER_WAKEUP = 0xff
 io_MANAGER_DIE    = 0xfe
 
+#if !defined(HAVE_SIGNAL_H)
+readControlMessage :: Control -> Fd -> IO ControlMessage
+readControlMessage _ _ = errorWithoutStackTrace "readControlMessage"
+#else
 foreign import ccall "__hscore_sizeof_siginfo_t"
     sizeof_siginfo_t :: CSize
 
@@ -180,6 +185,7 @@ readControlMessage ctrl fd
 #else
             4096
 #endif
+#endif
 
 sendWakeup :: Control -> IO ()
 #if defined(HAVE_EVENTFD)
@@ -229,5 +235,10 @@ foreign import ccall unsafe "sys/eventfd.h eventfd_write"
    c_eventfd_write :: CInt -> CULLong -> IO CInt
 #endif
 
+#if defined(wasm32_HOST_ARCH)
+c_setIOManagerWakeupFd :: CInt -> IO ()
+c_setIOManagerWakeupFd _ = pure ()
+#else
 foreign import ccall unsafe "setIOManagerWakeupFd"
    c_setIOManagerWakeupFd :: CInt -> IO ()
+#endif
diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs
index 4f67a97513..7e7b215f24 100644
--- a/libraries/base/GHC/Event/Thread.hs
+++ b/libraries/base/GHC/Event/Thread.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE BangPatterns, NoImplicitPrelude #-}
 
@@ -15,6 +16,9 @@ module GHC.Event.Thread
     , registerDelay
     , blockedOnBadFD -- used by RTS
     ) where
+
+#include <ghcplatform.h>
+
 -- TODO: Use new Windows I/O manager
 import Control.Exception (finally, SomeException, toException)
 import Data.Foldable (forM_, mapM_, sequence_)
@@ -421,9 +425,17 @@ ioManagerCapabilitiesChanged =
               tid <- restartPollLoop mgr i
               writeIOArray eventManagerArray i (Just (tid,mgr))
 
+#if defined(wasm32_HOST_ARCH)
+c_setIOManagerControlFd :: CUInt -> CInt -> IO ()
+c_setIOManagerControlFd _ _ = pure ()
+
+c_setTimerManagerControlFd :: CInt -> IO ()
+c_setTimerManagerControlFd _ = pure ()
+#else
 -- Used to tell the RTS how it can send messages to the I/O manager.
 foreign import ccall unsafe "setIOManagerControlFd"
    c_setIOManagerControlFd :: CUInt -> CInt -> IO ()
 
 foreign import ccall unsafe "setTimerManagerControlFd"
    c_setTimerManagerControlFd :: CInt -> IO ()
+#endif
diff --git a/libraries/base/GHC/TopHandler.hs b/libraries/base/GHC/TopHandler.hs
index 704e521e18..b2b29cf5d7 100644
--- a/libraries/base/GHC/TopHandler.hs
+++ b/libraries/base/GHC/TopHandler.hs
@@ -28,6 +28,7 @@ module GHC.TopHandler (
         flushStdHandles
     ) where
 
+#include <ghcplatform.h>
 #include "HsBaseConfig.h"
 
 import Control.Exception
@@ -103,6 +104,8 @@ install_interrupt_handler handler = do
            Close    -> handler
            _ -> return ()
   return ()
+#elif !defined(HAVE_SIGNAL_H)
+install_interrupt_handler _ = pure ()
 #else
 #include "rts/Signals.h"
 -- specialised version of System.Posix.Signals.installHandler, which
@@ -279,14 +282,22 @@ exitHelper exitKind r
   | otherwise
   = shutdownHaskellAndExit   0xff                exitKind >> unreachable
 
+-- See Note [Lack of signals on wasm32-wasi].
+#if !defined(HAVE_SIGNAL_H)
+shutdownHaskellAndSignal :: CInt -> CInt -> IO ()
+shutdownHaskellAndSignal = shutdownHaskellAndExit
+#else
 foreign import ccall "shutdownHaskellAndSignal"
   shutdownHaskellAndSignal :: CInt -> CInt -> IO ()
 #endif
+#endif
 
 exitInterrupted :: IO a
 exitInterrupted =
 #if defined(mingw32_HOST_OS)
   safeExit 252
+#elif !defined(HAVE_SIGNAL_H)
+  safeExit 1
 #else
   -- we must exit via the default action for SIGINT, so that the
   -- parent of this process can take appropriate action (see #2301)
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
index 2772a66c75..b940dbc54c 100644
--- a/libraries/base/System/Posix/Internals.hs
+++ b/libraries/base/System/Posix/Internals.hs
@@ -26,6 +26,7 @@
 
 module System.Posix.Internals where
 
+#include <ghcplatform.h>
 #include "HsBaseConfig.h"
 
 import System.Posix.Types
@@ -263,7 +264,7 @@ foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios"
 foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios"
    set_saved_termios :: CInt -> (Ptr CTermios) -> IO ()
 
-#else
+#elif defined(mingw32_HOST_OS)
 
 -- 'raw' mode for Win32 means turn off 'line input' (=> buffering and
 -- character translation for the console.) The Win32 API for doing
@@ -312,6 +313,17 @@ foreign import ccall unsafe "consUtils.h get_console_echo__"
 foreign import ccall unsafe "consUtils.h is_console__"
    is_console :: CInt -> IO CInt
 
+#else
+
+setCooked :: FD -> Bool -> IO ()
+setCooked _ _ = errorWithoutStackTrace "setCooked"
+
+setEcho :: FD -> Bool -> IO ()
+setEcho _ _ = errorWithoutStackTrace "setEcho"
+
+getEcho :: FD -> IO Bool
+getEcho _ = errorWithoutStackTrace "getEcho"
+
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -454,8 +466,13 @@ foreign import capi unsafe "unistd.h lseek"
 foreign import ccall unsafe "HsBase.h access"
    c_access :: CString -> CInt -> IO CInt
 
+#if !defined(HAVE_CHMOD)
+c_chmod :: CString -> CMode -> IO CInt
+c_chmod _ _ = ioError (ioeSetLocation unsupportedOperation "chmod")
+#else
 foreign import ccall unsafe "HsBase.h chmod"
    c_chmod :: CString -> CMode -> IO CInt
+#endif
 
 foreign import ccall unsafe "HsBase.h close"
    c_close :: CInt -> IO CInt
@@ -463,11 +480,19 @@ foreign import ccall unsafe "HsBase.h close"
 foreign import ccall unsafe "HsBase.h creat"
    c_creat :: CString -> CMode -> IO CInt
 
+#if !defined(HAVE_DUP)
+c_dup :: CInt -> IO CInt
+c_dup _ = ioError (ioeSetLocation unsupportedOperation "dup")
+
+c_dup2 :: CInt -> CInt -> IO CInt
+c_dup2 _ _ = ioError (ioeSetLocation unsupportedOperation "dup2")
+#else
 foreign import ccall unsafe "HsBase.h dup"
    c_dup :: CInt -> IO CInt
 
 foreign import ccall unsafe "HsBase.h dup2"
    c_dup2 :: CInt -> CInt -> IO CInt
+#endif
 
 foreign import ccall unsafe "HsBase.h isatty"
    c_isatty :: CInt -> IO CInt
@@ -518,9 +543,14 @@ foreign import capi unsafe "HsBase.h write"
 foreign import capi safe "HsBase.h write"
    c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize
 
+#if !defined(HAVE_PIPE)
+c_pipe :: Ptr CInt -> IO CInt
+c_pipe _ = ioError (ioeSetLocation unsupportedOperation "pipe")
+#else
 foreign import ccall unsafe "HsBase.h pipe"
    c_pipe :: Ptr CInt -> IO CInt
 #endif
+#endif
 
 foreign import ccall unsafe "HsBase.h unlink"
    c_unlink :: CString -> IO CInt
@@ -528,8 +558,13 @@ foreign import ccall unsafe "HsBase.h unlink"
 foreign import capi unsafe "HsBase.h utime"
    c_utime :: CString -> Ptr CUtimbuf -> IO CInt
 
+#if !defined(HAVE_GETPID)
+c_getpid :: IO CPid
+c_getpid = pure 1
+#else
 foreign import ccall unsafe "HsBase.h getpid"
    c_getpid :: IO CPid
+#endif
 
 foreign import ccall unsafe "HsBase.h __hscore_stat"
    c_stat :: CFilePath -> Ptr CStat -> IO CInt
@@ -547,16 +582,27 @@ foreign import capi unsafe "HsBase.h fcntl"
 foreign import capi unsafe "HsBase.h fcntl"
    c_fcntl_lock  :: CInt -> CInt -> Ptr CFLock -> IO CInt
 
+#if !defined(HAVE_FORK)
+c_fork :: IO CPid
+c_fork = ioError (ioeSetLocation unsupportedOperation "fork")
+#else
 foreign import ccall unsafe "HsBase.h fork"
    c_fork :: IO CPid
+#endif
 
 foreign import ccall unsafe "HsBase.h link"
    c_link :: CString -> CString -> IO CInt
 
+#if !defined(HAVE_MKFIFO)
+c_mkfifo :: CString -> CMode -> IO CInt
+c_mkfifo _ _ = ioError (ioeSetLocation unsupportedOperation "mkfifo")
+#else
 -- capi is required at least on Android
 foreign import capi unsafe "HsBase.h mkfifo"
    c_mkfifo :: CString -> CMode -> IO CInt
+#endif
 
+#if HAVE_SIGNAL_H
 foreign import capi unsafe "signal.h sigemptyset"
    c_sigemptyset :: Ptr CSigset -> IO CInt
 
@@ -565,6 +611,17 @@ foreign import capi unsafe "signal.h sigaddset"
 
 foreign import capi unsafe "signal.h sigprocmask"
    c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
+#endif
+
+#if !defined(HAVE_TERMIOS_H)
+
+c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt
+c_tcgetattr _ _ = ioError (ioeSetLocation unsupportedOperation "tcgetattr")
+
+c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
+c_tcsetattr _ _ _ = ioError (ioeSetLocation unsupportedOperation "tcsetattr")
+
+#else
 
 -- capi is required at least on Android
 foreign import capi unsafe "HsBase.h tcgetattr"
@@ -574,6 +631,8 @@ foreign import capi unsafe "HsBase.h tcgetattr"
 foreign import capi unsafe "HsBase.h tcsetattr"
    c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt
 
+#endif
+
 foreign import ccall unsafe "HsBase.h waitpid"
    c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid
 #endif
@@ -665,4 +724,3 @@ with the types in Microsoft's documentation which means that c_read,
 c_safe_read, c_write and c_safe_write have different Haskell types depending on
 the OS.
 -}
-
diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h
index d55ec0747a..12edce964d 100644
--- a/libraries/base/include/HsBase.h
+++ b/libraries/base/include/HsBase.h
@@ -465,7 +465,7 @@ INLINE int __hscore_sig_setmask( void )
 #endif
 }
 
-#if !defined(_WIN32)
+#if !defined(_WIN32) && defined(HAVE_SIGNAL_H)
 INLINE size_t __hscore_sizeof_siginfo_t (void)
 {
     return sizeof(siginfo_t);