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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
> {-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
> module Main where
> import Data.IORef
> import Control.Concurrent
> --import Control.Concurrent.STM
> import System.Environment
> import Data.Time
> import System.Mem
> import Data.List
> import Collection
> import RefInterface
> import TestData
> import TestRun
-- the contenders (we can run stand-alone for a fixed test case mainPar)
> import qualified CASList as CAS
>-- import qualified CASusingSTMList as CASusingSTM
> import qualified MVarListLockCoupling as MLC
>-- import qualified MVarusingSTM as MLCusingSTM
>-- import qualified LazyList2 as Lazy
> import qualified IOList as I
>-- import qualified STMList as S
> import qualified ImmList as IMM
create List
> createList :: Col c e => [e] -> IO c
> createList n =
> do nl <- newCol
> mapM (insertCol nl) n
> return nl
> createTasks :: [a] -> [Op a]
> createTasks xs = task 1 xs
> where
> insCnt = 5 -- every 5th op is insert
> delCnt = 9 -- ever 9th op is delete
> task _ [] = []
> task cnt (x:xs)
> | (cnt `mod` insCnt) == 0 = (Insert x) : task (cnt+1) xs
> | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs
> | otherwise = (Find x) : task (cnt+1) xs
mainly finds, some deletes which will be inserted again
> specificTask1 :: [a] -> [Op a]
> specificTask1 xs = task 1 xs []
> where
> delCnt = 6 -- every 6th op is delete
> insCnt = 50 -- after 5 deletes we'll insert them again
> task _ [] _ = []
> task cnt (x:xs) deletes
> | length deletes == insCnt = map Insert deletes ++ task (cnt+1) (x:xs) []
> | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs (x:deletes)
> | otherwise = (Find x) : task (cnt+1) xs deletes
> executeTasks :: Col c e => c -> [Op e] -> IO ()
> executeTasks lh ops =
> do mapM (\ task ->
> case task of
> Find x -> do { findCol lh x; return () }
> Insert x -> do { insertCol lh x; return () }
> Delete x -> do { deleteCol lh x; return () })
> ops
> return ()
put number into threads buckets
> distribution :: [Int] -> Int -> [[Int]]
> distribution no threads =
> let init = map (\ _ -> []) [1..threads]
> go :: [Int] -> Int -> [[Int]] -> [[Int]]
> go [] _ acc = acc
> go (x:xs) cnt acc =
> let idx = cnt `mod` threads
> acc' = take idx acc ++ [x : (acc !! idx)] ++ drop (idx+1) acc
> in go xs (cnt+1) acc'
>
> in go no 1 init
runnable version
main = mainPar
parallel version
> type RUN = CAS.ListHandle Int
> main :: IO ()
> main =
> do args <- getArgs
> case args of
> (mode:"-t":in_fname:rest) -> run_testdata in_fname mode
>-- [mode, t, l] ->
>-- do let len = read l :: Int
>-- let threads = read t :: Int
>-- let run nl = mainPar nl threads len
>-- case mode of
>-- "CAS" -> do nl :: CAS.ListHandle Int <- createList [0..len]
>-- run nl
>-- "CASusingSTM" -> do nl :: CASusingSTM.ListHandle Int <- createList [0..len]
>-- run nl
>-- "LAZY" -> do nl :: Lazy.ListHandle Int <- createList [0..len]
>-- run nl
>-- "MLC" -> do nl :: MLC.ListHandle Int <- createList [0..len]
>-- run nl
>-- "MLCusingSTM" -> do nl :: MLCusingSTM.ListHandle Int <- createList [0..len]
>-- run nl
>-- "IO" -> do nl :: I.ListHandle Int <- createList [0..len]
>-- run nl
>-- "STM" -> do nl :: S.ListHandle Int <- createList [0..len]
>-- run nl
>-- "IMM" -> do nl :: IMM.ListHandle Int <- createList [0..len]
>-- run nl
mainPar :: Col c Int => c -> Int -> Int -> IO ()
mainPar nl threads len =
do let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
let ds = distribution numbers threads
let ts = ds
wait <- atomically (newTVar 0)
putStrLn "Start"
start <- getCurrentTime
mapM (\ t -> forkIO (do executeTasks nl (specificTask1 t)
atomically(do counter <- readTVar wait
writeTVar wait (counter+1))))
ts
atomically ( do counter <- readTVar wait
if counter < threads then retry
else return () )
fin <- getCurrentTime
putStrLn "Done"
putStrLn $ "Time: " ++ show (diffUTCTime fin start)
mainPar2 nl len =
do cnt <- atomically (newTVar 0)
printCol nl
mapM (\ e -> forkIO ( do insertCol nl e
atomically(do i <- readTVar cnt
writeTVar cnt (i+1))))
[6..len]
atomically ( do i <- readTVar cnt
if i <= len-6 then retry
else return () )
printCol nl
n <- cntCol nl
putStrLn $ "Overall: " ++ show n
sequential version
> mainSeq nl len =
> do let threads = 4
> let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
> ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
> let [d1,d2,d3,d4] = distribution numbers threads
> let t1 = d1++d2++d3++d4
> let t2 = d2++d3++d4++d1
> let t3 = d3++d4++d1++d2
> let t4 = d4++d1++d2++d3
> putStrLn "Start"
> start <- getCurrentTime
> mapM (\ t -> executeTasks nl (specificTask1 t)) [t1,t2,t3,t4]
> fin <- getCurrentTime
> putStrLn "Done"
> putStrLn $ "Time: " ++ show (diffUTCTime fin start)
just testing
> mainTest nl len =
> do
> printCol nl
r <- deleteCol nl 3
putStrLn ("Result : " ++ show r)
find nl 10
> insertCol nl 11
> deleteCol nl 3
> findCol nl 11
> mapM (\x -> forkIO (insertCol nl x)) [12..50]
> threadDelay 1000000
> {-
> putStrLn "Start"
> executeTasks nl $ createTasks [1..len]
> find nl (len+1) -- we try to find a non-existant element
> -- this way, in the LazyList case, we will physically delete all (logically deleted) elements
> -}
> putStrLn "End"
> printCol nl
|
