Diff
Not logged in

Differences From Artifact [e42a6eb76c]:

To Artifact [c762c75955]:


191
192
193
194
195
196
197
198

199
200
201

202
203
204
205
206
207
208
191
192
193
194
195
196
197

198
199
200

201
202
203
204
205
206
207
208







-
+


-
+







     * current namespace unless the procedure's name included namespace
     * qualifiers. To create the new command in the right namespace, we
     * generate a fully qualified name for it.
     */

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	Tcl_DStringAppend(&ds, nsPtr->fullName, TCL_NOSIZE);
	TclDStringAppendLiteral(&ds, "::");
    }
    Tcl_DStringAppend(&ds, procName, -1);
    Tcl_DStringAppend(&ds, procName, TCL_NOSIZE);

    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
	    TclNRInterpProc, procPtr, TclProcDeleteProc);
    Tcl_DStringFree(&ds);

    /*
     * Now initialize the new procedure's cmdPtr field. This will be used
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540







-
+







	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
	    ckfree(fieldValues);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
		    "argument with no name", TCL_NOSIZE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	nameLength = strlen(fieldValues[0]);
	if (fieldCount == 2) {
1117
1118
1119
1120
1121
1122
1123
1124

1125
1126
1127
1128
1129
1130
1131
1117
1118
1119
1120
1121
1122
1123

1124
1125
1126
1127
1128
1129
1130
1131







-
+







     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", TCL_NOSIZE);
    } else {
	((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;

#ifdef AVOID_HACKS_FOR_ITCL
	desiredObjs[0] = framePtr->objv[skip-1];
#else
	desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
1998
1999
2000
2001
2002
2003
2004
2005

2006
2007
2008
2009
2010
2011
2012
1998
1999
2000
2001
2002
2003
2004

2005
2006
2007
2008
2009
2010
2011
2012







-
+







		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
	    return TCL_OK;
	}

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
			"a precompiled script jumped interps", TCL_NOSIZE));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
3024
3025
3026
3027
3028
3029
3030
3031

3032
3033
3034
3035
3036
3037
3038
3024
3025
3026
3027
3028
3029
3030

3031
3032
3033
3034
3035
3036
3037
3038







-
+







	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(objv[3]), NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
		    "body not available for this kind of method", TCL_NOSIZE));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
	    Command cmd;

3060
3061
3062
3063
3064
3065
3066
3067

3068
3069
3070
3071
3072
3073
3074
3060
3061
3062
3063
3064
3065
3066

3067
3068
3069
3070
3071
3072
3073
3074







-
+







    /*
     * Do the actual disassembly.
     */

    if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
	    & TCL_BYTECODE_PRECOMPILED) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not disassemble prebuilt bytecode", -1));
		"may not disassemble prebuilt bytecode", TCL_NOSIZE));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		"BYTECODE", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
    return TCL_OK;
}