[Git][ghc/ghc][wip/kill-ioport] Kill IOPort#
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Feb 16 16:04:08 UTC 2024
Ben Gamari pushed to branch wip/kill-ioport at Glasgow Haskell Compiler / GHC
Commits:
91449367 by Ben Gamari at 2024-02-16T11:03:29-05:00
Kill IOPort#
This type is unnecessary, having been superceded by `MVar` and a rework
of WinIO's blocking logic.
See #20947.
See https://github.com/haskell/core-libraries-committee/issues/213.
- - - - -
23 changed files:
- compiler/GHC/Builtin/Types/Prim.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Prim.hs
- libraries/base/base.cabal
- libraries/base/changelog.md
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Event/Windows.hsc
- libraries/ghc-internal/src/GHC/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Exts.hs
- libraries/ghc-internal/src/GHC/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/IO/Windows/Handle.hsc
- libraries/ghc-internal/src/GHC/IOPort.hs
- libraries/ghc-prim/GHC/Prim/PtrEq.hs
- libraries/ghc-prim/changelog.md
- rts/Prelude.h
- rts/PrimOps.cmm
- rts/RtsSymbols.c
- rts/include/stg/MiscClosures.h
- rts/win32/AsyncWinIO.c
- testsuite/tests/primops/should_run/UnliftedIOPort.hs
- testsuite/tests/primops/should_run/all.T
- utils/genprimopcode/Main.hs
Changes:
=====================================
compiler/GHC/Builtin/Types/Prim.hs
=====================================
@@ -76,7 +76,6 @@ module GHC.Builtin.Types.Prim(
mutVarPrimTyCon, mkMutVarPrimTy,
mVarPrimTyCon, mkMVarPrimTy,
- ioPortPrimTyCon, mkIOPortPrimTy,
tVarPrimTyCon, mkTVarPrimTy,
stablePtrPrimTyCon, mkStablePtrPrimTy,
stableNamePrimTyCon, mkStableNamePrimTy,
@@ -277,7 +276,6 @@ exposedPrimTyCons
, mutableByteArrayPrimTyCon
, smallMutableArrayPrimTyCon
, mVarPrimTyCon
- , ioPortPrimTyCon
, tVarPrimTyCon
, mutVarPrimTyCon
, realWorldTyCon
@@ -309,7 +307,7 @@ charPrimTyConName, intPrimTyConName, int8PrimTyConName, int16PrimTyConName, int3
arrayPrimTyConName, smallArrayPrimTyConName, byteArrayPrimTyConName,
mutableArrayPrimTyConName, mutableByteArrayPrimTyConName,
smallMutableArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName,
- ioPortPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName,
+ tVarPrimTyConName, stablePtrPrimTyConName,
stableNamePrimTyConName, compactPrimTyConName, bcoPrimTyConName,
weakPrimTyConName, threadIdPrimTyConName,
eqPrimTyConName, eqReprPrimTyConName, eqPhantPrimTyConName,
@@ -341,7 +339,6 @@ mutableArrayPrimTyConName = mkPrimTc (fsLit "MutableArray#") mutableArrayPri
mutableByteArrayPrimTyConName = mkPrimTc (fsLit "MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
smallMutableArrayPrimTyConName= mkPrimTc (fsLit "SmallMutableArray#") smallMutableArrayPrimTyConKey smallMutableArrayPrimTyCon
mutVarPrimTyConName = mkPrimTc (fsLit "MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
-ioPortPrimTyConName = mkPrimTc (fsLit "IOPort#") ioPortPrimTyConKey ioPortPrimTyCon
mVarPrimTyConName = mkPrimTc (fsLit "MVar#") mVarPrimTyConKey mVarPrimTyCon
tVarPrimTyConName = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon
stablePtrPrimTyConName = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
@@ -1277,20 +1274,6 @@ mutVarPrimTyCon = pcPrimTyCon_LevPolyLastArg mutVarPrimTyConName [Nominal, Repre
mkMutVarPrimTy :: Type -> Type -> Type
mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [getLevity elt, s, elt]
-{-
-************************************************************************
-* *
-\subsection[TysPrim-io-port-var]{The synchronizing I/O Port type}
-* *
-************************************************************************
--}
-
-ioPortPrimTyCon :: TyCon
-ioPortPrimTyCon = pcPrimTyCon_LevPolyLastArg ioPortPrimTyConName [Nominal, Representational] unliftedRepTy
-
-mkIOPortPrimTy :: Type -> Type -> Type
-mkIOPortPrimTy s elt = TyConApp ioPortPrimTyCon [getLevity elt, s, elt]
-
{-
************************************************************************
* *
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -3107,43 +3107,6 @@ primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
effect = ReadWriteEffect
-------------------------------------------------------------------------
-section "Synchronized I/O Ports"
- {Operations on 'IOPort#'s. }
-------------------------------------------------------------------------
-
-primtype IOPort# s a
- { A shared I/O port is almost the same as an 'MVar#'.
- The main difference is that IOPort has no deadlock detection or
- deadlock breaking code that forcibly releases the lock. }
-
-primop NewIOPortOp "newIOPort#" GenPrimOp
- State# s -> (# State# s, IOPort# s a_levpoly #)
- {Create new 'IOPort#'; initially empty.}
- with
- out_of_line = True
- effect = ReadWriteEffect
-
-primop ReadIOPortOp "readIOPort#" GenPrimOp
- IOPort# s a_levpoly -> State# s -> (# State# s, a_levpoly #)
- {If 'IOPort#' is empty, block until it becomes full.
- Then remove and return its contents, and set it empty.
- Throws an 'IOPortException' if another thread is already
- waiting to read this 'IOPort#'.}
- with
- out_of_line = True
- effect = ReadWriteEffect
-
-primop WriteIOPortOp "writeIOPort#" GenPrimOp
- IOPort# s a_levpoly -> a_levpoly -> State# s -> (# State# s, Int# #)
- {If 'IOPort#' is full, immediately return with integer 0,
- throwing an 'IOPortException'.
- Otherwise, store value arg as 'IOPort#''s new contents,
- and return with integer 1. }
- with
- out_of_line = True
- effect = ReadWriteEffect
-
------------------------------------------------------------------------
section "Delay/wait operations"
------------------------------------------------------------------------
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1695,9 +1695,6 @@ emitPrimOp cfg primop =
ReadMVarOp -> alwaysExternal
TryReadMVarOp -> alwaysExternal
IsEmptyMVarOp -> alwaysExternal
- NewIOPortOp -> alwaysExternal
- ReadIOPortOp -> alwaysExternal
- WriteIOPortOp -> alwaysExternal
DelayOp -> alwaysExternal
WaitReadOp -> alwaysExternal
WaitWriteOp -> alwaysExternal
=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -1148,10 +1148,6 @@ genPrim prof bound ty op = case op of
PromptOp -> unhandledPrimop op
Control0Op -> unhandledPrimop op
- NewIOPortOp -> unhandledPrimop op
- ReadIOPortOp -> unhandledPrimop op
- WriteIOPortOp -> unhandledPrimop op
-
GetSparkOp -> unhandledPrimop op
AnyToAddrOp -> unhandledPrimop op
MkApUpd0_Op -> unhandledPrimop op
=====================================
libraries/base/base.cabal
=====================================
@@ -255,8 +255,6 @@ Library
, Type.Reflection
, Type.Reflection.Unsafe
, Unsafe.Coerce
- -- TODO: remove
- , GHC.IOPort
reexported-modules:
GHC.Num.Integer
=====================================
libraries/base/changelog.md
=====================================
@@ -1,8 +1,10 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.20.0.0 *TBA*
+
* Export `foldl'` from `Prelude` ([CLC proposal #167](https://github.com/haskell/core-libraries-committee/issues/167))
* Add `permutations` and `permutations1` to `Data.List.NonEmpty` ([CLC proposal #68](https://github.com/haskell/core-libraries-committee/issues/68))
+ * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
* Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #175](https://github.com/haskell/core-libraries-committee/issues/175))
* Implement `stimes` for `instance Semigroup (Endo a)` explicitly ([CLC proposal #4](https://github.com/haskell/core-libraries-committee/issues/4))
* Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205))
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -244,14 +244,6 @@ data GenClosure b
, value :: !b -- ^ Pointer to closure
}
- -- | An @IOPort#@, with a queue of thread state objects blocking on them
- | IOPortClosure
- { info :: !StgInfoTable
- , queueHead :: !b -- ^ Pointer to head of queue
- , queueTail :: !b -- ^ Pointer to tail of queue
- , value :: !b -- ^ Pointer to closure
- }
-
-- | A @MutVar#@
| MutVarClosure
{ info :: !StgInfoTable
@@ -528,7 +520,6 @@ allClosures (MutArrClosure {..}) = mccPayload
allClosures (SmallMutArrClosure {..}) = mccPayload
allClosures (MutVarClosure {..}) = [var]
allClosures (MVarClosure {..}) = [queueHead,queueTail,value]
-allClosures (IOPortClosure {..}) = [queueHead,queueTail,value]
allClosures (FunClosure {..}) = ptrArgs
allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]
allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ Data.Foldable.toList weakLink
=====================================
libraries/ghc-internal/src/GHC/Event/Windows.hsc
=====================================
@@ -110,7 +110,6 @@ import GHC.Base
import GHC.Conc.Bound
import GHC.Conc.Sync
import GHC.IO
-import GHC.IOPort
import GHC.Num
import GHC.Real
import GHC.Enum (maxBound)
@@ -164,7 +163,7 @@ import {-# SOURCE #-} Debug.Trace (traceEventIO)
-- fact that something else has finished the remainder of their queue or must
-- have a guarantee to never block. In this implementation we strive to
-- never block. This is achieved by not having the worker threads call out
--- to any user code, and to have the IOPort synchronization primitive never
+-- to any user code, and to have the MVar synchronization primitive never
-- block. This means if the port is full the message is lost, however we
-- have an invariant that the port can never be full and have a waiting
-- receiver. As such, dropping the message does not change anything as there
@@ -535,11 +534,11 @@ withOverlappedEx :: forall a.
-> CompletionCallback (IOResult a)
-> IO (IOResult a)
withOverlappedEx mgr fname h async offset startCB completionCB = do
- signal <- newEmptyIOPort :: IO (IOPort (IOResult a))
+ signal <- newEmptyMVar :: IO (MVar (IOResult a))
let signalReturn a = failIfFalse_ (dbgMsg "signalReturn") $
- writeIOPort signal (IOSuccess a)
+ writeMVar signal (IOSuccess a)
signalThrow ex = failIfFalse_ (dbgMsg "signalThrow") $
- writeIOPort signal (IOFailed ex)
+ writeMVar signal (IOFailed ex)
mask_ $ do
let completionCB' e b = do
result <- completionCB e b
@@ -683,7 +682,7 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do
registerAlertableWait delay
return $ IOFailed Nothing
let runner = do debugIO $ (dbgMsg ":: waiting ") ++ " | " ++ show lpol
- res <- readIOPort signal `catch` cancel
+ res <- readMVar signal `catch` cancel
debugIO $ dbgMsg ":: signaled "
case res of
IOFailed err -> FFI.throwWinErr fname (maybe 0 fromIntegral err)
@@ -716,7 +715,7 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do
let err' = fromIntegral err
debugIO $ dbgMsg $ ":: done callback: " ++ show err' ++ " - " ++ show numBytes
completionCB err' (fromIntegral numBytes)
- else readIOPort signal
+ else readMVar signal
CbError err -> do
reqs3 <- removeRequest
debugIO $ "-1.. " ++ show reqs3 ++ " requests queued."
@@ -736,10 +735,10 @@ withOverlappedEx mgr fname h async offset startCB completionCB = do
-- Uses an inline definition of threadDelay to prevent an import
-- cycle.
let usecs = 250 -- 0.25ms
- m <- newEmptyIOPort
+ m <- newEmptyMVar
reg <- registerTimeout mgr usecs $
- writeIOPort m () >> return ()
- readIOPort m `onException` unregisterTimeout mgr reg
+ writeMVar m () >> return ()
+ readMVar m `onException` unregisterTimeout mgr reg
| otherwise = sleepBlock 1 -- 1 ms
waitForCompletion :: HANDLE -> Ptr FFI.OVERLAPPED -> IO (CbResult Int)
waitForCompletion fhndl lpol = do
=====================================
libraries/ghc-internal/src/GHC/Event/Windows/Thread.hs
=====================================
@@ -11,7 +11,6 @@ import GHC.Conc.Sync
import GHC.Base
import GHC.Event.Windows
import GHC.IO
-import GHC.IOPort
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning = wakeupIOManager
@@ -23,10 +22,10 @@ interruptIOManager = interruptSystemManager
-- 2147483647 μs, less than 36 minutes.
threadDelay :: Int -> IO ()
threadDelay usecs = mask_ $ do
- m <- newEmptyIOPort
+ m <- newEmptyMVar
mgr <- getSystemManager
- reg <- registerTimeout mgr usecs $ writeIOPort m () >> return ()
- readIOPort m `onException` unregisterTimeout mgr reg
+ reg <- registerTimeout mgr usecs $ writeMVar m () >> return ()
+ readMVar m `onException` unregisterTimeout mgr reg
-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
-- 2147483647 μs, less than 36 minutes.
=====================================
libraries/ghc-internal/src/GHC/Exts.hs
=====================================
@@ -59,7 +59,6 @@ module GHC.Exts
sameMVar#,
sameMutVar#,
sameTVar#,
- sameIOPort#,
samePromptTag#,
-- ** Compat wrapper
=====================================
libraries/ghc-internal/src/GHC/IO/Buffer.hs
=====================================
@@ -223,10 +223,10 @@ data BufferState = ReadBuffer | WriteBuffer
deriving Eq -- ^ @since 4.2.0.0
withBuffer :: Buffer e -> (Ptr e -> IO a) -> IO a
-withBuffer Buffer{ bufRaw=raw } f = withForeignPtr (castForeignPtr raw) f
+withBuffer Buffer{ bufRaw=raw } f = unsafeWithForeignPtr (castForeignPtr raw) f
withRawBuffer :: RawBuffer e -> (Ptr e -> IO a) -> IO a
-withRawBuffer raw f = withForeignPtr (castForeignPtr raw) f
+withRawBuffer raw f = unsafeWithForeignPtr (castForeignPtr raw) f
isEmptyBuffer :: Buffer e -> Bool
isEmptyBuffer Buffer{ bufL=l, bufR=r } = l == r
=====================================
libraries/ghc-internal/src/GHC/IO/Windows/Handle.hsc
=====================================
@@ -931,8 +931,7 @@ openFile' filepath iomode non_blocking tmp_opts =
-- handle. For WinIO we always use FILE_FLAG_OVERLAPPED, which
-- means we always issue asynchronous file operation using an
-- OVERLAPPED structure. All blocking, if required must be done
- -- on the Haskell side by using existing mechanisms such as MVar
- -- or IOPorts.
+ -- on the Haskell side by using existing mechanisms such as MVars.
then #{const FILE_FLAG_OVERLAPPED}
-- I believe most haskell programs do sequential scans, so
-- optimize for the common case. Though ideally, this would
=====================================
libraries/ghc-internal/src/GHC/IOPort.hs
=====================================
@@ -1,128 +0,0 @@
-{-# LANGUAGE Unsafe #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
-{-# OPTIONS_GHC -funbox-strict-fields #-}
-{-# OPTIONS_HADDOCK hide #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.IOPort
--- Copyright : (c) Tamar Christina 2019
--- License : see libraries/base/LICENSE
---
--- Maintainer : ghc-devs at haskell.org
--- Stability : internal
--- Portability : non-portable (GHC Extensions)
---
--- The 'IOPort' type. This is a facility used by the Windows IO subsystem.
---
--- /The API of this module is unstable and not meant to be consumed by the general public./
--- If you absolutely must depend on it, make sure to use a tight upper
--- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
--- change rapidly without much warning.
---
--- We have strict rules with an I/O Port:
--- * writing more than once is an error
--- * reading more than once is an error
---
--- It gives us the ability to have one thread to block, wait for a result from
--- another thread and then being woken up. *Nothing* more.
---
--- This type is very much GHC internal. It might be changed or removed without
--- notice in future releases.
---
------------------------------------------------------------------------------
-
-module GHC.IOPort (
- -- * IOPorts
- IOPort(..)
- , newIOPort
- , newEmptyIOPort
- , readIOPort
- , writeIOPort
- , doubleReadException
- ) where
-
-import GHC.Base
-import GHC.Exception
-import Text.Show
-
-data IOPortException = IOPortException deriving Show
-
-instance Exception IOPortException where
- displayException IOPortException = "IOPortException"
-
-
-doubleReadException :: SomeException
-doubleReadException = toException IOPortException
-
-data IOPort a = IOPort (IOPort# RealWorld a)
-{- ^
-An 'IOPort' is a synchronising variable, used
-for communication between concurrent threads, where one of the threads is
-controlled by an external state. e.g. by an I/O action that is serviced by the
-runtime. It can be thought of as a box, which may be empty or full.
-
-It is mostly similar to the behavior of 'Control.Concurrent.MVar.MVar'
-except 'writeIOPort' doesn't block if the variable is full and the GC
-won't forcibly release the lock if it thinks
-there's a deadlock.
-
-The properties of IOPorts are:
-* Writing to an empty IOPort will not block.
-* Writing to an full IOPort will not block. It might throw an exception.
-* Reading from an IOPort for the second time might throw an exception.
-* Reading from a full IOPort will not block, return the value and empty the port.
-* Reading from an empty IOPort will block until a write.
-* Reusing an IOPort (that is, reading or writing twice) is not supported
- and might throw an exception. Even if reads and writes are
- interleaved.
-
-This type is very much GHC internal. It might be changed or removed without
-notice in future releases.
-
--}
-
--- | @since 4.1.0.0
-instance Eq (IOPort a) where
- (IOPort ioport1#) == (IOPort ioport2#) =
- isTrue# (sameIOPort# ioport1# ioport2#)
-
-
-
--- |Create an 'IOPort' which is initially empty.
-newEmptyIOPort :: IO (IOPort a)
-newEmptyIOPort = IO $ \ s# ->
- case newIOPort# s# of
- (# s2#, svar# #) -> (# s2#, IOPort svar# #)
-
--- |Create an 'IOPort' which contains the supplied value.
-newIOPort :: a -> IO (IOPort a)
-newIOPort value =
- newEmptyIOPort >>= \ ioport ->
- writeIOPort ioport value >>
- return ioport
-
--- |Atomically read the contents of the 'IOPort'. If the 'IOPort' is
--- currently empty, 'readIOPort' will wait until it is full. After a
--- 'readIOPort', the 'IOPort' is left empty.
---
--- There is one important property of 'readIOPort':
---
--- * Only a single threads can be blocked on an 'IOPort'.
---
-readIOPort :: IOPort a -> IO a
-readIOPort (IOPort ioport#) = IO $ \ s# -> readIOPort# ioport# s#
-
--- |Put a value into an 'IOPort'. If the 'IOPort' is currently full,
--- 'writeIOPort' will throw an exception.
---
--- There is one important property of 'writeIOPort':
---
--- * Only a single thread can be blocked on an 'IOPort'.
---
-writeIOPort :: IOPort a -> a -> IO Bool
-writeIOPort (IOPort ioport#) x = IO $ \ s# ->
- case writeIOPort# ioport# x s# of
- (# s, 0# #) -> (# s, False #)
- (# s, _ #) -> (# s, True #)
-
=====================================
libraries/ghc-prim/GHC/Prim/PtrEq.hs
=====================================
@@ -34,7 +34,6 @@ module GHC.Prim.PtrEq
sameMutVar#,
sameTVar#,
sameMVar#,
- sameIOPort#,
samePromptTag#,
eqStableName#
) where
@@ -129,10 +128,6 @@ sameTVar# = unsafePtrEquality#
sameMVar# :: forall {l} s (a :: TYPE (BoxedRep l)). MVar# s a -> MVar# s a -> Int#
sameMVar# = unsafePtrEquality#
--- | Compare the underlying pointers of two 'IOPort#'s.
-sameIOPort# :: forall {l} s (a :: TYPE (BoxedRep l)). IOPort# s a -> IOPort# s a -> Int#
-sameIOPort# = unsafePtrEquality#
-
-- | Compare the underlying pointers of two 'PromptTag#'s.
samePromptTag# :: forall a. PromptTag# a -> PromptTag# a -> Int#
samePromptTag# = unsafePtrEquality#
=====================================
libraries/ghc-prim/changelog.md
=====================================
@@ -2,6 +2,8 @@
- Shipped with GHC 9.10.1
+- `IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
+
- Add unaligned addr access primops. These primops will be emulated on platforms that don't support unaligned access.
readWord8OffAddrAsChar# :: Addr# -> Int# -> State# s -> (# State# s, Char# #)
@@ -183,7 +185,7 @@
- `Array#`, `SmallArray#`, `Weak#`, `StablePtr#`, `StableName#`,
- `MutableArray#`, `SmallMutableArray#`, `MutVar#`,
- `TVar#`, `MVar#`, `IOPort#`.
+ `TVar#`, `MVar#`
For example, `Array#` used to have kind:
@@ -240,8 +242,6 @@
- `STM` operations `atomically#`, `retry#`, `catchRetry#` and `catchSTM#`.
- - `newIOPort#`, `readIOPort#`, `writeIOPort#`,
-
- `mkWeak#`, `mkWeakNoFinalizer#`, `addCFinalizerToWeak#`, `deRefWeak#`, `finalizeWeak#`,
- `makeStablePtr#`, `deRefStablePtr#`, `eqStablePtr#`, `makeStableName#`, `stableNameToInt#`,
@@ -340,7 +340,6 @@
- `sameMutableArray#`, `sameSmallMutableArray#`, `sameMutableByteArray#`
and `sameMutableArrayArray#`,
- `sameMutVar#`, `sameTVar#` and`sameMVar#`,
- - `sameIOPort#`,
- `eqStableName#`.
- The following functions have been added to `GHC.Exts`:
=====================================
rts/Prelude.h
=====================================
@@ -48,7 +48,6 @@ PRELUDE_CLOSURE(ghczminternal_GHCziIOziException_blockedIndefinitelyOnSTM_closur
PRELUDE_CLOSURE(ghczminternal_GHCziIOziException_cannotCompactFunction_closure);
PRELUDE_CLOSURE(ghczminternal_GHCziIOziException_cannotCompactPinned_closure);
PRELUDE_CLOSURE(ghczminternal_GHCziIOziException_cannotCompactMutable_closure);
-PRELUDE_CLOSURE(ghczminternal_GHCziIOPort_doubleReadException_closure);
PRELUDE_CLOSURE(ghczminternal_ControlziExceptionziBase_nonTermination_closure);
PRELUDE_CLOSURE(ghczminternal_ControlziExceptionziBase_nestedAtomically_closure);
PRELUDE_CLOSURE(ghczminternal_GHCziEventziThread_blockedOnBadFD_closure);
@@ -116,7 +115,6 @@ PRELUDE_INFO(ghczminternal_GHCziStable_StablePtr_con_info);
#define cannotCompactMutable_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziIOziException_cannotCompactMutable_closure)
#define nonTermination_closure DLL_IMPORT_DATA_REF(ghczminternal_ControlziExceptionziBase_nonTermination_closure)
#define nestedAtomically_closure DLL_IMPORT_DATA_REF(ghczminternal_ControlziExceptionziBase_nestedAtomically_closure)
-#define doubleReadException DLL_IMPORT_DATA_REF(ghczminternal_GHCziIOPort_doubleReadException_closure)
#define absentSumFieldError_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziPrimziPanic_absentSumFieldError_closure)
#define underflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziExceptionziType_underflowException_closure)
#define overflowException_closure DLL_IMPORT_DATA_REF(ghczminternal_GHCziExceptionziType_overflowException_closure)
=====================================
rts/PrimOps.cmm
=====================================
@@ -32,7 +32,6 @@ import pthread_mutex_unlock;
import CLOSURE ghczminternal_ControlziExceptionziBase_nestedAtomically_closure;
import CLOSURE ghczminternal_GHCziIOziException_heapOverflow_closure;
import CLOSURE ghczminternal_GHCziIOziException_blockedIndefinitelyOnMVar_closure;
-import CLOSURE ghczminternal_GHCziIOPort_doubleReadException_closure;
import AcquireSRWLockExclusive;
import ReleaseSRWLockExclusive;
import CLOSURE ghczmprim_GHCziTypes_False_closure;
@@ -2125,238 +2124,6 @@ stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ )
return (1, val);
}
-/* -----------------------------------------------------------------------------
- * IOPort primitives
- *
- * readIOPort & writeIOPort work as follows. Firstly, an important invariant:
- *
- * Only one read and one write is allowed for an IOPort.
- * Reading or writing to the same port twice will throw an exception.
- *
- * readIOPort:
- * IOPort empty : then add ourselves to the blocking queue
- * IOPort full : remove the value from the IOPort, and
- * blocking queue empty : return
- * blocking queue non-empty : perform the only blocked
- * writeIOPort from the queue, and
- * wake up the thread
- * (IOPort is now empty)
- *
- * writeIOPort is just the dual of the above algorithm.
- *
- * How do we "perform a writeIOPort"? Well, By storing the value and prt on the
- * stack, same way we do with MVars. Semantically the operations mutate the
- * stack the same way so we will re-use the logic and datastructures for MVars
- * for IOPort. See stg_block_putmvar and stg_block_takemvar in HeapStackCheck.c
- * for the stack layout, and the PerformPut and PerformTake macros below. We
- * also re-use the closure types MVAR_CLEAN/_DIRTY for IOPort.
- *
- * The remaining caveats of MVar thus also apply for an IOPort. The main
- * crucial difference between an MVar and IOPort is that the scheduler will not
- * be allowed to interrupt a blocked IOPort just because it thinks there's a
- * deadlock. This is especially crucial for the non-threaded runtime.
- *
- * To avoid double reads/writes we set only the head to a MVarTSOQueue when
- * a reader queues up on a port.
- * We set the tail to the port itself upon reading. We can do this
- * since there can only be one reader/writer for the port. In contrast to MVars
- * which do need to keep a list of blocked threads.
- *
- * This means IOPorts have these valid states and transitions:
- *
- ┌─────────┐
- │ Empty │ head == tail == value == END_TSO_QUEUE
- ├─────────┤
- │ │
- write │ │ read
- v v
- value != END_TSO_QUEUE ┌─────────┐ ┌─────────┐ value == END_TSO_QUEUE
- head == END_TSO_QUEUE │ full │ │ reading │ head == queue with single reader
- tail == END_TSO_QUEUE └─────────┘ └─────────┘ tail == END_TSO_QUEUE
- │ │
- read │ │ write
- │ │
- v v
- ┌──────────┐ value != END_TSO_QUEUE
- │ Used │ head == END_TSO_QUEUE
- └──────────┘ tail == ioport
-
- *
- * -------------------------------------------------------------------------- */
-
-
-stg_readIOPortzh ( P_ ioport /* :: IOPort a */ )
-{
- W_ val, info, tso, q;
-
- LOCK_CLOSURE(ioport, info);
-
- /* If the Port is empty, put ourselves on the blocked readers
- * list and wait until we're woken up.
- */
- if (StgMVar_value(ioport) == stg_END_TSO_QUEUE_closure) {
-
- // There is or was already another reader, throw exception.
- if (StgMVar_head(ioport) != stg_END_TSO_QUEUE_closure ||
- StgMVar_tail(ioport) != stg_END_TSO_QUEUE_closure) {
- unlockClosure(ioport, info);
- jump stg_raiseIOzh(ghczminternal_GHCziIOPort_doubleReadException_closure);
- }
-
- if (info == stg_MVAR_CLEAN_info) {
- ccall dirty_MVAR(BaseReg "ptr", ioport "ptr", StgMVar_value(ioport));
- }
-
- ALLOC_PRIM_WITH_CUSTOM_FAILURE
- (SIZEOF_StgMVarTSOQueue,
- unlockClosure(ioport, stg_MVAR_DIRTY_info);
- GC_PRIM_P(stg_readIOPortzh, ioport));
-
- q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
-
- // link = stg_END_TSO_QUEUE_closure since we check that
- // there is no other reader above.
- StgMVarTSOQueue_link(q) = stg_END_TSO_QUEUE_closure;
- StgMVarTSOQueue_tso(q) = CurrentTSO;
-
- SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
-
- %release StgMVar_head(ioport) = q;
- StgTSO__link(CurrentTSO) = q;
- StgTSO_block_info(CurrentTSO) = ioport;
-
- // See Note [Heap memory barriers]
- %release StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I32;
-
- //Unlocks the closure as well
- jump stg_block_readmvar(ioport);
- }
-
- //This way we can check of there has been a read already.
- //Upon reading we set tail to indicate the port is now closed.
- if (StgMVar_tail(ioport) == stg_END_TSO_QUEUE_closure) {
- StgMVar_tail(ioport) = ioport;
- StgMVar_head(ioport) = stg_END_TSO_QUEUE_closure;
- } else {
- //Or another thread has read already: Throw an exception.
- unlockClosure(ioport, info);
- jump stg_raiseIOzh(ghczminternal_GHCziIOPort_doubleReadException_closure);
- }
-
- val = StgMVar_value(ioport);
-
- unlockClosure(ioport, info);
- return (val);
-}
-
-stg_writeIOPortzh ( P_ ioport, /* :: IOPort a */
- P_ val, /* :: a */ )
-{
- W_ info, tso, q;
-
- LOCK_CLOSURE(ioport, info);
-
- /* If there is already a value in the port, then raise an exception
- as it's the second write.
- Correct usages of IOPort should never have a second
- write. */
- if (StgMVar_value(ioport) != stg_END_TSO_QUEUE_closure) {
- unlockClosure(ioport, info);
- jump stg_raiseIOzh(ghczminternal_GHCziIOPort_doubleReadException_closure);
- return (0);
- }
-
- // We are going to mutate the closure, make sure its current pointers
- // are marked.
- if (info == stg_MVAR_CLEAN_info) {
- ccall update_MVAR(BaseReg "ptr", ioport "ptr", StgMVar_value(ioport) "ptr");
- }
-
- q = StgMVar_head(ioport);
-loop:
- if (q == stg_END_TSO_QUEUE_closure) {
- /* No takes, the IOPort is now full. */
- if (info == stg_MVAR_CLEAN_info) {
- ccall dirty_MVAR(BaseReg "ptr", ioport "ptr", StgMVar_value(ioport) "ptr");
- }
- StgMVar_value(ioport) = val;
-
- unlockClosure(ioport, stg_MVAR_DIRTY_info);
- return (1);
- }
- //Possibly IND added by removeFromMVarBlockedQueue
- if (StgHeader_info(q) == stg_IND_info ||
- StgHeader_info(q) == stg_MSG_NULL_info) {
- q = %acquire StgInd_indirectee(q);
- goto loop;
- }
-
- // There is a readIOPort waiting: wake it up
- tso = StgMVarTSOQueue_tso(q);
-
- // Assert no read has happened yet.
- ASSERT(StgMVar_tail(ioport) == stg_END_TSO_QUEUE_closure);
- // And there is only one reader queued up.
- ASSERT(StgMVarTSOQueue_link(q) == stg_END_TSO_QUEUE_closure);
-
- // We perform the read here, so set tail/head accordingly.
- StgMVar_head(ioport) = stg_END_TSO_QUEUE_closure;
- StgMVar_tail(ioport) = ioport;
-
- // In contrast to MVars we do not need to move on to the
- // next element in the waiting list here, as there can only ever
- // be one thread blocked on a port.
-
- // save why_blocked here, because waking up the thread destroys
- // this information
- W_ why_blocked;
- why_blocked = TO_W_(StgTSO_why_blocked(tso)); // TODO Missing acquire
- ASSERT(StgTSO_block_info(tso) == ioport);
-
- // actually perform the takeMVar
- W_ stack;
- stack = StgTSO_stackobj(tso);
- if (IS_STACK_CLEAN(stack)) {
- ccall dirty_STACK(MyCapability() "ptr", stack "ptr");
- }
- PerformTake(stack, val);
-
- // indicate that the operation has now completed.
- StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
-
- ccall tryWakeupThread(MyCapability() "ptr", tso);
-
- // For MVars we loop here, waking up all readers.
- // IOPorts however can only have on reader. So we are done
- // at this point.
-
- //Either there was no reader queued, or he must have been
- //blocked on BlockedOnMVar
- ASSERT(why_blocked == BlockedOnMVar);
-
- unlockClosure(ioport, info);
- return (1);
-}
-/* -----------------------------------------------------------------------------
- IOPort primitives
- -------------------------------------------------------------------------- */
-
-stg_newIOPortzh ()
-{
- W_ ioport;
-
- ALLOC_PRIM_ (SIZEOF_StgMVar, stg_newIOPortzh);
-
- ioport = Hp - SIZEOF_StgMVar + WDS(1);
- SET_HDR(ioport, stg_MVAR_DIRTY_info,CCCS);
- // MVARs start dirty: generation 0 has no mutable list
- StgMVar_head(ioport) = stg_END_TSO_QUEUE_closure;
- StgMVar_tail(ioport) = stg_END_TSO_QUEUE_closure;
- StgMVar_value(ioport) = stg_END_TSO_QUEUE_closure;
-
- return (ioport);
-}
-
/* -----------------------------------------------------------------------------
Stable name primitives
------------------------------------------------------------------------- */
=====================================
rts/RtsSymbols.c
=====================================
@@ -650,9 +650,6 @@ extern char **environ;
SymI_HasDataProto(stg_newMVarzh) \
SymI_HasDataProto(stg_newMutVarzh) \
SymI_HasDataProto(stg_newTVarzh) \
- SymI_HasDataProto(stg_readIOPortzh) \
- SymI_HasDataProto(stg_writeIOPortzh) \
- SymI_HasDataProto(stg_newIOPortzh) \
SymI_HasDataProto(stg_noDuplicatezh) \
SymI_HasDataProto(stg_atomicModifyMutVar2zh) \
SymI_HasDataProto(stg_atomicModifyMutVarzuzh) \
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -423,10 +423,6 @@ RTS_FUN_DECL(stg_block_stmwait);
RTS_FUN_DECL(stg_block_throwto);
RTS_RET(stg_block_throwto);
-RTS_FUN_DECL(stg_readIOPortzh);
-RTS_FUN_DECL(stg_writeIOPortzh);
-RTS_FUN_DECL(stg_newIOPortzh);
-
/* Entry/exit points from StgStartup.cmm */
RTS_RET(stg_stop_thread);
=====================================
rts/win32/AsyncWinIO.c
=====================================
@@ -147,7 +147,7 @@
* Create a thread to execute "runner"
We never truly shut down the IO Manager. While this means we
- might block forever on the IOPort if the IO Manager is no longer
+ might block forever on the MVar if the IO Manager is no longer
needed we consider this cheap compared to the complexity of
properly handling pausing and resuming of the manager.
=====================================
testsuite/tests/primops/should_run/UnliftedIOPort.hs
=====================================
@@ -1,31 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedDatatypes #-}
-
-module Main where
-
-import Data.Kind
-import GHC.Exts
-import GHC.IO
-
-type U :: Type
-data U = U Int#
-
-main :: IO ()
-main = do
- res <- IO \ s0 ->
- case newIOPort# s0 of
- (# s1, port #) ->
- case writeIOPort# port (U 17#) s1 of
- (# s2, i #) ->
- case catch# (writeIOPort# port (U 19#)) (\ _ s -> (# s, 3# #)) s2 of
- (# s3, j #) ->
- case readIOPort# port s3 of
- (# s4, U r1 #) ->
- case catch# (readIOPort# port) (\ _ s -> (# s, U 4# #)) s4 of
- (# s5, U r2 #) ->
- (# s5, [ I# i, I# j, I# r1, I# r2 ] #)
- print res
=====================================
testsuite/tests/primops/should_run/all.T
=====================================
@@ -45,7 +45,6 @@ test('LevPolyPtrEquality2', normal, compile_and_run, [''])
test('UnliftedArray1', normal, compile_and_run, [''])
test('UnliftedArray2', normal, compile_and_run, [''])
test('UnliftedArrayCAS', normal, compile_and_run, [''])
-test('UnliftedIOPort', js_broken(22261), compile_and_run, [''])
test('UnliftedMutVar1', normal, compile_and_run, [''])
test('UnliftedMutVar2', normal, compile_and_run, [''])
test('UnliftedMutVar3', normal, compile_and_run, [''])
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -821,8 +821,6 @@ ppType (TyApp (TyCon "StableName#") [x]) = "mkStableNamePrimTy " ++ ppType x
ppType (TyApp (TyCon "MVar#") [x,y]) = "mkMVarPrimTy " ++ ppType x
++ " " ++ ppType y
-ppType (TyApp (TyCon "IOPort#") [x,y]) = "mkIOPortPrimTy " ++ ppType x
- ++ " " ++ ppType y
ppType (TyApp (TyCon "TVar#") [x,y]) = "mkTVarPrimTy " ++ ppType x
++ " " ++ ppType y
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9144936731591b3066a6d7e4205d4f028d8617c5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9144936731591b3066a6d7e4205d4f028d8617c5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240216/12b8c72b/attachment-0001.html>
More information about the ghc-commits
mailing list