Diff
Not logged in

Differences From Artifact [9a970c8247]:

To Artifact [7e8f8287b5]:


417
418
419
420
421
422
423
424

425
426
427
428
429
430
431
417
418
419
420
421
422
423

424
425
426
427
428
429
430
431







-
+







	 *
	 * We don't create and initialize a Proc structure for the procedure;
	 * rather, we use what is in the body object. We increment the ref
	 * count of the Proc struct since the command (soon to be created)
	 * will be holding a reference to it.
	 */

	procPtr = bodyPtr->internalRep.otherValuePtr;
	procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
	procPtr->iPtr = iPtr;
	procPtr->refCount++;
	precompiled = 1;
    } else {
	/*
	 * If the procedure's body object is shared because its string value
	 * is identical to, e.g., the body of another procedure, we must
1192
1193
1194
1195
1196
1197
1198
1199

1200
1201
1202
1203
1204
1205
1206
1192
1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
1206







-
+







    Tcl_Obj *bodyPtr;
    ByteCode *codePtr;

    bodyPtr = framePtr->procPtr->bodyPtr;
    if (bodyPtr->typePtr != &tclByteCodeType) {
	Tcl_Panic("body object for proc attached to frame is not a byte code type");
    }
    codePtr = bodyPtr->internalRep.otherValuePtr;
    codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;

    if (framePtr->numCompiledLocals) {
	if (!codePtr->localCachePtr) {
	    InitLocalCache(framePtr->procPtr) ;
	}
	framePtr->localCachePtr = codePtr->localCachePtr;
	framePtr->localCachePtr->refCount++;
1363
1364
1365
1366
1367
1368
1369
1370

1371
1372
1373
1374
1375
1376
1377
1363
1364
1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376
1377







-
+







}

static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    int localCt = procPtr->numCompiledLocals;
    int numArgs = procPtr->numArgs, i = 0;

    Tcl_Obj **namePtr;
    Var *varPtr;
    LocalCache *localCachePtr;
    CompiledLocal *localPtr;
1440
1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453
1454
1440
1441
1442
1443
1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454







-
+







				 * invoked. */
    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    register Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    register Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
1627
1628
1629
1630
1631
1632
1633
1634

1635
1636
1637
1638
1639
1640
1641
1627
1628
1629
1630
1631
1632
1633

1634
1635
1636
1637
1638
1639
1640
1641







-
+







	 * the bytecode must be for the right interpreter (no cross-leaks!),
	 * the code must be from the current epoch (so subcommand compilation
	 * is up-to-date), the namespace must match (so variable handling
	 * is right) and the resolverEpoch must match (so that new shadowed
	 * commands and/or resolver changes are considered).
	 */

	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
	codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
	    goto doCompilation;
	}
    } else {
1828
1829
1830
1831
1832
1833
1834
1835

1836
1837
1838
1839
1840
1841
1842
1828
1829
1830
1831
1832
1833
1834

1835
1836
1837
1838
1839
1840
1841
1842







-
+







#endif /* USE_DTRACE */

    /*
     * Invoke the commands in the procedure's body.
     */

    procPtr->refCount++;
    codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
    codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;

    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
	    NULL, NULL);
    return TclNRExecuteByteCode(interp, codePtr);
}

static int
1970
1971
1972
1973
1974
1975
1976
1977

1978
1979
1980
1981
1982
1983
1984
1970
1971
1972
1973
1974
1975
1976

1977
1978
1979
1980
1981
1982
1983
1984







-
+







				 * the context of this procedure.) */
    Namespace *nsPtr,		/* Namespace containing procedure. */
    const char *description,	/* string describing this body of code. */
    const char *procName)	/* Name of this procedure. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_CallFrame *framePtr;
    ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
    ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;

    /*
     * If necessary, compile the procedure's body. The compiler will allocate
     * frame slots for the procedure's non-argument local variables. If the
     * ByteCode already exists, make sure it hasn't been invalidated by
     * someone redefining a core command (this might make the compiled code
     * wrong). Also, if the code was compiled in/for a different interpreter,
2090
2091
2092
2093
2094
2095
2096
2097

2098
2099
2100
2101
2102
2103
2104
2090
2091
2092
2093
2094
2095
2096

2097
2098
2099
2100
2101
2102
2103
2104







-
+








	/*
	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
	 */

	iPtr->invokeWord = 0;
	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
	tclByteCodeType.setFromAnyProc(interp, bodyPtr);
	TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
	iPtr->invokeCmdFramePtr = NULL;
	TclPopStackFrame(interp);
    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
	/*
	 * The resolver epoch has changed, but we only need to invalidate the
	 * resolver cache.
	 */
