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.44.2.1 2003/07/18 23:35:39 dgp Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
/*
* Prototypes for static functions in this file
|
|
|
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.44.2.2 2004/05/02 21:07:16 msofer Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
/*
* Prototypes for static functions in this file
|
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
|
Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
CallFrame frame;
register CallFrame *framePtr = &frame;
register Var *varPtr;
register CompiledLocal *localPtr;
char *procName;
int nameLen, localCt, numArgs, argCt, i, result;
Tcl_Obj *objResult = Tcl_GetObjResult(interp);
|
<
|
906
907
908
909
910
911
912
913
914
915
916
917
918
919
|
Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
CallFrame frame;
register CallFrame *framePtr = &frame;
register Var *varPtr;
register CompiledLocal *localPtr;
char *procName;
int nameLen, localCt, numArgs, argCt, i, result;
/*
* This procedure generates an array "compiledLocals" that holds the
* storage for local variables. It starts out with stack-allocated space
* but uses dynamically-allocated storage if needed.
*/
|
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
|
} else {
goto incorrectArgs;
}
varPtr++;
localPtr = localPtr->nextPtr;
}
if (argCt > 0) {
incorrectArgs:
/*
* Build up equivalent to Tcl_WrongNumArgs message for proc
*/
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(objResult,
"wrong # args: should be \"", procName, (char *) NULL);
localPtr = procPtr->firstLocalPtr;
for (i = 1; i <= numArgs; i++) {
if (localPtr->defValuePtr != NULL) {
Tcl_AppendStringsToObj(objResult,
" ?", localPtr->name, "?", (char *) NULL);
} else {
Tcl_AppendStringsToObj(objResult,
|
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1032
1033
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
1070
1071
|
} else {
goto incorrectArgs;
}
varPtr++;
localPtr = localPtr->nextPtr;
}
if (argCt > 0) {
Tcl_Obj *objResult;
int len, flags;
incorrectArgs:
/*
* Build up equivalent to Tcl_WrongNumArgs message for proc
*/
Tcl_ResetResult(interp);
objResult = Tcl_GetObjResult(interp);
Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1);
/*
* Quote the proc name if it contains spaces (Bug 942757).
*/
len = Tcl_ScanCountedElement(procName, nameLen, &flags);
if (len != nameLen) {
char *procName1 = ckalloc((unsigned) len);
len = Tcl_ConvertCountedElement(procName, nameLen, procName1, flags);
Tcl_AppendToObj(objResult, procName1, len);
ckfree(procName1);
} else {
Tcl_AppendToObj(objResult, procName, len);
}
localPtr = procPtr->firstLocalPtr;
for (i = 1; i <= numArgs; i++) {
if (localPtr->defValuePtr != NULL) {
Tcl_AppendStringsToObj(objResult,
" ?", localPtr->name, "?", (char *) NULL);
} else {
Tcl_AppendStringsToObj(objResult,
|