Tcl Source Code

Artifact 0cbd02655638711963df249e56ff385ec46cc58a:

Attachment "nop4.patch" to ticket [451441ffff] added by msofer 2001-08-17 06:20:35.

---

? patch419528.txt
? patch451200.txt
? patch219184.txt
? nop3.patch
? nop4.patch
? generic/tclCompCmds.c.new
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.34
diff -u -r1.34 tclBasic.c
--- generic/tclBasic.c	2001/08/14 13:45:57	1.34
+++ generic/tclBasic.c	2001/08/16 23:11:12
@@ -459,6 +459,14 @@
     }
 
     /*
+     * Add the tcl::nop command.
+     */
+
+    cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::tcl::nop",
+	    Tcl_NopObjCmd, (ClientData) NULL, NULL);
+    cmdPtr->compileProc = TclCompileNopCmd;
+
+    /*
      * Register the builtin math functions.
      */
 
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.43
diff -u -r1.43 tclCmdMZ.c
--- generic/tclCmdMZ.c	2001/08/07 00:56:15	1.43
+++ generic/tclCmdMZ.c	2001/08/16 23:11:17
@@ -80,6 +80,33 @@
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_NopObjCmd --
+ *
+ *	This procedure is invoked to process the "tcl::nop" Tcl command.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_NopObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_PwdObjCmd --
  *
  *	This procedure is invoked to process the "pwd" Tcl command.
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.9
diff -u -r1.9 tclCompCmds.c
--- generic/tclCompCmds.c	2001/06/28 00:42:39	1.9
+++ generic/tclCompCmds.c	2001/08/16 23:11:18
@@ -1867,6 +1867,51 @@
 /*
  *----------------------------------------------------------------------
  *
+ * TclCompileNopCmd --
+ *
+ *	Procedure called to compile the "tcl::nop" command.
+ *
+ * Results:
+ *	The return value is TCL_OK, indicating successful compilation.
+ *
+ *	envPtr->maxStackDepth is updated with the maximum number of stack
+ *	elements needed to execute the command.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "tcl::nop" command
+ *	at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNopCmd(interp, parsePtr, envPtr)
+    Tcl_Interp *interp;         /* Used for error reporting. */
+    Tcl_Parse *parsePtr;        /* Points to a parse structure for the
+                                 * command created by Tcl_ParseCommand. */
+    CompileEnv *envPtr;         /* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr;
+    int i, code;
+
+    envPtr->maxStackDepth = 1;
+    tokenPtr = parsePtr->tokenPtr;
+    for(i = 1; i < parsePtr->numWords; i++) {
+	tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { 
+	    code = TclCompileTokens(interp, tokenPtr+1,
+	        tokenPtr->numComponents, envPtr);
+	    if (code != TCL_OK) return code;
+	    TclEmitOpcode(INST_POP, envPtr);
+	} 
+    }
+    TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclCompileReturnCmd --
  *
  *	Procedure called to compile the "return" command.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.58
diff -u -r1.58 tclInt.h
--- generic/tclInt.h	2001/07/31 19:12:06	1.58
+++ generic/tclInt.h	2001/08/16 23:11:44
@@ -2000,6 +2000,8 @@
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_NopObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_OpenObjCmd _ANSI_ARGS_((ClientData clientData,
 		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 EXTERN int	Tcl_PackageObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -2107,6 +2109,8 @@
 EXTERN int	TclCompileLindexCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileLlengthCmd _ANSI_ARGS_((Tcl_Interp *interp,
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int	TclCompileNopCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileReturnCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));