1 # rlm-misc.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1996-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/net/rlm-misc.tcl,v 1.5 2002/02/03 04:28:06 lim Exp $
32
33
34 #FIXME
35 #proc randomize v {
36 # return [expr 0.5 * $v + double([ns-random] % 10000000) / 1e7 * $v]
37 #
38 #}
39
40 proc uniform01 {} {
41 return [expr double(([random] % 10000000) + 1) / 1e7]
42 }
43
44 proc uniform { a b } {
45 return [expr ($b - $a) * [uniform01] + $a]
46 }
47
48 proc exponential mean {
49 return [expr - $mean * log([uniform01])]
50 }
51
52 proc trunc_exponential lambda {
53 while 1 {
54 set u [exponential $lambda]
55 if { $u < [expr 4 * $lambda] } {
56 return $u
57 }
58 }
59 }
60
61 #FIXME make this a class?
62 proc sched { delay proc } {
63 set delay [expr int($delay * 1000)]
64 return [after $delay $proc]
65 }
66
67 proc set_timer { which mmg delay } {
68 global rlm_tid
69 set v $which:$mmg
70 if [info exists rlm_tid($v)] {
71 puts "timer botched ($v)"
72 exit -1
73 }
74 set rlm_tid($v) [sched $delay "trigger_timer $which $mmg"]
75 }
76
77 proc trigger_timer { which mmg } {
78 global rlm_tid
79 unset rlm_tid($which:$mmg)
80 $mmg trigger_$which
81 }
82
83 #
84 # cancel s-timer on flow $mmg
85 # e.g., because we experienced loss
86 #
87 proc cancel_timer { which mmg } {
88 global rlm_tid
89 set v $which:$mmg
90 if [info exists rlm_tid($v)] {
91 after cancel $rlm_tid($v)
92 unset rlm_tid($v)
93 }
94 }
95
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.