Diff
Not logged in

Differences From Artifact [57f37eba47]:

To Artifact [34bef63f1d]:


57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;

/*
 * The ProcBodyObjType type
 */

const Tcl_ObjType tclProcBodyType = {
    "procbody",			/* name for this type */
    ProcBodyFree,		/* FreeInternalRep function */
    ProcBodyDup,		/* DupInternalRep function */
    NULL,			/* UpdateString function; Tcl_GetString and
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;

/*
 * The ProcBodyObjType type
 */

static const Tcl_ObjType procBodyType = {
    "procbody",			/* name for this type */
    ProcBodyFree,		/* FreeInternalRep function */
    ProcBodyDup,		/* DupInternalRep function */
    NULL,			/* UpdateString function; Tcl_GetString and
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 */

static const Tcl_ObjType lambdaType = {
    "lambdaExpr",		/* name */
    FreeLambdaInternalRep,	/* freeIntRepProc */
    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetLambdaFromAny		/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ProcObjCmd --
 *







|







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 */

static const Tcl_ObjType lambdaType = {
    "lambdaExpr",		/* name */
    FreeLambdaInternalRep,	/* freeIntRepProc */
    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL		/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ProcObjCmd --
 *
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
     *	   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_
     */

    if (objv[3]->typePtr == &tclProcBodyType) {
	goto done;
    }

    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;







|







320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
     *	   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_
     */

    if (objv[3]->typePtr == &procBodyType) {
	goto done;
    }

    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
    register Proc *procPtr;
    int i, length, result, numArgs;
    const char *args, *bytes, *p;
    register CompiledLocal *localPtr = NULL;
    Tcl_Obj *defPtr;
    int precompiled = 0;

    if (bodyPtr->typePtr == &tclProcBodyType) {
	/*
	 * Because the body is a TclProProcBody, the actual body is already
	 * compiled, and it is not shared with anyone else, so it's OK not to
	 * unshare it (as a matter of fact, it is bad to unshare it, because
	 * there may be no source code).
	 *
	 * We don't create and initialize a Proc structure for the procedure;







|







404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
    register Proc *procPtr;
    int i, length, result, numArgs;
    const char *args, *bytes, *p;
    register CompiledLocal *localPtr = NULL;
    Tcl_Obj *defPtr;
    int precompiled = 0;

    if (bodyPtr->typePtr == &procBodyType) {
	/*
	 * Because the body is a TclProProcBody, the actual body is already
	 * compiled, and it is not shared with anyone else, so it's OK not to
	 * unshare it (as a matter of fact, it is bad to unshare it, because
	 * there may be no source code).
	 *
	 * We don't create and initialize a Proc structure for the procedure;
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.twoPtrValue.ptr1 = procPtr;

	procPtr->refCount++;
    }

    return objPtr;
}







|







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 = &procBodyType;
	objPtr->internalRep.twoPtrValue.ptr1 = procPtr;

	procPtr->refCount++;
    }

    return objPtr;
}
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.twoPtrValue.ptr1;

    dupPtr->typePtr = &tclProcBodyType;
    dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    procPtr->refCount++;
}

/*
 *----------------------------------------------------------------------
 *







|







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.twoPtrValue.ptr1;

    dupPtr->typePtr = &procBodyType;
    dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    procPtr->refCount++;
}

/*
 *----------------------------------------------------------------------
 *