Fossil

Check-in [7905fb22]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Make sure that TH1 variables get removed from the call frame upon being unset.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | branch-1.28
Files: files | file ages | folders
SHA1:7905fb22f0e6636dc7206dc94e30b2e9ca893151
User & Date: mistachkin 2014-01-13 23:33:59
Context
2014-01-14
08:29
Cherrypick SQLite ac15455abc: In the command-line shell, defend against a NULL-pointer dereference in the case where sqlite3_column_name() returns NULL (as might happen following an OOM error) check-in: a12b9c45 user: jan.nijtmans tags: branch-1.28
2014-01-13
23:33
Make sure that TH1 variables get removed from the call frame upon being unset. check-in: 7905fb22 user: mistachkin tags: branch-1.28
23:27
Make sure that TH1 variables get removed from the call frame upon being unset. Closed-Leaf check-in: fa17f1ce user: mistachkin tags: th1Work
2014-01-12
10:55
Fix incorrect link. All bug-fixes from trunk are now merged into "branch-1.28" except (on purpose!) the harmless valgrind warning in the tarball generator check-in: 1c6a9917 user: jan.nijtmans tags: branch-1.28
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/th.c.

1
2
3
4
5
6
7
8
9
10
..
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
..
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
...
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
...
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
...
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
...
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
...
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
...
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
...
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
...
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
...
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
...
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
...
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
...
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
...
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
....
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
....
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
....
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
....
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
....
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
....
1251
1252
1253
1254
1255
1256
1257

1258
1259

1260
1261
1262
1263
1264


1265
1266
1267
1268
1269
1270
1271
....
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
....
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
....
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
....
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
....
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
....
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
....
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
....
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
....
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
....
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
....
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
....
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
....
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
....
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
....
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
....
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
....
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
....
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
....
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
....
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
....
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
....
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
....
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
....
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
....
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
....
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600

/*
** The implementation of the TH core. This file contains the parser, and 
** the implementation of the interface in th.h.
*/

#include "config.h"
#include "th.h"
#include <string.h>
#include <assert.h>
................................................................................
typedef struct Th_Variable  Th_Variable;

/*
** Interpreter structure.
*/
struct Th_Interp {
  Th_Vtab *pVtab;     /* Copy of the argument passed to Th_CreateInterp() */
  char *zResult;     /* Current interpreter result (Th_Malloc()ed) */
  int nResult;        /* number of bytes in zResult */
  Th_Hash *paCmd;     /* Table of registered commands */
  Th_Frame *pFrame;   /* Current execution frame */
  int isListMode;     /* True if thSplitList() should operate in "list" mode */
};

/*
................................................................................
** Each stack frame (variable scope) is represented by an instance
** of this structure. Variable values set using the Th_SetVar command
** are stored in the Th_Frame.paVar hash table member of the associated
** stack frame object.
**
** When an interpreter is created, a single Th_Frame structure is also
** allocated - the global variable scope. Th_Interp.pFrame (the current
** interpreter frame) is initialised to point to this Th_Frame. It is 
** not deleted for the lifetime of the interpreter (because the global 
** frame never goes out of scope).
**
** New stack frames are created by the Th_InFrame() function. Before
** invoking its callback function, Th_InFrame() allocates a new Th_Frame
** structure with pCaller set to the current frame (Th_Interp.pFrame),
** and sets the current frame to the new frame object. After the callback
** has been invoked, the allocated Th_Frame is deleted and the value
** of the current frame pointer restored.
** 
** By default, the Th_SetVar(), Th_UnsetVar() and Th_GetVar() functions 
** access variable values in the current frame. If they need to access 
** the global frame, they do so by traversing the pCaller pointer list.
** Likewise, the Th_LinkVar() function uses the pCaller pointers to 
** link to variables located in the global or other stack frames.
*/
struct Th_Frame {
  Th_Hash *paVar;               /* Variables defined in this scope */
  Th_Frame *pCaller;            /* Calling frame */
};

................................................................................
** a hash table mapping between array key name (a th1 string) and
** a pointer to the Th_Variable structure holding the scalar
** value.
*/
struct Th_Variable {
  int nRef;                   /* Number of references to this structure */
  int nData;                  /* Number of bytes at Th_Variable.zData */
  char *zData;               /* Data for scalar variables */
  Th_Hash *pHash;             /* Data for array variables */
};

/*
** Hash table API:
*/
#define TH_HASHSIZE 257
................................................................................
static void thPopFrame(Th_Interp*);

static void thFreeVariable(Th_HashEntry*, void*);
static void thFreeCommand(Th_HashEntry*, void*);

/*
** The following are used by both the expression and language parsers.
** Given that the start of the input string (z, n) is a language 
** construct of the relevant type (a command enclosed in [], an escape
** sequence etc.), these functions determine the number of bytes
** of the input consumed by the construct. For example:
**
**   int nByte;
**   thNextCommand(interp, "[expr $a+1] $nIter", 18, &nByte);
**
** results in variable nByte being set to 11. Or, 
**
**   thNextVarname(interp, "$a+1", 4, &nByte);
**
** results in nByte being set to 2.
*/
static int thNextCommand(Th_Interp*, const char *z, int n, int *pN);
static int thNextEscape (Th_Interp*, const char *z, int n, int *pN);
static int thNextVarname(Th_Interp*, const char *z, int n, int *pN);
static int thNextNumber (Th_Interp*, const char *z, int n, int *pN);
static int thNextSpace  (Th_Interp*, const char *z, int n, int *pN);

/*
** Given that the input string (z, n) contains a language construct of
** the relevant type (a command enclosed in [], an escape sequence 
** like "\xFF" or a variable reference like "${varname}", perform
** substitution on the string and store the resulting string in
** the interpreter result.
*/
static int thSubstCommand(Th_Interp*, const char *z, int n);
static int thSubstEscape (Th_Interp*, const char *z, int n);
static int thSubstVarname(Th_Interp*, const char *z, int n);

/*
** Given that there is a th1 word located at the start of the input 
** string (z, n), determine the length in bytes of that word. If the
** isCmd argument is non-zero, then an unescaped ";" byte not 
** located inside of a block or quoted string is considered to mark 
** the end of the word.
*/
static int thNextWord(Th_Interp*, const char *z, int n, int *pN, int isCmd);

/*
** Perform substitution on the word contained in the input string (z, n).
** Store the resulting string in the interpreter result.
................................................................................

/*
** Append nAdd bytes of content copied from zAdd to the end of buffer
** pBuffer. If there is not enough space currently allocated, resize
** the allocation to make space.
*/
static int thBufferWrite(
  Th_Interp *interp, 
  Buffer *pBuffer, 
  const char *zAdd, 
  int nAdd
){
  int nReq;

  if( nAdd<0 ){
    nAdd = th_strlen(zAdd);
  }
................................................................................
  Th_Frame *pFrame = interp->pFrame;
  Th_HashIterate(interp, pFrame->paVar, thFreeVariable, (void *)interp);
  Th_HashDelete(interp, pFrame->paVar);
  interp->pFrame = pFrame->pCaller;
}

/*
** The first part of the string (zInput,nInput) contains an escape 
** sequence. Set *pnEscape to the number of bytes in the escape sequence.
** If there is a parse error, return TH_ERROR and set the interpreter
** result to an error message. Otherwise return TH_OK.
*/
static int thNextEscape(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnEscape
){
  int i = 2;

  assert(nInput>0);
  assert(zInput[0]=='\\');

................................................................................
  }
  *pnEscape = i;
  return TH_OK;
}

/*
** The first part of the string (zInput,nInput) contains a variable
** reference. Set *pnVarname to the number of bytes in the variable 
** reference. If there is a parse error, return TH_ERROR and set the 
** interpreter result to an error message. Otherwise return TH_OK.
*/
int thNextVarname(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnVarname
){
  int i;

  assert(nInput>0);
  assert(zInput[0]=='$');

................................................................................

  *pnVarname = i;
  return TH_OK;
}

/*
** The first part of the string (zInput,nInput) contains a command
** enclosed in a "[]" block. Set *pnCommand to the number of bytes in 
** the variable reference. If there is a parse error, return TH_ERROR 
** and set the interpreter result to an error message. Otherwise return 
** TH_OK.
*/
int thNextCommand(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnCommand
){
  int nBrace = 0;
  int nSquare = 0;
  int i;

  assert(nInput>0);
................................................................................

  *pnCommand = i;

  return TH_OK;
}

/*
** Set *pnSpace to the number of whitespace bytes at the start of 
** input string (zInput, nInput). Always return TH_OK.
*/
int thNextSpace(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnSpace
){
  int i;
  for(i=0; i<nInput && th_isspace(zInput[i]); i++);
  *pnSpace = i;
  return TH_OK;
}

/*
** The first byte of the string (zInput,nInput) is not white-space.
** Set *pnWord to the number of bytes in the th1 word that starts
** with this byte. If a complete word cannot be parsed or some other
** error occurs, return TH_ERROR and set the interpreter result to 
** an error message. Otherwise return TH_OK.
**
** If the isCmd argument is non-zero, then an unescaped ";" byte not 
** located inside of a block or quoted string is considered to mark 
** the end of the word.
*/
static int thNextWord(
  Th_Interp *interp,
  const char *zInput, 
  int nInput, 
  int *pnWord,
  int isCmd
){
  int iEnd = 0;

  assert( !th_isspace(zInput[0]) );

................................................................................
  assert(nWord>=2);
  assert(zWord[0]=='[' && zWord[nWord-1]==']');
  return thEvalLocal(interp, &zWord[1], nWord-2);
}

/*
** The input string (zWord, nWord) contains a th1 variable reference
** (a '$' byte followed by a variable name). Perform substitution on 
** the input string and store the resulting string in the interpreter 
** result.
*/
static int thSubstVarname(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
................................................................................
    }
  }
  return Th_GetVar(interp, &zWord[1], nWord-1);
}

/*
** The input string (zWord, nWord) contains a th1 escape sequence.
** Perform substitution on the input string and store the resulting 
** string in the interpreter result.
*/
static int thSubstEscape(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
................................................................................

  Th_SetResult(interp, &c, 1);
  return TH_OK;
}

/*
** The input string (zWord, nWord) contains a th1 word. Perform
** substitution on the input string and store the resulting 
** string in the interpreter result.
*/
static int thSubstWord(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
................................................................................
      int nGet;

      int (*xGet)(Th_Interp *, const char*, int, int *) = 0;
      int (*xSubst)(Th_Interp *, const char*, int) = 0;

      switch( zWord[i] ){
        case '\\':
          xGet = thNextEscape; xSubst = thSubstEscape; 
          break;
        case '[':
          if( !interp->isListMode ){
            xGet = thNextCommand; xSubst = thSubstCommand; 
            break;
          }
        case '$':
          if( !interp->isListMode ){
            xGet = thNextVarname; xSubst = thSubstVarname; 
            break;
          }
        default: {
          thBufferWrite(interp, &output, &zWord[i], 1);
          continue; /* Go to the next iteration of the for(...) loop */
        }
      }
................................................................................

/*
** Return true if one of the following is true of the buffer pointed
** to by zInput, length nInput:
**
**   + It is empty, or
**   + It contains nothing but white-space, or
**   + It contains no non-white-space characters before the first 
**     newline character.
**
** Otherwise return false.
*/
static int thEndOfLine(const char *zInput, int nInput){
  int i;
  for(i=0; i<nInput && zInput[i]!='\n' && th_isspace(zInput[i]); i++);
................................................................................
**     Th_SplitList(interp, zList, nList, &argv, &argl, &argc);
**
**     // Free all memory allocated by Th_SplitList(). The arrays pointed
**     // to by argv and argl are invalidated by this call.
**     //
**     Th_Free(interp, argv);
**
*/ 
static int thSplitList(
  Th_Interp *interp,      /* Interpreter context */
  const char *zList,     /* Pointer to buffer containing input list */
  int nList,              /* Size of buffer pointed to by zList */
  char ***pazElem,       /* OUT: Array of list elements */
  int **panElem,          /* OUT: Lengths of each list element */
  int *pnCount            /* OUT: Number of list elements */
){
  int rc = TH_OK;

  Buffer strbuf;
  Buffer lenbuf;
................................................................................
    }
  }
  assert((lenbuf.nBuf/sizeof(int))==nCount);

  assert((pazElem && panElem) || (!pazElem && !panElem));
  if( pazElem && rc==TH_OK ){
    int i;
    char *zElem; 
    int *anElem;
    char **azElem = Th_Malloc(interp,
      sizeof(char*) * nCount +      /* azElem */
      sizeof(int) * nCount +         /* anElem */
      strbuf.nBuf                    /* space for list element strings */
    );
    anElem = (int *)&azElem[nCount];
    zElem = (char *)&anElem[nCount];
    memcpy(anElem, lenbuf.zBuf, lenbuf.nBuf);
    memcpy(zElem, strbuf.zBuf, strbuf.nBuf);
................................................................................
    }
    *pazElem = azElem;
    *panElem = anElem;
  }
  if( pnCount ){
    *pnCount = nCount;
  }
  
 finish:
  thBufferFree(interp, &strbuf);
  thBufferFree(interp, &lenbuf);
  return rc;
}

