File: ns-compat.tcl

package info (click to toggle)
ns2 2.35%2Bdfsg-3.1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 78,808 kB
  • sloc: cpp: 172,923; tcl: 107,130; perl: 6,391; sh: 6,143; ansic: 5,846; makefile: 816; awk: 525; csh: 355
file content (942 lines) | stat: -rw-r--r-- 27,773 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
#
# Copyright (c) 1996-1997 Regents of the University of California.
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
# 	This product includes software developed by the MASH Research
# 	Group at the University of California Berkeley.
# 4. Neither the name of the University nor of the Research Group may be
#    used to endorse or promote products derived from this software without
#    specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# @(#) $Header: /cvsroot/nsnam/ns-2/tcl/lib/ns-compat.tcl,v 1.47 2004/02/25 22:26:17 yuri Exp $
#

Class OldSim -superclass Simulator

#
# If the "ns" command is called, set up the simulator
# class to assume backward compat.  This creates an instance
# of a backward-compat simulator API with the name "ns"
# (which in turn overrides this proc)
#
proc ns args {
	OldSim ns
	eval ns $args
}

OldSim instproc default_catch { varName index op } {
	if { $index == "" } {
		error "ns-1 compat: default change caught, but not a default! (varName: $varName)"
		exit 1
	}

	if { $op == "r" || $op == "u" } {
		error "ns-1 compat: default change caught a $op operation"
		exit 1
	}
	set vname ${varName}($index)
	upvar $vname var
	$self default_assign $varName $index $var
}


OldSim instproc default_assign {aname index newval} {
	$self instvar classMap_ queueMap_
	if { $index == "" } {
		puts "something funny with default traces"
		exit 1
	}
	set obj [string trimleft $aname ns_]
	#
	# special case the link array
	#
	if { $obj == "link" } {
		if { $index == "queue-limit" } {
			Queue set limit_ $newval
			return
		}
		set ivar "$index\_"
		if { [lsearch [DelayLink info vars] $ivar] >= 0 } {
			DelayLink set $ivar $newval
			return
		}
		error "warning: ns-1 compatibility library cannot set link default ${aname}($index)"
		return
	}

	#
	# now everyone else
	#
	if ![info exists classMap_($obj)] {
		if ![info exists queueMap_($obj)] {
			puts "error: ns-2 compatibility library cannot set ns-v1 default ${aname}($index)"
			exit 1
		} else {
			set ns2obj "Queue/$queueMap_($obj)"
		}
	} else {
		set ns2obj $classMap_($obj)
	}
	SplitObject instvar varMap_ 
	if ![info exists varMap_($index)] {
		puts "error: ns-2 compatibility library cannot map instvar $index in class $ns2obj"
		exit 1
	}
	$ns2obj set $varMap_($index) $newval

}

#
# see if this array has any elements already set
# if so, arrange for the value to be set in ns-2
# also, add a trace hook so that future changes get
# reflected into ns-2
#
OldSim instproc map_ns_defaults old_arr {
	global $old_arr ; # these were all globals in ns-1
	SplitObject instvar varMap_

	foreach el [array names $old_arr] {
		set val [expr "$${old_arr}($el)"]
		$self default_assign $old_arr $el $val
	}

	# arrange to trace any read/write/unset op
	trace variable $old_arr rwu "$self default_catch"
}

OldSim instproc trace_old_defaults {} {
	# all ns-v1 defaults as of 1.4
	$self map_ns_defaults ns_tcp
	$self map_ns_defaults ns_tcpnewreno
	$self map_ns_defaults ns_trace
	$self map_ns_defaults ns_fulltcp
	$self map_ns_defaults ns_red
	$self map_ns_defaults ns_cbq
	$self map_ns_defaults ns_class
	$self map_ns_defaults ns_sink
	$self map_ns_defaults ns_delsink
	$self map_ns_defaults ns_sacksink
	$self map_ns_defaults ns_cbr
	$self map_ns_defaults ns_rlm
	$self map_ns_defaults ns_ivs
	$self map_ns_defaults ns_source
	$self map_ns_defaults ns_telnet
	$self map_ns_defaults ns_bursty
	$self map_ns_defaults ns_message
	$self map_ns_defaults ns_facktcp
	$self map_ns_defaults ns_link
	$self map_ns_defaults ns_lossy_uniform
	$self map_ns_defaults ns_lossy_patt
	$self map_ns_defaults ns_queue
  	$self map_ns_defaults ns_srm
}

