Fossil SCM

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

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button