/*
................................................................................

      /* Call the command procedure. */
      if( rc==TH_OK ){
        Th_Command *p = (Th_Command *)(pEntry->pData);
        const char **azArg = (const char **)argv;
        rc = p->xProc(interp, p->pContext, argc, azArg, argl);
      }
  
      /* If an error occurred, add this command to the stack trace report. */
      if( rc==TH_ERROR ){
        char *zRes;
        int nRes;
        char *zStack = 0;
        int nStack = 0;
  
        zRes = Th_TakeResult(interp, &nRes);
        if( TH_OK==Th_GetVar(interp, (char *)"::th_stack_trace", -1) ){
          zStack = Th_TakeResult(interp, &nStack);
        }
        Th_ListAppend(interp, &zStack, &nStack, zFirst, zInput-zFirst);
        Th_SetVar(interp, (char *)"::th_stack_trace", -1, zStack, nStack);
        Th_SetResult(interp, zRes, nRes);
................................................................................
** Th_Frame structure. If unsuccessful (no such frame), return 0 and
** leave an error message in the interpreter result.
**
** Argument iFrame is interpreted as follows:
**
**   * If iFrame is 0, this means the current frame.
**
**   * If iFrame is negative, then the nth frame up the stack, where 
**     n is the absolute value of iFrame. A value of -1 means the 
**     calling procedure.
**
**   * If iFrame is +ve, then the nth frame from the bottom of the 
**     stack. An iFrame value of 1 means the toplevel (global) frame.
*/
static Th_Frame *getFrame(Th_Interp *interp, int iFrame){
  Th_Frame *p = interp->pFrame;
  int i;
  if( iFrame>0 ){
    for(i=0; p; i++){
................................................................................
  return p;
}


/*
** Evaluate th1 script (zProgram, nProgram) in the frame identified by
** argument iFrame. Leave either an error message or a result in the
** interpreter result and return a th1 error code (TH_OK, TH_ERROR, 
** TH_RETURN, TH_CONTINUE or TH_BREAK).
*/
int Th_Eval(Th_Interp *interp, int iFrame, const char *zProgram, int nProgram){
  int rc = TH_OK;
  Th_Frame *pSavedFrame = interp->pFrame;

  /* Set Th_Interp.pFrame to the frame that this script is to be 
  ** evaluated in. The current frame is saved in pSavedFrame and will
  ** be restored before this function returns.
  */
  interp->pFrame = getFrame(interp, iFrame);

  if( !interp->pFrame ){
    rc = TH_ERROR;
  }else{
    int nInput = nProgram;
  
    if( nInput<0 ){
      nInput = th_strlen(zProgram);
    }
    rc = thEvalLocal(interp, zProgram, nInput);
  }

  interp->pFrame = pSavedFrame;
................................................................................
** array variable. If the variable is a scalar, *pzInner is set to 0.
** If it is an array variable, (*pzInner, *pnInner) is set to the
** array key name.
*/
static int thAnalyseVarname(
  const char *zVarname,
  int nVarname,
  const char **pzOuter,     /* OUT: Pointer to scalar/array name */
  int *pnOuter,              /* OUT: Number of bytes at *pzOuter */
  const char **pzInner,     /* OUT: Pointer to array key (or null) */
  int *pnInner,              /* OUT: Number of bytes at *pzInner */
  int *pisGlobal             /* OUT: Set to true if this is a global ref */
){
  const char *zOuter = zVarname;
  int nOuter;
  const char *zInner = 0;
  int nInner = 0;
................................................................................
  *pnInner = nInner;
  *pisGlobal = isGlobal;
  return TH_OK;
}

/*
** Input string (zVar, nVar) contains a variable name. This function locates
** the Th_Variable structure associated with the named variable. The 
** variable name may be a global or local scalar or array variable
**
** If the create argument is non-zero and the named variable does not exist
** it is created. Otherwise, an error is left in the interpreter result
** and NULL returned.
**
** If the arrayok argument is false and the named variable is an array,
** an error is left in the interpreter result and NULL returned. If
** arrayok is true an array name is Ok.
*/
static Th_Variable *thFindValue(
  Th_Interp *interp,
  const char *zVar,     /* Pointer to variable name */
  int nVar,              /* Number of bytes at nVar */
  int create,            /* If true, create the variable if not found */
  int arrayok,           /* If true, an array is Ok. Otherwise array==error */
  int noerror            /* If false, set interpreter result to error message */
){
  const char *zOuter;
  int nOuter;
................................................................................

  thAnalyseVarname(zVar, nVar, &zOuter, &nOuter, &zInner, &nInner, &isGlobal);
  if( isGlobal ){
    while( pFrame->pCaller ) pFrame = pFrame->pCaller;
  }

  pEntry = Th_HashFind(interp, pFrame->paVar, zOuter, nOuter, create);
  assert(pEntry || !create);
  if( !pEntry ){
    goto no_such_var;
  }

  pValue = (Th_Variable *)pEntry->pData;
  if( !pValue ){
    assert(create);
................................................................................
  if( !noerror ){
    Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
  }
  return 0;
}

/*
** String (zVar, nVar) must contain the name of a scalar variable or 
** array member. Look up the variable, store its current value in 
** the interpreter result and return TH_OK.
**
** If the named variable does not exist, return TH_ERROR and leave
** an error message in the interpreter result.
*/
int Th_GetVar(Th_Interp *interp, const char *zVar, int nVar){
  Th_Variable *pValue;
................................................................................
** array member. If the variable does not exist it is created. The
** variable is set to the value supplied in string (zValue, nValue).
**
** If (zVar, nVar) refers to an existing array, TH_ERROR is returned
** and an error message left in the interpreter result.
*/
int Th_SetVar(
  Th_Interp *interp, 
  const char *zVar, 
  int nVar,
  const char *zValue,
  int nValue
){
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 1, 0, 0);
................................................................................

/*
** Create a variable link so that accessing variable (zLocal, nLocal) is
** the same as accessing variable (zLink, nLink) in stack frame iFrame.
*/
int Th_LinkVar(
  Th_Interp *interp,                 /* Interpreter */
  const char *zLocal, int nLocal,   /* Local varname */
  int iFrame,                        /* Stack frame of linked var */
  const char *zLink, int nLink      /* Linked varname */
){
  Th_Frame *pSavedFrame = interp->pFrame;
  Th_Frame *pFrame;
  Th_HashEntry *pEntry;
  Th_Variable *pValue;

  pFrame = getFrame(interp, iFrame);
................................................................................
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 0, 1, 0);
  if( !pValue ){
    return TH_ERROR;
  }


  Th_Free(interp, pValue->zData);
  pValue->zData = 0;

  if( pValue->pHash ){
    Th_HashIterate(interp, pValue->pHash, thFreeVariable, (void *)interp);
    Th_HashDelete(interp, pValue->pHash);
    pValue->pHash = 0;
  }


  return TH_OK;
}

/*
** Return an allocated buffer containing a copy of string (z, n). The
** caller is responsible for eventually calling Th_Free() to free
** the returned buffer.
................................................................................
*/
int Th_ErrorMessage(Th_Interp *interp, const char *zPre, const char *z, int n){
  if( interp ){
    char *zRes = 0;
    int nRes = 0;

    Th_SetVar(interp, (char *)"::th_stack_trace", -1, 0, 0);
  
    Th_StringAppend(interp, &zRes, &nRes, zPre, -1);
    if( zRes[nRes-1]=='"' ){
      Th_StringAppend(interp, &zRes, &nRes, z, n);
      Th_StringAppend(interp, &zRes, &nRes, (const char *)"\"", 1);
    }else{
      Th_StringAppend(interp, &zRes, &nRes, (const char *)" ", 1);
      Th_StringAppend(interp, &zRes, &nRes, z, n);
................................................................................
    return zResult;
  }else{
    return (char *)Th_Malloc(pInterp, 1);
  }
}


/* 
** Wrappers around the supplied malloc() and free() 
*/
void *Th_Malloc(Th_Interp *pInterp, int nByte){
  void *p = pInterp->pVtab->xMalloc(nByte);
  if( p ){
    memset(p, 0, nByte);
  }
  return p;
................................................................................
void Th_Free(Th_Interp *pInterp, void *z){
  if( z ){
    pInterp->pVtab->xFree(z);
  }
}

/*
** Install a new th1 command. 
**
** If a command of the same name already exists, it is deleted automatically.
*/
int Th_CreateCommand(
  Th_Interp *interp, 
  const char *zName,                 /* New command name */
  Th_CommandProc xProc,              /* Command callback proc */
  void *pContext,                    /* Value to pass as second arg to xProc */
  void (*xDel)(Th_Interp *, void *)  /* Command destructor callback */
){
  Th_HashEntry *pEntry;
  Th_Command *pCommand;
................................................................................
  }else{
    pCommand = Th_Malloc(interp, sizeof(Th_Command));
  }
  pCommand->xProc = xProc;
  pCommand->pContext = pContext;
  pCommand->xDel = xDel;
  pEntry->pData = (void *)pCommand;
 
  return TH_OK;
}

/*
** Rename the existing command (zName, nName) to (zNew, nNew). If nNew is 0, 
** the command is deleted instead of renamed.
**
** If successful, TH_OK is returned. If command zName does not exist, or
** if command zNew already exists, an error message is left in the 
** interpreter result and TH_ERROR is returned.
*/
int Th_RenameCommand(
  Th_Interp *interp, 
  const char *zName,            /* Existing command name */
  int nName,                     /* Number of bytes at zName */
  const char *zNew,             /* New command name */
  int nNew                       /* Number of bytes at zNew */
){
  Th_HashEntry *pEntry;
  Th_HashEntry *pNewEntry;

  pEntry = Th_HashFind(interp, interp->paCmd, zName, nName, 0);
  if( !pEntry ){
................................................................................
** Split a th1 list into its component elements. The list to split is
** passed via arguments (zList, nList). If successful, TH_OK is returned.
** If an error occurs (if (zList, nList) is not a valid list) an error
** message is left in the interpreter result and TH_ERROR returned.
**
** If successful, *pnCount is set to the number of elements in the list.
** panElem is set to point at an array of *pnCount integers - the lengths
** of the element values. *pazElem is set to point at an array of 
** pointers to buffers containing the array element's data.
**
** To free the arrays allocated at *pazElem and *panElem, the caller
** should call Th_Free() on *pazElem only. Exactly one such call to
** Th_Free() must be made per call to Th_SplitList().
**
** Example:
................................................................................
**     }
**
**     Th_Free(interp, azElem);
**
*/
int Th_SplitList(
  Th_Interp *interp,
  const char *zList,             /* Pointer to buffer containing list */
  int nList,                      /* Number of bytes at zList */
  char ***pazElem,               /* OUT: Array of pointers to element data */
  int **panElem,                  /* OUT: Array of element data lengths */
  int *pnCount                    /* OUT: Number of elements in list */
){
  int rc;
  interp->isListMode = 1;
  rc = thSplitList(interp, zList, nList, pazElem, panElem, pnCount);
  interp->isListMode = 0;
................................................................................
  if( rc ){
    Th_ErrorMessage(interp, "Expected list, got: \"", zList, nList);
  }
  return rc;
}

/*
** Append a new element to an existing th1 list. The element to append 
** to the list is (zElem, nElem).
**
** A pointer to the existing list must be stored at *pzList when this
** function is called. The length must be stored in *pnList. The value 
** of *pzList must either be NULL (in which case *pnList must be 0), or 
** a pointer to memory obtained from Th_Malloc().
**
** This function calls Th_Free() to free the buffer at *pzList and sets
** *pzList to point to a new buffer containing the new list value. *pnList
** is similarly updated before returning. The return value is always TH_OK.
**
** Example:
................................................................................
**     }
**     Th_SetResult(interp, zList, nList);
**     Th_Free(interp, zList);
**
*/
int Th_ListAppend(
  Th_Interp *interp,           /* Interpreter context */
  char **pzList,              /* IN/OUT: Ptr to ptr to list */
  int *pnList,                 /* IN/OUT: Current length of *pzList */
  const char *zElem,          /* Data to append */
  int nElem                    /* Length of nElem */
){
  Buffer output;
  int i;

  int hasSpecialChar = 0;
  int hasEscapeChar = 0;
................................................................................

/*
** Append a new element to an existing th1 string. This function uses
** the same interface as the Th_ListAppend() function.
*/
int Th_StringAppend(
  Th_Interp *interp,           /* Interpreter context */
  char **pzStr,               /* IN/OUT: Ptr to ptr to list */
  int *pnStr,                  /* IN/OUT: Current length of *pzStr */
  const char *zElem,          /* Data to append */
  int nElem                    /* Length of nElem */
){
  char *zNew;
  int nNew;

  if( nElem<0 ){
    nElem = th_strlen(zElem);
................................................................................
  Th_Free(interp, *pzStr);
  *pzStr = zNew;
  *pnStr = nNew;

  return TH_OK;
}

/* 
** Delete an interpreter.
*/
void Th_DeleteInterp(Th_Interp *interp){
  assert(interp->pFrame);
  assert(0==interp->pFrame->pCaller);

  /* Delete the contents of the global frame. */
................................................................................
  Th_HashIterate(interp, interp->paCmd, thFreeCommand, (void *)interp);
  Th_HashDelete(interp, interp->paCmd);

  /* Delete the interpreter structure itself. */
  Th_Free(interp, (void *)interp);
}

/* 
** Create a new interpreter.
*/
Th_Interp * Th_CreateInterp(Th_Vtab *pVtab){
  Th_Interp *p;

  /* Allocate and initialise the interpreter and the global frame */
  p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
................................................................................
typedef struct Expr Expr;
struct Expr {
  Operator *pOp;
  Expr *pParent;
  Expr *pLeft;
  Expr *pRight;

  char *zValue;     /* Pointer to literal value */
  int nValue;        /* Length of literal value buffer */
};

/* Unary operators */
#define OP_UNARY_MINUS  2
#define OP_UNARY_PLUS   3
#define OP_BITWISE_NOT  4
................................................................................
  /* Note: all unary operators have (iPrecedence==1) */
  {"-",  OP_UNARY_MINUS,    1, ARG_NUMBER},
  {"+",  OP_UNARY_PLUS,     1, ARG_NUMBER},
  {"~",  OP_BITWISE_NOT,    1, ARG_INTEGER},
  {"!",  OP_LOGICAL_NOT,    1, ARG_INTEGER},

  /* Binary operators. It is important to the parsing in Th_Expr() that
   * the two-character symbols ("==") appear before the one-character 
   * ones ("="). And that the priorities of all binary operators are
   * integers between 2 and 12.
   */
  {"<<", OP_LEFTSHIFT,      4, ARG_INTEGER},
  {">>", OP_RIGHTSHIFT,     4, ARG_INTEGER},
  {"<=", OP_LE,             5, ARG_NUMBER},
  {">=", OP_GE,             5, ARG_NUMBER},
................................................................................
  {"|",  OP_BITWISE_OR,    10, ARG_INTEGER},

  {0,0,0,0}
};

/*
** The first part of the string (zInput,nInput) contains a number.
** Set *pnVarname to the number of bytes in the numeric string. 
*/
static int thNextNumber(
  Th_Interp *interp, 
  const char *zInput, 
  int nInput, 
  int *pnLiteral
){
  int i;
  int seenDot = 0;
  for(i=0; i<nInput; i++){
    char c = zInput[i];
    if( (seenDot || c!='.') && !th_isdigit(c) ) break;
................................................................................
    if( rc==TH_OK ){
      eArgType = pExpr->pOp->eArgType;
      if( eArgType==ARG_NUMBER ){
        if( (zLeft==0 || TH_OK==Th_ToInt(0, zLeft, nLeft, &iLeft))
         && (zRight==0 || TH_OK==Th_ToInt(0, zRight, nRight, &iRight))
        ){
          eArgType = ARG_INTEGER;
        }else if( 
          (zLeft && TH_OK!=Th_ToDouble(interp, zLeft, nLeft, &fLeft)) ||
          (zRight && TH_OK!=Th_ToDouble(interp, zRight, nRight, &fRight))
        ){
          /* A type error. */
          rc = TH_ERROR;
        }
      }else if( eArgType==ARG_INTEGER ){
        rc = Th_ToInt(interp, zLeft, nLeft, &iLeft);
        if( rc==TH_OK && zRight ){
          rc = Th_ToInt(interp, zRight, nRight, &iRight);
        }
      }  
    }

    if( rc==TH_OK && eArgType==ARG_INTEGER ){
      int iRes = 0;
      switch( pExpr->pOp->eOp ) {
        case OP_MULTIPLY:     iRes = iLeft*iRight;  break;
        case OP_DIVIDE:
................................................................................

  assert(nToken>0);
#define ISTERM(x) (apToken[x] && (!apToken[x]->pOp || apToken[x]->pLeft))

  for(jj=0; jj<nToken; jj++){
    if( apToken[jj]->pOp && apToken[jj]->pOp->eOp==OP_OPEN_BRACKET ){
      int nNest = 1;
      int iLeft = jj; 

      for(jj++; jj<nToken; jj++){
        Operator *pOp = apToken[jj]->pOp;
        if( pOp && pOp->eOp==OP_OPEN_BRACKET ) nNest++;
        if( pOp && pOp->eOp==OP_CLOSE_BRACKET ) nNest--;
        if( nNest==0 ) break;
      }
................................................................................
}

/*
** Parse a string containing a TH expression to a list of tokens.
*/
static int exprParse(
  Th_Interp *interp,        /* Interpreter to leave error message in */
  const char *zExpr,       /* Pointer to input string */
  int nExpr,                /* Number of bytes at zExpr */
  Expr ***papToken,         /* OUT: Array of tokens. */
  int *pnToken              /* OUT: Size of token array */
){
  int i;

  int rc = TH_OK;
................................................................................
          assert( !pNew->pOp );
          pNew->zValue = Th_Malloc(interp, pNew->nValue);
          memcpy(pNew->zValue, z, pNew->nValue);
          i += pNew->nValue;
        }
        if( (nToken%16)==0 ){
          /* Grow the apToken array. */
          Expr **apTokenOld = apToken; 
          apToken = Th_Malloc(interp, sizeof(Expr *)*(nToken+16));
          memcpy(apToken, apTokenOld, sizeof(Expr *)*nToken);
        }

        /* Put the new token at the end of the apToken array */
        apToken[nToken] = pNew;
        nToken++;
................................................................................
}

/*
** Evaluate the string (zExpr, nExpr) as a Th expression. Store
** the result in the interpreter interp and return TH_OK if
** successful. If an error occurs, store an error message in
** the interpreter result and return an error code.
*/ 
int Th_Expr(Th_Interp *interp, const char *zExpr, int nExpr){
  int rc;                           /* Return Code */
  int i;                            /* Loop counter */

  int nToken = 0;
  Expr **apToken = 0;

................................................................................
  }

  /* Parse the expression to a list of tokens. */
  rc = exprParse(interp, zExpr, nExpr, &apToken, &nToken);

  /* If the parsing was successful, create an expression tree from
  ** the parsed list of tokens. If successful, apToken[0] is set
  ** to point to the root of the expression tree. 
  */
  if( rc==TH_OK ){
    rc = exprMakeTree(interp, apToken, nToken);
  }

  if( rc!=TH_OK ){
    Th_ErrorMessage(interp, "syntax error in expression: \"", zExpr, nExpr);
................................................................................
/*
** Iterate through all values currently stored in the hash table. Invoke
** the callback function xCallback for each entry. The second argument
** passed to xCallback is a copy of the fourth argument passed to this
** function.
*/
void Th_HashIterate(
  Th_Interp *interp, 
  Th_Hash *pHash,
  void (*xCallback)(Th_HashEntry *pEntry, void *pContext),
  void *pContext
){
  int i;
  for(i=0; i<TH_HASHSIZE; i++){
    Th_HashEntry *pEntry;
................................................................................
  if( pHash ){
    Th_HashIterate(interp, pHash, xFreeHashEntry, (void *)interp);
    Th_Free(interp, pHash);
  }
}

/*
** This function is used to insert or delete hash table items, or to 
** query a hash table for an existing item.
**
** If parameter op is less than zero, then the hash-table element 
** identified by (zKey, nKey) is removed from the hash-table if it
** exists. NULL is returned.
**
** Otherwise, if the hash-table contains an item with key (zKey, nKey),
** a pointer to the associated Th_HashEntry is returned. If parameter
** op is greater than zero, then a new entry is added if one cannot
** be found. If op is zero, then NULL is returned if the item is
** not already present in the hash-table.
*/
Th_HashEntry *Th_HashFind(
  Th_Interp *interp, 
  Th_Hash *pHash,
  const char *zKey,
  int nKey,
  int op                      /* -ve = delete, 0 = find, +ve = insert */
){
  unsigned int iKey = 0;
  int i;
................................................................................
**     '\n'   0x0A
**     '\v'   0x0B
**     '\f'   0x0C
**     '\r'   0x0D
**
** Whitespace characters have the 0x01 flag set. Decimal digits have the
** 0x2 flag set. Single byte printable characters have the 0x4 flag set.
** Alphabet characters have the 0x8 bit set. 
**
** The special list characters have the 0x10 flag set
**
**    { } [ ] \ ; ' "
**
**    " 0x22
**
................................................................................
  }
  *pResult = sign<0 ? -v1 : v1;
  return z - zBegin;
}

/*
** Try to convert the string passed as arguments (z, n) to an integer.
** If successful, store the result in *piOut and return TH_OK. 
**
** If the string cannot be converted to an integer, return TH_ERROR. 
** If the interp argument is not NULL, leave an error message in the 
** interpreter result too.
*/
int Th_ToInt(Th_Interp *interp, const char *z, int n, int *piOut){
  int i = 0;
  int iOut = 0;

  if( n<0 ){
................................................................................

  *piOut = iOut;
  return TH_OK;
}

/*
** Try to convert the string passed as arguments (z, n) to a double.
** If successful, store the result in *pfOut and return TH_OK. 
**
** If the string cannot be converted to a double, return TH_ERROR. 
** If the interp argument is not NULL, leave an error message in the 
** interpreter result too.
*/
int Th_ToDouble(
  Th_Interp *interp, 
  const char *z, 
  int n, 
  double *pfOut
){
  if( !sqlite3IsNumber((const char *)z, 0) ){
    Th_ErrorMessage(interp, "expected number, got: \"", z, n);
    return TH_ERROR;
  }

................................................................................
/*
** Set the result of the interpreter to the th1 representation of
** the double fVal and return TH_OK.
*/
int Th_SetResultDouble(Th_Interp *interp, double fVal){
  int i;                /* Iterator variable */
  double v = fVal;      /* Input value */
  char zBuf[128];      /* Output buffer */
  char *z = zBuf;      /* Output cursor */
  int iDot = 0;         /* Digit after which to place decimal point */
  int iExp = 0;         /* Exponent (NN in eNN) */
  const char *zExp;    /* String representation of iExp */

  /* Precision: */
  #define INSIGNIFICANT 0.000000000001
  #define ROUNDER       0.0000000000005
  double insignificant = INSIGNIFICANT;

  /* If the real value is negative, write a '-' character to the
   * output and transform v to the corresponding positive number.
   */ 
  if( v<0.0 ){
    *z++ = '-';
    v *= -1.0;
  }

  /* Normalize v to a value between 1.0 and 10.0. Integer 
   * variable iExp is set to the exponent. i.e the original
   * value is (v * 10^iExp) (or the negative thereof).
   */ 
  if( v>0.0 ){
    while( (v+ROUNDER)>=10.0 ) { iExp++; v *= 0.1; }
    while( (v+ROUNDER)<1.0 )   { iExp--; v *= 10.0; }
  }
  v += ROUNDER;

  /* For a small (<12) positive exponent, move the decimal point


|







 







|







 







|
|








|
|
|

|







 







|







 







|







|













|









|

|
|







 







|
|
|







 







|






|
|







 







|
|




|
|







 







|
|
|




|
|







 







|




|
|












|


|
|




|
|







 







|
|







 







|







 







|







 







|



|




|







 







|







 







|


|

|







 







|


|







 







|







 







|






|







 







|
|


|







 







|






|









|







 







|

|







 







|












|







 







|







 







|
|







 







|
|







 







|

|







 







>
|
|
>





>
>







 







|







 







|
|







 







|




|







 







|




|



|



|
|

|







 







|







 







|

|







 







|



|
|







 







|

|







 







|

|







 







|







 







|







 







|







 







|







 







|


|
|
|







 







|











|







 







|







 







|







 







|







 







|







 







|







 







|







 







|


|










|







 







|







 







|

|
|







 







|

|
|



|
|
|







 







|
|


|








|





|


|







1
2
3
4
5
6
7
8
9
10
..
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
..
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
...
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
...
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
...
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
...
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
...
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
...
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
...
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
...
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
...
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
...
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
...
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
...
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
...
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
...
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
....
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
....
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
....
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
....
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
....
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
....
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
....
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
....
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
....
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
....
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
....
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
....
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
....
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
....
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
....
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
....
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
....
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
....
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
....
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
....
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
....
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
....
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
....
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
....
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
....
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
....
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
....
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
....
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
....
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
....
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
....
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
....
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604

/*
** The implementation of the TH core. This file contains the parser, and
** the implementation of the interface in th.h.
*/

#include "config.h"
#include "th.h"
#include <string.h>
#include <assert.h>
................................................................................
typedef struct Th_Variable  Th_Variable;

/*
** Interpreter structure.
*/
struct Th_Interp {
  Th_Vtab *pVtab;     /* Copy of the argument passed to Th_CreateInterp() */
  char *zResult;      /* Current interpreter result (Th_Malloc()ed) */
  int nResult;        /* number of bytes in zResult */
  Th_Hash *paCmd;     /* Table of registered commands */
  Th_Frame *pFrame;   /* Current execution frame */
  int isListMode;     /* True if thSplitList() should operate in "list" mode */
};

/*
................................................................................
** Each stack frame (variable scope) is represented by an instance
** of this structure. Variable values set using the Th_SetVar command
** are stored in the Th_Frame.paVar hash table member of the associated
** stack frame object.
**
** When an interpreter is created, a single Th_Frame structure is also
** allocated - the global variable scope. Th_Interp.pFrame (the current
** interpreter frame) is initialised to point to this Th_Frame. It is
** not deleted for the lifetime of the interpreter (because the global
** frame never goes out of scope).
**
** New stack frames are created by the Th_InFrame() function. Before
** invoking its callback function, Th_InFrame() allocates a new Th_Frame
** structure with pCaller set to the current frame (Th_Interp.pFrame),
** and sets the current frame to the new frame object. After the callback
** has been invoked, the allocated Th_Frame is deleted and the value
** of the current frame pointer restored.
**
** By default, the Th_SetVar(), Th_UnsetVar() and Th_GetVar() functions
** access variable values in the current frame. If they need to access
** the global frame, they do so by traversing the pCaller pointer list.
** Likewise, the Th_LinkVar() function uses the pCaller pointers to
** link to variables located in the global or other stack frames.
*/
struct Th_Frame {
  Th_Hash *paVar;               /* Variables defined in this scope */
  Th_Frame *pCaller;            /* Calling frame */
};

................................................................................
** a hash table mapping between array key name (a th1 string) and
** a pointer to the Th_Variable structure holding the scalar
** value.
*/
struct Th_Variable {
  int nRef;                   /* Number of references to this structure */
  int nData;                  /* Number of bytes at Th_Variable.zData */
  char *zData;                /* Data for scalar variables */
  Th_Hash *pHash;             /* Data for array variables */
};

/*
** Hash table API:
*/
#define TH_HASHSIZE 257
................................................................................
static void thPopFrame(Th_Interp*);

static void thFreeVariable(Th_HashEntry*, void*);
static void thFreeCommand(Th_HashEntry*, void*);

/*
** The following are used by both the expression and language parsers.
** Given that the start of the input string (z, n) is a language
** construct of the relevant type (a command enclosed in [], an escape
** sequence etc.), these functions determine the number of bytes
** of the input consumed by the construct. For example:
**
**   int nByte;
**   thNextCommand(interp, "[expr $a+1] $nIter", 18, &nByte);
**
** results in variable nByte being set to 11. Or,
**
**   thNextVarname(interp, "$a+1", 4, &nByte);
**
** results in nByte being set to 2.
*/
static int thNextCommand(Th_Interp*, const char *z, int n, int *pN);
static int thNextEscape (Th_Interp*, const char *z, int n, int *pN);
static int thNextVarname(Th_Interp*, const char *z, int n, int *pN);
static int thNextNumber (Th_Interp*, const char *z, int n, int *pN);
static int thNextSpace  (Th_Interp*, const char *z, int n, int *pN);

/*
** Given that the input string (z, n) contains a language construct of
** the relevant type (a command enclosed in [], an escape sequence
** like "\xFF" or a variable reference like "${varname}", perform
** substitution on the string and store the resulting string in
** the interpreter result.
*/
static int thSubstCommand(Th_Interp*, const char *z, int n);
static int thSubstEscape (Th_Interp*, const char *z, int n);
static int thSubstVarname(Th_Interp*, const char *z, int n);

/*
** Given that there is a th1 word located at the start of the input
** string (z, n), determine the length in bytes of that word. If the
** isCmd argument is non-zero, then an unescaped ";" byte not
** located inside of a block or quoted string is considered to mark
** the end of the word.
*/
static int thNextWord(Th_Interp*, const char *z, int n, int *pN, int isCmd);

/*
** Perform substitution on the word contained in the input string (z, n).
** Store the resulting string in the interpreter result.
................................................................................

/*
** Append nAdd bytes of content copied from zAdd to the end of buffer
** pBuffer. If there is not enough space currently allocated, resize
** the allocation to make space.
*/
static int thBufferWrite(
  Th_Interp *interp,
  Buffer *pBuffer,
  const char *zAdd,
  int nAdd
){
  int nReq;

  if( nAdd<0 ){
    nAdd = th_strlen(zAdd);
  }
................................................................................
  Th_Frame *pFrame = interp->pFrame;
  Th_HashIterate(interp, pFrame->paVar, thFreeVariable, (void *)interp);
  Th_HashDelete(interp, pFrame->paVar);
  interp->pFrame = pFrame->pCaller;
}

/*
** The first part of the string (zInput,nInput) contains an escape
** sequence. Set *pnEscape to the number of bytes in the escape sequence.
** If there is a parse error, return TH_ERROR and set the interpreter
** result to an error message. Otherwise return TH_OK.
*/
static int thNextEscape(
  Th_Interp *interp,
  const char *zInput,
  int nInput,
  int *pnEscape
){
  int i = 2;

  assert(nInput>0);
  assert(zInput[0]=='\\');

................................................................................
  }
  *pnEscape = i;
  return TH_OK;
}

/*
** The first part of the string (zInput,nInput) contains a variable
** reference. Set *pnVarname to the number of bytes in the variable
** reference. If there is a parse error, return TH_ERROR and set the
** interpreter result to an error message. Otherwise return TH_OK.
*/
int thNextVarname(
  Th_Interp *interp,
  const char *zInput,
  int nInput,
  int *pnVarname
){
  int i;

  assert(nInput>0);
  assert(zInput[0]=='$');

................................................................................

  *pnVarname = i;
  return TH_OK;
}

/*
** The first part of the string (zInput,nInput) contains a command
** enclosed in a "[]" block. Set *pnCommand to the number of bytes in
** the variable reference. If there is a parse error, return TH_ERROR
** and set the interpreter result to an error message. Otherwise return
** TH_OK.
*/
int thNextCommand(
  Th_Interp *interp,
  const char *zInput,
  int nInput,
  int *pnCommand
){
  int nBrace = 0;
  int nSquare = 0;
  int i;

  assert(nInput>0);
................................................................................

  *pnCommand = i;

  return TH_OK;
}

/*
** Set *pnSpace to the number of whitespace bytes at the start of
** input string (zInput, nInput). Always return TH_OK.
*/
int thNextSpace(
  Th_Interp *interp,
  const char *zInput,
  int nInput,
  int *pnSpace
){
  int i;
  for(i=0; i<nInput && th_isspace(zInput[i]); i++);
  *pnSpace = i;
  return TH_OK;
}

/*
** The first byte of the string (zInput,nInput) is not white-space.
** Set *pnWord to the number of bytes in the th1 word that starts
** with this byte. If a complete word cannot be parsed or some other
** error occurs, return TH_ERROR and set the interpreter result to
** an error message. Otherwise return TH_OK.
**
** If the isCmd argument is non-zero, then an unescaped ";" byte not
** located inside of a block or quoted string is considered to mark
** the end of the word.
*/
static int thNextWord(
  Th_Interp *interp,
  const char *zInput,
  int nInput,
  int *pnWord,
  int isCmd
){
  int iEnd = 0;

  assert( !th_isspace(zInput[0]) );

................................................................................
  assert(nWord>=2);
  assert(zWord[0]=='[' && zWord[nWord-1]==']');
  return thEvalLocal(interp, &zWord[1], nWord-2);
}

/*
** The input string (zWord, nWord) contains a th1 variable reference
** (a '$' byte followed by a variable name). Perform substitution on
** the input string and store the resulting string in the interpreter
** result.
*/
static int thSubstVarname(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
................................................................................
    }
  }
  return Th_GetVar(interp, &zWord[1], nWord-1);
}

/*
** The input string (zWord, nWord) contains a th1 escape sequence.
** Perform substitution on the input string and store the resulting
** string in the interpreter result.
*/
static int thSubstEscape(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
................................................................................

  Th_SetResult(interp, &c, 1);
  return TH_OK;
}

/*
** The input string (zWord, nWord) contains a th1 word. Perform
** substitution on the input string and store the resulting
** string in the interpreter result.
*/
static int thSubstWord(
  Th_Interp *interp,
  const char *zWord,
  int nWord
){
................................................................................
      int nGet;

      int (*xGet)(Th_Interp *, const char*, int, int *) = 0;
      int (*xSubst)(Th_Interp *, const char*, int) = 0;

      switch( zWord[i] ){
        case '\\':
          xGet = thNextEscape; xSubst = thSubstEscape;
          break;
        case '[':
          if( !interp->isListMode ){
            xGet = thNextCommand; xSubst = thSubstCommand;
            break;
          }
        case '$':
          if( !interp->isListMode ){
            xGet = thNextVarname; xSubst = thSubstVarname;
            break;
          }
        default: {
          thBufferWrite(interp, &output, &zWord[i], 1);
          continue; /* Go to the next iteration of the for(...) loop */
        }
      }
................................................................................

/*
** Return true if one of the following is true of the buffer pointed
** to by zInput, length nInput:
**
**   + It is empty, or
**   + It contains nothing but white-space, or
**   + It contains no non-white-space characters before the first
**     newline character.
**
** Otherwise return false.
*/
static int thEndOfLine(const char *zInput, int nInput){
  int i;
  for(i=0; i<nInput && zInput[i]!='\n' && th_isspace(zInput[i]); i++);
................................................................................
**     Th_SplitList(interp, zList, nList, &argv, &argl, &argc);
**
**     // Free all memory allocated by Th_SplitList(). The arrays pointed
**     // to by argv and argl are invalidated by this call.
**     //
**     Th_Free(interp, argv);
**
*/
static int thSplitList(
  Th_Interp *interp,      /* Interpreter context */
  const char *zList,      /* Pointer to buffer containing input list */
  int nList,              /* Size of buffer pointed to by zList */
  char ***pazElem,        /* OUT: Array of list elements */
  int **panElem,          /* OUT: Lengths of each list element */
  int *pnCount            /* OUT: Number of list elements */
){
  int rc = TH_OK;

  Buffer strbuf;
  Buffer lenbuf;
................................................................................
    }
  }
  assert((lenbuf.nBuf/sizeof(int))==nCount);

  assert((pazElem && panElem) || (!pazElem && !panElem));
  if( pazElem && rc==TH_OK ){
    int i;
    char *zElem;
    int *anElem;
    char **azElem = Th_Malloc(interp,
      sizeof(char*) * nCount +       /* azElem */
      sizeof(int) * nCount +         /* anElem */
      strbuf.nBuf                    /* space for list element strings */
    );
    anElem = (int *)&azElem[nCount];
    zElem = (char *)&anElem[nCount];
    memcpy(anElem, lenbuf.zBuf, lenbuf.nBuf);
    memcpy(zElem, strbuf.zBuf, strbuf.nBuf);
................................................................................
    }
    *pazElem = azElem;
    *panElem = anElem;
  }
  if( pnCount ){
    *pnCount = nCount;
  }

 finish:
  thBufferFree(interp, &strbuf);
  thBufferFree(interp, &lenbuf);
  return rc;
}

/*
................................................................................

      /* Call the command procedure. */
      if( rc==TH_OK ){
        Th_Command *p = (Th_Command *)(pEntry->pData);
        const char **azArg = (const char **)argv;
        rc = p->xProc(interp, p->pContext, argc, azArg, argl);
      }

      /* If an error occurred, add this command to the stack trace report. */
      if( rc==TH_ERROR ){
        char *zRes;
        int nRes;
        char *zStack = 0;
        int nStack = 0;

        zRes = Th_TakeResult(interp, &nRes);
        if( TH_OK==Th_GetVar(interp, (char *)"::th_stack_trace", -1) ){
          zStack = Th_TakeResult(interp, &nStack);
        }
        Th_ListAppend(interp, &zStack, &nStack, zFirst, zInput-zFirst);
        Th_SetVar(interp, (char *)"::th_stack_trace", -1, zStack, nStack);
        Th_SetResult(interp, zRes, nRes);
................................................................................
** Th_Frame structure. If unsuccessful (no such frame), return 0 and
** leave an error message in the interpreter result.
**
** Argument iFrame is interpreted as follows:
**
**   * If iFrame is 0, this means the current frame.
**
**   * If iFrame is negative, then the nth frame up the stack, where
**     n is the absolute value of iFrame. A value of -1 means the
**     calling procedure.
**
**   * If iFrame is +ve, then the nth frame from the bottom of the
**     stack. An iFrame value of 1 means the toplevel (global) frame.
*/
static Th_Frame *getFrame(Th_Interp *interp, int iFrame){
  Th_Frame *p = interp->pFrame;
  int i;
  if( iFrame>0 ){
    for(i=0; p; i++){
................................................................................
  return p;
}


/*
** Evaluate th1 script (zProgram, nProgram) in the frame identified by
** argument iFrame. Leave either an error message or a result in the
** interpreter result and return a th1 error code (TH_OK, TH_ERROR,
** TH_RETURN, TH_CONTINUE or TH_BREAK).
*/
int Th_Eval(Th_Interp *interp, int iFrame, const char *zProgram, int nProgram){
  int rc = TH_OK;
  Th_Frame *pSavedFrame = interp->pFrame;

  /* Set Th_Interp.pFrame to the frame that this script is to be
  ** evaluated in. The current frame is saved in pSavedFrame and will
  ** be restored before this function returns.
  */
  interp->pFrame = getFrame(interp, iFrame);

  if( !interp->pFrame ){
    rc = TH_ERROR;
  }else{
    int nInput = nProgram;

    if( nInput<0 ){
      nInput = th_strlen(zProgram);
    }
    rc = thEvalLocal(interp, zProgram, nInput);
  }

  interp->pFrame = pSavedFrame;
................................................................................
** array variable. If the variable is a scalar, *pzInner is set to 0.
** If it is an array variable, (*pzInner, *pnInner) is set to the
** array key name.
*/
static int thAnalyseVarname(
  const char *zVarname,
  int nVarname,
  const char **pzOuter,      /* OUT: Pointer to scalar/array name */
  int *pnOuter,              /* OUT: Number of bytes at *pzOuter */
  const char **pzInner,      /* OUT: Pointer to array key (or null) */
  int *pnInner,              /* OUT: Number of bytes at *pzInner */
  int *pisGlobal             /* OUT: Set to true if this is a global ref */
){
  const char *zOuter = zVarname;
  int nOuter;
  const char *zInner = 0;
  int nInner = 0;
................................................................................
  *pnInner = nInner;
  *pisGlobal = isGlobal;
  return TH_OK;
}

/*
** Input string (zVar, nVar) contains a variable name. This function locates
** the Th_Variable structure associated with the named variable. The
** variable name may be a global or local scalar or array variable
**
** If the create argument is non-zero and the named variable does not exist
** it is created. Otherwise, an error is left in the interpreter result
** and NULL returned.
**
** If the arrayok argument is false and the named variable is an array,
** an error is left in the interpreter result and NULL returned. If
** arrayok is true an array name is Ok.
*/
static Th_Variable *thFindValue(
  Th_Interp *interp,
  const char *zVar,      /* Pointer to variable name */
  int nVar,              /* Number of bytes at nVar */
  int create,            /* If true, create the variable if not found */
  int arrayok,           /* If true, an array is Ok. Otherwise array==error */
  int noerror            /* If false, set interpreter result to error message */
){
  const char *zOuter;
  int nOuter;
................................................................................

  thAnalyseVarname(zVar, nVar, &zOuter, &nOuter, &zInner, &nInner, &isGlobal);
  if( isGlobal ){
    while( pFrame->pCaller ) pFrame = pFrame->pCaller;
  }

  pEntry = Th_HashFind(interp, pFrame->paVar, zOuter, nOuter, create);
  assert(pEntry || create<=0);
  if( !pEntry ){
    goto no_such_var;
  }

  pValue = (Th_Variable *)pEntry->pData;
  if( !pValue ){
    assert(create);
................................................................................
  if( !noerror ){
    Th_ErrorMessage(interp, "no such variable:", zVar, nVar);
  }
  return 0;
}

/*
** String (zVar, nVar) must contain the name of a scalar variable or
** array member. Look up the variable, store its current value in
** the interpreter result and return TH_OK.
**
** If the named variable does not exist, return TH_ERROR and leave
** an error message in the interpreter result.
*/
int Th_GetVar(Th_Interp *interp, const char *zVar, int nVar){
  Th_Variable *pValue;
................................................................................
** array member. If the variable does not exist it is created. The
** variable is set to the value supplied in string (zValue, nValue).
**
** If (zVar, nVar) refers to an existing array, TH_ERROR is returned
** and an error message left in the interpreter result.
*/
int Th_SetVar(
  Th_Interp *interp,
  const char *zVar,
  int nVar,
  const char *zValue,
  int nValue
){
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 1, 0, 0);
................................................................................

/*
** Create a variable link so that accessing variable (zLocal, nLocal) is
** the same as accessing variable (zLink, nLink) in stack frame iFrame.
*/
int Th_LinkVar(
  Th_Interp *interp,                 /* Interpreter */
  const char *zLocal, int nLocal,    /* Local varname */
  int iFrame,                        /* Stack frame of linked var */
  const char *zLink, int nLink       /* Linked varname */
){
  Th_Frame *pSavedFrame = interp->pFrame;
  Th_Frame *pFrame;
  Th_HashEntry *pEntry;
  Th_Variable *pValue;

  pFrame = getFrame(interp, iFrame);
................................................................................
  Th_Variable *pValue;

  pValue = thFindValue(interp, zVar, nVar, 0, 1, 0);
  if( !pValue ){
    return TH_ERROR;
  }

  if( pValue->zData ){
    Th_Free(interp, pValue->zData);
    pValue->zData = 0;
  }
  if( pValue->pHash ){
    Th_HashIterate(interp, pValue->pHash, thFreeVariable, (void *)interp);
    Th_HashDelete(interp, pValue->pHash);
    pValue->pHash = 0;
  }

  thFindValue(interp, zVar, nVar, -1, 1, 1); /* Finally, delete from frame */
  return TH_OK;
}

/*
** Return an allocated buffer containing a copy of string (z, n). The
** caller is responsible for eventually calling Th_Free() to free
** the returned buffer.
................................................................................
*/
int Th_ErrorMessage(Th_Interp *interp, const char *zPre, const char *z, int n){
  if( interp ){
    char *zRes = 0;
    int nRes = 0;

    Th_SetVar(interp, (char *)"::th_stack_trace", -1, 0, 0);

    Th_StringAppend(interp, &zRes, &nRes, zPre, -1);
    if( zRes[nRes-1]=='"' ){
      Th_StringAppend(interp, &zRes, &nRes, z, n);
      Th_StringAppend(interp, &zRes, &nRes, (const char *)"\"", 1);
    }else{
      Th_StringAppend(interp, &zRes, &nRes, (const char *)" ", 1);
      Th_StringAppend(interp, &zRes, &nRes, z, n);
................................................................................
    return zResult;
  }else{
    return (char *)Th_Malloc(pInterp, 1);
  }
}


/*
** Wrappers around the supplied malloc() and free()
*/
void *Th_Malloc(Th_Interp *pInterp, int nByte){
  void *p = pInterp->pVtab->xMalloc(nByte);
  if( p ){
    memset(p, 0, nByte);
  }
  return p;
................................................................................
void Th_Free(Th_Interp *pInterp, void *z){
  if( z ){
    pInterp->pVtab->xFree(z);
  }
}

/*
** Install a new th1 command.
**
** If a command of the same name already exists, it is deleted automatically.
*/
int Th_CreateCommand(
  Th_Interp *interp,
  const char *zName,                 /* New command name */
  Th_CommandProc xProc,              /* Command callback proc */
  void *pContext,                    /* Value to pass as second arg to xProc */
  void (*xDel)(Th_Interp *, void *)  /* Command destructor callback */
){
  Th_HashEntry *pEntry;
  Th_Command *pCommand;
................................................................................
  }else{
    pCommand = Th_Malloc(interp, sizeof(Th_Command));
  }
  pCommand->xProc = xProc;
  pCommand->pContext = pContext;
  pCommand->xDel = xDel;
  pEntry->pData = (void *)pCommand;

  return TH_OK;
}

/*
** Rename the existing command (zName, nName) to (zNew, nNew). If nNew is 0,
** the command is deleted instead of renamed.
**
** If successful, TH_OK is returned. If command zName does not exist, or
** if command zNew already exists, an error message is left in the
** interpreter result and TH_ERROR is returned.
*/
int Th_RenameCommand(
  Th_Interp *interp,
  const char *zName,             /* Existing command name */
  int nName,                     /* Number of bytes at zName */
  const char *zNew,              /* New command name */
  int nNew                       /* Number of bytes at zNew */
){
  Th_HashEntry *pEntry;
  Th_HashEntry *pNewEntry;

  pEntry = Th_HashFind(interp, interp->paCmd, zName, nName, 0);
  if( !pEntry ){
................................................................................
** Split a th1 list into its component elements. The list to split is
** passed via arguments (zList, nList). If successful, TH_OK is returned.
** If an error occurs (if (zList, nList) is not a valid list) an error
** message is left in the interpreter result and TH_ERROR returned.
**
** If successful, *pnCount is set to the number of elements in the list.
** panElem is set to point at an array of *pnCount integers - the lengths
** of the element values. *pazElem is set to point at an array of
** pointers to buffers containing the array element's data.
**
** To free the arrays allocated at *pazElem and *panElem, the caller
** should call Th_Free() on *pazElem only. Exactly one such call to
** Th_Free() must be made per call to Th_SplitList().
**
** Example:
................................................................................
**     }
**
**     Th_Free(interp, azElem);
**
*/
int Th_SplitList(
  Th_Interp *interp,
  const char *zList,              /* Pointer to buffer containing list */
  int nList,                      /* Number of bytes at zList */
  char ***pazElem,                /* OUT: Array of pointers to element data */
  int **panElem,                  /* OUT: Array of element data lengths */
  int *pnCount                    /* OUT: Number of elements in list */
){
  int rc;
  interp->isListMode = 1;
  rc = thSplitList(interp, zList, nList, pazElem, panElem, pnCount);
  interp->isListMode = 0;
................................................................................
  if( rc ){
    Th_ErrorMessage(interp, "Expected list, got: \"", zList, nList);
  }
  return rc;
}

/*
** Append a new element to an existing th1 list. The element to append
** to the list is (zElem, nElem).
**
** A pointer to the existing list must be stored at *pzList when this
** function is called. The length must be stored in *pnList. The value
** of *pzList must either be NULL (in which case *pnList must be 0), or
** a pointer to memory obtained from Th_Malloc().
**
** This function calls Th_Free() to free the buffer at *pzList and sets
** *pzList to point to a new buffer containing the new list value. *pnList
** is similarly updated before returning. The return value is always TH_OK.
**
** Example:
................................................................................
**     }
**     Th_SetResult(interp, zList, nList);
**     Th_Free(interp, zList);
**
*/
int Th_ListAppend(
  Th_Interp *interp,           /* Interpreter context */
  char **pzList,               /* IN/OUT: Ptr to ptr to list */
  int *pnList,                 /* IN/OUT: Current length of *pzList */
  const char *zElem,           /* Data to append */
  int nElem                    /* Length of nElem */
){
  Buffer output;
  int i;

  int hasSpecialChar = 0;
  int hasEscapeChar = 0;
................................................................................

/*
** Append a new element to an existing th1 string. This function uses
** the same interface as the Th_ListAppend() function.
*/
int Th_StringAppend(
  Th_Interp *interp,           /* Interpreter context */
  char **pzStr,                /* IN/OUT: Ptr to ptr to list */
  int *pnStr,                  /* IN/OUT: Current length of *pzStr */
  const char *zElem,           /* Data to append */
  int nElem                    /* Length of nElem */
){
  char *zNew;
  int nNew;

  if( nElem<0 ){
    nElem = th_strlen(zElem);
................................................................................
  Th_Free(interp, *pzStr);
  *pzStr = zNew;
  *pnStr = nNew;

  return TH_OK;
}

/*
** Delete an interpreter.
*/
void Th_DeleteInterp(Th_Interp *interp){
  assert(interp->pFrame);
  assert(0==interp->pFrame->pCaller);

  /* Delete the contents of the global frame. */
................................................................................
  Th_HashIterate(interp, interp->paCmd, thFreeCommand, (void *)interp);
  Th_HashDelete(interp, interp->paCmd);

  /* Delete the interpreter structure itself. */
  Th_Free(interp, (void *)interp);
}

/*
** Create a new interpreter.
*/
Th_Interp * Th_CreateInterp(Th_Vtab *pVtab){
  Th_Interp *p;

  /* Allocate and initialise the interpreter and the global frame */
  p = pVtab->xMalloc(sizeof(Th_Interp) + sizeof(Th_Frame));
................................................................................
typedef struct Expr Expr;
struct Expr {
  Operator *pOp;
  Expr *pParent;
  Expr *pLeft;
  Expr *pRight;

  char *zValue;      /* Pointer to literal value */
  int nValue;        /* Length of literal value buffer */
};

/* Unary operators */
#define OP_UNARY_MINUS  2
#define OP_UNARY_PLUS   3
#define OP_BITWISE_NOT  4
................................................................................
  /* Note: all unary operators have (iPrecedence==1) */
  {"-",  OP_UNARY_MINUS,    1, ARG_NUMBER},
  {"+",  OP_UNARY_PLUS,     1, ARG_NUMBER},
  {"~",  OP_BITWISE_NOT,    1, ARG_INTEGER},
  {"!",  OP_LOGICAL_NOT,    1, ARG_INTEGER},

  /* Binary operators. It is important to the parsing in Th_Expr() that
   * the two-character symbols ("==") appear before the one-character
   * ones ("="). And that the priorities of all binary operators are
   * integers between 2 and 12.
   */
  {"<<", OP_LEFTSHIFT,      4, ARG_INTEGER},
  {">>", OP_RIGHTSHIFT,     4, ARG_INTEGER},
  {"<=", OP_LE,             5, ARG_NUMBER},
  {">=", OP_GE,             5, ARG_NUMBER},
................................................................................
  {"|",  OP_BITWISE_OR,    10, ARG_INTEGER},

  {0,0,0,0}
};

/*
** The first part of the string (zInput,nInput) contains a number.
** Set *pnVarname to the number of bytes in the numeric string.
*/
static int thNextNumber(
  Th_Interp *interp,
  const char *zInput,
  int nInput,
  int *pnLiteral
){
  int i;
  int seenDot = 0;
  for(i=0; i<nInput; i++){
    char c = zInput[i];
    if( (seenDot || c!='.') && !th_isdigit(c) ) break;
................................................................................
    if( rc==TH_OK ){
      eArgType = pExpr->pOp->eArgType;
      if( eArgType==ARG_NUMBER ){
        if( (zLeft==0 || TH_OK==Th_ToInt(0, zLeft, nLeft, &iLeft))
         && (zRight==0 || TH_OK==Th_ToInt(0, zRight, nRight, &iRight))
        ){
          eArgType = ARG_INTEGER;
        }else if(
          (zLeft && TH_OK!=Th_ToDouble(interp, zLeft, nLeft, &fLeft)) ||
          (zRight && TH_OK!=Th_ToDouble(interp, zRight, nRight, &fRight))
        ){
          /* A type error. */
          rc = TH_ERROR;
        }
      }else if( eArgType==ARG_INTEGER ){
        rc = Th_ToInt(interp, zLeft, nLeft, &iLeft);
        if( rc==TH_OK && zRight ){
          rc = Th_ToInt(interp, zRight, nRight, &iRight);
        }
      }
    }

    if( rc==TH_OK && eArgType==ARG_INTEGER ){
      int iRes = 0;
      switch( pExpr->pOp->eOp ) {
        case OP_MULTIPLY:     iRes = iLeft*iRight;  break;
        case OP_DIVIDE:
................................................................................

  assert(nToken>0);
#define ISTERM(x) (apToken[x] && (!apToken[x]->pOp || apToken[x]->pLeft))

  for(jj=0; jj<nToken; jj++){
    if( apToken[jj]->pOp && apToken[jj]->pOp->eOp==OP_OPEN_BRACKET ){
      int nNest = 1;
      int iLeft = jj;

      for(jj++; jj<nToken; jj++){
        Operator *pOp = apToken[jj]->pOp;
        if( pOp && pOp->eOp==OP_OPEN_BRACKET ) nNest++;
        if( pOp && pOp->eOp==OP_CLOSE_BRACKET ) nNest--;
        if( nNest==0 ) break;
      }
................................................................................
}

/*
** Parse a string containing a TH expression to a list of tokens.
*/
static int exprParse(
  Th_Interp *interp,        /* Interpreter to leave error message in */
  const char *zExpr,        /* Pointer to input string */
  int nExpr,                /* Number of bytes at zExpr */
  Expr ***papToken,         /* OUT: Array of tokens. */
  int *pnToken              /* OUT: Size of token array */
){
  int i;

  int rc = TH_OK;
................................................................................
          assert( !pNew->pOp );
          pNew->zValue = Th_Malloc(interp, pNew->nValue);
          memcpy(pNew->zValue, z, pNew->nValue);
          i += pNew->nValue;
        }
        if( (nToken%16)==0 ){
          /* Grow the apToken array. */
          Expr **apTokenOld = apToken;
          apToken = Th_Malloc(interp, sizeof(Expr *)*(nToken+16));
          memcpy(apToken, apTokenOld, sizeof(Expr *)*nToken);
        }

        /* Put the new token at the end of the apToken array */
        apToken[nToken] = pNew;
        nToken++;
................................................................................
}

/*
** Evaluate the string (zExpr, nExpr) as a Th expression. Store
** the result in the interpreter interp and return TH_OK if
** successful. If an error occurs, store an error message in
** the interpreter result and return an error code.
*/
int Th_Expr(Th_Interp *interp, const char *zExpr, int nExpr){
  int rc;                           /* Return Code */
  int i;                            /* Loop counter */

  int nToken = 0;
  Expr **apToken = 0;

................................................................................
  }

  /* Parse the expression to a list of tokens. */
  rc = exprParse(interp, zExpr, nExpr, &apToken, &nToken);

  /* If the parsing was successful, create an expression tree from
  ** the parsed list of tokens. If successful, apToken[0] is set
  ** to point to the root of the expression tree.
  */
  if( rc==TH_OK ){
    rc = exprMakeTree(interp, apToken, nToken);
  }

  if( rc!=TH_OK ){
    Th_ErrorMessage(interp, "syntax error in expression: \"", zExpr, nExpr);
................................................................................
/*
** Iterate through all values currently stored in the hash table. Invoke
** the callback function xCallback for each entry. The second argument
** passed to xCallback is a copy of the fourth argument passed to this
** function.
*/
void Th_HashIterate(
  Th_Interp *interp,
  Th_Hash *pHash,
  void (*xCallback)(Th_HashEntry *pEntry, void *pContext),
  void *pContext
){
  int i;
  for(i=0; i<TH_HASHSIZE; i++){
    Th_HashEntry *pEntry;
................................................................................
  if( pHash ){
    Th_HashIterate(interp, pHash, xFreeHashEntry, (void *)interp);
    Th_Free(interp, pHash);
  }
}

/*
** This function is used to insert or delete hash table items, or to
** query a hash table for an existing item.
**
** If parameter op is less than zero, then the hash-table element
** identified by (zKey, nKey) is removed from the hash-table if it
** exists. NULL is returned.
**
** Otherwise, if the hash-table contains an item with key (zKey, nKey),
** a pointer to the associated Th_HashEntry is returned. If parameter
** op is greater than zero, then a new entry is added if one cannot
** be found. If op is zero, then NULL is returned if the item is
** not already present in the hash-table.
*/
Th_HashEntry *Th_HashFind(
  Th_Interp *interp,
  Th_Hash *pHash,
  const char *zKey,
  int nKey,
  int op                      /* -ve = delete, 0 = find, +ve = insert */
){
  unsigned int iKey = 0;
  int i;
................................................................................
**     '\n'   0x0A
**     '\v'   0x0B
**     '\f'   0x0C
**     '\r'   0x0D
**
** Whitespace characters have the 0x01 flag set. Decimal digits have the
** 0x2 flag set. Single byte printable characters have the 0x4 flag set.
** Alphabet characters have the 0x8 bit set.
**
** The special list characters have the 0x10 flag set
**
**    { } [ ] \ ; ' "
**
**    " 0x22
**
................................................................................
  }
  *pResult = sign<0 ? -v1 : v1;
  return z - zBegin;
}

/*
** Try to convert the string passed as arguments (z, n) to an integer.
** If successful, store the result in *piOut and return TH_OK.
**
** If the string cannot be converted to an integer, return TH_ERROR.
** If the interp argument is not NULL, leave an error message in the
** interpreter result too.
*/
int Th_ToInt(Th_Interp *interp, const char *z, int n, int *piOut){
  int i = 0;
  int iOut = 0;

  if( n<0 ){
................................................................................

  *piOut = iOut;
  return TH_OK;
}

/*
** Try to convert the string passed as arguments (z, n) to a double.
** If successful, store the result in *pfOut and return TH_OK.
**
** If the string cannot be converted to a double, return TH_ERROR.
** If the interp argument is not NULL, leave an error message in the
** interpreter result too.
*/
int Th_ToDouble(
  Th_Interp *interp,
  const char *z,
  int n,
  double *pfOut
){
  if( !sqlite3IsNumber((const char *)z, 0) ){
    Th_ErrorMessage(interp, "expected number, got: \"", z, n);
    return TH_ERROR;
  }

................................................................................
/*
** Set the result of the interpreter to the th1 representation of
** the double fVal and return TH_OK.
*/
int Th_SetResultDouble(Th_Interp *interp, double fVal){
  int i;                /* Iterator variable */
  double v = fVal;      /* Input value */
  char zBuf[128];       /* Output buffer */
  char *z = zBuf;       /* Output cursor */
  int iDot = 0;         /* Digit after which to place decimal point */
  int iExp = 0;         /* Exponent (NN in eNN) */
  const char *zExp;     /* String representation of iExp */

  /* Precision: */
  #define INSIGNIFICANT 0.000000000001
  #define ROUNDER       0.0000000000005
  double insignificant = INSIGNIFICANT;

  /* If the real value is negative, write a '-' character to the
   * output and transform v to the corresponding positive number.
   */
  if( v<0.0 ){
    *z++ = '-';
    v *= -1.0;
  }

  /* Normalize v to a value between 1.0 and 10.0. Integer
   * variable iExp is set to the exponent. i.e the original
   * value is (v * 10^iExp) (or the negative thereof).
   */
  if( v>0.0 ){
    while( (v+ROUNDER)>=10.0 ) { iExp++; v *= 0.1; }
    while( (v+ROUNDER)<1.0 )   { iExp--; v *= 10.0; }
  }
  v += ROUNDER;

  /* For a small (<12) positive exponent, move the decimal point

Changes to src/th.h.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
..
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
typedef struct Th_Vtab Th_Vtab;

/*
** Opaque handle for interpeter.
*/
typedef struct Th_Interp Th_Interp;

/* 
** Create and delete interpreters. 
*/
Th_Interp * Th_CreateInterp(Th_Vtab *pVtab);
void Th_DeleteInterp(Th_Interp *);

/* 
** Evaluate an TH program in the stack frame identified by parameter
** iFrame, according to the following rules:
**
**   * If iFrame is 0, this means the current frame.
**
**   * If iFrame is negative, then the nth frame up the stack, where n is 
**     the absolute value of iFrame. A value of -1 means the calling
**     procedure.
**
**   * If iFrame is +ve, then the nth frame from the bottom of the stack.
**     An iFrame value of 1 means the toplevel (global) frame.
*/
int Th_Eval(Th_Interp *interp, int iFrame, const char *zProg, int nProg);

/*
** Evaluate a TH expression. The result is stored in the 
** interpreter result.
*/
int Th_Expr(Th_Interp *interp, const char *, int);

/* 
** Access TH variables in the current stack frame. If the variable name
** begins with "::", the lookup is in the top level (global) frame. 
*/
int Th_ExistsVar(Th_Interp *, const char *, int);
int Th_GetVar(Th_Interp *, const char *, int);
int Th_SetVar(Th_Interp *, const char *, int, const char *, int);
int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int);
int Th_UnsetVar(Th_Interp *, const char *, int);

typedef int (*Th_CommandProc)(Th_Interp *, void *, int, const char **, int *);

/* 
** Register new commands. 
*/
int Th_CreateCommand(
  Th_Interp *interp, 
  const char *zName, 
  /* int (*xProc)(Th_Interp *, void *, int, const char **, int *), */
  Th_CommandProc xProc,
  void *pContext,
  void (*xDel)(Th_Interp *, void *)
);

/* 
** Delete or rename commands.
*/
int Th_RenameCommand(Th_Interp *, const char *, int, const char *, int);

/* 
** Push a new stack frame (local variable context) onto the interpreter 
** stack, call the function supplied as parameter xCall with the two 
** context arguments, 
**
**   xCall(interp, pContext1, pContext2)
**
** , then pop the frame off of the interpreter stack. The value returned
** by the xCall() function is returned as the result of this function.
**
** This is intended for use by the implementation of commands such as
................................................................................
*/
int Th_InFrame(Th_Interp *interp,
  int (*xCall)(Th_Interp *, void *pContext1, void *pContext2),
  void *pContext1,
  void *pContext2
);

/* 
** Valid return codes for xProc callbacks.
*/
#define TH_OK       0
#define TH_ERROR    1
#define TH_BREAK    2
#define TH_RETURN   3
#define TH_CONTINUE 4

/* 
** Set and get the interpreter result. 
*/
int Th_SetResult(Th_Interp *, const char *, int);
const char *Th_GetResult(Th_Interp *, int *);
char *Th_TakeResult(Th_Interp *, int *);

/*
** Set an error message as the interpreter result. This also
** sets the global stack-trace variable $::th_stack_trace.
*/
int Th_ErrorMessage(Th_Interp *, const char *, const char *, int);

/* 
** Access the memory management functions associated with the specified
** interpreter.
*/
void *Th_Malloc(Th_Interp *, int);
void Th_Free(Th_Interp *, void *);

/* 
** Functions for handling TH lists.
*/
int Th_ListAppend(Th_Interp *, char **, int *, const char *, int);
int Th_SplitList(Th_Interp *, const char *, int, char ***, int **, int *);

int Th_StringAppend(Th_Interp *, char **, int *, const char *, int);

/* 
** Functions for handling numbers and pointers.
*/
int Th_ToInt(Th_Interp *, const char *, int, int *);
int Th_ToDouble(Th_Interp *, const char *, int, double *);
int Th_SetResultInt(Th_Interp *, int);
int Th_SetResultDouble(Th_Interp *, double);








|
|




|





|









|




|

|









|
|


|
|






|




|
|
|
|







 







|








|
|











|






|







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
..
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
typedef struct Th_Vtab Th_Vtab;

/*
** Opaque handle for interpeter.
*/
typedef struct Th_Interp Th_Interp;

/*
** Create and delete interpreters.
*/
Th_Interp * Th_CreateInterp(Th_Vtab *pVtab);
void Th_DeleteInterp(Th_Interp *);

/*
** Evaluate an TH program in the stack frame identified by parameter
** iFrame, according to the following rules:
**
**   * If iFrame is 0, this means the current frame.
**
**   * If iFrame is negative, then the nth frame up the stack, where n is
**     the absolute value of iFrame. A value of -1 means the calling
**     procedure.
**
**   * If iFrame is +ve, then the nth frame from the bottom of the stack.
**     An iFrame value of 1 means the toplevel (global) frame.
*/
int Th_Eval(Th_Interp *interp, int iFrame, const char *zProg, int nProg);

/*
** Evaluate a TH expression. The result is stored in the
** interpreter result.
*/
int Th_Expr(Th_Interp *interp, const char *, int);

/*
** Access TH variables in the current stack frame. If the variable name
** begins with "::", the lookup is in the top level (global) frame.
*/
int Th_ExistsVar(Th_Interp *, const char *, int);
int Th_GetVar(Th_Interp *, const char *, int);
int Th_SetVar(Th_Interp *, const char *, int, const char *, int);
int Th_LinkVar(Th_Interp *, const char *, int, int, const char *, int);
int Th_UnsetVar(Th_Interp *, const char *, int);

typedef int (*Th_CommandProc)(Th_Interp *, void *, int, const char **, int *);

/*
** Register new commands.
*/
int Th_CreateCommand(
  Th_Interp *interp,
  const char *zName,
  /* int (*xProc)(Th_Interp *, void *, int, const char **, int *), */
  Th_CommandProc xProc,
  void *pContext,
  void (*xDel)(Th_Interp *, void *)
);

/*
** Delete or rename commands.
*/
int Th_RenameCommand(Th_Interp *, const char *, int, const char *, int);

/*
** Push a new stack frame (local variable context) onto the interpreter
** stack, call the function supplied as parameter xCall with the two
** context arguments,
**
**   xCall(interp, pContext1, pContext2)
**
** , then pop the frame off of the interpreter stack. The value returned
** by the xCall() function is returned as the result of this function.
**
** This is intended for use by the implementation of commands such as
................................................................................
*/
int Th_InFrame(Th_Interp *interp,
  int (*xCall)(Th_Interp *, void *pContext1, void *pContext2),
  void *pContext1,
  void *pContext2
);

/*
** Valid return codes for xProc callbacks.
*/
#define TH_OK       0
#define TH_ERROR    1
#define TH_BREAK    2
#define TH_RETURN   3
#define TH_CONTINUE 4

/*
** Set and get the interpreter result.
*/
int Th_SetResult(Th_Interp *, const char *, int);
const char *Th_GetResult(Th_Interp *, int *);
char *Th_TakeResult(Th_Interp *, int *);

/*
** Set an error message as the interpreter result. This also
** sets the global stack-trace variable $::th_stack_trace.
*/
int Th_ErrorMessage(Th_Interp *, const char *, const char *, int);

/*
** Access the memory management functions associated with the specified
** interpreter.
*/
void *Th_Malloc(Th_Interp *, int);
void Th_Free(Th_Interp *, void *);

/*
** Functions for handling TH lists.
*/
int Th_ListAppend(Th_Interp *, char **, int *, const char *, int);
int Th_SplitList(Th_Interp *, const char *, int, char ***, int **, int *);

int Th_StringAppend(Th_Interp *, char **, int *, const char *, int);

/*
** Functions for handling numbers and pointers.
*/
int Th_ToInt(Th_Interp *, const char *, int, int *);
int Th_ToDouble(Th_Interp *, const char *, int, double *);
int Th_SetResultInt(Th_Interp *, int);
int Th_SetResultDouble(Th_Interp *, double);

Changes to src/th_lang.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
...
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
...
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
...
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
...
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
...
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
...
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
...
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
...
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
...
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
...
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
...
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
...
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
...
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
....
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
....
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103

/*
** This file contains the implementation of all of the TH language 
** built-in commands. 
**
** All built-in commands are implemented using the public interface 
** declared in th.h, so this file serves as both a part of the language 
** implementation and an example of how to extend the language with
** new commands.
*/

#include "config.h"
#include "th.h"
#include <string.h>
................................................................................

int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg){
  Th_ErrorMessage(interp, "wrong # args: should be \"", zMsg, -1);
  return TH_ERROR;
}

/*
** Syntax: 
**
**   catch script ?varname?
*/
static int catch_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc;

  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "catch script ?varname?");
  }
................................................................................
  }

  Th_SetResultInt(interp, rc);
  return TH_OK;
}

/*
** TH Syntax: 
**
**   if expr1 body1 ?elseif expr2 body2? ? ?else? bodyN?
*/
static int if_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc = TH_OK;

  int iCond;           /* Result of evaluating expression */
  int i;

................................................................................
  return rc;

wrong_args:
  return Th_WrongNumArgs(interp, "if ...");
}

/*
** TH Syntax: 
**
**   expr expr
*/
static int expr_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "expr expression");
  }

  return Th_Expr(interp, argv[1], argl[1]);
}

/*
** Evaluate the th1 script (zBody, nBody) in the local stack frame. 
** Return the result of the evaluation, except if the result
** is TH_CONTINUE, return TH_OK instead.
*/
static int eval_loopbody(Th_Interp *interp, const char *zBody, int nBody){
  int rc = Th_Eval(interp, 0, zBody, nBody);
  if( rc==TH_CONTINUE ){
    rc = TH_OK;
  }
  return rc;
}

/*
** TH Syntax: 
**
**   for init condition incr script
*/
static int for_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int rc;
  int iCond;

  if( argc!=5 ){
    return Th_WrongNumArgs(interp, "for init condition incr script");
  }

  /* Evaluate the 'init' script */
  rc = Th_Eval(interp, 0, argv[1], -1);

  while( rc==TH_OK 
     && TH_OK==(rc = Th_Expr(interp, argv[2], -1))
     && TH_OK==(rc = Th_ToInt(interp, Th_GetResult(interp, 0), -1, &iCond))
     && iCond
     && TH_OK==(rc = eval_loopbody(interp, argv[4], argl[4]))
  ){
    rc = Th_Eval(interp, 0, argv[3], -1);
  }

  if( rc==TH_BREAK ) rc = TH_OK;
  return rc;
}

/*
** TH Syntax: 
**
**   list ?arg1 ?arg2? ...?
*/
static int list_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  char *zList = 0;
  int nList = 0;
  int i;

  for(i=1; i<argc; i++){
    Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]);
  }
 
  Th_SetResult(interp, zList, nList);
  Th_Free(interp, zList);

  return TH_OK;
}

/*
** TH Syntax: 
**
**   lindex list index
*/
static int lindex_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int iElem;
  int rc;

  char **azElem;
  int *anElem;
................................................................................
    Th_Free(interp, azElem);
  }

  return rc;
}

/*
** TH Syntax: 
**
**   llength list
*/
static int llength_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int nElem;
  int rc;

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "llength list");
................................................................................
    Th_SetResultInt(interp, nElem);
  }

  return rc;
}

/*
** TH Syntax: 
**
**   set varname ?value?
*/
static int set_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "set varname ?value?");
  }

  if( argc==3 ){
................................................................................
    Th_SetVar(interp, argv[1], argl[1], argv[2], argl[2]);
  }
  return Th_GetVar(interp, argv[1], argl[1]);
}

/*
** When a new command is created using the built-in [proc] command, an
** instance of the following structure is allocated and populated. A 
** pointer to the structure is passed as the context (second) argument 
** to function proc_call1() when the new command is executed.
*/
typedef struct ProcDefn ProcDefn;
struct ProcDefn {
  int nParam;                /* Number of formal (non "args") parameters */
  char **azParam;           /* Parameter names */
  int *anParam;              /* Lengths of parameter names */
  char **azDefault;         /* Default values */
  int *anDefault;            /* Lengths of default values */
  int hasArgs;               /* True if there is an "args" parameter */
  char *zProgram;           /* Body of proc */
  int nProgram;              /* Number of bytes at zProgram */
  char *zUsage;             /* Usage message */
  int nUsage;                /* Number of bytes at zUsage */
};

/* This structure is used to temporarily store arguments passed to an 
** invocation of a command created using [proc]. A pointer to an 
** instance is passed as the second argument to the proc_call2() function.
*/
typedef struct ProcArgs ProcArgs;
struct ProcArgs {
  int argc;
  const char **argv;
  int *argl;
................................................................................
  int i;
  ProcDefn *p = (ProcDefn *)pContext1;
  ProcArgs *pArgs = (ProcArgs *)pContext2;

  /* Check if there are the right number of arguments. If there are
  ** not, generate a usage message for the command.
  */
  if( (pArgs->argc>(p->nParam+1) && !p->hasArgs) 
   || (pArgs->argc<=(p->nParam) && !p->azDefault[pArgs->argc-1])
  ){
    char *zUsage = 0;
    int nUsage = 0;
    Th_StringAppend(interp, &zUsage, &nUsage, pArgs->argv[0], pArgs->argl[0]);
    Th_StringAppend(interp, &zUsage, &nUsage, p->zUsage, p->nUsage);
    Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"", 1);
................................................................................
/*
** This function is the command callback registered for all commands
** created using the [proc] command. The second argument, pContext,
** is a pointer to the associated ProcDefn structure.
*/
static int proc_call1(
  Th_Interp *interp,
  void *pContext, 
  int argc, 
  const char **argv,
  int *argl
){
  int rc;

  ProcDefn *p = (ProcDefn *)pContext;
  ProcArgs procargs;
................................................................................
  if( rc==TH_RETURN ){
    rc = TH_OK;
  }
  return rc;
}

/*
** This function is registered as the delete callback for all commands 
** created using the built-in [proc] command. It is called automatically 
** when a command created using [proc] is deleted. 
**
** It frees the ProcDefn structure allocated when the command was created.
*/ 
static void proc_del(Th_Interp *interp, void *pContext){
  ProcDefn *p = (ProcDefn *)pContext;
  Th_Free(interp, (void *)p->zUsage);
  Th_Free(interp, (void *)p);
}

/*
** TH Syntax: 
**
**   proc name arglist code
*/
static int proc_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc,
  const char **argv, 
  int *argl
){
  int rc;
  char *zName;

  ProcDefn *p;
  int nByte;
................................................................................
  int i;
  char *zSpace;

  char **azParam;
  int *anParam;
  int nParam;

  char *zUsage = 0;               /* Build up a usage message here */
  int nUsage = 0;                  /* Number of bytes at zUsage */

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "proc name arglist code");
  }
  if( Th_SplitList(interp, argv[2], argl[2], &azParam, &anParam, &nParam) ){
    return TH_ERROR;
  }

  /* Allocate the new ProcDefn structure. */
  nByte = sizeof(ProcDefn) +                        /* ProcDefn structure */
      (sizeof(char *) + sizeof(int)) * nParam +    /* azParam, anParam */
      (sizeof(char *) + sizeof(int)) * nParam +    /* azDefault, anDefault */
      argl[3] +                                     /* zProgram */
      argl[2];     /* Space for copies of parameter names and default values */
  p = (ProcDefn *)Th_Malloc(interp, nByte);

  /* If the last parameter in the parameter list is "args", then set the
  ** ProcDefn.hasArgs flag. The "args" parameter does not require an
  ** entry in the ProcDefn.azParam[] or ProcDefn.azDefault[] arrays.
  */
  if( anParam[nParam-1]==4 && 0==memcmp(azParam[nParam-1], "args", 4) ){
................................................................................
  p->anParam   = (int *)&p->azParam[nParam];
  p->azDefault = (char **)&p->anParam[nParam];
  p->anDefault = (int *)&p->azDefault[nParam];
  p->zProgram = (char *)&p->anDefault[nParam];
  memcpy(p->zProgram, argv[3], argl[3]);
  p->nProgram = argl[3];
  zSpace = &p->zProgram[p->nProgram];
  
  for(i=0; i<nParam; i++){
    char **az;
    int *an;
    int n;
    if( Th_SplitList(interp, azParam[i], anParam[i], &az, &an, &n) ){
      goto error_out;
    }
................................................................................
 error_out:
  Th_Free(interp, azParam);
  Th_Free(interp, zUsage);
  return TH_ERROR;
}

/*
** TH Syntax: 
**
**   rename oldcmd newcmd
*/
static int rename_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc,
  const char **argv, 
  int *argl
){
  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "rename oldcmd newcmd");
  }
  return Th_RenameCommand(interp, argv[1], argl[1], argv[2], argl[2]);
}

/*
** TH Syntax: 
**
**   break    ?value...?
**   continue ?value...?
**   ok       ?value...?
**   error    ?value...?
*/
static int simple_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  if( argc!=1 && argc!=2 ){
    return Th_WrongNumArgs(interp, "return ?value?");
  }
  if( argc==2 ){
    Th_SetResult(interp, argv[1], argl[1]);
  }
  return FOSSIL_PTR_TO_INT(ctx);
}

/*
** TH Syntax: 
**
**   return ?-code code? ?value?
*/
static int return_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int iCode = TH_RETURN;
  if( argc<1 || argc>4 ){
    return Th_WrongNumArgs(interp, "return ?-code code? ?value?");
  }
  if( argc>2 ){
................................................................................
  }
  if( iRes==0 ){
    iRes = nLeft-nRight;
  }

  if( iRes<0 ) iRes = -1;
  if( iRes>0 ) iRes = 1;
  
  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string first NEEDLE HAYSTACK
................................................................................

  for(i=0; i<(nHaystack-nNeedle); i++){
    if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
      iRes = i;
      break;
    }
  }
  
  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string is CLASS STRING
................................................................................

  for(i=nHaystack-nNeedle-1; i>=0; i--){
    if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
      iRes = i;
      break;
    }
  }
  
  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string length STRING
................................................................................

/*
** TH Syntax:
**
**   unset VAR
*/
static int unset_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "unset var");
  }
  return Th_UnsetVar(interp, argv[1], argl[1]);
}

