1 #pragma prototyped
2 #include "tkshlib.h"
3
4 #define NAMEBUFLEN 512
5
TkshMapName(char * name)6 char *TkshMapName(char *name)
7 {
8 static char namebuf[NAMEBUFLEN+4] = "tcl_";
9 char *mapname = namebuf;
10 Namval_t *np;
11
12 if (strlen(name) >= NAMEBUFLEN)
13 {
14 mapname = (char *) malloc(strlen(name)+5);
15 memcpy(mapname, namebuf, 4);
16 }
17 strcpy(mapname+4, name);
18 if ((np = nv_open(mapname, sh_bltin_tree(), NV_NOADD)) && np->nvalue)
19 name = nv_name(np);
20 else
21 name = TkshMapKeyword(name);
22 if (namebuf != mapname)
23 free(mapname);
24 return name;
25 }
26
27
28 /*
29 *----------------------------------------------------------------------
30 *
31 * TclUpdateReturnInfo --
32 *
33 * This procedure is called when procedures return, and at other
34 * points where the TCL_RETURN code is used. It examines fields
35 * such as iPtr->returnCode and iPtr->errorCode and modifies
36 * the real return status accordingly.
37 *
38 * Results:
39 * The return value is the true completion code to use for
40 * the procedure, instead of TCL_RETURN.
41 *
42 * Side effects:
43 * The errorInfo and errorCode variables may get modified.
44 *
45 *----------------------------------------------------------------------
46 */
47
48 int
TclUpdateReturnInfo(iPtr)49 TclUpdateReturnInfo(iPtr)
50 Interp *iPtr; /* Interpreter for which TCL_RETURN
51 * exception is being processed. */
52 {
53 int code;
54
55 code = iPtr->returnCode;
56 iPtr->returnCode = TCL_OK;
57 if (code == TCL_ERROR) {
58 Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode", (char *) NULL,
59 (iPtr->errorCode != NULL) ? iPtr->errorCode : "NONE",
60 TCL_GLOBAL_ONLY);
61 iPtr->flags |= ERROR_CODE_SET;
62 if (iPtr->errorInfo != NULL) {
63 Tcl_SetVar2((Tcl_Interp *) iPtr, "errorInfo", (char *) NULL,
64 iPtr->errorInfo, TCL_GLOBAL_ONLY);
65 iPtr->flags |= ERR_IN_PROGRESS;
66 }
67 }
68 return code;
69 }
70
71 /*
72 *-----------------------------------------------------------------
73 *
74 * Tcl_Eval --
75 *
76 * Parse and execute a command in the Tcl language.
77 *
78 * Results:
79 * The return value is one of the return codes defined in tcl.hd
80 * (such as TCL_OK), and interp->result contains a string value
81 * to supplement the return code. The value of interp->result
82 * will persist only until the next call to Tcl_Eval: copy it or
83 * lose it! *TermPtr is filled in with the character just after
84 * the last one that was part of the command (usually a NULL
85 * character or a closing bracket).
86 *
87 * Side effects:
88 * Almost certainly; depends on the command.
89 *
90 *-----------------------------------------------------------------
91 */
92
93 int
Tcl_TclEval(interp,cmd)94 Tcl_TclEval(interp, cmd)
95 Tcl_Interp *interp; /* Token for command interpreter (returned
96 * by a previous call to Tcl_CreateInterp). */
97 char *cmd; /* Pointer to TCL command to interpret. */
98 {
99 /*
100 * The storage immediately below is used to generate a copy
101 * of the command, after all argument substitutions. Pv will
102 * contain the argv values passed to the command procedure.
103 */
104
105 # define NUM_CHARS 200
106 char copyStorage[NUM_CHARS];
107 ParseValue pv;
108 char *oldBuffer;
109
110 /*
111 * This procedure generates an (argv, argc) array for the command,
112 * It starts out with stack-allocated space but uses dynamically-
113 * allocated storage to increase it if needed.
114 */
115
116 # define NUM_ARGS 10
117 char *(argStorage[NUM_ARGS]);
118 char **argv = argStorage;
119 int argc;
120 int argSize = NUM_ARGS;
121
122 register char *src; /* Points to current character
123 * in cmd. */
124 char termChar; /* Return when this character is found
125 * (either ']' or '\0'). Zero means
126 * that newlines terminate commands. */
127 int flags; /* Interp->evalFlags value when the
128 * procedure was called. */
129 int result; /* Return value. */
130 register Interp *iPtr = (Interp *) interp;
131 char *termPtr; /* Contains character just after the
132 * last one in the command. */
133 char *cmdStart; /* Points to first non-blank char. in
134 * command (used in calling trace
135 * procedures). */
136 char *ellipsis = ""; /* Used in setting errorInfo variable;
137 * set to "..." to indicate that not
138 * all of offending command is included
139 * in errorInfo. "" means that the
140 * command is all there. */
141 #ifdef TKSH_NOT_USED
142 Tcl_HashEntry *hPtr;
143 register Trace *tracePtr;
144 #else
145 Namval_t *nv;
146 int oldInterpType;
147
148 dprintf(("------- TCL EVAL ------------\n"));
149 oldInterpType = iPtr->interpType;
150 iPtr->interpType = INTERP_TCL;
151 #endif
152
153 /*
154 * Initialize the result to an empty string and clear out any
155 * error information. This makes sure that we return an empty
156 * result if there are no commands in the command string.
157 */
158
159 Tcl_FreeResult((Tcl_Interp *) iPtr);
160 iPtr->result = iPtr->resultSpace;
161 iPtr->resultSpace[0] = 0;
162 result = TCL_OK;
163
164 /*
165 * Initialize the area in which command copies will be assembled.
166 */
167
168 pv.buffer = copyStorage;
169 pv.end = copyStorage + NUM_CHARS - 1;
170 pv.expandProc = TclExpandParseValue;
171 pv.clientData = (ClientData) NULL;
172
173 src = cmd;
174 flags = iPtr->evalFlags;
175 iPtr->evalFlags = 0;
176 if (flags & TCL_BRACKET_TERM) {
177 termChar = ']';
178 } else {
179 termChar = 0;
180 }
181 termPtr = src;
182 cmdStart = src;
183
184 /*
185 * Check depth of nested calls to Tcl_Eval: if this gets too large,
186 * it's probably because of an infinite loop somewhere.
187 */
188
189 iPtr->numLevels++;
190 if (iPtr->numLevels > iPtr->maxNestingDepth) {
191 iPtr->numLevels--;
192 iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
193 iPtr->termPtr = termPtr;
194 iPtr->interpType = oldInterpType;
195 return TCL_ERROR;
196 }
197
198 /*
199 * There can be many sub-commands (separated by semi-colons or
200 * newlines) in one command string. This outer loop iterates over
201 * individual commands.
202 */
203
204 while (*src != termChar) {
205 iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET);
206
207 /*
208 * Skim off leading white space and semi-colons, and skip
209 * comments.
210 */
211
212 while (1) {
213 register char c = *src;
214
215 if ((CHAR_TYPE(c) != TCL_SPACE) && (c != ';') && (c != '\n')) {
216 break;
217 }
218 src += 1;
219 }
220 if (*src == '#') {
221 for (src++; *src != 0; src++) {
222 if ((*src == '\n') && (src[-1] != '\\')) {
223 src++;
224 termPtr = src;
225 break;
226 }
227 }
228 continue;
229 }
230 cmdStart = src;
231
232 /*
233 * Parse the words of the command, generating the argc and
234 * argv for the command procedure. May have to call
235 * TclParseWords several times, expanding the argv array
236 * between calls.
237 */
238
239 pv.next = oldBuffer = pv.buffer;
240 argc = 0;
241 while (1) {
242 int newArgs, maxArgs;
243 char **newArgv;
244 int i;
245
246 /*
247 * Note: the "- 2" below guarantees that we won't use the
248 * last two argv slots here. One is for a NULL pointer to
249 * mark the end of the list, and the other is to leave room
250 * for inserting the command name "unknown" as the first
251 * argument (see below).
252 */
253
254 maxArgs = argSize - argc - 2;
255 result = TclParseWords((Tcl_Interp *) iPtr, src, flags,
256 maxArgs, &termPtr, &newArgs, &argv[argc], &pv);
257 src = termPtr;
258 if (result != TCL_OK) {
259 ellipsis = "...";
260 goto done;
261 }
262
263 /*
264 * Careful! Buffer space may have gotten reallocated while
265 * parsing words. If this happened, be sure to update all
266 * of the older argv pointers to refer to the new space.
267 */
268
269 if (oldBuffer != pv.buffer) {
270 int i;
271
272 for (i = 0; i < argc; i++) {
273 argv[i] = pv.buffer + (argv[i] - oldBuffer);
274 }
275 oldBuffer = pv.buffer;
276 }
277 argc += newArgs;
278 if (newArgs < maxArgs) {
279 argv[argc] = (char *) NULL;
280 break;
281 }
282
283 /*
284 * Args didn't all fit in the current array. Make it bigger.
285 */
286
287 argSize *= 2;
288 newArgv = (char **)
289 ckalloc((unsigned) argSize * sizeof(char *));
290 for (i = 0; i < argc; i++) {
291 newArgv[i] = argv[i];
292 }
293 if (argv != argStorage) {
294 ckfree((char *) argv);
295 }
296 argv = newArgv;
297 }
298
299 /*
300 * If this is an empty command (or if we're just parsing
301 * commands without evaluating them), then just skip to the
302 * next command.
303 */
304
305 if ((argc == 0) || iPtr->noEval) {
306 continue;
307 }
308 argv[argc] = NULL;
309
310 /*
311 * Save information for the history module, if needed.
312 */
313
314 #ifdef TKSH_NOT_USED
315 if (flags & TCL_RECORD_BOUNDS) {
316 iPtr->evalFirst = cmdStart;
317 iPtr->evalLast = src-1;
318 }
319
320 /*
321 * Find the procedure to execute this command. If there isn't
322 * one, then see if there is a command "unknown". If so,
323 * invoke it instead, passing it the words of the original
324 * command as arguments.
325 */
326
327 hPtr = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]);
328 if (hPtr == NULL) {
329 int i;
330
331 hPtr = Tcl_FindHashEntry(&iPtr->commandTable, "unknown");
332 if (hPtr == NULL) {
333 Tcl_ResetResult(interp);
334 Tcl_AppendResult(interp, "invalid command name \"",
335 argv[0], "\"", (char *) NULL);
336 result = TCL_ERROR;
337 goto done;
338 }
339 for (i = argc; i >= 0; i--) {
340 argv[i+1] = argv[i];
341 }
342 argv[0] = "unknown";
343 argc++;
344 }
345 cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
346
347 /*
348 * Call trace procedures, if any.
349 */
350
351 for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
352 tracePtr = tracePtr->nextPtr) {
353 char saved;
354
355 if (tracePtr->level < iPtr->numLevels) {
356 continue;
357 }
358 saved = *src;
359 *src = 0;
360 (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
361 cmdStart, cmdPtr->proc, cmdPtr->clientData, argc, argv);
362 *src = saved;
363 }
364
365 #endif
366 /*
367 * At long last, invoke the command procedure. Reset the
368 * result to its default empty value first (it could have
369 * gotten changed by earlier commands in the same command
370 * string).
371 */
372
373 #ifdef TKSH_NOT_USED
374 iPtr->cmdCount++;
375 #endif
376 Tcl_FreeResult(iPtr);
377 iPtr->result = iPtr->resultSpace;
378 iPtr->resultSpace[0] = 0;
379 #ifdef TKSH_NOT_USED
380 result= (*cmdPtr->proc)(cmdPtr->clientData, interp, argc, argv);
381 #else
382 nv=nv_search(TkshMapName(argv[0]),sh_bltin_tree(),0);
383 if (nv && nv->nvalue)
384 {
385 Shbltin_t bd;
386 Sfio_t *f = NIL(Sfio_t *); char *s;
387 if (! nv->nvfun) /* KSH builtin */
388 {
389 sfstack(sfstdout, f=sftmp(4096));
390 dprintfArgs("Tcl_Eval (ksh direct)", argc, argv);
391 }
392 else
393 dprintfArgs("Tcl_Eval (Tcl direct)", argc, argv);
394 /* NOTE: 2008-03-16 &sh is a cheat here */
395 bd = *(Shbltin_t*)((Interp*)interp)->shbltin;
396 bd.shp = &sh;
397 bd.ptr = nv->nvfun;
398 result = (*((ShellProc_t) nv->nvalue))(argc, argv, &bd);
399 if (f)
400 {
401 sfstack(sfstdout, NIL(Sfio_t *));
402 sfputc(f,0); /* null terminate */
403 sfseek(f,0L,SEEK_SET);
404 s = sfreserve(f,SF_UNBOUND,-1);
405 if ( s[sfvalue(f)-2] == '\n' )
406 s[sfvalue(f)-2] = 0;
407 Tcl_SetResult(interp, s, TCL_VOLATILE);
408 sfclose(f);
409 }
410 }
411 else
412 {
413 /* We need to check aliases too XX - also check mapped name? */
414 nv = nv_search(argv[0], sh.fun_tree, 0);
415 if (nv && nv->nvalue)
416 {
417 Sfio_t *tclcommand;
418 int oldMode;
419 char *cmd;
420
421 oldMode = TkshSetListMode(iPtr->interpType=INTERP_KSH);
422 cmd = Tcl_Merge(argc, argv);
423 TkshSetListMode(oldMode);
424 dprintf(("Tcl_Eval (ksh): %s\n", cmd));
425 if ((tclcommand = sfopen((Sfio_t *) 0, cmd, "s")))
426 sh_eval(tclcommand,0x8000); /* closed in sh_eval */
427 iPtr->interpType = INTERP_TCL;
428 /* TkshSetListMode(oldMode); */
429 ckfree(cmd);
430 result = Tksh_ReturnVal();
431 }
432 else
433 {
434 int i;
435 dprintf(("Tcl_Eval: (unknown) %s\n", cmd));
436 nv = nv_search("unknown", sh_bltin_tree(), 0);
437 if (!nv || !nv->nvalue)
438 {
439 Tcl_ResetResult(interp);
440 Tcl_AppendResult(interp,
441 "invalid command name \"", argv[0],
442 "\"", (char *) NULL);
443 result = TCL_ERROR;
444 goto done;
445 }
446 for (i = argc; i >= 0; i--) {
447 argv[i+1] = argv[i];
448 }
449 argv[0] = "unknown";
450 argc++;
451 result = (*((ShellProc_t) nv->nvalue))(argc, argv,
452 (void *) nv->nvfun);
453 }
454 }
455 #endif
456 if (Tcl_AsyncReady()) {
457 result = Tcl_AsyncInvoke(interp, result);
458 }
459 if (result != TCL_OK) {
460 break;
461 }
462 }
463
464 done:
465
466 /*
467 * Free up any extra resources that were allocated.
468 */
469
470 if (pv.buffer != copyStorage) {
471 ckfree((char *) pv.buffer);
472 }
473 if (argv != argStorage) {
474 ckfree((char *) argv);
475 }
476 iPtr->numLevels--;
477 if (iPtr->numLevels == 0) {
478 if (result == TCL_RETURN) {
479 result = TclUpdateReturnInfo(iPtr);
480 }
481 #if TCL_MINOR_VERSION == 3
482 if ((result != TCL_OK) && (result != TCL_ERROR)) {
483 #else
484 if ((result != TCL_OK) && (result != TCL_ERROR)
485 && !(flags & TCL_ALLOW_EXCEPTIONS)) {
486
487 #endif
488 Tcl_ResetResult(interp);
489 if (result == TCL_BREAK) {
490 iPtr->result = "invoked \"break\" outside of a loop";
491 } else if (result == TCL_CONTINUE) {
492 iPtr->result = "invoked \"continue\" outside of a loop";
493 } else {
494 iPtr->result = iPtr->resultSpace;
495 sprintf(iPtr->resultSpace, "command returned bad code: %d",
496 result);
497 }
498 result = TCL_ERROR;
499 }
500 if (iPtr->flags & DELETED) {
501 /*
502 * Someone tried to delete the interpreter, but it couldn't
503 * actually be deleted because commands were in the middle of
504 * being evaluated. Delete the interpreter now. Also, return
505 * immediately: we can't execute the remaining code in the
506 * procedure because it accesses fields of the dead interpreter.
507 */
508
509 Tcl_DeleteInterp(interp);
510 return result;
511 }
512 }
513
514 /*
515 * If an error occurred, record information about what was being
516 * executed when the error occurred.
517 */
518
519 if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
520 int numChars;
521 register char *p;
522
523 /*
524 * Compute the line number where the error occurred.
525 */
526
527 iPtr->errorLine = 1;
528 for (p = cmd; p != cmdStart; p++) {
529 if (*p == '\n') {
530 iPtr->errorLine++;
531 }
532 }
533 for ( ; isspace(UCHAR(*p)) || (*p == ';'); p++) {
534 if (*p == '\n') {
535 iPtr->errorLine++;
536 }
537 }
538
539 /*
540 * Figure out how much of the command to print in the error
541 * message (up to a certain number of characters, or up to
542 * the first new-line).
543 */
544
545 numChars = src - cmdStart;
546 if (numChars > (NUM_CHARS-50)) {
547 numChars = NUM_CHARS-50;
548 ellipsis = " ...";
549 }
550
551 if (!(iPtr->flags & ERR_IN_PROGRESS)) {
552 sprintf(copyStorage, "\n while executing\n\"%.*s%s\"",
553 numChars, cmdStart, ellipsis);
554 } else {
555 sprintf(copyStorage, "\n invoked from within\n\"%.*s%s\"",
556 numChars, cmdStart, ellipsis);
557 }
558 Tcl_AddErrorInfo(interp, copyStorage);
559 iPtr->flags &= ~ERR_ALREADY_LOGGED;
560 } else {
561 iPtr->flags &= ~ERR_ALREADY_LOGGED;
562 }
563 iPtr->termPtr = termPtr;
564 sh_sigcheck(0);
565 iPtr->interpType = oldInterpType;
566 return result;
567 }
568