| ︙ | | | ︙ | |
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
TclGetNamespaceForQualName(interp, procName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
if (nsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": unknown namespace",
procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
return TCL_ERROR;
}
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": bad procedure name",
procName));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
return TCL_ERROR;
}
/*
* Create the data structure to represent the procedure.
*/
|
|
|
|
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
TclGetNamespaceForQualName(interp, procName, NULL, 0,
&nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
if (nsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": unknown namespace",
procName));
TclSetErrorCode(interp, "TCL", "VALUE", "COMMAND");
return TCL_ERROR;
}
if (simpleName == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create procedure \"%s\": bad procedure name",
procName));
TclSetErrorCode(interp, "TCL", "VALUE", "COMMAND");
return TCL_ERROR;
}
/*
* Create the data structure to represent the procedure.
*/
|
| ︙ | | | ︙ | |
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
|
}
if (errorCode) {
if (errorCode == TOOMANYARGS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains too many (%"
TCL_SIZE_MODIFIER "d) entries", procName, numArgs));
}
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
errorCode, (char *)NULL);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
|
|
<
|
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
|
}
if (errorCode) {
if (errorCode == TOOMANYARGS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains too many (%"
TCL_SIZE_MODIFIER "d) entries", procName, numArgs));
}
TclSetErrorCode(interp, "TCL", "OPERATION", "PROC", errorCode);
}
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | | | ︙ | |
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
|
}
}
badLevel:
if (name == NULL) {
name = objPtr ? TclGetString(objPtr) : "1" ;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, (char *)NULL);
return -1;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UplevelObjCmd --
|
|
|
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
|
}
}
badLevel:
if (name == NULL) {
name = objPtr ? TclGetString(objPtr) : "1" ;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
TclSetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name);
return -1;
}
/*
*----------------------------------------------------------------------
*
* Tcl_UplevelObjCmd --
|
| ︙ | | | ︙ | |
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
|
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?",
(char *)NULL);
} else if (defPtr->flags & VAR_IS_ARGS) {
numArgs--;
final = "?arg ...?";
break;
} else {
argObj = namePtr;
Tcl_IncrRefCount(namePtr);
|
|
<
|
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
|
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
TclAppendStringsToObj(argObj, "?", TclGetString(namePtr), "?");
} else if (defPtr->flags & VAR_IS_ARGS) {
numArgs--;
final = "?arg ...?";
break;
} else {
argObj = namePtr;
Tcl_IncrRefCount(namePtr);
|
| ︙ | | | ︙ | |
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
|
* It's an error to get to this point from a 'break' or 'continue', so
* transform to an error now.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invoked \"%s\" outside of a loop",
((result == TCL_BREAK) ? "break" : "continue")));
Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", (char *)NULL);
result = TCL_ERROR;
TCL_FALLTHROUGH();
case TCL_ERROR:
/*
* Now it _must_ be an error, so we need to log it as such. This means
* filling out the error trace. Luckily, we just hand this off to the
|
|
|
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
|
* It's an error to get to this point from a 'break' or 'continue', so
* transform to an error now.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"invoked \"%s\" outside of a loop",
((result == TCL_BREAK) ? "break" : "continue")));
TclSetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED");
result = TCL_ERROR;
TCL_FALLTHROUGH();
case TCL_ERROR:
/*
* Now it _must_ be an error, so we need to log it as such. This means
* filling out the error trace. Luckily, we just hand this off to the
|
| ︙ | | | ︙ | |
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
|
return TCL_OK;
}
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
if ((Interp *) *codePtr->interpHandle != iPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"a precompiled script jumped interps", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"CROSSINTERPBYTECODE", (char *)NULL);
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
Tcl_StoreInternalRep(bodyPtr, &tclByteCodeType, NULL);
codePtr = NULL;
|
|
|
|
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
|
return TCL_OK;
}
if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
if ((Interp *) *codePtr->interpHandle != iPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"a precompiled script jumped interps", -1));
TclSetErrorCode(interp, "TCL", "OPERATION", "PROC",
"CROSSINTERPBYTECODE");
return TCL_ERROR;
}
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
Tcl_StoreInternalRep(bodyPtr, &tclByteCodeType, NULL);
codePtr = NULL;
|
| ︙ | | | ︙ | |
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
|
* to compile.
*/
Tcl_Obj *message;
TclNewLiteralStringObj(message, "Compiling ");
Tcl_IncrRefCount(message);
Tcl_AppendStringsToObj(message, description, " \"", (char *)NULL);
Tcl_AppendLimitedToObj(message, procName, TCL_INDEX_NONE, 50, NULL);
fprintf(stdout, "%s\"\n", TclGetString(message));
Tcl_DecrRefCount(message);
}
#else
(void)description;
(void)procName;
|
|
|
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
|
* to compile.
*/
Tcl_Obj *message;
TclNewLiteralStringObj(message, "Compiling ");
Tcl_IncrRefCount(message);
TclAppendStringsToObj(message, description, " \"");
Tcl_AppendLimitedToObj(message, procName, TCL_INDEX_NONE, 50, NULL);
fprintf(stdout, "%s\"\n", TclGetString(message));
Tcl_DecrRefCount(message);
}
#else
(void)description;
(void)procName;
|
| ︙ | | | ︙ | |
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
|
*/
result = TclListObjLength(NULL, objPtr, &objc);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
return TCL_ERROR;
}
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (char *)NULL);
return TCL_ERROR;
}
argsPtr = objv[0];
bodyPtr = objv[1];
/*
|
|
|
|
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
|
*/
result = TclListObjLength(NULL, objPtr, &objc);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
Tcl_GetString(objPtr)));
TclSetErrorCode(interp, "TCL", "VALUE", "LAMBDA");
return TCL_ERROR;
}
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't interpret \"%s\" as a lambda expression",
TclGetString(objPtr)));
TclSetErrorCode(interp, "TCL", "VALUE", "LAMBDA");
return TCL_ERROR;
}
argsPtr = objv[0];
bodyPtr = objv[1];
/*
|
| ︙ | | | ︙ | |
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
|
Tcl_Free(localPtr);
}
Tcl_Free(newProc);
// Complain about the failure to allocate.
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains too many (%"
TCL_SIZE_MODIFIER "d) entries", cmdName, origProc->numArgs));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
TOOMANYARGS, (char *)NULL);
return TCL_ERROR;
}
// Duplicate all the procedures in a namespace into another (new) namespace.
int
TclCopyNamespaceProcedures(
Tcl_Interp *interp,
|
|
<
|
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
|
Tcl_Free(localPtr);
}
Tcl_Free(newProc);
// Complain about the failure to allocate.
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": arg list contains too many (%"
TCL_SIZE_MODIFIER "d) entries", cmdName, origProc->numArgs));
TclSetErrorCode(interp, "TCL", "OPERATION", "PROC", TOOMANYARGS);
return TCL_ERROR;
}
// Duplicate all the procedures in a namespace into another (new) namespace.
int
TclCopyNamespaceProcedures(
Tcl_Interp *interp,
|
| ︙ | | | ︙ | |