srm.tcl

在Linux下做的QuadTree的程序

# 
#  Copyright (c) 1997 by the University of Southern California
#  All rights reserved.
# 
#  Permission to use, copy, modify, and distribute this software and its
#  documentation in source and binary forms for non-commercial purposes
#  and without fee is hereby granted, provided that the above copyright
#  notice appear in all copies and that both the copyright notice and
#  this permission notice appear in supporting documentation. and that
#  any documentation, advertising materials, and other materials related
#  to such distribution and use acknowledge that the software was
#  developed by the University of Southern California, Information
#  Sciences Institute.  The name of the University may not be used to
#  endorse or promote products derived from this software without
#  specific prior written permission.
# 
#  THE UNIVERSITY OF SOUTHERN CALIFORNIA makes no representations about
#  the suitability of this software for any purpose.  THIS SOFTWARE IS
#  PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
#  INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
#  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
# 
#  Other copyrights might apply to parts of this software and are so
#  noted when applicable.
# 
# Source srm-debug.tcl if you want to turn on tracing of events.
# Do not insert probes directly in this code unless you are sure
# that what you want is not available there.
#
#	Author:		Kannan Varadhan	<[e-mail]>
#	Version Date:	Mon Jun 30 15:51:33 PDT 1997
#
# @(#) $Header: /home/am6/jinyang/cvs/our-ns/tcl/mcast/srm.tcl,v 1.1.1.1 2000/08/28 18:40:40 jinyang Exp $ (USC/ISI)
#

# THis routine is a temporary hack.  It is likely to dissappear
# at some point in time.
#
Agent instproc traffic-source agent {
	$self instvar tg_
	set tg_ $agent
	$tg_ target $self
	$tg_ set addr_ [$self set addr_]
}

Agent/SRM set packetSize_  1024	;# assume default message size for repair is 1K
Agent/SRM set groupSize_   1

Agent/SRM set distanceCompute_	ewma

Agent/SRM set C1_	2.0
Agent/SRM set C2_	2.0
Agent/SRM set requestFunction_	"SRM/request"
Agent/SRM set requestBackoffLimit_	5

Agent/SRM set D1_	1.0
Agent/SRM set D2_	1.0
Agent/SRM set repairFunction_	"SRM/repair"

Agent/SRM set sessionDelay_ 1.0
Agent/SRM set sessionFunction_	"SRM/session"

Class Agent/SRM/Deterministic -superclass Agent/SRM
Agent/SRM/Deterministic set C2_ 0.0
Agent/SRM/Deterministic set D2_ 0.0

Class Agent/SRM/Probabilistic -superclass Agent/SRM
Agent/SRM/Probabilistic set C1_ 0.0
Agent/SRM/Probabilistic set D1_ 0.0

Class Agent/SRM/Fixed -superclass Agent/SRM

Class SRM
Class SRM/request -superclass SRM
Class SRM/repair -superclass SRM
Class SRM/session -superclass SRM

source ../mcast/srm-adaptive.tcl

###
Agent/SRM instproc init {} {
	$self next
	$self instvar ns_ requestFunction_ repairFunction_
	set ns_ [Simulator instance]
	$self init-instvar sessionDelay_
	foreach var {C1_ C2_ D1_ D2_} {
		$self init-instvar $var
	}
	$self init-instvar requestFunction_
	$self init-instvar repairFunction_
	$self init-instvar sessionFunction_
	$self init-instvar requestBackoffLimit_
	$self init-instvar distanceCompute_

	$self array set stats_ [list		\
			dup-req		-1	ave-dup-req	-1	\
			dup-rep		-1	ave-dup-rep	-1	\
			req-delay	0.0	ave-req-delay	-1	\
			rep-delay	0.0	ave-rep-delay	-1	\
			]
}

Agent/SRM instproc delete {} {
	$self instvar ns_ pending_ done_ session_ tg_
	foreach i [array names pending_] {
		$pending_($i) cancel DELETE
		delete $pending_($i)
	}
	$self cleanup
	delete $session_
	if [info exists tg_] {
		delete $tg_
	}
}

Agent/SRM instproc start {} {
	$self instvar node_ dst_	;# defined in Agent base class
	set dst_ [expr $dst_]		;# get rid of possibly leading 0x etc.
	$self cmd start

	$node_ join-group $self $dst_

	$self instvar ns_ session_ sessionFunction_
	set session_ [new $sessionFunction_ $ns_ $self]
	$session_ schedule
}

Agent/SRM instproc start-source {} {
	$self instvar tg_
	if ![info exists tg_] {
		error "No source defined for agent $self"
	}
	$tg_ start
}

Agent/SRM instproc sessionFunction f {
	$self instvar sessionFunction_
	set sessionFunction_ $f
}

Agent/SRM instproc requestFunction f {
	$self instvar requestFunction_
	set requestFunction_ $f
}

Agent/SRM instproc repairFunction f {
	$self instvar repairFunction_
	set repairFunction_ $f
}

Agent/SRM instproc groupSize? {} {
	$self set groupSize_
}

global alpha
if ![info exists alpha] {
	set alpha	0.25
}

proc ewma {ave cur} {
	if {$ave < 0} {
		return $cur
	} else {
		global alpha
		return [expr (1 - $alpha) * $ave + $alpha * $cur]
	}
}

proc instantaneous {ave cur} {
	set cur
}