OldSim instproc init args {
	eval $self next $args
	puts stderr "warning: using backward compatibility mode"
	$self instvar classMap_
 
        Simulator set nsv1flag 1

	#
	# Always use the list scheduler.
	$self instvar scheduler_
	set scheduler_ [new Scheduler/List]

	#
	# in CBQ, setting the algorithm_ variable becomes invoking
	# the algorithm method
	#
	# also, there really isn't a limit_ for CBQ, as each queue
	# has its own.
	#
	Queue/CBQ instproc set args {
		$self instvar compat_qlim_
		if { [lindex $args 0] == "queue-limit" || \
				[lindex $args 0] == "limit_" } { 
			if { [llength $args] == 2 } {
				set val [lindex $args 1]
				set compat_qlim_ $val
				return $val
			}
			return $compat_qlim_
		} elseif { [lindex $args 0] == "algorithm_" } {
			$self algorithm [lindex $args 1]
			# note: no return here
		}
		eval $self next $args
	}
        #
        # Catch queue-limit variable which is now "$q limit"
        #
        Queue/DropTail instproc set args {
                if { [llength $args] == 2 &&
                        [lindex $args 0] == "queue-limit" } {
                        # this will recursively call ourself
                        $self set limit_ [lindex $args 1]
                        return
                }
                eval $self next $args
        }
        Queue/RED instproc set args {
                if { [llength $args] == 2 &&
                        [lindex $args 0] == "queue-limit" } {
                        # this will recursively call ourself
                        $self set limit_ [lindex $args 1]
                        return
                }
                eval $self next $args
        }
	Queue/RED instproc enable-vartrace file {
		$self trace ave_
		$self trace prob_
		$self trace curq_
		$self attach $file
	}
	#
	# Catch set maxpkts for FTP sources, (needed because Source objects are
	# not derived from TclObject, and hence can't use varMap method below)
	#
	Source/FTP instproc set args {
		if { [llength $args] == 2 &&
			[lindex $args 0] == "maxpkts" } {
			$self set maxpkts_ [lindex $args 1]
			return
		}
		eval $self next $args
	}
	Source/Telnet instproc set args {
		if { [llength $args] == 2 &&
			[lindex $args 0] == "interval" } {
			$self set interval_ [lindex $args 1]
			return
		}
		eval $self next $args
	}
	#
	# Support for things like "set ftp [$tcp source ftp]"
	#
	Agent/TCP instproc source type {
		if { $type == "ftp" } {
			set type FTP
		}
		if { $type == "telnet" } {
			set type Telnet
		}
		set src [new Source/$type]
		$src attach $self
		return $src
	}
	Agent/TCP set restart_bugfix_ false
	#
	# support for new variable names
	# it'd be nice to set up mappings on a per-class
	# basis, but this is too painful.  Just do the
	# mapping across all objects and hope this
	# doesn't cause any collisions...
	#
	SplitObject instproc set args {
		SplitObject instvar varMap_
		set var [lindex $args 0] 
		if [info exists varMap_($var)] {
			set var $varMap_($var)
			set args "$var [lrange $args 1 end]"
		}
		# xxx: re-implement the code from tcl-object.tcl
		$self instvar -parse-part1 $var
		if {[llength $args] == 1} {
			return [subst $[subst $var]]
		} else {
			return [set $var [lrange $args 1 end]]
		}
	}
	SplitObject instproc get {var} {
		SplitObject instvar varMap_
		if [info exists varMap_($var)] {
			# puts stderr "TclObject::get $var -> $varMap_($var)."
			return [$self set $varMap_($var)]
		} else {
			return [$self next $var]
		}
	}
	# Agent
	TclObject set varMap_(addr) addr_
	TclObject set varMap_(dst) dst_
## now gone
###TclObject set varMap_(seqno) seqno_
###TclObject set varMap_(cls) class_
## class -> flow id
	TclObject set varMap_(cls) fid_

	# Trace
	TclObject set varMap_(src) src_
	TclObject set varMap_(show_tcphdr) show_tcphdr_

	# TCP
	TclObject set varMap_(window) window_
	TclObject set varMap_(window-init) windowInit_
	TclObject set varMap_(window-option) windowOption_
	TclObject set varMap_(window-constant) windowConstant_
	TclObject set varMap_(window-thresh) windowThresh_
	TclObject set varMap_(overhead) overhead_
	TclObject set varMap_(tcp-tick) tcpTick_
	TclObject set varMap_(ecn) ecn_
	TclObject set varMap_(bug-fix) bugFix_
	TclObject set varMap_(maxburst) maxburst_
	TclObject set varMap_(maxcwnd) maxcwnd_
	TclObject set varMap_(dupacks) dupacks_
	TclObject set varMap_(seqno) seqno_
	TclObject set varMap_(ack) ack_
	TclObject set varMap_(cwnd) cwnd_
	TclObject set varMap_(awnd) awnd_
	TclObject set varMap_(ssthresh) ssthresh_
	TclObject set varMap_(rtt) rtt_
	TclObject set varMap_(srtt) srtt_
	TclObject set varMap_(rttvar) rttvar_
	TclObject set varMap_(backoff) backoff_
	TclObject set varMap_(v-alpha) v_alpha_
	TclObject set varMap_(v-beta) v_beta_
	TclObject set varMap_(v-gamma) v_gamma_

	# Agent/TCP/NewReno
	TclObject set varMap_(changes) newreno_changes_

	# Agent/TCP/Fack
	TclObject set varMap_(rampdown) rampdown_ 
	TclObject set varMap_(ss-div4) ss-div4_

	# Queue
	TclObject set varMap_(limit) limit_

	# Queue/SFQ
	TclObject set varMap_(limit) maxqueue_
	TclObject set varMap_(buckets) buckets_

	# Queue/RED
	TclObject set varMap_(bytes) bytes_
	TclObject set varMap_(thresh) thresh_
	TclObject set varMap_(maxthresh) maxthresh_
	TclObject set varMap_(mean_pktsize) meanPacketSize_
	TclObject set varMap_(q_weight) queueWeight_
	TclObject set varMap_(wait) wait_
	TclObject set varMap_(linterm) linterm_
	TclObject set varMap_(setbit) setbit_
	TclObject set varMap_(drop-tail) dropTail_
	TclObject set varMap_(doubleq) doubleq_
	TclObject set varMap_(dqthresh) dqthresh_
	TclObject set varMap_(subclasses) subclasses_
	# CBQClass
	TclObject set varMap_(algorithm) algorithm_
	TclObject set varMap_(max-pktsize) maxpkt_
	TclObject set varMap_(priority) priority_
	TclObject set varMap_(maxidle) maxidle_
	TclObject set varMap_(extradelay) extradelay_

	# Agent/TCPSinnk, Agent/CBR
	TclObject set varMap_(packet-size) packetSize_
	TclObject set varMap_(interval) interval_

	# Agent/CBR
	TclObject set varMap_(random) random_

	# IVS
	TclObject set varMap_(S) S_
	TclObject set varMap_(R) R_
	TclObject set varMap_(state) state_
	TclObject set varMap_(rttShift) rttShift_
	TclObject set varMap_(keyShift) keyShift_
	TclObject set varMap_(key) key_
	TclObject set varMap_(maxrtt) maxrtt_

	Class traceHelper
	traceHelper instproc attach f {
		$self instvar file_
		set file_ $f
	}

	#
	# linkHelper
	# backward compat for "[ns link $n1 $n2] set linkVar $value"
	#
	# unfortunately, 'linkVar' in ns-1 can be associated
	# with a link (delay, bandwidth, generic queue requests) or
	# can be specific to a particular queue (e.g. RED) which
	# has a bunch of variables (see above).
	#
	Class linkHelper
	linkHelper instproc init args {
		$self instvar node1_ node2_ linkref_ queue_
		set node1_ [lindex $args 0]
		set node2_ [lindex $args 1]
		set lid [$node1_ id]:[$node2_ id]	    
		set linkref_ [ns set link_($lid)]
		set queue_ [$linkref_ queue]
		# these will be used in support of link stats
		set sqi [new SnoopQueue/In]
		set sqo [new SnoopQueue/Out]
		set sqd [new SnoopQueue/Drop]
		set dsamples [new Samples]
		set qmon [new QueueMonitor/Compat]
		$qmon set-delay-samples $dsamples
		$linkref_ attach-monitors $sqi $sqo $sqd $qmon
		$linkref_ set bytesInt_ [new Integrator]
		$linkref_ set pktsInt_ [new Integrator]
		$qmon set-bytes-integrator [$linkref_ set bytesInt_]
		$qmon set-pkts-integrator [$linkref_ set pktsInt_]
	}
	linkHelper instproc trace traceObj {
		$self instvar node1_ node2_
		$self instvar queue_
		set tfile [$traceObj set file_]
		ns trace-queue $node1_ $node2_ $tfile
		# XXX: special-case RED queue for var tracing
		if { [string first Queue/RED [$queue_ info class]] == 0 } {
			$queue_ enable-vartrace $tfile
		}
	}
 	linkHelper instproc callback {fn} {
		# Reach deep into the guts of the link and twist...
		# (This code makes assumptions about how
		# SimpleLink instproc trace works.)
		# NEEDSWORK: should this be done with attach-monitors?
 		$self instvar linkref_
		foreach part {enqT_ deqT_ drpT_} {
			set to [$linkref_ set $part]
			$to set callback_ 1
			$to proc handle {args} "$fn \$args"
		}
 	}
	linkHelper instproc set { var val } {

		$self instvar linkref_ queue_
		set qvars [$queue_ info vars]
		set linkvars [$linkref_ info vars]
		set linkdelayvars [[$linkref_ link] info vars]
		#
		# adjust the string to have a trailing '_'
		# because all instvars are constructed that way
		#
		if { [string last _ $var] != ( [string length $var] - 1) } {
			set var ${var}_
		}
		if { $var == "queue-limit_" } {
			set var "limit_"
		}
		if { [lsearch $qvars $var] >= 0 } {
			# set a queue var
			$queue_ set $var $val
		} elseif { [lsearch $linkvars $var] >= 0 } {
			# set a link OTcl var
			$linkref_ set $var $val
		} elseif { [lsearch $linkdelayvars $var] >= 0 } {
			# set a linkdelay object var
			[$linkref_ link] set $var $val
		} else {
			puts stderr "linkHelper warning: couldn't set unknown variable $var"
		}
	}

	linkHelper instproc get var {

		$self instvar linkref_ queue_
		set qvars [$queue_ info vars]
		set linkvars [$linkref_ info vars]
		set linkdelayvars [[$linkref_ link] info vars]
		#
		# adjust the string to have a trailing '_'
		# because all instvars are constructed that way
		#
		if { [string last _ $var] != ( [string length $var] - 1) } {
			set var ${var}_
		}
		if { $var == "queue-limit_" } {
			set var "limit_"
		}
		if { [lsearch $qvars $var] >= 0 } {
			# set a queue var
			return [$queue_ set $var]
		} elseif { [lsearch $linkvars $var] >= 0 } {
			# set a link OTcl var
			return [$linkref_ set $var]
		} elseif { [lsearch $linkdelayvars $var] >= 0 } {
			# set a linkdelay object var
			return [[$linkref_ link] set $var]
		} else {
			puts stderr "linkHelper warning: couldn't set unknown variable $var"
			return ""
		}
		return ""
	}

	#
	# gross, but works:
	#
	# In ns-1 queues were a sublass of link, and this compat
	# code carries around a 'linkHelper' as the returned object
	# when you do a [ns link $r1 $r2] or a [ns link $r1 $r2 $qtype]
	# command.  So, operations on this object could have been
	# either link ops or queue ops in ns-1.  It is possible to see
	# whether an Otcl class or object supports certain commands
	# but it isn't possible to look inside a C++ implemented object
	# (i.e. into it's cmd function) to see what it supports.  Instead,
	# arrange to catch the exception generated while trying into a
	# not-implemented method in a C++ object.
	#
	linkHelper instproc try { obj operation argv } {
		set op [eval list $obj $operation $argv]
		set ocl [$obj info class]
		set iprocs [$ocl info instcommands]
		set oprocs [$obj info commands]
		# if it's a OTcl-implemented method we see it in info
		# and thus don't need to catch it
		if { $operation != "cmd" } {
			if { [lsearch $iprocs $operation] >= 0 } {
				return [eval $op]
			}
			if { [lsearch $oprocs $operation] >= 0 } {
				return [eval $op]
			}
		}
		#catch the c++-implemented method in case it's not there
		#ret will contain error string or return string
		# value of catch operation will be 1 on error
		if [catch $op ret] {
			return -1
		}
		return $ret
	}
	# so, try to invoke the op on a queue and if that causes
	# an exception (a missing function hopefully) try it on
	# the link instead
	#
	# we need to override 'TclObject instproc unknown args'
	# (well, at least we did), because it was coded such that
	# if a command() function didn't exist, an exit 1 happened
	#
	linkHelper instproc unknown { m args } {
		# method could be in: queue, link, linkdelay
		# or any of its command procedures
		# note that if any of those have errors in them
		# we can get a general error by ending up at the end here
		$self instvar linkref_ queue_
		set oldbody [TclObject info instbody unknown]
		TclObject instproc unknown args {
			if { [lindex $args 0] == "cmd" } {
				puts stderr "Can't dispatch $args"
				exit 1
			}
			eval $self cmd $args
		}

		# try an OTcl queue then the underlying queue object
		set rval [$self try $queue_ $m $args]
		if { $rval != -1 } {
			TclObject instproc unknown args $oldbody
			return $rval
		}
		set rval [$self try $queue_ cmd [list $m $args]]
		if { $rval != -1 } {
			TclObject instproc unknown args $oldbody
			return $rval
		}
		set rval [$self try $linkref_ $m $args]
		if { $rval != -1 } {
			TclObject instproc unknown args $oldbody
			return $rval
		}
		set rval [$self try $linkref_ cmd [list $m $args]]
		if { $rval != -1 } {
			TclObject instproc unknown args $oldbody
			return $rval
		}
		set dlink [$linkref_ link]
		set rval [$self try $dlink $m $args]
		if { $rval != -1 } {
			TclObject instproc unknown args $oldbody
			return $rval
		}
		set rval [$self try $dlink cmd [list $m $args]]
		if { $rval != -1 } {
			TclObject instproc unknown args $oldbody
			return $rval
		}
		TclObject instproc unknown args $oldbody
		puts stderr "Unknown operation $m or subbordinate operation failed"
		exit 1
	}
	linkHelper instproc stat { classid item } {
		$self instvar linkref_
		set qmon [$linkref_ set qMonitor_]
		# note: in ns-1 the packets/bytes stats are counts
		# of the number of *departures* at a link/queue
		#
		if { $item == "packets" } {
			return [$qmon pkts $classid]
		} elseif { $item == "bytes" } {
			return [$qmon bytes $classid]
		} elseif { $item == "drops"} {
			return [$qmon drops $classid]
		} elseif { $item == "mean-qdelay" } {
			set dsamp [$qmon get-class-delay-samples $classid]
			if { [$dsamp cnt] > 0 } {
				return [$dsamp mean]
			} else {
				return NaN
			}
		} else {
			puts stderr "linkHelper: unknown stat op $item"
			exit 1
		}
	}
	linkHelper instproc integral { itype } {
		$self instvar linkref_
		if { $itype == "qsize" } {
			set integ [$linkref_ set bytesInt_]
		} elseif { $itype == "qlen" } {
			set integ [$linkref_ set pktsInt_]
		}

		return [$integ set sum_]
	}

	#
	# end linkHelper
	#

	set classMap_(tcp) Agent/TCP
	set classMap_(tcp-reno) Agent/TCP/Reno
	set classMap_(tcp-vegas) Agent/TCP/Vegas
	set classMap_(tcp-full) Agent/TCP/FullTcp
	set classMap_(fulltcp) Agent/TCP/FullTcp
	set classMap_(tcp-fack) Agent/TCP/Fack
	set classMap_(facktcp) Agent/TCP/Fack
	set classMap_(tcp-newreno) Agent/TCP/Newreno
	set classMap_(tcpnewreno) Agent/TCP/Newreno
	set classMap_(cbr) Agent/CBR
	set classMap_(tcp-sink) Agent/TCPSink
	set classMap_(tcp-sack1) Agent/TCP/Sack1
	set classMap_(sack1-tcp-sink) Agent/TCPSink/Sack1
	set classMap_(tcp-sink-da) Agent/TCPSink/DelAck
	set classMap_(sack1-tcp-sink-da) Agent/TCPSink/Sack1/DelAck
	set classMap_(sink) Agent/TCPSink
	set classMap_(delsink) Agent/TCPSink/DelAck
	set classMap_(sacksink) Agent/TCPSink ; # sacksink becomes TCPSink here
	set classMap_(loss-monitor) Agent/LossMonitor
	set classMap_(class) CBQClass
	set classMap_(ivs) Agent/IVS/Source
	set classMap_(trace) Trace
  	set classMap_(srm) Agent/SRM

	$self instvar queueMap_
	set queueMap_(drop-tail) DropTail
	set queueMap_(sfq) SFQ
	set queueMap_(red) RED
	set queueMap_(cbq) CBQ
	set queueMap_(wrr-cbq) CBQ/WRR

	$self trace_old_defaults

	#
	# this is a hack to deal with the unfortunate name
	# of a CBQ class chosen in ns-1 (i.e. "class").
	#
	# the "new" procedure in Tcl/tcl-object.tcl will end
	# up calling:
	#	eval class create id ""
	# so, catch this here... yuck
        global tcl_version
        if {$tcl_version < 8} {
                set class_name "class"
        } else {
                set class_name "::class"
        }
	proc $class_name args {
		set arglen [llength $args]
		if { $arglen < 2 } {
			return
		}
		set op [lindex $args 0]
		set id [lindex $args 1]
		if { $op != "create" } {
			error "ns-v1 compat: malformed class operation: op $op"
			return
		}
                #
                # we need to prevent a "phantom" argument from
                # showing up in the argument list to [CBQClass create],
                # so, don't pass an empty string if we weren't
                # called with one!
                #
                # by calling through [eval], we suppress any {} that
                # might result from the [lrange ...] below
                #
                eval CBQClass create $id [lrange $args 2 [expr $arglen - 1]]
	}
}

#
# links in ns-1 had support for statistics collection...
# $link stat packets/bytes/drops
#
OldSim instproc simplex-link-compat { n1 n2 bw delay qtype } {
	$self simplex-link $n1 $n2 $bw $delay $qtype
	# need to call 'simplex-link', not '-Nargs' cludges, because
	# the queue wants to know the delay and bandwidth when it
	# attaches
        $self link-twoargs $n1 $n2 ;#maybe this is not needed, whatever...
}

OldSim instproc duplex-link-compat { n1 n2 bw delay type } {
	ns simplex-link-compat $n1 $n2 $bw $delay $type
	ns simplex-link-compat $n2 $n1 $bw $delay $type
}

OldSim instproc get-queues { n1 n2 } {
	$self instvar link_
	set n1 [$n1 id]
	set n2 [$n2 id]
	return "[$link_($n1:$n2) queue] [$link_($n2:$n1) queue]"
}

OldSim instproc create-agent { node type pktClass } {

	$self instvar classMap_
	if ![info exists classMap_($type)] {
		puts stderr \
		  "backward compat bug: need to update classMap for $type"
		exit 1
	}
	set agent [new $classMap_($type)]
	# new mapping old class -> flowid
	$agent set fid_ $pktClass
	$self attach-agent $node $agent

# This has been replaced by TclObject instproc get.  -johnh, 10-Sep-97
#
#	$agent proc get var {
#		return [$self set $var]
#	}

	return $agent
}

OldSim instproc agent { type node } {
	return [$self create-agent $node $type 0]
}

OldSim instproc create-connection \
	{ srcType srcNode sinkType sinkNode pktClass } {

	set src [$self create-agent $srcNode $srcType $pktClass]
	set sink [$self create-agent $sinkNode $sinkType $pktClass]
	$self connect $src $sink

	return $src
}

proc ns_connect { src sink } {
	return [ns connect $src $sink]
}

#
# return helper object for backward compat of "ns link" command
#
OldSim instproc link args {
	set nargs [llength $args]
	set arg0 [lindex $args 0]
	set arg1 [lindex $args 1]
	if { $nargs == 2 } {
		return [$self link-twoargs $arg0 $arg1]
	} elseif { $nargs == 3 } {
		return [$self link-threeargs $arg0 $arg1 [lindex $args 2]]
	}
}
OldSim instproc link-twoargs { n1 n2 } {
	$self instvar LH_
	if ![info exists LH_($n1:$n2)] {
		set LH_($n1:$n2) 1
		linkHelper LH_:$n1:$n2 $n1 $n2
	}
	return LH_:$n1:$n2
}

OldSim instproc link-threeargs { n1 n2 qtype } {
	# new link with 0 bandwidth and 0 delay
	$self simplex-link $n1 $n2 0 0 $qtype
        return [$self link-twoargs $n1 $n2]
}

OldSim instproc trace {} {
	return [new traceHelper]
}

OldSim instproc random { seed } {
	return [ns-random $seed]
}

proc ns_simplex { n1 n2 bw delay type } {
        # this was never used in ns-1
        puts stderr "ns_simplex: no backward compat"
        exit 1
}

proc ns_duplex { n1 n2 bw delay type } {
	ns duplex-link-compat $n1 $n2 $bw $delay $type
	return [ns get-queues $n1 $n2]
}

#
# Create a source/sink connection pair and return the source agent.
# 
proc ns_create_connection { srcType srcNode sinkType sinkNode pktClass } {
	ns create-connection $srcType $srcNode $sinkType \
		$sinkNode $pktClass
}

#
# Create a source/sink CBR pair and return the source agent.
# 
proc ns_create_cbr { srcNode sinkNode pktSize interval fid } {
	set s [ns create-connection cbr $srcNode loss-monitor \
		$sinkNode $fid]
	$s set interval_ $interval
	$s set packetSize_ $pktSize
	return $s
}

#
# compat code for CBQ
#
proc ns_create_class { parent borrow allot maxidle notused prio depth xdelay } {
	set cl [new CBQClass]
	#
	# major hack: if the prio is 8 (the highest in ns-1) it's
	# an internal node, hence no queue disc
	if { $prio < 8 } {
		set qtype [CBQClass set def_qtype_]
		set q [new Queue/$qtype]
		$cl install-queue $q
	}
	set depth [expr $depth + 1]
	if { $borrow == "none" } {
		set borrowok false
	} elseif { $borrow == $parent } {
		set borrowok true
	} else {
		puts stderr "CBQ: borrowing from non-parent not supported"
		exit 1
	}

	$cl setparams $parent $borrowok $allot $maxidle $prio $depth $xdelay
	return $cl
}

