我有以下程序：
rename proc _proc
_proc proc {name args body} {
global pass_log_trace
set g_log_trace "0"
if {[info exists pass_log_trace]} {
set g_log_trace $pass_log_trace
}
# simple check if we have double declaration of the same procedure
if {[info procs $name] != ""} {
puts "\nERROR: redeclaration of procedure: $name"
}
_proc $name $args $body
if {$g_log_trace != 0} {
trace add execution $name enter trace_report_enter
trace add execution $name leave trace_report_leave
}
}
它是从使用 Tcl 解释器C 库构建的 C shell 调用的。shell的代码如下：
#define _GNU_SOURCE
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <getopt.h>
#include <signal.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <tcl.h>
#include <readline/readline.h>
#include <readline/history.h>
/* Global variables */
static char init_file[256];
static char history_file[256];
static pid_t sfg_pid;
static Tcl_Interp *tcl_interp = NULL;
static int help(char *prog);
/**
* Print the application help.
* @param prog
* @return
*/
static int
help(char *prog)
{
printf("Usage: %s [OPTIONS]\n", prog);
printf("\n");
printf(" -h|-? Print this message and exit.\n");
printf(" --init/-i file Source this file when tcl is started.\n");
printf(" --history/-f file Read/Save history using this existing file.\n");
printf(" --log/-l file Save the Tcl log to the specified file.\n");
printf("\n");
exit(EXIT_SUCCESS);
}
int
main(int argc, char ** argv)
{
const int buf_size = 1024;
const useconds_t sfg_init_tmo_usec = 100000;
char buf[buf_size+1];
int rc;
char *inp = NULL;
char pwd[buf_size+1];
int hfile;
char *prompt = NULL;
int c;
int option_index = 0;
struct option long_options[] = {
/*name arg flag val */
{"help", 0, 0, 'h'},
{"init", 1, 0, 'i'},
{"log", 1, 0, 'l'},
{"configuration", 1, 0, 'c'},
{0, 0, 0, 0}
};
/* default values */
strcpy(init_file, "log_init.tcl");
sfg_pid = 0;
/**
* Options processing...
*/
while ((c = getopt_long (argc, argv, "?hi:f:s:t:p:b:l:c:er",
long_options, &option_index)) != -1) {
switch (c) {
case 'h':
case '?':
help(argv[0]);
break;
case 'i':
strncpy(init_file, optarg, sizeof(init_file)-1);
break;
default:
printf ("?? getopt returned character code %c ??\n", c);
}
}
if (optind < argc) {
printf ("non-option ARGV-elements: ");
while (optind < argc)
printf ("%s ", argv[optind++]);
printf ("\n");
exit(EXIT_FAILURE);
}
/**
* Start and configure tcl interpreter
*/
if ((tcl_interp = Tcl_CreateInterp()) == NULL) {
printf("Could not create Tcl interpreter: %s\n", Tcl_ErrnoMsg(Tcl_GetErrno()));
exit(EXIT_FAILURE);
}
/* allocate a prompt string, default to diag_tcl> , link to TCL variable */
if ((prompt = Tcl_Alloc(256)) == NULL) {
printf("Cannot allocate a prompt variable: %s\n", tcl_interp->result);
exit(EXIT_FAILURE);
}
strncpy(prompt, "diag_tcl> ", 256);
if (Tcl_LinkVar(tcl_interp, "g_shell_prompt", (char *)&prompt, TCL_LINK_STRING) != TCL_OK) {
printf("Unable to link to a prompt global variable: %s\n", tcl_interp->result);
}
/* Source an init file if specified */
if (init_file[0]) {
strcpy(buf, "source ");
strncat(buf, init_file, (buf_size - strlen(buf)));
if ((rc = Tcl_Eval(tcl_interp, buf)) != TCL_OK) {
printf("Tcl Interpreter Error: %s\n", tcl_interp->result);
}
}
/**
* Main single command loop
*/
while (1) {
if (inp) {
free(inp);
inp = NULL;
}
inp = readline(prompt);
if (inp == NULL)
break;
if (*inp == '\n' || *inp == '\r' || *inp == 0) {
continue;
}
if (feof(stdin))
break;
if ((rc = Tcl_Eval(tcl_interp, inp)) != TCL_OK) {
printf("Tcl Interpreter Error: %s\n",
Tcl_GetVar(tcl_interp, "errorInfo", TCL_GLOBAL_ONLY));
}
}
return 0;
}
生成文件：
INC=-I/net/tools/include
LIB=-L/net/tools/lib -L/lib32 -L/usr/lib -m32
BIN=diag.lin
GCC = gcc
all: diag_tclsh
diag_tclsh: diag_tclsh.c
$(GCC) $^ $(INC) $(LIB) -ltcl8.4 -lreadline -lncurses -ltermcap -o $@
install:
cp -f strad /net/tools/bin/$(BIN)
clean:
-rm -f diag_tclsh
此过程的目的主要是为代码中的所有过程添加入口和出口点跟踪器。但是，由于某种原因，它也删除了命名空间范围。例如，这样的代码：
namespace eval bob {
namespace eval joe {
proc proc1 {} {}
}
proc proc2 {} {
puts "proc2"
}
}
puts "Namespace calling [info procs ::bob\::*]"
不会在bob命名空间中创建过程，而是在全局命名空间中。调用namespace current总是返回::。
有任何想法吗？