Changeset 4 for hiersort/tests/heat1d
- Timestamp:
- 02/18/08 02:47:48 (3 years ago)
- Files:
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
hiersort/tests/heat1d/Heat1DProg.hs
r3 r4 30 30 deriving (Eq,Ord,Show) 31 31 32 mkorder [i,j] = i+j:[i,j] 32 mkSkewedOrder [i,j] = i+j:[i,j] 33 mkStraightOrder ij = 0:ij 33 34 34 heat1d cfg = (heat1DMatcher nit size,heat1DGenerator size,size-2) 35 mkOrderFunc cfg 36 | skewOrder = mkSkewedOrder 37 | otherwise = mkStraightOrder 38 where 39 skewOrder = readTaskParam "skewOrdering" False cfg 40 41 heat1d cfg = (heat1DMatcher ordFunc nit size,heat1DGenerator ordFunc size,size-2) 35 42 where 36 43 size = readTaskParam "taskSize" 10 cfg 37 44 nit = readTaskParam "iterationsCount" 1 cfg 45 ordFunc = mkOrderFunc cfg 38 46 39 heat1DGenerator size = [b1,b2]++is47 heat1DGenerator orderFunc size = [b1,b2]++is 40 48 where 41 49 is = [ item 0 i (ReplX $ toEnum i) | i <- [2..size-1]] 42 50 item it i inp = Msg { 43 msgOrder = oIndexes GWrk ( mkorder[it,i])++oNode node51 msgOrder = oIndexes GWrk (orderFunc [it,i])++oNode node 44 52 ,msgModuleAddr = tokenToMod i 45 53 ,msgArity = inparity node … … 49 57 node = inpnode inp 50 58 b1 = item 1 1 (B1X 0) 51 b2 = item 1 size(B2X 0)59 b2 = item 1 (size-1) (B2X 0) 52 60 53 heat1DMatcher nit size pair order = procp $ case pair of61 heat1DMatcher orderFunc nit size pair order = procp $ case pair of 54 62 P1 inp -> case inp of 55 B1X v -> nodeB1 nit v cxIterI56 B2X v -> nodeB2 nit v cxIterI57 ReplX v -> nodeRepl size nit v cxIterI63 B1X v -> nodeB1 orderFunc nit v cxIterI 64 B2X v -> nodeB2 orderFunc nit v cxIterI 65 ReplX v -> nodeRepl orderFunc size nit v cxIterI 58 66 _ -> error $ "heat1DMatcher bad single input "++show (inp,order) 59 67 P2 ia ib -> case (ia,ib) of 60 (S1X va,S1Y vb) -> nodeS1 va vb cxIterI61 (S1Y vb,S1X va) -> nodeS1 va vb cxIterI62 (S2X va,S2Y vb) -> nodeS2 va vb cxIterI63 (S2Y vb,S2X va) -> nodeS2 va vb cxIterI68 (S1X va,S1Y vb) -> nodeS1 orderFunc va vb cxIterI 69 (S1Y vb,S1X va) -> nodeS1 orderFunc va vb cxIterI 70 (S2X va,S2Y vb) -> nodeS2 orderFunc va vb cxIterI 71 (S2Y vb,S2X va) -> nodeS2 orderFunc va vb cxIterI 64 72 _ -> error $ "heat1DMatcher bad pair input "++show (pair,order) 65 73 where … … 110 118 return $ tokenToMod mi 111 119 112 sendval ix@[iter,i] inp v = do120 sendval orderFunc ix@[iter,i] inp v = do 113 121 modindex <- nodemodindex node [i] 114 asend (oIndexes group ( mkorderix)++oNode node) modindex arity (inp v)122 asend (oIndexes group (orderFunc ix)++oNode node) modindex arity (inp v) 115 123 where 116 124 node = inpnode $ inp v … … 118 126 arity = inparity node 119 127 120 nodeB1 nit x [_,iter,i] = do128 nodeB1 orderFunc nit x [_,iter,i] = do 121 129 c <- ile iter nit 122 130 aif c … … 124 132 i1 <- iadd i 1 125 133 it1 <- iadd iter 1 126 sendval [iter,i1] S1X x127 sendval [it1,i] B1X x134 sendval orderFunc [iter,i1] S1X x 135 sendval orderFunc [it1,i] B1X x 128 136 ) 129 137 (return ()) 130 138 131 nodeB2 nit y [_,iter,i] = do139 nodeB2 orderFunc nit y [_,iter,i] = do 132 140 c <- ile iter nit 133 141 aif c 134 142 (do 135 i1 <- isub i 1136 143 it1 <- iadd iter 1 137 sendval [iter,i1] S1Y y138 sendval [it1,i] B2X y144 sendval orderFunc [iter,i] S1Y y 145 sendval orderFunc [it1,i] B2X y 139 146 ) 140 147 (return ()) 141 148 142 nodeRepl n nit x ix@[_,iter,i] = do149 nodeRepl orderFunc n nit x ix@[_,iter,i] = do 143 150 c <- ige iter nit 144 151 aif c 145 152 (do 146 sendval [iter,i] HostX x153 sendval orderFunc [iter,i] HostX x 147 154 ) 148 155 (do … … 152 159 (do 153 160 i1 <- isub i 1 154 sendval [nextIter,i1] S1Y x161 sendval orderFunc [nextIter,i1] S1Y x 155 162 ) 156 163 (return ()) 157 sendval [nextIter,i] S2Y x164 sendval orderFunc [nextIter,i] S2Y x 158 165 cltn1 <- ilt i (n-1) -- n-1 is basically constant, so we CAN. 159 166 aif cltn1 160 167 (do 161 168 i1 <- iadd i 1 162 sendval [nextIter,i1] S1X x169 sendval orderFunc [nextIter,i1] S1X x 163 170 ) 164 171 (return ()) 165 172 ) 166 173 167 nodeS1 x y [_,iter,i] = do174 nodeS1 orderFunc x y [_,iter,i] = do 168 175 s <- fadd x y 169 176 m <- fmul s 0.5 170 sendval [iter,i] S2X m177 sendval orderFunc [iter,i] S2X m 171 178 172 nodeS2 x y ix@[_,iter,i] = do179 nodeS2 orderFunc x y ix@[_,iter,i] = do 173 180 m <- fmul y 0.5 174 181 s <- fadd x m 175 182 -- iter1 <- iadd iter 1 176 sendval [iter,i] ReplX s183 sendval orderFunc [iter,i] ReplX s