int Th_CallSubCommand(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl,
  Th_SubCommand *aSub
){
  if( argc>1 ){
................................................................................
**   string is      CLASS STRING
**   string last    NEEDLE HAYSTACK ?STARTINDEX?
**   string length  STRING
**   string range   STRING FIRST LAST
**   string repeat  STRING COUNT
*/
static int string_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Th_SubCommand aSub[] = {
    { "compare", string_compare_command },
................................................................................

/*
** TH Syntax:
**
**   info exists VARNAME
*/
static int info_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Th_SubCommand aSub[] = {
    { "exists",  info_exists_command },
    { 0, 0 }
  };
  return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
}

/*
** Convert the script level frame specification (used by the commands 
** [uplevel] and [upvar]) in (zFrame, nFrame) to an integer frame as 
** used by Th_LinkVar() and Th_Eval(). If successful, write the integer
** frame level to *piFrame and return TH_OK. Otherwise, return TH_ERROR
** and leave an error message in the interpreter result.
*/
static int thToFrame(
  Th_Interp *interp, 
  const char *zFrame, 
  int nFrame, 
  int *piFrame
){
  int iFrame;
  if( th_isdigit(zFrame[0]) ){
    int rc = Th_ToInt(interp, zFrame, nFrame, &iFrame);
    if( rc!=TH_OK ) return rc;
    iFrame = iFrame * -1;
................................................................................

/*
** TH Syntax:
**
**   uplevel ?LEVEL? SCRIPT
*/
static int uplevel_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int iFrame = -1;

................................................................................
  if( argc==3 && TH_OK!=thToFrame(interp, argv[1], argl[1], &iFrame) ){
    return TH_ERROR;
  }
  return Th_Eval(interp, iFrame, argv[argc-1], -1);
}

/*
** TH Syntax: 
**
**   upvar ?FRAME? OTHERVAR MYVAR ?OTHERVAR MYVAR ...?
*/
static int upvar_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int iVar = 1;
  int iFrame = -1;
  int rc = TH_OK;
  int i;

  if( TH_OK==thToFrame(0, argv[1], argl[1], &iFrame) ){
    iVar++;
  }
  if( argc==iVar || (argc-iVar)%2 ){
    return Th_WrongNumArgs(interp, 
        "upvar frame othervar myvar ?othervar myvar...?");
  }
  for(i=iVar; rc==TH_OK && i<argc; i=i+2){
    rc = Th_LinkVar(interp, argv[i+1], argl[i+1], iFrame, argv[i], argl[i]);
  }
  return rc;
}

/*
** TH Syntax: 
**
**   breakpoint ARGS
**
** This command does nothing at all. Its purpose in life is to serve
** as a point for setting breakpoints in a debugger.
*/
static int breakpoint_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const char **argv, 
  int *argl
){
  int cnt = 0;
  cnt++;
  return TH_OK;
}

................................................................................
    {"expr",     expr_command,    0},
    {"for",      for_command,     0},
    {"if",       if_command,      0},
    {"info",     info_command,    0},
    {"lindex",   lindex_command,  0},
    {"list",     list_command,    0},
    {"llength",  llength_command, 0},
    {"proc",     proc_command,    0}, 
    {"rename",   rename_command,  0},
    {"set",      set_command,     0},
    {"string",   string_command,  0},
    {"unset",    unset_command,   0},
    {"uplevel",  uplevel_command, 0},
    {"upvar",    upvar_command,   0},

    {"breakpoint", breakpoint_command, 0},

    {"return",   return_command, 0},
    {"break",    simple_command, (void *)TH_BREAK}, 
    {"continue", simple_command, (void *)TH_CONTINUE}, 
    {"error",    simple_command, (void *)TH_ERROR}, 

    {0, 0, 0}
  };
  int i;

  /* Add the language commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){


|
|

|
|







 







|




|
|
|
|







 







|




|
|
|
|







 







|




|
|
|
|










|












|




|
|
|
|












|













|




|
|
|
|









|







|




|
|
|
|







 







|




|
|
|
|







 







|




|
|
|
|







 







|
|





|

|


|

|



|
|







 







|







 







|
|







 







|
|
|


|







|




|
|

|







 







|











|
|

|







 







|







 







|




|
|

|









|







|
|
|
|












|




|
|
|
|







 







|







 







|







 







|







 







|












|







 







|







 







|













|
|





|
|
|







 







|







 







|




|
|
|
|











|









|







|
|
|
|







 







|










|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
...
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
...
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
...
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
...
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
...
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
...
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
...
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
...
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
...
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
...
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
...
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
...
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
...
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
....
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
....
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103

/*
** This file contains the implementation of all of the TH language
** built-in commands.
**
** All built-in commands are implemented using the public interface
** declared in th.h, so this file serves as both a part of the language
** implementation and an example of how to extend the language with
** new commands.
*/

