Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
cc35bcba
Commit
cc35bcba
authored
Mar 14, 1997
by
sof
Browse files
[project @ 1997-03-14 05:19:02 by sof]
Import changes
parent
15ecf716
Changes
2
Hide whitespace changes
Inline
Side-by-side
ghc/lib/concurrent/Merge.lhs
View file @
cc35bcba
...
...
@@ -15,7 +15,9 @@ module Merge
) where
import Semaphore
import ConcBase
import STBase ( unsafeInterleavePrimIO )
import IOBase
max_buff_size = 1
...
...
@@ -64,7 +66,7 @@ suckIO branches_running buff@(tail_list,e) vs
unsafeInterleavePrimIO ( ioToPrimIO $
takeMVar next_node >>= \ x ->
signalQSem e >>
return x) `
stThen
` \ next_node_val ->
return x) `
thenIO_Prim
` \ next_node_val ->
putMVar node (x:next_node_val) >>
putMVar tail_list next_node >>
suckIO branches_running buff xs
...
...
ghc/lib/concurrent/Parallel.lhs
View file @
cc35bcba
...
...
@@ -13,6 +13,9 @@ module Parallel (par, seq -- re-exported
import ConcBase ( par )
#if defined(__GRANSIM__)
import PrelBase
import GHCerr ( parError )
import GHC ( parGlobal#, parLocal#, parAt#, parAtForNow# )
{-# INLINE parGlobal #-}
parGlobal :: Int -> Int -> Int -> Int -> a -> b -> b
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment