diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclAssembly.c | 20 | ||||
| -rw-r--r-- | generic/tclClock.c | 20 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 99 | ||||
| -rw-r--r-- | generic/tclCompile.c | 5 | ||||
| -rw-r--r-- | generic/tclCompile.h | 4 | ||||
| -rw-r--r-- | generic/tclExecute.c | 33 | ||||
| -rw-r--r-- | generic/tclInt.h | 6 |
7 files changed, 174 insertions, 13 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index f56da8f..120fd9a 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -137,6 +137,8 @@ typedef enum TalInstType { * ranges */ ASSEM_BOOL, /* One Boolean operand */ ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */ + ASSEM_CLOCK_READ, /* 1-byte unsigned-integer case number, in the + * range 0-3 */ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must * be strictly positive, consumes N, produces * 1 */ @@ -350,6 +352,7 @@ static const TalInstDesc TalInstructionTable[] = { {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, + {"clockRead", ASSEM_CLOCK_READ, INST_CLOCK_READ, 0, 1}, {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, @@ -1363,6 +1366,23 @@ AssembleOneLine( TclEmitInt4(localVar, envPtr); break; + case ASSEM_CLOCK_READ: + if (parsePtr->numWords != 2) { + Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8"); + goto cleanup; + } + if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { + goto cleanup; + } + if (opnd < 0 || opnd > 3) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("operand must be [0..3]", -1)); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL); + goto cleanup; + } + BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd); + break; + case ASSEM_CONCAT1: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8"); diff --git a/generic/tclClock.c b/generic/tclClock.c index bb9fbeb..02b2845 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -208,11 +208,7 @@ struct ClockCommand { }; static const struct ClockCommand clockCommands[] = { - { "clicks", ClockClicksObjCmd }, { "getenv", ClockGetenvObjCmd }, - { "microseconds", ClockMicrosecondsObjCmd }, - { "milliseconds", ClockMillisecondsObjCmd }, - { "seconds", ClockSecondsObjCmd }, { "Oldscan", TclClockOldscanObjCmd }, { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, { "GetDateFields", ClockGetdatefieldsObjCmd }, @@ -256,14 +252,14 @@ TclClockInit( /* Structure of the 'clock' ensemble */ static const EnsembleImplMap clockImplMap[] = { - {"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"clicks", NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, - {"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"microseconds", NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, - {"milliseconds", NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, - {"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"seconds", NULL, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, - {NULL, NULL, NULL, NULL, NULL, 0} + {"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} }; /* diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 7dba232..635447c 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -734,6 +734,105 @@ TclCompileCatchCmd( return TCL_OK; } +/*---------------------------------------------------------------------- + * + * TclCompileClockClicksCmd -- + * + * Procedure called to compile the "tcl::clock::clicks" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to run time. + * + * Side effects: + * Instructions are added to envPtr to execute the "clock clicks" + * command at runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileClockClicksCmd( + Tcl_Interp* interp, /* Tcl interpreter */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token* tokenPtr; + + switch (parsePtr->numWords) { + case 1: + /* + * No args + */ + TclEmitInstInt1(INST_CLOCK_READ, 0, envPtr); + break; + case 2: + /* + * -milliseconds or -microseconds + */ + tokenPtr = TokenAfter(parsePtr->tokenPtr); + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD + || tokenPtr[1].size < 4 + || tokenPtr[1].size > 13) { + return TCL_ERROR; + } else if (!strncmp(tokenPtr[1].start, "-microseconds", + tokenPtr[1].size)) { + TclEmitInstInt1(INST_CLOCK_READ, 1, envPtr); + break; + } else if (!strncmp(tokenPtr[1].start, "-milliseconds", + tokenPtr[1].size)) { + TclEmitInstInt1(INST_CLOCK_READ, 2, envPtr); + break; + } else { + return TCL_ERROR; + } + default: + return TCL_ERROR; + } + return TCL_OK; +} + + +/*---------------------------------------------------------------------- + * + * TclCompileClockReadingCmd -- + * + * Procedure called to compile the "tcl::clock::microseconds", + * "tcl::clock::milliseconds" and "tcl::clock::seconds" commands. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to run time. + * + * Side effects: + * Instructions are added to envPtr to execute the "clock clicks" + * command at runtime. + * + * Client data is 1 for microseconds, 2 for milliseconds, 3 for seconds. + *---------------------------------------------------------------------- + */ + +int +TclCompileClockReadingCmd( + Tcl_Interp* interp, /* Tcl interpreter */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + if (parsePtr->numWords != 1) { + return TCL_ERROR; + } + + TclEmitInstInt1(INST_CLOCK_READ, PTR2INT(cmdPtr->objClientData), envPtr); + + return TCL_OK; +} + /* *---------------------------------------------------------------------- * diff --git a/generic/tclCompile.c b/generic/tclCompile.c index f6b3c52..f716195 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -654,6 +654,11 @@ InstructionDesc const tclInstructionTable[] = { /* Lappend list to general variable. * Stack: ... varName list => ... listVarContents */ + {"clockRead", 2, +1, 1, {OPERAND_UINT1}}, + /* Read clock out to the stack. Operand is which clock to read + * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds. + * Stack: ... => ... time */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index ba6ad44..e5d026c 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -821,8 +821,10 @@ typedef struct ByteCode { #define INST_LAPPEND_LIST_ARRAY_STK 187 #define INST_LAPPEND_LIST_STK 188 +#define INST_CLOCK_READ 189 + /* The last opcode */ -#define LAST_INST_OPCODE 188 +#define LAST_INST_OPCODE 189 /* * Table describing the Tcl bytecode instructions: their name (for displaying diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 1d3a825..4250958 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -7840,6 +7840,39 @@ TEBCresume( * ----------------------------------------------------------------- */ + case INST_CLOCK_READ: + { /* Read the wall clock */ + Tcl_WideInt wval; + Tcl_Time now; + switch(TclGetUInt1AtPtr(pc+1)) { + case 0: /* clicks */ +#ifdef TCL_WIDE_CLICKS + wval = TclpGetWideClicks(); +#else + wval = (Tcl_WideInt) TclpGetClicks(); +#endif + break; + case 1: /* microseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt) now.sec * 1000000 + now.usec; + break; + case 2: /* milliseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000; + break; + case 3: /* seconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt) now.sec; + break; + default: + Tcl_Panic("clockRead instruction with unknown clock#"); + } + /* TclNewWideObj(objResultPtr, wval); doesn't exist */ + objResultPtr = Tcl_NewWideIntObj(wval); + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(2, 0, 1); + } + default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); } /* end of switch on opCode */ diff --git a/generic/tclInt.h b/generic/tclInt.h index 3749735..1deda3c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3478,6 +3478,12 @@ MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileClockClicksCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileClockReadingCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); |