1
2 /*
3 ** The implementation of the TH core. This file contains the parser, and
4 ** the implementation of the interface in th.h.
5 */
6
7 #include "config.h"
8 #include "th.h"
9 #include <string.h>
10 #include <assert.h>
11
12 /*
13 ** Values used for element values in the tcl_platform array.
14 */
15
16 #if !defined(TH_ENGINE)
17 # define TH_ENGINE "TH1"
18 #endif
19
20 #if !defined(TH_PLATFORM)
21 # if defined(_WIN32) || defined(WIN32)
22 # define TH_PLATFORM "windows"
23 # else
24 # define TH_PLATFORM "unix"
25 # endif
26 #endif
27
28 /*
29 ** Forward declarations for structures defined below.
30 */
31
32 typedef struct Th_Command Th_Command;
33 typedef struct Th_Frame Th_Frame;
34 typedef struct Th_Variable Th_Variable;
35 typedef struct Th_InterpAndList Th_InterpAndList;
36
37 /*
38 ** Interpreter structure.
39 */
40 struct Th_Interp {
41 Th_Vtab *pVtab; /* Copy of the argument passed to Th_CreateInterp() */
42 char *zResult; /* Current interpreter result (Th_Malloc()ed) */
43 int nResult; /* number of bytes in zResult */
44 Th_Hash *paCmd; /* Table of registered commands */
45 Th_Frame *pFrame; /* Current execution frame */
46 int isListMode; /* True if thSplitList() should operate in "list" mode */
47 };
48
49 /*
50 ** Each TH command registered using Th_CreateCommand() is represented
51 ** by an instance of the following structure stored in the Th_Interp.paCmd
52 ** hash-table.
53 */
54 struct Th_Command {
55 int (*xProc)(Th_Interp *, void *, int, const char **, int *);
56 void *pContext;
57 void (*xDel)(Th_Interp *, void *);
58 };
59
60 /*
61 ** Each stack frame (variable scope) is represented by an instance
62 ** of this structure. Variable values set using the Th_SetVar command
63 ** are stored in the Th_Frame.paVar hash table member of the associated
64 ** stack frame object.
65 **
66 ** When an interpreter is created, a single Th_Frame structure is also
67 ** allocated - the global variable scope. Th_Interp.pFrame (the current
68 ** interpreter frame) is initialised to point to this Th_Frame. It is
69 ** not deleted for the lifetime of the interpreter (because the global
70 ** frame never goes out of scope).
71 **
72 ** New stack frames are created by the Th_InFrame() function. Before
73 ** invoking its callback function, Th_InFrame() allocates a new Th_Frame
74 ** structure with pCaller set to the current frame (Th_Interp.pFrame),
75 ** and sets the current frame to the new frame object. After the callback
76 ** has been invoked, the allocated Th_Frame is deleted and the value
77 ** of the current frame pointer restored.
78 **
79 ** By default, the Th_SetVar(), Th_UnsetVar() and Th_GetVar() functions
80 ** access variable values in the current frame. If they need to access
81 ** the global frame, they do so by traversing the pCaller pointer list.
82 ** Likewise, the Th_LinkVar() function uses the pCaller pointers to
83 ** link to variables located in the global or other stack frames.
84 */
85 struct Th_Frame {
86 Th_Hash *paVar; /* Variables defined in this scope */
87 Th_Frame *pCaller; /* Calling frame */
88 };
89
90 /*
91 ** This structure represents a value assigned to a th1 variable.
92 **
93 ** The Th_Frame.paVar hash table maps from variable name (a th1 string)
94 ** to a pointer to an instance of the following structure. More than
95 ** one hash table entry may map to a single structure if variable
96 ** links have been created using Th_LinkVar(). The number of references
97 ** is stored in Th_Variable.nRef.
98 **
99 ** For scalar variables, Th_Variable.zData is never 0. Th_Variable.nData
100 ** stores the number of bytes in the value pointed to by zData.
101 **
102 ** For an array variable, Th_Variable.zData is 0 and pHash points to
103 ** a hash table mapping between array key name (a th1 string) and
104 ** a pointer to the Th_Variable structure holding the scalar
105 ** value.
106 */
107 struct Th_Variable {
108 int nRef; /* Number of references to this structure */
109 int nData; /* Number of bytes at Th_Variable.zData */
110 char *zData; /* Data for scalar variables */
111 Th_Hash *pHash; /* Data for array variables */
112 };
113
114 /*
115 ** This structure is used to pass complete context information to the
116 ** hash iteration callback functions that need a Th_Interp and a list
117 ** to operate on, e.g. thListAppendHashKey().
118 */
119 struct Th_InterpAndList {
120 Th_Interp *interp; /* Associated interpreter context */
121 char **pzList; /* IN/OUT: Ptr to ptr to list */
122 int *pnList; /* IN/OUT: Current length of *pzList */
123 };
124
125 /*
126 ** Hash table API:
127 */
128 #define TH_HASHSIZE 257
129 struct Th_Hash {
130 Th_HashEntry *a[TH_HASHSIZE];
131 };
132
133 static int thEvalLocal(Th_Interp *, const char *, int);
134 static int thSplitList(Th_Interp*, const char*, int, char***, int **, int*);
135
136 static int thHexdigit(char c);
137 static int thEndOfLine(const char *, int);
138
139 static int thPushFrame(Th_Interp*, Th_Frame*);
140 static void thPopFrame(Th_Interp*);
141
142 static int thFreeVariable(Th_HashEntry*, void*);
143 static int thFreeCommand(Th_HashEntry*, void*);
144
145 /*
146 ** The following are used by both the expression and language parsers.
147 ** Given that the start of the input string (z, n) is a language
148 ** construct of the relevant type (a command enclosed in [], an escape
149 ** sequence etc.), these functions determine the number of bytes
150 ** of the input consumed by the construct. For example:
151 **
152 ** int nByte;
153 ** thNextCommand(interp, "[expr $a+1] $nIter", 18, &nByte);
154 **
155 ** results in variable nByte being set to 11. Or,
156 **
157 ** thNextVarname(interp, "$a+1", 4, &nByte);
158 **
159 ** results in nByte being set to 2.
160 */
161 static int thNextCommand(Th_Interp*, const char *z, int n, int *pN);
162 static int thNextEscape (Th_Interp*, const char *z, int n, int *pN);
163 static int thNextVarname(Th_Interp*, const char *z, int n, int *pN);
164 static int thNextNumber (Th_Interp*, const char *z, int n, int *pN);
165 static int thNextInteger (Th_Interp*, const char *z, int n, int *pN);
166 static int thNextSpace (Th_Interp*, const char *z, int n, int *pN);
167
168 /*
169 ** Given that the input string (z, n) contains a language construct of
170 ** the relevant type (a command enclosed in [], an escape sequence
171 ** like "\xFF" or a variable reference like "${varname}", perform
172 ** substitution on the string and store the resulting string in
173 ** the interpreter result.
174 */
175 static int thSubstCommand(Th_Interp*, const char *z, int n);
176 static int thSubstEscape (Th_Interp*, const char *z, int n);
177 static int thSubstVarname(Th_Interp*, const char *z, int n);
178
179 /*
180 ** Given that there is a th1 word located at the start of the input
181 ** string (z, n), determine the length in bytes of that word. If the
182 ** isCmd argument is non-zero, then an unescaped ";" byte not
183 ** located inside of a block or quoted string is considered to mark
184 ** the end of the word.
185 */
186 static int thNextWord(Th_Interp*, const char *z, int n, int *pN, int isCmd);
187
188 /*
189 ** Perform substitution on the word contained in the input string (z, n).
190 ** Store the resulting string in the interpreter result.
191 */
192 static int thSubstWord(Th_Interp*, const char *z, int n);
193
194 /*
195 ** The Buffer structure and the thBufferXXX() functions are used to make
196 ** memory allocation easier when building up a result.
197 */
198 struct Buffer {
199 char *zBuf;
200 int nBuf;
201 int nBufAlloc;
202 };
203 typedef struct Buffer Buffer;
204 static void thBufferInit(Buffer *);
205 static void thBufferFree(Th_Interp *interp, Buffer *);
206
207 /*
208 ** This version of memcpy() allows the first and second argument to
209 ** be NULL as long as the number of bytes to copy is zero.
210 */
th_memcpy(void * dest,const void * src,size_t n)211 static void th_memcpy(void *dest, const void *src, size_t n){
212 if( n>0 ) memcpy(dest,src,n);
213 }
214
215 /*
216 ** Append nAdd bytes of content copied from zAdd to the end of buffer
217 ** pBuffer. If there is not enough space currently allocated, resize
218 ** the allocation to make space.
219 */
thBufferWriteResize(Th_Interp * interp,Buffer * pBuffer,const char * zAdd,int nAdd)220 static void thBufferWriteResize(
221 Th_Interp *interp,
222 Buffer *pBuffer,
223 const char *zAdd,
224 int nAdd
225 ){
226 int nNew = (pBuffer->nBuf+nAdd)*2+32;
227 #if defined(TH_MEMDEBUG)
228 char *zNew = (char *)Th_Malloc(interp, nNew);
229 th_memcpy(zNew, pBuffer->zBuf, pBuffer->nBuf);
230 Th_Free(interp, pBuffer->zBuf);
231 pBuffer->zBuf = zNew;
232 #else
233 int nOld = pBuffer->nBufAlloc;
234 pBuffer->zBuf = Th_Realloc(interp, pBuffer->zBuf, nNew);
235 memset(pBuffer->zBuf+nOld, 0, nNew-nOld);
236 #endif
237 pBuffer->nBufAlloc = nNew;
238 th_memcpy(&pBuffer->zBuf[pBuffer->nBuf], zAdd, nAdd);
239 pBuffer->nBuf += nAdd;
240 }
thBufferWriteFast(Th_Interp * interp,Buffer * pBuffer,const char * zAdd,int nAdd)241 static void thBufferWriteFast(
242 Th_Interp *interp,
243 Buffer *pBuffer,
244 const char *zAdd,
245 int nAdd
246 ){
247 if( pBuffer->nBuf+nAdd > pBuffer->nBufAlloc ){
248 thBufferWriteResize(interp, pBuffer, zAdd, nAdd);
249 }else{
250 char *z = pBuffer->zBuf + pBuffer->nBuf;
251 pBuffer->nBuf += nAdd;
252 memcpy(z, zAdd, nAdd);
253 }
254 }
255 #define thBufferWrite(a,b,c,d) thBufferWriteFast(a,b,(const char *)c,d)
256
257 /*
258 ** Add a single character to a buffer
259 */
thBufferAddChar(Th_Interp * interp,Buffer * pBuffer,char c)260 static void thBufferAddChar(
261 Th_Interp *interp,
262 Buffer *pBuffer,
263 char c
264 ){
265 if( pBuffer->nBuf+1 > pBuffer->nBufAlloc ){
266 thBufferWriteResize(interp, pBuffer, &c, 1);
267 }else{
268 pBuffer->zBuf[pBuffer->nBuf++] = c;
269 }
270 }
271
272 /*
273 ** Initialize the Buffer structure pointed to by pBuffer.
274 */
thBufferInit(Buffer * pBuffer)275 static void thBufferInit(Buffer *pBuffer){
276 memset(pBuffer, 0, sizeof(Buffer));
277 }
278
279 /*
280 ** Zero the buffer pointed to by pBuffer and free the associated memory
281 ** allocation.
282 */
thBufferFree(Th_Interp * interp,Buffer * pBuffer)283 static void thBufferFree(Th_Interp *interp, Buffer *pBuffer){
284 Th_Free(interp, pBuffer->zBuf);
285 thBufferInit(pBuffer);
286 }
287
288 /*
289 ** Assuming parameter c contains a hexadecimal digit character,
290 ** return the corresponding value of that digit. If c is not
291 ** a hexadecimal digit character, -1 is returned.
292 */
thHexdigit(char c)293 static int thHexdigit(char c){
294 switch (c) {
295 case '0': return 0;
296 case '1': return 1;
297 case '2': return 2;
298 case '3': return 3;
299 case '4': return 4;
300 case '5': return 5;
301 case '6': return 6;
302 case '7': return 7;
303 case '8': return 8;
304 case '9': return 9;
305 case 'a': case 'A': return 10;
306 case 'b': case 'B': return 11;
307 case 'c': case 'C': return 12;
308 case 'd': case 'D': return 13;
309 case 'e': case 'E': return 14;
310 case 'f': case 'F': return 15;
311 }
312 return -1;
313 }
314
315 /*
316 ** Argument pEntry points to an entry in a stack frame hash table
317 ** (Th_Frame.paVar). Decrement the reference count of the Th_Variable
318 ** structure that the entry points to. Free the Th_Variable if its
319 ** reference count reaches 0.
320 **
321 ** Argument pContext is a pointer to the interpreter structure.
322 **
323 ** Returns non-zero if the Th_Variable was actually freed.
324 */
thFreeVariable(Th_HashEntry * pEntry,void * pContext)325 static int thFreeVariable(Th_HashEntry *pEntry, void *pContext){
326 Th_Variable *pValue = (Th_Variable *)pEntry->pData;
327 pValue->nRef--;
328 assert( pValue->nRef>=0 );
329 if( pValue->nRef==0 ){
330 Th_Interp *interp = (Th_Interp *)pContext;
331 Th_Free(interp, pValue->zData);
332 if( pValue->pHash ){
333 Th_HashIterate(interp, pValue->pHash, thFreeVariable, pContext);
334 Th_HashDelete(interp, pValue->pHash);
335 }
336 Th_Free(interp, pValue);
337 pEntry->pData = 0;
338 return 1;
339 }
340 return 0;
341 }
342
343 /*
344 ** Argument pEntry points to an entry in the command hash table
345 ** (Th_Interp.paCmd). Delete the Th_Command structure that the
346 ** entry points to.
347 **
348 ** Argument pContext is a pointer to the interpreter structure.
349 **
350 ** Always returns non-zero.
351 */
thFreeCommand(Th_HashEntry * pEntry,void * pContext)352 static int thFreeCommand(Th_HashEntry *pEntry, void *pContext){
353 Th_Command *pCommand = (Th_Command *)pEntry->pData;
354 if( pCommand->xDel ){
355 pCommand->xDel((Th_Interp *)pContext, pCommand->pContext);
356 }
357 Th_Free((Th_Interp *)pContext, pEntry->pData);
358 pEntry->pData = 0;
359 return 1;
360 }
361
362 /*
363 ** Argument pEntry points to an entry in a hash table. The key is
364 ** the list element to be added.
365 **
366 ** Argument pContext is a pointer to the Th_InterpAndList structure.
367 **
368 ** Always returns non-zero.
369 */
thListAppendHashKey(Th_HashEntry * pEntry,void * pContext)370 static int thListAppendHashKey(Th_HashEntry *pEntry, void *pContext){
371 Th_InterpAndList *pInterpAndList = (Th_InterpAndList *)pContext;
372 Th_ListAppend(pInterpAndList->interp, pInterpAndList->pzList,
373 pInterpAndList->pnList, pEntry->zKey, pEntry->nKey);
374 return 1;
375 }
376
377 /*
378 ** Push a new frame onto the stack.
379 */
thPushFrame(Th_Interp * interp,Th_Frame * pFrame)380 static int thPushFrame(Th_Interp *interp, Th_Frame *pFrame){
381 pFrame->paVar = Th_HashNew(interp);
382 pFrame->pCaller = interp->pFrame;
383 interp->pFrame = pFrame;
384 return TH_OK;
385 }
386
387 /*
388 ** Pop a frame off the top of the stack.
389 */
thPopFrame(Th_Interp * interp)390 static void thPopFrame(Th_Interp *interp){
391 Th_Frame *pFrame = interp->pFrame;
392 Th_HashIterate(interp, pFrame->paVar, thFreeVariable, (void *)interp);
393 Th_HashDelete(interp, pFrame->paVar);
394 interp->pFrame = pFrame->pCaller;
395 }
396
397 /*
398 ** The first part of the string (zInput,nInput) contains an escape
399 ** sequence. Set *pnEscape to the number of bytes in the escape sequence.
400 ** If there is a parse error, return TH_ERROR and set the interpreter
401 ** result to an error message. Otherwise return TH_OK.
402 */
thNextEscape(Th_Interp * interp,const char * zInput,int nInput,int * pnEscape)403 static int thNextEscape(
404 Th_Interp *interp,
405 const char *zInput,
406 int nInput,
407 int *pnEscape
408 ){
409 int i = 2;
410
411 assert(nInput>0);
412 assert(zInput[0]=='\\');
413
414 if( nInput<=1 ){
415 return TH_ERROR;
416 }
417
418 switch( zInput[1] ){
419 case 'x': i = 4;
420 }
421
422 if( i>nInput ){
423 return TH_ERROR;
424 }
425 *pnEscape = i;
426 return TH_OK;
427 }
428
429 /*
430 ** The first part of the string (zInput,nInput) contains a variable
431 ** reference. Set *pnVarname to the number of bytes in the variable
432 ** reference. If there is a parse error, return TH_ERROR and set the
433 ** interpreter result to an error message. Otherwise return TH_OK.
434 */
thNextVarname(Th_Interp * interp,const char * zInput,int nInput,int * pnVarname)435 int thNextVarname(
436 Th_Interp *interp,
437 const char *zInput,
438 int nInput,
439 int *pnVarname
440 ){
441 int i;
442
443 assert(nInput>0);
444 assert(zInput[0]=='$');
445
446 if( nInput>0 && zInput[1]=='{' ){
447 for(i=2; i<nInput && zInput[i]!='}'; i++);
448 if( i==nInput ){
449 return TH_ERROR;
450 }
451 i++;
452 }else{
453 i = 1;
454 if( nInput>2 && zInput[1]==':' && zInput[2]==':' ){
455 i += 2;
456 }
457 for(; i<nInput; i++){
458 if( zInput[i]=='(' ){
459 for(i++; i<nInput; i++){
460 if( zInput[i]==')' ) break;
461 if( zInput[i]=='\\' ) i++;
462 if( zInput[i]=='{' || zInput[i]=='[' || zInput[i]=='"' ){
463 int nWord;
464 int rc = thNextWord(interp, &zInput[i], nInput-i, &nWord, 0);
465 if( rc!=TH_OK ){
466 return rc;
467 }
468 i += nWord;
469 }
470 }
471 if( i>=nInput ){
472 Th_ErrorMessage(interp, "Unmatched brackets:", zInput, nInput);
473 return TH_ERROR;
474 }
475 i++;
476 break;
477 }
478 if( !th_isalnum(zInput[i]) && zInput[i]!='_' ) break;
479 }
480 }
481
482 *pnVarname = i;
483 return TH_OK;
484 }
485
486 /*
487 ** The first part of the string (zInput,nInput) contains a command
488 ** enclosed in a "[]" block. Set *pnCommand to the number of bytes in
489 ** the variable reference. If there is a parse error, return TH_ERROR
490 ** and set the interpreter result to an error message. Otherwise return
491 ** TH_OK.
492 */
thNextCommand(Th_Interp * interp,const char * zInput,int nInput,int * pnCommand)493 int thNextCommand(
494 Th_Interp *interp,
495 const char *zInput,
496 int nInput,
497 int *pnCommand
498 ){
499 int nBrace = 0;
500 int nSquare = 0;
501 int i;
502
503 assert(nInput>0);
504 assert( zInput[0]=='[' || zInput[0]=='{' );
505
506 for(i=0; i<nInput && (i==0 || nBrace>0 || nSquare>0); i++){
507 switch( zInput[i] ){
508 case '\\': i++; break;
509 case '{': nBrace++; break;
510 case '}': nBrace--; break;
511 case '[': nSquare++; break;
512 case ']': nSquare--; break;
513 }
514 }
515 if( nBrace || nSquare ){
516 return TH_ERROR;
517 }
518
519 *pnCommand = i;
520
521 return TH_OK;
522 }
523
524 /*
525 ** Set *pnSpace to the number of whitespace bytes at the start of
526 ** input string (zInput, nInput). Always return TH_OK.
527 */
thNextSpace(Th_Interp * interp,const char * zInput,int nInput,int * pnSpace)528 int thNextSpace(
529 Th_Interp *interp,
530 const char *zInput,
531 int nInput,
532 int *pnSpace
533 ){
534 int i;
535 for(i=0; i<nInput && th_isspace(zInput[i]); i++);
536 *pnSpace = i;
537 return TH_OK;
538 }
539
540 /*
541 ** The first byte of the string (zInput,nInput) is not white-space.
542 ** Set *pnWord to the number of bytes in the th1 word that starts
543 ** with this byte. If a complete word cannot be parsed or some other
544 ** error occurs, return TH_ERROR and set the interpreter result to
545 ** an error message. Otherwise return TH_OK.
546 **
547 ** If the isCmd argument is non-zero, then an unescaped ";" byte not
548 ** located inside of a block or quoted string is considered to mark
549 ** the end of the word.
550 */
thNextWord(Th_Interp * interp,const char * zInput,int nInput,int * pnWord,int isCmd)551 static int thNextWord(
552 Th_Interp *interp,
553 const char *zInput,
554 int nInput,
555 int *pnWord,
556 int isCmd
557 ){
558 int iEnd = 0;
559
560 assert( !th_isspace(zInput[0]) );
561
562 if( zInput[0]=='"' ){
563 /* The word is terminated by the next unescaped '"' character. */
564 iEnd++;
565 while( iEnd<nInput && zInput[iEnd]!='"' ){
566 if( zInput[iEnd]=='\\' ){
567 iEnd++;
568 }
569 iEnd++;
570 }
571 iEnd++;
572 }else{
573 int nBrace = 0;
574 int nSq = 0;
575 while( iEnd<nInput && (nBrace>0 || nSq>0 ||
576 (!th_isspace(zInput[iEnd]) && (!isCmd || zInput[iEnd]!=';'))
577 )){
578 switch( zInput[iEnd] ){
579 case '\\': iEnd++; break;
580 case '{': if( nSq==0 ) nBrace++; break;
581 case '}': if( nSq==0 ) nBrace--; break;
582 case '[': if( nBrace==0 ) nSq++; break;
583 case ']': if( nBrace==0 ) nSq--; break;
584 }
585 iEnd++;
586 }
587 if( nBrace>0 || nSq>0 ){
588 /* Parse error */
589 Th_SetResult(interp, "parse error", -1);
590 return TH_ERROR;
591 }
592 }
593
594 if( iEnd>nInput ){
595 /* Parse error */
596 Th_SetResult(interp, "parse error", -1);
597 return TH_ERROR;
598 }
599 *pnWord = iEnd;
600 return TH_OK;
601 }
602
603 /*
604 ** The input string (zWord, nWord) contains a th1 script enclosed in
605 ** a [] block. Perform substitution on the input string and store the
606 ** resulting string in the interpreter result.
607 */
thSubstCommand(Th_Interp * interp,const char * zWord,int nWord)608 static int thSubstCommand(
609 Th_Interp *interp,
610 const char *zWord,
611 int nWord
612 ){
613 assert(nWord>=2);
614 assert(zWord[0]=='[' && zWord[nWord-1]==']');
615 return thEvalLocal(interp, &zWord[1], nWord-2);
616 }
617
618 /*
619 ** The input string (zWord, nWord) contains a th1 variable reference
620 ** (a '$' byte followed by a variable name). Perform substitution on
621 ** the input string and store the resulting string in the interpreter
622 ** result.
623 */
thSubstVarname(Th_Interp * interp,const char * zWord,int nWord)624 static int thSubstVarname(
625 Th_Interp *interp,
626 const char *zWord,
627 int nWord
628 ){
629 assert(nWord>=1);
630 assert(zWord[0]=='$');
631 assert(nWord==1 || zWord[1]!='{' || zWord[nWord-1]=='}');
632 if( nWord>1 && zWord[1]=='{' ){
633 zWord++;
634 nWord -= 2;
635 }else if( zWord[nWord-1]==')' ){
636 int i;
637 for(i=1; i<nWord && zWord[i]!='('; i++);
638 if( i<nWord ){
639 Buffer varname;
640 int nInner;
641 const char *zInner;
642
643 int rc = thSubstWord(interp, &zWord[i+1], nWord-i-2);
644 if( rc!=TH_OK ) return rc;
645
646 zInner = Th_GetResult(interp, &nInner);
647 thBufferInit(&varname);
648 thBufferWrite(interp, &varname, &zWord[1], i);
649 thBufferWrite(interp, &varname, zInner, nInner);
650 thBufferAddChar(interp, &varname, ')');
651 rc = Th_GetVar(interp, varname.zBuf, varname.nBuf);
652 thBufferFree(interp, &varname);
653 return rc;
654 }
655 }
656 return Th_GetVar(interp, &zWord[1], nWord-1);
657 }
658
659 /*
660 ** The input string (zWord, nWord) contains a th1 escape sequence.
661 ** Perform substitution on the input string and store the resulting
662 ** string in the interpreter result.
663 */
thSubstEscape(Th_Interp * interp,const char * zWord,int nWord)664 static int thSubstEscape(
665 Th_Interp *interp,
666 const char *zWord,
667 int nWord
668 ){
669 char c;
670
671 assert(nWord>=2);
672 assert(zWord[0]=='\\');
673
674 switch( zWord[1] ){
675 case 'x': {
676 assert(nWord==4);
677 c = ((thHexdigit(zWord[2])<<4) + thHexdigit(zWord[3]));
678 break;
679 }
680 case 'n': {
681 c = '\n';
682 break;
683 }
684 default: {
685 assert(nWord==2);
686 c = zWord[1];
687 break;
688 }
689 }
690
691 Th_SetResult(interp, &c, 1);
692 return TH_OK;
693 }
694
695 /*
696 ** The input string (zWord, nWord) contains a th1 word. Perform
697 ** substitution on the input string and store the resulting
698 ** string in the interpreter result.
699 */
thSubstWord(Th_Interp * interp,const char * zWord,int nWord)700 static int thSubstWord(
701 Th_Interp *interp,
702 const char *zWord,
703 int nWord
704 ){
705 int rc = TH_OK;
706 Buffer output;
707 int i;
708
709 thBufferInit(&output);
710
711 if( nWord>1 && (zWord[0]=='{' && zWord[nWord-1]=='}') ){
712 thBufferWrite(interp, &output, &zWord[1], nWord-2);
713 }else{
714
715 /* If the word is surrounded by double-quotes strip these away. */
716 if( nWord>1 && (zWord[0]=='"' && zWord[nWord-1]=='"') ){
717 zWord++;
718 nWord -= 2;
719 }
720
721 for(i=0; rc==TH_OK && i<nWord; i++){
722 int nGet;
723
724 int (*xGet)(Th_Interp *, const char*, int, int *) = 0;
725 int (*xSubst)(Th_Interp *, const char*, int) = 0;
726
727 switch( zWord[i] ){
728 case '\\':
729 xGet = thNextEscape; xSubst = thSubstEscape;
730 break;
731 case '[':
732 if( !interp->isListMode ){
733 xGet = thNextCommand; xSubst = thSubstCommand;
734 break;
735 }
736 case '$':
737 if( !interp->isListMode ){
738 xGet = thNextVarname; xSubst = thSubstVarname;
739 break;
740 }
741 default: {
742 thBufferAddChar(interp, &output, zWord[i]);
743 continue; /* Go to the next iteration of the for(...) loop */
744 }
745 }
746
747 rc = xGet(interp, &zWord[i], nWord-i, &nGet);
748 if( rc==TH_OK ){
749 rc = xSubst(interp, &zWord[i], nGet);
750 }
751 if( rc==TH_OK ){
752 const char *zRes;
753 int nRes;
754 zRes = Th_GetResult(interp, &nRes);
755 thBufferWrite(interp, &output, zRes, nRes);
756 i += (nGet-1);
757 }
758 }
759 }
760
761 if( rc==TH_OK ){
762 Th_SetResult(interp, output.zBuf, output.nBuf);
763 }
764 thBufferFree(interp, &output);
765 return rc;
766 }
767
768 /*
769 ** Return true if one of the following is true of the buffer pointed
770 ** to by zInput, length nInput:
771 **
772 ** + It is empty, or
773 ** + It contains nothing but white-space, or
774 ** + It contains no non-white-space characters before the first
775 ** newline character.
776 **
777 ** Otherwise return false.
778 */
thEndOfLine(const char * zInput,int nInput)779 static int thEndOfLine(const char *zInput, int nInput){
780 int i;
781 for(i=0; i<nInput && zInput[i]!='\n' && th_isspace(zInput[i]); i++);
782 return ((i==nInput || zInput[i]=='\n')?1:0);
783 }
784
785 /*
786 ** This function splits the supplied th1 list (contained in buffer zList,
787 ** size nList) into elements and performs word-substitution on each
788 ** element. If the Th_Interp.isListMode variable is true, then only
789 ** escape sequences are substituted (used by the Th_SplitList() function).
790 ** If Th_Interp.isListMode is false, then variable and command substitution
791 ** is also performed (used by Th_Eval()).
792 **
793 ** If zList/nList does not contain a valid list, TH_ERROR is returned
794 ** and an error message stored in interp.
795 **
796 ** If TH_OK is returned and pazElem is not NULL, the caller should free the
797 ** pointer written to (*pazElem) using Th_Free(). This releases memory
798 ** allocated for both the (*pazElem) and (*panElem) arrays. Example:
799 **
800 ** char **argv;
801 ** int *argl;
802 ** int argc;
803 **
804 ** // After this call, argv and argl point to valid arrays. The
805 ** // number of elements in each is argc.
806 ** //
807 ** Th_SplitList(interp, zList, nList, &argv, &argl, &argc);
808 **
809 ** // Free all memory allocated by Th_SplitList(). The arrays pointed
810 ** // to by argv and argl are invalidated by this call.
811 ** //
812 ** Th_Free(interp, argv);
813 **
814 */
thSplitList(Th_Interp * interp,const char * zList,int nList,char *** pazElem,int ** panElem,int * pnCount)815 static int thSplitList(
816 Th_Interp *interp, /* Interpreter context */
817 const char *zList, /* Pointer to buffer containing input list */
818 int nList, /* Size of buffer pointed to by zList */
819 char ***pazElem, /* OUT: Array of list elements */
820 int **panElem, /* OUT: Lengths of each list element */
821 int *pnCount /* OUT: Number of list elements */
822 ){
823 int rc = TH_OK;
824
825 Buffer strbuf;
826 Buffer lenbuf;
827 int nCount = 0;
828
829 const char *zInput = zList;
830 int nInput = nList;
831
832 thBufferInit(&strbuf);
833 thBufferInit(&lenbuf);
834
835 while( nInput>0 ){
836 const char *zWord;
837 int nWord;
838
839 thNextSpace(interp, zInput, nInput, &nWord);
840 zInput += nWord;
841 nInput = nList-(zInput-zList);
842
843 if( TH_OK!=(rc = thNextWord(interp, zInput, nInput, &nWord, 0))
844 || TH_OK!=(rc = thSubstWord(interp, zInput, nWord))
845 ){
846 goto finish;
847 }
848 zInput = &zInput[nWord];
849 nInput = nList-(zInput-zList);
850 if( nWord>0 ){
851 zWord = Th_GetResult(interp, &nWord);
852 thBufferWrite(interp, &strbuf, zWord, nWord);
853 thBufferAddChar(interp, &strbuf, 0);
854 thBufferWrite(interp, &lenbuf, &nWord, sizeof(int));
855 nCount++;
856 }
857 }
858 assert((lenbuf.nBuf/sizeof(int))==nCount);
859
860 assert((pazElem && panElem) || (!pazElem && !panElem));
861 if( pazElem && rc==TH_OK ){
862 int i;
863 char *zElem;
864 int *anElem;
865 char **azElem = Th_Malloc(interp,
866 sizeof(char*) * nCount + /* azElem */
867 sizeof(int) * nCount + /* anElem */
868 strbuf.nBuf /* space for list element strings */
869 );
870 anElem = (int *)&azElem[nCount];
871 zElem = (char *)&anElem[nCount];
872 th_memcpy(anElem, lenbuf.zBuf, lenbuf.nBuf);
873 th_memcpy(zElem, strbuf.zBuf, strbuf.nBuf);
874 for(i=0; i<nCount;i++){
875 azElem[i] = zElem;
876 zElem += (anElem[i] + 1);
877 }
878 *pazElem = azElem;
879 *panElem = anElem;
880 }
881 if( pnCount ){
882 *pnCount = nCount;
883 }
884
885 finish:
886 thBufferFree(interp, &strbuf);
887 thBufferFree(interp, &lenbuf);
888 return rc;
889 }
890
891 /*
892 ** Evaluate the th1 script contained in the string (zProgram, nProgram)
893 ** in the current stack frame.
894 */
thEvalLocal(Th_Interp * interp,const char * zProgram,int nProgram)895 static int thEvalLocal(Th_Interp *interp, const char *zProgram, int nProgram){
896 int rc = TH_OK;
897 const char *zInput = zProgram;
898 int nInput = nProgram;
899
900 while( rc==TH_OK && nInput ){
901 Th_HashEntry *pEntry;
902 int nSpace;
903 const char *zFirst;
904
905 char **argv;
906 int *argl;
907 int argc;
908
909 assert(nInput>=0);
910
911 /* Skip a semi-colon */
912 if( *zInput==';' ){
913 zInput++;
914 nInput--;
915 }
916
917 /* Skip past leading white-space. */
918 thNextSpace(interp, zInput, nInput, &nSpace);
919 zInput += nSpace;
920 nInput -= nSpace;
921 zFirst = zInput;
922
923 /* Check for a comment. If found, skip to the end of the line. */
924 if( zInput[0]=='#' ){
925 while( !thEndOfLine(zInput, nInput) ){
926 zInput++;
927 nInput--;
928 }
929 continue;
930 }
931
932 /* Gobble up input a word at a time until the end of the command
933 ** (a semi-colon or end of line).
934 */
935 while( rc==TH_OK && *zInput!=';' && !thEndOfLine(zInput, nInput) ){
936 int nWord=0;
937 thNextSpace(interp, zInput, nInput, &nSpace);
938 rc = thNextWord(interp, &zInput[nSpace], nInput-nSpace, &nWord, 1);
939 zInput += (nSpace+nWord);
940 nInput -= (nSpace+nWord);
941 }
942 if( rc!=TH_OK ) continue;
943
944 /* Split the command into an array of words. This call also does
945 ** substitution of each individual word.
946 */
947 rc = thSplitList(interp, zFirst, zInput-zFirst, &argv, &argl, &argc);
948 if( rc!=TH_OK ) continue;
949
950 if( argc>0 ){
951
952 /* Look up the command name in the command hash-table. */
953 pEntry = Th_HashFind(interp, interp->paCmd, argv[0], argl[0], 0);
954 if( !pEntry ){
955 Th_ErrorMessage(interp, "no such command: ", argv[0], argl[0]);
956 rc = TH_ERROR;
957 }
958
959 /* Call the command procedure. */
960 if( rc==TH_OK ){
961 Th_Command *p = (Th_Command *)(pEntry->pData);
962 const char **azArg = (const char **)argv;
963 rc = p->xProc(interp, p->pContext, argc, azArg, argl);
964 }
965
966 /* If an error occurred, add this command to the stack trace report. */
967 if( rc==TH_ERROR ){
968 char *zRes;
969 int nRes;
970 char *zStack = 0;
971 int nStack = 0;
972
973 zRes = Th_TakeResult(interp, &nRes);
974 if( TH_OK==Th_GetVar(interp, (char *)"::th_stack_trace", -1) ){
975 zStack = Th_TakeResult(interp, &nStack);
976 }
977 Th_ListAppend(interp, &zStack, &nStack, zFirst, zInput-zFirst);
978 Th_SetVar(interp, (char *)"::th_stack_trace", -1, zStack, nStack);
979 Th_SetResult(interp, zRes, nRes);
980 Th_Free(interp, zRes);
981 Th_Free(interp, zStack);
982 }
983 }
984
985 Th_Free(interp, argv);
986 }
987
988 return rc;
989 }
990
991 /*
992 ** Interpret an integer frame identifier passed to either Th_Eval() or
993 ** Th_LinkVar(). If successful, return a pointer to the identified
994 ** Th_Frame structure. If unsuccessful (no such frame), return 0 and
995 ** leave an error message in the interpreter result.
996 **
997 ** Argument iFrame is interpreted as follows:
998 **
999 ** * If iFrame is 0, this means the current frame.
1000 **
1001 ** * If iFrame is negative, then the nth frame up the stack, where
1002 ** n is the absolute value of iFrame. A value of -1 means the
1003 ** calling procedure.
1004 **
1005 ** * If iFrame is +ve, then the nth frame from the bottom of the
1006 ** stack. An iFrame value of 1 means the toplevel (global) frame.
1007 */
getFrame(Th_Interp * interp,int iFrame)1008 static Th_Frame *getFrame(Th_Interp *interp, int iFrame){
1009 Th_Frame *p = interp->pFrame;
1010 int i;
1011 if( iFrame>0 ){
1012 for(i=0; p; i++){
1013 p = p->pCaller;
1014 }
1015 iFrame = (i*-1) + iFrame;
1016 p = interp->pFrame;
1017 }
1018 for(i=0; p && i<(iFrame*-1); i++){
1019 p = p->pCaller;
1020 }
1021
1022 if( !p ){
1023 char *zFrame;
1024 int nFrame;
1025 Th_SetResultInt(interp, iFrame);
1026 zFrame = Th_TakeResult(interp, &nFrame);
1027 Th_ErrorMessage(interp, "no such frame:", zFrame, nFrame);
1028 Th_Free(interp, zFrame);
1029 }
1030 return p;
1031 }
1032
1033
1034 /*
1035 ** Evaluate th1 script (zProgram, nProgram) in the frame identified by
1036 ** argument iFrame. Leave either an error message or a result in the
1037 ** interpreter result and return a th1 error code (TH_OK, TH_ERROR,
1038 ** TH_RETURN, TH_CONTINUE or TH_BREAK).
1039 */
Th_Eval(Th_Interp * interp,int iFrame,const char * zProgram,int nProgram)1040 int Th_Eval(Th_Interp *interp, int iFrame, const char *zProgram, int nProgram){
1041 int rc = TH_OK;
1042 Th_Frame *pSavedFrame = interp->pFrame;
1043
1044 /* Set Th_Interp.pFrame to the frame that this script is to be
1045 ** evaluated in. The current frame is saved in pSavedFrame and will
1046 ** be restored before this function returns.
1047 */
1048 interp->pFrame = getFrame(interp, iFrame);
1049
1050 if( !interp->pFrame ){
1051 rc = TH_ERROR;
1052 }else{
1053 int nInput = nProgram;
1054
1055 if( nInput<0 ){
1056 nInput = th_strlen(zProgram);
1057 }
1058 rc = thEvalLocal(interp, zProgram, nInput);
1059 }
1060
1061 interp->pFrame = pSavedFrame;
1062 return rc;
1063 }
1064
1065 /*
1066 ** Input string (zVarname, nVarname) contains a th1 variable name. It
1067 ** may be a simple scalar variable name or it may be a reference
1068 ** to an array member. The variable name may or may not begin with
1069 ** "::", indicating that the name refers to a global variable, not
1070 ** a local scope one.
1071 **
1072 ** This function inspects and categorizes the supplied variable name.
1073 **
1074 ** If the name is a global reference, *pisGlobal is set to true. Otherwise
1075 ** false. Output string (*pzOuter, *pnOuter) is set to the variable name
1076 ** if it is a scalar reference, or the name of the array if it is an
1077 ** array variable. If the variable is a scalar, *pzInner is set to 0.
1078 ** If it is an array variable, (*pzInner, *pnInner) is set to the
1079 ** array key name.
1080 */
thAnalyseVarname(const char * zVarname,int nVarname,const char ** pzOuter,int * pnOuter,const char ** pzInner,int * pnInner,int * pisGlobal)1081 static int thAnalyseVarname(
1082 const char *zVarname,
1083 int nVarname,
1084 const char **pzOuter, /* OUT: Pointer to scalar/array name */
1085 int *pnOuter, /* OUT: Number of bytes at *pzOuter */
1086 const char **pzInner, /* OUT: Pointer to array key (or null) */
1087 int *pnInner, /* OUT: Number of bytes at *pzInner */
1088 int *pisGlobal /* OUT: Set to true if this is a global ref */
1089 ){
1090 const char *zOuter = zVarname;
1091 int nOuter;
1092 const char *zInner = 0;
1093 int nInner = 0;
1094 int isGlobal = 0;
1095 int i;
1096
1097 if( nVarname<0 ){
1098 nVarname = th_strlen(zVarname);
1099 }
1100 nOuter = nVarname;
1101
1102 /* If the variable name starts with "::", then do the lookup is in the
1103 ** uppermost (global) frame.
1104 */
1105 if( nVarname>2 && zVarname[0]==':' && zVarname[1]==':' ){
1106 zOuter += 2;
1107 nOuter -= 2;
1108 isGlobal = 1;
1109 }
1110
1111 /* Check if this is an array reference. */
1112 if( zOuter[nOuter-1]==')' ){
1113 for(i=0; i<nOuter; i++){
1114 if( zOuter[i]=='(' ){
1115 zInner = &zOuter[i+1];
1116 nInner = nOuter-i-2;
1117 nOuter = i;
1118 break;
1119 }
1120 }
1121 }
1122
1123 *pzOuter = zOuter;
1124 *pnOuter = nOuter;
1125 *pzInner = zInner;
1126 *pnInner = nInner;
1127 *pisGlobal = isGlobal;
1128 return TH_OK;
1129 }
1130
1131 /*
1132 ** The Find structure is used to return extra information to callers of the
1133 ** thFindValue function. The fields within it are populated by thFindValue
1134 ** as soon as the necessary information is available. Callers should check
1135 ** each field of interest upon return.
1136 */
1137
1138 struct Find {
1139 Th_HashEntry *pValueEntry; /* Pointer to the scalar or array hash entry */
1140 Th_HashEntry *pElemEntry; /* Pointer to array element hash entry, if any */
1141 const char *zElem; /* Name of array element, if applicable */
1142 int nElem; /* Length of array element name, if applicable */
1143 };
1144 typedef struct Find Find;
1145
1146 /*
1147 ** Input string (zVar, nVar) contains a variable name. This function locates
1148 ** the Th_Variable structure associated with the named variable. The
1149 ** variable name may be a global or local scalar or array variable
1150 **
1151 ** If the create argument is non-zero and the named variable does not exist
1152 ** it is created. Otherwise, an error is left in the interpreter result
1153 ** and NULL returned.
1154 **
1155 ** If the arrayok argument is false and the named variable is an array,
1156 ** an error is left in the interpreter result and NULL returned. If
1157 ** arrayok is true an array name is OK.
1158 */
1159
thFindValue(Th_Interp * interp,const char * zVar,int nVar,int create,int arrayok,int noerror,Find * pFind)1160 static Th_Variable *thFindValue(
1161 Th_Interp *interp,
1162 const char *zVar, /* Pointer to variable name */
1163 int nVar, /* Number of bytes at nVar */
1164 int create, /* If true, create the variable if not found */
1165 int arrayok, /* If true, an array is OK. Otherwise array==error */
1166 int noerror, /* If false, set interpreter result to error */
1167 Find *pFind /* If non-zero, place output here */
1168 ){
1169 const char *zOuter;
1170 int nOuter;
1171 const char *zInner;
1172 int nInner;
1173 int isGlobal;
1174
1175 Th_HashEntry *pEntry;
1176 Th_Frame *pFrame = interp->pFrame;
1177 Th_Variable *pValue;
1178
1179 thAnalyseVarname(zVar, nVar, &zOuter, &nOuter, &zInner, &nInner, &isGlobal);
1180 if( pFind ){
1181 memset(pFind, 0, sizeof(Find));
1182 pFind->zElem = zInner;
1183 pFind->nElem = nInner;
1184 }
1185 if( isGlobal ){
1186 while( pFrame->pCaller ) pFrame = pFrame->pCaller;
1187 }
1188
1189 pEntry = Th_HashFind(interp, pFrame->paVar, zOuter, nOuter, create);
1190 assert(pEntry || create<=0);
1191 if( pFind ){
1192 pFind->pValueEntry = pEntry;
1193 }
1194 if( !pEntry ){
1195 goto no_such_var;
1196 }
1197
1198 pValue = (Th_Variable *)pEntry->pData;
1199 if( !pValue ){
1200 assert(create);
1201 pValue = Th_Malloc(interp, sizeof(Th_Variable));
1202 pValue->nRef = 1;
1203 pEntry->pData = (void *)pValue;
1204 }
1205
1206 if( zInner ){
1207 if( pValue->zData ){
1208 if( !noerror ){
1209 Th_ErrorMessage(interp, "variable is a scalar:", zOuter, nOuter);
1210 }
1211 return 0;
1212 }
1213 if( !pValue->pHash ){
1214 if( !create ){
1215 goto no_such_var;
1216 }
1217 pValue->pHash = Th_HashNew(interp);
1218 }
1219 pEntry = Th_HashFind(interp, pValue->pHash, zInner, nInner, create);
1220 assert(pEntry || create<=0);
1221 if( pFind ){
1222 pFind->pElemEntry = pEntry;
1223 }
1224 if( !pEntry ){
1225 goto no_such_var;
1226 }
1227 pValue = (Th_Variable *)pEntry->pData;
1228 if( !pValue ){
1229 assert(create);
1230 pValue = Th_Malloc(interp, sizeof(Th_Variable));
1231 pValue->nRef = 1;
1232 pEntry->pData = (void *)pValue;
1233 }
1234 }else{
1235 if( pValue->pHash && !arrayok ){
1236 if( !noerror ){
1237 Th_ErrorMessage(interp, "variable is an array:", zOuter, nOuter);
1238 }
1239 return 0;
1240 }
1241 }
1242
1243 return pValue;
1244
1245 no_such_var:
1246 if( !noerror ){
1247 Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
1248 }
1249 return 0;
1250 }
1251
1252 /*
1253 ** String (zVar, nVar) must contain the name of a scalar variable or
1254 ** array member. Look up the variable, store its current value in
1255 ** the interpreter result and return TH_OK.
1256 **
1257 ** If the named variable does not exist, return TH_ERROR and leave
1258 ** an error message in the interpreter result.
1259 */
Th_GetVar(Th_Interp * interp,const char * zVar,int nVar)1260 int Th_GetVar(Th_Interp *interp, const char *zVar, int nVar){
1261 Th_Variable *pValue;
1262
1263 pValue = thFindValue(interp, zVar, nVar, 0, 0, 0, 0);
1264 if( !pValue ){
1265 return TH_ERROR;
1266 }
1267 if( !pValue->zData ){
1268 Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
1269 return TH_ERROR;
1270 }
1271
1272 return Th_SetResult(interp, pValue->zData, pValue->nData);
1273 }
1274
1275 /*
1276 ** Return true if variable (zVar, nVar) exists.
1277 */
Th_ExistsVar(Th_Interp * interp,const char * zVar,int nVar)1278 int Th_ExistsVar(Th_Interp *interp, const char *zVar, int nVar){
1279 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
1280 return pValue && (pValue->zData || pValue->pHash);
1281 }
1282
1283 /*
1284 ** Return true if array variable (zVar, nVar) exists.
1285 */
Th_ExistsArrayVar(Th_Interp * interp,const char * zVar,int nVar)1286 int Th_ExistsArrayVar(Th_Interp *interp, const char *zVar, int nVar){
1287 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
1288 return pValue && !pValue->zData && pValue->pHash;
1289 }
1290
1291 /*
1292 ** String (zVar, nVar) must contain the name of a scalar variable or
1293 ** array member. If the variable does not exist it is created. The
1294 ** variable is set to the value supplied in string (zValue, nValue).
1295 **
1296 ** If (zVar, nVar) refers to an existing array, TH_ERROR is returned
1297 ** and an error message left in the interpreter result.
1298 */
Th_SetVar(Th_Interp * interp,const char * zVar,int nVar,const char * zValue,int nValue)1299 int Th_SetVar(
1300 Th_Interp *interp,
1301 const char *zVar,
1302 int nVar,
1303 const char *zValue,
1304 int nValue
1305 ){
1306 Th_Variable *pValue;
1307
1308 pValue = thFindValue(interp, zVar, nVar, 1, 0, 0, 0);
1309 if( !pValue ){
1310 return TH_ERROR;
1311 }
1312
1313 if( nValue<0 ){
1314 nValue = th_strlen(zValue);
1315 }
1316 if( pValue->zData ){
1317 Th_Free(interp, pValue->zData);
1318 pValue->zData = 0;
1319 }
1320
1321 assert(zValue || nValue==0);
1322 pValue->zData = Th_Malloc(interp, nValue+1);
1323 pValue->zData[nValue] = '\0';
1324 th_memcpy(pValue->zData, zValue, nValue);
1325 pValue->nData = nValue;
1326
1327 return TH_OK;
1328 }
1329
1330 /*
1331 ** Create a variable link so that accessing variable (zLocal, nLocal) is
1332 ** the same as accessing variable (zLink, nLink) in stack frame iFrame.
1333 */
Th_LinkVar(Th_Interp * interp,const char * zLocal,int nLocal,int iFrame,const char * zLink,int nLink)1334 int Th_LinkVar(
1335 Th_Interp *interp, /* Interpreter */
1336 const char *zLocal, int nLocal, /* Local varname */
1337 int iFrame, /* Stack frame of linked var */
1338 const char *zLink, int nLink /* Linked varname */
1339 ){
1340 Th_Frame *pSavedFrame = interp->pFrame;
1341 Th_Frame *pFrame;
1342 Th_HashEntry *pEntry;
1343 Th_Variable *pValue;
1344
1345 pFrame = getFrame(interp, iFrame);
1346 if( !pFrame ){
1347 return TH_ERROR;
1348 }
1349 pSavedFrame = interp->pFrame;
1350 interp->pFrame = pFrame;
1351 pValue = thFindValue(interp, zLink, nLink, 1, 1, 0, 0);
1352 interp->pFrame = pSavedFrame;
1353
1354 pEntry = Th_HashFind(interp, interp->pFrame->paVar, zLocal, nLocal, 1);
1355 if( pEntry->pData ){
1356 Th_ErrorMessage(interp, "variable exists:", zLocal, nLocal);
1357 return TH_ERROR;
1358 }
1359 pEntry->pData = (void *)pValue;
1360 pValue->nRef++;
1361
1362 return TH_OK;
1363 }
1364
1365 /*
1366 ** Input string (zVar, nVar) must contain the name of a scalar variable,
1367 ** an array, or an array member. If the identified variable exists, it
1368 ** is deleted and TH_OK returned. Otherwise, an error message is left
1369 ** in the interpreter result and TH_ERROR is returned.
1370 */
Th_UnsetVar(Th_Interp * interp,const char * zVar,int nVar)1371 int Th_UnsetVar(Th_Interp *interp, const char *zVar, int nVar){
1372 Find find;
1373 Th_Variable *pValue;
1374 Th_HashEntry *pEntry;
1375 int rc = TH_ERROR;
1376
1377 pValue = thFindValue(interp, zVar, nVar, 0, 1, 0, &find);
1378 if( !pValue ){
1379 return rc;
1380 }
1381
1382 if( pValue->zData || pValue->pHash ){
1383 rc = TH_OK;
1384 }else {
1385 Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
1386 }
1387
1388 /*
1389 ** The variable may be shared by more than one frame; therefore, make sure
1390 ** it is actually freed prior to freeing the parent structure. The values
1391 ** for the variable must be freed now so the variable appears undefined in
1392 ** all frames. The hash entry in the current frame must also be deleted
1393 ** now; otherwise, if the current stack frame is later popped, it will try
1394 ** to delete a variable which has already been freed.
1395 */
1396 if( find.zElem ){
1397 pEntry = find.pElemEntry;
1398 }else{
1399 pEntry = find.pValueEntry;
1400 }
1401 assert( pEntry );
1402 assert( pValue );
1403 if( thFreeVariable(pEntry, (void *)interp) ){
1404 if( find.zElem ){
1405 Th_Variable *pValue2 = find.pValueEntry->pData;
1406 Th_HashFind(interp, pValue2->pHash, find.zElem, find.nElem, -1);
1407 }else if( pEntry->pData ){
1408 Th_Free(interp, pEntry->pData);
1409 pEntry->pData = 0;
1410 }
1411 }else{
1412 if( pValue->zData ){
1413 Th_Free(interp, pValue->zData);
1414 pValue->zData = 0;
1415 }
1416 if( pValue->pHash ){
1417 Th_HashIterate(interp, pValue->pHash, thFreeVariable, (void *)interp);
1418 Th_HashDelete(interp, pValue->pHash);
1419 pValue->pHash = 0;
1420 }
1421 if( find.zElem ){
1422 Th_Variable *pValue2 = find.pValueEntry->pData;
1423 Th_HashFind(interp, pValue2->pHash, find.zElem, find.nElem, -1);
1424 }
1425 }
1426 if( !find.zElem ){
1427 Th_HashFind(interp, interp->pFrame->paVar, zVar, nVar, -1);
1428 }
1429 return rc;
1430 }
1431
1432 /*
1433 ** Return an allocated buffer containing a copy of string (z, n). The
1434 ** caller is responsible for eventually calling Th_Free() to free
1435 ** the returned buffer.
1436 */
th_strdup(Th_Interp * interp,const char * z,int n)1437 char *th_strdup(Th_Interp *interp, const char *z, int n){
1438 char *zRes;
1439 if( n<0 ){
1440 n = th_strlen(z);
1441 }
1442 zRes = Th_Malloc(interp, n+1);
1443 th_memcpy(zRes, z, n);
1444 zRes[n] = '\0';
1445 return zRes;
1446 }
1447
1448 /*
1449 ** Argument zPre must be a nul-terminated string. Set the interpreter
1450 ** result to a string containing the contents of zPre, followed by
1451 ** a space (" ") character, followed by a copy of string (z, n).
1452 **
1453 ** In other words, the equivalent of:
1454 *
1455 ** printf("%s %.*s", zPre, n, z);
1456 **
1457 ** Example:
1458 **
1459 ** Th_ErrorMessage(interp, "no such variable:", zVarname, nVarname);
1460 **
1461 */
Th_ErrorMessage(Th_Interp * interp,const char * zPre,const char * z,int n)1462 int Th_ErrorMessage(Th_Interp *interp, const char *zPre, const char *z, int n){
1463 if( interp ){
1464 char *zRes = 0;
1465 int nRes = 0;
1466
1467 Th_SetVar(interp, (char *)"::th_stack_trace", -1, 0, 0);
1468
1469 Th_StringAppend(interp, &zRes, &nRes, zPre, -1);
1470 if( zRes[nRes-1]=='"' ){
1471 Th_StringAppend(interp, &zRes, &nRes, z, n);
1472 Th_StringAppend(interp, &zRes, &nRes, (const char *)"\"", 1);
1473 }else{
1474 Th_StringAppend(interp, &zRes, &nRes, (const char *)" ", 1);
1475 Th_StringAppend(interp, &zRes, &nRes, z, n);
1476 }
1477
1478 Th_SetResult(interp, zRes, nRes);
1479 Th_Free(interp, zRes);
1480 }
1481
1482 return TH_OK;
1483 }
1484
1485 /*
1486 ** Set the current interpreter result by taking a copy of the buffer
1487 ** pointed to by z, size n bytes. TH_OK is always returned.
1488 */
Th_SetResult(Th_Interp * pInterp,const char * z,int n)1489 int Th_SetResult(Th_Interp *pInterp, const char *z, int n){
1490
1491 /* Free the current result */
1492 Th_Free(pInterp, pInterp->zResult);
1493 pInterp->zResult = 0;
1494 pInterp->nResult = 0;
1495
1496 if( n<0 ){
1497 n = th_strlen(z);
1498 }
1499
1500 if( z && n>0 ){
1501 char *zResult;
1502 zResult = Th_Malloc(pInterp, n+1);
1503 th_memcpy(zResult, z, n);
1504 zResult[n] = '\0';
1505 pInterp->zResult = zResult;
1506 pInterp->nResult = n;
1507 }
1508
1509 return TH_OK;
1510 }
1511
1512 /*
1513 ** Return a pointer to the buffer containing the current interpreter
1514 ** result. If pN is not NULL, set *pN to the size of the returned
1515 ** buffer.
1516 */
Th_GetResult(Th_Interp * pInterp,int * pN)1517 const char *Th_GetResult(Th_Interp *pInterp, int *pN){
1518 assert(pInterp->zResult || pInterp->nResult==0);
1519 if( pN ){
1520 *pN = pInterp->nResult;
1521 }
1522 return (pInterp->zResult ? pInterp->zResult : (const char *)"");
1523 }
1524
1525 /*
1526 ** Return a pointer to the buffer containing the current interpreter
1527 ** result. If pN is not NULL, set *pN to the size of the returned
1528 ** buffer.
1529 **
1530 ** This function is the same as Th_GetResult() except that the
1531 ** caller is responsible for eventually calling Th_Free() on the
1532 ** returned buffer. The internal interpreter result is cleared
1533 ** after this function is called.
1534 */
Th_TakeResult(Th_Interp * pInterp,int * pN)1535 char *Th_TakeResult(Th_Interp *pInterp, int *pN){
1536 if( pN ){
1537 *pN = pInterp->nResult;
1538 }
1539 if( pInterp->zResult ){
1540 char *zResult = pInterp->zResult;
1541 pInterp->zResult = 0;
1542 pInterp->nResult = 0;
1543 return zResult;
1544 }else{
1545 return (char *)Th_Malloc(pInterp, 1);
1546 }
1547 }
1548
1549 #if defined(TH_MEMDEBUG)
1550 /*
1551 ** Wrappers around the supplied malloc() and free()
1552 */
Th_DbgMalloc(Th_Interp * pInterp,int nByte)1553 void *Th_DbgMalloc(Th_Interp *pInterp, int nByte){
1554 void *p;
1555 Th_Vtab *pVtab = pInterp->pVtab;
1556 if( pVtab ){
1557 p = pVtab->xMalloc(nByte);
1558 if( p ) memset(p, 0, nByte);
1559 }else{
1560 p = Th_SysMalloc(pInterp, nByte);
1561 }
1562 return p;
1563 }
Th_DbgFree(Th_Interp * pInterp,void * z)1564 void Th_DbgFree(Th_Interp *pInterp, void *z){
1565 if( z ){
1566 Th_Vtab *pVtab = pInterp->pVtab;
1567 if( pVtab ){
1568 pVtab->xFree(z);
1569 }else{
1570 Th_SysFree(pInterp, z);
1571 }
1572 }
1573 }
1574 #endif
1575
1576 /*
1577 ** Install a new th1 command.
1578 **
1579 ** If a command of the same name already exists, it is deleted automatically.
1580 */
Th_CreateCommand(Th_Interp * interp,const char * zName,Th_CommandProc xProc,void * pContext,void (* xDel)(Th_Interp *,void *))1581 int Th_CreateCommand(
1582 Th_Interp *interp,
1583 const char *zName, /* New command name */
1584 Th_CommandProc xProc, /* Command callback proc */
1585 void *pContext, /* Value to pass as second arg to xProc */
1586 void (*xDel)(Th_Interp *, void *) /* Command destructor callback */
1587 ){
1588 Th_HashEntry *pEntry;
1589 Th_Command *pCommand;
1590
1591 pEntry = Th_HashFind(interp, interp->paCmd, (const char *)zName, -1, 1);
1592 if( pEntry->pData ){
1593 pCommand = pEntry->pData;
1594 if( pCommand->xDel ){
1595 pCommand->xDel(interp, pCommand->pContext);
1596 }
1597 }else{
1598 pCommand = Th_Malloc(interp, sizeof(Th_Command));
1599 }
1600 pCommand->xProc = xProc;
1601 pCommand->pContext = pContext;
1602 pCommand->xDel = xDel;
1603 pEntry->pData = (void *)pCommand;
1604
1605 return TH_OK;
1606 }
1607
1608 /*
1609 ** Rename the existing command (zName, nName) to (zNew, nNew). If nNew is 0,
1610 ** the command is deleted instead of renamed.
1611 **
1612 ** If successful, TH_OK is returned. If command zName does not exist, or
1613 ** if command zNew already exists, an error message is left in the
1614 ** interpreter result and TH_ERROR is returned.
1615 */
Th_RenameCommand(Th_Interp * interp,const char * zName,int nName,const char * zNew,int nNew)1616 int Th_RenameCommand(
1617 Th_Interp *interp,
1618 const char *zName, /* Existing command name */
1619 int nName, /* Number of bytes at zName */
1620 const char *zNew, /* New command name */
1621 int nNew /* Number of bytes at zNew */
1622 ){
1623 Th_HashEntry *pEntry;
1624 Th_HashEntry *pNewEntry;
1625
1626 pEntry = Th_HashFind(interp, interp->paCmd, zName, nName, 0);
1627 if( !pEntry ){
1628 Th_ErrorMessage(interp, "no such command:", zName, nName);
1629 return TH_ERROR;
1630 }
1631 assert(pEntry->pData);
1632
1633 if( nNew>0 ){
1634 pNewEntry = Th_HashFind(interp, interp->paCmd, zNew, nNew, 1);
1635 if( pNewEntry->pData ){
1636 Th_ErrorMessage(interp, "command exists:", zNew, nNew);
1637 return TH_ERROR;
1638 }
1639 pNewEntry->pData = pEntry->pData;
1640 }else{
1641 Th_Command *pCommand = (Th_Command *)(pEntry->pData);
1642 if( pCommand->xDel ){
1643 pCommand->xDel(interp, pCommand->pContext);
1644 }
1645 Th_Free(interp, pCommand);
1646 }
1647
1648 Th_HashFind(interp, interp->paCmd, zName, nName, -1);
1649 return TH_OK;
1650 }
1651
1652 /*
1653 ** Push a stack frame onto the interpreter stack, invoke the
1654 ** callback, and pop the frame back off again. See the implementation
1655 ** of [proc] (th_lang.c) for an example.
1656 */
Th_InFrame(Th_Interp * interp,int (* xCall)(Th_Interp *,void * pContext1,void * pContext2),void * pContext1,void * pContext2)1657 int Th_InFrame(Th_Interp *interp,
1658 int (*xCall)(Th_Interp *, void *pContext1, void *pContext2),
1659 void *pContext1,
1660 void *pContext2
1661 ){
1662 Th_Frame frame;
1663 int rc;
1664 thPushFrame(interp, &frame);
1665 rc = xCall(interp, pContext1, pContext2);
1666 thPopFrame(interp);
1667 return rc;
1668 }
1669
1670 /*
1671 ** Split a th1 list into its component elements. The list to split is
1672 ** passed via arguments (zList, nList). If successful, TH_OK is returned.
1673 ** If an error occurs (if (zList, nList) is not a valid list) an error
1674 ** message is left in the interpreter result and TH_ERROR returned.
1675 **
1676 ** If successful, *pnCount is set to the number of elements in the list.
1677 ** panElem is set to point at an array of *pnCount integers - the lengths
1678 ** of the element values. *pazElem is set to point at an array of
1679 ** pointers to buffers containing the array element's data.
1680 **
1681 ** To free the arrays allocated at *pazElem and *panElem, the caller
1682 ** should call Th_Free() on *pazElem only. Exactly one such call to
1683 ** Th_Free() must be made per call to Th_SplitList().
1684 **
1685 ** Example:
1686 **
1687 ** int nElem;
1688 ** int *anElem;
1689 ** char **azElem;
1690 ** int i;
1691 **
1692 ** Th_SplitList(interp, zList, nList, &azElem, &anElem, &nElem);
1693 ** for(i=0; i<nElem; i++){
1694 ** int nData = anElem[i];
1695 ** char *zData = azElem[i];
1696 ** ...
1697 ** }
1698 **
1699 ** Th_Free(interp, azElem);
1700 **
1701 */
Th_SplitList(Th_Interp * interp,const char * zList,int nList,char *** pazElem,int ** panElem,int * pnCount)1702 int Th_SplitList(
1703 Th_Interp *interp,
1704 const char *zList, /* Pointer to buffer containing list */
1705 int nList, /* Number of bytes at zList */
1706 char ***pazElem, /* OUT: Array of pointers to element data */
1707 int **panElem, /* OUT: Array of element data lengths */
1708 int *pnCount /* OUT: Number of elements in list */
1709 ){
1710 int rc;
1711 interp->isListMode = 1;
1712 rc = thSplitList(interp, zList, nList, pazElem, panElem, pnCount);
1713 interp->isListMode = 0;
1714 if( rc ){
1715 Th_ErrorMessage(interp, "Expected list, got: \"", zList, nList);
1716 }
1717 return rc;
1718 }
1719
1720 /*
1721 ** Append a new element to an existing th1 list. The element to append
1722 ** to the list is (zElem, nElem).
1723 **
1724 ** A pointer to the existing list must be stored at *pzList when this
1725 ** function is called. The length must be stored in *pnList. The value
1726 ** of *pzList must either be NULL (in which case *pnList must be 0), or
1727 ** a pointer to memory obtained from Th_Malloc().
1728 **
1729 ** This function calls Th_Free() to free the buffer at *pzList and sets
1730 ** *pzList to point to a new buffer containing the new list value. *pnList
1731 ** is similarly updated before returning. The return value is always TH_OK.
1732 **
1733 ** Example:
1734 **
1735 ** char *zList = 0;
1736 ** int nList = 0;
1737 ** for (...) {
1738 ** char *zElem = <some expression>;
1739 ** Th_ListAppend(interp, &zList, &nList, zElem, -1);
1740 ** }
1741 ** Th_SetResult(interp, zList, nList);
1742 ** Th_Free(interp, zList);
1743 **
1744 */
Th_ListAppend(Th_Interp * interp,char ** pzList,int * pnList,const char * zElem,int nElem)1745 int Th_ListAppend(
1746 Th_Interp *interp, /* Interpreter context */
1747 char **pzList, /* IN/OUT: Ptr to ptr to list */
1748 int *pnList, /* IN/OUT: Current length of *pzList */
1749 const char *zElem, /* Data to append */
1750 int nElem /* Length of nElem */
1751 ){
1752 Buffer output;
1753 int i;
1754
1755 int hasSpecialChar = 0;
1756 int hasEscapeChar = 0;
1757 int nBrace = 0;
1758
1759 output.zBuf = *pzList;
1760 output.nBuf = *pnList;
1761 output.nBufAlloc = output.nBuf;
1762
1763 if( nElem<0 ){
1764 nElem = th_strlen(zElem);
1765 }
1766 if( output.nBuf>0 ){
1767 thBufferAddChar(interp, &output, ' ');
1768 }
1769
1770 for(i=0; i<nElem; i++){
1771 char c = zElem[i];
1772 if( th_isspecial(c) ) hasSpecialChar = 1;
1773 if( c=='\\' ) hasEscapeChar = 1;
1774 if( c=='{' ) nBrace++;
1775 if( c=='}' ) nBrace--;
1776 }
1777
1778 if( nElem==0 || (!hasEscapeChar && hasSpecialChar && nBrace==0) ){
1779 thBufferAddChar(interp, &output, '{');
1780 thBufferWrite(interp, &output, zElem, nElem);
1781 thBufferAddChar(interp, &output, '}');
1782 }else{
1783 for(i=0; i<nElem; i++){
1784 char c = zElem[i];
1785 if( th_isspecial(c) ) thBufferAddChar(interp, &output, '\\');
1786 thBufferAddChar(interp, &output, c);
1787 }
1788 }
1789
1790 *pzList = output.zBuf;
1791 *pnList = output.nBuf;
1792
1793 return TH_OK;
1794 }
1795
1796 /*
1797 ** Append a new element to an existing th1 string. This function uses
1798 ** the same interface as the Th_ListAppend() function.
1799 */
Th_StringAppend(Th_Interp * interp,char ** pzStr,int * pnStr,const char * zElem,int nElem)1800 int Th_StringAppend(
1801 Th_Interp *interp, /* Interpreter context */
1802 char **pzStr, /* IN/OUT: Ptr to ptr to list */
1803 int *pnStr, /* IN/OUT: Current length of *pzStr */
1804 const char *zElem, /* Data to append */
1805 int nElem /* Length of nElem */
1806 ){
1807 char *zNew;
1808 int nNew;
1809
1810 if( nElem<0 ){
1811 nElem = th_strlen(zElem);
1812 }
1813
1814 nNew = *pnStr + nElem;
1815 zNew = Th_Malloc(interp, nNew);
1816 th_memcpy(zNew, *pzStr, *pnStr);
1817 th_memcpy(&zNew[*pnStr], zElem, nElem);
1818
1819 Th_Free(interp, *pzStr);
1820 *pzStr = zNew;
1821 *pnStr = nNew;
1822
1823 return TH_OK;
1824 }
1825
1826 /*
1827 ** Initialize an interpreter.
1828 */
thInitialize(Th_Interp * interp)1829 static int thInitialize(Th_Interp *interp){
1830 assert(interp->pFrame);
1831
1832 Th_SetVar(interp, (char *)"::tcl_platform(engine)", -1, TH_ENGINE, -1);
1833 Th_SetVar(interp, (char *)"::tcl_platform(platform)", -1, TH_PLATFORM, -1);
1834
1835 return TH_OK;
1836 }
1837
1838 /*
1839 ** Delete an interpreter.
1840 */
Th_DeleteInterp(Th_Interp * interp)1841 void Th_DeleteInterp(Th_Interp *interp){
1842 assert(interp->pFrame);
1843 assert(0==interp->pFrame->pCaller);
1844
1845 /* Delete the contents of the global frame. */
1846 thPopFrame(interp);
1847
1848 /* Delete any result currently stored in the interpreter. */
1849 Th_SetResult(interp, 0, 0);
1850
1851 /* Delete all registered commands and the command hash-table itself. */
1852 Th_HashIterate(interp, interp->paCmd, thFreeCommand, (void *)interp);
1853 Th_HashDelete(interp, interp->paCmd);
1854
1855 /* Delete the interpreter structure itself. */
1856 Th_Free(interp, (void *)interp);
1857 }
1858
1859 /*
1860 ** Create a new interpreter.
1861 */
Th_CreateInterp(Th_Vtab * pVtab)1862 Th_Interp * Th_CreateInterp(Th_Vtab *pVtab){
1863 int nByte = sizeof(Th_Interp) + sizeof(Th_Frame);
1864 Th_Interp *p;
1865
1866 /* Allocate and initialise the interpreter and the global frame */
1867 #if defined(TH_MEMDEBUG)
1868 if( pVtab ){
1869 p = pVtab->xMalloc(nByte);
1870 memset(p, 0, nByte);
1871 p->pVtab = pVtab;
1872 }else
1873 #endif
1874 p = Th_SysMalloc(0, nByte);
1875
1876 p->paCmd = Th_HashNew(p);
1877 thPushFrame(p, (Th_Frame *)&p[1]);
1878 thInitialize(p);
1879
1880 return p;
1881 }
1882
1883 /*
1884 ** These two types are used only by the expression module, where
1885 ** the expression module means the Th_Expr() and exprXXX() functions.
1886 */
1887 typedef struct Operator Operator;
1888 struct Operator {
1889 const char *zOp;
1890 int nOp;
1891 int eOp;
1892 int iPrecedence;
1893 int eArgType;
1894 };
1895 typedef struct Expr Expr;
1896 struct Expr {
1897 Operator *pOp;
1898 Expr *pParent;
1899 Expr *pLeft;
1900 Expr *pRight;
1901
1902 char *zValue; /* Pointer to literal value */
1903 int nValue; /* Length of literal value buffer */
1904 };
1905
1906 /* Unary operators */
1907 #define OP_UNARY_MINUS 2
1908 #define OP_UNARY_PLUS 3
1909 #define OP_BITWISE_NOT 4
1910 #define OP_LOGICAL_NOT 5
1911
1912 /* Binary operators */
1913 #define OP_MULTIPLY 6
1914 #define OP_DIVIDE 7
1915 #define OP_MODULUS 8
1916 #define OP_ADD 9
1917 #define OP_SUBTRACT 10
1918 #define OP_LEFTSHIFT 11
1919 #define OP_RIGHTSHIFT 12
1920 #define OP_LT 13
1921 #define OP_GT 14
1922 #define OP_LE 15
1923 #define OP_GE 16
1924 #define OP_EQ 17
1925 #define OP_NE 18
1926 #define OP_SEQ 19
1927 #define OP_SNE 20
1928 #define OP_BITWISE_AND 21
1929 #define OP_BITWISE_XOR 22
1930 #define OP_BITWISE_OR 24
1931 #define OP_LOGICAL_AND 25
1932 #define OP_LOGICAL_OR 26
1933
1934 /* Other symbols */
1935 #define OP_OPEN_BRACKET 27
1936 #define OP_CLOSE_BRACKET 28
1937
1938 /* Argument types. Each operator in the expression syntax is defined
1939 ** as requiring either integer, number (real or integer) or string
1940 ** operands.
1941 */
1942 #define ARG_INTEGER 1
1943 #define ARG_NUMBER 2
1944 #define ARG_STRING 3
1945
1946 static Operator aOperator[] = {
1947
1948 {"(", 1, OP_OPEN_BRACKET, -1, 0},
1949 {")", 1, OP_CLOSE_BRACKET, -1, 0},
1950
1951 /* Note: all unary operators have (iPrecedence==1) */
1952 {"-", 1, OP_UNARY_MINUS, 1, ARG_NUMBER},
1953 {"+", 1, OP_UNARY_PLUS, 1, ARG_NUMBER},
1954 {"~", 1, OP_BITWISE_NOT, 1, ARG_INTEGER},
1955 {"!", 1, OP_LOGICAL_NOT, 1, ARG_INTEGER},
1956
1957 /* Binary operators. It is important to the parsing in Th_Expr() that
1958 * the two-character symbols ("==") appear before the one-character
1959 * ones ("="). And that the priorities of all binary operators are
1960 * integers between 2 and 12.
1961 */
1962 {"<<", 2, OP_LEFTSHIFT, 4, ARG_INTEGER},
1963 {">>", 2, OP_RIGHTSHIFT, 4, ARG_INTEGER},
1964 {"<=", 2, OP_LE, 5, ARG_NUMBER},
1965 {">=", 2, OP_GE, 5, ARG_NUMBER},
1966 {"==", 2, OP_EQ, 6, ARG_NUMBER},
1967 {"!=", 2, OP_NE, 6, ARG_NUMBER},
1968 {"eq", 2, OP_SEQ, 7, ARG_STRING},
1969 {"ne", 2, OP_SNE, 7, ARG_STRING},
1970 {"&&", 2, OP_LOGICAL_AND, 11, ARG_INTEGER},
1971 {"||", 2, OP_LOGICAL_OR, 12, ARG_INTEGER},
1972
1973 {"*", 1, OP_MULTIPLY, 2, ARG_NUMBER},
1974 {"/", 1, OP_DIVIDE, 2, ARG_NUMBER},
1975 {"%", 1, OP_MODULUS, 2, ARG_INTEGER},
1976 {"+", 1, OP_ADD, 3, ARG_NUMBER},
1977 {"-", 1, OP_SUBTRACT, 3, ARG_NUMBER},
1978 {"<", 1, OP_LT, 5, ARG_NUMBER},
1979 {">", 1, OP_GT, 5, ARG_NUMBER},
1980 {"&", 1, OP_BITWISE_AND, 8, ARG_INTEGER},
1981 {"^", 1, OP_BITWISE_XOR, 9, ARG_INTEGER},
1982 {"|", 1, OP_BITWISE_OR, 10, ARG_INTEGER},
1983
1984 {0,0,0,0,0}
1985 };
1986
1987 /*
1988 ** The first part of the string (zInput,nInput) contains an integer.
1989 ** Set *pnVarname to the number of bytes in the numeric string.
1990 */
thNextInteger(Th_Interp * interp,const char * zInput,int nInput,int * pnLiteral)1991 static int thNextInteger(
1992 Th_Interp *interp,
1993 const char *zInput,
1994 int nInput,
1995 int *pnLiteral
1996 ){
1997 int i;
1998 int (*isdigit)(char) = th_isdigit;
1999 char c;
2000
2001 if( nInput<2) return TH_ERROR;
2002 assert(zInput[0]=='0');
2003 c = zInput[1];
2004 if( c>='A' && c<='Z' ) c += 'a' - 'A';
2005 if( c=='x' ){
2006 isdigit = th_ishexdig;
2007 }else if( c!='o' && c!='b' ){
2008 return TH_ERROR;
2009 }
2010 for(i=2; i<nInput; i++){
2011 c = zInput[i];
2012 if( !isdigit(c) ){
2013 break;
2014 }
2015 }
2016 *pnLiteral = i;
2017 return TH_OK;
2018 }
2019
2020 /*
2021 ** The first part of the string (zInput,nInput) contains a number.
2022 ** Set *pnVarname to the number of bytes in the numeric string.
2023 */
thNextNumber(Th_Interp * interp,const char * zInput,int nInput,int * pnLiteral)2024 static int thNextNumber(
2025 Th_Interp *interp,
2026 const char *zInput,
2027 int nInput,
2028 int *pnLiteral
2029 ){
2030 int i = 0;
2031 int seenDot = 0;
2032 for(; i<nInput; i++){
2033 char c = zInput[i];
2034 if( (seenDot || c!='.') && !th_isdigit(c) ) break;
2035 if( c=='.' ) seenDot = 1;
2036 }
2037 *pnLiteral = i;
2038 return TH_OK;
2039 }
2040
2041 /*
2042 ** Free an expression tree.
2043 */
exprFree(Th_Interp * interp,Expr * pExpr)2044 static void exprFree(Th_Interp *interp, Expr *pExpr){
2045 if( pExpr ){
2046 exprFree(interp, pExpr->pLeft);
2047 exprFree(interp, pExpr->pRight);
2048 Th_Free(interp, pExpr->zValue);
2049 Th_Free(interp, pExpr);
2050 }
2051 }
2052
2053 /*
2054 ** Evaluate an expression tree.
2055 */
exprEval(Th_Interp * interp,Expr * pExpr)2056 static int exprEval(Th_Interp *interp, Expr *pExpr){
2057 int rc = TH_OK;
2058
2059 if( pExpr->pOp==0 ){
2060 /* A literal */
2061 rc = thSubstWord(interp, pExpr->zValue, pExpr->nValue);
2062 }else{
2063 int eArgType = 0; /* Actual type of arguments */
2064
2065 /* Argument values */
2066 int iLeft = 0;
2067 int iRight = 0;
2068 double fLeft;
2069 double fRight;
2070
2071 /* Left and right arguments as strings */
2072 char *zLeft = 0; int nLeft = 0;
2073 char *zRight = 0; int nRight = 0;
2074
2075 /* Evaluate left and right arguments, if they exist. */
2076 if( pExpr->pLeft ){
2077 rc = exprEval(interp, pExpr->pLeft);
2078 if( rc==TH_OK ){
2079 zLeft = Th_TakeResult(interp, &nLeft);
2080 }
2081 }
2082 if( rc==TH_OK && pExpr->pRight ){
2083 rc = exprEval(interp, pExpr->pRight);
2084 if( rc==TH_OK ){
2085 zRight = Th_TakeResult(interp, &nRight);
2086 }
2087 }
2088
2089 /* Convert arguments to their required forms. */
2090 if( rc==TH_OK ){
2091 eArgType = pExpr->pOp->eArgType;
2092 if( eArgType==ARG_NUMBER ){
2093 if( (zLeft==0 || TH_OK==Th_ToInt(0, zLeft, nLeft, &iLeft))
2094 && (zRight==0 || TH_OK==Th_ToInt(0, zRight, nRight, &iRight))
2095 ){
2096 eArgType = ARG_INTEGER;
2097 }else if(
2098 (zLeft && TH_OK!=Th_ToDouble(interp, zLeft, nLeft, &fLeft)) ||
2099 (zRight && TH_OK!=Th_ToDouble(interp, zRight, nRight, &fRight))
2100 ){
2101 /* A type error. */
2102 rc = TH_ERROR;
2103 }
2104 }else if( eArgType==ARG_INTEGER ){
2105 rc = Th_ToInt(interp, zLeft, nLeft, &iLeft);
2106 if( rc==TH_OK && zRight ){
2107 rc = Th_ToInt(interp, zRight, nRight, &iRight);
2108 }
2109 }
2110 }
2111
2112 if( rc==TH_OK && eArgType==ARG_INTEGER ){
2113 int iRes = 0;
2114 switch( pExpr->pOp->eOp ) {
2115 case OP_MULTIPLY: iRes = iLeft*iRight; break;
2116 case OP_DIVIDE:
2117 if( !iRight ){
2118 Th_ErrorMessage(interp, "Divide by 0:", zLeft, nLeft);
2119 rc = TH_ERROR;
2120 goto finish;
2121 }
2122 iRes = iLeft/iRight;
2123 break;
2124 case OP_MODULUS:
2125 if( !iRight ){
2126 Th_ErrorMessage(interp, "Modulo by 0:", zLeft, nLeft);
2127 rc = TH_ERROR;
2128 goto finish;
2129 }
2130 iRes = iLeft%iRight;
2131 break;
2132 case OP_ADD: iRes = iLeft+iRight; break;
2133 case OP_SUBTRACT: iRes = iLeft-iRight; break;
2134 case OP_LEFTSHIFT: iRes = iLeft<<iRight; break;
2135 case OP_RIGHTSHIFT: iRes = iLeft>>iRight; break;
2136 case OP_LT: iRes = iLeft<iRight; break;
2137 case OP_GT: iRes = iLeft>iRight; break;
2138 case OP_LE: iRes = iLeft<=iRight; break;
2139 case OP_GE: iRes = iLeft>=iRight; break;
2140 case OP_EQ: iRes = iLeft==iRight; break;
2141 case OP_NE: iRes = iLeft!=iRight; break;
2142 case OP_BITWISE_AND: iRes = iLeft&iRight; break;
2143 case OP_BITWISE_XOR: iRes = iLeft^iRight; break;
2144 case OP_BITWISE_OR: iRes = iLeft|iRight; break;
2145 case OP_LOGICAL_AND: iRes = iLeft&&iRight; break;
2146 case OP_LOGICAL_OR: iRes = iLeft||iRight; break;
2147 case OP_UNARY_MINUS: iRes = -iLeft; break;
2148 case OP_UNARY_PLUS: iRes = +iLeft; break;
2149 case OP_BITWISE_NOT: iRes = ~iLeft; break;
2150 case OP_LOGICAL_NOT: iRes = !iLeft; break;
2151 default: assert(!"Internal error");
2152 }
2153 Th_SetResultInt(interp, iRes);
2154 }else if( rc==TH_OK && eArgType==ARG_NUMBER ){
2155 switch( pExpr->pOp->eOp ) {
2156 case OP_MULTIPLY: Th_SetResultDouble(interp, fLeft*fRight); break;
2157 case OP_DIVIDE:
2158 if( fRight==0.0 ){
2159 Th_ErrorMessage(interp, "Divide by 0:", zLeft, nLeft);
2160 rc = TH_ERROR;
2161 goto finish;
2162 }
2163 Th_SetResultDouble(interp, fLeft/fRight);
2164 break;
2165 case OP_ADD: Th_SetResultDouble(interp, fLeft+fRight); break;
2166 case OP_SUBTRACT: Th_SetResultDouble(interp, fLeft-fRight); break;
2167 case OP_LT: Th_SetResultInt(interp, fLeft<fRight); break;
2168 case OP_GT: Th_SetResultInt(interp, fLeft>fRight); break;
2169 case OP_LE: Th_SetResultInt(interp, fLeft<=fRight); break;
2170 case OP_GE: Th_SetResultInt(interp, fLeft>=fRight); break;
2171 case OP_EQ: Th_SetResultInt(interp, fLeft==fRight); break;
2172 case OP_NE: Th_SetResultInt(interp, fLeft!=fRight); break;
2173 case OP_UNARY_MINUS: Th_SetResultDouble(interp, -fLeft); break;
2174 case OP_UNARY_PLUS: Th_SetResultDouble(interp, +fLeft); break;
2175 default: assert(!"Internal error");
2176 }
2177 }else if( rc==TH_OK ){
2178 int iEqual = 0;
2179 assert( eArgType==ARG_STRING );
2180 if( nRight==nLeft && 0==memcmp(zRight, zLeft, nRight) ){
2181 iEqual = 1;
2182 }
2183 switch( pExpr->pOp->eOp ) {
2184 case OP_SEQ: Th_SetResultInt(interp, iEqual); break;
2185 case OP_SNE: Th_SetResultInt(interp, !iEqual); break;
2186 default: assert(!"Internal error");
2187 }
2188 }
2189
2190 finish:
2191
2192 Th_Free(interp, zLeft);
2193 Th_Free(interp, zRight);
2194 }
2195
2196 return rc;
2197 }
2198
2199 /*
2200 ** Create an expression tree from an array of tokens. If successful,
2201 ** the root of the tree is stored in apToken[0].
2202 */
exprMakeTree(Th_Interp * interp,Expr ** apToken,int nToken)2203 int exprMakeTree(Th_Interp *interp, Expr **apToken, int nToken){
2204 int iLeft;
2205 int i;
2206 int jj;
2207
2208 assert(nToken>0);
2209 #define ISTERM(x) (apToken[x] && (!apToken[x]->pOp || apToken[x]->pLeft))
2210
2211 for(jj=0; jj<nToken; jj++){
2212 if( apToken[jj]->pOp && apToken[jj]->pOp->eOp==OP_OPEN_BRACKET ){
2213 int nNest = 1;
2214 int iLeft = jj;
2215
2216 for(jj++; jj<nToken; jj++){
2217 Operator *pOp = apToken[jj]->pOp;
2218 if( pOp && pOp->eOp==OP_OPEN_BRACKET ) nNest++;
2219 if( pOp && pOp->eOp==OP_CLOSE_BRACKET ) nNest--;
2220 if( nNest==0 ) break;
2221 }
2222 if( jj==nToken ){
2223 return TH_ERROR;
2224 }
2225 if( (jj-iLeft)>1 ){
2226 if( exprMakeTree(interp, &apToken[iLeft+1], jj-iLeft-1) ){
2227 return TH_ERROR;
2228 }
2229 exprFree(interp, apToken[jj]);
2230 exprFree(interp, apToken[iLeft]);
2231 apToken[jj] = 0;
2232 apToken[iLeft] = 0;
2233 }
2234 }
2235 }
2236
2237 iLeft = 0;
2238 for(jj=nToken-1; jj>=0; jj--){
2239 if( apToken[jj] ){
2240 if( apToken[jj]->pOp && apToken[jj]->pOp->iPrecedence==1
2241 && iLeft>0 && ISTERM(iLeft) ){
2242 apToken[jj]->pLeft = apToken[iLeft];
2243 apToken[jj]->pLeft->pParent = apToken[jj];
2244 apToken[iLeft] = 0;
2245 }
2246 iLeft = jj;
2247 }
2248 }
2249 for(i=2; i<=12; i++){
2250 iLeft = -1;
2251 for(jj=0; jj<nToken; jj++){
2252 Expr *pToken = apToken[jj];
2253 if( apToken[jj] ){
2254 if( pToken->pOp && !pToken->pLeft && pToken->pOp->iPrecedence==i ){
2255 int iRight = jj+1;
2256 for(; !apToken[iRight] && iRight<nToken; iRight++);
2257 if( iRight==nToken || iLeft<0 || !ISTERM(iRight) || !ISTERM(iLeft) ){
2258 return TH_ERROR;
2259 }
2260 pToken->pLeft = apToken[iLeft];
2261 apToken[iLeft] = 0;
2262 pToken->pLeft->pParent = pToken;
2263 pToken->pRight = apToken[iRight];
2264 apToken[iRight] = 0;
2265 pToken->pRight->pParent = pToken;
2266 }
2267 iLeft = jj;
2268 }
2269 }
2270 }
2271 for(jj=1; jj<nToken; jj++){
2272 assert( !apToken[jj] || !apToken[0] );
2273 if( apToken[jj] ){
2274 apToken[0] = apToken[jj];
2275 apToken[jj] = 0;
2276 }
2277 }
2278
2279 return TH_OK;
2280 }
2281
2282 /*
2283 ** Parse a string containing a TH expression to a list of tokens.
2284 */
exprParse(Th_Interp * interp,const char * zExpr,int nExpr,Expr *** papToken,int * pnToken)2285 static int exprParse(
2286 Th_Interp *interp, /* Interpreter to leave error message in */
2287 const char *zExpr, /* Pointer to input string */
2288 int nExpr, /* Number of bytes at zExpr */
2289 Expr ***papToken, /* OUT: Array of tokens. */
2290 int *pnToken /* OUT: Size of token array */
2291 ){
2292 int i;
2293
2294 int rc = TH_OK;
2295 int nNest = 0;
2296 int nToken = 0;
2297 Expr **apToken = 0;
2298
2299 for(i=0; rc==TH_OK && i<nExpr; ){
2300 char c = zExpr[i];
2301 if( th_isspace(c) ){ /* White-space */
2302 i++;
2303 }else{
2304 Expr *pNew = (Expr *)Th_Malloc(interp, sizeof(Expr));
2305 const char *z = &zExpr[i];
2306
2307 switch (c) {
2308 case '0':
2309 if( thNextInteger(interp, z, nExpr-i, &pNew->nValue)==TH_OK ){
2310 break;
2311 }
2312 /* fall through */
2313 case '1': case '2': case '3': case '4': case '5':
2314 case '6': case '7': case '8': case '9':
2315 thNextNumber(interp, z, nExpr-i, &pNew->nValue);
2316 break;
2317
2318 case '$':
2319 thNextVarname(interp, z, nExpr-i, &pNew->nValue);
2320 break;
2321
2322 case '{': case '[': {
2323 thNextCommand(interp, z, nExpr-i, &pNew->nValue);
2324 break;
2325 }
2326
2327 case '"': {
2328 int iEnd = i;
2329 while( ++iEnd<nExpr && zExpr[iEnd]!='"' ){
2330 if( zExpr[iEnd]=='\\' ) iEnd++;
2331 }
2332 if( iEnd<nExpr ){
2333 pNew->nValue = iEnd+1-i;
2334 }
2335 break;
2336 }
2337
2338 default: {
2339 int j;
2340 const char *zOp;
2341 for(j=0; (zOp=aOperator[j].zOp); j++){
2342 int nOp = aOperator[j].nOp;
2343 int nRemain = nExpr - i;
2344 int isMatch = 0;
2345 if( nRemain>=nOp && 0==memcmp(zOp, &zExpr[i], nOp) ){
2346 isMatch = 1;
2347 }
2348 if( isMatch ){
2349 if( aOperator[j].eOp==OP_CLOSE_BRACKET ){
2350 nNest--;
2351 }else if( nRemain>nOp ){
2352 if( aOperator[j].eOp==OP_OPEN_BRACKET ){
2353 nNest++;
2354 }
2355 }else{
2356 /*
2357 ** This is not really a match because this operator cannot
2358 ** legally appear at the end of the string.
2359 */
2360 isMatch = 0;
2361 }
2362 }
2363 if( nToken>0 && aOperator[j].iPrecedence==1 ){
2364 Expr *pPrev = apToken[nToken-1];
2365 if( !pPrev->pOp || pPrev->pOp->eOp==OP_CLOSE_BRACKET ){
2366 continue;
2367 }
2368 }
2369 if( isMatch ){
2370 pNew->pOp = &aOperator[j];
2371 i += nOp;
2372 break;
2373 }
2374 }
2375 }
2376 }
2377
2378 if( pNew->pOp || pNew->nValue ){
2379 if( pNew->nValue ){
2380 /* A terminal. Copy the string value. */
2381 assert( !pNew->pOp );
2382 pNew->zValue = Th_Malloc(interp, pNew->nValue);
2383 th_memcpy(pNew->zValue, z, pNew->nValue);
2384 i += pNew->nValue;
2385 }
2386 if( (nToken%16)==0 ){
2387 /* Grow the apToken array. */
2388 Expr **apTokenOld = apToken;
2389 apToken = Th_Malloc(interp, sizeof(Expr *)*(nToken+16));
2390 th_memcpy(apToken, apTokenOld, sizeof(Expr *)*nToken);
2391 }
2392
2393 /* Put the new token at the end of the apToken array */
2394 apToken[nToken] = pNew;
2395 nToken++;
2396 }else{
2397 Th_Free(interp, pNew);
2398 rc = TH_ERROR;
2399 }
2400 }
2401 }
2402
2403 if( nNest!=0 ){
2404 rc = TH_ERROR;
2405 }
2406
2407 *papToken = apToken;
2408 *pnToken = nToken;
2409 return rc;
2410 }
2411
2412 /*
2413 ** Evaluate the string (zExpr, nExpr) as a Th expression. Store
2414 ** the result in the interpreter interp and return TH_OK if
2415 ** successful. If an error occurs, store an error message in
2416 ** the interpreter result and return an error code.
2417 */
Th_Expr(Th_Interp * interp,const char * zExpr,int nExpr)2418 int Th_Expr(Th_Interp *interp, const char *zExpr, int nExpr){
2419 int rc; /* Return Code */
2420 int i; /* Loop counter */
2421
2422 int nToken = 0;
2423 Expr **apToken = 0;
2424
2425 if( nExpr<0 ){
2426 nExpr = th_strlen(zExpr);
2427 }
2428
2429 /* Parse the expression to a list of tokens. */
2430 rc = exprParse(interp, zExpr, nExpr, &apToken, &nToken);
2431
2432 /* If the parsing was successful, create an expression tree from
2433 ** the parsed list of tokens. If successful, apToken[0] is set
2434 ** to point to the root of the expression tree.
2435 */
2436 if( rc==TH_OK ){
2437 rc = exprMakeTree(interp, apToken, nToken);
2438 }
2439
2440 if( rc!=TH_OK ){
2441 Th_ErrorMessage(interp, "syntax error in expression: \"", zExpr, nExpr);
2442 }
2443
2444 /* Evaluate the expression tree. */
2445 if( rc==TH_OK ){
2446 rc = exprEval(interp, apToken[0]);
2447 }
2448
2449 /* Free memory allocated by exprParse(). */
2450 for(i=0; i<nToken; i++){
2451 exprFree(interp, apToken[i]);
2452 }
2453 Th_Free(interp, apToken);
2454
2455 return rc;
2456 }
2457
2458 /*
2459 ** Allocate and return a pointer to a new hash-table. The caller should
2460 ** (eventually) delete the hash-table by passing it to Th_HashDelete().
2461 */
Th_HashNew(Th_Interp * interp)2462 Th_Hash *Th_HashNew(Th_Interp *interp){
2463 Th_Hash *p;
2464 p = Th_Malloc(interp, sizeof(Th_Hash));
2465 return p;
2466 }
2467
2468 /*
2469 ** Iterate through all values currently stored in the hash table. Invoke
2470 ** the callback function xCallback for each entry. The second argument
2471 ** passed to xCallback is a copy of the fourth argument passed to this
2472 ** function. The return value from the callback function xCallback is
2473 ** ignored.
2474 */
Th_HashIterate(Th_Interp * interp,Th_Hash * pHash,int (* xCallback)(Th_HashEntry * pEntry,void * pContext),void * pContext)2475 void Th_HashIterate(
2476 Th_Interp *interp,
2477 Th_Hash *pHash,
2478 int (*xCallback)(Th_HashEntry *pEntry, void *pContext),
2479 void *pContext
2480 ){
2481 int i;
2482 for(i=0; i<TH_HASHSIZE; i++){
2483 Th_HashEntry *pEntry;
2484 Th_HashEntry *pNext;
2485 for(pEntry=pHash->a[i]; pEntry; pEntry=pNext){
2486 pNext = pEntry->pNext;
2487 xCallback(pEntry, pContext);
2488 }
2489 }
2490 }
2491
2492 /*
2493 ** Helper function for Th_HashDelete(). Always returns non-zero.
2494 */
xFreeHashEntry(Th_HashEntry * pEntry,void * pContext)2495 static int xFreeHashEntry(Th_HashEntry *pEntry, void *pContext){
2496 Th_Free((Th_Interp *)pContext, (void *)pEntry);
2497 return 1;
2498 }
2499
2500 /*
2501 ** Free a hash-table previously allocated by Th_HashNew().
2502 */
Th_HashDelete(Th_Interp * interp,Th_Hash * pHash)2503 void Th_HashDelete(Th_Interp *interp, Th_Hash *pHash){
2504 if( pHash ){
2505 Th_HashIterate(interp, pHash, xFreeHashEntry, (void *)interp);
2506 Th_Free(interp, pHash);
2507 }
2508 }
2509
2510 /*
2511 ** This function is used to insert or delete hash table items, or to
2512 ** query a hash table for an existing item.
2513 **
2514 ** If parameter op is less than zero, then the hash-table element
2515 ** identified by (zKey, nKey) is removed from the hash-table if it
2516 ** exists. NULL is returned.
2517 **
2518 ** Otherwise, if the hash-table contains an item with key (zKey, nKey),
2519 ** a pointer to the associated Th_HashEntry is returned. If parameter
2520 ** op is greater than zero, then a new entry is added if one cannot
2521 ** be found. If op is zero, then NULL is returned if the item is
2522 ** not already present in the hash-table.
2523 */
Th_HashFind(Th_Interp * interp,Th_Hash * pHash,const char * zKey,int nKey,int op)2524 Th_HashEntry *Th_HashFind(
2525 Th_Interp *interp,
2526 Th_Hash *pHash,
2527 const char *zKey,
2528 int nKey,
2529 int op /* -ve = delete, 0 = find, +ve = insert */
2530 ){
2531 unsigned int iKey = 0;
2532 int i;
2533 Th_HashEntry *pRet;
2534 Th_HashEntry **ppRet;
2535
2536 if( nKey<0 ){
2537 nKey = th_strlen(zKey);
2538 }
2539
2540 for(i=0; i<nKey; i++){
2541 iKey = (iKey<<3) ^ iKey ^ zKey[i];
2542 }
2543 iKey = iKey % TH_HASHSIZE;
2544
2545 for(ppRet=&pHash->a[iKey]; (pRet=*ppRet); ppRet=&pRet->pNext){
2546 assert( pRet && ppRet && *ppRet==pRet );
2547 if( pRet->nKey==nKey && 0==memcmp(pRet->zKey, zKey, nKey) ) break;
2548 }
2549
2550 if( op<0 && pRet ){
2551 assert( ppRet && *ppRet==pRet );
2552 *ppRet = pRet->pNext;
2553 Th_Free(interp, pRet);
2554 pRet = 0;
2555 }
2556
2557 if( op>0 && !pRet ){
2558 pRet = (Th_HashEntry *)Th_Malloc(interp, sizeof(Th_HashEntry) + nKey);
2559 pRet->zKey = (char *)&pRet[1];
2560 pRet->nKey = nKey;
2561 th_memcpy(pRet->zKey, zKey, nKey);
2562 pRet->pNext = pHash->a[iKey];
2563 pHash->a[iKey] = pRet;
2564 }
2565
2566 return pRet;
2567 }
2568
2569 /*
2570 ** This function is the same as the standard strlen() function, except
2571 ** that it returns 0 (instead of being undefined) if the argument is
2572 ** a null pointer.
2573 */
th_strlen(const char * zStr)2574 int th_strlen(const char *zStr){
2575 int n = 0;
2576 if( zStr ){
2577 while( zStr[n] ) n++;
2578 }
2579 return n;
2580 }
2581
2582 /* Whitespace characters:
2583 **
2584 ** ' ' 0x20
2585 ** '\t' 0x09
2586 ** '\n' 0x0A
2587 ** '\v' 0x0B
2588 ** '\f' 0x0C
2589 ** '\r' 0x0D
2590 **
2591 ** Whitespace characters have the 0x01 flag set. Decimal digits have the
2592 ** 0x2 flag set. Single byte printable characters have the 0x4 flag set.
2593 ** Alphabet characters have the 0x8 bit set. Hexadecimal digits have the
2594 ** 0x20 flag set.
2595 **
2596 ** The special list characters have the 0x10 flag set
2597 **
2598 ** { } [ ] \ ; ' "
2599 **
2600 ** " 0x22
2601 **
2602 */
2603 static unsigned char aCharProp[256] = {
2604 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, /* 0x0. */
2605 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x1. */
2606 5, 4, 20, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, /* 0x2. */
2607 38, 38, 38, 38, 38, 38, 38, 38, 38, 38, 4, 20, 4, 4, 4, 4, /* 0x3. */
2608 4, 44, 44, 44, 44, 44, 44, 12, 12, 12, 12, 12, 12, 12, 12, 12, /* 0x4. */
2609 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 20, 20, 20, 4, 4, /* 0x5. */
2610 4, 44, 44, 44, 44, 44, 44, 12, 12, 12, 12, 12, 12, 12, 12, 12, /* 0x6. */
2611 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 20, 4, 20, 4, 4, /* 0x7. */
2612
2613 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x8. */
2614 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x9. */
2615 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xA. */
2616 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xB. */
2617 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xC. */
2618 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xD. */
2619 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xE. */
2620 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /* 0xF. */
2621 };
2622
2623 /*
2624 ** Clone of the standard isspace() and isdigit function/macros.
2625 */
th_isspace(char c)2626 int th_isspace(char c){
2627 return (aCharProp[(unsigned char)c] & 0x01);
2628 }
th_isdigit(char c)2629 int th_isdigit(char c){
2630 return (aCharProp[(unsigned char)c] & 0x02);
2631 }
th_isspecial(char c)2632 int th_isspecial(char c){
2633 return (aCharProp[(unsigned char)c] & 0x11);
2634 }
th_isalnum(char c)2635 int th_isalnum(char c){
2636 return (aCharProp[(unsigned char)c] & 0x0A);
2637 }
th_isalpha(char c)2638 int th_isalpha(char c){
2639 return (aCharProp[(unsigned char)c] & 0x08);
2640 }
th_ishexdig(char c)2641 int th_ishexdig(char c){
2642 return (aCharProp[(unsigned char)c] & 0x20);
2643 }
th_isoctdig(char c)2644 int th_isoctdig(char c){
2645 return ((c|7) == '7');
2646 }
th_isbindig(char c)2647 int th_isbindig(char c){
2648 return ((c|1) == '1');
2649 }
2650
2651 #ifndef LONGDOUBLE_TYPE
2652 # define LONGDOUBLE_TYPE long double
2653 #endif
2654
2655
2656 /*
2657 ** Return TRUE if z is a pure numeric string. Return FALSE if the
2658 ** string contains any character which is not part of a number. If
2659 ** the string is numeric and contains the '.' character, set *realnum
2660 ** to TRUE (otherwise FALSE).
2661 **
2662 ** An empty string is considered non-numeric.
2663 */
sqlite3IsNumber(const char * z,int * realnum)2664 static int sqlite3IsNumber(const char *z, int *realnum){
2665 int incr = 1;
2666 if( *z=='-' || *z=='+' ) z += incr;
2667 if( !th_isdigit(*(u8*)z) ){
2668 return 0;
2669 }
2670 z += incr;
2671 if( realnum ) *realnum = 0;
2672 while( th_isdigit(*(u8*)z) ){ z += incr; }
2673 if( *z=='.' ){
2674 z += incr;
2675 if( !th_isdigit(*(u8*)z) ) return 0;
2676 while( th_isdigit(*(u8*)z) ){ z += incr; }
2677 if( realnum ) *realnum = 1;
2678 }
2679 if( *z=='e' || *z=='E' ){
2680 z += incr;
2681 if( *z=='+' || *z=='-' ) z += incr;
2682 if( !th_isdigit(*(u8*)z) ) return 0;
2683 while( th_isdigit(*(u8*)z) ){ z += incr; }
2684 if( realnum ) *realnum = 1;
2685 }
2686 return *z==0;
2687 }
2688
2689 /*
2690 ** The string z[] is an ascii representation of a real number.
2691 ** Convert this string to a double.
2692 **
2693 ** This routine assumes that z[] really is a valid number. If it
2694 ** is not, the result is undefined.
2695 **
2696 ** This routine is used instead of the library atof() function because
2697 ** the library atof() might want to use "," as the decimal point instead
2698 ** of "." depending on how locale is set. But that would cause problems
2699 ** for SQL. So this routine always uses "." regardless of locale.
2700 */
sqlite3AtoF(const char * z,double * pResult)2701 static int sqlite3AtoF(const char *z, double *pResult){
2702 int sign = 1;
2703 const char *zBegin = z;
2704 LONGDOUBLE_TYPE v1 = 0.0;
2705 while( th_isspace(*(u8*)z) ) z++;
2706 if( *z=='-' ){
2707 sign = -1;
2708 z++;
2709 }else if( *z=='+' ){
2710 z++;
2711 }
2712 while( th_isdigit(*(u8*)z) ){
2713 v1 = v1*10.0 + (*z - '0');
2714 z++;
2715 }
2716 if( *z=='.' ){
2717 LONGDOUBLE_TYPE divisor = 1.0;
2718 z++;
2719 while( th_isdigit(*(u8*)z) ){
2720 v1 = v1*10.0 + (*z - '0');
2721 divisor *= 10.0;
2722 z++;
2723 }
2724 v1 /= divisor;
2725 }
2726 if( *z=='e' || *z=='E' ){
2727 int esign = 1;
2728 int eval = 0;
2729 LONGDOUBLE_TYPE scale = 1.0;
2730 z++;
2731 if( *z=='-' ){
2732 esign = -1;
2733 z++;
2734 }else if( *z=='+' ){
2735 z++;
2736 }
2737 while( th_isdigit(*(u8*)z) ){
2738 eval = eval*10 + *z - '0';
2739 z++;
2740 }
2741 while( eval>=64 ){ scale *= 1.0e+64; eval -= 64; }
2742 while( eval>=16 ){ scale *= 1.0e+16; eval -= 16; }
2743 while( eval>=4 ){ scale *= 1.0e+4; eval -= 4; }
2744 while( eval>=1 ){ scale *= 1.0e+1; eval -= 1; }
2745 if( esign<0 ){
2746 v1 /= scale;
2747 }else{
2748 v1 *= scale;
2749 }
2750 }
2751 *pResult = sign<0 ? -v1 : v1;
2752 return z - zBegin;
2753 }
2754
2755 /*
2756 ** Try to convert the string passed as arguments (z, n) to an integer.
2757 ** If successful, store the result in *piOut and return TH_OK.
2758 **
2759 ** If the string cannot be converted to an integer, return TH_ERROR.
2760 ** If the interp argument is not NULL, leave an error message in the
2761 ** interpreter result too.
2762 */
Th_ToInt(Th_Interp * interp,const char * z,int n,int * piOut)2763 int Th_ToInt(Th_Interp *interp, const char *z, int n, int *piOut){
2764 int i = 0;
2765 int iOut = 0;
2766 int base = 10;
2767 int (*isdigit)(char) = th_isdigit;
2768
2769 if( n<0 ){
2770 n = th_strlen(z);
2771 }
2772
2773 if( n>1 && (z[0]=='-' || z[0]=='+') ){
2774 i = 1;
2775 }
2776 if( (n-i)>2 && z[i]=='0' ){
2777 if( z[i+1]=='x' || z[i+1]=='X' ){
2778 i += 2;
2779 base = 16;
2780 isdigit = th_ishexdig;
2781 }else if( z[i+1]=='o' || z[i+1]=='O' ){
2782 i += 2;
2783 base = 8;
2784 isdigit = th_isoctdig;
2785 }else if( z[i+1]=='b' || z[i+1]=='B' ){
2786 i += 2;
2787 base = 2;
2788 isdigit = th_isbindig;
2789 }
2790 }
2791 for(; i<n; i++){
2792 char c = z[i];
2793 if( !isdigit(c) ){
2794 Th_ErrorMessage(interp, "expected integer, got: \"", z, n);
2795 return TH_ERROR;
2796 }
2797 if( c>='a' ){
2798 c -= 'a'-10;
2799 }else if( c>='A' ){
2800 c -= 'A'-10;
2801 }else{
2802 c -= '0';
2803 }
2804 iOut = iOut * base + c;
2805 }
2806
2807 if( n>0 && z[0]=='-' ){
2808 iOut *= -1;
2809 }
2810
2811 *piOut = iOut;
2812 return TH_OK;
2813 }
2814
2815 /*
2816 ** Try to convert the string passed as arguments (z, n) to a double.
2817 ** If successful, store the result in *pfOut and return TH_OK.
2818 **
2819 ** If the string cannot be converted to a double, return TH_ERROR.
2820 ** If the interp argument is not NULL, leave an error message in the
2821 ** interpreter result too.
2822 */
Th_ToDouble(Th_Interp * interp,const char * z,int n,double * pfOut)2823 int Th_ToDouble(
2824 Th_Interp *interp,
2825 const char *z,
2826 int n,
2827 double *pfOut
2828 ){
2829 if( !sqlite3IsNumber((const char *)z, 0) ){
2830 Th_ErrorMessage(interp, "expected number, got: \"", z, n);
2831 return TH_ERROR;
2832 }
2833
2834 sqlite3AtoF((const char *)z, pfOut);
2835 return TH_OK;
2836 }
2837
2838 /*
2839 ** Set the result of the interpreter to the th1 representation of
2840 ** the integer iVal and return TH_OK.
2841 */
Th_SetResultInt(Th_Interp * interp,int iVal)2842 int Th_SetResultInt(Th_Interp *interp, int iVal){
2843 int isNegative = 0;
2844 char zBuf[32];
2845 char *z = &zBuf[32];
2846
2847 if( iVal<0 ){
2848 isNegative = 1;
2849 iVal = iVal * -1;
2850 }
2851 *(--z) = '\0';
2852 *(--z) = (char)(48+((unsigned)iVal%10));
2853 while( (iVal = ((unsigned)iVal/10))>0 ){
2854 *(--z) = (char)(48+((unsigned)iVal%10));
2855 assert(z>zBuf);
2856 }
2857 if( isNegative ){
2858 *(--z) = '-';
2859 }
2860
2861 return Th_SetResult(interp, z, -1);
2862 }
2863
2864 /*
2865 ** Set the result of the interpreter to the th1 representation of
2866 ** the double fVal and return TH_OK.
2867 */
Th_SetResultDouble(Th_Interp * interp,double fVal)2868 int Th_SetResultDouble(Th_Interp *interp, double fVal){
2869 int i; /* Iterator variable */
2870 double v = fVal; /* Input value */
2871 char zBuf[128]; /* Output buffer */
2872 char *z = zBuf; /* Output cursor */
2873 int iDot = 0; /* Digit after which to place decimal point */
2874 int iExp = 0; /* Exponent (NN in eNN) */
2875 const char *zExp; /* String representation of iExp */
2876
2877 /* Precision: */
2878 #define INSIGNIFICANT 0.000000000001
2879 #define ROUNDER 0.0000000000005
2880 double insignificant = INSIGNIFICANT;
2881
2882 /* If the real value is negative, write a '-' character to the
2883 * output and transform v to the corresponding positive number.
2884 */
2885 if( v<0.0 ){
2886 *z++ = '-';
2887 v *= -1.0;
2888 }
2889
2890 /* Normalize v to a value between 1.0 and 10.0. Integer
2891 * variable iExp is set to the exponent. i.e the original
2892 * value is (v * 10^iExp) (or the negative thereof).
2893 */
2894 if( v>0.0 ){
2895 while( (v+ROUNDER)>=10.0 ) { iExp++; v *= 0.1; }
2896 while( (v+ROUNDER)<1.0 ) { iExp--; v *= 10.0; }
2897 }
2898 v += ROUNDER;
2899
2900 /* For a small (<12) positive exponent, move the decimal point
2901 * instead of using the "eXX" notation.
2902 */
2903 if( iExp>0 && iExp<12 ){
2904 iDot = iExp;
2905 iExp = 0;
2906 }
2907
2908 /* For a small (>-4) negative exponent, write leading zeroes
2909 * instead of using the "eXX" notation.
2910 */
2911 if( iExp<0 && iExp>-4 ){
2912 *z++ = '0';
2913 *z++ = '.';
2914 for(i=0; i>(iExp+1); i--){
2915 *z++ = '0';
2916 }
2917 iDot = -1;
2918 iExp = 0;
2919 }
2920
2921 /* Output the digits in real value v. The value of iDot determines
2922 * where (if at all) the decimal point is placed.
2923 */
2924 for(i=0; i<=(iDot+1) || v>=insignificant; i++){
2925 *z++ = (char)(48 + (int)v);
2926 v = (v - ((double)(int)v)) * 10.0;
2927 insignificant *= 10.0;
2928 if( iDot==i ){
2929 *z++ = '.';
2930 }
2931 }
2932
2933 /* If the exponent is not zero, add the "eXX" notation to the
2934 * end of the string.
2935 */
2936 if( iExp!=0 ){
2937 *z++ = 'e';
2938 Th_SetResultInt(interp, iExp);
2939 zExp = Th_GetResult(interp, 0);
2940 for(i=0; zExp[i]; i++){
2941 *z++ = zExp[i];
2942 }
2943 }
2944
2945 *z = '\0';
2946 return Th_SetResult(interp, zBuf, -1);
2947 }
2948
2949 /*
2950 ** Appends all currently registered command names to the specified list
2951 ** and returns TH_OK upon success. Any other return value indicates an
2952 ** error.
2953 */
Th_ListAppendCommands(Th_Interp * interp,char ** pzList,int * pnList)2954 int Th_ListAppendCommands(
2955 Th_Interp *interp, /* Interpreter context */
2956 char **pzList, /* OUT: List of command names */
2957 int *pnList /* OUT: Number of command names */
2958 ){
2959 Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
2960 interp, sizeof(Th_InterpAndList)
2961 );
2962 p->interp = interp;
2963 p->pzList = pzList;
2964 p->pnList = pnList;
2965 Th_HashIterate(interp, interp->paCmd, thListAppendHashKey, p);
2966 Th_Free(interp, p);
2967 return TH_OK;
2968 }
2969
2970 /*
2971 ** Appends all variable names for the current frame to the specified list
2972 ** and returns TH_OK upon success. Any other return value indicates an
2973 ** error. If the current frame cannot be obtained, TH_ERROR is returned.
2974 */
Th_ListAppendVariables(Th_Interp * interp,char ** pzList,int * pnList)2975 int Th_ListAppendVariables(
2976 Th_Interp *interp, /* Interpreter context */
2977 char **pzList, /* OUT: List of variable names */
2978 int *pnList /* OUT: Number of variable names */
2979 ){
2980 Th_Frame *pFrame = getFrame(interp, 0);
2981 if( pFrame ){
2982 Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
2983 interp, sizeof(Th_InterpAndList)
2984 );
2985 p->interp = interp;
2986 p->pzList = pzList;
2987 p->pnList = pnList;
2988 Th_HashIterate(interp, pFrame->paVar, thListAppendHashKey, p);
2989 Th_Free(interp, p);
2990 return TH_OK;
2991 }else{
2992 return TH_ERROR;
2993 }
2994 }
2995
2996 /*
2997 ** Appends all array element names for the specified array variable to the
2998 ** specified list and returns TH_OK upon success. Any other return value
2999 ** indicates an error.
3000 */
Th_ListAppendArray(Th_Interp * interp,const char * zVar,int nVar,char ** pzList,int * pnList)3001 int Th_ListAppendArray(
3002 Th_Interp *interp, /* Interpreter context */
3003 const char *zVar, /* Pointer to variable name */
3004 int nVar, /* Number of bytes at nVar */
3005 char **pzList, /* OUT: List of array element names */
3006 int *pnList /* OUT: Number of array element names */
3007 ){
3008 Th_Variable *pValue = thFindValue(interp, zVar, nVar, 0, 1, 1, 0);
3009 if( pValue && !pValue->zData && pValue->pHash ){
3010 Th_InterpAndList *p = (Th_InterpAndList *)Th_Malloc(
3011 interp, sizeof(Th_InterpAndList)
3012 );
3013 p->interp = interp;
3014 p->pzList = pzList;
3015 p->pnList = pnList;
3016 Th_HashIterate(interp, pValue->pHash, thListAppendHashKey, p);
3017 Th_Free(interp, p);
3018 }else{
3019 *pzList = 0;
3020 *pnList = 0;
3021 }
3022 return TH_OK;
3023 }
3024