session.tcl

跑leach需要的

		} else {
			$r reset $srcID $dstID
		}
	}
	$r compute
}

SessionSim instproc compute-hier-routes {} {
        $self instvar bw_
        set r [$self get-routelogic]
        #
        # send hierarchical data :
        # array of cluster size, #clusters, #domains
        # assuming 3 levels of hierarchy --> this should be extended to
	# support
        # n-levels of hierarchy
        #
        # puts "Computing Hierarchical routes\n"
        set level [AddrParams hlevel]
        $r hlevel-is $level
        $self hier-topo $r

        foreach ln [array names bw_] {
                set L [split $ln :]
                set srcID [[$self get-node-by-id [lindex $L 0]] node-addr]
                set dstID [[$self get-node-by-id [lindex $L 1]] node-addr]
                if { $bw_($ln) != 0 } {
#                        $r hier-insert $srcID $dstID $bw_($ln)
                        $r hier-insert $srcID $dstID
                } else {
                        $r hier-reset $srcID $dstID
                }
        }       
        $r hier-compute
}

SessionSim instproc compute-algo-routes {} {
    set r [$self get-routelogic]
    
    # puts "Computing algorithmic routes"

    $r BFS
    $r compute
}

### Route length analysis helper function
SessionSim instproc dump-routelogic-distance {} {
	$self instvar routingTable_ sessionNode_ bw_
	if ![info exists routingTable_] {
	    puts "error: routing table is not computed yet!"
	    return 0
	}

	# puts "Dumping Routing Table: Distance Information"
	set n [Node set nn_]
	set i 0
	puts -nonewline "\t"
	while { $i < $n } {
	    if ![info exists sessionNode_($i)] {
		incr i
		continue
	    }
	    puts -nonewline "$i\t"
	    incr i
	}

	set i 0
	while { $i < $n } {
		if ![info exists sessionNode_($i)] {
		    incr i
		    continue
		}
		puts -nonewline "\n$i\t"
		set n1 $sessionNode_($i)
		set j 0
		while { $j < $n } {
			if { $i != $j } {
				set nh [$routingTable_ lookup $i $j]
				if { $nh >= 0 } {
				    set distance 0
				    set tmpfrom $i
				    set tmpto $j
				    while {$tmpfrom != $tmpto} {
					set tmpnext [$routingTable_ lookup $tmpfrom $tmpto]
					set distance [expr $distance + 1]
					set tmpfrom $tmpnext
				    }
				    puts -nonewline "$distance\t"
				} else {
				    puts -nonewline "0\t"
				}
			} else {
			    puts -nonewline "0\t"
			}
			incr j
		}
		incr i
	}
	puts ""
}

### SessionSim instproc run
SessionSim instproc run args {
        $self rtmodel-configure                 ;# in case there are any
        [$self get-routelogic] configure
	$self instvar scheduler_ sessionNode_ started_

	set started_ 1

	#
	# Reset every node, which resets every agent
	#
	foreach nn [array names sessionNode_] {
		$sessionNode_($nn) reset
	}

	if {[SessionSim set MixMode_]} {
	    foreach nn [array names Node_] {
		$Node_($nn) reset
	    }
	}

	# We don't have queues in SessionSim
	$self dump-namcolors
	$self dump-namnodes
	$self dump-namlinks
	$self dump-namagents

        return [$scheduler_ run]
}

# Debugging mcast tree function; Contributed by Haobo Yu
# Get multicast tree in session simulator: By assembling individual 
# (receiver, sender) paths into a SPT.
# src is a Node.
SessionSim instproc get-mcast-tree { src grp } {
	$self instvar treeLinks_ session_

	if [info exists treeLinks_] {
		unset treeLinks_
	}

	set sid [$src id] 

	# get member list
	foreach idx [array names session_] {
		set tri [split $idx :]
		if {[lindex $tri 0] == $sid && [lindex $tri 1] == $grp} {
			set mbrs [$session_($idx) list-mbr]
			break
		}
	}		

	foreach mbr $mbrs {
		# Find path from $mbr to $src
		while {![string match "Agent*" [$mbr info class]]} {
			# In case agent is at the end of the chain... 
			set mbr [$mbr target]
		}
		set mid [[$mbr set node_] id]
		if {$sid == $mid} {
			continue
		}
		# get paths for each individual member
		$self merge-path $sid $mid
	}

	# generating tree link list
	foreach lnk [array names treeLinks_] {
		lappend res $lnk $treeLinks_($lnk)
	}
	return $res
}

