summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclClock.c66
-rw-r--r--generic/tclEnsemble.c20
-rw-r--r--library/init.tcl15
3 files changed, 61 insertions, 40 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
diff --git a/library/init.tcl b/library/init.tcl
index 87e84e4..824f66f 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -45,6 +45,7 @@ if {![info exists auto_path]} {
set auto_path ""
}
}
+
namespace eval tcl {
variable Dir
foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
@@ -169,9 +170,16 @@ if {[interp issafe]} {
namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library]
- proc ::tcl::initClock {} {
- # Auto-loading stubs for 'clock.tcl'
+ proc clock args {
+ set cmdmap [dict create]
+ foreach cmd {add clicks format microseconds milliseconds scan seconds configure} {
+ dict set cmdmap $cmd ::tcl::clock::$cmd
+ }
+ namespace eval ::tcl::clock [list namespace ensemble create -command \
+ [uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \
+ -map $cmdmap -compile 1]
+ # Auto-loading stubs for 'clock.tcl'
foreach cmd {mcget LocalizeFormat SetupTimeZone GetSystemTimeZone} {
proc ::tcl::clock::$cmd args {
variable TclLibDir
@@ -180,9 +188,8 @@ if {[interp issafe]} {
}
}
- rename ::tcl::initClock {}
+ return [uplevel 1 [info level 0]]
}
- ::tcl::initClock
}
# Conditionalize for presence of exec.