1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
|
-
+
-
-
+
+
-
+
|
/*
* 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.
* Copyright (c) 2004-2006 Miguel Sofer
*
* 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.115.2.5 2007/06/17 19:14:35 dgp Exp $
* RCS: @(#) $Id: tclProc.c,v 1.115.2.6 2007/06/17 21:54:27 dgp Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
/*
* 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_Obj *procNameObj, int skip);
static int InitArgsAndLocals(Tcl_Interp *interp,
Tcl_Obj *procNameObj, int skip);
static void InitCompiledLocals(Tcl_Interp *interp,
ByteCode *codePtr, CompiledLocal *localPtr,
Var *varPtr, Namespace *nsPtr);
static int PushProcCallFrame(ClientData clientData,
static int PushProcCallFrame(ClientData clientData,
register Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[], int isLambda);
static void ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void ProcBodyFree(Tcl_Obj *objPtr);
static void MakeProcError(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void MakeLambdaError(Tcl_Interp *interp,
|
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
|
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
|
-
+
|
"procedure \"%s\": formal parameter %d is "
"inconsistent with precompiled body", procName, i));
ckfree((char *) fieldValues);
goto procError;
}
/*
* compare the default value if any
* Compare the default value if any.
*/
if (localPtr->defValuePtr != NULL) {
int tmpLength;
char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
&tmpLength);
|
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
|
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
|
-
+
|
* for executing it.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* The proc's body may be recompiled. A CallFrame is pushed, it will have
* to be popped by the caller.
* to be popped by the caller.
*
*----------------------------------------------------------------------
*/
static int
PushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
|
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
|
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
|
+
|
if (result != TCL_OK) {
goto procDone;
}
#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
register CallFrame *framePtr = ((Interp *)interp)->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++) {
|