edentv-4.1.0.0: EdenTvType.hs
{- The Eden Trace Viewer (or simply EdenTV) is a tool that can generate diagrams to visualize the behaviour of Eden programs.
Copyright (C) 2005-2012 Phillips Universitaet Marburg
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-}
{-# LANGUAGE CPP #-}
-- JB: adapted instances (see end of file)
module EdenTvType where
import Data.Tree
import Data.Word
import qualified Data.Map as M
import qualified Data.Sequence as S
--import DeepSeq
import Graphics.UI.Gtk.Gdk.Pixbuf
import Graphics.UI.Gtk.Gdk.GC
-- A State to carry around:
-- What has to be drawn and how?
data ViewerState = VS
{ selRow :: [Double] -- currently selected row, [] if none
, selView :: Int -- machine- (0), process- (1) or threadView (2)
, locTime :: Bool -- all machines starting simultaneously
, showMsg :: Bool -- draw messages?
, matrixM :: [Double] -- \ :-)
, matrixP :: [Double] -- these lists control sorting in diffrent views
, matrixT :: [Double] -- /
, matrixGP :: [Double]
, ommitRedraw :: Bool
, clicked :: Bool
, deleteSel :: Bool
, noDND :: Bool
, oldView :: Maybe Pixbuf
, confMachines :: [(MachineID, (Bool,Bool))] -- show in/out Messages Machines
, confProcesses :: [(ProcessID, (Bool,Bool))] -- show in/out Messages Procs
, autoTicks :: Bool
, tickSkip :: Seconds
, tickMark :: Int
, filename :: String -- the trace file the data was read from
, ignoreMessages :: Bool -- indicates if the trace file was parsed without messages
} deriving Show
instance Show Pixbuf where
show x = "pixbuf"
data EdenTvState = ES
{ lastPath :: String
, colors :: Colors
} deriving Show
data ColorRGBA = RGBA
{ rgbColor :: Color
, alpha :: Word16
} deriving Show
data Colors = Colors
{ statusRunning :: ColorRGBA
, statusSuspended :: ColorRGBA
, statusBlocked :: ColorRGBA
, statusIdle :: ColorRGBA
, messagesSystem :: ColorRGBA
, messagesHead :: ColorRGBA
, messagesData :: ColorRGBA
, messagesHeadLocal :: ColorRGBA
, messagesDataLocal :: ColorRGBA
, messagesBlock :: ColorRGBA
, messagesReceive :: ColorRGBA
, markerLine :: ColorRGBA
, markerLabel :: ColorRGBA
, markerStartup :: ColorRGBA
, chartBackground :: ColorRGBA
, chartAxes :: ColorRGBA
, chartAxesLabel :: ColorRGBA
} deriving Show
rgba :: Word16 -> Word16 -> Word16 -> Word16 -> ColorRGBA
rgba r g b a = RGBA {rgbColor = (Color r g b), alpha = a}
rgb :: Word16 -> Word16 -> Word16 -> ColorRGBA
rgb r g b = rgba r g b 65535
type Seconds = Double
type InportID = Int
type OutportID = Int
class EdenEvent e where
getEventTime :: e -> Seconds
setEventTime :: e -> Seconds -> e
-- A machine consists of an id and a list of related events
type MachineID = Int
type Machine = (MachineID,Int,Int,(Int,Int,Int),[MachineEvent])
-- (mID, allP,blkP,(#Proc,#sent,#rcv),events)
data MachineEvent
= StartMachine !Seconds -- Event 137
| EndMachine !Seconds -- Event 145
| GCMachine !Seconds !Int !Int !Int !Int -- Event 849 (Garbage Collection)
| IdleMachine !Seconds -- virtual event (no processes available)
| RunningMachine !Seconds -- virtual event (process running)
| SuspendedMachine !Seconds -- virtual event (no process running but runnable waiting)
| BlockedMachine !Seconds -- virtual event (all processes blocked)
| MNewProcess !Seconds -- other virtual events triggert by ProcessEvents
| MKillRProcess !Seconds
| MKillSProcess !Seconds
| MKillBProcess !Seconds
| MRunProcess !Seconds
| MSuspendProcess !Seconds
| MBlockProcess !Seconds
| MIdleProcess !Seconds
deriving (Show,Eq)
instance EdenEvent MachineEvent where
getEventTime (StartMachine s) = s
getEventTime (EndMachine s) = s
getEventTime (GCMachine s _ _ _ _) = s
getEventTime (IdleMachine s) = s
getEventTime (RunningMachine s) = s
getEventTime (SuspendedMachine s) = s
getEventTime (BlockedMachine s) = s
getEventTime (MNewProcess s) = s
getEventTime (MKillBProcess s) = s
getEventTime (MRunProcess s) = s
getEventTime (MSuspendProcess s) = s
getEventTime (MBlockProcess s) = s
getEventTime (MIdleProcess s) = s
getEventTime (MKillSProcess s) = s
getEventTime (MKillRProcess s) = s
--getEventTime e = error (show e)
setEventTime (StartMachine _) s = StartMachine s
setEventTime (EndMachine _) s = EndMachine s
setEventTime (GCMachine _ g a c l) s = GCMachine s g a c l
setEventTime (IdleMachine _) s = IdleMachine s
setEventTime (RunningMachine _) s = RunningMachine s
setEventTime (SuspendedMachine _) s = SuspendedMachine s
setEventTime (BlockedMachine _) s = BlockedMachine s
setEventTime (MNewProcess _) s = MNewProcess s
setEventTime (MKillBProcess _) s = MKillBProcess s
setEventTime (MRunProcess _) s = MRunProcess s
setEventTime (MSuspendProcess _) s = MSuspendProcess s
setEventTime (MBlockProcess _) s = MBlockProcess s
setEventTime (MIdleProcess _) s = MIdleProcess s
{-instance DeepSeq MachineEvent where
deepSeq (StartMachine sec) y = deepSeq sec y
deepSeq (EndMachine sec) y = deepSeq sec y
-}
-- A process is identified by its own id and the machine's id
-- it is running on, completed with it's events
type ProcessID = (MachineID,Int) -- (MachineID,ProcessID)
type Process = (ProcessID,Int,Int,(Int,Int,Int),[ProcessEvent])
-- (pID,allT,blockedT,(#Threads,#sent,#rec),events)
data ProcessEvent
= NewProcess !Seconds -- Event 153
| LabelProcess !Seconds String
| KillProcess !Seconds (Int,Int,Int) -- Event 161
| GCProcess !Seconds !Int !Int !Int !Int
| IdleProcess !Seconds -- virtual event (no threads available)
| RunningProcess !Seconds -- virtual event (thread running)
| SuspendedProcess !Seconds -- virtual event (no thread running but runnable waiting)
| BlockedProcess !Seconds -- virtual event (all threads blocked)
| PNewThread !Seconds
| PKillRThread !Seconds
| PKillSThread !Seconds
| PKillBThread !Seconds
| PRunThread !Seconds
| PSuspendThread !Seconds
| PBlockThread !Seconds
| PDeblockThread !Seconds
deriving (Show,Eq)
instance EdenEvent ProcessEvent where
getEventTime (NewProcess s) = s
getEventTime (LabelProcess s _) = s
getEventTime (KillProcess s _) = s
getEventTime (GCProcess s _ _ _ _) = s
getEventTime (IdleProcess s) = s
getEventTime (RunningProcess s) = s
getEventTime (SuspendedProcess s) = s
getEventTime (BlockedProcess s) = s
getEventTime (PNewThread s) = s
getEventTime (PKillRThread s) = s
getEventTime (PKillSThread s) = s
getEventTime (PKillBThread s) = s
getEventTime (PRunThread s) = s
getEventTime (PSuspendThread s) = s
getEventTime (PBlockThread s) = s
getEventTime (PDeblockThread s) = s
setEventTime (NewProcess _) s = NewProcess s
setEventTime (LabelProcess _ l) s = LabelProcess s l
setEventTime (KillProcess _ i) s = KillProcess s i
setEventTime (GCProcess _ g a c l) s = GCProcess s g a c l
setEventTime (IdleProcess _) s = IdleProcess s
setEventTime (RunningProcess _) s = RunningProcess s
setEventTime (SuspendedProcess _) s = SuspendedProcess s
setEventTime (BlockedProcess _) s = BlockedProcess s
setEventTime (PNewThread _) s = PNewThread s
setEventTime (PKillRThread _) s = PKillRThread s
setEventTime (PKillSThread _) s = PKillSThread s
setEventTime (PKillBThread _) s = PKillBThread s
setEventTime (PRunThread _) s = PRunThread s
setEventTime (PSuspendThread _) s = PSuspendThread s
setEventTime (PBlockThread _) s = PBlockThread s
setEventTime (PDeblockThread _) s = PDeblockThread s
-- Threads also have events and an identifier.
type ThreadID = (ProcessID,Int) -- (MachineID,ProcessID,ThreadID)
type Thread = (ThreadID,[ThreadEvent])
type OpenThread = (MachineID,(ThreadID,ThreadEvent),[Thread])
data ThreadEvent
= NewThread !Seconds !OutportID -- Event 169
| KillThread !Seconds -- Event 177
| GCThread !Seconds !Int !Int !Int !Int
| RunThread !Seconds -- Event 185
| SuspendThread !Seconds -- Event 193
| BlockThread !Seconds !InportID !Reason -- Event 201
| DeblockThread !Seconds -- Event 209
| DummyThread
deriving (Show,Eq)
instance EdenEvent ThreadEvent where
getEventTime (NewThread s _) = s
getEventTime (KillThread s) = s
getEventTime (GCThread s _ _ _ _) = s
getEventTime (RunThread s) = s
getEventTime (SuspendThread s) = s
getEventTime (BlockThread s _ _) = s
getEventTime (DeblockThread s) = s
setEventTime (NewThread _ o) s = NewThread s o
setEventTime (KillThread _) s = KillThread s
setEventTime (GCThread _ g a c l) s = GCThread s g a c l
setEventTime (RunThread _) s = RunThread s
setEventTime (SuspendThread _) s = SuspendThread s
setEventTime (BlockThread _ i r) s = BlockThread s i r
setEventTime (DeblockThread _) s = DeblockThread s
{-instance DeepSeq ThreadEvent where
deepSeq (NewThread sec outPort) y = deepSeq sec $ deepSeq outPort y
deepSeq (KillThread sec) y = deepSeq sec y
deepSeq (RunThread sec) y = deepSeq sec y
deepSeq (SuspendThread sec) y = deepSeq sec y
deepSeq (BlockThread sec inPort tag) y = deepSeq sec $ deepSeq inPort $ deepSeq tag y
deepSeq (DeblockThread sec) y = deepSeq sec y
-}
-- Messages:
data ReasonType =
RFork | -- legacy code: 85
Connect | -- legacy code: 86
DataMes | -- legacy code: 87
Head | -- legacy code: 88
Constr | -- legacy code: 89
Part | -- legacy code: 90
Terminate | -- legacy code: 91
Default | -- legacy code: -1
BlockReason | -- legacy code: 1
LocalHead | -- new: optimized message on local machine
LocalDataMes -- new: optimized message on local machine
deriving (Show, Eq, Ord)
type Reason = ReasonType
type Size = Int
-- Map of open messages per process.
--
-- Key: sender process id
-- Value: all message events (send and receive) that were
-- triggered for messages sent by this process
--
type OpenMessagesPerProcess = M.Map ProcessID OpenMessages
-- Map of open messages for a process. The key used in this map (`OpenMessageKey`)
-- is not unique for a message event. It groups messages sent to the same process
-- through the same channel (inport/outport) and with the same type and reason.
-- These messages with the same key are organized in a sequence/queue, so that
-- the message events can be matched in the right order.
--
type OpenMessages = M.Map OpenMessageKey (S.Seq SmallOpenMessageEvent)
type OpenMessageKey = (OpenMessageType, ProcessID, OutportID, InportID, Reason)
data OpenMessageType = TORM | TOSM deriving (Show, Eq, Ord)
-- This type is used to store an open message as value in `OpenMessages`.
-- All other information of the message is already contained in the map key.
--
data SmallOpenMessageEvent
= SmallORM !Seconds !Size
| SmallOSM !Seconds
deriving (Show,Eq)
-- Data type for open message events for messages sent from a process.
-- The process id for both ORM and OSM is always the the receiver process id.
data OpenMessageEvent
= ORM !Seconds !ProcessID !OutportID !InportID !Reason !Size
| OSM !Seconds !ProcessID !OutportID !InportID !Reason
deriving (Show,Eq)
{-instance DeepSeq OpenMessageEvent where
deepSeq (ORM sec proc ports info) y = deepSeq sec $ deepSeq proc $ deepSeq ports $ deepSeq info y
deepSeq (OSM sec proc ports info) y = deepSeq sec $ deepSeq proc $ deepSeq ports $ deepSeq info y
-}
-- Message: Complete message with send- and receive information
type ChannelID = (ProcessID,OutportID,ProcessID,InportID)
data Message = MSG !ChannelID !Seconds !Seconds !Reason !Size
-- channel stime rtime tag size
deriving (Show,Eq)
{-instance DeepSeq Message where
deepSeq (MSG times procs ports info) y = deepSeq times $ deepSeq procs $ deepSeq ports $ deepSeq info y
-}
-- the time it took to receive a message
type ReceiveLength = ((MachineID, [(Int,Seconds)]), Seconds, Seconds)
-- HeadMessage: Messages of type 100
type Count = Int
type DSize = Double
type OpenHeadMessage = (ChannelID,Size,Count,[Seconds],[Seconds])
-- channel, sum of sizes, quantity, sending/receiving times
type HeadMessage = (ChannelID,(Seconds,Seconds,Seconds,Seconds),DSize,Count)
-- channel stimeA,rtimeA stimeO,rtimeO size num
type OpenProcMessage = (MachineID,[(ProcessID,OpenMessageEvent)],[(ProcessID,OpenMessageEvent)],[ProcessID])
-- rcvMach sent Messages rcvd Messages NewProcess
type OpenMessageList = (OpenMessagesPerProcess,[Message],([OpenProcMessage],ProcessList,ProcessTree),([OpenHeadMessage],Double,[HeadMessage]))
type MessageList = (
[Message], --
[Message], -- additional messages: messages sent in a stream (bulk messages)
[HeadMessage], -- msgs from
ProcessTree,
[ReceiveLength] -- time to receive the messages
)
type ProcessList = [(ProcessID,[ProcessID])]
type ProcessTree = (Tree ProcessID) -- Node ProcessID [ProcessTree])
-- (Trace-)Events:
type EventID = Int
type NewEvent = ((EventID,Seconds,[Int]),Maybe String)
-- datatype used within the calculation
type OpenEvents = (
([Machine], [Process], [OpenThread]), -- list of machines/processes/threads
[(MachineID,Double)], -- machine starttimes
OpenMessageList, -- o/c Msgs
(Seconds,Seconds,Int,Int)) -- min_t max_t #P maxLD
-- The main datatype for the generated list of information
type Events = (
([Machine], [Process], [Thread]), -- list of machines/processes/threads
[(MachineID, Double)], -- start-times per machine
(Seconds, [(MachineID, Seconds)]), -- maxStartup msgs/heads
MessageList,
( Seconds, -- min_t
Seconds, -- max_t
Seconds, -- max_t_diff
Double, -- maxMsgSize
Double), -- MaxLD
(Int, Int, Int) -- number of machines/processes/threads
)
#if __GLASGOW_HASKELL__ < 606
#warning __GLASGOW_HASKELL__
instance (Show a,Show b,Show c,Show d,Show e,Show f) => Show (a,b,c,d,e,f)
instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g) => Show (a,b,c,d,e,f,g)
instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h) => Show (a,b,c,d,e,f,g,h)
instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h,Show i) => Show (a,b,c,d,e,f,g,h,i)
instance (Show a,Show b,Show c,Show d,Show e,Show f,Show g,Show h,Show i,Show j) => Show (a,b,c,d,e,f,g,h,i,j)
#endif