diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2007-11-16 14:11:50 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2007-11-16 14:11:50 (GMT) |
commit | 837b9c9c7f6f3f01e286eb8ab111b268eba47842 (patch) | |
tree | 752c216216cf230e79bafdc10e22bb4d6d97502c /generic/tclCmdIL.c | |
parent | 7ac80cab9e7494b78ed8010a98bd096e83cd5955 (diff) | |
download | tcl-837b9c9c7f6f3f01e286eb8ab111b268eba47842.zip tcl-837b9c9c7f6f3f01e286eb8ab111b268eba47842.tar.gz tcl-837b9c9c7f6f3f01e286eb8ab111b268eba47842.tar.bz2 |
Greatly improved ensemble compiler. This one now can handle any ensemble.
It is usually not enabled though; only worth it when a subcommand is actually
expected to undergo bytecode compilation.
Diffstat (limited to 'generic/tclCmdIL.c')
-rw-r--r-- | generic/tclCmdIL.c | 70 |
1 files changed, 36 insertions, 34 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 2647a4c..8c3262e 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.125 2007/11/14 23:05:01 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.126 2007/11/16 14:11:51 dkf Exp $ */ #include "tclInt.h" @@ -152,30 +152,31 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, static const struct { const char *name; /* The name of the subcommand. */ Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ + CompileProc *compileProc; /* The compiler for the subcommand. */ } defaultInfoMap[] = { - {"args", InfoArgsCmd}, - {"body", InfoBodyCmd}, - {"cmdcount", InfoCmdCountCmd}, - {"commands", InfoCommandsCmd}, - {"complete", InfoCompleteCmd}, - {"default", InfoDefaultCmd}, - {"exists", TclInfoExistsCmd}, - {"frame", InfoFrameCmd}, - {"functions", InfoFunctionsCmd}, - {"globals", TclInfoGlobalsCmd}, - {"hostname", InfoHostnameCmd}, - {"level", InfoLevelCmd}, - {"library", InfoLibraryCmd}, - {"loaded", InfoLoadedCmd}, - {"locals", TclInfoLocalsCmd}, - {"nameofexecutable",InfoNameOfExecutableCmd}, - {"patchlevel", InfoPatchLevelCmd}, - {"procs", InfoProcsCmd}, - {"script", InfoScriptCmd}, - {"sharedlibextension", InfoSharedlibCmd}, - {"tclversion", InfoTclVersionCmd}, - {"vars", TclInfoVarsCmd}, - {NULL, NULL} + {"args", InfoArgsCmd, NULL}, + {"body", InfoBodyCmd, NULL}, + {"cmdcount", InfoCmdCountCmd, NULL}, + {"commands", InfoCommandsCmd, NULL}, + {"complete", InfoCompleteCmd, NULL}, + {"default", InfoDefaultCmd, NULL}, + {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd}, + {"frame", InfoFrameCmd, NULL}, + {"functions", InfoFunctionsCmd, NULL}, + {"globals", TclInfoGlobalsCmd, NULL}, + {"hostname", InfoHostnameCmd, NULL}, + {"level", InfoLevelCmd, NULL}, + {"library", InfoLibraryCmd, NULL}, + {"loaded", InfoLoadedCmd, NULL}, + {"locals", TclInfoLocalsCmd, NULL}, + {"nameofexecutable", InfoNameOfExecutableCmd, NULL}, + {"patchlevel", InfoPatchLevelCmd, NULL}, + {"procs", InfoProcsCmd, NULL}, + {"script", InfoScriptCmd, NULL}, + {"sharedlibextension", InfoSharedlibCmd, NULL}, + {"tclversion", InfoTclVersionCmd, NULL}, + {"vars", TclInfoVarsCmd, NULL}, + {NULL, NULL, NULL} }; /* @@ -395,8 +396,13 @@ TclInitInfoCmd( if (tclNsPtr == NULL) { Tcl_Panic("unable to find or create ::tcl namespace!"); } + tclNsPtr = Tcl_FindNamespace(interp, "::tcl::info", NULL, + TCL_CREATE_NS_IF_UNKNOWN); + if (tclNsPtr == NULL) { + Tcl_Panic("unable to find or create ::tcl::info namespace!"); + } ensemble = Tcl_CreateEnsemble(interp, "::info", tclNsPtr, - TCL_ENSEMBLE_PREFIX); + TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE); if (ensemble != NULL) { Tcl_Obj *mapDict; int i; @@ -404,23 +410,19 @@ TclInitInfoCmd( TclNewObj(mapDict); for (i=0 ; defaultInfoMap[i].name != NULL ; i++) { Tcl_Obj *fromObj, *toObj; + Command *cmdPtr; fromObj = Tcl_NewStringObj(defaultInfoMap[i].name, -1); - TclNewLiteralStringObj(toObj, "::tcl::Info_"); + TclNewLiteralStringObj(toObj, "::tcl::info::"); Tcl_AppendToObj(toObj, defaultInfoMap[i].name, -1); Tcl_DictObjPut(NULL, mapDict, fromObj, toObj); - Tcl_CreateObjCommand(interp, TclGetString(toObj), - defaultInfoMap[i].proc, NULL, NULL); + cmdPtr = (Command *) Tcl_CreateObjCommand(interp, + TclGetString(toObj), defaultInfoMap[i].proc, NULL, NULL); + cmdPtr->compileProc = defaultInfoMap[i].compileProc; } Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict); } - /* - * Enable compilation of the [info exists] subcommand. - */ - - ((Command *)ensemble)->compileProc = &TclCompileInfoCmd; - return ensemble; } |