ns-lib.tcl

在Linux下做的QuadTree的程序

}

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
	}
}

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

# 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]
	$p set src_ [$src id]
	$p set dst_ [$dst id]
	lappend alltrace_ $p
	if {$file != ""} {
		$p ${op}attach $file		
	}
	return $p
}

Simulator instproc namtrace-queue { n1 n2 file } {
	$self instvar link_
	$link_([$n1 id]:[$n2 id]) nam-trace $self $file
}

Simulator instproc trace-queue { n1 n2 file } {
	$self instvar link_
	$link_([$n1 id]:[$n2 id]) trace $self $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 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 } {
    $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
    }
}




#XXX need to check that agents are attached to nodes already
Simulator instproc connect { src dst } {
	#
	# connect agents (low eight bits of addr are port,
	# high 24 bits are node number)
	#
	set srcNode [$src set node_]
	set dstNode [$dst set node_]
#	$src set dst_ [expr [$dstNode id] << 8 | [$dst port]]
#	$dst set dst_ [expr [$srcNode id] << 8 | [$src port]]

	$src set dst_ [$dstNode id] 
	$src set dport_ [$dst port]

	$dst set dst_ [$srcNode id]
	$dst set dport_ [$src port]

	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 link_
    set link_([$n1 id]:[$n2 id])
}

# Creates connection. First creates a source agent of type s_type and binds
# it to source.  Next creates a destination agent of type d_type and binds
# it to dest.  Finally creates bindings for the source and destination agents,
# connects them, and  returns the source agent.
Simulator instproc create-connection {s_type source d_type dest pktClass} {
	set s_agent [new Agent/$s_type]
	set d_agent [new Agent/$d_type]
	$s_agent set fid_ $pktClass
	$d_agent set fid_ $pktClass
	$self attach-agent $source $s_agent
	$self attach-agent $dest $d_agent
	$self connect $s_agent $d_agent
	
	return $s_agent
}

Classifier instproc no-slot slot {
	#XXX should say something better for routing problem
	puts stderr "$self: no target for slot $slot"
	### exit 1
}


#
# Other classifier methods overload the instproc-likes to track 
# and return the installed objects.
#
Classifier instproc install {slot val} {
    $self instvar elements_
    set elements_($val) $slot
    $self cmd install $slot $val
}

Classifier instproc installNext val {
    $self instvar elements_
    set elements_($val) [$self cmd installNext $val]
    return $elements_($val)
}

Classifier instproc adjacents {} {
    $self instvar elements_
    return [array get elements_]
}

#
# To create: multi-access lan, and 
#            links with interface labels
#
Simulator instproc simplex-link-of-interfaces { f1 f2 bw delay type } {
        $self instvar link_ nullAgent_
        set n1 [$f1 getNode]
        set n2 [$f2 getNode]
        set sid [$n1 id]
        set did [$n2 id]
        set q [new Queue/$type]
        $q drop-target $nullAgent_
        set link_($sid:$did) [new SimpleLink $f1 $f2 $bw $delay $q]
        $n1 add-neighbor $n2
}

Simulator instproc duplex-link-of-interfaces { n1 n2 bw delay type {ori ""} {q_clrid 0} } {
        set f1 [new DuplexNetInterface]
        $n1 addInterface $f1
        set f2 [new DuplexNetInterface]
        $n2 addInterface $f2
        $self simplex-link-of-interfaces $f1 $f2 $bw $delay $type
        $self simplex-link-of-interfaces $f2 $f1 $bw $delay $type

	set trace [$self get-ns-traceall]
	if {$trace != ""} {
		$self trace-queue $n1 $n2 $trace
                $self trace-queue $n2 $n1 $trace
	}
	set trace [$self get-nam-traceall]
	if {$trace != ""} {
		$self namtrace-queue $n1 $n2 $trace
                $self namtrace-queue $n2 $n1 $trace
	}

	# nam only has duplex link. We do a registration here because 
	# automatic layout doesn't require calling Link::orient.
	$self instvar link_
	$self register-nam-linkconfig $link_([$n1 id]:[$n2 id])
}