Agent/SRM instproc compute-ave var {
	$self instvar stats_
	set stats_(ave-$var) [ewma $stats_(ave-$var) $stats_($var)]
}

####

Agent/SRM instproc recv {type args} {
	eval $self recv-$type $args
}

Agent/SRM instproc recv-data {sender msgid} {
	$self instvar pending_
	if ![info exists pending_($sender:$msgid)] {
		# This is a very late data of some wierd sort.
		# How did we get here?
		error "Oy vey!  How did we get here?"
	}
	if {[$pending_($sender:$msgid) set round_] == 1} {
		$pending_($sender:$msgid) cancel DATA
		$pending_($sender:$msgid) evTrace Q DATA
		delete $pending_($sender:$msgid)
		unset pending_($sender:$msgid)
	} else {
		$pending_($sender:$msgid) recv-repair
	}
}

Agent/SRM instproc mark-period period {
	$self compute-ave $period
	$self set stats_($period) 0
}

Agent/SRM instproc request {sender args} {
	# called when agent detects a lost packet
	$self instvar pending_ ns_ requestFunction_
	set newReq 0
	foreach msgid $args {
		if [info exists pending_($sender:$msgid)] {
			error "duplicate loss detection in agent"
		}
		set pending_($sender:$msgid) [new $requestFunction_ $ns_ $self]
		$pending_($sender:$msgid) set-params $sender $msgid
		$pending_($sender:$msgid) schedule
		
		if ![info exists old_($sender:$msgid)] {
			incr newReq
		}
	}
	if $newReq {
		$self mark-period dup-req
	}
}

Agent/SRM instproc update-ave {type delay} {
	$self instvar stats_
	set stats_(${type}-delay) $delay
	$self compute-ave ${type}-delay
}

Agent/SRM instproc recv-request {requestor round sender msgid} {
	# called when agent receives a control message for an old ADU
	$self instvar pending_ stats_
	if [info exists pending_($sender:$msgid)] {
		# Either a request or a repair is pending.
		# Possibly mark duplicates.
		if { $round == 1 } {
			incr stats_(dup-req) [$pending_($sender:$msgid)	\
					dup-request?]
		}
		$pending_($sender:$msgid) recv-request
	} else {
		# We have no events pending, only if the ADU is old, and
		# we have received that ADU.
		$self repair $requestor $sender $msgid
	}
}

Agent/SRM instproc repair {requestor sender msgid} {
	# called whenever agent receives a request, and packet exists
	$self instvar pending_ ns_ repairFunction_
	if [info exists pending_($sender:$msgid)] {
		error "duplicate repair detection in agent??  really??"
	}
	set pending_($sender:$msgid) [new $repairFunction_ $ns_ $self]
	$pending_($sender:$msgid) set requestor_ $requestor
	$pending_($sender:$msgid) set-params $sender $msgid
	$pending_($sender:$msgid) schedule
	$self mark-period dup-rep
}

Agent/SRM instproc recv-repair {round sender msgid} {
	$self instvar pending_ stats_
	if ![info exists pending_($sender:$msgid)] {
		# 1.  We didn't hear the request for the older ADU, or
		# 2.  This is a very late repair beyond the $3 d_{S,B}$ wait
		# What should we do?
		#if { $round == 1 } { incr stats_(dup-rep) }
		$self instvar trace_ ns_ node_ 
		if [info exists trace_] {
			# puts -nonewline $trace_ [format "%7.4f" [$ns_ now]]
			# puts $trace_ " n [$node_ id] m <$sender:$msgid> r $round X REPAIR late dup"
		}
	} else {
		if { $round == 1 } {
			incr stats_(dup-rep) [$pending_($sender:$msgid)	\
					dup-repair?]
		}
		$pending_($sender:$msgid) recv-repair
	}
}

Agent/SRM/Fixed instproc repair args {
	$self set D1_ [expr log10([$self set groupSize_])]
	$self set D2_ [expr log10([$self set groupSize_])]
	eval $self next $args
}

####

Agent/SRM instproc clear {obj s m} {
	$self instvar pending_ done_ old_ logfile_
	set done_($s:$m) $obj
	set old_($s:$m) [$obj set round_]
	if [info exists logfile_] {
		$obj dump-stats $logfile_
	}
	unset pending_($s:$m)
	if {[array size done_] > 32} {
		$self instvar ns_
		$ns_ at [expr [$ns_ now] + 0.01] "$self cleanup"
	}
}

Agent/SRM instproc round? {s m} {
	$self instvar old_
	if [info exists old_($s:$m)] {
		return $old_($s:$m)
	} else {
		return 0
	}
}

Agent/SRM instproc cleanup {} {
	# We need to do this somewhere...now seems a good time
	$self instvar done_
	if [info exists done_] {
		foreach i [array names done_] {
			delete $done_($i)
		}
		unset done_
	}
}

Agent/SRM instproc trace file {
	$self set trace_ $file
}

Agent/SRM instproc log file {
	$self set logfile_ $file
}

#
#
# Note that the SRM event handlers are not rooted as TclObjects.
#
SRM instproc init {ns agent} {
	$self next
	$self instvar ns_ agent_ nid_ distf_
	set ns_ $ns
	set agent_ $agent
	set nid_ [[$agent_ set node_] id]
	set distf_ [$agent_ set distanceCompute_]