NRE implementation [Patch 2017110]

1 files changed, 88 insertions, 2 deletions

diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index c681da5..c4f8515 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInterp.c,v 1.86 2008/06/20 20:48:47 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.87 2008/07/13 09:03:35 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -196,6 +196,9 @@ static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
 static int		AliasObjCmd(ClientData dummy,
 			    Tcl_Interp *currentInterp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		AliasNRCmd(ClientData dummy,
+			    Tcl_Interp *currentInterp, int objc,
+			    Tcl_Obj *const objv[]);
 static void		AliasObjCmdDeleteProc(ClientData clientData);
 static Tcl_Interp *	GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
 static Tcl_Interp *	GetInterp2(Tcl_Interp *interp, int objc,
@@ -1482,9 +1485,15 @@ AliasCreate(
     Tcl_Preserve(slaveInterp);
     Tcl_Preserve(masterInterp);
 
+    if (slaveInterp == masterInterp) {
+	aliasPtr->slaveCmd = TclNR_CreateCommand(slaveInterp,
+		TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr, 
+		AliasObjCmdDeleteProc);
+    } else {
     aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
 	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
 	    AliasObjCmdDeleteProc);
+    }
 
     if (TclPreventAliasLoop(interp, slaveInterp,
 	    aliasPtr->slaveCmd) != TCL_OK) {
@@ -1739,6 +1748,69 @@ AliasList(
  */
 
 static int
+AliasNRCmd(
+    ClientData clientData,	/* Alias record. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument vector. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Alias *aliasPtr = clientData;
+    int prefc, cmdc, i;
+    Tcl_Obj **prefv, **cmdv;
+    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+    Tcl_Obj *listPtr;
+    List *listRep;
+    int flags = TCL_EVAL_INVOKE;
+    
+    /*
+     * Append the arguments to the command prefix and invoke the command in
+     * the target interp's global namespace.
+     */
+
+    prefc = aliasPtr->objc;
+    prefv = &aliasPtr->objPtr;
+    cmdc = prefc + objc - 1;
+
+    listPtr = Tcl_NewListObj(cmdc, NULL);
+    listRep = listPtr->internalRep.twoPtrValue.ptr1;
+    listRep->elemCount = cmdc;
+    cmdv = &listRep->elements;
+    
+    prefv = &aliasPtr->objPtr;
+    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+
+    for (i=0; i<cmdc; i++) {
+	Tcl_IncrRefCount(cmdv[i]);
+    }
+
+    /*
+     * Use the ensemble rewriting machinery to ensure correct error messages:
+     * only the source command should show, not the full target prefix.
+     */
+
+    if (isRootEnsemble) {
+	iPtr->ensembleRewrite.sourceObjs = objv;
+	iPtr->ensembleRewrite.numRemovedObjs = 1;
+	iPtr->ensembleRewrite.numInsertedObjs = prefc;
+    } else {
+	iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
+    }
+
+    /*
+     * We are sending a 0-refCount obj, do not need a callback: it will be
+     * cleaned up automatically. But we may need to clear the rootEnsemble
+     * stuff ...
+     */
+
+    if (isRootEnsemble) {
+	TclNR_AddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+    }
+    return TclNREvalCmd(interp, listPtr, flags);
+}
+
+static int
 AliasObjCmd(
     ClientData clientData,	/* Alias record. */
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -2542,10 +2614,24 @@ SlaveEval(
     if (objc == 1) {
 	/*
 	 * TIP #280: Make invoker available to eval'd script.
+	 *
+	 * Do not let any intReps accross, with the exception of
+	 * bytecodes. The intrep spoiling is due to happen anyway when
+	 * compiling. 
 	 */
 
         Interp *iPtr = (Interp *) interp;
-	result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr, 0);
+
+	objPtr = objv[0];
+	if (objPtr->typePtr
+		&& (objPtr->typePtr != &tclByteCodeType)
+		&& objPtr->typePtr->freeIntRepProc) {
+	    (void) TclGetString(objPtr);
+	    TclFreeIntRep(objPtr);
+	    objPtr->typePtr = NULL;
+	}
+	
+	result = TclEvalObjEx(slaveInterp, objPtr, 0, iPtr->cmdFramePtr, 0);
     } else {
 	objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);