1 # nam-network.tcl --
2 #
3 # NamNetwork: this is a "graph" of edges and nodes, and their
4 # characteristics
5 #
6 # Copyright (c) 1997-2002 The Regents of the University of California.
7 # All rights reserved.
8 #
9 # Redistribution and use in source and binary forms, with or without
10 # modification, are permitted provided that the following conditions are met:
11 #
12 # A. Redistributions of source code must retain the above copyright notice,
13 # this list of conditions and the following disclaimer.
14 # B. Redistributions in binary form must reproduce the above copyright notice,
15 # this list of conditions and the following disclaimer in the documentation
16 # and/or other materials provided with the distribution.
17 # C. Neither the names of the copyright holders nor the names of its
18 # contributors may be used to endorse or promote products derived from this
19 # software without specific prior written permission.
20 #
21 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
22 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
23 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
24 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
25 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
26 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
29 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 #
32 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/atobj/nam-network.tcl,v 1.6 2002/02/03 04:25:26 lim Exp $
33
34
35 ####################################################################
36 # NamNetwork --
37 #
38 # This is a "graph" that knows about edges and nodes, and their
39 # characteristics. Note that it is different from the edges and nodes in
40 # the animation itself.
41 #
42 #---
43
44 Class NamNetwork
45
46
47 #NamNetwork set pi_ 3.14159265358979323846
48 NamNetwork set pi_ 3.14159
49
50 NamNetwork instproc init {} {
51 # REVIEW: decide how to handle initialization
52 nam_config $self
53 }
54
55 # for backward compatibility
56 NamNetwork instproc node {id shape} {
57 $self new_node $id $shape
58 }
59
60 NamNetwork instproc new_node {id shape} {
61 $self instvar nodes_ nodeIds_
62 set nodes_(shape,$id) $shape
63 set nodes_(size,$id) 0
64 lappend nodeIds_ $id
65 }
66
67 NamNetwork instproc new_link {srcId destId bw delay angle} {
68 $self instvar edges_ nodes_
69
70 set pi [NamNetwork set pi_]
71 set edges_($srcId,$destId) [list $bw $delay [expr $angle*$pi]]
72
73 # DbgOut edge($srcId,$destId) "is" $edges_($srcId,$destId)
74 # DbgOut id says $edges_($srcId,$destId) is \
75 # [[$edges_($srcId,$destId) src] get_id] \
76 # [[$edges_($srcId,$destId) dest] get_id]
77 }
78
79 NamNetwork instproc nodes {} {
80 return [$self set nodeIds_]
81 }
82
83 # the format returned is "n0,n1 n1,n2 ...." (note the comma in between)
84 NamNetwork instproc edges {} {
85 return [$self array names edges_]
86 }
87
88 # pkt_size is in byes, bw in bits per sec, hence the << 3
89 NamNetwork instproc xmitTime {src dest pkt_size} {
90 set bw [$self edgeBW $src $dest]
91 return [expr (($pkt_size<<3)/$bw)]
92 }
93
94 NamNetwork instproc hasEdge {src dest} {
95 $self instvar edges_
96 return [info exists edges_($src,$dest)]
97 }
98
99 NamNetwork instproc edgeBW {src dest} {
100 $self instvar edges_
101 if [info exists edges_($src,$dest)] {
102 return [lindex $edges_($src,$dest) 0]
103 } else {
104 return ""
105 }
106 }
107
108 NamNetwork instproc edgeDelay {src dest} {
109 $self instvar edges_
110 if [info exists edges_($src,$dest)] {
111 return [lindex $edges_($src,$dest) 1]
112 } else {
113 return ""
114 }
115 }
116
117 NamNetwork instproc edgeAngle {src dest} {
118 $self instvar edges_
119 if [info exists edges_($src,$dest)] {
120 return [lindex $edges_($src,$dest) 2]
121 } else {
122 return ""
123 }
124 }
125
126 NamNetwork instproc setEdgePos {src dest x0 y0 x1 y1} {
127 $self set edge_pos_($src,$dest) [list $x0 $y0 $x1 $y1]
128 }
129
130 NamNetwork instproc edgePos {src dest} {
131 return [$self set edge_pos_($src,$dest)]
132 }
133
134
135 NamNetwork instproc setPktHt {src dest pktHt} {
136 $self set edges_pktHt($src,$dest) $pktHt
137 }
138
139 NamNetwork instproc pktHt {src dest} {
140 return [$self set edges_pktHt($src,$dest)]
141 }
142
143 NamNetwork instproc adjNodes {nId} {
144 $self instvar edges_
145 set neighbors ""
146 foreach pair [array names edges_ "$nId,*"] {
147 lappend neighbors [lindex [split $pair ","] 1]
148 }
149 return $neighbors
150 }
151
152 NamNetwork instproc queue {args} {
153 # puts stderr "TODO: implement queue!"
154 }
155
156 NamNetwork instproc setNodePos {node pos} {
157 $self set nodes_(pos,$node) $pos
158 }
159
160 NamNetwork instproc nodePos {node} {
161 return [$self set nodes_(pos,$node)]
162 }
163
164 NamNetwork instproc nodePlaced {node} {
165 $self instvar nodes_
166 return [info exists nodes_(pos,$node)]
167 }
168
169 NamNetwork instproc setNodeSize {nId size} {
170 # DbgOut node $nId size is $size
171 $self set nodes_(size,$nId) $size
172 }
173
174 NamNetwork instproc nodeSize {nId} {
175 $self set nodes_(size,$nId)
176 }
177
178 NamNetwork instproc layout {} {
179 $self instvar nodes_ edges_ nodeIds_ bbox_
180
181 $self scale_estimate
182 $self setNodePos [lindex $nodeIds_ 0] {0.0 0.0}
183 while 1 {
184 set did_something 0
185 foreach nId $nodeIds_ {
186 set did_something [expr $did_something | \
187 [$self traverse $nId]]
188 }
189 if {$did_something == 0} break
190 }
191
192 foreach nId $nodeIds_ {
193 foreach neighbor [$self adjNodes $nId] {
194 $self placeEdge $nId $neighbor
195 }
196 }
197
198 }
199
200 NamNetwork instproc placeEdge {src dest} {
201 $self instvar edge_pos_
202 if {![info exist edge_pos_($src,$dest)]} {
203 set angle [$self edgeAngle $src $dest]
204 set s [expr sin($angle)]
205 if {[expr abs($angle - 3.14159) < 0.00001]} {
206 set c -1.0
207 } elseif {[expr abs($angle) < 0.00001]} {
208 set c 1.0
209 } else {
210 set c [expr cos($angle)]
211 }
212 set nsin [ expr 0.75 * $s ]
213 set ncos [ expr 0.75 * $c ]
214 set srcPos [$self nodePos $src]
215 set dstPos [$self nodePos $dest]
216 set srcSize [$self nodeSize $src]
217 set destSize [$self nodeSize $dest]
218 set x0 [expr [lindex $srcPos 0] + $srcSize * $ncos]
219 set y0 [expr [lindex $srcPos 1] + $srcSize * $nsin]
220 set x1 [expr [lindex $dstPos 0] - $destSize * $ncos]
221 set y1 [expr [lindex $dstPos 1] - $destSize * $nsin]
222 # place the queues here later
223 $self setEdgePos $src $dest $x0 $y0 $x1 $y1
224 }
225 }
226
227 #
228 # move {x y} using a vector in polar co-ordinates
229 # {$angle, displacement ($disp)}
230 #
231 NamNetwork instproc move { pos angle disp } {
232 set x [lindex $pos 0]
233 set y [lindex $pos 1]
234 return [list [expr $x + ($disp * cos($angle))] \
235 [expr $y + ($disp * sin($angle))] ]
236 }
237
238 #
239 # Traverse node n's neighbors and place them based on the
240 # delay of their links to n. The two branches of the if..else
241 # are to handle unidirectional links -- we place ourselves if
242 # we haven't been placed & our downstream neighbor has.
243 #
244 NamNetwork instproc traverse {node} {
245 $self instvar edges_
246
247 set did_something 0
248 foreach n [$self adjNodes $node] {
249 lappend edges [list $node $n]
250 }
251
252 set nodes $node
253 # DbgOut "edges:$edges"
254 while {1} {
255 if {[llength $edges]==0} {
256 break
257 }
258 set edge [removeFirst edges]
259 # DbgOut traversing edge: ($edge = [$edge src] \
260 # [$edge dest] angle: \
261 # [expr [$edge get_angle]/3.1415926]
262 set node [lindex $edge 0]
263 set neighbor [lindex $edge 1]
264
265 # DbgOut "neighbor: [$neighbor get_id]"
266
267 if {[$self nodePlaced $node] && [$self nodePlaced $neighbor]} {
268 continue
269 }
270
271 # one of the nodes is not placed
272 # 0.75 is to allow space for the nodes themselves
273 set d [expr [$self edgeDelay $node $neighbor] + \
274 (0.75 * ([$self nodeSize $neighbor] + \
275 [$self nodeSize $node]))]
276 if [$self nodePlaced $neighbor] {
277 set place [$self move \
278 [$self nodePos $neighbor] \
279 [$self edgeAngle $node $neighbor] \
280 [expr -1 * $d]]
281 $self setNodePos $node $place
282 set did_something 1
283 } elseif [$self nodePlaced $node] {
284 set place [$self move \
285 [$self nodePos $node] \
286 [$self edgeAngle $node $neighbor] $d]
287 $self setNodePos $neighbor $place
288
289 # Note: we doing breadth first search here instead of
290 # depth first as in the original NAM
291 foreach nn [$self adjNodes $neighbor] {
292 lappend edges [list $neighbor $nn]
293 }
294 # REVIEW: compute nymax_ and nymin_ (see orig NAM) ??
295 } else {
296 error "check the algorithm ($node,$neighbor)"
297 }
298 }
299 return $did_something
300 }
301
302 #
303 # Compute reasonable defaults for missing node or edge sizes
304 # based on the maximum link delay.
305 #
306 NamNetwork instproc scale_estimate {} {
307 $self instvar nodes_ edges_ nodeIds_
308 # Determine the maximum link delay
309 set max 0.0
310 foreach nodeId $nodeIds_ {
311 foreach n [$self adjNodes $nodeId] {
312 if {[$self edgeDelay $nodeId $n] > $max} {
313 set max [$self edgeDelay $nodeId $n]
314 }
315 }
316 }
317 # DbgVar max
318
319 # Check for missing node or edge sizes. If any are found,
320 # compute a reasonable default based on the maximum edge
321 # dimension.
322
323 foreach node $nodeIds_ {
324 if {[$self nodeSize $node] <= 0} {
325 # DbgOut Setting node $node to size [expr $max * 0.1]
326 $self setNodeSize $node [expr $max * 0.1]
327 }
328 foreach n [$self adjNodes $node] {
329 $self setPktHt $node $n [expr $max * 0.03]
330 }
331 }
332 }
333
334 NamNetwork instproc color {index color} {
335 $self instvar colors_
336 set colors_($index) $color
337 }
338
339 NamNetwork instproc get_color {colorindex} {
340 $self instvar colors_
341 if [info exists colors_($colorindex)] {
342 return $colors_($colorindex)
343 } else {
344 return black
345 }
346 }
347
348
349
350 #--------------------------------------------------------------------------
351 # Helper functions for nam, used to be backward compatible with
352 # the standalone NAM
353 #
354
355 #
356 # helper functions
357 #
358 proc nam_angle { v } {
359 switch $v {
360 up-right -
361 right-up { return 0.25 }
362 up { return 0.5 }
363 up-left -
364 left-up { return 0.75 }
365 left { return 1. }
366 left-down -
367 down-left { return 1.25 }
368 down { return 1.5 }
369 down-right -
370 right-down { return 1.75 }
371 default { return 0.0 }
372 }
373 }
374
375 if 0 {
376 NamNetwork set scales_ {m u k M}
377 NamNetwork set uscale_(m) 1e-3
378 NamNetwork set uscale_(u) 1e-6
379 NamNetwork set uscale_(k) 1e3
380 NamNetwork set uscale_(M) 1e6
381 }
382
383 NamNetwork array set scales_ {
384 m 1e-3
385 u 1e-6
386 k 1e3
387 M 1e6
388 }
389
390 proc time2real {v} {
391 foreach u [NamNetwork array names scales_] {
392 set k [string first $u $v]
393 if { $k >= 0 } {
394 set scale [NamNetwork set scales_($u)]
395 break
396 }
397 }
398 if { $k > 0 } {
399 set v [string range $v 0 [expr $k - 1]]
400 set v [expr $scale * $v]
401 }
402 return $v
403 }
404
405 #FIXME
406 proc bw2real {v} {
407 return [time2real $v]
408 }
409
410 proc mklink { net n0 n1 bandwidth delay angle } {
411 global delay01
412 set th [nam_angle $angle]
413 set result [$net new_link $n0 $n1 \
414 [bw2real $bandwidth] [time2real $delay] $th]
415 $net new_link $n1 $n0 \
416 [bw2real $bandwidth] [time2real $delay] [expr $th + 1]
417 if { $n0 == 0 && $n1 == 1 } {
418 set delay01 $result
419 }
420 }
421
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.