All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

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