summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2017-05-10 12:29:54 (GMT)
committersebres <sebres@users.sourceforge.net>2017-05-10 12:29:54 (GMT)
commitefee121d8db22043e295d65a80ec3486ee0ac6fb (patch)
tree652c18c95e51b2d10f06d292f095643d11f1936e /generic
parent8482cde58cabe42d58e50e08a72e9b78298df93c (diff)
downloadtcl-efee121d8db22043e295d65a80ec3486ee0ac6fb.zip
tcl-efee121d8db22043e295d65a80ec3486ee0ac6fb.tar.gz
tcl-efee121d8db22043e295d65a80ec3486ee0ac6fb.tar.bz2
Ensemble "clock" fixed after merge with kbk's clock ensemble solution. All commands (including new) compiled now also in ensemble (implemented without TclMakeEnsemble, because it can be extended via new map entries).
Ensemble handling partially cherry-picked from new performance branch (TODO: check temporary "-compile" option can be reverted if it becomes ready/merged).
Diffstat (limited to 'generic')
-rw-r--r--generic/tclClock.c66
-rw-r--r--generic/tclEnsemble.c20
2 files changed, 50 insertions, 36 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 8e176b6..ad3d6e7 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -17,6 +17,7 @@
#include "tclInt.h"
#include "tclStrIdxTree.h"
#include "tclDate.h"
+#include "tclCompile.h"
/*
* Windows has mktime. The configurators do not check.
@@ -152,21 +153,29 @@ struct ClockCommand {
Tcl_ObjCmdProc *objCmdProc; /* Function that implements the command. This
* will always have the ClockClientData sent
* to it, but may well ignore this data. */
+ CompileProc *compileProc; /* The compiler for the command. */
+ ClientData clientData; /* Any clientData to give the command (if NULL
+ * a reference to ClockClientData will be sent) */
};
static const struct ClockCommand clockCommands[] = {
- { "getenv", ClockGetenvObjCmd },
- { "format", ClockFormatObjCmd },
- { "scan", ClockScanObjCmd },
- { "configure", ClockConfigureObjCmd },
- { "Oldscan", TclClockOldscanObjCmd },
- { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd },
- { "GetDateFields", ClockGetdatefieldsObjCmd },
- { "GetJulianDayFromEraYearMonthDay",
- ClockGetjuliandayfromerayearmonthdayObjCmd },
- { "GetJulianDayFromEraYearWeekDay",
- ClockGetjuliandayfromerayearweekdayObjCmd },
- { NULL, NULL }
+ {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL},
+ {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)},
+ {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)},
+ {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL},
+ {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)},
+ {"configure", ClockConfigureObjCmd, NULL, NULL},
+ {"Oldscan", TclClockOldscanObjCmd, NULL, NULL},
+ {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL},
+ {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL},
+ {"GetJulianDayFromEraYearMonthDay",
+ ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL},
+ {"GetJulianDayFromEraYearWeekDay",
+ ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL},
+ {NULL, NULL, NULL, NULL}
};
/*
@@ -195,22 +204,10 @@ TclClockInit(
char cmdName[50]; /* Buffer large enough to hold the string
*::tcl::clock::GetJulianDayFromEraYearMonthDay
* plus a terminating NUL. */
+ Command *cmdPtr;
ClockClientData *data;
int i;
- /* Structure of the 'clock' ensemble */
-
- static const EnsembleImplMap clockImplMap[] = {
- {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
- {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0},
- {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
- {"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0},
- {"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0},
- {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0},
- {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0},
- {NULL, NULL, NULL, NULL, NULL, 0}
- };
-
/*
* Safe interps get [::clock] as alias to a master, so do not need their
* own copies of the support routines.
@@ -258,21 +255,24 @@ TclClockInit(
/*
* Install the commands.
- * TODO - Let Tcl_MakeEnsemble do this?
*/
#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
+ ClientData clientData;
+
strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
- data->refCount++;
- Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
- ClockDeleteCmdProc);
+ if (!(clientData = clockCmdPtr->clientData)) {
+ clientData = data;
+ data->refCount++;
+ }
+ cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName,
+ clockCmdPtr->objCmdProc, clientData,
+ clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc);
+ cmdPtr->compileProc = clockCmdPtr->compileProc ?
+ clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd;
}
-
- /* Make the clock ensemble */
-
- TclMakeEnsemble(interp, "clock", clockImplMap);
}
/*
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index c1b0890..2480685 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -55,11 +55,12 @@ enum EnsSubcmds {
};
static const char *const ensembleCreateOptions[] = {
- "-command", "-map", "-parameters", "-prefixes", "-subcommands",
- "-unknown", NULL
+ "-command", "-compile", "-map", "-parameters", "-prefixes",
+ "-subcommands", "-unknown", NULL
};
enum EnsCreateOpts {
- CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
+ CRT_CMD, CRT_COMPILE, CRT_MAP, CRT_PARAM, CRT_PREFIX,
+ CRT_SUBCMDS, CRT_UNKNOWN
};
static const char *const ensembleConfigOptions[] = {
@@ -183,6 +184,7 @@ TclNamespaceEnsembleCmd(
int permitPrefix = 1;
Tcl_Obj *unknownObj = NULL;
Tcl_Obj *paramObj = NULL;
+ int ensCompFlag = -1;
/*
* Check that we've got option-value pairs... [Bug 1558654]
@@ -325,6 +327,12 @@ TclNamespaceEnsembleCmd(
return TCL_ERROR;
}
continue;
+ case CRT_COMPILE:
+ if (Tcl_GetBooleanFromObj(interp, objv[1],
+ &ensCompFlag) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ continue;
case CRT_UNKNOWN:
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
if (allocatedMapFlag) {
@@ -350,6 +358,12 @@ TclNamespaceEnsembleCmd(
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
Tcl_SetEnsembleParameterList(interp, token, paramObj);
+ /*
+ * Ensemble should be compiled if it has map (performance purposes)
+ */
+ if (ensCompFlag > 0 && mapObj != NULL) {
+ Tcl_SetEnsembleFlags(interp, token, ENSEMBLE_COMPILE);
+ }
/*
* Tricky! Must ensure that the result is not shared (command delete