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.51 2004/05/02 20:49:56 msofer 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.52 2004/05/04 03:20:22 msofer Exp $
*/
#include "tclInt.h"
#include "tclCompile.h"
/*
* Prototypes for static functions in this file
|
| ︙ | | | ︙ | |
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
|
*
* TclCreateProc --
*
* Creates the data associated with a Tcl procedure definition.
* This procedure knows how to handle two types of body objects:
* strings and procbody. Strings are the traditional (and common) value
* for bodies, procbody are values created by extensions that have
* loaded a previously compiled script.
*
* Results:
* Returns TCL_OK on success, along with a pointer to a Tcl
* procedure definition in procPtrPtr. This definition should
* be freed by calling TclCleanupProc() when it is no longer
* needed. Returns TCL_ERROR if anything goes wrong.
*
* Side effects:
* If anything goes wrong, this procedure returns an error
* message in the interpreter.
*
*----------------------------------------------------------------------
*/
|
|
|
>
|
|
|
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
*
* TclCreateProc --
*
* Creates the data associated with a Tcl procedure definition.
* This procedure knows how to handle two types of body objects:
* strings and procbody. Strings are the traditional (and common) value
* for bodies, procbody are values created by extensions that have
* loaded a previously compiled script.
*
* Results:
* Returns TCL_OK on success, along with a pointer to a Tcl
* procedure definition in procPtrPtr where the cmdPtr field is not
* initialised. This definition should be freed by calling
* TclCleanupProc() when it is no longer needed. Returns TCL_ERROR if
* anything goes wrong.
*
* Side effects:
* If anything goes wrong, this procedure returns an error
* message in the interpreter.
*
*----------------------------------------------------------------------
*/
|
| ︙ | | | ︙ | |
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
* unshare it (as a matter of fact, it is bad to unshare it, because
* there may be no source code).
*
* We don't create and initialize a Proc structure for the procedure;
* rather, we use what is in the body object. Note that
* we initialize its cmdPtr field below after we've created the command
* for the procedure. We increment the ref count of the Proc struct
* since the command (soon to be created) will be holding a reference
* to it.
*/
procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
procPtr->iPtr = iPtr;
procPtr->refCount++;
precompiled = 1;
} else {
|
|
<
|
|
<
|
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
|
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
* unshare it (as a matter of fact, it is bad to unshare it, because
* there may be no source code).
*
* We don't create and initialize a Proc structure for the procedure;
* rather, we use what is in the body object. We increment the ref
* count of the Proc struct since the command (soon to be created)
* will be holding a reference to it.
*/
procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
procPtr->iPtr = iPtr;
procPtr->refCount++;
precompiled = 1;
} else {
|
| ︙ | | | ︙ | |
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
if (Tcl_IsShared(bodyPtr)) {
bytes = Tcl_GetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
}
/*
* Create and initialize a Proc structure for the procedure. Note that
* we initialize its cmdPtr field below after we've created the command
* for the procedure. We increment the ref count of the procedure's
* body object since there will be a reference to it in the Proc
* structure.
*/
Tcl_IncrRefCount(bodyPtr);
procPtr = (Proc *) ckalloc(sizeof(Proc));
procPtr->iPtr = iPtr;
procPtr->refCount = 1;
|
|
<
|
|
<
|
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
if (Tcl_IsShared(bodyPtr)) {
bytes = Tcl_GetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
}
/*
* Create and initialize a Proc structure for the procedure. We
* increment the ref count of the procedure's body object since there
* will be a reference to it in the Proc structure.
*/
Tcl_IncrRefCount(bodyPtr);
procPtr = (Proc *) ckalloc(sizeof(Proc));
procPtr->iPtr = iPtr;
procPtr->refCount = 1;
|
| ︙ | | | ︙ | |
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
|
localPtr->defValuePtr = NULL;
}
strcpy(localPtr->name, fieldValues[0]);
}
ckfree((char *) fieldValues);
}
/*
* 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.
*/
*procPtrPtr = procPtr;
ckfree((char *) argArray);
return TCL_OK;
procError:
if (precompiled) {
|
<
<
<
<
<
<
<
|
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
localPtr->defValuePtr = NULL;
}
strcpy(localPtr->name, fieldValues[0]);
}
ckfree((char *) fieldValues);
}
*procPtrPtr = procPtr;
ckfree((char *) argArray);
return TCL_OK;
procError:
if (precompiled) {
|
| ︙ | | | ︙ | |