source: trunk/kitgen/8.x/blt/generic/bltParse.c@ 199

Last change on this file since 199 was 175, checked in by demin, 12 years ago

initial commit
File size: 17.5 KB
Line 
1/*
2 * tclParse.c --
3 *
4 * Contains a collection of procedures that are used to parse Tcl
5 * commands or parts of commands (like quoted strings or nested
6 * sub-commands).
7 *
8 * Since Tcl 8.1.0 these routines have been replaced by ones that
9 * generate byte-codes. But since these routines are used in
10 * vector expressions, where no such byte-compilation is
11 * necessary, I now include them. In fact, the byte-compiled
12 * versions would be slower since the compiled code typically
13 * runs only one time.
14 *
15 * Copyright (c) 1987-1993 The Regents of the University of California.
16 * Copyright (c) 19941998 Sun Microsystems, Inc.
17 *
18 */
19
20#include "bltInt.h"
21
22#if (TCL_VERSION_NUMBER >= _VERSION(8,1,0))
23#include "bltInterp.h"
24
25/*
26 * A table used to classify input characters to assist in parsing
27 * Tcl commands. The table should be indexed with a signed character
28 * using the CHAR_TYPE macro. The character may have a negative
29 * value. The CHAR_TYPE macro takes a pointer to a signed character
30 * and a pointer to the last character in the source string. If the
31 * src pointer is pointing at the terminating null of the string,
32 * CHAR_TYPE returns TCL_COMMAND_END.
33 */
34
35#define STATIC_STRING_SPACE 150
36#define UCHAR(c) ((unsigned char) (c))
37#define TCL_NORMAL 0x01
38#define TCL_SPACE 0x02
39#define TCL_COMMAND_END 0x04
40#define TCL_QUOTE 0x08
41#define TCL_OPEN_BRACKET 0x10
42#define TCL_OPEN_BRACE 0x20
43#define TCL_CLOSE_BRACE 0x40
44#define TCL_BACKSLASH 0x80
45#define TCL_DOLLAR 0x00
46
47/*
48 * The following table assigns a type to each character. Only types
49 * meaningful to Tcl parsing are represented here. The table is
50 * designed to be referenced with either signed or unsigned characters,
51 * so it has 384 entries. The first 128 entries correspond to negative
52 * character values, the next 256 correspond to positive character
53 * values. The last 128 entries are identical to the first 128. The
54 * table is always indexed with a 128-byte offset (the 128th entry
55 * corresponds to a 0 character value).
56 */
57
58static unsigned char tclTypeTable[] =
59{
60 /*
61 * Negative character values, from -128 to -1:
62 */
63
64 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
65 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
66 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
67 TCL_NORMAL, TCL_NORMAL, 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_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
73 TCL_NORMAL, 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_NORMAL,
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_NORMAL,
87 TCL_NORMAL, TCL_NORMAL, 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_NORMAL,
95 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
96
97 /*
98 * Positive character values, from 0-127:
99 */
100
101 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
102 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
103 TCL_NORMAL, TCL_SPACE, TCL_COMMAND_END, TCL_SPACE,
104 TCL_SPACE, TCL_SPACE, TCL_NORMAL, TCL_NORMAL,
105 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
106 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
107 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
108 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
109 TCL_SPACE, TCL_NORMAL, TCL_QUOTE, TCL_NORMAL,
110 TCL_DOLLAR, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
111 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
112 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
113 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
114 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
115 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_COMMAND_END,
116 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
117 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
118 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
119 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
120 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
121 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
122 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
123 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACKET,
124 TCL_BACKSLASH, TCL_COMMAND_END, TCL_NORMAL, TCL_NORMAL,
125 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
126 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
127 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
128 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
129 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
130 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
131 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_OPEN_BRACE,
132 TCL_NORMAL, TCL_CLOSE_BRACE, TCL_NORMAL, TCL_NORMAL,
133
134 /*
135 * Large unsigned character values, from 128-255:
136 */
137
138 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
139 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
140 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
141 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
142 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
143 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
144 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
145 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
146 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
147 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
148 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
149 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
150 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
151 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
152 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
153 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
154 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
155 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
156 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
157 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
158 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
159 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
160 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
161 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
162 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
163 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
164 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
165 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
166 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
167 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
168 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
169 TCL_NORMAL, TCL_NORMAL, TCL_NORMAL, TCL_NORMAL,
170};
171
172#define CHAR_TYPE(src,last) \
173 (((src)==(last))?TCL_COMMAND_END:(tclTypeTable+128)[(int)*(src)])
174
175/*
176 *--------------------------------------------------------------
177 *
178 * Blt_ParseNestedCmd --
179 *
180 * This procedure parses a nested Tcl command between
181 * brackets, returning the result of the command.
182 *
183 * Results:
184 * The return value is a standard Tcl result, which is
185 * TCL_OK unless there was an error while executing the
186 * nested command. If an error occurs then interp->result
187 * contains a standard error message. *TermPtr is filled
188 * in with the address of the character just after the
189 * last one processed; this is usually the character just
190 * after the matching close-bracket, or the null character
191 * at the end of the string if the close-bracket was missing
192 * (a missing close bracket is an error). The result returned
193 * by the command is stored in standard fashion in *parsePtr,
194 * null-terminated, with parsePtr->next pointing to the null
195 * character.
196 *
197 * Side effects:
198 * The storage space at *parsePtr may be expanded.
199 *
200 *--------------------------------------------------------------
201 */
202int
203Blt_ParseNestedCmd(interp, string, flags, termPtr, parsePtr)
204 Tcl_Interp *interp; /* Interpreter to use for nested command
205 * evaluations and error messages. */
206 char *string; /* Character just after opening bracket. */
207 int flags; /* Flags to pass to nested Tcl_Eval. */
208 char **termPtr; /* Store address of terminating character
209 * here. */
210 ParseValue *parsePtr; /* Information about where to place
211 * result of command. */
212{
213 int result, length, shortfall;
214 Interp *iPtr = (Interp *) interp;
215
216 iPtr->evalFlags = flags | TCL_BRACKET_TERM;
217 result = Tcl_Eval(interp, string);
218 *termPtr = (string + iPtr->termOffset);
219 if (result != TCL_OK) {
220 /*
221 * The increment below results in slightly cleaner message in
222 * the errorInfo variable (the close-bracket will appear).
223 */
224
225 if (**termPtr == ']') {
226 *termPtr += 1;
227 }
228 return result;
229 }
230 (*termPtr) += 1;
231 length = strlen(iPtr->result);
232 shortfall = length + 1 - (parsePtr->end - parsePtr->next);
233 if (shortfall > 0) {
234 (*parsePtr->expandProc) (parsePtr, shortfall);
235 }
236 strcpy(parsePtr->next, iPtr->result);
237 parsePtr->next += length;
238
239 Tcl_FreeResult(interp);
240 iPtr->result = iPtr->resultSpace;
241 iPtr->resultSpace[0] = '\0';
242 return TCL_OK;
243}
244
245
246/*
247 *--------------------------------------------------------------
248 *
249 * Blt_ParseBraces --
250 *
251 * This procedure scans the information between matching
252 * curly braces.
253 *
254 * Results:
255 * The return value is a standard Tcl result, which is
256 * TCL_OK unless there was an error while parsing string.
257 * If an error occurs then interp->result contains a
258 * standard error message. *TermPtr is filled
259 * in with the address of the character just after the
260 * last one successfully processed; this is usually the
261 * character just after the matching close-brace. The
262 * information between curly braces is stored in standard
263 * fashion in *parsePtr, null-terminated with parsePtr->next
264 * pointing to the terminating null character.
265 *
266 * Side effects:
267 * The storage space at *parsePtr may be expanded.
268 *
269 *--------------------------------------------------------------
270 */
271
272int
273Blt_ParseBraces(interp, string, termPtr, parsePtr)
274 Tcl_Interp *interp; /* Interpreter to use for nested command
275 * evaluations and error messages. */
276 char *string; /* Character just after opening bracket. */
277 char **termPtr; /* Store address of terminating character
278 * here. */
279 ParseValue *parsePtr; /* Information about where to place
280 * result of command. */
281{
282 int level;
283 register char *src, *dest, *end;
284 register char c;
285 char *lastChar = string + strlen(string);
286
287 src = string;
288 dest = parsePtr->next;
289 end = parsePtr->end;
290 level = 1;
291
292 /*
293 * Copy the characters one at a time to the result area, stopping
294 * when the matching close-brace is found.
295 */
296
297 for (;;) {
298 c = *src;
299 src++;
300
301 if (dest == end) {
302 parsePtr->next = dest;
303 (*parsePtr->expandProc) (parsePtr, 20);
304 dest = parsePtr->next;
305 end = parsePtr->end;
306 }
307 *dest = c;
308 dest++;
309
310 if (CHAR_TYPE(src - 1, lastChar) == TCL_NORMAL) {
311 continue;
312 } else if (c == '{') {
313 level++;
314 } else if (c == '}') {
315 level--;
316 if (level == 0) {
317 dest--; /* Don't copy the last close brace. */
318 break;
319 }
320 } else if (c == '\\') {
321 int count;
322
323 /*
324 * Must always squish out backslash-newlines, even when in
325 * braces. This is needed so that this sequence can appear
326 * anywhere in a command, such as the middle of an expression.
327 */
328
329 if (*src == '\n') {
330 dest[-1] = Tcl_Backslash(src - 1, &count);
331 src += count - 1;
332 } else {
333 Tcl_Backslash(src - 1, &count);
334 while (count > 1) {
335 if (dest == end) {
336 parsePtr->next = dest;
337 (*parsePtr->expandProc) (parsePtr, 20);
338 dest = parsePtr->next;
339 end = parsePtr->end;
340 }
341 *dest = *src;
342 dest++;
343 src++;
344 count--;
345 }
346 }
347 } else if (c == '\0') {
348 Tcl_AppendResult(interp, "missing close-brace", (char *)NULL);
349 *termPtr = string - 1;
350 return TCL_ERROR;
351 }
352 }
353
354 *dest = '\0';
355 parsePtr->next = dest;
356 *termPtr = src;
357 return TCL_OK;
358}
359
360
361/*
362 *--------------------------------------------------------------
363 *
364 * Blt_ExpandParseValue --
365 *
366 * This procedure is commonly used as the value of the
367 * expandProc in a ParseValue. It uses malloc to allocate
368 * more space for the result of a parse.
369 *
370 * Results:
371 * The buffer space in *parsePtr is reallocated to something
372 * larger, and if parsePtr->clientData is non-zero the old
373 * buffer is freed. Information is copied from the old
374 * buffer to the new one.
375 *
376 * Side effects:
377 * None.
378 *
379 *--------------------------------------------------------------
380 */
381void
382Blt_ExpandParseValue(parsePtr, needed)
383 ParseValue *parsePtr; /* Information about buffer that
384 * must be expanded. If the clientData
385 * in the structure is non-zero, it
386 * means that the current buffer is
387 * dynamically allocated. */
388 int needed; /* Minimum amount of additional space
389 * to allocate. */
390{
391 int size;
392 char *buffer;
393
394 /*
395 * Either double the size of the buffer or add enough new space
396 * to meet the demand, whichever produces a larger new buffer.
397 */
398 size = (parsePtr->end - parsePtr->buffer) + 1;
399 if (size < needed) {
400 size += needed;
401 } else {
402 size += size;
403 }
404 buffer = Blt_Malloc((unsigned int)size);
405
406 /*
407 * Copy from old buffer to new, free old buffer if needed, and
408 * mark new buffer as malloc-ed.
409 */
410 memcpy((VOID *) buffer, (VOID *) parsePtr->buffer,
411 (size_t) (parsePtr->next - parsePtr->buffer));
412 parsePtr->next = buffer + (parsePtr->next - parsePtr->buffer);
413 if (parsePtr->clientData != 0) {
414 Blt_Free(parsePtr->buffer);
415 }
416 parsePtr->buffer = buffer;
417 parsePtr->end = buffer + size - 1;
418 parsePtr->clientData = (ClientData)1;
419}
420
421/*
422 *--------------------------------------------------------------
423 *
424 * Blt_ParseQuotes --
425 *
426 * This procedure parses a double-quoted string such as a
427 * quoted Tcl command argument or a quoted value in a Tcl
428 * expression. This procedure is also used to parse array
429 * element names within parentheses, or anything else that
430 * needs all the substitutions that happen in quotes.
431 *
432 * Results:
433 * The return value is a standard Tcl result, which is
434 * TCL_OK unless there was an error while parsing the
435 * quoted string. If an error occurs then interp->result
436 * contains a standard error message. *TermPtr is filled
437 * in with the address of the character just after the
438 * last one successfully processed; this is usually the
439 * character just after the matching close-quote. The
440 * fully-substituted contents of the quotes are stored in
441 * standard fashion in *parsePtr, null-terminated with
442 * parsePtr->next pointing to the terminating null character.
443 *
444 * Side effects:
445 * The buffer space in parsePtr may be enlarged by calling its
446 * expandProc.
447 *
448 *--------------------------------------------------------------
449 */
450int
451Blt_ParseQuotes(interp, string, termChar, flags, termPtr, parsePtr)
452 Tcl_Interp *interp; /* Interpreter to use for nested command
453 * evaluations and error messages. */
454 char *string; /* Character just after opening double-
455 * quote. */
456 int termChar; /* Character that terminates "quoted" string
457 * (usually double-quote, but sometimes
458 * right-paren or something else). */
459 int flags; /* Flags to pass to nested Tcl_Eval calls. */
460 char **termPtr; /* Store address of terminating character
461 * here. */
462 ParseValue *parsePtr; /* Information about where to place
463 * fully-substituted result of parse. */
464{
465 register char *src, *dest, c;
466 char *lastChar = string + strlen(string);
467
468 src = string;
469 dest = parsePtr->next;
470
471 for (;;) {
472 if (dest == parsePtr->end) {
473 /*
474 * Target buffer space is about to run out. Make more space.
475 */
476 parsePtr->next = dest;
477 (*parsePtr->expandProc) (parsePtr, 1);
478 dest = parsePtr->next;
479 }
480 c = *src;
481 src++;
482 if (c == termChar) {
483 *dest = '\0';
484 parsePtr->next = dest;
485 *termPtr = src;
486 return TCL_OK;
487 } else if (CHAR_TYPE(src - 1, lastChar) == TCL_NORMAL) {
488 copy:
489 *dest = c;
490 dest++;
491 continue;
492 } else if (c == '$') {
493 int length;
494 CONST char *value;
495
496 value = Tcl_ParseVar(interp, src - 1, termPtr);
497 if (value == NULL) {
498 return TCL_ERROR;
499 }
500 src = *termPtr;
501 length = strlen(value);
502 if ((parsePtr->end - dest) <= length) {
503 parsePtr->next = dest;
504 (*parsePtr->expandProc) (parsePtr, length);
505 dest = parsePtr->next;
506 }
507 strcpy(dest, value);
508 dest += length;
509 continue;
510 } else if (c == '[') {
511 int result;
512
513 parsePtr->next = dest;
514 result = Blt_ParseNestedCmd(interp, src, flags, termPtr, parsePtr);
515 if (result != TCL_OK) {
516 return result;
517 }
518 src = *termPtr;
519 dest = parsePtr->next;
520 continue;
521 } else if (c == '\\') {
522 int nRead;
523
524 src--;
525 *dest = Tcl_Backslash(src, &nRead);
526 dest++;
527 src += nRead;
528 continue;
529 } else if (c == '\0') {
530 char buf[30];
531
532 Tcl_ResetResult(interp);
533 sprintf(buf, "missing %c", termChar);
534 Tcl_SetResult(interp, buf, TCL_VOLATILE);
535 *termPtr = string - 1;
536 return TCL_ERROR;
537 } else {
538 goto copy;
539 }
540 }
541}
542
543#endif /* TCL_VERSION_NUMBER >= _VERSION(8,1,0) */
Note: See TracBrowser for help on using the repository browser.