2360
2361
2362
2363
2364
2365
2366
2367

2368
2369
2370
2371
2372
2373
2374
2360
2361
2362
2363
2364
2365
2366

2367
2368
2369
2370
2371
2372
2373
2374







-
+







    if (!procPtr) {
	return NULL;
    }

    TclNewObj(objPtr);
    if (objPtr) {
	objPtr->typePtr = &tclProcBodyType;
	objPtr->internalRep.otherValuePtr = procPtr;
	objPtr->internalRep.twoPtrValue.ptr1 = procPtr;

	procPtr->refCount++;
    }

    return objPtr;
}

2390
2391
2392
2393
2394
2395
2396
2397

2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2390
2391
2392
2393
2394
2395
2396

2397
2398
2399

2400
2401
2402
2403
2404
2405
2406
2407







-
+


-
+







 */

static void
ProcBodyDup(
    Tcl_Obj *srcPtr,		/* Object to copy. */
    Tcl_Obj *dupPtr)		/* Target object for the duplication. */
{
    Proc *procPtr = srcPtr->internalRep.otherValuePtr;
    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;

    dupPtr->typePtr = &tclProcBodyType;
    dupPtr->internalRep.otherValuePtr = procPtr;
    dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    procPtr->refCount++;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyFree --
2420
2421
2422
2423
2424
2425
2426
2427

2428
2429
2430

2431
2432
2433
2434
2435
2436
2437
2420
2421
2422
2423
2424
2425
2426

2427
2428


2429
2430
2431
2432
2433
2434
2435
2436







-
+

-
-
+







 *----------------------------------------------------------------------
 */

static void
ProcBodyFree(
    Tcl_Obj *objPtr)		/* The object to clean up. */
{
    Proc *procPtr = objPtr->internalRep.otherValuePtr;
    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;

    procPtr->refCount--;
    if (procPtr->refCount <= 0) {
    if (procPtr->refCount-- < 2) {
	TclProcCleanupProc(procPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2715
2716
2717
2718
2719
2720
2721

2722
2723
2724
2725
2726
2727
2728







-







 * the code. (MS)
 */

#if JOE_EXTENSION
    else {
	/*
	 * Joe English's suggestion to allow cmdNames to function as lambdas.
	 * Also requires making tclCmdNameType non-static in tclObj.c
	 */

	Tcl_Obj *elemPtr;
	int numElem;

	if ((lambdaPtr->typePtr == &tclCmdNameType) ||
		(TclListObjGetElements(interp, lambdaPtr, &numElem,
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965



2966
2967
2968
2969
2970
2971
2972
2973
2954
2955
2956
2957
2958
2959
2960



2961
2962
2963

2964
2965
2966
2967
2968
2969
2970







-
-
-
+
+
+
-







	 * Compile and disassemble a script.
	 */

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script");
	    return TCL_ERROR;
	}
	if (objv[2]->typePtr != &tclByteCodeType) {
	    if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){
		return TCL_ERROR;
	if ((objv[2]->typePtr != &tclByteCodeType)
		&& (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
	    return TCL_ERROR;
	    }
	}
	codeObjPtr = objv[2];
	break;

    case DISAS_CLASS_METHOD:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
3056
3057
3058
3059
3060
3061
3062
3063

3064
3065
3066
3067
3068
3069
3070
3053
3054
3055
3056
3057
3058
3059

3060
3061
3062
3063
3064
3065
3066
3067







-
+







	CLANG_ASSERT(0);
    }

    /*
     * Do the actual disassembly.
     */

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