~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/atobj/datasrc-nam.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # datasrc-nam.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1997-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 
 31 
 32 #----------------------------------
 33 # DataSrc/Nam
 34 # ~~~~~~~~~~~
 35 #
 36 Class DataSrc/Nam -superclass DataSrc
 37 
 38 DataSrc/Nam instproc init {} {
 39         $self next
 40         $self set events_(0) "{} 0"
 41 }
 42 
 43 # events format: startTime endTime eventType
 44 # (c.r. DataSrc/Local/Nam convert*)
 45 DataSrc/Nam instproc eventST {evId} {
 46         return [lindex [$self set events_($evId)] 1]
 47 }
 48 
 49 DataSrc/Nam instproc eventET {evId} {
 50         return [lindex [$self set events_($evId)] 2]
 51 }
 52 
 53 DataSrc/Nam instproc inRange {eId t} {
 54         $self instvar events_ lastStatic_
 55         return [expr [lindex $events_($eId) 1] <= $t && \
 56                         [lindex $events_($eId) 2] >= $t]
 57 }
 58 
 59 
 60 #----------------------------------
 61 # DataSrc/Nam/Local
 62 # ~~~~~~~~~~~~~~~~~
 63 # - this is a special data source that reads from a text file
 64 # - one line per data item
 65 # - data items identified by the line number (one event per line)
 66 # - the line number is the event number
 67 Class DataSrc/Local/Nam -superclass {DataSrc/Local DataSrc/Nam}
 68 
 69 DataSrc/Local/Nam instproc init {filename} {
 70         if ![file exists $filename] {
 71                 error "file $filename does not exist!"
 72         }
 73         if ![file readable $filename] {
 74                 error "file $filename is not readable!"
 75         }
 76         $self set file_ [open $filename r]
 77         $self next
 78 }
 79 
 80 DataSrc/Local/Nam instproc reset {} {
 81         $self instvar events_ file_ lastRead_ firstEId_
 82         $self next
 83 
 84         if ![info exists events_] {
 85                 DbgOut "#*************** RESET!!!! *****************#"
 86                 set events_(0) 0
 87                 seek $file_ 0
 88                 set lastRead_ [expr $firstEId_ - 1]
 89         }
 90 }
 91 
 92 DataSrc/Local/Nam instproc attach_layout {nw} {
 93         $self set layout_ $nw
 94 }
 95 
 96 DataSrc/Local/Nam instproc convert_pkt {eId e} {
 97         # just a shortcut to parse the variables
 98         $self instvar layout_ events_
 99         # sT is the start time
100         foreach {sT src dest size attr ptype convid id} $e {}
101 
102         if ![$layout_ hasEdge $src $dest] {
103                 DbgOut "data error: edge ($src,$dest) non_existent!"
104         }
105         set xmitT [$layout_ xmitTime $src $dest $size]
106         set delay [$layout_ edgeDelay $src $dest]
107         set pos [$layout_ edgePos $src $dest]
108         set eT [expr $sT + $xmitT + $delay]
109 
110         set events_($eId) [list NamPkt $sT $eT $pos $delay $xmitT \
111                         [$layout_ pktHt $src $dest] \
112                         $attr [$layout_ get_color $convid] $id]
113 
114 #        DbgOut "packet e=$eId pid=$id ($src,$dest) : $events_($eId)"
115         return 1
116 }
117 
118 # converts a raw trace event to an animation object creation event
119 DataSrc/Local/Nam instproc convert_event {eId e} {
120         set type [removeFirst e]
121         switch -- $type {
122                 h {
123                         return [$self convert_pkt $eId $e]
124                 }
125                 default {
126                         return 0
127                 }
128         }
129 }
130 
131 DataSrc/Local/Nam instproc get_event {lineN} {
132         $self instvar events_ lastRead_ file_
133 
134 #        DbgVar lineN lastRead_
135         # if the event is in front,
136         #     we move forward until we find it.
137         # elseif it is behind,
138         #     we should have it, since right now we only do sequential scan
139         if ![info exists events_($lineN)] {
140                 while {$lastRead_ <= $lineN} {
141                         incr lastRead_
142                         set e ""
143                         set c [gets $file_ e]
144                         if {$c==-1} {
145                                 # EOF
146                                 $self set lastEId_ $lineN
147                                 incr lastRead_ -1
148                                 $self set events_($lineN) [list "END" \
149                                                 [$self eventST $lastRead_] \
150                                                 [$self eventET $lastRead_]]
151                                 return ""
152                         }
153 #                        DbgOut retrieved $e
154                         # try again if we cannot convert the event
155                         if ![$self convert_event $lastRead_ $e] {
156                                 incr lastRead_ -1
157                         }
158                 }
159                 if ![info exists events_($lineN)] {
160                         error "line $lineN is not available, should not happen"
161                 }
162         }
163         return $events_($lineN)
164 }
165 
166 DataSrc/Local/Nam instproc mintime {} {
167         $self instvar file_ firstEId_ mintime_
168         # use the cached value if possible
169         if [info exists mintime_] {
170                 return $mintime_
171         }
172         set pos [tell $file_]
173         seek $file_ 0
174         # the start time of the first event is the min time
175         set c [gets $file_ firstEvent]
176         DbgOut $firstEvent
177         set mintime_ [lindex $firstEvent 1]
178         seek $file_ $pos
179         DbgOut "[$self info class] mintime -> $mintime_"
180         return $mintime_
181 }
182 
183 DataSrc/Local/Nam instproc maxtime {} {
184         $self instvar file_ maxtime_
185         # use the cached value if possible
186         if [info exists maxtime_] {
187                 return $maxtime_
188         }
189 
190         # REVIEW: assume that each line is less than 300 characters
191         set pos [tell $file_]
192         seek $file_ -300 end
193         set lines [split [read $file_] \n]
194 
195         set lastline [lindex $lines end]
196         # the last character might be a return
197         if {"$lastline" == ""} {
198 #                DbgOut "last line is null, no. lines = [llength $lines]"
199                 set lastline [lindex $lines [expr [llength $lines] - 2]]
200 #                DbgOut "last line: $lastline"
201         }
202         set maxtime [lindex $lastline 1]
203 
204         DbgOut maxtime is $maxtime
205         # REVIEW: since we only have packet size in the last line,
206         #         we cannot figure out the end_time, so add 0.5 to be save
207         #         nothing in a network should last longer than 0.5 secs right?
208 
209         set maxtime_ [expr $maxtime + 0.5]
210         seek $file_ $pos
211         return $maxtime
212 }
213 
214 # gives the (data) source a chance to send out any data...
215 DataSrc/Local/Nam instproc setup {} {
216         $self instvar layout_ events_
217 
218         # start at event 2, event 1 is reserved for startup information.
219         set i 2
220         foreach n [$layout_ nodes] {
221                 set events_($i) [list NamNode 0 0 $n [$layout_ nodePos $n] \
222                                 [$layout_ nodeSize $n]]
223                 incr i
224         }
225         foreach e [$layout_ edges] {
226                 set events_($i) [list NamEdge 0 0 \
227                                 [eval $layout_ edgePos [split $e ","]] 0]
228                 incr i
229         }
230         set lastStatic [expr $i - 1]
231         DbgOut last static is: $lastStatic
232         for {set i 2} {$i<=$lastStatic} {incr i} {
233                 $self handle $i $events_($i)
234         }
235 
236         # insert setup information
237         # format:  type st et firstEvent lastStaticEvent mintime maxtime
238         $self instvar view_
239         $self set firstEId_ $lastStatic
240         $self set lastRead_ $lastStatic
241 
242         DbgOut mintime is: [$self mintime]
243         set events_(1) [list INIT 0 0 1 $lastStatic \
244                         [$self mintime] [$self maxtime] [$view_ bbox]]
245 
246         # we send out the initialization after the rest, so as to be
247         # consistent with the notion of sending dependencies first.
248         # But we want this to be one so that it is a consistent place for
249         # initial packet request....
250         # REVIEW: should really cast them into the namespace....
251         $self handle 1 $events_(1)
252         DbgOut mintime is: [$self mintime]
253 
254         # note most variables will get initialized during handle event...
255         $self instvar now_
256         $self hook_updateTime $now_
257 }
258 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.