# Merge the path from mbr to src
# src is node id.
SessionSim instproc merge-path { src mbr } {
	$self instvar routingTable_ treeLinks_ bw_

	# get paths from mbr to src and merge into treeLinks_
	set tmp $mbr
	while {$tmp != $src} {
		set nxt [$routingTable_ lookup $tmp $src]
		# XXX 
		# Assume routingTable lookup is always successful, so 
		#   don't validate existence of bw_($tid:$sid)
		# Always arrange tree links in (parent, child).
		if ![info exists treeLinks_($nxt:$tmp)] {
			set treeLinks_($nxt:$tmp) $bw_($nxt:$tmp)
		}
		if [info exists treeLinks_($tmp:$nxt)] {
			error "Reverse links in a SPT!"
		}
		set tmp $nxt
	}
}

SessionSim instproc get-node-by-id id {
	$self instvar sessionNode_ Node_
    if [info exists Node_($id)] {
	set Node_($id)
    } else {
	set sessionNode_($id)
    }
}

SessionSim instproc get-node-id-by-addr address {
        $self instvar sessionNode_
        set n [Node set nn_]
        for {set q 0} {$q < $n} {incr q} {
                set nq $sessionNode_($q)
                if {[string compare [$nq node-addr] $address] == 0} {
                        return $q
                }
        }
        error "get-node-id-by-addr:Cannot find node with given address"
}

############## SessionNode ##############
Class SessionNode -superclass Node
SessionNode instproc init args {
    $self instvar id_ np_ address_
    set id_ [Node getid]
    set np_ 0
    if {[llength $args] > 0} {
	set address_ $args
    } else {
        set address_ $id_
    }
}

SessionNode instproc id {} {
    $self instvar id_
    return $id_
}

SessionNode instproc reset {} {
}

SessionNode instproc alloc-port {} {
    $self instvar np_
    set p $np_
    incr np_
    return $p
}

SessionNode instproc attach agent {
	$self instvar id_ address_
	$agent set node_ $self
	set port [$self alloc-port]
	$agent set agent_addr_ [AddrParams addr2id $address_]
	$agent set agent_port_ $port
}

SessionNode instproc join-group { rcvAgent group } {
    set group [expr $group]
    if {[SessionSim set MixMode_]} {
	[Simulator instance] join-intermediate-session $rcvAgent $group
    } else {
	[Simulator instance] join-group $rcvAgent $group
    }
}

SessionNode instproc leave-group { rcvAgent group } {
    set group [expr $group]
    [Simulator instance] leave-group $rcvAgent $group
}


Agent/LossMonitor instproc show-delay { seqno delay } {
    $self instvar node_

    puts "[$node_ id] $seqno $delay"
}

####################### Mix Mode Stuff ##################################
### Create a session helper that does not associates with a src agent ###
### I.e., Create an intermediate session for mix mode operation       ###
### Return the obj to perform detailed join                           ###


SessionSim instproc RPF-link { src from to } {
	$self instvar routingTable_ link_
	#
	# If this link is on the RPF tree, return the link object.
	#
        if [info exists routingTable_] {
	    set tmp $to
	    while {$tmp != $src} {
		set reverse [$routingTable_ lookup $tmp $src]
		if [info exists link_($reverse:$tmp)] {
		    return $link_($reverse:$tmp)
		}
		set tmp $reverse
	    }
	}
	return ""
}

SessionSim instproc detailed-link? { from to } {
    $self instvar link_
    
    return [info exist link_($from:$to)]
}

SessionSim instproc create-intermediate-session { src group nid } {
    $self instvar session_

    set session_($src:$group:$nid) [new SessionHelper]
    $session_($src:$group:$nid) set-node $nid
	
    if {[SessionSim set rc_]} {
	$session_($src:$group:$nid) set rc_ 1
    }

    # If exists nam-traceall, we'll insert an intermediate trace object
    set trace [$self get-nam-traceall]
    if {$trace != ""} {
	# This will write every packet sent and received to 
	# the nam trace file
	set p [$self create-trace SessEnque $trace $nid $dst "nam"]
	$p target $session_($src:$group:$nid)
	return $p
    } else {
	return $session_($src:$group:$nid)
    }

}

