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
218
219
|
{-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses #-}
module TestRun (
run_testdata -- FilePath -> FilePath -> IO ()
) where
import TestData
import TestDataParser
import Collection
import Control.Monad
import GHC.Conc
import Text.Printf
import Data.List
import Data.IORef
import Control.Concurrent
--import Control.Concurrent.STM
import System.Environment
import Data.Time
import System.Mem
import System.Random
import Control.Exception
-- the contenders
import qualified CASList as CAS
import qualified ImmList as IMM
--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
instance (Eq e, Show e) => Col (CAS.ListHandle e) e where
newCol = CAS.newList
insertCol c e = do CAS.addToTail c e
return ()
deleteCol = CAS.delete
findCol = CAS.find
printCol = CAS.printList
cntCol = CAS.cntList
instance (Eq e, Show e) => Col (IMM.ListHandle e) e where
newCol = IMM.newList
insertCol c e = do IMM.addToTail c e
return ()
deleteCol = IMM.delete
findCol = IMM.find
printCol = IMM.printList
cntCol = IMM.cntList
--instance (Eq e, Show e) => Col (CASusingSTM.ListHandle e) e where
-- newCol = CASusingSTM.newList
-- insertCol c e = do CASusingSTM.addToTail c e
-- return ()
-- deleteCol = CASusingSTM.delete
-- findCol = CASusingSTM.find
-- printCol = CASusingSTM.printList
-- cntCol = CASusingSTM.cntList
--instance (Eq e, Show e) => Col (Lazy.ListHandle e) e where
-- newCol = Lazy.newList
-- insertCol c e = do Lazy.addToTail c e
-- return ()
-- deleteCol = Lazy.delete
-- findCol = Lazy.find
-- printCol = Lazy.printList
-- cntCol = Lazy.cntList
instance (Eq e, Show e) => Col (I.ListHandle e) e where
newCol = I.newList
insertCol c e = do I.addToTail c e
return ()
deleteCol = I.delete
findCol = I.find
printCol = I.printList
cntCol = I.cntList
--instance (Eq e, Show e) => Col (MLCusingSTM.ListHandle e) e where
-- newCol = MLCusingSTM.newList
-- insertCol c e = do MLCusingSTM.addToTail c e
-- return ()
-- deleteCol = MLCusingSTM.delete
-- findCol = MLCusingSTM.find
-- printCol = MLCusingSTM.printList
-- cntCol = MLCusingSTM.cntList
instance (Eq e, Show e) => Col (MLC.ListHandle e) e where
newCol = MLC.newList
insertCol c e = do MLC.addToTail c e
return ()
deleteCol = MLC.delete
findCol = MLC.find
printCol = MLC.printList
cntCol = MLC.cntList
--instance (Eq e, Show e) => Col (S.ListHandle e) e where
-- newCol = S.newList
-- insertCol c e = do S.addToTail c e
-- return ()
-- deleteCol = S.delete
-- findCol = S.find
-- printCol = S.printList
-- cntCol = S.cntList
-- Auxiliary functions
createList :: Col c e => [e] -> IO c
createList n =
do nl <- newCol
mapM (insertCol nl) n
return nl
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 ()
appendIORef :: IORef [a] -> a -> IO ()
appendIORef ref a = do
{ as <- readIORef ref
; writeIORef ref (a:as) }
showComma :: [String] -> String
showComma (s:ss) = "," ++ s ++ (showComma ss)
showComma [] = ""
-- Main interface
run_testdata :: FilePath -> String -> IO ()
run_testdata testdata_fname mode = do
{ tc <- parse_testdata testdata_fname
; putStrLn "Test Initiated: "
; let init_elems = t_init_list tc
works = t_tasks tc
; medians <- newIORef []
; highlows <- newIORef []
; runtests mode init_elems works (medians,highlows)
}
where
runtests m elems works refs =
case m of
"CAS" -> do nl :: CAS.ListHandle Int <- createList elems
runtest m works nl refs
"IMM" -> do nl :: IMM.ListHandle Int <- createList elems
runtest m works nl refs
-- "CASusingSTM" -> do nl :: CASusingSTM.ListHandle Int <- createList elems
-- runtest m works nl refs
-- "LAZY" -> do nl :: Lazy.ListHandle Int <- createList elems
-- runtest m works nl refs
"MLC" -> do nl :: MLC.ListHandle Int <- createList elems
runtest m works nl refs
-- "MLCusingSTM" -> do nl :: MLCusingSTM.ListHandle Int <- createList elems
-- runtest m works nl refs
"IO" -> do nl :: I.ListHandle Int <- createList elems
runtest m works nl refs
-- "STM" -> do nl :: S.ListHandle Int <- createList elems
-- runtest m works nl refs
trash -> fail $ "Oi! No such concurrency mode: " ++ trash
runtest m works nl (medians,highlows) = do
{ putStrLn $ "Test Started: " ++ m
; performGC
-- ; wait <- atomically (newTVar 0)
; wait <- newEmptyMVar
; start <- getCurrentTime
; zipWithM (\n work -> forkOn n (do { executeTasks nl work
; putMVar wait () }))
--atomically(do counter <- readTVar wait
-- writeTVar wait (counter+1)) }))
[0..] works
; replicateM_ (length works) (takeMVar wait)
-- ; atomically ( do { counter <- readTVar wait
-- ; if counter < length works then retry
-- else return () } )
; fin <- getCurrentTime
; let result = diffUTCTime fin start
; -- printf "time: %.2fs\n" (realToFrac result :: Double)
; return () }
output_fname = "out"
write_output mod ms mref hlref = do
{ if mod == 1
then do { writeFile output_fname ""
; output_header output_fname ms
; appendFile output_fname ",,"
; output_header output_fname ms
; appendFile output_fname "\n1Core" }
else appendFile output_fname ("\n" ++ (show mod) ++ "Cores")
; medians <- readIORef mref
; highlows <- readIORef hlref
; let mstr = reverse $ map show medians
hlstr = reverse $ highlows
; appendFile output_fname (filter (/='s') (showComma mstr))
; appendFile output_fname ",,"
; appendFile output_fname (filter (/='s') (showComma hlstr)) }
output_header output_fname (m:ms) = do
{ appendFile output_fname ("," ++ m)
; output_header output_fname ms }
output_header output_fname [] = return ()
high_low results =
let fst = head results
lst = head $ drop ((length results) - 1) results
in (fst,lst)
|
