| ︙ | | | ︙ | |
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
/*
* Prototypes for static functions in this file
*/
static void DupLambdaInternalRep(Tcl_Obj *objPtr,
Tcl_Obj *copyPtr);
static void FreeLambdaInternalRep(Tcl_Obj *objPtr);
static int InitArgsAndLocals(Tcl_Interp *interp, int skip);
static void InitResolvedLocals(Tcl_Interp *interp,
ByteCode *codePtr, Var *defPtr,
Namespace *nsPtr);
static void InitLocalCache(Proc *procPtr);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
static int ProcWrongNumArgs(Tcl_Interp *interp, int skip);
static void MakeProcError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void MakeLambdaError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_NRPostProc ApplyNR2;
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;
static Tcl_ObjCmdProc NRInterpProc;
/*
* The ProcBodyObjType type
*/
const Tcl_ObjType tclProcBodyType = {
"procbody", /* name for this type */
|
|
|
<
|
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
/*
* Prototypes for static functions in this file
*/
static void DupLambdaInternalRep(Tcl_Obj *objPtr,
Tcl_Obj *copyPtr);
static void FreeLambdaInternalRep(Tcl_Obj *objPtr);
static int InitArgsAndLocals(Tcl_Interp *interp, Tcl_Size skip);
static void InitResolvedLocals(Tcl_Interp *interp,
ByteCode *codePtr, Var *defPtr,
Namespace *nsPtr);
static void InitLocalCache(Proc *procPtr);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
static int ProcWrongNumArgs(Tcl_Interp *interp, Tcl_Size skip);
static void MakeProcError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void MakeLambdaError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_NRPostProc ApplyNR2;
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;
/*
* The ProcBodyObjType type
*/
const Tcl_ObjType tclProcBodyType = {
"procbody", /* name for this type */
|
| ︙ | | | ︙ | |
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
*
* Side effects:
* A new procedure gets created.
*
*----------------------------------------------------------------------
*/
#undef TclObjInterpProc
int
Tcl_ProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
|
|
|
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
*
* Side effects:
* A new procedure gets created.
*
*----------------------------------------------------------------------
*/
#undef TclObjInterpProc2
int
Tcl_ProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
|
| ︙ | | | ︙ | |
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
TclObjInterpProc, NRInterpProc, procPtr, TclProcDeleteProc);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
* later when the procedure is called to determine what namespace the
* procedure will run in. This will be different than the current
* namespace if the proc was renamed into a different namespace.
*/
|
|
|
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
Tcl_AddErrorInfo(interp, simpleName);
Tcl_AddErrorInfo(interp, "\")");
return TCL_ERROR;
}
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
TclObjInterpProc2, TclNRInterpProc, procPtr, TclProcDeleteProc);
/*
* Now initialize the new procedure's cmdPtr field. This will be used
* later when the procedure is called to determine what namespace the
* procedure will run in. This will be different than the current
* namespace if the proc was renamed into a different namespace.
*/
|
| ︙ | | | ︙ | |
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
|
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;
int result, level;
const Tcl_ObjInternalRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
|
|
|
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
|
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;
Tcl_Size curLevel;
int result, level;
const Tcl_ObjInternalRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
|
| ︙ | | | ︙ | |
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
|
* a generation of a stringrep.
*/
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
TclGetWideIntFromObj(NULL, objPtr, &w);
if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
result = -1;
} else {
level = curLevel - level;
result = 1;
}
} else if ((irPtr = TclFetchInternalRep(objPtr, &levelReferenceType))) {
level = irPtr->wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
if (level < 0 || (level > 0 && name[1] == '-')) {
result = -1;
|
|
|
|
|
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
|
* a generation of a stringrep.
*/
if (objPtr == NULL) {
/* Do nothing */
} else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
TclGetWideIntFromObj(NULL, objPtr, &w);
if (w < 0 || w > INT_MAX || curLevel > INT_MAX) {
result = -1;
} else {
level = (int)curLevel - level;
result = 1;
}
} else if ((irPtr = TclFetchInternalRep(objPtr, &levelReferenceType))) {
level = (int)irPtr->wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
if (level < 0 || (level > 0 && name[1] == '-')) {
result = -1;
|
| ︙ | | | ︙ | |
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
|
/* if relative current level */
if (result == 0) {
if (!curLevel) {
/* we are in top-level, so simply generate bad level */
name = "1";
goto badLevel;
}
level = curLevel - 1;
}
if (level >= 0) {
CallFrame *framePtr;
for (framePtr = iPtr->varFramePtr; framePtr != NULL;
framePtr = framePtr->callerVarPtr) {
if ((int)framePtr->level == level) {
*framePtrPtr = framePtr;
|
|
|
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
|
/* if relative current level */
if (result == 0) {
if (!curLevel) {
/* we are in top-level, so simply generate bad level */
name = "1";
goto badLevel;
}
level = (int)curLevel - 1;
}
if (level >= 0) {
CallFrame *framePtr;
for (framePtr = iPtr->varFramePtr; framePtr != NULL;
framePtr = framePtr->callerVarPtr) {
if ((int)framePtr->level == level) {
*framePtrPtr = framePtr;
|
| ︙ | | | ︙ | |
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
|
return result;
}
int
Tcl_UplevelObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, clientData, objc, objv);
}
int
TclNRUplevelObjCmd(
TCL_UNUSED(void *),
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) {
/* to do
* simplify things by interpreting the argument as a command when there
|
|
|
|
|
|
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
|
return result;
}
int
Tcl_UplevelObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRUplevelObjCmd, clientData, objc, objv);
}
int
TclNRUplevelObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
Tcl_Size word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
if (objc < 2) {
/* to do
* simplify things by interpreting the argument as a command when there
|
| ︙ | | | ︙ | |
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
|
{
Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
if (cmdPtr->deleteProc == TclProcDeleteProc) {
return (Proc *)cmdPtr->objClientData;
}
return NULL;
}
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
|
|
|
|
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
|
{
Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
if (origCmd != NULL) {
cmdPtr = (Command *) origCmd;
}
if (cmdPtr->deleteProc == TclProcDeleteProc) {
return (Proc *)cmdPtr->objClientData2;
}
return NULL;
}
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
Tcl_Size skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
|
| ︙ | | | ︙ | |
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
|
ByteCode *codePtr,
Var *varPtr,
Namespace *nsPtr) /* Pointer to current namespace. */
{
Interp *iPtr = (Interp *) interp;
int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
CompiledLocal *firstLocalPtr, *localPtr;
int varNum;
Tcl_ResolvedVarInfo *resVarInfo;
/*
* Find the localPtr corresponding to varPtr
*/
varNum = varPtr - iPtr->framePtr->compiledLocals;
|
|
|
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
|
ByteCode *codePtr,
Var *varPtr,
Namespace *nsPtr) /* Pointer to current namespace. */
{
Interp *iPtr = (Interp *) interp;
int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
CompiledLocal *firstLocalPtr, *localPtr;
Tcl_Size varNum;
Tcl_ResolvedVarInfo *resVarInfo;
/*
* Find the localPtr corresponding to varPtr
*/
varNum = varPtr - iPtr->framePtr->compiledLocals;
|
| ︙ | | | ︙ | |
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
|
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
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;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
|
|
|
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
|
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size 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;
Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
|
| ︙ | | | ︙ | |
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
|
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclObjInterpProc --
*
* When a Tcl procedure gets invoked during bytecode evaluation, this
* object-based routine gets invoked to interpret the procedure.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* Depends on the commands in the procedure.
*
*----------------------------------------------------------------------
*/
int
TclObjInterpProc(
void *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, NRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
|
|
|
|
|
|
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
|
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclObjInterpProc2/TclNRInterpProc --
*
* When a Tcl procedure gets invoked during bytecode evaluation, this
* object-based routine gets invoked to interpret the procedure.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* Depends on the commands in the procedure.
*
*----------------------------------------------------------------------
*/
int
TclObjInterpProc2(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size 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_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
|
| ︙ | | | ︙ | |
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
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
|
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
static int
NRInterpProc(
void *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);
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
static int
ObjInterpProc2(
void *clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp, /* Interpreter in which procedure was
* invoked. */
Tcl_Size 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_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv);
}
/*
*----------------------------------------------------------------------
*
* TclNRInterpProcCore --
*
* When a Tcl procedure, lambda term or anything else that works like a
* procedure gets invoked during bytecode evaluation, this object-based
|
>
|
>
|
|
|
|
|
>
|
>
|
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
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
|
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
#ifndef TCL_NO_DEPRECATED
static int
NRInterpProc(
void *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);
if (result != TCL_OK) {
return TCL_ERROR;
}
return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}
#undef TclObjInterpProc
int
TclObjInterpProc(
void *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, NRInterpProc, clientData, objc, objv);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* TclNRInterpProcCore --
*
* When a Tcl procedure, lambda term or anything else that works like a
* procedure gets invoked during bytecode evaluation, this object-based
|
| ︙ | | | ︙ | |
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
|
*/
iPtr->compiledProcPtr = procPtr;
if (procPtr->numCompiledLocals > procPtr->numArgs) {
CompiledLocal *clPtr = procPtr->firstLocalPtr;
CompiledLocal *lastPtr = NULL;
int i, numArgs = procPtr->numArgs;
for (i = 0; i < numArgs; i++) {
lastPtr = clPtr;
clPtr = clPtr->nextPtr;
}
if (lastPtr) {
|
|
|
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
|
*/
iPtr->compiledProcPtr = procPtr;
if (procPtr->numCompiledLocals > procPtr->numArgs) {
CompiledLocal *clPtr = procPtr->firstLocalPtr;
CompiledLocal *lastPtr = NULL;
Tcl_Size i, numArgs = procPtr->numArgs;
for (i = 0; i < numArgs; i++) {
lastPtr = clPtr;
clPtr = clPtr->nextPtr;
}
if (lastPtr) {
|
| ︙ | | | ︙ | |
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
|
}
/*
*----------------------------------------------------------------------
*
* MakeProcError --
*
* Function called by TclObjInterpProc to create the stack information
* upon an error from a procedure.
*
* Results:
* The interpreter's error info trace is set to a value that supplements
* the error code.
*
* Side effects:
|
|
|
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
|
}
/*
*----------------------------------------------------------------------
*
* MakeProcError --
*
* Function called by TclObjInterpProc2 to create the stack information
* upon an error from a procedure.
*
* Results:
* The interpreter's error info trace is set to a value that supplements
* the error code.
*
* Side effects:
|
| ︙ | | | ︙ | |
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
|
}
return code;
}
/*
*----------------------------------------------------------------------
*
* TclGetObjInterpProc/TclGetObjInterpProc2 --
*
* Returns a pointer to the TclObjInterpProc/ObjInterpProc2 functions;
* this is different from the value obtained from the TclObjInterpProc
* reference on systems like Windows where import and export versions
* of a function exported by a DLL exist.
*
* Results:
* Returns the internal address of the TclObjInterpProc/ObjInterpProc2
* functions.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_ObjCmdProc *
TclGetObjInterpProc(void)
{
return TclObjInterpProc;
}
Tcl_ObjCmdProc2 *
TclGetObjInterpProc2(void)
{
return ObjInterpProc2;
}
/*
*----------------------------------------------------------------------
*
* TclNewProcBodyObj --
*
|
|
|
|
|
|
|
<
>
>
|
|
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
|
}
return code;
}
/*
*----------------------------------------------------------------------
*
* TclGetObjInterpProc2 --
*
* Returns a pointer to the TclObjInterpProc2 function; this is different
* from the value obtained from the TclObjInterpProc2 reference on systems
* like Windows where import and export versions of a function exported
* by a DLL exist.
*
* Results:
* Returns the internal address of the TclObjInterpProc2 function.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
Tcl_ObjCmdProc *
TclGetObjInterpProc(void)
{
return TclObjInterpProc;
}
#endif /* TCL_NO_DEPRECATED */
Tcl_ObjCmdProc2 *
TclGetObjInterpProc2(void)
{
return TclObjInterpProc2;
}
/*
*----------------------------------------------------------------------
*
* TclNewProcBodyObj --
*
|
| ︙ | | | ︙ | |
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
|
*----------------------------------------------------------------------
*/
int
Tcl_ApplyObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, clientData, objc, objv);
}
int
TclNRApplyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
int result;
Tcl_Namespace *nsPtr;
ApplyExtraData *extraPtr;
|
|
|
|
|
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
|
*----------------------------------------------------------------------
*/
int
Tcl_ApplyObjCmd(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
return Tcl_NRCallObjProc2(interp, TclNRApplyObjCmd, clientData, objc, objv);
}
int
TclNRApplyObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
int result;
Tcl_Namespace *nsPtr;
ApplyExtraData *extraPtr;
|
| ︙ | | | ︙ | |
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
|
if (procPtr == NULL) {
return TCL_ERROR;
}
/*
* Push a call frame for the lambda namespace.
* Note that TclObjInterpProc() will pop it.
*/
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return TCL_ERROR;
}
|
|
|
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
|
if (procPtr == NULL) {
return TCL_ERROR;
}
/*
* Push a call frame for the lambda namespace.
* Note that TclObjInterpProc2() will pop it.
*/
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | | | ︙ | |
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
|
}
/*
*----------------------------------------------------------------------
*
* MakeLambdaError --
*
* Function called by TclObjInterpProc to create the stack information
* upon an error from a lambda term.
*
* Results:
* The interpreter's error info trace is set to a value that supplements
* the error code.
*
* Side effects:
|
|
|
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
|
}
/*
*----------------------------------------------------------------------
*
* MakeLambdaError --
*
* Function called by TclObjInterpProc2 to create the stack information
* upon an error from a lambda term.
*
* Results:
* The interpreter's error info trace is set to a value that supplements
* the error code.
*
* Side effects:
|
| ︙ | | | ︙ | |