root/hiersort/sim/Presorter.hs

Revision 4, 4.7 kB (checked in by thesz, 2 years ago)

Added script for conducting experiments. Added some experiments parameters. Less debug info (faster execution). Fixed 'send back in time' bug in heat1d.

Line 
1 -- | Presorter.hs
2 -- A circuit on the entry of communication environment node.
3 --
4 -- Copytight (C) 2007, 2008 Serguey Zefirov
5 --
6 -- This program is free software; you can redistribute it and/or modify
7 -- it under the terms of the GNU General Public License as published by
8 -- the Free Software Foundation; either version 3, or (at your option)
9 -- any later version.
10 -- See file COPYING or visit http://www.gnu.org/licenses for details.
11
12 -- Presorter forwards tokens into left or right subhierarchies or right into
13 -- upstream buffer (when token does not belong into any subhierarchy).
14 --
15 -- And some handy functions here, as a bonus.
16 --
17
18 module Presorter(
19                  presorter
20                 ,isNotToHost
21         ) where
22
23 import Data.Maybe
24
25 import Info
26 import S
27 import InterfaceTypes
28
29 -------------------------------------------------------------------------------
30 -- Uncomparable filter state changer.
31
32 presorterF ourAddrF leftAddrF
33         maxlen
34         presorterSortWidth
35         presorterUpWidth
36         tokensBuf
37         (inTokens,(upstreamcts,(leftsortercts,rightsortercts)))
38         =
39 #ifdef  DEBUG
40         (nextTokensBuf,((((leftSorterToken,rightSorterToken),allUpstreamTokens),(uprtr,dnrtr)),debinfo))
41 #else
42         (nextTokensBuf,(((leftSorterToken,rightSorterToken),allUpstreamTokens),(uprtr,dnrtr)))
43 #endif
44         where
45                 presorterUpMaxLen = fromWidth presorterUpWidth
46                 presorterSortMaxLen = fromWidth presorterSortWidth
47
48                 forceuplevel = fromEnum $ toEnum maxlen * 0.5
49
50                 tokensBufLen = length tokensBuf
51                 dnrtr = tokensBufLen < maxlen
52                 uprtr = dnrtr   -- historical accident.
53                 findFirst 0 f acc miss xs = (reverse acc,reverse miss ++ xs)
54                 findFirst n f acc miss [] = (reverse acc,reverse miss)
55                 findFirst n f acc miss (x:xs)
56                         | f x = findFirst (n-1) f (x:acc) miss xs
57                         | otherwise = findFirst n f acc (x:miss) xs
58                 sendToken n f xs = case findFirst n f [] [] xs of
59                         (r,xs) -> (r,xs)
60                 (upstreamToken,sendUp) =
61                         sendToken
62                                 presorterUpMaxLen
63                                 ((upstreamcts && ) . not . ourAddrF) tokensBuf
64                 (flushUpTokens,flushUp)
65 {-
66                         | tokensBufLen > forceuplevel =
67                                 sendToken
68                                         (presorterUpMaxLen-length upstreamToken)
69                                         ((upstreamcts && ) . const True)
70                                         sendUp
71 -}
72                         | otherwise = ([],sendUp)
73                 allUpstreamTokens = flushUpTokens++upstreamToken
74                 leftF x = ourAddrF x && leftAddrF x
75                 rightF x = ourAddrF x && not (leftAddrF x)
76                 (leftSorterToken,sendLeftSorter) =
77                         sendToken
78                                 presorterSortMaxLen
79                                 ((leftsortercts && ) . leftF)
80                                 flushUp
81                 (rightSorterToken,sendRightSorter) =
82                         sendToken
83                                 presorterSortMaxLen
84                                 ((rightsortercts && ) . rightF) sendLeftSorter
85                 nextTokensBuf = sendRightSorter++inTokens
86                 noinfo = ""
87                 debinfo =       "presorter"
88                         !#      ("maxlen",maxlen)
89 --                      ##      ("tokensBufLen",tokensBufLen)
90 --                      ##      ("tokensBuf",tokensBuf)
91 --                      ##      ("inTokens",inTokens)
92 --                      ##      ("(upstreamcts,(leftsortercts,rightsortercts))",(upstreamcts,(leftsortercts,rightsortercts)))
93 --                      ##      ("((leftSorterToken,rightSorterToken),upstreamToken)",((leftSorterToken,rightSorterToken),upstreamToken))
94 --                      ##      ("number of tokens out",length leftSorterToken+length rightSorterToken+length upstreamToken)
95 --                      ##      ("tokensBufLen == number of tokens out",tokensBufLen == length leftSorterToken+length rightSorterToken+length upstreamToken)
96 --                      ##      ("number of tokens in",length inTokens)
97 --                      ##      ("fmap ourAddrF leftSorterToken",fmap ourAddrF leftSorterToken)
98 --                      ##      ("fmap ourAddrF rightSorterToken",fmap ourAddrF rightSorterToken)
99 --                      ##      ("fmap ourAddrF upstreamToken",fmap ourAddrF upstreamToken)
100 --                      ##      ("presorterSortWidth",fromWidth presorterSortWidth)
101 --                      ##      ("presorterUpWidth",fromWidth presorterUpWidth)
102 --                      ##      ("nextTokensBuf",nextTokensBuf)
103                         #!      ("presorter rtr",dnrtr)
104
105 -------------------------------------------------------------------------------
106 -- Uncomparable filter circuit.
107
108 presorter ourAddrF leftAddrF
109         maxlen
110         presorterSortWidth
111         presorterUpWidth
112         inTokens1 inTokens2 inTokens3
113         upstreamCTS leftSorterCTS rightSorterCTS =
114 #ifdef  DEBUG
115         (leftSorterTokens,rightSorterTokens,upstreamTokens,uprtr,dnrtr,info)
116 #else
117         (leftSorterTokens,rightSorterTokens,upstreamTokens,uprtr,dnrtr)
118 #endif
119         where
120                 allInTokens =
121                         mapS (concat) $ listSToSList[
122                                          inTokens1
123                                         ,inTokens2
124                                         ,inTokens3
125                                 ]
126 #ifdef  DEBUG
127                 (bus,info) =
128                         unzipS $
129 #else
130                 (bus) =
131 #endif
132                         loopS   []
133                                 (presorterF
134                                         ourAddrF leftAddrF
135                                         maxlen  presorterSortWidth
136                                         presorterUpWidth)
137                                 (zipS allInTokens $ zipS upstreamCTS $ zipS leftSorterCTS rightSorterCTS)
138                 (alltokens,rtrs) = unzipS bus
139                 (uprtr,dnrtr) = unzipS rtrs
140                 (leftRightTokens,upstreamTokens) = unzipS alltokens
141                 (leftSorterTokens,rightSorterTokens) = unzipS leftRightTokens
142
143 -------------------------------------------------------------------------------
144 -- Functions for uncomparable filter circuit.
145
146 isNotToHost Msg {msgModuleAddr = moduleaddr} = moduleaddr /= HostTok
Note: See TracBrowser for help on using the browser.