Commit e9b8c412 authored by Christopher Alfeld's avatar Christopher Alfeld

Serious restructuring of parsing.

This makes variable dereferencing work as expected.  So:

        for {set i 1} {$i <= 8} {incr i} {
            set c($i) [$ns node]
            tb-set-node-cmdline $c($i) "BATCH=1 DST_NAME=$c($i)"
        }

will now expand $c($i) to correctly to c-$i.  Similarly:

set node1 [$ns node]
puts "First node is $node1"

will output:

First node is node1.

Caveat: It assumes that every node and lan will be stored in a
variable.  So doing something like:

$ns duplex-link [$ns node] [$ns node] 100Mb 150ms DroPTail

while in theory valid and sensible, won't work.

A clean rewrite of the parsing stuff is probably something I should do
soon.  It needs it to do all the variable munging correctly.
parent 33144107
......@@ -4,7 +4,7 @@ Class lan
# output format: <id> "<nodes>" <delay> <bw>
lan instproc print {file} {
global nodeid_map prefix
global nodeid_map prefix rid_map
if {[info exists nodeid_map(lan[$self set id])]} {
set lanname $nodeid_map(lan[$self set id])
......@@ -15,8 +15,8 @@ lan instproc print {file} {
puts -nonewline $file "$prefix-$lanname \""
set lastnode [lindex [$self set nodes] end]
foreach node [$self set nodes] {
if {[info exists nodeid_map(n[$node set id])]} {
set nodename $nodeid_map(n[$node set id])
if {[info exists nodeid_map(n[$rid_map($node) set id])]} {
set nodename $nodeid_map(n[$rid_map($node) set id])
} else {
set nodename n[$self set id]
}
......
......@@ -32,8 +32,8 @@ node instproc print {file} {
#add link
node instproc addlink {link} {
$self instvar nodelinks
lappend nodelinks $link
$self instvar nodelinks
lappend nodelinks $link
}
#getLan/setLan
......
......@@ -28,6 +28,7 @@ real_set skipset 0
proc set {args} {
global skipset
global nodeid_map
global rid_map
if {! $skipset} {
real_set skipset 1
real_set var [lindex $args 0]
......@@ -39,11 +40,20 @@ proc set {args} {
regsub -all {[)]} $var {} out
real_set var $out
real_set val [lindex $args 1]
if {([regexp {^n[0-9]+$} $val] != -1) ||
([regexp {^lan[0-9]+$} $val] != -1) ||
([regexp {^l[0-9]+$} $val] != -1)} {
if {![info exists nodeid_map($val)]} {
if {([regexp {^n[0-9]+$} $val] != 0) ||
([regexp {^lan[0-9]+$} $val] != 0) ||
([regexp {^l[0-9]+$} $val] != 0)} {
# Ok, we change it so that the variable will hold
# it's own name. We still need nodeid_map for
# classes to find their names. rid_map is the
# reverse mapping of nodeid_map
# XXX - might be cleaner to have a class variable
# that we set here instead of using the nodeid_map.
if {([llength $args] == 2) &&
(![info exists nodeid_map($val)])} {
real_set nodeid_map($val) $var
real_set rid_map($var) $val
real_set args [list [lindex $args 0] $var]
}
}
}
......
......@@ -35,7 +35,7 @@
# SUCH DAMAGE.
#
# @(#) $Header: /home/cvs_mirrors/cvs-public.flux.utah.edu/CVS/testbed/tbsetup/ns2ir/Attic/sim.tcl,v 1.7 2001-03-14 21:06:40 calfeld Exp $
# @(#) $Header: /home/cvs_mirrors/cvs-public.flux.utah.edu/CVS/testbed/tbsetup/ns2ir/Attic/sim.tcl,v 1.8 2001-04-11 16:54:14 calfeld Exp $
#
......@@ -227,8 +227,7 @@ Simulator instproc clearMemTrace {} {
}
Simulator instproc simplex-link { n1 n2 bw delay qtype args } {
$self duplex-link $n1 $n2 $bw $delay $qtype $args
$self duplex-link $id_map$n1 $n2 $bw $delay $qtype $args
}
#
......@@ -253,6 +252,7 @@ Simulator instproc duplex-link { n1 n2 bw delay type args } {
global linkslist
global nodeID
global linkmap
global rid_map
# if there are delay or bandwidth restrictions, add a delay node
# and link to it
......@@ -274,8 +274,8 @@ Simulator instproc duplex-link { n1 n2 bw delay type args } {
$currLink set bw $bw
$currLink set id $linkID
$n1 addlink $currLink
$n2 addlink $currLink
$rid_map($n1) addlink $currLink
$rid_map($n2) addlink $currLink
incr linkID
......@@ -507,10 +507,11 @@ Simulator instproc bw_parse { bspec } {
{chanType Channel}
{phyType Phy/WiredPhy}} {
global lanlist
global lanID
global lanID
global rid_map
foreach node $nodelist {
if {[$node getLan] != {}} {
if {[$rid_map($node) getLan] != {}} {
throw "$node already in a LAN!"
}
}
......@@ -523,7 +524,7 @@ Simulator instproc bw_parse { bspec } {
$currlan set id $lanID
foreach node $nodelist {
$node setLan $currlan
$rid_map($node) setLan $currlan
}
lappend lanlist $currlan
......
......@@ -8,19 +8,15 @@ if {[catch "open tbcmds w" TBCMD]} {
}
proc tb-set-ip {node ip} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-ip $nodeid_map($node) $ip"
global TBCMD
puts $TBCMD "tb-set-ip $node $ip"
}
proc tb-set-ip-interface {src dst ip} {
global TBCMD nodeid_map
global TBCMD
global linkmap prefix lanlist
if {[info exists linkmap($src:$dst)]} {
if {[info exists nodeid_map($linkmap($src:$dst))]} {
real_set linkname $nodeid_map($linkmap($src:$dst))
} else {
real_set linkname $linkmap($src:$dst)
}
puts $TBCMD "tb-set-ip-link $nodeid_map($src) $prefix-$linkname $ip"
real_set linkname $linkmap($src:$dst)
puts $TBCMD "tb-set-ip-link $src $prefix-$linkname $ip"
} elseif {([lsearch $lanlist $dst] != -1)} {
tb-set-ip-lan $src $dst $ip
} else {
......@@ -29,38 +25,34 @@ proc tb-set-ip-interface {src dst ip} {
}
}
proc tb-set-ip-lan {src lan ip} {
global TBCMD nodeid_map
global TBCMD
global prefix
puts $TBCMD "tb-set-ip-lan $nodeid_map($src) $prefix-$nodeid_map($lan) $ip"
puts $TBCMD "tb-set-ip-lan $src $prefix-$lan $ip"
}
proc tb-set-ip-link {src link ip} {
global TBCMD nodeid_map prefix
puts $TBCMD "tb-set-ip-link $nodeid_map($src) $prefix-$nodeid_map($link) $ip"
global TBCMD prefix
puts $TBCMD "tb-set-ip-link $src) $prefix-$link $ip"
}
proc tb-set-hardware {node type args} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-hardware $nodeid_map($node) $type $args"
global TBCMD
puts $TBCMD "tb-set-hardware $node $type $args"
}
proc tb-set-node-os {node os} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-node-os $nodeid_map($node) $os"
global TBCMD
puts $TBCMD "tb-set-node-os $node $os"
}
proc tb-create-os {label path partition} {
global TBCMD nodeid_map
global TBCMD
puts $TBCMD "tb-create-os $label $path $partition"
}
proc tb-set-link-loss {srclink args} {
global TBCMD nodeid_map
global TBCMD
global linkmap prefix
if {[llength $args] == 2} {
set dst [lindex $args 0]
set loss [lindex $args 1]
if {[info exists linkmap($srclink:$dst)]} {
if {[info exists nodeid_map($linkmap($srclink:$dst))]} {
real_set linkname $nodeid_map($linkmap($srclink:$dst))
} else {
real_set linkname $linkmap($srclink:$dst)
}
real_set linkname $linkmap($srclink:$dst)
puts $TBCMD "tb-set-link-loss $prefix-$linkname $loss"
} else {
puts stderr "No link between $srclink and $dst."
......@@ -68,31 +60,31 @@ proc tb-set-link-loss {srclink args} {
}
} elseif {[llength $args] == 1} {
set loss [lindex $args 0]
puts $TBCMD "tb-set-link-loss $prefix-$nodeid_map($srclink) $loss"
puts $TBCMD "tb-set-link-loss $prefix-$srclink $loss"
} else {
puts stderr "tb-set-link-loss takes 2 or 3 parameters."
exit 1
}
}
proc tb-set-lan-loss {lan rate} {
global TBCMD nodeid_map prefix
puts $TBCMD "tb-set-lan-loss $prefix-$nodeid_map($lan) $rate"
global TBCMD prefix
puts $TBCMD "tb-set-lan-loss $prefix-$lan $rate"
}
proc tb-set-node-cmdline {node cmdline} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-node-cmdline $nodeid_map($node) $cmdline"
global TBCMD
puts $TBCMD "tb-set-node-cmdline $node $cmdline"
}
proc tb-set-node-rpms {node args} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-node-rpms $nodeid_map($node) $args"
global TBCMD
puts $TBCMD "tb-set-node-rpms $node $args"
}
proc tb-set-node-startup {node cmd} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-node-startup $nodeid_map($node) $cmd"
global TBCMD
puts $TBCMD "tb-set-node-startup $node $cmd"
}
proc tb-set-node-deltas {node args} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-node-deltas $nodeid_map($node) $args"
global TBCMD
puts $TBCMD "tb-set-node-deltas $node $args"
}
# Show that we have loaded
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment