parse.tcl.in 2.62 KB
Newer Older
Mac Newbold's avatar
Mac Newbold committed
1 2
#!/usr/local/bin/otclsh

Christopher Alfeld's avatar
Christopher Alfeld committed
3
if {$argc != 3} {
4
   puts "usage: $argv0 id ns_input_file ir_file"
Mac Newbold's avatar
Mac Newbold committed
5 6
   exit 1
}
7
set id [lindex $argv 0]
Christopher Alfeld's avatar
Christopher Alfeld committed
8 9
set nsfile [lindex $argv 1]
set irfile [lindex $argv 2]
Mac Newbold's avatar
Mac Newbold committed
10

11 12 13
set tbroot @prefix@

set libdir @prefix@/lib/ns2ir
14
set tbcompat "$libdir/tb_compat.tcl"
Mac Newbold's avatar
Mac Newbold committed
15 16 17 18
source $libdir/tcl-object.tcl
source $libdir/node.tcl
source $libdir/link.tcl
source $libdir/event.tcl
19
source $libdir/lan.tcl
Mac Newbold's avatar
Mac Newbold committed
20 21 22 23 24 25 26 27 28 29 30

###
# calfeld@cs.utah.edu
# This some ugly/interesting tcl hacking to figure out what variables the user
# stored the node ids in.
###
rename set real_set
real_set skipset 0
proc set {args} {
    global skipset
    global nodeid_map
31
    global rid_map
Mac Newbold's avatar
Mac Newbold committed
32 33 34
    if {! $skipset} {
	real_set skipset 1
	real_set var [lindex $args 0]
35
	if {$var != "currnode" && $var != "currlan"} {
Mac Newbold's avatar
Mac Newbold committed
36
	    if {[llength $args] > 1} {
37
		# Munge var in case it's a variable
38
		regsub -all {[(]} $var {-} out
39
		real_set var $out
40
		regsub -all {[)]} $var {} out
41
		real_set var $out
Mac Newbold's avatar
Mac Newbold committed
42
		real_set val [lindex $args 1]
43 44 45 46 47 48 49 50 51 52 53
		if {([regexp {^n[0-9]+$} $val] != 0) ||
		    ([regexp {^lan[0-9]+$} $val] != 0) ||
		    ([regexp {^l[0-9]+$} $val] != 0)} {
		    # Ok, we change it so that the variable will hold
		    # it's own name.  We still need nodeid_map for
		    # classes to find their names.  rid_map is the
		    # reverse mapping of nodeid_map
		    # XXX - might be cleaner to have a class variable
		    # that we set here instead of using the nodeid_map.
		    if {([llength $args] == 2) &&
			(![info exists nodeid_map($val)])} {
Mac Newbold's avatar
Mac Newbold committed
54
			real_set nodeid_map($val) $var
55 56
			real_set rid_map($var) $val
			real_set args [list [lindex $args 0] $var]
Mac Newbold's avatar
Mac Newbold committed
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
		    }
		}
	    }
	}
	real_set skipset 0
    }
    if {[llength $args] == 1} {
	return [uplevel real_set [lindex $args 0]]
    } else {
	return [uplevel real_set [lindex $args 0] \{[lindex $args 1]\}]
    }
}
###

#nop is used for unimplemented $ns instprocs that are supposed to
#return things. the instproc returns a nop, which users call in their
#ns input file. 
proc nop {args} {}

#begin at 0. 1,2,3... i cheerfully ignore the possibility of wrapping...
set nodeID 0
set linkID 0
79
set lanID 0
Mac Newbold's avatar
Mac Newbold committed
80 81 82 83 84 85 86 87
set eventID 0

set nodelist {}

set linkslist {}

set eventlist {}

88 89
set lanlist {}

Mac Newbold's avatar
Mac Newbold committed
90 91 92 93 94 95 96 97 98 99
# sim.tcl handles the ns Simulator methods
source $libdir/sim.tcl

# stubs.tcl contains a lot of dummy things to allow execution of 
# ns files without going through the trouble of redoing ns or something.
# i fear that it will grow without bound (or at least until I give up and
# make this whole thing into an ns add-on and keep all of the ns behavior)

source $libdir/stubs.tcl
 
100
set prefix $id
Mac Newbold's avatar
Mac Newbold committed
101

102 103 104
# Copy in tb_compat.tcl
file copy -force $tbcompat [file dirname $nsfile]
source $nsfile