summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-11-21 14:30:22 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-11-21 14:30:22 (GMT)
commit6e360c3d1ad0bbf16377cf5d2d9f8eac1f8092a8 (patch)
tree833b08f4554fe3791997147f2fbf9f826b62860b
parent98ce25af617901be6af682a617c9b35abee2c548 (diff)
downloadtcl-6e360c3d1ad0bbf16377cf5d2d9f8eac1f8092a8.zip
tcl-6e360c3d1ad0bbf16377cf5d2d9f8eac1f8092a8.tar.gz
tcl-6e360c3d1ad0bbf16377cf5d2d9f8eac1f8092a8.tar.bz2
Factor out the core compiled-ensemble builder for simplicity.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdIL.c45
-rw-r--r--generic/tclInt.h18
-rw-r--r--generic/tclNamesp.c76
4 files changed, 98 insertions, 47 deletions
diff --git a/ChangeLog b/ChangeLog
index 81a3205..7d9ae95 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,8 @@
-2007-10-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+2007-11-21 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
+
+ * generic/tclNamesp.c (TclMakeEnsemble): Factor out the code to set up
+ a core ensemble from a table of information about subcommands, ready
+ for reuse within the core.
* generic/various: Start to return more useful Error codes, currently
mainly on assorted lookup failures.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 8c3262e..8d05eba 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.126 2007/11/16 14:11:51 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.127 2007/11/21 14:30:31 dkf Exp $
*/
#include "tclInt.h"
@@ -149,11 +149,7 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
* "info" command.
*/
-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[] = {
+static const EnsembleImplMap defaultInfoMap[] = {
{"args", InfoArgsCmd, NULL},
{"body", InfoBodyCmd, NULL},
{"cmdcount", InfoCmdCountCmd, NULL},
@@ -388,42 +384,7 @@ Tcl_Command
TclInitInfoCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
- Tcl_Command ensemble; /* The overall ensemble. */
- Tcl_Namespace *tclNsPtr; /* Reference to the "::tcl" namespace. */
-
- tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
- TCL_CREATE_NS_IF_UNKNOWN);
- 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 | ENSEMBLE_COMPILE);
- if (ensemble != NULL) {
- Tcl_Obj *mapDict;
- int i;
-
- 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::");
- Tcl_AppendToObj(toObj, defaultInfoMap[i].name, -1);
- Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
- cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
- TclGetString(toObj), defaultInfoMap[i].proc, NULL, NULL);
- cmdPtr->compileProc = defaultInfoMap[i].compileProc;
- }
- Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
- }
-
- return ensemble;
+ return TclMakeEnsemble(interp, "info", defaultInfoMap);
}
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 479232b..f726571 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.349 2007/11/20 20:43:12 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.350 2007/11/21 14:30:34 dkf Exp $
*/
#ifndef _TCLINT
@@ -1291,7 +1291,6 @@ typedef struct ExecStack {
Tcl_Obj *stackWords[1];
} ExecStack;
-
/*
* The data structure defining the execution environment for ByteCode's.
* There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
@@ -1394,6 +1393,17 @@ typedef struct ByteCodeStats {
#endif /* TCL_COMPILE_STATS */
/*
+ * Structure used in implementation of those core ensembles which are
+ * partially compiled.
+ */
+
+typedef struct {
+ const char *name; /* The name of the subcommand. */
+ Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */
+ CompileProc *compileProc; /* The compiler for the subcommand. */
+} EnsembleImplMap;
+
+/*
*----------------------------------------------------------------
* Data structures related to commands.
*----------------------------------------------------------------
@@ -1880,7 +1890,7 @@ typedef struct Interp {
} Interp;
/*
- * Macros that use the TSD-ekeko
+ * Macros that use the TSD-ekeko.
*/
#define TclAsyncReady(iPtr) \
@@ -2521,6 +2531,8 @@ MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
int indexCount, Tcl_Obj *const indexArray[],
Tcl_Obj *valuePtr);
+MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
+ const EnsembleImplMap map[]);
MODULE_SCOPE int TclMarkList(Tcl_Interp *interp, const char *list,
const char *end, int *argcPtr,
const int **argszPtr, const char ***argvPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index bab0684..d8023a7 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.157 2007/11/19 11:02:40 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.158 2007/11/21 14:30:34 dkf Exp $
*/
#include "tclInt.h"
@@ -5875,6 +5875,80 @@ Tcl_IsEnsemble(
/*
*----------------------------------------------------------------------
*
+ * TclMakeEnsemble --
+ *
+ * Create an ensemble from a table of implementation commands. The
+ * ensemble will be subject to (limited) compilation if any of the
+ * implementation commands are compilable.
+ *
+ * Results:
+ * Handle for the ensemble, or NULL if creation of it fails.
+ *
+ * Side effects:
+ * May advance bytecode compilation epoch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclMakeEnsemble(
+ Tcl_Interp *interp,
+ const char *name,
+ const EnsembleImplMap map[])
+{
+ Tcl_Command ensemble; /* The overall ensemble. */
+ Tcl_Namespace *tclNsPtr; /* Reference to the "::tcl" namespace. */
+ Tcl_DString buf;
+
+ tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
+ TCL_CREATE_NS_IF_UNKNOWN);
+ if (tclNsPtr == NULL) {
+ Tcl_Panic("unable to find or create ::tcl namespace!");
+ }
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, "::tcl::", -1);
+ Tcl_DStringAppend(&buf, name, -1);
+ tclNsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
+ TCL_CREATE_NS_IF_UNKNOWN);
+ if (tclNsPtr == NULL) {
+ Tcl_Panic("unable to find or create %s namespace!",
+ Tcl_DStringValue(&buf));
+ }
+ ensemble = Tcl_CreateEnsemble(interp, Tcl_DStringValue(&buf)+5, tclNsPtr,
+ TCL_ENSEMBLE_PREFIX);
+ Tcl_DStringAppend(&buf, "::", -1);
+ if (ensemble != NULL) {
+ Tcl_Obj *mapDict;
+ int i, compile = 0;
+
+ TclNewObj(mapDict);
+ for (i=0 ; map[i].name != NULL ; i++) {
+ Tcl_Obj *fromObj, *toObj;
+ Command *cmdPtr;
+
+ fromObj = Tcl_NewStringObj(map[i].name, -1);
+ TclNewStringObj(toObj, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf));
+ Tcl_AppendToObj(toObj, map[i].name, -1);
+ Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
+ cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
+ TclGetString(toObj), map[i].proc, NULL, NULL);
+ cmdPtr->compileProc = map[i].compileProc;
+ compile |= (map[i].compileProc != NULL);
+ }
+ Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
+ if (compile) {
+ Tcl_SetEnsembleFlags(interp, ensemble,
+ TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
+ }
+ }
+
+ return ensemble;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NsEnsembleImplementationCmd --
*
* Implements an ensemble of commands (being those exported by a