1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
-
+
|
/*
* tclProc.c --
*
* This file contains routines that implement Tcl procedures,
* including the "proc" and "uplevel" commands.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclProc.c,v 1.68 2004/12/14 21:11:47 msofer Exp $
* RCS: @(#) $Id: tclProc.c,v 1.69 2004/12/15 20:44:41 msofer Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
/*
* Prototypes for static functions in this file
|
| ︙ | | |
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
|
-
+
-
|
* invoked. */
int objc; /* Count of number of arguments to this
* procedure. */
Tcl_Obj *CONST objv[]; /* Argument value objects. */
{
register Proc *procPtr = (Proc *) clientData;
Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
CallFrame frame;
CallFrame *framePtr, **framePtrPtr;
register CallFrame *framePtr = &frame;
register Var *varPtr;
register CompiledLocal *localPtr;
char *procName;
int nameLen, localCt, numArgs, argCt, i, imax, result;
/*
* This procedure generates an array "compiledLocals" that holds the
|
| ︙ | | |
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
|
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
|
+
-
+
|
* Set up and push a new call frame for the new procedure invocation.
* This call frame will execute in the proc's namespace, which might
* be different than the current namespace. The proc's namespace is
* that of its command, which can change if the command is renamed
* from one namespace to another.
*/
framePtrPtr = &framePtr;
result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
(Tcl_Namespace *) nsPtr, FRAME_IS_PROC);
if (result != TCL_OK) {
return result;
}
framePtr->objc = objc;
|
| ︙ | | |
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
|
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
|
-
+
|
/*
* Pop and free the call frame for this procedure invocation, then
* free the compiledLocals array if malloc'ed storage was used.
*/
procDone:
Tcl_PopCallFrame(interp);
TclPopStackFrame(interp);
if (compiledLocals != localStorage) {
ckfree((char *) compiledLocals);
}
return result;
#undef NUM_LOCALS
}
|
| ︙ | | |
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
|
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
|
-
+
|
* in 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;
int result;
Tcl_CallFrame frame;
Tcl_CallFrame *framePtr;
Proc *saveProcPtr;
ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
/*
* 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
|
| ︙ | | |
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
|
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
|
-
+
-
+
|
* proper namespace context, so that the byte codes are
* compiled in the appropriate class context.
*/
saveProcPtr = iPtr->compiledProcPtr;
iPtr->compiledProcPtr = procPtr;
result = Tcl_PushCallFrame(interp, &frame,
result = TclPushStackFrame(interp, &framePtr,
(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
if (result == TCL_OK) {
result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
Tcl_PopCallFrame(interp);
TclPopStackFrame(interp);
}
iPtr->compiledProcPtr = saveProcPtr;
if (result != TCL_OK) {
if (result == TCL_ERROR) {
Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
|
| ︙ | | |