1: #! /usr/bin/tcl 2: 3: 4: proc test_proc1 {arg} { 5: puts "heh: [test_proc2 $arg jim]" 6: } 7: 8: proc test_proc2 {bob joe} { 9: puts "whee: $joe $bob" 10: return joe 11: } 12: 13: proc unknown args { 14: global TOTALEXECTIME EXECCNT DEBUG 15: set oldcmd [lindex $args 0] 16: set realcmd "${oldcmd}_real" 17: if {([info proc $realcmd]=="" && [info command $realcmd]=="") || [string match "*_real" $oldcmd]} { 18: return [error "Unknown command: $oldcmd \[$realcmd\]"] 19: } 20: 21: if {![info exists TOTALEXECTIME($oldcmd)]} { set TOTALEXECTIME($oldcmd) 0 } 22: if {![info exists EXECCNT($oldcmd)]} { set EXECCNT($oldcmd) 0 } 23: set times [time { 24: set ret [uplevel 1 [lreplace $args 0 0 $realcmd]] 25: }] 26: 27: set usectime [lindex $times 0] 28: incr TOTALEXECTIME($oldcmd) $usectime 29: incr EXECCNT($oldcmd) 30: puts stderr "$args\[$EXECCNT($oldcmd)\]: $usectime usec (total=$TOTALEXECTIME($oldcmd) usec)" 31: return $ret 32: } 33: 34: foreach jproc [join [list [info procs]]] { 35: if {$jproc=="unknown" || [string match "*_real" $jproc]} { continue } 36: rename $jproc ${jproc}_real 37: } 38: 39: test_proc1 sally 40: test_proc2 bobby wally |