#include "config.h"
#include "th.h"
#include <string.h>
................................................................................

int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg){
  Th_ErrorMessage(interp, "wrong # args: should be \"", zMsg, -1);
  return TH_ERROR;
}

/*
** Syntax:
**
**   catch script ?varname?
*/
static int catch_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int rc;

  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "catch script ?varname?");
  }
................................................................................
  }

  Th_SetResultInt(interp, rc);
  return TH_OK;
}

/*
** TH Syntax:
**
**   if expr1 body1 ?elseif expr2 body2? ? ?else? bodyN?
*/
static int if_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int rc = TH_OK;

  int iCond;           /* Result of evaluating expression */
  int i;

................................................................................
  return rc;

wrong_args:
  return Th_WrongNumArgs(interp, "if ...");
}

/*
** TH Syntax:
**
**   expr expr
*/
static int expr_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "expr expression");
  }

  return Th_Expr(interp, argv[1], argl[1]);
}

/*
** Evaluate the th1 script (zBody, nBody) in the local stack frame.
** Return the result of the evaluation, except if the result
** is TH_CONTINUE, return TH_OK instead.
*/
static int eval_loopbody(Th_Interp *interp, const char *zBody, int nBody){
  int rc = Th_Eval(interp, 0, zBody, nBody);
  if( rc==TH_CONTINUE ){
    rc = TH_OK;
  }
  return rc;
}

