]> cvs.zerfleddert.de Git - micropolis/blob - src/tcl/tclparse.c
projects / micropolis / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
Fixes for compilation with gcc 15
[micropolis] / src / tcl / tclparse.c
1 /*
2 * tclParse.c --
3 *
4 * This file contains a collection of procedures that are used
5 * to parse Tcl commands or parts of commands (like quoted
6 * strings or nested sub-commands).
7 *
8 * Copyright 1991 Regents of the University of California.
9 * Permission to use, copy, modify, and distribute this
10 * software and its documentation for any purpose and without
11 * fee is hereby granted, provided that the above copyright
12 * notice appear in all copies. The University of California
13 * makes no representations about the suitability of this
14 * software for any purpose. It is provided "as is" without
15 * express or implied warranty.
16 */
17
18 #ifndef lint
19 static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclParse.c,v 1.21 92/06/08 09:32:37 ouster Exp $ SPRITE (Berkeley)";
20 #endif
21
22 #include "tclint.h"
23
24 /*
25 * The following table assigns a type to each character. Only types
26 * meaningful to Tcl parsing are represented here. The table indexes
27 * all 256 characters, with the negative ones first, then the positive
28 * ones.
29 */
30
31 char tclTypeTable[] = {
32 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
33 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
34 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
35 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
36 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
37 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
38 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
39 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
40 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
41 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
42 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
43 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
44 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
45 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
46 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
47 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
48 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
49 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
50 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
51 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
52 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
53 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
54 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
55 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
56 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
57 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
58 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
59 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
60 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
61 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
62 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
63 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
64 TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
65 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
66 TCL_NORMAL, TCL_SPACE, TCL_COMMAND_END, TCL_SPACE,
67 TCL_SPACE, TCL_SPACE, TCL_NORMAL, TCL_NORMAL,
68 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
69 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
70 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
71 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
72 TCL_SPACE, TCL_NORMAL, TCL_QUOTE, TCL_NORMAL,
73 TCL_DOLLAR, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
74 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
75 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
76 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
77 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
78 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_COMMAND_END,
79 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
80 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
81 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
82 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
83 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
84 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
85 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
86 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACKET,
87 TCL_BACKSLASH, TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL,
88 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
89 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
90 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
91 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
92 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
93 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
94 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACE,
95 TCL_NORMAL, TCL_CLOSE_BRACE, TCL_NORMAL, TCL_NORMAL,
96 };
97
98 /*
99 * Function prototypes for procedures local to this file:
100 */
101
102 static char * QuoteEnd _ANSI_ARGS_((char *string, int term));
103 static char * VarNameEnd _ANSI_ARGS_((char *string));
104 \f
105 /*
106 *----------------------------------------------------------------------
107 *
108 * Tcl_Backslash --
109 *
110 * Figure out how to handle a backslash sequence.
111 *
112 * Results:
113 * The return value is the character that should be substituted
114 * in place of the backslash sequence that starts at src, or 0
115 * if the backslash sequence should be replace by nothing (e.g.
116 * backslash followed by newline). If readPtr isn't NULL then
117 * it is filled in with a count of the number of characters in
118 * the backslash sequence. Note: if the backslash isn't followed
119 * by characters that are understood here, then the backslash
120 * sequence is only considered to be one character long, and it
121 * is replaced by a backslash char.
122 *
123 * Side effects:
124 * None.
125 *
126 *----------------------------------------------------------------------
127 */
128
129 char
130 Tcl_Backslash (
131 char *src, /* Points to the backslash character of
132 * a backslash sequence. */
133 int *readPtr /* Fill in with number of characters read
134 * from src, unless NULL. */
135 )
136 {
137 register char *p = src+1;
138 char result;
139 int count;
140
141 count = 2;
142
143 switch (*p) {
144 case 'b':
145 result = '\b';
146 break;
147 case 'e':
148 result = 033;
149 break;
150 case 'f':
151 result = '\f';
152 break;
153 case 'n':
154 result = '\n';
155 break;
156 case 'r':
157 result = '\r';
158 break;
159 case 't':
160 result = '\t';
161 break;
162 case 'v':
163 result = '\v';
164 break;
165 case 'C':
166 p++;
167 if (isspace(*p) || (*p == 0)) {
168 result = 'C';
169 count = 1;
170 break;
171 }
172 count = 3;
173 if (*p == 'M') {
174 p++;
175 if (isspace(*p) || (*p == 0)) {
176 result = 'M' & 037;
177 break;
178 }
179 count = 4;
180 result = (*p & 037) | 0200;
181 break;
182 }
183 count = 3;
184 result = *p & 037;
185 break;
186 case 'M':
187 p++;
188 if (isspace(*p) || (*p == 0)) {
189 result = 'M';
190 count = 1;
191 break;
192 }
193 count = 3;
194 result = *p + 0200;
195 break;
196 case '}':
197 case '{':
198 case ']':
199 case '[':
200 case '$':
201 case ' ':
202 case ';':
203 case '"':
204 case '\\':
205 result = *p;
206 break;
207 case '\n':
208 result = 0;
209 break;
210 default:
211 if (isdigit(*p)) {
212 result = *p - '0';
213 p++;
214 if (!isdigit(*p)) {
215 break;
216 }
217 count = 3;
218 result = (result << 3) + (*p - '0');
219 p++;
220 if (!isdigit(*p)) {
221 break;
222 }
223 count = 4;
224 result = (result << 3) + (*p - '0');
225 break;
226 }
227 result = '\\';
228 count = 1;
229 break;
230 }
231
232 if (readPtr != NULL) {
233 *readPtr = count;
234 }
235 return result;
236 }
237 \f
238 /*
239 *--------------------------------------------------------------
240 *
241 * TclParseQuotes --
242 *
243 * This procedure parses a double-quoted string such as a
244 * quoted Tcl command argument or a quoted value in a Tcl
245 * expression. This procedure is also used to parse array
246 * element names within parentheses, or anything else that
247 * needs all the substitutions that happen in quotes.
248 *
249 * Results:
250 * The return value is a standard Tcl result, which is
251 * TCL_OK unless there was an error while parsing the
252 * quoted string. If an error occurs then interp->result
253 * contains a standard error message. *TermPtr is filled
254 * in with the address of the character just after the
255 * last one successfully processed; this is usually the
256 * character just after the matching close-quote. The
257 * fully-substituted contents of the quotes are stored in
258 * standard fashion in *pvPtr, null-terminated with
259 * pvPtr->next pointing to the terminating null character.
260 *
261 * Side effects:
262 * The buffer space in pvPtr may be enlarged by calling its
263 * expandProc.
264 *
265 *--------------------------------------------------------------
266 */
267
268 int
269 TclParseQuotes (
270 Tcl_Interp *interp, /* Interpreter to use for nested command
271 * evaluations and error messages. */
272 char *string, /* Character just after opening double-
273 * quote. */
274 int termChar, /* Character that terminates "quoted" string
275 * (usually double-quote, but sometimes
276 * right-paren or something else). */
277 int flags, /* Flags to pass to nested Tcl_Eval calls. */
278 char **termPtr, /* Store address of terminating character
279 * here. */
280 ParseValue *pvPtr /* Information about where to place
281 * fully-substituted result of parse. */
282 )
283 {
284 register char *src, *dst, c;
285
286 src = string;
287 dst = pvPtr->next;
288
289 while (1) {
290 if (dst == pvPtr->end) {
291 /*
292 * Target buffer space is about to run out. Make more space.
293 */
294
295 pvPtr->next = dst;
296 (*pvPtr->expandProc)(pvPtr, 1);
297 dst = pvPtr->next;
298 }
299
300 c = *src;
301 src++;
302 if (c == termChar) {
303 *dst = '\0';
304 pvPtr->next = dst;
305 *termPtr = src;
306 return TCL_OK;
307 } else if (CHAR_TYPE(c) == TCL_NORMAL) {
308 copy:
309 *dst = c;
310 dst++;
311 continue;
312 } else if (c == '$') {
313 int length;
314 char *value;
315
316 value = Tcl_ParseVar(interp, src-1, termPtr);
317 if (value == NULL) {
318 return TCL_ERROR;
319 }
320 src = *termPtr;
321 length = strlen(value);
322 if ((pvPtr->end - dst) <= length) {
323 pvPtr->next = dst;
324 (*pvPtr->expandProc)(pvPtr, length);
325 dst = pvPtr->next;
326 }
327 strcpy(dst, value);
328 dst += length;
329 continue;
330 } else if (c == '[') {
331 int result;
332
333 pvPtr->next = dst;
334 result = TclParseNestedCmd(interp, src, flags, termPtr, pvPtr);
335 if (result != TCL_OK) {
336 return result;
337 }
338 src = *termPtr;
339 dst = pvPtr->next;
340 continue;
341 } else if (c == '\\') {
342 int numRead;
343
344 src--;
345 *dst = Tcl_Backslash(src, &numRead);
346 if (*dst != 0) {
347 dst++;
348 }
349 src += numRead;
350 continue;
351 } else if (c == '\0') {
352 Tcl_ResetResult(interp);
353 sprintf(interp->result, "missing %c", termChar);
354 *termPtr = string-1;
355 return TCL_ERROR;
356 } else {
357 goto copy;
358 }
359 }
360 }
361 \f
362 /*
363 *--------------------------------------------------------------
364 *
365 * TclParseNestedCmd --
366 *
367 * This procedure parses a nested Tcl command between
368 * brackets, returning the result of the command.
369 *
370 * Results:
371 * The return value is a standard Tcl result, which is
372 * TCL_OK unless there was an error while executing the
373 * nested command. If an error occurs then interp->result
374 * contains a standard error message. *TermPtr is filled
375 * in with the address of the character just after the
376 * last one processed; this is usually the character just
377 * after the matching close-bracket, or the null character
378 * at the end of the string if the close-bracket was missing
379 * (a missing close bracket is an error). The result returned
380 * by the command is stored in standard fashion in *pvPtr,
381 * null-terminated, with pvPtr->next pointing to the null
382 * character.
383 *
384 * Side effects:
385 * The storage space at *pvPtr may be expanded.
386 *
387 *--------------------------------------------------------------
388 */
389
390 int
391 TclParseNestedCmd (
392 Tcl_Interp *interp, /* Interpreter to use for nested command
393 * evaluations and error messages. */
394 char *string, /* Character just after opening bracket. */
395 int flags, /* Flags to pass to nested Tcl_Eval. */
396 char **termPtr, /* Store address of terminating character
397 * here. */
398 register ParseValue *pvPtr /* Information about where to place
399 * result of command. */
400 )
401 {
402 int result, length, shortfall;
403 Interp *iPtr = (Interp *) interp;
404
405 result = Tcl_Eval(interp, string, flags | TCL_BRACKET_TERM, termPtr);
406 if (result != TCL_OK) {
407 /*
408 * The increment below results in slightly cleaner message in
409 * the errorInfo variable (the close-bracket will appear).
410 */
411
412 if (**termPtr == ']') {
413 *termPtr += 1;
414 }
415 return result;
416 }
417 (*termPtr) += 1;
418 length = strlen(iPtr->result);
419 shortfall = length + 1 - (pvPtr->end - pvPtr->next);
420 if (shortfall > 0) {
421 (*pvPtr->expandProc)(pvPtr, shortfall);
422 }
423 strcpy(pvPtr->next, iPtr->result);
424 pvPtr->next += length;
425 Tcl_FreeResult(iPtr);
426 iPtr->result = iPtr->resultSpace;
427 iPtr->resultSpace[0] = '\0';
428 return TCL_OK;
429 }
430 \f
431 /*
432 *--------------------------------------------------------------
433 *
434 * TclParseBraces --
435 *
436 * This procedure scans the information between matching
437 * curly braces.
438 *
439 * Results:
440 * The return value is a standard Tcl result, which is
441 * TCL_OK unless there was an error while parsing string.
442 * If an error occurs then interp->result contains a
443 * standard error message. *TermPtr is filled
444 * in with the address of the character just after the
445 * last one successfully processed; this is usually the
446 * character just after the matching close-brace. The
447 * information between curly braces is stored in standard
448 * fashion in *pvPtr, null-terminated with pvPtr->next
449 * pointing to the terminating null character.
450 *
451 * Side effects:
452 * The storage space at *pvPtr may be expanded.
453 *
454 *--------------------------------------------------------------
455 */
456
457 int
458 TclParseBraces (
459 Tcl_Interp *interp, /* Interpreter to use for nested command
460 * evaluations and error messages. */
461 char *string, /* Character just after opening bracket. */
462 char **termPtr, /* Store address of terminating character
463 * here. */
464 register ParseValue *pvPtr /* Information about where to place
465 * result of command. */
466 )
467 {
468 int level;
469 register char *src, *dst, *end;
470 register char c;
471
472 src = string;
473 dst = pvPtr->next;
474 end = pvPtr->end;
475 level = 1;
476
477 /*
478 * Copy the characters one at a time to the result area, stopping
479 * when the matching close-brace is found.
480 */
481
482 while (1) {
483 c = *src;
484 src++;
485 if (dst == end) {
486 pvPtr->next = dst;
487 (*pvPtr->expandProc)(pvPtr, 20);
488 dst = pvPtr->next;
489 end = pvPtr->end;
490 }
491 *dst = c;
492 dst++;
493 if (CHAR_TYPE(c) == TCL_NORMAL) {
494 continue;
495 } else if (c == '{') {
496 level++;
497 } else if (c == '}') {
498 level--;
499 if (level == 0) {
500 dst--; /* Don't copy the last close brace. */
501 break;
502 }
503 } else if (c == '\\') {
504 int count;
505
506 /*
507 * Must always squish out backslash-newlines, even when in
508 * braces. This is needed so that this sequence can appear
509 * anywhere in a command, such as the middle of an expression.
510 */
511
512 if (*src == '\n') {
513 dst--;
514 src++;
515 } else {
516 (void) Tcl_Backslash(src-1, &count);
517 while (count > 1) {
518 if (dst == end) {
519 pvPtr->next = dst;
520 (*pvPtr->expandProc)(pvPtr, 20);
521 dst = pvPtr->next;
522 end = pvPtr->end;
523 }
524 *dst = *src;
525 dst++;
526 src++;
527 count--;
528 }
529 }
530 } else if (c == '\0') {
531 Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
532 *termPtr = string-1;
533 return TCL_ERROR;
534 }
535 }
536
537 *dst = '\0';
538 pvPtr->next = dst;
539 *termPtr = src;
540 return TCL_OK;
541 }
542 \f
543 /*
544 *--------------------------------------------------------------
545 *
546 * TclParseWords --
547 *
548 * This procedure parses one or more words from a command
549 * string and creates argv-style pointers to fully-substituted
550 * copies of those words.
551 *
552 * Results:
553 * The return value is a standard Tcl result.
554 *
555 * *argcPtr is modified to hold a count of the number of words
556 * successfully parsed, which may be 0. At most maxWords words
557 * will be parsed. If 0 <= *argcPtr < maxWords then it
558 * means that a command separator was seen. If *argcPtr
559 * is maxWords then it means that a command separator was
560 * not seen yet.
561 *
562 * *TermPtr is filled in with the address of the character
563 * just after the last one successfully processed in the
564 * last word. This is either the command terminator (if
565 * *argcPtr < maxWords), the character just after the last
566 * one in a word (if *argcPtr is maxWords), or the vicinity
567 * of an error (if the result is not TCL_OK).
568 *
569 * The pointers at *argv are filled in with pointers to the
570 * fully-substituted words, and the actual contents of the
571 * words are copied to the buffer at pvPtr.
572 *
573 * If an error occurrs then an error message is left in
574 * interp->result and the information at *argv, *argcPtr,
575 * and *pvPtr may be incomplete.
576 *
577 * Side effects:
578 * The buffer space in pvPtr may be enlarged by calling its
579 * expandProc.
580 *
581 *--------------------------------------------------------------
582 */
583
584 int
585 TclParseWords (
586 Tcl_Interp *interp, /* Interpreter to use for nested command
587 * evaluations and error messages. */
588 char *string, /* First character of word. */
589 int flags, /* Flags to control parsing (same values as
590 * passed to Tcl_Eval). */
591 int maxWords, /* Maximum number of words to parse. */
592 char **termPtr, /* Store address of terminating character
593 * here. */
594 int *argcPtr, /* Filled in with actual number of words
595 * parsed. */
596 char **argv, /* Store addresses of individual words here. */
597 register ParseValue *pvPtr /* Information about where to place
598 * fully-substituted word. */
599 )
600 {
601 register char *src, *dst;
602 register char c;
603 int type, result, argc;
604 char *oldBuffer; /* Used to detect when pvPtr's buffer gets
605 * reallocated, so we can adjust all of the
606 * argv pointers. */
607
608 src = string;
609 oldBuffer = pvPtr->buffer;
610 dst = pvPtr->next;
611 for (argc = 0; argc < maxWords; argc++) {
612 argv[argc] = dst;
613
614 /*
615 * Skip leading space.
616 */
617
618 skipSpace:
619 c = *src;
620 type = CHAR_TYPE(c);
621 while (type == TCL_SPACE) {
622 src++;
623 c = *src;
624 type = CHAR_TYPE(c);
625 }
626
627 /*
628 * Handle the normal case (i.e. no leading double-quote or brace).
629 */
630
631 if (type == TCL_NORMAL) {
632 normalArg:
633 while (1) {
634 if (dst == pvPtr->end) {
635 /*
636 * Target buffer space is about to run out. Make
637 * more space.
638 */
639
640 pvPtr->next = dst;
641 (*pvPtr->expandProc)(pvPtr, 1);
642 dst = pvPtr->next;
643 }
644
645 if (type == TCL_NORMAL) {
646 copy:
647 *dst = c;
648 dst++;
649 src++;
650 } else if (type == TCL_SPACE) {
651 goto wordEnd;
652 } else if (type == TCL_DOLLAR) {
653 int length;
654 char *value;
655
656 value = Tcl_ParseVar(interp, src, termPtr);
657 if (value == NULL) {
658 return TCL_ERROR;
659 }
660 src = *termPtr;
661 length = strlen(value);
662 if ((pvPtr->end - dst) <= length) {
663 pvPtr->next = dst;
664 (*pvPtr->expandProc)(pvPtr, length);
665 dst = pvPtr->next;
666 }
667 strcpy(dst, value);
668 dst += length;
669 } else if (type == TCL_COMMAND_END) {
670 if ((c == ']') && !(flags & TCL_BRACKET_TERM)) {
671 goto copy;
672 }
673
674 /*
675 * End of command; simulate a word-end first, so
676 * that the end-of-command can be processed as the
677 * first thing in a new word.
678 */
679
680 goto wordEnd;
681 } else if (type == TCL_OPEN_BRACKET) {
682 pvPtr->next = dst;
683 result = TclParseNestedCmd(interp, src+1, flags, termPtr,
684 pvPtr);
685 if (result != TCL_OK) {
686 return result;
687 }
688 src = *termPtr;
689 dst = pvPtr->next;
690 } else if (type == TCL_BACKSLASH) {
691 int numRead;
692
693 *dst = Tcl_Backslash(src, &numRead);
694 if (*dst != 0) {
695 dst++;
696 }
697 src += numRead;
698 } else {
699 goto copy;
700 }
701 c = *src;
702 type = CHAR_TYPE(c);
703 }
704 } else {
705
706 /*
707 * Check for the end of the command.
708 */
709
710 if (type == TCL_COMMAND_END) {
711 if (flags & TCL_BRACKET_TERM) {
712 if (c == '\0') {
713 Tcl_SetResult(interp, "missing close-bracket",
714 TCL_STATIC);
715 return TCL_ERROR;
716 }
717 } else {
718 if (c == ']') {
719 goto normalArg;
720 }
721 }
722 goto done;
723 }
724
725 /*
726 * Now handle the special cases: open braces, double-quotes,
727 * and backslash-newline.
728 */
729
730 pvPtr->next = dst;
731 if (type == TCL_QUOTE) {
732 result = TclParseQuotes(interp, src+1, '"', flags,
733 termPtr, pvPtr);
734 } else if (type == TCL_OPEN_BRACE) {
735 result = TclParseBraces(interp, src+1, termPtr, pvPtr);
736 } else if ((type == TCL_BACKSLASH) && (src[1] == '\n')) {
737 src += 2;
738 goto skipSpace;
739 } else {
740 goto normalArg;
741 }
742 if (result != TCL_OK) {
743 return result;
744 }
745
746 /*
747 * Back from quotes or braces; make sure that the terminating
748 * character was the end of the word. Have to be careful here
749 * to handle continuation lines (i.e. lines ending in backslash).
750 */
751
752 c = **termPtr;
753 if ((c == '\\') && ((*termPtr)[1] == '\n')) {
754 c = (*termPtr)[2];
755 }
756 type = CHAR_TYPE(c);
757 if ((type != TCL_SPACE) && (type != TCL_COMMAND_END)) {
758 if (*src == '"') {
759 Tcl_SetResult(interp, "extra characters after close-quote",
760 TCL_STATIC);
761 } else {
762 Tcl_SetResult(interp, "extra characters after close-brace",
763 TCL_STATIC);
764 }
765 return TCL_ERROR;
766 }
767 src = *termPtr;
768 dst = pvPtr->next;
769
770 }
771
772 /*
773 * We're at the end of a word, so add a null terminator. Then
774 * see if the buffer was re-allocated during this word. If so,
775 * update all of the argv pointers.
776 */
777
778 wordEnd:
779 *dst = '\0';
780 dst++;
781 if (oldBuffer != pvPtr->buffer) {
782 int i;
783
784 for (i = 0; i <= argc; i++) {
785 argv[i] = pvPtr->buffer + (argv[i] - oldBuffer);
786 }
787 oldBuffer = pvPtr->buffer;
788 }
789 }
790
791 done:
792 pvPtr->next = dst;
793 *termPtr = src;
794 *argcPtr = argc;
795 return TCL_OK;
796 }
797 \f
798 /*
799 *--------------------------------------------------------------
800 *
801 * TclExpandParseValue --
802 *
803 * This procedure is commonly used as the value of the
804 * expandProc in a ParseValue. It uses malloc to allocate
805 * more space for the result of a parse.
806 *
807 * Results:
808 * The buffer space in *pvPtr is reallocated to something
809 * larger, and if pvPtr->clientData is non-zero the old
810 * buffer is freed. Information is copied from the old
811 * buffer to the new one.
812 *
813 * Side effects:
814 * None.
815 *
816 *--------------------------------------------------------------
817 */
818
819 void
820 TclExpandParseValue (
821 register ParseValue *pvPtr, /* Information about buffer that
822 * must be expanded. If the clientData
823 * in the structure is non-zero, it
824 * means that the current buffer is
825 * dynamically allocated. */
826 int needed /* Minimum amount of additional space
827 * to allocate. */
828 )
829 {
830 int newSpace;
831 char *new;
832
833 /*
834 * Either double the size of the buffer or add enough new space
835 * to meet the demand, whichever produces a larger new buffer.
836 */
837
838 newSpace = (pvPtr->end - pvPtr->buffer) + 1;
839 if (newSpace < needed) {
840 newSpace += needed;
841 } else {
842 newSpace += newSpace;
843 }
844 new = (char *) ckalloc((unsigned) newSpace);
845
846 /*
847 * Copy from old buffer to new, free old buffer if needed, and
848 * mark new buffer as malloc-ed.
849 */
850
851 memcpy((VOID *) new, (VOID *) pvPtr->buffer, pvPtr->next - pvPtr->buffer);
852 pvPtr->next = new + (pvPtr->next - pvPtr->buffer);
853 if (pvPtr->clientData != 0) {
854 ckfree(pvPtr->buffer);
855 }
856 pvPtr->buffer = new;
857 pvPtr->end = new + newSpace - 1;
858 pvPtr->clientData = (ClientData) 1;
859 }
860 \f
861 /*
862 *----------------------------------------------------------------------
863 *
864 * TclWordEnd --
865 *
866 * Given a pointer into a Tcl command, find the end of the next
867 * word of the command.
868 *
869 * Results:
870 * The return value is a pointer to the character just after the
871 * last one that's part of the word pointed to by "start". This
872 * may be the address of the NULL character at the end of the
873 * string.
874 *
875 * Side effects:
876 * None.
877 *
878 *----------------------------------------------------------------------
879 */
880
881 char *
882 TclWordEnd (
883 char *start, /* Beginning of a word of a Tcl command. */
884 int nested /* Zero means this is a top-level command.
885 * One means this is a nested command (close
886 * brace is a word terminator). */
887 )
888 {
889 register char *p;
890 int count;
891
892 p = start;
893 while (isspace(*p)) {
894 p++;
895 }
896
897 /*
898 * Handle words beginning with a double-quote or a brace.
899 */
900
901 if (*p == '"') {
902 p = QuoteEnd(p+1, '"');
903 } else if (*p == '{') {
904 int braces = 1;
905 while (braces != 0) {
906 p++;
907 while (*p == '\\') {
908 (void) Tcl_Backslash(p, &count);
909 p += count;
910 }
911 if (*p == '}') {
912 braces--;
913 } else if (*p == '{') {
914 braces++;
915 } else if (*p == 0) {
916 return p;
917 }
918 }
919 }
920
921 /*
922 * Handle words that don't start with a brace or double-quote.
923 * This code is also invoked if the word starts with a brace or
924 * double-quote and there is garbage after the closing brace or
925 * quote. This is an error as far as Tcl_Eval is concerned, but
926 * for here the garbage is treated as part of the word.
927 */
928
929 while (*p != 0) {
930 if (*p == '[') {
931 p++;
932 while ((*p != ']') && (*p != 0)) {
933 p = TclWordEnd(p, 1);
934 }
935 if (*p == ']') {
936 p++;
937 }
938 } else if (*p == '\\') {
939 (void) Tcl_Backslash(p, &count);
940 p += count;
941 } else if (*p == '$') {
942 p = VarNameEnd(p);
943 } else if (*p == ';') {
944 /*
945 * Note: semi-colon terminates a word
946 * and also counts as a word by itself.
947 */
948
949 if (p == start) {
950 p++;
951 }
952 break;
953 } else if (isspace(*p)) {
954 break;
955 } else if ((*p == ']') && nested) {
956 break;
957 } else {
958 p++;
959 }
960 }
961 return p;
962 }
963 \f
964 /*
965 *----------------------------------------------------------------------
966 *
967 * QuoteEnd --
968 *
969 * Given a pointer to a string that obeys the parsing conventions
970 * for quoted things in Tcl, find the end of that quoted thing.
971 * The actual thing may be a quoted argument or a parenthesized
972 * index name.
973 *
974 * Results:
975 * The return value is a pointer to the character just after the
976 * last one that is part of the quoted string.
977 *
978 * Side effects:
979 * None.
980 *
981 *----------------------------------------------------------------------
982 */
983
984 static char *
985 QuoteEnd (
986 char *string, /* Pointer to character just after opening
987 * "quote". */
988 int term /* This character will terminate the
989 * quoted string (e.g. '"' or ')'). */
990 )
991 {
992 register char *p = string;
993 int count;
994
995 while ((*p != 0) && (*p != term)) {
996 if (*p == '\\') {
997 (void) Tcl_Backslash(p, &count);
998 p += count;
999 } else if (*p == '[') {
1000 p++;
1001 while ((*p != ']') && (*p != 0)) {
1002 p = TclWordEnd(p, 1);
1003 }
1004 if (*p == ']') {
1005 p++;
1006 }
1007 } else if (*p == '$') {
1008 p = VarNameEnd(p);
1009 } else {
1010 p++;
1011 }
1012 }
1013 return p;
1014 }
1015 \f
1016 /*
1017 *----------------------------------------------------------------------
1018 *
1019 * VarNameEnd --
1020 *
1021 * Given a pointer to a variable reference using $-notation, find
1022 * the end of the variable name spec.
1023 *
1024 * Results:
1025 * The return value is a pointer to the character just after the
1026 * last one that is part of the variable name.
1027 *
1028 * Side effects:
1029 * None.
1030 *
1031 *----------------------------------------------------------------------
1032 */
1033
1034 static char *
1035 VarNameEnd (
1036 char *string /* Pointer to dollar-sign character. */
1037 )
1038 {
1039 register char *p = string+1;
1040
1041 if (*p == '{') {
1042 do {
1043 p++;
1044 } while ((*p != '}') && (*p != 0));
1045 } else {
1046 while (isalnum(*p) || (*p == '_')) {
1047 p++;
1048 }
1049 if ((*p == '(') && (p != string+1)) {
1050 p = QuoteEnd(p+1, ')');
1051 }
1052 }
1053 return p;
1054 }
1055 \f
1056 /*
1057 *----------------------------------------------------------------------
1058 *
1059 * Tcl_ParseVar --
1060 *
1061 * Given a string starting with a $ sign, parse off a variable
1062 * name and return its value.
1063 *
1064 * Results:
1065 * The return value is the contents of the variable given by
1066 * the leading characters of string. If termPtr isn't NULL,
1067 * *termPtr gets filled in with the address of the character
1068 * just after the last one in the variable specifier. If the
1069 * variable doesn't exist, then the return value is NULL and
1070 * an error message will be left in interp->result.
1071 *
1072 * Side effects:
1073 * None.
1074 *
1075 *----------------------------------------------------------------------
1076 */
1077
1078 char *
1079 Tcl_ParseVar (
1080 Tcl_Interp *interp, /* Context for looking up variable. */
1081 register char *string, /* String containing variable name.
1082 * First character must be "$". */
1083 char **termPtr /* If non-NULL, points to word to fill
1084 * in with character just after last
1085 * one in the variable specifier. */
1086 )
1087
1088 {
1089 char *name1, *name1End, c, *result;
1090 register char *name2;
1091 #define NUM_CHARS 200
1092 char copyStorage[NUM_CHARS];
1093 ParseValue pv;
1094
1095 /*
1096 * There are three cases:
1097 * 1. The $ sign is followed by an open curly brace. Then the variable
1098 * name is everything up to the next close curly brace, and the
1099 * variable is a scalar variable.
1100 * 2. The $ sign is not followed by an open curly brace. Then the
1101 * variable name is everything up to the next character that isn't
1102 * a letter, digit, or underscore. If the following character is an
1103 * open parenthesis, then the information between parentheses is
1104 * the array element name, which can include any of the substitutions
1105 * permissible between quotes.
1106 * 3. The $ sign is followed by something that isn't a letter, digit,
1107 * or underscore: in this case, there is no variable name, and "$"
1108 * is returned.
1109 */
1110
1111 name2 = NULL;
1112 string++;
1113 if (*string == '{') {
1114 string++;
1115 name1 = string;
1116 while (*string != '}') {
1117 if (*string == 0) {
1118 Tcl_SetResult(interp, "missing close-brace for variable name",
1119 TCL_STATIC);
1120 if (termPtr != 0) {
1121 *termPtr = string;
1122 }
1123 return NULL;
1124 }
1125 string++;
1126 }
1127 name1End = string;
1128 string++;
1129 } else {
1130 name1 = string;
1131 while (isalnum(*string) || (*string == '_')) {
1132 string++;
1133 }
1134 if (string == name1) {
1135 if (termPtr != 0) {
1136 *termPtr = string;
1137 }
1138 return "$";
1139 }
1140 name1End = string;
1141 if (*string == '(') {
1142 char *end;
1143
1144 /*
1145 * Perform substitutions on the array element name, just as
1146 * is done for quotes.
1147 */
1148
1149 pv.buffer = pv.next = copyStorage;
1150 pv.end = copyStorage + NUM_CHARS - 1;
1151 pv.expandProc = TclExpandParseValue;
1152 pv.clientData = (ClientData) NULL;
1153 if (TclParseQuotes(interp, string+1, ')', 0, &end, &pv)
1154 != TCL_OK) {
1155 char msg[100];
1156 sprintf(msg, "\n (parsing index for array \"%.*s\")",
1157 string-name1, name1);
1158 Tcl_AddErrorInfo(interp, msg);
1159 result = NULL;
1160 name2 = pv.buffer;
1161 if (termPtr != 0) {
1162 *termPtr = end;
1163 }
1164 goto done;
1165 }
1166 string = end;
1167 name2 = pv.buffer;
1168 }
1169 }
1170 if (termPtr != 0) {
1171 *termPtr = string;
1172 }
1173
1174 c = *name1End;
1175 *name1End = 0;
1176 result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
1177 *name1End = c;
1178
1179 done:
1180 if ((name2 != NULL) && (pv.buffer != copyStorage)) {
1181 ckfree(pv.buffer);
1182 }
1183 return result;
1184 }
Micropolis
Impressum, Datenschutz