| ︙ | | | ︙ | |
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
int
Tcl_ProcObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
Proc *procPtr;
const char *procName;
const char *simpleName, *procArgs, *procBody;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
if (objc != 4) {
|
|
|
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
int
Tcl_ProcObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr;
const char *procName;
const char *simpleName, *procArgs, *procBody;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
if (objc != 4) {
|
| ︙ | | | ︙ | |
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
const char *procName, /* Unqualified name of this proc. */
Tcl_Obj *argsPtr, /* Description of arguments. */
Tcl_Obj *bodyPtr, /* Command body. */
Proc **procPtrPtr) /* Returns: pointer to proc data. */
{
Interp *iPtr = (Interp *) interp;
register Proc *procPtr = NULL;
int i, result, numArgs;
register CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
int precompiled = 0;
ProcGetIntRep(bodyPtr, procPtr);
if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
|
|
|
|
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
const char *procName, /* Unqualified name of this proc. */
Tcl_Obj *argsPtr, /* Description of arguments. */
Tcl_Obj *bodyPtr, /* Command body. */
Proc **procPtrPtr) /* Returns: pointer to proc data. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr = NULL;
int i, result, numArgs;
CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
int precompiled = 0;
ProcGetIntRep(bodyPtr, procPtr);
if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
|
| ︙ | | | ︙ | |
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
|
int
TclObjGetFrame(
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
register Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
const Tcl_ObjIntRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
|
|
|
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
|
int
TclObjGetFrame(
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
const Tcl_ObjIntRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
|
| ︙ | | | ︙ | |
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
|
TclNRUplevelObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
int word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
if (objc < 2) {
|
|
|
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
|
TclNRUplevelObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
int word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
if (objc < 2) {
|
| ︙ | | | ︙ | |
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
|
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
register Proc *procPtr = framePtr->procPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
/*
* Build up desired argument list for Tcl_WrongNumArgs
*/
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);
} else {
desiredObjs[0] = framePtr->objv[skip-1];
}
Tcl_IncrRefCount(desiredObjs[0]);
if (localCt > 0) {
register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
|
|
|
|
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
|
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
/*
* Build up desired argument list for Tcl_WrongNumArgs
*/
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);
} else {
desiredObjs[0] = framePtr->objv[skip-1];
}
Tcl_IncrRefCount(desiredObjs[0]);
if (localCt > 0) {
Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
|
| ︙ | | | ︙ | |
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
|
/*
* Now invoke the resolvers to determine the exact variables that
* should be used.
*/
resVarInfo = localPtr->resolveInfo;
if (resVarInfo && resVarInfo->fetchProc) {
register Var *resolvedVarPtr = (Var *)
resVarInfo->fetchProc(interp, resVarInfo);
if (resolvedVarPtr) {
if (TclIsVarInHash(resolvedVarPtr)) {
VarHashRefCount(resolvedVarPtr)++;
}
varPtr->flags = VAR_LINK;
|
|
|
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
|
/*
* Now invoke the resolvers to determine the exact variables that
* should be used.
*/
resVarInfo = localPtr->resolveInfo;
if (resVarInfo && resVarInfo->fetchProc) {
Var *resolvedVarPtr = (Var *)
resVarInfo->fetchProc(interp, resVarInfo);
if (resolvedVarPtr) {
if (TclIsVarInHash(resolvedVarPtr)) {
VarHashRefCount(resolvedVarPtr)++;
}
varPtr->flags = VAR_LINK;
|
| ︙ | | | ︙ | |
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
|
Tcl_Interp *interp,
LocalCache *localCachePtr)
{
int i;
Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
register Tcl_Obj *objPtr = *namePtrPtr;
if (objPtr) {
/* TclReleaseLiteral calls Tcl_DecrRefCount for us */
TclReleaseLiteral(interp, objPtr);
}
}
Tcl_Free(localCachePtr);
|
|
|
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
|
Tcl_Interp *interp,
LocalCache *localCachePtr)
{
int i;
Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
Tcl_Obj *objPtr = *namePtrPtr;
if (objPtr) {
/* TclReleaseLiteral calls Tcl_DecrRefCount for us */
TclReleaseLiteral(interp, objPtr);
}
}
Tcl_Free(localCachePtr);
|
| ︙ | | | ︙ | |
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
|
* are being referenced at runtime.
*
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
register Tcl_Interp *interp,/* Interpreter in which procedure was
* 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;
register Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
/*
* Make sure that the local cache of variable names and initial values has
|
|
|
|
|
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
|
* are being referenced at runtime.
*
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
Tcl_Interp *interp,/* Interpreter in which procedure was
* 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;
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr;
Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
/*
* Make sure that the local cache of variable names and initial values has
|
| ︙ | | | ︙ | |
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
|
*----------------------------------------------------------------------
*/
int
TclPushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
register Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[], /* Argument value objects. */
int isLambda) /* 1 if this is a call by ApplyObjCmd: it
* needs special rules for error msg */
{
|
|
|
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
|
*----------------------------------------------------------------------
*/
int
TclPushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[], /* Argument value objects. */
int isLambda) /* 1 if this is a call by ApplyObjCmd: it
* needs special rules for error msg */
{
|
| ︙ | | | ︙ | |
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
|
*----------------------------------------------------------------------
*/
int
TclObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
register Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
register Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
int result = TclPushProcCallFrame(clientData, interp, objc, objv,
/*isLambda*/ 0);
|
|
|
|
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
|
*----------------------------------------------------------------------
*/
int
TclObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
int result = TclPushProcCallFrame(clientData, interp, objc, objv,
/*isLambda*/ 0);
|
| ︙ | | | ︙ | |
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
|
* Nearly anything; depends on the commands in the procedure body.
*
*----------------------------------------------------------------------
*/
int
TclNRInterpProcCore(
register Tcl_Interp *interp,/* Interpreter in which procedure was
* 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". */
ProcErrorProc *errorProc) /* How to convert results from the script into
* results of the overall procedure. */
{
Interp *iPtr = (Interp *) interp;
register Proc *procPtr = iPtr->varFramePtr->procPtr;
int result;
CallFrame *freePtr;
ByteCode *codePtr;
result = InitArgsAndLocals(interp, procNameObj, skip);
if (result != TCL_OK) {
freePtr = iPtr->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
TclStackFree(interp, freePtr->compiledLocals);
/* Free compiledLocals. */
TclStackFree(interp, freePtr); /* Free CallFrame. */
return TCL_ERROR;
}
#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
register CallFrame *framePtr = iPtr->varFramePtr;
register int i;
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
fprintf(stdout, "Calling lambda ");
} else {
fprintf(stdout, "Calling proc ");
}
for (i = 0; i < framePtr->objc; i++) {
|
|
|
|
|
|
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
|
* Nearly anything; depends on the commands in the procedure body.
*
*----------------------------------------------------------------------
*/
int
TclNRInterpProcCore(
Tcl_Interp *interp,/* Interpreter in which procedure was
* 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". */
ProcErrorProc *errorProc) /* How to convert results from the script into
* results of the overall procedure. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr = iPtr->varFramePtr->procPtr;
int result;
CallFrame *freePtr;
ByteCode *codePtr;
result = InitArgsAndLocals(interp, procNameObj, skip);
if (result != TCL_OK) {
freePtr = iPtr->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
TclStackFree(interp, freePtr->compiledLocals);
/* Free compiledLocals. */
TclStackFree(interp, freePtr); /* Free CallFrame. */
return TCL_ERROR;
}
#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
CallFrame *framePtr = iPtr->varFramePtr;
int i;
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
fprintf(stdout, "Calling lambda ");
} else {
fprintf(stdout, "Calling proc ");
}
for (i = 0; i < framePtr->objc; i++) {
|
| ︙ | | | ︙ | |
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
|
* Memory gets freed.
*
*----------------------------------------------------------------------
*/
void
TclProcCleanupProc(
register Proc *procPtr) /* Procedure to be deleted. */
{
register CompiledLocal *localPtr;
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
Tcl_Obj *defPtr;
Tcl_ResolvedVarInfo *resVarInfo;
Tcl_HashEntry *hePtr = NULL;
CmdFrame *cfPtr = NULL;
Interp *iPtr = procPtr->iPtr;
|
|
|
|
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
|
* Memory gets freed.
*
*----------------------------------------------------------------------
*/
void
TclProcCleanupProc(
Proc *procPtr) /* Procedure to be deleted. */
{
CompiledLocal *localPtr;
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
Tcl_Obj *defPtr;
Tcl_ResolvedVarInfo *resVarInfo;
Tcl_HashEntry *hePtr = NULL;
CmdFrame *cfPtr = NULL;
Interp *iPtr = procPtr->iPtr;
|
| ︙ | | | ︙ | |
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
|
*
*----------------------------------------------------------------------
*/
static void
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetIntRep(srcPtr, procPtr, nsObjPtr);
assert(procPtr != NULL);
procPtr->refCount++;
LambdaSetIntRep(copyPtr, procPtr, nsObjPtr);
}
static void
FreeLambdaInternalRep(
register Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
assert(procPtr != NULL);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
}
static int
SetLambdaFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
int isNew, objc, result;
CmdFrame *cfPtr = NULL;
Proc *procPtr;
|
|
|
|
|
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
|
*
*----------------------------------------------------------------------
*/
static void
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetIntRep(srcPtr, procPtr, nsObjPtr);
assert(procPtr != NULL);
procPtr->refCount++;
LambdaSetIntRep(copyPtr, procPtr, nsObjPtr);
}
static void
FreeLambdaInternalRep(
Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
Proc *procPtr;
Tcl_Obj *nsObjPtr;
LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
assert(procPtr != NULL);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
}
static int
SetLambdaFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
int isNew, objc, result;
CmdFrame *cfPtr = NULL;
Proc *procPtr;
|
| ︙ | | | ︙ | |