/*
** TH Syntax:
**
**   for init condition incr script
*/
static int for_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int rc;
  int iCond;

  if( argc!=5 ){
    return Th_WrongNumArgs(interp, "for init condition incr script");
  }

  /* Evaluate the 'init' script */
  rc = Th_Eval(interp, 0, argv[1], -1);

  while( rc==TH_OK
     && TH_OK==(rc = Th_Expr(interp, argv[2], -1))
     && TH_OK==(rc = Th_ToInt(interp, Th_GetResult(interp, 0), -1, &iCond))
     && iCond
     && TH_OK==(rc = eval_loopbody(interp, argv[4], argl[4]))
  ){
    rc = Th_Eval(interp, 0, argv[3], -1);
  }

  if( rc==TH_BREAK ) rc = TH_OK;
  return rc;
}

/*
** TH Syntax:
**
**   list ?arg1 ?arg2? ...?
*/
static int list_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  char *zList = 0;
  int nList = 0;
  int i;

  for(i=1; i<argc; i++){
    Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]);
  }

  Th_SetResult(interp, zList, nList);
  Th_Free(interp, zList);

  return TH_OK;
}

/*
** TH Syntax:
**
**   lindex list index
*/
static int lindex_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int iElem;
  int rc;

  char **azElem;
  int *anElem;