SessionSim instproc join-intermediate-session { rcvAgent group } {
    $self instvar session_ routingTable_ delay_ bw_ link_ Node_ dlist_

    foreach index [array names session_] {
	set tri [split $index :]
	set src [lindex $tri 0]
	set grp [lindex $tri 1]
	set owner [lindex $tri 2]
	if {$grp == $group && $src == $owner} {
	    set session_area 1
	    set dst [[$rcvAgent set node_] id]
	    set delay 0
	    set accu_bw 0
	    set ttl 0
	    set tmp $dst
	    while {$tmp != $src} {
		set next [$routingTable_ lookup $tmp $src]

		# Conditions to perform session/detailed join
		if {$session_area} {
		    if [info exist link_($tmp:$next)] {

			# walking into detailed area from session area
			set session_area 0
			if ![info exist session_($src:$grp:$tmp)] {
			    set inter_session [$self create-intermediate-session $src $grp $tmp]
			} else {
			    set inter_session $session_($src:$grp:$tmp)
			}
			if {![info exist dlist_($src:$grp:$tmp)] || [lsearch $dlist_($src:$grp:$tmp) $rcvAgent] < 0 } {
			    $inter_session add-dst $accu_bw $delay $ttl $dst $rcvAgent
			    $self update-loss-dependency $src $dst $tmp $rcvAgent $group
			    lappend dlist_($src:$grp:$tmp) $rcvAgent
			}
			$Node_($tmp) join-group $inter_session $group
			# puts "s->d: $dst, $rcvAgent, [$rcvAgent info class], join session $inter_session which detailed-joined the group $group, $delay, $accu_bw, $ttl"

		    } else {

			# stay in session area, keep track of accumulative
			# delay, bw, ttl
			set delay [expr $delay + $delay_($tmp:$next)]
			if {$accu_bw} {
			    set accu_bw [expr 1 / (1 / $accu_bw + 1 / $bw_($tmp:$next))]
			} else {
			    set accu_bw $bw_($tmp:$next)
			}
			incr ttl
			# puts "s->s: $dst, $rcvAgent, [$rcvAgent info class], $group, $delay, $accu_bw, $ttl"
		    }
		} else {
		    if [info exist link_($tmp:$next)] {

			# stay in detailed area, do nothing
			# puts "d->d"
		    } else {

			# walking into session area from detailed area
			set session_area 1
			set accu_bw $bw_($tmp:$next)
			set delay $delay_($tmp:$next)
			set ttl 1
			set dst $tmp
			set rcvAgent [$Node_($tmp) entry]
			# puts "d->s: $dst, $rcvAgent, [$rcvAgent info class], $group, $delay, $accu_bw, $ttl"
		    }
		}
		set tmp $next
	    }
	    
	    # Create nam queues for all receivers if traceall is turned on
	    # XXX 
	    # nam will deal with the issue whether all groups share a 
	    # single queue per receiver. The simulator simply writes 
	    # this information there
	    $self puts-nam-config "G -t [$self now] -i $group -a $dst"
	    
	    # And we should add a trace object before each receiver,
	    # because only this will capture the packet before it 
	    # reaches the receiver and after it left the sender
	    set f [$self get-nam-traceall]

	    if {$session_area} {
		if {$f != ""} { 
		    set p [$self create-trace SessDeque $f $src $dst "nam"]
		    $p target $rcvAgent
		    if {![info exist dlist_($index)] || [lsearch $dlist_($index) $rcvAgent] < 0 } {
			$session_($index) add-dst $accu_bw $delay $ttl $dst $p
			$self update-loss-dependency $src $dst $src $p $group
			lappend dlist_($index) $rcvAgent
		    }
		} else {
		    # puts "session area: add-dst $accu_bw $delay $ttl $src $dst $rcvAgent [$rcvAgent info class]"
		    if {![info exist dlist_($index)] || [lsearch $dlist_($index) $rcvAgent] < 0 } {
			$session_($index) add-dst $accu_bw $delay $ttl $dst $rcvAgent
			$self update-loss-dependency $src $dst $src $rcvAgent $group
			lappend dlist_($index) $rcvAgent
		    }
		}
	    } else {
		if {$f != ""} { 
		    set p [$self create-trace SessDeque $f $src $src "nam"]
		    $p target [$Node_($tmp) entry]
		    if {![info exist dlist_($index)] || [lsearch $dlist_($index) [$Node_($tmp) entry]] < 0 } {
			$session_($index) add-dst 0 0 0 $src $p
			$self update-loss-dependency $src $src $src $p $group
			lappend dlist_($index) [$Node_($tmp) entry]
		    }
		} else {
		    # puts "detailed area: add-dst $accu_bw $delay $ttl $src $dst[$Node_($tmp) entry] [[$Node_($tmp) entry] info class]"
		    if {![info exist dlist_($index)] || [lsearch $dlist_($index) [$Node_($tmp) entry]] < 0 } {
			$session_($index) add-dst 0 0 0 $src [$Node_($tmp) entry]
			$self update-loss-dependency $src $src $src [$Node_($tmp) entry] $group
			lappend dlist_($index) [$Node_($tmp) entry]
		    }
		}
	    }
	}
    }
}