Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.26
diff -u -r1.26 tclProc.c
--- generic/tclProc.c	2001/09/04 22:45:52	1.26
+++ generic/tclProc.c	2001/09/10 17:00:40
@@ -27,6 +27,8 @@
 static void	ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr));
 static  int	ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
 		    char *procName, int nameLen, int returnCode));
+static int	TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
+		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 
 /*
  * The ProcBodyObjType type
@@ -146,6 +148,58 @@
     
     procPtr->cmdPtr = (Command *) cmd;
 
+
+    /*
+     * Optimize for noop procs: if the argument list is just "args"
+     * and the body is empty, define a compileProc.
+     *
+     * Notes: 
+     *   - cannot be done for any argument list without having different
+     *     compiled/not-compiled behaviour in the "wrong argument #" case, 
+     *     or making this code much more complicated. In any case, it doesn't 
+     *     seem to make a lot of sense to verify the number of arguments we 
+     *     are about to ignore ...
+     *   - could be enhanced to handle also non-empty bodies that contain 
+     *     only comments; however, parsing the body will slow down the 
+     *     compilation of all procs whose argument list is just _args_ 
+     */
+    
+    {
+	char *txt;
+	txt = Tcl_GetString(objv[2]);
+	
+	while(*txt == ' ') txt++;
+	
+	if ((txt[0] == 'a') && (memcmp(txt, "args", 4) == 0)) {
+	    txt +=4;
+	    while(*txt != '\0') {
+		if (*txt != ' ') {
+		    goto done;
+		}
+		txt++;
+	    }	
+    
+	    /* 
+	     * The argument list is just "args"; check the body
+	     */
+
+	    txt = Tcl_GetString(objv[3]);
+	    while(*txt != '\0') {
+		if (!isspace(*txt)) {
+		    goto done;
+		}
+		txt++;
+	    }	
+    
+	    /* 
+	     * The body is just spaces: link the compileProc
+	     */
+
+	    ((Command *) cmd)->compileProc = TclCompileNoOp;
+	}
+    }
+
+ done:
     return TCL_OK;
 }
 
@@ -1591,3 +1645,53 @@
 {
     panic("called ProcBodyUpdateString");
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNoOp --
+ *
+ *	Procedure called to compile noOp's
+ *
+ * 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 a noOp at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclCompileNoOp(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;
+}
+
+
+
Index: tests/proc.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/proc.test,v
retrieving revision 1.9
diff -u -r1.9 proc.test
--- tests/proc.test	2001/09/04 22:45:52	1.9
+++ tests/proc.test	2001/09/10 17:00:40
@@ -299,6 +299,23 @@
     set result
 } {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
 
+test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
+    proc p args {} ; # this will be bytecompiled into t
+    proc t {} {
+	set res {}
+	set a 0
+	set b 0
+	trace add variable a read {append res a ;#}
+	trace add variable b write {append res b ;#}
+	p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
+	set res
+    }
+    set result [t]
+    catch {rename p ""}
+    catch {rename t ""}
+    set result
+} {aba}    
+
 # cleanup
 catch {rename p ""}
 catch {rename t ""}