................................................................................
    Th_Free(interp, azElem);
  }

  return rc;
}

/*
** TH Syntax:
**
**   llength list
*/
static int llength_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int nElem;
  int rc;

  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "llength list");
................................................................................
    Th_SetResultInt(interp, nElem);
  }

  return rc;
}

/*
** TH Syntax:
**
**   set varname ?value?
*/
static int set_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=2 && argc!=3 ){
    return Th_WrongNumArgs(interp, "set varname ?value?");
  }

  if( argc==3 ){
................................................................................
    Th_SetVar(interp, argv[1], argl[1], argv[2], argl[2]);
  }
  return Th_GetVar(interp, argv[1], argl[1]);
}

/*
** When a new command is created using the built-in [proc] command, an
** instance of the following structure is allocated and populated. A
** pointer to the structure is passed as the context (second) argument
** to function proc_call1() when the new command is executed.
*/
typedef struct ProcDefn ProcDefn;
struct ProcDefn {
  int nParam;                /* Number of formal (non "args") parameters */
  char **azParam;            /* Parameter names */
  int *anParam;              /* Lengths of parameter names */
  char **azDefault;          /* Default values */
  int *anDefault;            /* Lengths of default values */
  int hasArgs;               /* True if there is an "args" parameter */
  char *zProgram;            /* Body of proc */
  int nProgram;              /* Number of bytes at zProgram */
  char *zUsage;              /* Usage message */
  int nUsage;                /* Number of bytes at zUsage */
};