proc ns_create_class1 { parent borrow allot maxidle notused prio depth xdelay Mb } {
	set cl [ns_create_class $parent $borrow $allot $maxidle $notused $prio $depth $xdelay]
	ns_class_maxIdle $cl $allot $maxidle $prio $Mb
	return $cl
}

proc ns_class_params { cl parent borrow allot maxidle notused prio depth xdelay Mb } {
	set depth [expr $depth + 1]
	if { $borrow == "none" } {
		set borrowok false
	} elseif { $borrow == $parent } {
		set borrowok true
	} else {
		puts stderr "CBQ: borrowing from non-parent not supported"
		exit 1
	}
	$cl setparams $parent $borrowok $allot $maxidle $prio $depth $xdelay
	ns_class_maxIdle $cl $allot $maxidle $prio $Mb
	return $cl
}

#
# If $maxIdle is "auto", set maxIdle to Max[t(1/p-1)(1-g^n)/g^n, t(1-g)].
# For p = allotment, t = packet transmission time, g = weight for EWMA.
# The parameter t is calculated for a medium-sized 1000-byte packet.
#
proc ns_class_maxIdle { cl allot maxIdle priority Mbps } {
        if { $maxIdle == "auto" } {
                set g 0.9375
                set n [expr 8 * $priority]
                set gTOn [expr pow($g, $n)]
                set first [expr ((1/$allot) - 1) * (1-$gTOn) / $gTOn ]
                set second [expr (1 - $g)]
                set packetsize 1000
                set t [expr ($packetsize * 8)/($Mbps * 1000000) ]
                if { $first > $second } {
                        $cl set maxidle_ [expr $t * $first]
                } else {
                        $cl set maxidle_ [expr $t * $second]
                }
        } else {
                $cl set maxidle_ $maxIdle
        }
        return $cl
}
#
# backward compat for agent methods that were replaced
# by OTcl instance variables
#
Agent instproc connect d {
	$self set dst_ $d
}

