diff options
author | Cheng Shao <astrohavoc@gmail.com> | 2022-10-24 07:59:00 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-11-11 00:26:55 -0500 |
commit | 00a9359f965941b4344e605579531132c11a891b (patch) | |
tree | 6801c496647a64bc48df38db35159dd9f87059d8 | |
parent | 5fcbae0b5c3e8cf9662fc46a327314705912516b (diff) | |
download | haskell-00a9359f965941b4344e605579531132c11a891b.tar.gz |
base: avoid using unsupported posix functionality on wasm32
This base patch avoids using unsupported posix functionality on
wasm32.
-rw-r--r-- | libraries/base/Foreign/C/Types.hs | 10 | ||||
-rw-r--r-- | libraries/base/GHC/Event/Control.hs | 11 | ||||
-rw-r--r-- | libraries/base/GHC/Event/Thread.hs | 12 | ||||
-rw-r--r-- | libraries/base/GHC/TopHandler.hs | 11 | ||||
-rw-r--r-- | libraries/base/System/Posix/Internals.hs | 62 | ||||
-rw-r--r-- | libraries/base/include/HsBase.h | 2 |
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); |