/* This structure is used to temporarily store arguments passed to an
** invocation of a command created using [proc]. A pointer to an
** instance is passed as the second argument to the proc_call2() function.
*/
typedef struct ProcArgs ProcArgs;
struct ProcArgs {
  int argc;
  const char **argv;
  int *argl;
................................................................................
  int i;
  ProcDefn *p = (ProcDefn *)pContext1;
  ProcArgs *pArgs = (ProcArgs *)pContext2;

  /* Check if there are the right number of arguments. If there are
  ** not, generate a usage message for the command.
  */
  if( (pArgs->argc>(p->nParam+1) && !p->hasArgs)
   || (pArgs->argc<=(p->nParam) && !p->azDefault[pArgs->argc-1])
  ){
    char *zUsage = 0;
    int nUsage = 0;
    Th_StringAppend(interp, &zUsage, &nUsage, pArgs->argv[0], pArgs->argl[0]);
    Th_StringAppend(interp, &zUsage, &nUsage, p->zUsage, p->nUsage);
    Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"", 1);
................................................................................
/*
** This function is the command callback registered for all commands
** created using the [proc] command. The second argument, pContext,
** is a pointer to the associated ProcDefn structure.
*/
static int proc_call1(
  Th_Interp *interp,
  void *pContext,
  int argc,
  const char **argv,
  int *argl
){
  int rc;

  ProcDefn *p = (ProcDefn *)pContext;
  ProcArgs procargs;
................................................................................
  if( rc==TH_RETURN ){
    rc = TH_OK;
  }
  return rc;
}

/*
** This function is registered as the delete callback for all commands
** created using the built-in [proc] command. It is called automatically
** when a command created using [proc] is deleted.
**
** It frees the ProcDefn structure allocated when the command was created.
*/
static void proc_del(Th_Interp *interp, void *pContext){
  ProcDefn *p = (ProcDefn *)pContext;
  Th_Free(interp, (void *)p->zUsage);
  Th_Free(interp, (void *)p);
}

/*
** TH Syntax:
**
**   proc name arglist code
*/
static int proc_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int rc;
  char *zName;

