Fork me on GitHub

source: git/external/tcl/tclProc.c@ 0b8551f

Last change on this file since 0b8551f was adeddd8, checked in by Pavel Demin <pavel-demin@…>, 5 years ago

remove debug code from Tcl
  • Property mode set to 100644
File size: 43.3 KB
RevLine 
[d7d2da3]1/*
2 * tclProc.c --
3 *
4 * This file contains routines that implement Tcl procedures,
5 * including the "proc" and "uplevel" commands.
6 *
7 * Copyright (c) 1987-1993 The Regents of the University of California.
8 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclProc.c,v 1.1 2008-06-04 13:58:10 demin Exp $
14 */
15
16#include "tclInt.h"
17#include "tclCompile.h"
18
19/*
20 * Prototypes for static functions in this file
21 */
22
23static void ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
24static void ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
25static int ProcBodySetFromAny _ANSI_ARGS_((Tcl_Interp *interp,
26 Tcl_Obj *objPtr));
27static void ProcBodyUpdateString _ANSI_ARGS_((Tcl_Obj *objPtr));
28
29/*
30 * The ProcBodyObjType type
31 */
32
33Tcl_ObjType tclProcBodyType = {
34 "procbody", /* name for this type */
35 ProcBodyFree, /* FreeInternalRep procedure */
36 ProcBodyDup, /* DupInternalRep procedure */
37 ProcBodyUpdateString, /* UpdateString procedure */
38 ProcBodySetFromAny /* SetFromAny procedure */
39};
40
41
42
43/*
44 *----------------------------------------------------------------------
45 *
46 * Tcl_ProcObjCmd --
47 *
48 * This object-based procedure is invoked to process the "proc" Tcl
49 * command. See the user documentation for details on what it does.
50 *
51 * Results:
52 * A standard Tcl object result value.
53 *
54 * Side effects:
55 * A new procedure gets created.
56 *
57 *----------------------------------------------------------------------
58 */
59
60 /* ARGSUSED */
61int
62Tcl_ProcObjCmd(dummy, interp, objc, objv)
63 ClientData dummy; /* Not used. */
64 Tcl_Interp *interp; /* Current interpreter. */
65 int objc; /* Number of arguments. */
66 Tcl_Obj *CONST objv[]; /* Argument objects. */
67{
68 register Interp *iPtr = (Interp *) interp;
69 Proc *procPtr;
70 char *fullName, *procName;
71 Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
72 Tcl_Command cmd;
73 Tcl_DString ds;
74
75 if (objc != 4) {
76 Tcl_WrongNumArgs(interp, 1, objv, "name args body");
77 return TCL_ERROR;
78 }
79
80 /*
81 * Determine the namespace where the procedure should reside. Unless
82 * the command name includes namespace qualifiers, this will be the
83 * current namespace.
84 */
85
86 fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
87 TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
88 /*flags*/ 0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
89
90 if (nsPtr == NULL) {
91 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
92 "can't create procedure \"", fullName,
93 "\": unknown namespace", (char *) NULL);
94 return TCL_ERROR;
95 }
96 if (procName == NULL) {
97 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
98 "can't create procedure \"", fullName,
99 "\": bad procedure name", (char *) NULL);
100 return TCL_ERROR;
101 }
102 if ((nsPtr != iPtr->globalNsPtr)
103 && (procName != NULL) && (procName[0] == ':')) {
104 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
105 "can't create procedure \"", procName,
106 "\" in non-global namespace with name starting with \":\"",
107 (char *) NULL);
108 return TCL_ERROR;
109 }
110
111 /*
112 * Create the data structure to represent the procedure.
113 */
114 if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
115 &procPtr) != TCL_OK) {
116 return TCL_ERROR;
117 }
118
119 /*
120 * Now create a command for the procedure. This will initially be in
121 * the current namespace unless the procedure's name included namespace
122 * qualifiers. To create the new command in the right namespace, we
123 * generate a fully qualified name for it.
124 */
125
126 Tcl_DStringInit(&ds);
127 if (nsPtr != iPtr->globalNsPtr) {
128 Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
129 Tcl_DStringAppend(&ds, "::", 2);
130 }
131 Tcl_DStringAppend(&ds, procName, -1);
132
133 Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), TclProcInterpProc,
134 (ClientData) procPtr, TclProcDeleteProc);
135 cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
136 TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
137
138 /*
139 * Now initialize the new procedure's cmdPtr field. This will be used
140 * later when the procedure is called to determine what namespace the
141 * procedure will run in. This will be different than the current
142 * namespace if the proc was renamed into a different namespace.
143 */
144
145 procPtr->cmdPtr = (Command *) cmd;
146
147 return TCL_OK;
148}
149
150
151
152/*
153 *----------------------------------------------------------------------
154 *
155 * TclCreateProc --
156 *
157 * Creates the data associated with a Tcl procedure definition.
158 * This procedure knows how to handle two types of body objects:
159 * strings and procbody. Strings are the traditional (and common) value
160 * for bodies, procbody are values created by extensions that have
161 * loaded a previously compiled script.
162 *
163 * Results:
164 * Returns TCL_OK on success, along with a pointer to a Tcl
165 * procedure definition in procPtrPtr. This definition should
166 * be freed by calling TclCleanupProc() when it is no longer
167 * needed. Returns TCL_ERROR if anything goes wrong.
168 *
169 * Side effects:
170 * If anything goes wrong, this procedure returns an error
171 * message in the interpreter.
172 *
173 *----------------------------------------------------------------------
174 */
175int
176TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
177 Tcl_Interp *interp; /* interpreter containing proc */
178 Namespace *nsPtr; /* namespace containing this proc */
179 char *procName; /* unqualified name of this proc */
180 Tcl_Obj *argsPtr; /* description of arguments */
181 Tcl_Obj *bodyPtr; /* command body */
182 Proc **procPtrPtr; /* returns: pointer to proc data */
183{
184 Interp *iPtr = (Interp*)interp;
185 char **argArray = NULL;
186
187 register Proc *procPtr;
188 int i, length, result, numArgs;
189 char *args, *bytes, *p;
190 register CompiledLocal *localPtr;
191 Tcl_Obj *defPtr;
192 int precompiled = 0;
193
194 if (bodyPtr->typePtr == &tclProcBodyType) {
195 /*
196 * Because the body is a TclProProcBody, the actual body is already
197 * compiled, and it is not shared with anyone else, so it's OK not to
198 * unshare it (as a matter of fact, it is bad to unshare it, because
199 * there may be no source code).
200 *
201 * We don't create and initialize a Proc structure for the procedure;
202 * rather, we use what is in the body object. Note that
203 * we initialize its cmdPtr field below after we've created the command
204 * for the procedure. We increment the ref count of the Proc struct
205 * since the command (soon to be created) will be holding a reference
206 * to it.
207 */
208
209 procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
210 procPtr->iPtr = iPtr;
211 procPtr->refCount++;
212 precompiled = 1;
213 } else {
214 /*
215 * If the procedure's body object is shared because its string value is
216 * identical to, e.g., the body of another procedure, we must create a
217 * private copy for this procedure to use. Such sharing of procedure
218 * bodies is rare but can cause problems. A procedure body is compiled
219 * in a context that includes the number of compiler-allocated "slots"
220 * for local variables. Each formal parameter is given a local variable
221 * slot (the "procPtr->numCompiledLocals = numArgs" assignment
222 * below). This means that the same code can not be shared by two
223 * procedures that have a different number of arguments, even if their
224 * bodies are identical. Note that we don't use Tcl_DuplicateObj since
225 * we would not want any bytecode internal representation.
226 */
227
228 if (Tcl_IsShared(bodyPtr)) {
229 bytes = Tcl_GetStringFromObj(bodyPtr, &length);
230 bodyPtr = Tcl_NewStringObj(bytes, length);
231 }
232
233 /*
234 * Create and initialize a Proc structure for the procedure. Note that
235 * we initialize its cmdPtr field below after we've created the command
236 * for the procedure. We increment the ref count of the procedure's
237 * body object since there will be a reference to it in the Proc
238 * structure.
239 */
240
241 Tcl_IncrRefCount(bodyPtr);
242
243 procPtr = (Proc *) ckalloc(sizeof(Proc));
244 procPtr->iPtr = iPtr;
245 procPtr->refCount = 1;
246 procPtr->bodyPtr = bodyPtr;
247 procPtr->numArgs = 0; /* actual argument count is set below. */
248 procPtr->numCompiledLocals = 0;
249 procPtr->firstLocalPtr = NULL;
250 procPtr->lastLocalPtr = NULL;
251 }
252
253 /*
254 * Break up the argument list into argument specifiers, then process
255 * each argument specifier.
256 * If the body is precompiled, processing is limited to checking that
257 * the the parsed argument is consistent with the one stored in the
258 * Proc.
259 * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULLS.
260 */
261
262 args = Tcl_GetStringFromObj(argsPtr, &length);
263 result = Tcl_SplitList(interp, args, &numArgs, &argArray);
264 if (result != TCL_OK) {
265 goto procError;
266 }
267
268 if (precompiled) {
269 if (numArgs > procPtr->numArgs) {
270 char buf[128];
271 sprintf(buf, "\": arg list contains %d entries, precompiled header expects %d",
272 numArgs, procPtr->numArgs);
273 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
274 "procedure \"", procName,
275 buf, (char *) NULL);
276 goto procError;
277 }
278 localPtr = procPtr->firstLocalPtr;
279 } else {
280 procPtr->numArgs = numArgs;
281 procPtr->numCompiledLocals = numArgs;
282 }
283 for (i = 0; i < numArgs; i++) {
284 int fieldCount, nameLength, valueLength;
285 char **fieldValues;
286
287 /*
288 * Now divide the specifier up into name and default.
289 */
290
291 result = Tcl_SplitList(interp, argArray[i], &fieldCount,
292 &fieldValues);
293 if (result != TCL_OK) {
294 goto procError;
295 }
296 if (fieldCount > 2) {
297 ckfree((char *) fieldValues);
298 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
299 "too many fields in argument specifier \"",
300 argArray[i], "\"", (char *) NULL);
301 goto procError;
302 }
303 if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
304 ckfree((char *) fieldValues);
305 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
306 "procedure \"", procName,
307 "\" has argument with no name", (char *) NULL);
308 goto procError;
309 }
310
311 nameLength = strlen(fieldValues[0]);
312 if (fieldCount == 2) {
313 valueLength = strlen(fieldValues[1]);
314 } else {
315 valueLength = 0;
316 }
317
318 /*
319 * Check that the formal parameter name is a scalar.
320 */
321
322 p = fieldValues[0];
323 while (*p != '\0') {
324 if (*p == '(') {
325 char *q = p;
326 do {
327 q++;
328 } while (*q != '\0');
329 q--;
330 if (*q == ')') { /* we have an array element */
331 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
332 "procedure \"", procName,
333 "\" has formal parameter \"", fieldValues[0],
334 "\" that is an array element",
335 (char *) NULL);
336 ckfree((char *) fieldValues);
337 goto procError;
338 }
339 }
340 p++;
341 }
342
343 if (precompiled) {
344 /*
345 * compare the parsed argument with the stored one
346 */
347
348 if ((localPtr->nameLength != nameLength)
349 || (strcmp(localPtr->name, fieldValues[0]))
350 || (localPtr->frameIndex != i)
351 || (localPtr->flags != (VAR_SCALAR | VAR_ARGUMENT))
352 || ((localPtr->defValuePtr == NULL)
353 && (fieldCount == 2))
354 || ((localPtr->defValuePtr != NULL)
355 && (fieldCount != 2))) {
356 char buf[128];
357 sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
358 i);
359 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
360 "procedure \"", procName,
361 buf, (char *) NULL);
362 ckfree((char *) fieldValues);
363 goto procError;
364 }
365
366 /*
367 * compare the default value if any
368 */
369
370 if (localPtr->defValuePtr != NULL) {
371 int tmpLength;
372 char *tmpPtr = Tcl_GetStringFromObj(localPtr->defValuePtr,
373 &tmpLength);
374 if ((valueLength != tmpLength)
375 || (strncmp(fieldValues[1], tmpPtr,
376 (size_t) tmpLength))) {
377 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
378 "procedure \"", procName,
379 "\": formal parameter \"",
380 fieldValues[0],
381 "\" has default value inconsistent with precompiled body",
382 (char *) NULL);
383 ckfree((char *) fieldValues);
384 goto procError;
385 }
386 }
387
388 localPtr = localPtr->nextPtr;
389 } else {
390 /*
391 * Allocate an entry in the runtime procedure frame's array of
392 * local variables for the argument.
393 */
394
395 localPtr = (CompiledLocal *) ckalloc((unsigned)
396 (sizeof(CompiledLocal) - sizeof(localPtr->name)
397 + nameLength+1));
398 if (procPtr->firstLocalPtr == NULL) {
399 procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
400 } else {
401 procPtr->lastLocalPtr->nextPtr = localPtr;
402 procPtr->lastLocalPtr = localPtr;
403 }
404 localPtr->nextPtr = NULL;
405 localPtr->nameLength = nameLength;
406 localPtr->frameIndex = i;
407 localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
408 localPtr->resolveInfo = NULL;
409
410 if (fieldCount == 2) {
411 localPtr->defValuePtr =
412 Tcl_NewStringObj(fieldValues[1], valueLength);
413 Tcl_IncrRefCount(localPtr->defValuePtr);
414 } else {
415 localPtr->defValuePtr = NULL;
416 }
417 strcpy(localPtr->name, fieldValues[0]);
418 }
419
420 ckfree((char *) fieldValues);
421 }
422
423 /*
424 * Now initialize the new procedure's cmdPtr field. This will be used
425 * later when the procedure is called to determine what namespace the
426 * procedure will run in. This will be different than the current
427 * namespace if the proc was renamed into a different namespace.
428 */
429
430 *procPtrPtr = procPtr;
431 ckfree((char *) argArray);
432 return TCL_OK;
433
434procError:
435 if (precompiled) {
436 procPtr->refCount--;
437 } else {
438 Tcl_DecrRefCount(bodyPtr);
439 while (procPtr->firstLocalPtr != NULL) {
440 localPtr = procPtr->firstLocalPtr;
441 procPtr->firstLocalPtr = localPtr->nextPtr;
442
443 defPtr = localPtr->defValuePtr;
444 if (defPtr != NULL) {
445 Tcl_DecrRefCount(defPtr);
446 }
447
448 ckfree((char *) localPtr);
449 }
450 ckfree((char *) procPtr);
451 }
452 if (argArray != NULL) {
453 ckfree((char *) argArray);
454 }
455 return TCL_ERROR;
456}
457
458
459
460/*
461 *----------------------------------------------------------------------
462 *
463 * TclGetFrame --
464 *
465 * Given a description of a procedure frame, such as the first
466 * argument to an "uplevel" or "upvar" command, locate the
467 * call frame for the appropriate level of procedure.
468 *
469 * Results:
470 * The return value is -1 if an error occurred in finding the
471 * frame (in this case an error message is left in interp->result).
472 * 1 is returned if string was either a number or a number preceded
473 * by "#" and it specified a valid frame. 0 is returned if string
474 * isn't one of the two things above (in this case, the lookup
475 * acts as if string were "1"). The variable pointed to by
476 * framePtrPtr is filled in with the address of the desired frame
477 * (unless an error occurs, in which case it isn't modified).
478 *
479 * Side effects:
480 * None.
481 *
482 *----------------------------------------------------------------------
483 */
484
485int
486TclGetFrame(interp, string, framePtrPtr)
487 Tcl_Interp *interp; /* Interpreter in which to find frame. */
488 char *string; /* String describing frame. */
489 CallFrame **framePtrPtr; /* Store pointer to frame here (or NULL
490 * if global frame indicated). */
491{
492 register Interp *iPtr = (Interp *) interp;
493 int curLevel, level, result;
494 CallFrame *framePtr;
495
496 /*
497 * Parse string to figure out which level number to go to.
498 */
499
500 result = 1;
501 curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
502 if (*string == '#') {
503 if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
504 return -1;
505 }
506 if (level < 0) {
507 levelError:
508 Tcl_AppendResult(interp, "bad level \"", string, "\"",
509 (char *) NULL);
510 return -1;
511 }
512 } else if (isdigit(UCHAR(*string))) {
513 if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
514 return -1;
515 }
516 level = curLevel - level;
517 } else {
518 level = curLevel - 1;
519 result = 0;
520 }
521
522 /*
523 * Figure out which frame to use, and modify the interpreter so
524 * its variables come from that frame.
525 */
526
527 if (level == 0) {
528 framePtr = NULL;
529 } else {
530 for (framePtr = iPtr->varFramePtr; framePtr != NULL;
531 framePtr = framePtr->callerVarPtr) {
532 if (framePtr->level == level) {
533 break;
534 }
535 }
536 if (framePtr == NULL) {
537 goto levelError;
538 }
539 }
540 *framePtrPtr = framePtr;
541 return result;
542}
543
544
545/*
546 *----------------------------------------------------------------------
547 *
548 * Tcl_UplevelObjCmd --
549 *
550 * This object procedure is invoked to process the "uplevel" Tcl
551 * command. See the user documentation for details on what it does.
552 *
553 * Results:
554 * A standard Tcl object result value.
555 *
556 * Side effects:
557 * See the user documentation.
558 *
559 *----------------------------------------------------------------------
560 */
561
562 /* ARGSUSED */
563int
564Tcl_UplevelObjCmd(dummy, interp, objc, objv)
565 ClientData dummy; /* Not used. */
566 Tcl_Interp *interp; /* Current interpreter. */
567 int objc; /* Number of arguments. */
568 Tcl_Obj *CONST objv[]; /* Argument objects. */
569{
570 register Interp *iPtr = (Interp *) interp;
571 char *optLevel;
572 int length, result;
573 CallFrame *savedVarFramePtr, *framePtr;
574
575 if (objc < 2) {
576 uplevelSyntax:
577 Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
578 return TCL_ERROR;
579 }
580
581 /*
582 * Find the level to use for executing the command.
583 * THIS FAILS IF THE OBJECT RESULT'S STRING REP CONTAINS A NULL.
584 */
585
586 optLevel = Tcl_GetStringFromObj(objv[1], &length);
587 result = TclGetFrame(interp, optLevel, &framePtr);
588 if (result == -1) {
589 return TCL_ERROR;
590 }
591 objc -= (result+1);
592 if (objc == 0) {
593 goto uplevelSyntax;
594 }
595 objv += (result+1);
596
597 /*
598 * Modify the interpreter state to execute in the given frame.
599 */
600
601 savedVarFramePtr = iPtr->varFramePtr;
602 iPtr->varFramePtr = framePtr;
603
604 /*
605 * Execute the residual arguments as a command.
606 */
607
608 if (objc == 1) {
609 result = Tcl_EvalObj(interp, objv[0]);
610 } else {
611 Tcl_Obj *cmdObjPtr = Tcl_ConcatObj(objc, objv);
612 result = Tcl_EvalObj(interp, cmdObjPtr);
613 Tcl_DecrRefCount(cmdObjPtr); /* done with object */
614 }
615 if (result == TCL_ERROR) {
616 char msg[60];
617 sprintf(msg, "\n (\"uplevel\" body line %d)", interp->errorLine);
618 Tcl_AddObjErrorInfo(interp, msg, -1);
619 }
620
621 /*
622 * Restore the variable frame, and return.
623 */
624
625 iPtr->varFramePtr = savedVarFramePtr;
626 return result;
627}
628
629
630/*
631 *----------------------------------------------------------------------
632 *
633 * TclFindProc --
634 *
635 * Given the name of a procedure, return a pointer to the
636 * record describing the procedure.
637 *
638 * Results:
639 * NULL is returned if the name doesn't correspond to any
640 * procedure. Otherwise the return value is a pointer to
641 * the procedure's record.
642 *
643 * Side effects:
644 * None.
645 *
646 *----------------------------------------------------------------------
647 */
648
649Proc *
650TclFindProc(iPtr, procName)
651 Interp *iPtr; /* Interpreter in which to look. */
652 char *procName; /* Name of desired procedure. */
653{
654 Tcl_Command cmd;
655 Tcl_Command origCmd;
656 Command *cmdPtr;
657
658 cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
659 (Tcl_Namespace *) NULL, /*flags*/ 0);
660 if (cmd == (Tcl_Command) NULL) {
661 return NULL;
662 }
663 cmdPtr = (Command *) cmd;
664
665 origCmd = TclGetOriginalCommand(cmd);
666 if (origCmd != NULL) {
667 cmdPtr = (Command *) origCmd;
668 }
669 if (cmdPtr->proc != TclProcInterpProc) {
670 return NULL;
671 }
672 return (Proc *) cmdPtr->clientData;
673}
674
675
676/*
677 *----------------------------------------------------------------------
678 *
679 * TclIsProc --
680 *
681 * Tells whether a command is a Tcl procedure or not.
682 *
683 * Results:
684 * If the given command is actually a Tcl procedure, the
685 * return value is the address of the record describing
686 * the procedure. Otherwise the return value is 0.
687 *
688 * Side effects:
689 * None.
690 *
691 *----------------------------------------------------------------------
692 */
693
694Proc *
695TclIsProc(cmdPtr)
696 Command *cmdPtr; /* Command to test. */
697{
698 Tcl_Command origCmd;
699
700 origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
701 if (origCmd != NULL) {
702 cmdPtr = (Command *) origCmd;
703 }
704 if (cmdPtr->proc == TclProcInterpProc) {
705 return (Proc *) cmdPtr->clientData;
706 }
707 return (Proc *) 0;
708}
709
710
711/*
712 *----------------------------------------------------------------------
713 *
714 * TclProcInterpProc --
715 *
716 * When a Tcl procedure gets invoked with an argc/argv array of
717 * strings, this routine gets invoked to interpret the procedure.
718 *
719 * Results:
720 * A standard Tcl result value, usually TCL_OK.
721 *
722 * Side effects:
723 * Depends on the commands in the procedure.
724 *
725 *----------------------------------------------------------------------
726 */
727
728int
729TclProcInterpProc(clientData, interp, argc, argv)
730 ClientData clientData; /* Record describing procedure to be
731 * interpreted. */
732 Tcl_Interp *interp; /* Interpreter in which procedure was
733 * invoked. */
734 int argc; /* Count of number of arguments to this
735 * procedure. */
736 register char **argv; /* Argument values. */
737{
738 register Tcl_Obj *objPtr;
739 register int i;
740 int result;
741
742 /*
743 * This procedure generates an objv array for object arguments that hold
744 * the argv strings. It starts out with stack-allocated space but uses
745 * dynamically-allocated storage if needed.
746 */
747
748#define NUM_ARGS 20
749 Tcl_Obj *(objStorage[NUM_ARGS]);
750 register Tcl_Obj **objv = objStorage;
751
752 /*
753 * Create the object argument array "objv". Make sure objv is large
754 * enough to hold the objc arguments plus 1 extra for the zero
755 * end-of-objv word.
756 */
757
758 if ((argc + 1) > NUM_ARGS) {
759 objv = (Tcl_Obj **)
760 ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
761 }
762
763 for (i = 0; i < argc; i++) {
764 objv[i] = Tcl_NewStringObj(argv[i], -1);
765 Tcl_IncrRefCount(objv[i]);
766 }
767 objv[argc] = 0;
768
769 /*
770 * Use TclObjInterpProc to actually interpret the procedure.
771 */
772
773 result = TclObjInterpProc(clientData, interp, argc, objv);
774
775 /*
776 * Move the interpreter's object result to the string result,
777 * then reset the object result.
778 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION CONTAINS NULLS.
779 */
780
781 Tcl_SetResult(interp,
782 TclGetStringFromObj(Tcl_GetObjResult(interp), (int *) NULL),
783 TCL_VOLATILE);
784
785 /*
786 * Decrement the ref counts on the objv elements since we are done
787 * with them.
788 */
789
790 for (i = 0; i < argc; i++) {
791 objPtr = objv[i];
792 TclDecrRefCount(objPtr);
793 }
794
795 /*
796 * Free the objv array if malloc'ed storage was used.
797 */
798
799 if (objv != objStorage) {
800 ckfree((char *) objv);
801 }
802 return result;
803#undef NUM_ARGS
804}
805
806
807/*
808 *----------------------------------------------------------------------
809 *
810 * TclObjInterpProc --
811 *
812 * When a Tcl procedure gets invoked during bytecode evaluation, this
813 * object-based routine gets invoked to interpret the procedure.
814 *
815 * Results:
816 * A standard Tcl object result value.
817 *
818 * Side effects:
819 * Depends on the commands in the procedure.
820 *
821 *----------------------------------------------------------------------
822 */
823
824int
825TclObjInterpProc(clientData, interp, objc, objv)
826 ClientData clientData; /* Record describing procedure to be
827 * interpreted. */
828 Tcl_Interp *interp; /* Interpreter in which procedure was
829 * invoked. */
830 int objc; /* Count of number of arguments to this
831 * procedure. */
832 Tcl_Obj *CONST objv[]; /* Argument value objects. */
833{
834 Interp *iPtr = (Interp *) interp;
835 Proc *procPtr = (Proc *) clientData;
836 Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
837 CallFrame frame;
838 register CallFrame *framePtr = &frame;
839 register CompiledLocal *localPtr;
840 char *procName, *bytes;
841 int nameLen, localCt, numArgs, argCt, length, i, result;
842 Var *varPtr;
843
844 /*
845 * This procedure generates an array "compiledLocals" that holds the
846 * storage for local variables. It starts out with stack-allocated space
847 * but uses dynamically-allocated storage if needed.
848 */
849
850#define NUM_LOCALS 20
851 Var localStorage[NUM_LOCALS];
852 Var *compiledLocals = localStorage;
853
854 /*
855 * Get the procedure's name.
856 * THIS FAILS IF THE PROC NAME'S STRING REP HAS A NULL.
857 */
858
859 procName = Tcl_GetStringFromObj(objv[0], &nameLen);
860
861 /*
862 * If necessary, compile the procedure's body. The compiler will
863 * allocate frame slots for the procedure's non-argument local
864 * variables. Note that compiling the body might increase
865 * procPtr->numCompiledLocals if new local variables are found
866 * while compiling.
867 */
868
869 result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
870 "body of proc", procName);
871
872 if (result != TCL_OK) {
873 return result;
874 }
875
876 /*
877 * Create the "compiledLocals" array. Make sure it is large enough to
878 * hold all the procedure's compiled local variables, including its
879 * formal parameters.
880 */
881
882 localCt = procPtr->numCompiledLocals;
883 if (localCt > NUM_LOCALS) {
884 compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
885 }
886
887 /*
888 * Set up and push a new call frame for the new procedure invocation.
889 * This call frame will execute in the proc's namespace, which might
890 * be different than the current namespace. The proc's namespace is
891 * that of its command, which can change if the command is renamed
892 * from one namespace to another.
893 */
894
895 result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
896 (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1);
897
898 if (result != TCL_OK) {
899 return result;
900 }
901
902 framePtr->objc = objc;
903 framePtr->objv = objv; /* ref counts for args are incremented below */
904
905 /*
906 * Initialize and resolve compiled variable references.
907 */
908
909 framePtr->procPtr = procPtr;
910 framePtr->numCompiledLocals = localCt;
911 framePtr->compiledLocals = compiledLocals;
912
913 TclInitCompiledLocals(interp, framePtr, nsPtr);
914
915 /*
916 * Match and assign the call's actual parameters to the procedure's
917 * formal arguments. The formal arguments are described by the first
918 * numArgs entries in both the Proc structure's local variable list and
919 * the call frame's local variable array.
920 */
921
922 numArgs = procPtr->numArgs;
923 varPtr = framePtr->compiledLocals;
924 localPtr = procPtr->firstLocalPtr;
925 argCt = objc;
926 for (i = 1, argCt -= 1; i <= numArgs; i++, argCt--) {
927 if (!TclIsVarArgument(localPtr)) {
928 panic("TclObjInterpProc: local variable %s is not argument but should be",
929 localPtr->name);
930 return TCL_ERROR;
931 }
932 if (TclIsVarTemporary(localPtr)) {
933 panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
934 return TCL_ERROR;
935 }
936
937 /*
938 * Handle the special case of the last formal being "args". When
939 * it occurs, assign it a list consisting of all the remaining
940 * actual arguments.
941 */
942
943 if ((i == numArgs) && ((localPtr->name[0] == 'a')
944 && (strcmp(localPtr->name, "args") == 0))) {
945 Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
946 varPtr->value.objPtr = listPtr;
947 Tcl_IncrRefCount(listPtr); /* local var is a reference */
948 varPtr->flags &= ~VAR_UNDEFINED;
949 argCt = 0;
950 break; /* done processing args */
951 } else if (argCt > 0) {
952 Tcl_Obj *objPtr = objv[i];
953 varPtr->value.objPtr = objPtr;
954 varPtr->flags &= ~VAR_UNDEFINED;
955 Tcl_IncrRefCount(objPtr); /* since the local variable now has
956 * another reference to object. */
957 } else if (localPtr->defValuePtr != NULL) {
958 Tcl_Obj *objPtr = localPtr->defValuePtr;
959 varPtr->value.objPtr = objPtr;
960 varPtr->flags &= ~VAR_UNDEFINED;
961 Tcl_IncrRefCount(objPtr); /* since the local variable now has
962 * another reference to object. */
963 } else {
964 Tcl_ResetResult(interp);
965 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
966 "no value given for parameter \"", localPtr->name,
967 "\" to \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
968 "\"", (char *) NULL);
969 result = TCL_ERROR;
970 goto procDone;
971 }
972 varPtr++;
973 localPtr = localPtr->nextPtr;
974 }
975 if (argCt > 0) {
976 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
977 "called \"", Tcl_GetStringFromObj(objv[0], (int *) NULL),
978 "\" with too many arguments", (char *) NULL);
979 result = TCL_ERROR;
980 goto procDone;
981 }
982
983 /*
984 * Invoke the commands in the procedure's body.
985 */
986
987 iPtr->returnCode = TCL_OK;
988 procPtr->refCount++;
989 result = Tcl_EvalObj(interp, procPtr->bodyPtr);
990 procPtr->refCount--;
991 if (procPtr->refCount <= 0) {
992 TclProcCleanupProc(procPtr);
993 }
994
995 if (result != TCL_OK) {
996 if (result == TCL_RETURN) {
997 result = TclUpdateReturnInfo(iPtr);
998 } else if (result == TCL_ERROR) {
999 char msg[100];
1000 sprintf(msg, "\n (procedure \"%.50s\" line %d)",
1001 procName, iPtr->errorLine);
1002 Tcl_AddObjErrorInfo(interp, msg, -1);
1003 } else if (result == TCL_BREAK) {
1004 Tcl_ResetResult(interp);
1005 Tcl_AppendToObj(Tcl_GetObjResult(interp),
1006 "invoked \"break\" outside of a loop", -1);
1007 result = TCL_ERROR;
1008 } else if (result == TCL_CONTINUE) {
1009 Tcl_ResetResult(interp);
1010 Tcl_AppendToObj(Tcl_GetObjResult(interp),
1011 "invoked \"continue\" outside of a loop", -1);
1012 result = TCL_ERROR;
1013 }
1014 }
1015
1016 procDone:
1017
1018 /*
1019 * Pop and free the call frame for this procedure invocation.
1020 */
1021
1022 Tcl_PopCallFrame(interp);
1023
1024 /*
1025 * Free the compiledLocals array if malloc'ed storage was used.
1026 */
1027
1028 if (compiledLocals != localStorage) {
1029 ckfree((char *) compiledLocals);
1030 }
1031 return result;
1032#undef NUM_LOCALS
1033}
1034
1035
1036/*
1037 *----------------------------------------------------------------------
1038 *
1039 * TclProcCompileProc --
1040 *
1041 * Called just before a procedure is executed to compile the
1042 * body to byte codes. If the type of the body is not
1043 * "byte code" or if the compile conditions have changed
1044 * (namespace context, epoch counters, etc.) then the body
1045 * is recompiled. Otherwise, this procedure does nothing.
1046 *
1047 * Results:
1048 * None.
1049 *
1050 * Side effects:
1051 * May change the internal representation of the body object
1052 * to compiled code.
1053 *
1054 *----------------------------------------------------------------------
1055 */
1056
1057int
1058TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
1059 Tcl_Interp *interp; /* Interpreter containing procedure. */
1060 Proc *procPtr; /* Data associated with procedure. */
1061 Tcl_Obj *bodyPtr; /* Body of proc. (Usually procPtr->bodyPtr,
1062 * but could be any code fragment compiled
1063 * in the context of this procedure.) */
1064 Namespace *nsPtr; /* Namespace containing procedure. */
1065 CONST char *description; /* string describing this body of code. */
1066 CONST char *procName; /* Name of this procedure. */
1067{
1068 Interp *iPtr = (Interp*)interp;
1069 int result;
1070 Tcl_CallFrame frame;
1071 Proc *saveProcPtr;
1072 ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
1073
1074 /*
1075 * If necessary, compile the procedure's body. The compiler will
1076 * allocate frame slots for the procedure's non-argument local
1077 * variables. If the ByteCode already exists, make sure it hasn't been
1078 * invalidated by someone redefining a core command (this might make the
1079 * compiled code wrong). Also, if the code was compiled in/for a
1080 * different interpreter, we recompile it. Note that compiling the body
1081 * might increase procPtr->numCompiledLocals if new local variables are
1082 * found while compiling.
1083 *
1084 * Precompiled procedure bodies, however, are immutable and therefore
1085 * they are not recompiled, even if things have changed.
1086 */
1087
1088 if (bodyPtr->typePtr == &tclByteCodeType) {
1089 if ((codePtr->iPtr != iPtr)
1090 || (codePtr->compileEpoch != iPtr->compileEpoch)
1091 || (codePtr->nsPtr != nsPtr)) {
1092 if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
1093 if (codePtr->iPtr != iPtr) {
1094 Tcl_AppendResult(interp,
1095 "a precompiled script jumped interps", NULL);
1096 return TCL_ERROR;
1097 }
1098 codePtr->compileEpoch = iPtr->compileEpoch;
1099 codePtr->nsPtr = nsPtr;
1100 } else {
1101 tclByteCodeType.freeIntRepProc(bodyPtr);
1102 bodyPtr->typePtr = (Tcl_ObjType *) NULL;
1103 }
1104 }
1105 }
1106 if (bodyPtr->typePtr != &tclByteCodeType) {
1107 char buf[100];
1108 int numChars;
1109 char *ellipsis;
1110
1111 /*
1112 * Plug the current procPtr into the interpreter and coerce
1113 * the code body to byte codes. The interpreter needs to
1114 * know which proc it's compiling so that it can access its
1115 * list of compiled locals.
1116 *
1117 * TRICKY NOTE: Be careful to push a call frame with the
1118 * proper namespace context, so that the byte codes are
1119 * compiled in the appropriate class context.
1120 */
1121
1122 saveProcPtr = iPtr->compiledProcPtr;
1123 iPtr->compiledProcPtr = procPtr;
1124
1125 result = Tcl_PushCallFrame(interp, &frame,
1126 (Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
1127
1128 if (result == TCL_OK) {
1129 result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
1130 Tcl_PopCallFrame(interp);
1131 }
1132
1133 iPtr->compiledProcPtr = saveProcPtr;
1134
1135 if (result != TCL_OK) {
1136 if (result == TCL_ERROR) {
1137 numChars = strlen(procName);
1138 ellipsis = "";
1139 if (numChars > 50) {
1140 numChars = 50;
1141 ellipsis = "...";
1142 }
1143 sprintf(buf, "\n (compiling %s \"%.*s%s\", line %d)",
1144 description, numChars, procName, ellipsis,
1145 interp->errorLine);
1146 Tcl_AddObjErrorInfo(interp, buf, -1);
1147 }
1148 return result;
1149 }
1150 } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
1151 register CompiledLocal *localPtr;
1152
1153 /*
1154 * The resolver epoch has changed, but we only need to invalidate
1155 * the resolver cache.
1156 */
1157
1158 for (localPtr = procPtr->firstLocalPtr; localPtr != NULL;
1159 localPtr = localPtr->nextPtr) {
1160 localPtr->flags &= ~(VAR_RESOLVED);
1161 if (localPtr->resolveInfo) {
1162 if (localPtr->resolveInfo->deleteProc) {
1163 localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
1164 } else {
1165 ckfree((char*)localPtr->resolveInfo);
1166 }
1167 localPtr->resolveInfo = NULL;
1168 }
1169 }
1170 }
1171 return TCL_OK;
1172}
1173
1174
1175
1176/*
1177 *----------------------------------------------------------------------
1178 *
1179 * TclProcDeleteProc --
1180 *
1181 * This procedure is invoked just before a command procedure is
1182 * removed from an interpreter. Its job is to release all the
1183 * resources allocated to the procedure.
1184 *
1185 * Results:
1186 * None.
1187 *
1188 * Side effects:
1189 * Memory gets freed, unless the procedure is actively being
1190 * executed. In this case the cleanup is delayed until the
1191 * last call to the current procedure completes.
1192 *
1193 *----------------------------------------------------------------------
1194 */
1195
1196void
1197TclProcDeleteProc(clientData)
1198 ClientData clientData; /* Procedure to be deleted. */
1199{
1200 Proc *procPtr = (Proc *) clientData;
1201
1202 procPtr->refCount--;
1203 if (procPtr->refCount <= 0) {
1204 TclProcCleanupProc(procPtr);
1205 }
1206}
1207
1208
1209/*
1210 *----------------------------------------------------------------------
1211 *
1212 * TclProcCleanupProc --
1213 *
1214 * This procedure does all the real work of freeing up a Proc
1215 * structure. It's called only when the structure's reference
1216 * count becomes zero.
1217 *
1218 * Results:
1219 * None.
1220 *
1221 * Side effects:
1222 * Memory gets freed.
1223 *
1224 *----------------------------------------------------------------------
1225 */
1226
1227void
1228TclProcCleanupProc(procPtr)
1229 register Proc *procPtr; /* Procedure to be deleted. */
1230{
1231 register CompiledLocal *localPtr;
1232 Tcl_Obj *bodyPtr = procPtr->bodyPtr;
1233 Tcl_Obj *defPtr;
1234 Tcl_ResolvedVarInfo *resVarInfo;
1235
1236 if (bodyPtr != NULL) {
1237 Tcl_DecrRefCount(bodyPtr);
1238 }
1239 for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) {
1240 CompiledLocal *nextPtr = localPtr->nextPtr;
1241
1242 resVarInfo = localPtr->resolveInfo;
1243 if (resVarInfo) {
1244 if (resVarInfo->deleteProc) {
1245 (*resVarInfo->deleteProc)(resVarInfo);
1246 } else {
1247 ckfree((char *) resVarInfo);
1248 }
1249 }
1250
1251 if (localPtr->defValuePtr != NULL) {
1252 defPtr = localPtr->defValuePtr;
1253 Tcl_DecrRefCount(defPtr);
1254 }
1255 ckfree((char *) localPtr);
1256 localPtr = nextPtr;
1257 }
1258 ckfree((char *) procPtr);
1259}
1260
1261
1262/*
1263 *----------------------------------------------------------------------
1264 *
1265 * TclUpdateReturnInfo --
1266 *
1267 * This procedure is called when procedures return, and at other
1268 * points where the TCL_RETURN code is used. It examines fields
1269 * such as iPtr->returnCode and iPtr->errorCode and modifies
1270 * the real return status accordingly.
1271 *
1272 * Results:
1273 * The return value is the true completion code to use for
1274 * the procedure, instead of TCL_RETURN.
1275 *
1276 * Side effects:
1277 * The errorInfo and errorCode variables may get modified.
1278 *
1279 *----------------------------------------------------------------------
1280 */
1281
1282int
1283TclUpdateReturnInfo(iPtr)
1284 Interp *iPtr; /* Interpreter for which TCL_RETURN
1285 * exception is being processed. */
1286{
1287 int code;
1288
1289 code = iPtr->returnCode;
1290 iPtr->returnCode = TCL_OK;
1291 if (code == TCL_ERROR) {
1292 Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode", (char *) NULL,
1293 (iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE",
1294 TCL_GLOBAL_ONLY);
1295 iPtr->flags |= ERROR_CODE_SET;
1296 if (iPtr->errorInfo != NULL) {
1297 Tcl_SetVar2((Tcl_Interp *) iPtr, "errorInfo", (char *) NULL,
1298 iPtr->errorInfo, TCL_GLOBAL_ONLY);
1299 iPtr->flags |= ERR_IN_PROGRESS;
1300 }
1301 }
1302 return code;
1303}
1304
1305
1306/*
1307 *----------------------------------------------------------------------
1308 *
1309 * TclGetInterpProc --
1310 *
1311 * Returns a pointer to the TclProcInterpProc procedure; this is different
1312 * from the value obtained from the TclProcInterpProc reference on systems
1313 * like Windows where import and export versions of a procedure exported
1314 * by a DLL exist.
1315 *
1316 * Results:
1317 * Returns the internal address of the TclProcInterpProc procedure.
1318 *
1319 * Side effects:
1320 * None.
1321 *
1322 *----------------------------------------------------------------------
1323 */
1324
1325TclCmdProcType
1326TclGetInterpProc()
1327{
1328 return TclProcInterpProc;
1329}
1330
1331
1332/*
1333 *----------------------------------------------------------------------
1334 *
1335 * TclGetObjInterpProc --
1336 *
1337 * Returns a pointer to the TclObjInterpProc procedure; this is different
1338 * from the value obtained from the TclObjInterpProc reference on systems
1339 * like Windows where import and export versions of a procedure exported
1340 * by a DLL exist.
1341 *
1342 * Results:
1343 * Returns the internal address of the TclObjInterpProc procedure.
1344 *
1345 * Side effects:
1346 * None.
1347 *
1348 *----------------------------------------------------------------------
1349 */
1350
1351TclObjCmdProcType
1352TclGetObjInterpProc()
1353{
1354 return TclObjInterpProc;
1355}
1356
1357
1358/*
1359 *----------------------------------------------------------------------
1360 *
1361 * TclNewProcBodyObj --
1362 *
1363 * Creates a new object, of type "procbody", whose internal
1364 * representation is the given Proc struct.
1365 * The newly created object's reference count is 0.
1366 *
1367 * Results:
1368 * Returns a pointer to a newly allocated Tcl_Obj, 0 on error.
1369 *
1370 * Side effects:
1371 * The reference count in the ByteCode attached to the Proc is bumped up
1372 * by one, since the internal rep stores a pointer to it.
1373 *
1374 *----------------------------------------------------------------------
1375 */
1376
1377Tcl_Obj *
1378TclNewProcBodyObj(procPtr)
1379 Proc *procPtr; /* the Proc struct to store as the internal
1380 * representation. */
1381{
1382 Tcl_Obj *objPtr;
1383
1384 if (!procPtr) {
1385 return (Tcl_Obj *) NULL;
1386 }
1387
1388 objPtr = Tcl_NewStringObj("", 0);
1389
1390 if (objPtr) {
1391 objPtr->typePtr = &tclProcBodyType;
1392 objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
1393
1394 procPtr->refCount++;
1395 }
1396
1397 return objPtr;
1398}
1399
1400
1401/*
1402 *----------------------------------------------------------------------
1403 *
1404 * ProcBodyDup --
1405 *
1406 * Tcl_ObjType's Dup function for the proc body object.
1407 * Bumps the reference count on the Proc stored in the internal
1408 * representation.
1409 *
1410 * Results:
1411 * None.
1412 *
1413 * Side effects:
1414 * Sets up the object in dupPtr to be a duplicate of the one in srcPtr.
1415 *
1416 *----------------------------------------------------------------------
1417 */
1418
1419static void ProcBodyDup(srcPtr, dupPtr)
1420 Tcl_Obj *srcPtr; /* object to copy */
1421 Tcl_Obj *dupPtr; /* target object for the duplication */
1422{
1423 Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
1424
1425 dupPtr->typePtr = &tclProcBodyType;
1426 dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
1427 procPtr->refCount++;
1428}
1429
1430
1431/*
1432 *----------------------------------------------------------------------
1433 *
1434 * ProcBodyFree --
1435 *
1436 * Tcl_ObjType's Free function for the proc body object.
1437 * The reference count on its Proc struct is decreased by 1; if the count
1438 * reaches 0, the proc is freed.
1439 *
1440 * Results:
1441 * None.
1442 *
1443 * Side effects:
1444 * If the reference count on the Proc struct reaches 0, the struct is freed.
1445 *
1446 *----------------------------------------------------------------------
1447 */
1448
1449static void
1450ProcBodyFree(objPtr)
1451 Tcl_Obj *objPtr; /* the object to clean up */
1452{
1453 Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
1454 procPtr->refCount--;
1455 if (procPtr->refCount <= 0) {
1456 TclProcCleanupProc(procPtr);
1457 }
1458}
1459
1460
1461/*
1462 *----------------------------------------------------------------------
1463 *
1464 * ProcBodySetFromAny --
1465 *
1466 * Tcl_ObjType's SetFromAny function for the proc body object.
1467 * Calls panic.
1468 *
1469 * Results:
1470 * Theoretically returns a TCL result code.
1471 *
1472 * Side effects:
1473 * Calls panic, since we can't set the value of the object from a string
1474 * representation (or any other internal ones).
1475 *
1476 *----------------------------------------------------------------------
1477 */
1478
1479static int
1480ProcBodySetFromAny(interp, objPtr)
1481 Tcl_Interp *interp; /* current interpreter */
1482 Tcl_Obj *objPtr; /* object pointer */
1483{
1484 panic("called ProcBodySetFromAny");
1485
1486 /*
1487 * this to keep compilers happy.
1488 */
1489
1490 return TCL_OK;
1491}
1492
1493
1494/*
1495 *----------------------------------------------------------------------
1496 *
1497 * ProcBodyUpdateString --
1498 *
1499 * Tcl_ObjType's UpdateString function for the proc body object.
1500 * Calls panic.
1501 *
1502 * Results:
1503 * None.
1504 *
1505 * Side effects:
1506 * Calls panic, since we this type has no string representation.
1507 *
1508 *----------------------------------------------------------------------
1509 */
1510
1511static void
1512ProcBodyUpdateString(objPtr)
1513 Tcl_Obj *objPtr; /* the object to update */
1514{
1515 panic("called ProcBodyUpdateString");
1516}
Note: See TracBrowser for help on using the repository browser.