Diff
Not logged in

Differences From Artifact [8faf9f9a83]:

To Artifact [87b44d94cf]:


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) {