| 1 |
-- | UpBuf.hs |
|---|
| 2 |
-- Upstream buffer stands at the exit of communication environment node and |
|---|
| 3 |
-- equalize token streams that go into upper part of hierarchy (be they |
|---|
| 4 |
-- "greater" tokens from sorting queues overflows or just tokens for another |
|---|
| 5 |
-- part of hierarchy). |
|---|
| 6 |
-- |
|---|
| 7 |
-- This circuit is one of the simplest. |
|---|
| 8 |
-- |
|---|
| 9 |
-- Copytight (C) 2007, 2008 Serguey Zefirov |
|---|
| 10 |
-- |
|---|
| 11 |
-- This program is free software; you can redistribute it and/or modify |
|---|
| 12 |
-- it under the terms of the GNU General Public License as published by |
|---|
| 13 |
-- the Free Software Foundation; either version 3, or (at your option) |
|---|
| 14 |
-- any later version. |
|---|
| 15 |
-- See file COPYING or visit http://www.gnu.org/licenses for details. |
|---|
| 16 |
|
|---|
| 17 |
module UpBuf(upstreamBuffer) where |
|---|
| 18 |
|
|---|
| 19 |
import Data.Maybe |
|---|
| 20 |
|
|---|
| 21 |
import Info |
|---|
| 22 |
import S |
|---|
| 23 |
import InterfaceTypes |
|---|
| 24 |
|
|---|
| 25 |
------------------------------------------------------------------------------- |
|---|
| 26 |
-- Upstream buffer state changer. |
|---|
| 27 |
|
|---|
| 28 |
upstreamBufferF maxlen outWidth buf (ts,cts) = |
|---|
| 29 |
#ifndef DEBUG |
|---|
| 30 |
(nextBuf,(tok,rtr)) |
|---|
| 31 |
#else |
|---|
| 32 |
(nextBuf,((tok,rtr),info)) |
|---|
| 33 |
#endif |
|---|
| 34 |
where |
|---|
| 35 |
bufLen = length buf |
|---|
| 36 |
rtr = bufLen < maxlen |
|---|
| 37 |
(tok,sendUp) |
|---|
| 38 |
| cts = splitAt (fromWidth outWidth) buf |
|---|
| 39 |
| otherwise = ([],buf) |
|---|
| 40 |
nextBuf = sendUp++ts |
|---|
| 41 |
info = "upstream buffer" |
|---|
| 42 |
!# ("upstream rtr",rtr) |
|---|
| 43 |
-- ## ("buffer maxlen",maxlen) |
|---|
| 44 |
-- ## ("buffer length",bufLen) |
|---|
| 45 |
-- ## ("outWidth",fromWidth outWidth) |
|---|
| 46 |
#! ("upstream cts",cts) |
|---|
| 47 |
|
|---|
| 48 |
------------------------------------------------------------------------------- |
|---|
| 49 |
-- Upstream buffer circuit. |
|---|
| 50 |
|
|---|
| 51 |
upstreamBuffer maxlen outWidth fromPresorter fromLeftSorter fromRightSorter cts = |
|---|
| 52 |
#ifdef DEBUG |
|---|
| 53 |
(upstreamTokens,rtr,info) |
|---|
| 54 |
#else |
|---|
| 55 |
(upstreamTokens,rtr) |
|---|
| 56 |
#endif |
|---|
| 57 |
where |
|---|
| 58 |
tokensCombined = |
|---|
| 59 |
zipWithS (++) |
|---|
| 60 |
fromPresorter |
|---|
| 61 |
$ zipWithS (++) |
|---|
| 62 |
fromLeftSorter |
|---|
| 63 |
fromRightSorter |
|---|
| 64 |
maybeToListS = mapS maybeToList |
|---|
| 65 |
(upstreamTokens,rtr) = unzipS bus |
|---|
| 66 |
#ifdef DEBUG |
|---|
| 67 |
(bus,info) = unzipS $ |
|---|
| 68 |
#else |
|---|
| 69 |
bus = |
|---|
| 70 |
#endif |
|---|
| 71 |
loopS [] (upstreamBufferF maxlen outWidth) $ |
|---|
| 72 |
zipS tokensCombined cts |
|---|