Simulator instproc multi-link { nodes bw delay type } {
	$self instvar link_ 
	# set multiLink [new PhysicalMultiLink $nodes $bw $delay $type]
	set multiLink [new NonReflectingMultiLink $nodes $bw $delay $type]
	# set up dummy links for unicast routing
	foreach n $nodes {
		set q [$multiLink getQueue $n]
		set l [$multiLink getDelay $n]
		set did [$n id]
		foreach n2 $nodes {
			if { [$n2 id] != $did } {
				set sid [$n2 id]
				set dumlink [new DummyLink $n2 $n $q $l]
				set link_($sid:$did) $dumlink
				$dumlink setContainingObject $multiLink
				set trace [$self get-ns-traceall]
				if {$trace != ""} {
					$self trace-queue $n2 $n $trace
				}
				set trace [$self get-nam-traceall]
				if {$trace != ""} {
					$self namtrace-queue $n2 $n $trace
				}
			}
		}
	}
}

Simulator instproc multi-link-of-interfaces { nodes bw delay type } {
        $self instvar link_ 
        
        # create the interfaces
        set ifs ""
        foreach n $nodes {
                set f [new DuplexNetInterface]
                $n addInterface $f
                lappend ifs $f
        }
        set multiLink [new NonReflectingMultiLink $ifs $bw $delay $type]
        # set up dummy links for unicast routing
        foreach f $ifs {
                set n [$f getNode]
                set q [$multiLink getQueue $n]
                set l [$multiLink getDelay $n]  
                set did [$n id]
                foreach f2 $ifs {
                        set n2 [$f2 getNode]
                        if { [$n2 id] != $did } {
				set sid [$n2 id]   
				set dumlink [new DummyLink $f2 $f $q $l $multiLink]
				set link_($sid:$did) $dumlink

				set trace [$self get-ns-traceall]
				if {$trace != "" } {
					$self trace-queue $n2 $n $trace
				}
				set trace [$self get-nam-traceall]
				if {$trace != ""} {
				   $self namtrace-queue $n2 $n $trace
				}
                        }
                }
        }
        return $multiLink
}

Simulator instproc getlink { id1 id2 } {
        $self instvar link_
        if [info exists link_($id1:$id2)] {
                return $link_($id1:$id2)
        }
        return -1
}

Simulator instproc makeflowmon { cltype { clslots 29 } } {

	set flowmon [new QueueMonitor/ED/Flowmon]
        set cl [new Classifier/Hash/$cltype $clslots]

        $cl proc unknown-flow { src dst fid hashbucket }  {
                set fdesc [new QueueMonitor/ED/Flow]
		set dsamp [new Samples]
		$fdesc set-delay-samples $dsamp
                set slot [$self installNext $fdesc] 
                $self set-hash $hashbucket $src $dst $fid $slot
	}

	$cl proc no-slot slotnum {
		#
		# note: we can wind up here when a packet passes
		# through either an Out or a Drop Snoop Queue for
		# a queue that the flow doesn't belong to anymore.
		# Since there is no longer hash state in the
		# hash classifier, we get a -1 return value for the
		# hash classifier's classify() function, and there
		# is no node at slot_[-1].  What to do about this?
		# Well, we are talking about flows that have already
		# been moved and so should rightly have their stats
		# zero'd anyhow, so for now just ignore this case..
		# puts "classifier $self, no-slot for slotnum $slotnum"
	}
        $flowmon classifier $cl
        return $flowmon
}

# attach a flow monitor to a link
# 3rd argument dictates whether early drop support is to be used

Simulator instproc attach-fmon {lnk fm { edrop 0 } } {
    set isnoop [new SnoopQueue/In]
    set osnoop [new SnoopQueue/Out]
    set dsnoop [new SnoopQueue/Drop]
    $lnk attach-monitors $isnoop $osnoop $dsnoop $fm
    if { $edrop != 0 } {
	    set edsnoop [new SnoopQueue/EDrop]
	    $edsnoop set-monitor $fm
	    [$lnk queue] early-drop-target $edsnoop
	    $edsnoop target [$self set nullAgent_]
    }
    [$lnk queue] drop-target $dsnoop
}

# Imported from session.tcl. It is deleted there.
### to insert loss module to regular links in detailed Simulator
Simulator instproc lossmodel {lossobj from to} {
    set link [$self link $from $to]
    set head [$link head]
    # puts "[[$head target] info class]"
    $lossobj target [$head target]
    $head target $lossobj
    # puts "[[$head target] info class]"
}