# XXX changed call from "handle" to "recv"
Agent/Message instproc recv msg {
	$self handle $msg
}

#Renamed variables in Queue/RED and Queue/DropTail
Queue/RED proc set { var {arg ""} } {
	if { $var == "queue-in-bytes_" } {
		warn "Warning: use `queue_in_bytes_' rather than `queue-in-bytes_'"
		set var "queue_in_bytes_"
	} elseif { $var == "drop-tail_" } {
		warn "Warning: use `drop_tail_' rather than `drop-tail_'"
		set var "drop_tail_"
	} elseif { $var == "drop-front_" } {
		warn "Warning: use `drop_front_' rather than `drop-front_'"
		set var "drop_front_"
	} elseif { $var == "drop-rand_" } {
		warn "Warning: use `drop_rand_' rather than `drop-rand_'"
		set var "drop_rand_"
	} elseif { $var == "ns1-compat_" } {
		warn "Warning: use `ns1_compat_' rather than `ns1-compat_'"
		set var "ns1_compat_"
	}
	eval $self next $var $arg
}

Queue/DropTail proc set { var {arg ""} } {
	if { $var == "drop-front_" } {
		warn "Warning: use `drop_front_' rather than `drop-front_'"
		set var "drop_front_"
	}
	eval $self next $var $arg
}