![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclProc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl|
Return to tclProc.c CVS log | Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl |
1.1 root 1: /*
2: * tclProc.c --
3: *
4: * This file contains routines that implement Tcl procedures and
5: * variables.
6: *
7: * Copyright 1987 Regents of the University of California
8: * Permission to use, copy, modify, and distribute this
9: * software and its documentation for any purpose and without
10: * fee is hereby granted, provided that the above copyright
11: * notice appear in all copies. The University of California
12: * makes no representations about the suitability of this
13: * software for any purpose. It is provided "as is" without
14: * express or implied warranty.
15: */
16:
17: #ifndef lint
18: static char rcsid[] = "$Header: /sprite/src/lib/tcl/RCS/tclProc.c,v 1.35 90/03/29 10:55:16 ouster Exp $ SPRITE (Berkeley)";
19: #pragma ref rcsid
20: #endif not lint
21:
22: #include <stdio.h>
23: #include <stdlib.h>
24: #include <string.h>
25: #include <ctype.h>
26: #include "tclInt.h"
27:
28: /*
29: * Forward references to procedures defined later in this file:
30: */
31:
32: extern Var * FindVar();
33: extern int InterpProc();
34: extern Var * NewVar();
35: extern void ProcDeleteProc();
36:
37: /*
38: *----------------------------------------------------------------------
39: *
40: * Tcl_ProcCmd --
41: *
42: * This procedure is invoked to process the "proc" Tcl command.
43: * See the user documentation for details on what it does.
44: *
45: * Results:
46: * A standard Tcl result value.
47: *
48: * Side effects:
49: * A new procedure gets created.
50: *
51: *----------------------------------------------------------------------
52: */
53:
54: /* ARGSUSED */
55: int
56: Tcl_ProcCmd(dummy, interp, argc, argv)
57: ClientData dummy; /* Not used. */
58: Tcl_Interp *interp; /* Current interpreter. */
59: int argc; /* Number of arguments. */
60: char **argv; /* Argument strings. */
61: {
62: #pragma ref dummy
63: register Interp *iPtr = (Interp *) interp;
64: register Proc *procPtr;
65: int result, argCount, i;
66: char **argArray;
67:
68: if (argc != 4) {
69: sprintf(iPtr->result,
70: "wrong # args: should be \"%.50s name args body\"",
71: argv[0]);
72: return TCL_ERROR;
73: }
74:
75: procPtr = (Proc *) malloc(sizeof(Proc));
76: procPtr->iPtr = iPtr;
77: procPtr->command = (char *) malloc((unsigned) strlen(argv[3]) + 1);
78: strcpy(procPtr->command, argv[3]);
79: procPtr->argPtr = NULL;
80: Tcl_CreateCommand(interp, argv[1], InterpProc,
81: (ClientData) procPtr, ProcDeleteProc);
82:
83: /*
84: * Break up the argument list into argument specifiers, then process
85: * each argument specifier.
86: */
87:
88: result = Tcl_SplitList(interp, argv[2], &argCount, &argArray);
89: if (result != TCL_OK) {
90: return result;
91: }
92: for (i = 0; i < argCount; i++) {
93: int fieldCount, nameLength, valueLength;
94: char **fieldValues;
95: register Var *argPtr;
96:
97: /*
98: * Now divide the specifier up into name and default.
99: */
100:
101: result = Tcl_SplitList(interp, argArray[i], &fieldCount,
102: &fieldValues);
103: if (result != TCL_OK) {
104: goto procError;
105: }
106: if (fieldCount > 2) {
107: sprintf(iPtr->result,
108: "too many fields in argument specifier \"%.50s\"",
109: argArray[i]);
110: result = TCL_ERROR;
111: goto procError;
112: }
113: if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
114: sprintf(iPtr->result,
115: "procedure \"%.50s\" has argument with no name", argv[1]);
116: result = TCL_ERROR;
117: goto procError;
118: }
119: nameLength = strlen(fieldValues[0]);
120: if (fieldCount == 2) {
121: valueLength = strlen(fieldValues[1]);
122: } else {
123: valueLength = 0;
124: }
125: if (procPtr->argPtr == NULL) {
126: argPtr = (Var *) malloc(VAR_SIZE(nameLength, valueLength));
127: procPtr->argPtr = argPtr;
128: } else {
129: argPtr->nextPtr = (Var *) malloc(VAR_SIZE(nameLength, valueLength));
130: argPtr = argPtr->nextPtr;
131: }
132: strcpy(argPtr->name, fieldValues[0]);
133: if (fieldCount == 2) {
134: argPtr->value = argPtr->name + nameLength + 1;
135: strcpy(argPtr->value, fieldValues[1]);
136: } else {
137: argPtr->value = NULL;
138: }
139: argPtr->valueLength = valueLength;
140: argPtr->flags = 0;
141: argPtr->nextPtr = NULL;
142: free((char *) fieldValues);
143: }
144:
145: free((char *) argArray);
146: return TCL_OK;
147:
148: procError:
149: free((char *) argArray);
150: return result;
151: }
152:
153: /*1
154: *----------------------------------------------------------------------
155: *
156: * Tcl_GetVar --
157: *
158: * Return the value of a Tcl variable.
159: *
160: * Results:
161: * The return value points to the current value of varName. If
162: * the variable is not defined in interp, either as a local or
163: * global variable, then a NULL pointer is returned. Note: the
164: * return value is only valid up until the next call to Tcl_SetVar;
165: * if you depend on the value lasting longer than that, then make
166: * yourself a private copy.
167: *
168: * Side effects:
169: * None.
170: *
171: *----------------------------------------------------------------------
172: */
173:
174: char *
175: Tcl_GetVar(interp, varName, global)
176: Tcl_Interp *interp; /* Command interpreter in which varName is
177: * to be looked up. */
178: char *varName; /* Name of a variable in interp. */
179: int global; /* If non-zero, use only a global variable */
180: {
181: Var *varPtr;
182: Interp *iPtr = (Interp *) interp;
183:
184: if (global || (iPtr->varFramePtr == NULL)) {
185: varPtr = FindVar(&iPtr->globalPtr, varName);
186: } else {
187: varPtr = FindVar(&iPtr->varFramePtr->varPtr, varName);
188: }
189: if (varPtr == NULL) {
190: return NULL;
191: }
192: if (varPtr->flags & VAR_GLOBAL) {
193: varPtr = varPtr->globalPtr;
194: }
195: if (varPtr->flags & VAR_DOESNT_EXIST) {
196: return NULL;
197: }
198: return varPtr->value;
199: }
200:
201: /*
202: *----------------------------------------------------------------------
203: *
204: * Tcl_SetVar --
205: *
206: * Change the value of a variable.
207: *
208: * Results:
209: * None.
210: *
211: * Side effects:
212: * If varName is defined as a local or global variable in interp,
213: * its value is changed to newValue. If varName isn't currently
214: * defined, then a new global variable by that name is created.
215: *
216: *----------------------------------------------------------------------
217: */
218:
219: void
220: Tcl_SetVar(interp, varName, newValue, global)
221: Tcl_Interp *interp; /* Command interpreter in which varName is
222: * to be looked up. */
223: char *varName; /* Name of a variable in interp. */
224: char *newValue; /* New value for varName. */
225: int global; /* If non-zero, use only a global variable. */
226: {
227: register Var *varPtr, **varListPtr;
228: register Interp *iPtr = (Interp *) interp;
229: int valueLength;
230:
231: if (global || (iPtr->varFramePtr == NULL)) {
232: varListPtr = &iPtr->globalPtr;
233: } else {
234: varListPtr = &iPtr->varFramePtr->varPtr;
235: }
236: varPtr = FindVar(varListPtr, varName);
237: if (varPtr == NULL) {
238: varPtr = NewVar(varName, newValue);
239: varPtr->nextPtr = *varListPtr;
240: *varListPtr = varPtr;
241: } else {
242: if (varPtr->flags & VAR_GLOBAL) {
243: varPtr = varPtr->globalPtr;
244: }
245: valueLength = strlen(newValue);
246: if (valueLength > varPtr->valueLength) {
247: if (varPtr->flags & VAR_DYNAMIC) {
248: free(varPtr->value);
249: }
250: varPtr->value = (char *) malloc((unsigned) valueLength + 1);
251: varPtr->flags |= VAR_DYNAMIC;
252: varPtr->valueLength = valueLength;
253: }
254: strcpy(varPtr->value, newValue);
255: varPtr->flags &= ~VAR_DOESNT_EXIST;
256: }
257: }
258:
259: /*
260: *----------------------------------------------------------------------
261: *
262: * Tcl_ParseVar --
263: *
264: * Given a string starting with a $ sign, parse off a variable
265: * name and return its value.
266: *
267: * Results:
268: * The return value is the contents of the variable given by
269: * the leading characters of string. If termPtr isn't NULL,
270: * *termPtr gets filled in with the address of the character
271: * just after the last one in the variable specifier. If the
272: * variable doesn't exist, then the return value is NULL and
273: * an error message will be left in interp->result.
274: *
275: * Side effects:
276: * None.
277: *
278: *----------------------------------------------------------------------
279: */
280:
281: char *
282: Tcl_ParseVar(interp, string, termPtr)
283: Tcl_Interp *interp; /* Context for looking up variable. */
284: register char *string; /* String containing variable name.
285: * First character must be "$". */
286: char **termPtr; /* If non-NULL, points to word to fill
287: * in with character just after last
288: * one in the variable specifier. */
289:
290: {
291: char *name, c, *result;
292:
293: /*
294: * There are two cases:
295: * 1. The $ sign is followed by an open curly brace. Then the variable
296: * name is everything up to the next close curly brace.
297: * 2. The $ sign is not followed by an open curly brace. Then the
298: * variable name is everything up to the next character that isn't
299: * a letter, digit, or underscore.
300: * 3. The $ sign is followed by something that isn't a letter, digit,
301: * or underscore: in this case, there is no variable name, and "$"
302: * is returned.
303: */
304:
305: string++;
306: if (*string == '{') {
307: string++;
308: name = string;
309: while ((*string != '}') && (*string != 0)) {
310: string++;
311: }
312: if (termPtr != 0) {
313: if (*string != 0) {
314: *termPtr = string+1;
315: } else {
316: *termPtr = string;
317: }
318: }
319: } else {
320: name = string;
321: while (isalnum(*string) || (*string == '_')) {
322: string++;
323: }
324: if (termPtr != 0) {
325: *termPtr = string;
326: }
327: if (string == name) {
328: return "$";
329: }
330: }
331:
332: c = *string;
333: *string = 0;
334: result = Tcl_GetVar(interp, name, 0);
335: if (result == NULL) {
336: Tcl_Return(interp, (char *) NULL, TCL_STATIC);
337: sprintf(interp->result, "couldn't find variable \"%.50s\"", name);
338: }
339: *string = c;
340: return result;
341: }
342:
343: /*
344: *----------------------------------------------------------------------
345: *
346: * Tcl_SetCmd --
347: *
348: * This procedure is invoked to process the "set" Tcl command.
349: * See the user documentation for details on what it does.
350: *
351: * Results:
352: * A standard Tcl result value.
353: *
354: * Side effects:
355: * A variable's value may be changed.
356: *
357: *----------------------------------------------------------------------
358: */
359:
360: /* ARGSUSED */
361: int
362: Tcl_SetCmd(dummy, interp, argc, argv)
363: ClientData dummy; /* Not used. */
364: register Tcl_Interp *interp; /* Current interpreter. */
365: int argc; /* Number of arguments. */
366: char **argv; /* Argument strings. */
367: {
368: #pragma ref dummy
369: if (argc == 2) {
370: char *value;
371:
372: value = Tcl_GetVar(interp, argv[1], 0);
373: if (value == NULL) {
374: sprintf(interp->result, "couldn't find variable \"%.50s\"",
375: argv[1]);
376: return TCL_ERROR;
377: }
378: interp->result = value;
379: return TCL_OK;
380: } else if (argc == 3) {
381: Tcl_SetVar(interp, argv[1], argv[2], 0);
382: return TCL_OK;
383: } else {
384: sprintf(interp->result,
385: "wrong # args: should be \"%.50s varName [newValue]\"",
386: argv[0]);
387: return TCL_ERROR;
388: }
389: }
390:
391: /*
392: *----------------------------------------------------------------------
393: *
394: * Tcl_GlobalCmd --
395: *
396: * This procedure is invoked to process the "global" Tcl command.
397: * See the user documentation for details on what it does.
398: *
399: * Results:
400: * A standard Tcl result value.
401: *
402: * Side effects:
403: * See the user documentation.
404: *
405: *----------------------------------------------------------------------
406: */
407:
408: /* ARGSUSED */
409: int
410: Tcl_GlobalCmd(dummy, interp, argc, argv)
411: ClientData dummy; /* Not used. */
412: Tcl_Interp *interp; /* Current interpreter. */
413: int argc; /* Number of arguments. */
414: char **argv; /* Argument strings. */
415: {
416: #pragma ref dummy
417: register Var *varPtr;
418: register Interp *iPtr = (Interp *) interp;
419: Var *gVarPtr;
420:
421: if (argc < 2) {
422: sprintf(iPtr->result,
423: "too few args: should be \"%.50s varName varName ...\"",
424: argv[0]);
425: return TCL_ERROR;
426: }
427: if (iPtr->varFramePtr == NULL) {
428: return TCL_OK;
429: }
430:
431: for (argc--, argv++; argc > 0; argc--, argv++) {
432: gVarPtr = FindVar(&iPtr->globalPtr, *argv);
433: if (gVarPtr == NULL) {
434: gVarPtr = NewVar(*argv, "");
435: gVarPtr->nextPtr = iPtr->globalPtr;
436: iPtr->globalPtr = gVarPtr;
437: gVarPtr->flags |= VAR_DOESNT_EXIST;
438: }
439: varPtr = NewVar(*argv, "");
440: varPtr->flags |= VAR_GLOBAL;
441: varPtr->globalPtr = gVarPtr;
442: varPtr->nextPtr = iPtr->varFramePtr->varPtr;
443: iPtr->varFramePtr->varPtr = varPtr;
444: }
445: return TCL_OK;
446: }
447:
448: /*
449: *----------------------------------------------------------------------
450: *
451: * Tcl_UplevelCmd --
452: *
453: * This procedure is invoked to process the "uplevel" Tcl command.
454: * See the user documentation for details on what it does.
455: *
456: * Results:
457: * A standard Tcl result value.
458: *
459: * Side effects:
460: * See the user documentation.
461: *
462: *----------------------------------------------------------------------
463: */
464:
465: /* ARGSUSED */
466: int
467: Tcl_UplevelCmd(dummy, interp, argc, argv)
468: ClientData dummy; /* Not used. */
469: Tcl_Interp *interp; /* Current interpreter. */
470: int argc; /* Number of arguments. */
471: char **argv; /* Argument strings. */
472: {
473: #pragma ref dummy
474: register Interp *iPtr = (Interp *) interp;
475: int level, result;
476: char *end, *levelArg;
477: CallFrame *savedVarFramePtr, *framePtr;
478:
479: if (argc < 2) {
480: uplevelSyntax:
481: sprintf(iPtr->result,
482: "too few args: should be \"%.50s [level] command ...\"",
483: argv[0]);
484: return TCL_ERROR;
485: }
486:
487: /*
488: * Parse arguments to figure out which level to go to, and set
489: * argv and argc to refer to the command to execute at that level.
490: */
491:
492: levelArg = argv[1];
493: if (*levelArg == '#') {
494: level = strtoul(levelArg+1, &end, 10);
495: if ((end == (levelArg+1)) || (*end != '\0')) {
496: goto levelError;
497: }
498: argc -= 2;
499: argv += 2;
500: } else if (isdigit(*levelArg)) {
501: level = strtoul(levelArg, &end, 10);
502: if ((end == levelArg) || (*end != '\0')) {
503: goto levelError;
504: }
505: if (iPtr->varFramePtr == NULL) {
506: goto levelError;
507: }
508: level = iPtr->varFramePtr->level - level;
509: argc -= 2;
510: argv += 2;
511: } else {
512: if (iPtr->varFramePtr == NULL) {
513: goto levelError;
514: }
515: level = iPtr->varFramePtr->level - 1;
516: argc--;
517: argv++;
518: }
519:
520: /*
521: * Figure out which frame to use, and modify the interpreter so
522: * its variables come from that frame.
523: */
524:
525: savedVarFramePtr = iPtr->varFramePtr;
526: if (level == 0) {
527: iPtr->varFramePtr = NULL;
528: } else {
529: for (framePtr = savedVarFramePtr; framePtr != NULL;
530: framePtr = framePtr->callerVarPtr) {
531: if (framePtr->level == level) {
532: break;
533: }
534: }
535: if (framePtr == NULL) {
536: goto levelError;
537: }
538: iPtr->varFramePtr = framePtr;
539: }
540:
541: /*
542: * Execute the residual arguments as a command.
543: */
544:
545: if (argc == 0) {
546: goto uplevelSyntax;
547: }
548: if (argc == 1) {
549: result = Tcl_Eval(interp, argv[0], 0, (char **) NULL);
550: } else {
551: char *cmd;
552:
553: cmd = Tcl_Concat(argc, argv);
554: result = Tcl_Eval(interp, cmd, 0, (char **) NULL);
555: }
556: if (result == TCL_ERROR) {
557: char msg[60];
558: sprintf(msg, " (\"uplevel\" body line %d)", interp->errorLine);
559: Tcl_AddErrorInfo(interp, msg);
560: }
561:
562: /*
563: * Restore the variable frame, and return.
564: */
565:
566: iPtr->varFramePtr = savedVarFramePtr;
567: return result;
568:
569: levelError:
570: sprintf(iPtr->result, "bad level \"%.50s\"", levelArg);
571: return TCL_ERROR;
572: }
573:
574: /*
575: *----------------------------------------------------------------------
576: *
577: * TclFindProc --
578: *
579: * Given the name of a procedure, return a pointer to the
580: * record describing the procedure.
581: *
582: * Results:
583: * NULL is returned if the name doesn't correspond to any
584: * procedure. Otherwise the return value is a pointer to
585: * the procedure's record.
586: *
587: * Side effects:
588: * None.
589: *
590: *----------------------------------------------------------------------
591: */
592:
593: Proc *
594: TclFindProc(iPtr, procName)
595: Interp *iPtr; /* Interpreter in which to look. */
596: char *procName; /* Name of desired procedure. */
597: {
598: Command *cmdPtr;
599:
600: cmdPtr = TclFindCmd(iPtr, procName, 0);
601: if (cmdPtr == NULL) {
602: return NULL;
603: }
604: if (cmdPtr->proc != InterpProc) {
605: return NULL;
606: }
607: return (Proc *) cmdPtr->clientData;
608: }
609:
610: /*
611: *----------------------------------------------------------------------
612: *
613: * TclIsProc --
614: *
615: * Tells whether a command is a Tcl procedure or not.
616: *
617: * Results:
618: * If the given command is actuall a Tcl procedure, the
619: * return value is the address of the record describing
620: * the procedure. Otherwise the return value is 0.
621: *
622: * Side effects:
623: * None.
624: *
625: *----------------------------------------------------------------------
626: */
627:
628: Proc *
629: TclIsProc(cmdPtr)
630: Command *cmdPtr; /* Command to test. */
631: {
632: if (cmdPtr->proc == InterpProc) {
633: return (Proc *) cmdPtr->clientData;
634: }
635: return (Proc *) 0;
636: }
637:
638: /*
639: *----------------------------------------------------------------------
640: *
641: * TclDeleteVars --
642: *
643: * This procedure is called as part of deleting an interpreter:
644: * it recycles all the storage space associated with global
645: * variables (the local ones should already have been deleted).
646: *
647: * Results:
648: * None.
649: *
650: * Side effects:
651: * Variables are deleted.
652: *
653: *----------------------------------------------------------------------
654: */
655:
656: void
657: TclDeleteVars(iPtr)
658: Interp *iPtr; /* Interpreter to nuke. */
659: {
660: register Var *varPtr;
661:
662: for (varPtr = iPtr->globalPtr; varPtr != NULL; varPtr = varPtr->nextPtr) {
663: if (varPtr->flags & VAR_DYNAMIC) {
664: free(varPtr->value);
665: }
666: free((char *) varPtr);
667: }
668: }
669:
670: /*
671: *----------------------------------------------------------------------
672: *
673: * InterpProc --
674: *
675: * When a Tcl procedure gets invoked, this routine gets invoked
676: * to interpret the procedure.
677: *
678: * Results:
679: * A standard Tcl result value, usually TCL_OK.
680: *
681: * Side effects:
682: * Depends on the commands in the procedure.
683: *
684: *----------------------------------------------------------------------
685: */
686:
687: int
688: InterpProc(procPtr, interp, argc, argv)
689: register Proc *procPtr; /* Record describing procedure to be
690: * interpreted. */
691: Tcl_Interp *interp; /* Interpreter in which procedure was
692: * invoked. */
693: int argc; /* Count of number of arguments to this
694: * procedure. */
695: char **argv; /* Argument values. */
696: {
697: char **args;
698: register Var *formalPtr, *argPtr;
699: register Interp *iPtr = (Interp *) interp;
700: CallFrame frame;
701: char *value, *end;
702: int result;
703:
704: /*
705: * Set up a call frame for the new procedure invocation.
706: */
707:
708: iPtr = procPtr->iPtr;
709: frame.varPtr = NULL;
710: if (iPtr->varFramePtr != NULL) {
711: frame.level = iPtr->varFramePtr->level + 1;
712: } else {
713: frame.level = 1;
714: }
715: frame.argc = argc;
716: frame.argv = argv;
717: frame.callerPtr = iPtr->framePtr;
718: frame.callerVarPtr = iPtr->varFramePtr;
719: iPtr->framePtr = &frame;
720: iPtr->varFramePtr = &frame;
721:
722: /*
723: * Match the actual arguments against the procedure's formal
724: * parameters to compute local variables.
725: */
726:
727: for (formalPtr = procPtr->argPtr, args = argv+1, argc -= 1;
728: formalPtr != NULL;
729: formalPtr = formalPtr->nextPtr, args++, argc--) {
730:
731: /*
732: * Handle the special case of the last formal being "args". When
733: * it occurs, assign it a list consisting of all the remaining
734: * actual arguments.
735: */
736:
737: if ((formalPtr->nextPtr == NULL)
738: && (strcmp(formalPtr->name, "args") == 0)) {
739: if (argc < 0) {
740: argc = 0;
741: }
742: value = Tcl_Merge(argc, args);
743: argPtr = NewVar(formalPtr->name, value);
744: free(value);
745: argPtr->nextPtr = frame.varPtr;
746: frame.varPtr = argPtr;
747: argc = 0;
748: break;
749: } else if (argc > 0) {
750: value = *args;
751: } else if (formalPtr->value != NULL) {
752: value = formalPtr->value;
753: } else {
754: sprintf(iPtr->result,
755: "no value given for parameter \"%s\" to \"%s\"",
756: formalPtr->name, argv[0]);
757: result = TCL_ERROR;
758: goto procDone;
759: }
760: argPtr = NewVar(formalPtr->name, value);
761: argPtr->nextPtr = frame.varPtr;
762: frame.varPtr = argPtr;
763: }
764: if (argc > 0) {
765: sprintf(iPtr->result, "called \"%s\" with too many arguments",
766: argv[0]);
767: result = TCL_ERROR;
768: goto procDone;
769: }
770:
771: /*
772: * Invoke the commands in the procedure's body.
773: */
774:
775: result = Tcl_Eval(interp, procPtr->command, 0, &end);
776: if (result == TCL_RETURN) {
777: result = TCL_OK;
778: } else if (result == TCL_ERROR) {
779: char msg[100];
780:
781: /*
782: * Record information telling where the error occurred.
783: */
784:
785: sprintf(msg, " (procedure \"%.50s\" line %d)", argv[0],
786: iPtr->errorLine);
787: Tcl_AddErrorInfo(interp, msg);
788: } else if (result == TCL_BREAK) {
789: iPtr->result = "invoked \"break\" outside of a loop";
790: result = TCL_ERROR;
791: } else if (result == TCL_CONTINUE) {
792: iPtr->result = "invoked \"continue\" outside of a loop";
793: result = TCL_ERROR;
794: }
795:
796: /*
797: * Delete the call frame for this procedure invocation.
798: */
799:
800: procDone:
801: for (argPtr = frame.varPtr; argPtr != NULL; argPtr = argPtr->nextPtr) {
802: if (argPtr->flags & VAR_DYNAMIC) {
803: free(argPtr->value);
804: }
805: free((char *) argPtr);
806: }
807: iPtr->framePtr = frame.callerPtr;
808: iPtr->varFramePtr = frame.callerVarPtr;
809: return result;
810: }
811:
812: /*
813: *----------------------------------------------------------------------
814: *
815: * ProcDeleteProc --
816: *
817: * This procedure is invoked just before a command procedure is
818: * removed from an interpreter. Its job is to release all the
819: * resources allocated to the procedure.
820: *
821: * Results:
822: * None.
823: *
824: * Side effects:
825: * Memory gets freed.
826: *
827: *----------------------------------------------------------------------
828: */
829:
830: void
831: ProcDeleteProc(procPtr)
832: register Proc *procPtr; /* Procedure to be deleted. */
833: {
834: register Var *argPtr;
835:
836: free((char *) procPtr->command);
837: for (argPtr = procPtr->argPtr; argPtr != NULL; argPtr = argPtr->nextPtr) {
838: if (argPtr->flags & VAR_DYNAMIC) {
839: free(argPtr->value);
840: }
841: free((char *) argPtr);
842: }
843: free((char *) procPtr);
844: }
845:
846: /*
847: *----------------------------------------------------------------------
848: *
849: * FindVar --
850: *
851: * Locate the Var structure corresponding to varName, if there
852: * is one defined in a given list.
853: *
854: * Results:
855: * The return value points to the Var structure corresponding to
856: * the current value of varName in varListPtr, or NULL if varName
857: * isn't currently defined in the list.
858: *
859: * Side effects:
860: * If the variable is found, it is moved to the front of the list.
861: *
862: *----------------------------------------------------------------------
863: */
864:
865: Var *
866: FindVar(varListPtr, varName)
867: Var **varListPtr; /* Pointer to head of list. The value pointed
868: * to will be modified to bring the found
869: * variable to the front of the list. */
870: char *varName; /* Desired variable. */
871: {
872: register Var *prev, *cur;
873: register char c;
874:
875: c = *varName;
876:
877: /*
878: * Local variables take precedence over global ones. Check the
879: * first character immediately, before wasting time calling strcmp.
880: */
881:
882: for (prev = NULL, cur = *varListPtr; cur != NULL;
883: prev = cur, cur = cur->nextPtr) {
884: if ((cur->name[0] == c) && (strcmp(cur->name, varName) == 0)) {
885: if (prev != NULL) {
886: prev->nextPtr = cur->nextPtr;
887: cur->nextPtr = *varListPtr;
888: *varListPtr = cur;
889: }
890: return cur;
891: }
892: }
893: return NULL;
894: }
895:
896: /*
897: *----------------------------------------------------------------------
898: *
899: * NewVar --
900: *
901: * Create a new variable with the given name and initial value.
902: *
903: * Results:
904: * The return value is a pointer to the new variable. The variable
905: * will not have been linked into any particular list, and its
906: * nextPtr field will be NULL.
907: *
908: * Side effects:
909: * Storage gets allocated.
910: *
911: *----------------------------------------------------------------------
912: */
913:
914: Var *
915: NewVar(name, value)
916: char *name; /* Name for variable. */
917: char *value; /* Value for variable. */
918: {
919: register Var *varPtr;
920: int nameLength, valueLength;
921:
922: nameLength = strlen(name);
923: valueLength = strlen(value);
924: if (valueLength < 20) {
925: valueLength = 20;
926: }
927: varPtr = (Var *) malloc(VAR_SIZE(nameLength, valueLength));
928: strcpy(varPtr->name, name);
929: varPtr->value = varPtr->name + nameLength + 1;
930: strcpy(varPtr->value, value);
931: varPtr->valueLength = valueLength;
932: varPtr->flags = 0;
933: varPtr->globalPtr = NULL;
934: varPtr->nextPtr = NULL;
935: return varPtr;
936: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.