ns-lib.tcl

NS-2.28的802.11e协议扩展源代码

                        } else {
                                set c [lindex $args 0]
                        }
                        set link_($sid:$did) [new CBQLink       \
                                        $n1 $n2 $bw $delay $q $c]
                }
		FQ      {
			set link_($sid:$did) [new FQLink $n1 $n2 $bw $delay $q]
		}
                intserv {
                        #XX need to clean this up
                        set link_($sid:$did) [new IntServLink   \
                                        $n1 $n2 $bw $delay $q	\
						[concat $qtypeOrig $args]]
                }
                default {
                        set link_($sid:$did) [new SimpleLink    \
                                        $n1 $n2 $bw $delay $q]
                }
        }
	$n1 add-neighbor $n2
	
	#XXX yuck
	if {[string first "RED" $qtype] != -1} {
		$q link [$link_($sid:$did) set link_]
	}

        #XXX Yun Wang
        if {[string first "RIO" $qtype] != -1} {
                $q link [$link_($sid:$did) set link_]
        }
	
	set trace [$self get-ns-traceall]
	if {$trace != ""} {
		$self trace-queue $n1 $n2 $trace
	}
	set trace [$self get-nam-traceall]
	if {$trace != ""} {
		$self namtrace-queue $n1 $n2 $trace
	}
	
	# Register this simplex link in nam link list. Treat it as 
	# a duplex link in nam
	$self register-nam-linkconfig $link_($sid:$did)
}

#
# This is used by Link::orient to register/update the order in which links 
# should created in nam. This is important because different creation order
# may result in different layout.
#
# A poor hack. :( Any better ideas?
#
Simulator instproc register-nam-linkconfig link {
    $self instvar linkConfigList_ link_
    if [info exists linkConfigList_] {
	# Check whether the reverse simplex link is registered,
	# if so, don't register this link again.
	# We should have a separate object for duplex link.
	set i1 [[$link src] id]
	set i2 [[$link dst] id]
	if [info exists link_($i2:$i1)] {
	    set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
	    if {$pos >= 0} {
		set a1 [$link_($i2:$i1) get-attribute "ORIENTATION"]
		set a2 [$link get-attribute "ORIENTATION"]
		if {$a1 == "" && $a2 != ""} {
		    # If this duplex link has not been 
		    # assigned an orientation, do it.
		    set linkConfigList_ \
			[lreplace $linkConfigList_ $pos $pos]
		} else {
		    return
		}
	    }
	}

	# Remove $link from list if it's already there
	set pos [lsearch $linkConfigList_ $link]
	if {$pos >= 0} {
	    set linkConfigList_ \
		[lreplace $linkConfigList_ $pos $pos]
	}
    }
    lappend linkConfigList_ $link
}

#
# GT-ITM may occasionally generate duplicate links, so we need this check
# to ensure duplicated links do not appear in nam trace files.
#
Simulator instproc remove-nam-linkconfig {i1 i2} {
	$self instvar linkConfigList_ link_
	if ![info exists linkConfigList_] {
		return
	}
	set pos [lsearch $linkConfigList_ $link_($i1:$i2)]
	if {$pos >= 0} {
		set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
		return
	}
	set pos [lsearch $linkConfigList_ $link_($i2:$i1)]
	if {$pos >= 0} {
		set linkConfigList_ [lreplace $linkConfigList_ $pos $pos]
	}
}

Simulator instproc duplex-link { n1 n2 bw delay type args } {
	$self instvar link_
	set i1 [$n1 id]
	set i2 [$n2 id]
	if [info exists link_($i1:$i2)] {
		$self remove-nam-linkconfig $i1 $i2
	}

	eval $self simplex-link $n1 $n2 $bw $delay $type $args
	eval $self simplex-link $n2 $n1 $bw $delay $type $args
}

Simulator instproc duplex-intserv-link { n1 n2 bw pd sched signal adc args } {
	eval $self duplex-link $n1 $n2 $bw $pd intserv $sched $signal $adc $args
}

Simulator instproc simplex-link-op { n1 n2 op args } {
	$self instvar link_
	eval $link_([$n1 id]:[$n2 id]) $op $args
}

Simulator instproc duplex-link-op { n1 n2 op args } {
	$self instvar link_
	eval $link_([$n1 id]:[$n2 id]) $op $args
	eval $link_([$n2 id]:[$n1 id]) $op $args
}

Simulator instproc flush-trace {} {
	$self instvar alltrace_
	if [info exists alltrace_] {
		foreach trace $alltrace_ {
			$trace flush
		}
	}
}

Simulator instproc namtrace-all file   {
	$self instvar namtraceAllFile_
	if {$file != ""} {
		set namtraceAllFile_ $file
	} else {
		unset namtraceAllFile_
	}

}

