Commit f3d80e1d authored by Christopher Alfeld's avatar Christopher Alfeld

Added in all vtype code. tb-make-soft-vtype, tb-make-hard-vtype,

tb-make-weighted-vtype.
parent d55a2b0e
......@@ -9,7 +9,7 @@ SUBDIR = tbsetup/ns2ir
include $(OBJDIR)/Makeconf
LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
nsobject.tcl traffic.tcl
nsobject.tcl traffic.tcl vtype.tcl
LIBEXEC_STUFF = parse.tcl
#
......
......@@ -69,6 +69,7 @@ namespace eval GLOBALS {
variable verbose 1
variable impotent 0
variable anonymous 0
variable vtype_list {}
}
while {$argv != {}} {
......@@ -155,6 +156,7 @@ source ${GLOBALS::libdir}/lanlink.tcl
source ${GLOBALS::libdir}/node.tcl
source ${GLOBALS::libdir}/null.tcl
source ${GLOBALS::libdir}/traffic.tcl
source ${GLOBALS::libdir}/vtype.tcl
##################################################
# Redifing Assignment
......
......@@ -148,6 +148,7 @@ Simulator instproc run {} {
var_import ::GLOBALS::ran
var_import ::GLOBALS::DB
var_import ::GLOBALS::impotent
var_import ::GLOBALS::vtypes
# Fill out IPs
foreach obj [concat [array names lanlink_list]] {
......@@ -189,6 +190,9 @@ Simulator instproc run {} {
foreach lan [concat [array names lanlink_list]] {
$lan updatedb $DB
}
foreach vtype [array names vtypes] {
$vtype updatedb $DB
}
}
# attach-agent <node> <agent>
......
......@@ -14,7 +14,13 @@ namespace eval TBCOMPAT {
# This is an RE to match a floating point number.
variable FLOAT {(^[0-9]+(\.[0-9]+)?$)|(^\.[0-9]+$)}
# This is the default weight for a soft vtype.
variable default_soft_vtype_weight 0.5
# This is the default weight for a hard vtype.
variable default_hard_vtype_weight 1.0
# This is a general procedure that takes a node, an object (lan or link)
# it is connected to, and an IP address, and sets the IP address
# for the node on that object. It checks both the validity of the
......@@ -99,7 +105,9 @@ proc tb-set-ip-link {src link ip} {
# Node state routines.
proc tb-set-hardware {node type args} {
var_import ::TBCOMPAT::hwtypes
if {! [info exists hwtypes($type)]} {
var_import ::GLOBALS::vtypes
if {(! [info exists hwtypes($type)]) &&
(! [info exists vtypes($type)])} {
perror "\[tb-set-hardware] Invalid hardware type $type."
return
}
......@@ -292,3 +300,45 @@ proc tb-fix-node {vnode pnode} {
$vnode set fixed $pnode
}
proc tb-make-soft-vtype {name types} {
var_import ::TBCOMPAT::hwtypes
var_import ::GLOBALS::vtypes
var_import ::TBCOMPAT::default_soft_vtype_weight
foreach type $types {
if {! [info exists hwtypes($type)]} {
perror "\[tb-make-soft-vtype] Invalid hardware type $type."
}
}
set vtypes($name) [Vtype $name $default_soft_vtype_weight $types]
}
proc tb-make-hard-vtype {name types} {
var_import ::TBCOMPAT::hwtypes
var_import ::GLOBALS::vtypes
var_import ::TBCOMPAT::default_hard_vtype_weight
foreach type $types {
if {! [info exists hwtypes($type)]} {
perror "\[tb-make-hard-vtype] Invalid hardware type $type."
}
}
set vtypes($name) [Vtype $name $default_hard_vtype_weight $types]
}
proc tb-make-weighted-vtype {name weight types} {
var_import ::TBCOMPAT::hwtypes
var_import ::GLOBALS::vtypes
var_import ::TBCOMPAT::FLOAT
foreach type $types {
if {! [info exists hwtypes($type)]} {
perror "\[tb-make-hard-vtype] Invalid hardware type $type."
}
}
if {([regexp $FLOAT $weight] == 0) ||
($weight <= 0) || ($weight >= 1.0)} {
perror "\[tb-make-weighted-vtype] $weight is not a valid weight. (0 < weight < 1)."
}
set vtypes($name) [Vtype $name $weight $types]
}
\ No newline at end of file
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