#!/usr/local/bin/tcl
#
proc findEm {pname which} {

	upvar #0 $which$pname tree
	global level
	upvar #0 ${which}fp fp
	upvar #0 counter$which pcount

#	echo "$which$pname (global) is aliased to tree"
#	echo [info var tree]

	set err [catch {array names tree}]
	if {$err} {
		echo "error on array names of $which$pname, end of line"
		return
	}
	incr level

	if {$pcount($pname) < $level} {
		echo "recursion detected, just return"
		incr level -1
		return
	} else {
		set pcount($pname) $level
	}

	echo "findEm $pname $which $level"
	foreach ndx [array names tree] {
		puts $fp "$level: $ndx"	
		findEm $ndx $which
	}
	incr level -1
	return
}
#
echo "args:  call list file produced by 'calling', and proc name to trace"
set froot [lindex $argv 0]
set lname [file root $infile]
set pname [lindex $argv 1]
set infile $froot.callist
#
set callers {}
set callees {}
for_file line $infile {

	set line [string trim $line]

	if {$line == ""} {continue}

	if {[lindex $line 0] == "proc"} {
		set p [lindex $line 1]
#		echo "new proc $p"
		append callers "$p "
		set callees [lrmdups $callees]
		set counterA($p) 99999
		set counterB($p) 99999
		continue
	}

	set A${p}($line) 1
	set B${line}($p) 1
	append callees " $line "
}
# echo "callers:\n$callers"
# echo "callees:\n$callees"
#
# OK, we gots two lists of names, and two kinds of arrays:
#	Aname(name2) which means that name calls name2, and
#	Bname(name2) which means that name2 calls name
#	we ought to be able to do anything from here.
#
set caller 1
set callee 1
if {[lsearch $callers $pname] < 0} {
	echo "proc $pname did not call any other procs"
	catch {echo "but was called by [array names B$pname]"}
	set caller 0
} else {
	catch {echo "proc $pname called [array names A$pname]"}
}
if {[lsearch $callees $pname] < 0} {
	echo "proc $pname was not called by any other procs"
	catch {echo "but called [array names A$pname]"}
	set callee 0
} else {
	catch {echo "proc $pname was called by [array names B$pname]"}
}
catch {echo "A: [array names A$pname]"}
catch {echo "B: [array names B$pname]"}
#
# I don't think we are allowed to recurse in tcl...?
# but we'll find out!!
#
set Afp [open ${lname}_$pname.calls w]
set Bfp [open ${lname}_$pname.called w]
#
puts $Afp "0: $pname calls"
puts $Bfp "0: $pname called by"
#
set level 0
if {$caller} {
	findEm $pname A
}
#
if {$callee} {
	findEm $pname B
}
#
close $Afp
close $Bfp
#
