Diff
Not logged in

Differences From Artifact [7454c9a311]:

To Artifact [82b69f007a]:


402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
402
403
404
405
406
407
408

409
410
411
412
413
414
415
416







-
+







	 *
	 * 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
1162
1163
1164
1165
1166
1167
1168
1169

1170
1171
1172
1173
1174
1175
1176
1162
1163
1164
1165
1166
1167
1168

1169
1170
1171
1172
1173
1174
1175
1176







-
+







    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++;
1330
1331
1332
1333
1334
1335
1336
1337

1338
1339
1340
1341
1342
1343
1344
1330
1331
1332
1333
1334
1335
1336

1337
1338
1339
1340
1341
1342
1343
1344







-
+







    ckfree((char *) localCachePtr);
}

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;
1387
1388
1389
1390
1391
1392
1393
1394

1395
1396
1397
1398
1399
1400
1401
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401







-
+







				 * 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 .
1575
1576
1577
1578
1579
1580
1581
1582

1583
1584
1585
1586
1587
1588
1589
1575
1576
1577
1578
1579
1580
1581

1582
1583
1584
1585
1586
1587
1588
1589







-
+







	 * 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 {
1743
1744
1745
1746
1747
1748
1749
1750

1751
1752
1753
1754
1755
1756
1757
1743
1744
1745
1746
1747
1748
1749

1750
1751
1752
1753
1754
1755
1756
1757







-
+







    procPtr->refCount++;
    iPtr->numLevels++;

    if (TclInterpReady(interp) == TCL_ERROR) {
	result = TCL_ERROR;
    } else {
	register ByteCode *codePtr =
		procPtr->bodyPtr->internalRep.otherValuePtr;
		procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;

	codePtr->refCount++;
#ifdef USE_DTRACE
	if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	    int l;

	    l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
1904
1905
1906
1907
1908
1909
1910
1911

1912
1913
1914
1915
1916
1917
1918
1904
1905
1906
1907
1908
1909
1910

1911
1912
1913
1914
1915
1916
1917
1918







-
+







    CONST char *procName,	/* Name of this procedure. */
    Proc **procPtrPtr)		/* Points to storage where a replacement
				 * (Proc *) value may be written. */
{
    Interp *iPtr = (Interp *) interp;
    int i;
    Tcl_CallFrame *framePtr;
    ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
    ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
    CompiledLocal *localPtr;

    /*
     * 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
2323
2324
2325
2326
2327
2328
2329

2330

2331
2332
2333
2334
2335
2336
2337
2323
2324
2325
2326
2327
2328
2329
2330

2331
2332
2333
2334
2335
2336
2337
2338







+
-
+







    if (!procPtr) {
	return NULL;
    }

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

	procPtr->refCount++;
    }

    return objPtr;
}

2353
2354
2355
2356
2357
2358
2359
2360

2361
2362

2363

2364
2365
2366
2367
2368
2369
2370
2354
2355
2356
2357
2358
2359
2360

2361
2362
2363
2364

2365
2366
2367
2368
2369
2370
2371
2372







-
+


+
-
+







 */

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.twoPtrValue.ptr1 = procPtr;
    dupPtr->internalRep.otherValuePtr = procPtr;
    dupPtr->internalRep.twoPtrValue.ptr2 = NULL;
    procPtr->refCount++;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyFree --
2383
2384
2385
2386
2387
2388
2389
2390

2391
2392
2393
2394
2395
2396
2397
2385
2386
2387
2388
2389
2390
2391

2392
2393
2394
2395
2396
2397
2398
2399







-
+







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

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) {
	TclProcCleanupProc(procPtr);
    }
}

2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864
2852
2853
2854
2855
2856
2857
2858

2859
2860
2861
2862
2863
2864
2865
2866







-
+







	cmd.nsPtr = (Namespace *) nsPtr;
	procPtr->cmdPtr = &cmd;
	result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
	if (result != TCL_OK) {
	    return result;
	}
	TclPopStackFrame(interp);
	if (((ByteCode *) procPtr->bodyPtr->internalRep.otherValuePtr)->flags
	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
		& TCL_BYTECODE_PRECOMPILED) {
	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
	break;
2877
2878
2879
2880
2881
2882
2883
2884

2885
2886
2887
2888
2889
2890
2891
2879
2880
2881
2882
2883
2884
2885

2886
2887
2888
2889
2890
2891
2892
2893







-
+







	 */

	result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
	if (result != TCL_OK) {
	    return result;
	}
	TclPopStackFrame(interp);
	if (((ByteCode *) procPtr->bodyPtr->internalRep.otherValuePtr)->flags
	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
		& TCL_BYTECODE_PRECOMPILED) {
	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
	break;