{- 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