merge trunkinitsubsystems

1 files changed, 157 insertions, 36 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 041694f..b9bc228 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -54,7 +54,7 @@ static int		CompileDictEachCmd(Tcl_Interp *interp,
  * The structures below define the AuxData types defined in this file.
  */
 
-const AuxDataType tclForeachInfoType = {
+static const AuxDataType foreachInfoType = {
     "ForeachInfo",		/* name */
     DupForeachInfo,		/* dupProc */
     FreeForeachInfo,		/* freeProc */
@@ -62,7 +62,7 @@ const AuxDataType tclForeachInfoType = {
     DisassembleForeachInfo	/* disassembleProc */
 };
 
-const AuxDataType tclNewForeachInfoType = {
+static const AuxDataType newForeachInfoType = {
     "NewForeachInfo",		/* name */
     DupForeachInfo,		/* dupProc */
     FreeForeachInfo,		/* freeProc */
@@ -70,7 +70,7 @@ const AuxDataType tclNewForeachInfoType = {
     DisassembleNewForeachInfo	/* disassembleProc */
 };
 
-const AuxDataType tclDictUpdateInfoType = {
+static const AuxDataType dictUpdateInfoType = {
     "DictUpdateInfo",		/* name */
     DupDictUpdateInfo,		/* dupProc */
     FreeDictUpdateInfo,		/* freeProc */
@@ -81,6 +81,39 @@ const AuxDataType tclDictUpdateInfoType = {
 /*
  *----------------------------------------------------------------------
  *
+ * TclGetAuxDataType --
+ *
+ *	This procedure looks up an Auxdata type by name.
+ *
+ * Results:
+ *	If an AuxData type with name matching "typeName" is found, a pointer
+ *	to its AuxDataType structure is returned; otherwise, NULL is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+const AuxDataType *
+TclGetAuxDataType(
+    const char *typeName)	/* Name of AuxData type to look up. */
+{
+    if (!strcmp(typeName, foreachInfoType.name)) {
+	return &foreachInfoType;
+    } else if (!strcmp(typeName, newForeachInfoType.name)) {
+	return &newForeachInfoType;
+    } else if (!strcmp(typeName, dictUpdateInfoType.name)) {
+	return &dictUpdateInfoType;
+    } else if (!strcmp(typeName, tclJumptableInfoType.name)) {
+	return &tclJumptableInfoType;
+    }
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileAppendCmd --
  *
  *	Procedure called to compile the "append" command.
@@ -351,7 +384,7 @@ TclCompileArraySetCmd(
 	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
 	TclEmitOpcode(INST_POP,          			envPtr);
     }
-    
+
     /*
      * Prepare for the internal foreach.
      */
@@ -365,7 +398,7 @@ TclCompileArraySetCmd(
     infoPtr->varLists[0]->numVars = 2;
     infoPtr->varLists[0]->varIndexes[0] = keyVar;
     infoPtr->varLists[0]->varIndexes[1] = valVar;
-    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
+    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
 
     /*
      * Start issuing instructions to write to the array.
@@ -547,7 +580,7 @@ TclCompileCatchCmd(
     int resultIndex, optsIndex, range, dropScript = 0;
     DefineLineInformation;	/* TIP #280 */
     int depth = TclGetStackDepth(envPtr);
-    
+
     /*
      * If syntax does not match what we expect for [catch], do not compile.
      * Let runtime checks determine if syntax has changed.
@@ -626,7 +659,7 @@ TclCompileCatchCmd(
     }
     ExceptionRangeEnds(envPtr, range);
 
-    
+
     /*
      * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
      * and jump around the "error case" code.
@@ -636,14 +669,14 @@ TclCompileCatchCmd(
     PushStringLiteral(envPtr, "0");
     TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
 
-    /* 
+    /*
      * Emit the "error case" epilogue. Push the interpreter result and the
      * return code.
      */
 
     ExceptionRangeTarget(envPtr, range, catchOffset);
     TclSetStackDepth(depth + dropScript, envPtr);
-    
+
     if (dropScript) {
 	TclEmitOpcode(		INST_POP,			envPtr);
     }
@@ -701,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;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -768,7 +900,7 @@ TclCompileConcatCmd(
 	Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
 	objPtr = Tcl_ConcatObj(len, objs);
 	Tcl_DecrRefCount(listObj);
-	bytes = Tcl_GetStringFromObj(objPtr, &len);
+	bytes = TclGetStringFromObj(objPtr, &len);
 	PushLiteral(envPtr, bytes, len);
 	Tcl_DecrRefCount(objPtr);
 	return TCL_OK;
@@ -1176,7 +1308,7 @@ TclCompileDictCreateCmd(
      * We did! Excellent. The "verifyDict" is to do type forcing.
      */
 
-    bytes = Tcl_GetStringFromObj(dictObj, &len);
+    bytes = TclGetStringFromObj(dictObj, &len);
     PushLiteral(envPtr, bytes, len);
     TclEmitOpcode(		INST_DUP,			envPtr);
     TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
@@ -1669,7 +1801,7 @@ TclCompileDictUpdateCmd(
      * can't be snagged by literal sharing and forced to shimmer dangerously.
      */
 
-    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);
+    infoIndex = TclCreateAuxData(duiPtr, &dictUpdateInfoType, envPtr);
 
     for (i=0 ; i<numVars ; i++) {
 	CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2);
@@ -2530,7 +2662,7 @@ CompileEachloopCmd(
     ForeachInfo *infoPtr=NULL;	/* Points to the structure describing this
 				 * foreach command. Stored in a AuxData
 				 * record in the ByteCode. */
-    
+
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     int jumpBackOffset, infoIndex, range;
     int numWords, numLists, i, j, code = TCL_OK;
@@ -2617,7 +2749,7 @@ CompileEachloopCmd(
 	    int numBytes, varIndex;
 
 	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
-	    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
+	    bytes = TclGetStringFromObj(varNameObj, &numBytes);
 	    varIndex = LocalScalar(bytes, numBytes, envPtr);
 	    if (varIndex < 0) {
 		code = TCL_ERROR;
@@ -2632,16 +2764,16 @@ CompileEachloopCmd(
      * We will compile the foreach command.
      */
 
-    infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
+    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
 
     /*
      * Create the collecting object, unshared.
      */
-    
+
     if (collect == TCL_EACH_COLLECT) {
 	TclEmitInstInt4(INST_LIST, 0, envPtr);
     }
-	    
+
     /*
      * Evaluate each value list and leave it on stack.
      */
@@ -2655,7 +2787,7 @@ CompileEachloopCmd(
     }
 
     TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
-    
+
     /*
      * Inline compile the loop body.
      */
@@ -2665,7 +2797,7 @@ CompileEachloopCmd(
     ExceptionRangeStarts(envPtr, range);
     BODY(bodyTokenPtr, numWords - 1);
     ExceptionRangeEnds(envPtr, range);
-    
+
     if (collect == TCL_EACH_COLLECT) {
 	TclEmitOpcode(INST_LMAP_COLLECT, envPtr);
     } else {
@@ -2674,7 +2806,7 @@ CompileEachloopCmd(
 
     /*
      * Bottom of loop code: assign each loop variable and check whether
-     * to terminate the loop. Set the loop's break target. 
+     * to terminate the loop. Set the loop's break target.
      */
 
     ExceptionRangeTarget(envPtr, range, continueOffset);
@@ -2688,7 +2820,7 @@ CompileEachloopCmd(
      * Set the jumpback distance from INST_FOREACH_STEP to the start of the
      * body's code. Misuse loopCtTemp for storing the jump size.
      */
-    
+
     jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
 	    envPtr->exceptArrayPtr[range].codeOffset;
     infoPtr->loopCtTemp = -jumpBackOffset;
@@ -2701,7 +2833,7 @@ CompileEachloopCmd(
     if (collect != TCL_EACH_COLLECT) {
 	PushStringLiteral(envPtr, "");
     }
-    
+
     done:
     if (code == TCL_ERROR) {
 	FreeForeachInfo(infoPtr);
@@ -3054,7 +3186,7 @@ TclCompileFormatCmd(
      * literal. Job done.
      */
 
-    bytes = Tcl_GetStringFromObj(tmpObj, &len);
+    bytes = TclGetStringFromObj(tmpObj, &len);
     PushLiteral(envPtr, bytes, len);
     Tcl_DecrRefCount(tmpObj);
     return TCL_OK;
@@ -3125,7 +3257,7 @@ TclCompileFormatCmd(
 	    if (*++bytes == '%') {
 		Tcl_AppendToObj(tmpObj, "%", 1);
 	    } else {
-		char *b = Tcl_GetStringFromObj(tmpObj, &len);
+		char *b = TclGetStringFromObj(tmpObj, &len);
 
 		/*
 		 * If there is a non-empty literal from the format string,
@@ -3159,7 +3291,7 @@ TclCompileFormatCmd(
      */
 
     Tcl_AppendToObj(tmpObj, start, bytes - start);
-    bytes = Tcl_GetStringFromObj(tmpObj, &len);
+    bytes = TclGetStringFromObj(tmpObj, &len);
     if (len > 0) {
 	PushLiteral(envPtr, bytes, len);
 	i++;
@@ -3173,17 +3305,6 @@ TclCompileFormatCmd(
 	 */
 
 	TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
-    } else {
-	/*
-	 * EVIL HACK! Force there to be a string representation in the case
-	 * where there's just a "%s" in the format; case covered by the test
-	 * format-20.1 (and it is horrible...)
-	 */
-
-	TclEmitOpcode(INST_DUP, envPtr);
-	PushStringLiteral(envPtr, "");
-	TclEmitOpcode(INST_STR_EQ, envPtr);
-	TclEmitOpcode(INST_POP, envPtr);
     }
     return TCL_OK;
 }