blob: bbfd374c43a4bc41d0f3e8ed06a327baccd44901 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
module Scheduler
( runTIO
, module Event
, module Thread
, TTree
, TIO
)
where
import Event
import Thread
import Control.Concurrent
import System.IO
--------------------------------
type TTree = ThreadTree SysReq SysRsp IO
type TIO = ContM SysReq SysRsp IO
runTIO :: [TIO ()] -> IO ()
runTIO l = runThreads $ map buildThread l
data World = World
{ mReadyQ :: ! (Chan (TTree)) }
max_steps = 1
worker_pure world=
do
t <- readChan readyq
case t of
(Atom _) -> return ()
_ -> return ()
exec_thread max_steps t
return ()
where
readyq = mReadyQ world
exec_thread 0 t =
do putStr "."; hFlush stdout
writeChan readyq t
exec_thread c (Atom mx) =
do
x <- mx
exec_thread (c-1) x
exec_thread c (Stop) = return ()
runThreads :: [TTree] -> IO ()
runThreads l =
do
mready <- newChan
writeList2Chan mready l
let world = World mready
multiloop world
loop_p world = do worker_pure world; loop_p world
multiloop world =
do
-- a mixture of bound threads & lightweight threads
-- to make things interesting...
forkOS (loop_p world)
forkOS (loop_p world)
forkOS (loop_p world)
forkOS (loop_p world)
forkOS (loop_p world)
forkOS (loop_p world)
forkIO (loop_p world)
forkIO (loop_p world)
forkIO (loop_p world)
forkIO (loop_p world)
forkIO (loop_p world)
forkIO (loop_p world)
forkIO (loop_p world)
loop_p world
|