Simulator instproc energy-color-change {level1 level2} {
	$self instvar level1_ level2_
 	set level1_ $level1
 	set level2_ $level2
}


Simulator instproc namtrace-all-wireless {file optx opty} {
        $self instvar namtraceAllFile_
        if {$file != ""} {
                set namtraceAllFile_ $file
        } else {
                unset namtraceAllFile_
        }
	if { $optx != "" && $opty != "" } {
            $self puts-nam-config "W -t * -x $optx -y $opty"
	}
}

Simulator instproc nam-end-wireless {stoptime} {
        $self instvar namtraceAllFile_

        if {$namtraceAllFile_ != ""} {
	    $self puts-nam-config "W -t $stoptime"
        }
}

#Simulator instproc initial_node_pos {nodep size} {
#
#          $self puts-nam-config "n -t * -s [$nodep id] \
#           -x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size \
#           -v circle -c black"
#}

Simulator instproc namtrace-some file {
	$self instvar namtraceSomeFile_
	set namtraceSomeFile_ $file
}

Simulator instproc namtrace-all-wireless {file optx opty} {
        $self instvar namtraceAllFile_  
 
        if {$file != ""} { 
                set namtraceAllFile_ $file
        } else {
                unset namtraceAllFile_
        }       
        $self puts-nam-config "W -t * -x $optx -y $opty"
}
        
Simulator instproc initial_node_pos {nodep size} {
    $self instvar addressType_
    $self instvar energyModel_ 

    if [info exists energyModel_] {  
      set nodeColor "green"
    } else {
      set nodeColor "black"
    }

    if { [info exists addressType_] && $addressType_ == "hierarchical" } {

        #hierarchical addressing
        $self puts-nam-config "n -t * -a [$nodep set address_] -s [$nodep id] \
-x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size \
-v circle -c $nodeColor"
    } else { #flat addressing
        $self puts-nam-config "n -t * -s [$nodep id] \
-x [$nodep set X_] -y [$nodep set Y_] -Z [$nodep set Z_] -z $size \
-v circle -c $nodeColor"
    }
}

Simulator instproc trace-all file {
	$self instvar traceAllFile_
	set traceAllFile_ $file
}

Simulator instproc get-nam-traceall {} {
	$self instvar namtraceAllFile_
	if [info exists namtraceAllFile_] {
		return $namtraceAllFile_
	} else {
		return ""
	}
}

Simulator instproc get-ns-traceall {} {
	$self instvar traceAllFile_
	if [info exists traceAllFile_] {
		return $traceAllFile_
	} else {
		return ""
	}
}

# If exists a traceAllFile_, print $str to $traceAllFile_
Simulator instproc puts-ns-traceall { str } {
	$self instvar traceAllFile_
	if [info exists traceAllFile_] {
		puts $traceAllFile_ $str
	}
}

# If exists a traceAllFile_, print $str to $traceAllFile_
Simulator instproc puts-nam-traceall { str } {
	$self instvar namtraceAllFile_
	if [info exists namtraceAllFile_] {
		puts $namtraceAllFile_ $str
	} elseif [info exists namtraceSomeFile_] {
		puts $namtraceSomeFile_ $str
	}
}

# namConfigFile is used for writing color/link/node/queue/annotations. 
# XXX It cannot co-exist with namtraceAll.
Simulator instproc namtrace-config { f } {
	$self instvar namConfigFile_
	set namConfigFile_ $f
}

Simulator instproc get-nam-config {} {
	$self instvar namConfigFile_
	if [info exists namConfigFile_] {
		return $namConfigFile_
	} else {
		return ""
	}
}

# Used only for writing nam configurations to trace file(s). This is different
# from puts-nam-traceall because we may want to separate configuration 
# informations and actual tracing information
Simulator instproc puts-nam-config { str } {
	$self instvar namtraceAllFile_ namConfigFile_
	
	if [info exists namConfigFile_] {
		puts $namConfigFile_ $str
	} elseif [info exists namtraceAllFile_] {
		puts $namtraceAllFile_ $str
	} elseif [info exists namtraceSomeFile_] {
		puts $namtraceSomeFile_ $str
	}
}

Simulator instproc color { id name } {
	$self instvar color_
	set color_($id) $name
}

Simulator instproc get-color { id } {
	$self instvar color_
	return $color_($id)
}

# you can pass in {} as a null file
Simulator instproc create-trace { type file src dst {op ""} } {
	$self instvar alltrace_
	set p [new Trace/$type]
	if [catch {$p set src_ [$src id]}] {
		$p set src_ $src
	}
	if [catch {$p set dst_ [$dst id]}] {
		$p set dst_ $dst
	}
	lappend alltrace_ $p
	if {$file != ""} {
		$p ${op}attach $file		
	}
	return $p
}