  ProcDefn *p;
  int nByte;
................................................................................
  int i;
  char *zSpace;

  char **azParam;
  int *anParam;
  int nParam;

  char *zUsage = 0;                /* Build up a usage message here */
  int nUsage = 0;                  /* Number of bytes at zUsage */

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "proc name arglist code");
  }
  if( Th_SplitList(interp, argv[2], argl[2], &azParam, &anParam, &nParam) ){
    return TH_ERROR;
  }

  /* Allocate the new ProcDefn structure. */
  nByte = sizeof(ProcDefn) +                        /* ProcDefn structure */
      (sizeof(char *) + sizeof(int)) * nParam +     /* azParam, anParam */
      (sizeof(char *) + sizeof(int)) * nParam +     /* azDefault, anDefault */
      argl[3] +                                     /* zProgram */
      argl[2];    /* Space for copies of parameter names and default values */
  p = (ProcDefn *)Th_Malloc(interp, nByte);

  /* If the last parameter in the parameter list is "args", then set the
  ** ProcDefn.hasArgs flag. The "args" parameter does not require an
  ** entry in the ProcDefn.azParam[] or ProcDefn.azDefault[] arrays.
  */
  if( anParam[nParam-1]==4 && 0==memcmp(azParam[nParam-1], "args", 4) ){
................................................................................
  p->anParam   = (int *)&p->azParam[nParam];
  p->azDefault = (char **)&p->anParam[nParam];
  p->anDefault = (int *)&p->azDefault[nParam];
  p->zProgram = (char *)&p->anDefault[nParam];
  memcpy(p->zProgram, argv[3], argl[3]);
  p->nProgram = argl[3];
  zSpace = &p->zProgram[p->nProgram];

  for(i=0; i<nParam; i++){
    char **az;
    int *an;
    int n;
    if( Th_SplitList(interp, azParam[i], anParam[i], &az, &an, &n) ){
      goto error_out;
    }
................................................................................
 error_out:
  Th_Free(interp, azParam);
  Th_Free(interp, zUsage);
  return TH_ERROR;
}

/*
** TH Syntax:
**
**   rename oldcmd newcmd
*/
static int rename_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "rename oldcmd newcmd");
  }
  return Th_RenameCommand(interp, argv[1], argl[1], argv[2], argl[2]);
}

/*
** TH Syntax:
**
**   break    ?value...?
**   continue ?value...?
**   ok       ?value...?
**   error    ?value...?
*/
static int simple_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=1 && argc!=2 ){
    return Th_WrongNumArgs(interp, "return ?value?");
  }
  if( argc==2 ){
    Th_SetResult(interp, argv[1], argl[1]);
  }
  return FOSSIL_PTR_TO_INT(ctx);
}

/*
** TH Syntax:
**
**   return ?-code code? ?value?
*/
static int return_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int iCode = TH_RETURN;
  if( argc<1 || argc>4 ){
    return Th_WrongNumArgs(interp, "return ?-code code? ?value?");
  }
  if( argc>2 ){
................................................................................
  }
  if( iRes==0 ){
    iRes = nLeft-nRight;
  }

  if( iRes<0 ) iRes = -1;
  if( iRes>0 ) iRes = 1;

  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string first NEEDLE HAYSTACK
................................................................................

  for(i=0; i<(nHaystack-nNeedle); i++){
    if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
      iRes = i;
      break;
    }
  }

  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string is CLASS STRING
................................................................................

  for(i=nHaystack-nNeedle-1; i>=0; i--){
    if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
      iRes = i;
      break;
    }
  }

  return Th_SetResultInt(interp, iRes);
}

/*
** TH Syntax:
**
**   string length STRING
................................................................................

/*
** TH Syntax:
**
**   unset VAR
*/
static int unset_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "unset var");
  }
  return Th_UnsetVar(interp, argv[1], argl[1]);
}

int Th_CallSubCommand(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl,
  Th_SubCommand *aSub
){
  if( argc>1 ){
................................................................................
**   string is      CLASS STRING
**   string last    NEEDLE HAYSTACK ?STARTINDEX?
**   string length  STRING
**   string range   STRING FIRST LAST
**   string repeat  STRING COUNT
*/
static int string_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Th_SubCommand aSub[] = {
    { "compare", string_compare_command },
................................................................................

/*
** TH Syntax:
**
**   info exists VARNAME
*/
static int info_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  Th_SubCommand aSub[] = {
    { "exists",  info_exists_command },
    { 0, 0 }
  };
  return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
}

/*
** Convert the script level frame specification (used by the commands
** [uplevel] and [upvar]) in (zFrame, nFrame) to an integer frame as
** used by Th_LinkVar() and Th_Eval(). If successful, write the integer
** frame level to *piFrame and return TH_OK. Otherwise, return TH_ERROR
** and leave an error message in the interpreter result.
*/
static int thToFrame(
  Th_Interp *interp,
  const char *zFrame,
  int nFrame,
  int *piFrame
){
  int iFrame;
  if( th_isdigit(zFrame[0]) ){
    int rc = Th_ToInt(interp, zFrame, nFrame, &iFrame);
    if( rc!=TH_OK ) return rc;
    iFrame = iFrame * -1;
................................................................................

/*
** TH Syntax:
**
**   uplevel ?LEVEL? SCRIPT
*/
static int uplevel_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int iFrame = -1;

................................................................................
  if( argc==3 && TH_OK!=thToFrame(interp, argv[1], argl[1], &iFrame) ){
    return TH_ERROR;
  }
  return Th_Eval(interp, iFrame, argv[argc-1], -1);
}

/*
** TH Syntax:
**
**   upvar ?FRAME? OTHERVAR MYVAR ?OTHERVAR MYVAR ...?
*/
static int upvar_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int iVar = 1;
  int iFrame = -1;
  int rc = TH_OK;
  int i;

  if( TH_OK==thToFrame(0, argv[1], argl[1], &iFrame) ){
    iVar++;
  }
  if( argc==iVar || (argc-iVar)%2 ){
    return Th_WrongNumArgs(interp,
        "upvar frame othervar myvar ?othervar myvar...?");
  }
  for(i=iVar; rc==TH_OK && i<argc; i=i+2){
    rc = Th_LinkVar(interp, argv[i+1], argl[i+1], iFrame, argv[i], argl[i]);
  }
  return rc;
}

/*
** TH Syntax:
**
**   breakpoint ARGS
**
** This command does nothing at all. Its purpose in life is to serve
** as a point for setting breakpoints in a debugger.
*/
static int breakpoint_command(
  Th_Interp *interp,
  void *ctx,
  int argc,
  const char **argv,
  int *argl
){
  int cnt = 0;
  cnt++;
  return TH_OK;
}

................................................................................
    {"expr",     expr_command,    0},
    {"for",      for_command,     0},
    {"if",       if_command,      0},
    {"info",     info_command,    0},
    {"lindex",   lindex_command,  0},
    {"list",     list_command,    0},
    {"llength",  llength_command, 0},
    {"proc",     proc_command,    0},
    {"rename",   rename_command,  0},
    {"set",      set_command,     0},
    {"string",   string_command,  0},
    {"unset",    unset_command,   0},
    {"uplevel",  uplevel_command, 0},
    {"upvar",    upvar_command,   0},

    {"breakpoint", breakpoint_command, 0},

    {"return",   return_command, 0},
    {"break",    simple_command, (void *)TH_BREAK},
    {"continue", simple_command, (void *)TH_CONTINUE},
    {"error",    simple_command, (void *)TH_ERROR},

    {0, 0, 0}
  };
  int i;

  /* Add the language commands. */
  for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){

Changes to test/th1.test.

145
146
147
148
149
150
151





fossil test-th-eval "set var 1; unset var"
test th1-unset-1 {$RESULT eq {var}}

###############################################################################

fossil test-th-eval "unset var"
test th1-unset-2 {$RESULT eq {TH_ERROR: no such variable: var}}












>
>
>
>
>
145
146
147
148
149
150
151
152
153
154
155
156
fossil test-th-eval "set var 1; unset var"
test th1-unset-1 {$RESULT eq {var}}

###############################################################################

fossil test-th-eval "unset var"
test th1-unset-2 {$RESULT eq {TH_ERROR: no such variable: var}}

###############################################################################

fossil test-th-eval "set var 1; unset var; unset var"
test th1-unset-3 {$RESULT eq {TH_ERROR: no such variable: var}}

Changes to www/makefile.wiki.

205
206
207
208
209
210
211

212
213
214
215
216


217
218
219
220
221
222
223
Some files require special C-preprocessor macro definitions.
When compiling sqlite.c, the following macros are recommended:

  *  -DSQLITE_OMIT_LOAD_EXTENSION=1
  *  -DSQLITE_ENABLE_LOCKING_STYLE=0
  *  -DSQLITE_THREADSAFE=0
  *  -DSQLITE_DEFAULT_FILE_FORMAT=4


The first symbol definition above is required; the others
are merely recommended.  Extension loading is omitted
as a security measure.  Fossil is single-threaded so mutexing is disabled
in SQLite as a performance enhancement.



When compiling the shell.c source file, these macros are required:

  *  -Dmain=sqlite3_main
  *  -DSQLITE_OMIT_LOAD_EXTENSION=1

The "main()" routine in the shell must be changed into sqlite3_main()







>




|
>
>







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
Some files require special C-preprocessor macro definitions.
When compiling sqlite.c, the following macros are recommended:

  *  -DSQLITE_OMIT_LOAD_EXTENSION=1
  *  -DSQLITE_ENABLE_LOCKING_STYLE=0
  *  -DSQLITE_THREADSAFE=0
  *  -DSQLITE_DEFAULT_FILE_FORMAT=4
  *  -DSQLITE_ENABLE_EXPLAIN_COMMENTS=1

The first symbol definition above is required; the others
are merely recommended.  Extension loading is omitted
as a security measure.  Fossil is single-threaded so mutexing is disabled
in SQLite as a performance enhancement.  The SQLITE_ENABLE_EXPLAIN_COMMENTS
option makes the output of "EXPLAIN" queries in the 
"[/help?cmd=sqlite3|fossil sql]" command much more readable.

When compiling the shell.c source file, these macros are required:

  *  -Dmain=sqlite3_main
  *  -DSQLITE_OMIT_LOAD_EXTENSION=1

The "main()" routine in the shell must be changed into sqlite3_main()