Simulator instproc namtrace-queue { n1 n2 {file ""} } {
	$self instvar link_ namtraceAllFile_
	if {$file == ""} {
		if ![info exists namtraceAllFile_] return
		set file $namtraceAllFile_
	}
	$link_([$n1 id]:[$n2 id]) nam-trace $self $file
    
	#added later for queue specific tracing events other than enque, deque and drop 
	#as of now nam does not understand special events. 
	#changes will have to be made to nam for it to understand events 
	#like early drops if they are prefixed differently than "d". - ratul
	set queue [$link_([$n1 id]:[$n2 id]) queue]
	$queue attach-nam-traces $n1 $n2 $file
}

Simulator instproc trace-queue { n1 n2 {file ""} } {
	$self instvar link_ traceAllFile_
	if {$file == ""} {
		if ![info exists traceAllFile_] return
		set file $traceAllFile_
	}
	$link_([$n1 id]:[$n2 id]) trace $self $file
	
	#added later for queue specific tracing events other than enque, deque and drop - ratul
	set queue [$link_([$n1 id]:[$n2 id]) queue]
	$queue attach-traces $n1 $n2 $file
}


#
# arrange for queue length of link between nodes n1 and n2
# to be tracked and return object that can be queried
# to learn average q size etc.  XXX this API still rough
#
Simulator instproc monitor-queue { n1 n2 qtrace { sampleInterval 0.1 } } {
	$self instvar link_
	return [$link_([$n1 id]:[$n2 id]) init-monitor $self $qtrace $sampleInterval]
}

Simulator instproc queue-limit { n1 n2 limit } {
	$self instvar link_
	[$link_([$n1 id]:[$n2 id]) queue] set limit_ $limit
}

Simulator instproc drop-trace { n1 n2 trace } {
	$self instvar link_
	[$link_([$n1 id]:[$n2 id]) queue] drop-target $trace
}

Simulator instproc cost {n1 n2 c} {
	$self instvar link_
	$link_([$n1 id]:[$n2 id]) cost $c
}

Simulator instproc attach-agent { node agent } {
	$node attach $agent
}

Simulator instproc attach-tbf-agent { node agent tbf } {
	$node attach $agent
	$agent attach-tbf $tbf
}


Simulator instproc detach-agent { node agent } {
	$self instvar nullAgent_
	$node detach $agent $nullAgent_
}

#
#   Helper proc for setting delay on an existing link
#
Simulator instproc delay { n1 n2 delay {type simplex} } {
	$self instvar link_
	set sid [$n1 id]
	set did [$n2 id]
	if [info exists link_($sid:$did)] {
		set d [$link_($sid:$did) link]
		$d set delay_ $delay
	}
	if {$type == "duplex"} {
		if [info exists link_($did:$sid)] {
			set d [$link_($did:$sid) link]
			$d set delay_ $delay
		}
	}
}

# 
#   Helper proc for setting bandwidth on an existing link
#
Simulator instproc bandwidth { n1 n2 bandwidth {type simplex} } {
        $self instvar link_
        set sid [$n1 id]
        set did [$n2 id]
        if [info exists link_($sid:$did)] {
                set d [$link_($sid:$did) link]
                $d set bandwidth_ $bandwidth
        } 
        if {$type == "duplex"} {
                if [info exists link_($did:$sid)] {
                        set d [$link_($did:$sid) link]
                        $d set bandwidth_ $bandwidth
                }
        }
}


#XXX need to check that agents are attached to nodes already
Simulator instproc connect {src dst} {
	$self simplex-connect $src $dst
	$self simplex-connect $dst $src
	return $src
}

Simulator instproc simplex-connect { src dst } {
	$src set dst_addr_ [$dst set agent_addr_] 
	$src set dst_port_ [$dst set agent_port_]

        # Polly Huang: to support abstract TCP simulations
        if {[lindex [split [$src info class] "/"] 1] == "AbsTCP"} {
	    $self at [$self now] "$self rtt $src $dst"
	    $dst set class_ [$src set class_]
        }

	return $src
}

#
# Here are a bunch of helper methods.
#


Simulator proc instance {} {
	set ns [Simulator info instances]
	if { $ns != "" } {
		return $ns
	}
	foreach sim [Simulator info subclass] {
		set ns [$sim info instances]
		if { $ns != "" } {
			return $ns
		}
	}
	error "Cannot find instance of simulator"
}

Simulator instproc get-node-by-id id {
	$self instvar Node_
	set Node_($id)
}

Simulator instproc all-nodes-list {} {
	$self instvar Node_
	set nodes ""
	foreach n [array names Node_] {
		lappend nodes $Node_($n)
	}
	set nodes
}

Simulator instproc link { n1 n2 } {
        $self instvar Node_ link_
        if { ![catch "$n1 info class Node"] } {