Fossil

typedef struct Th_Variable  Th_Variable;

/*
** Interpreter structure.
*/
struct Th_Interp {
  Th_Vtab *pVtab;     /* Copy of the argument passed to Th_CreateInterp() */
  uchar *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 TH command registered using Th_CreateCommand() is represented
** by an instance of the following structure stored in the Th_Interp.paCmd
** hash-table.
*/
struct Th_Command {
  int (*xProc)(Th_Interp *, void *, int, const uchar **, int *);
  void *pContext;
  void (*xDel)(Th_Interp *, void *);
};

/*
** Each stack frame (variable scope) is represented by an instance
** of this structure. Variable values set using the Th_SetVar command

** a hash table mapping between array key name (a th1 string) and
** a the 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 */
  uchar *zData;               /* Data for scalar variables */
  Th_Hash *pHash;             /* Data for array variables */
};

/*
** Hash table API:
*/
#define TH_HASHSIZE 257
struct Th_Hash {
  Th_HashEntry *a[TH_HASHSIZE];
};

static int thEvalLocal(Th_Interp *, const uchar *, int);
static int thSplitList(Th_Interp*, const uchar*, int, uchar***, int **, int*);

static int thHexdigit(uchar c);
static int thEndOfLine(const uchar *, int);

static int  thPushFrame(Th_Interp*, Th_Frame*);
static void thPopFrame(Th_Interp*);

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

**
** 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 uchar *z, int n, int *pN);
static int thNextEscape (Th_Interp*, const uchar *z, int n, int *pN);
static int thNextVarname(Th_Interp*, const uchar *z, int n, int *pN);
static int thNextNumber (Th_Interp*, const uchar *z, int n, int *pN);
static int thNextSpace  (Th_Interp*, const uchar *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 uchar *z, int n);
static int thSubstEscape (Th_Interp*, const uchar *z, int n);
static int thSubstVarname(Th_Interp*, const uchar *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 uchar *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.
*/
static int thSubstWord(Th_Interp*, const uchar *z, int n);

/*
** The Buffer structure and the thBufferXXX() functions are used to make
** memory allocation easier when building up a result.
*/
struct Buffer {
  uchar *zBuf;
  int nBuf;
  int nBufAlloc;
};
typedef struct Buffer Buffer;
static int  thBufferWrite(Th_Interp *interp, Buffer *, const uchar *, int);
static void thBufferInit(Buffer *);
static void thBufferFree(Th_Interp *interp, Buffer *);

/*
** 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 uchar *zAdd, 
  int nAdd
){
  int nReq;

  if( nAdd<0 ){
    nAdd = th_strlen(zAdd);
  }
  nReq = pBuffer->nBuf+nAdd+1;

  if( nReq>pBuffer->nBufAlloc ){
    uchar *zNew;
    int nNew;

    nNew = nReq*2;
    zNew = (uchar *)Th_Malloc(interp, nNew);
    memcpy(zNew, pBuffer->zBuf, pBuffer->nBuf);
    Th_Free(interp, pBuffer->zBuf);
    pBuffer->nBufAlloc = nNew;
    pBuffer->zBuf = zNew;
  }

  memcpy(&pBuffer->zBuf[pBuffer->nBuf], zAdd, nAdd);
  pBuffer->nBuf += nAdd;
  pBuffer->zBuf[pBuffer->nBuf] = '\0';

  return TH_OK;
}
#define thBufferWrite(a,b,c,d) thBufferWrite(a,b,(const uchar *)c,d)

/*
** Initialize the Buffer structure pointed to by pBuffer.
*/
static void thBufferInit(Buffer *pBuffer){
  memset(pBuffer, 0, sizeof(Buffer));
}

}

/*
** Assuming parameter c contains a hexadecimal digit character,
** return the corresponding value of that digit. If c is not
** a hexadecimal digit character, -1 is returned.
*/
static int thHexdigit(uchar c){
  switch (c) {
    case '0': return 0;
    case '1': return 1;
    case '2': return 2;
    case '3': return 3;
    case '4': return 4;
    case '5': return 5;

** 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 uchar *zInput, 
  int nInput, 
  int *pnEscape
){
  int i = 2;

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

** 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 uchar *zInput, 
  int nInput, 
  int *pnVarname
){
  int i;

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

** 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 uchar *zInput, 
  int nInput, 
  int *pnCommand
){
  int nBrace = 0;
  int nSquare = 0;
  int i;

/*
** 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 uchar *zInput, 
  int nInput, 
  int *pnSpace
){
  int i;
  for(i=0; i<nInput && th_isspace(zInput[i]); i++);
  *pnSpace = i;
  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 uchar *zInput, 
  int nInput, 
  int *pnWord,
  int isCmd
){
  int iEnd = 0;

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

/*
** The input string (zWord, nWord) contains a th1 script enclosed in
** a [] block. Perform substitution on the input string and store the
** resulting string in the interpreter result.
*/
static int thSubstCommand(
  Th_Interp *interp,
  const uchar *zWord,
  int nWord
){
  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 uchar *zWord,
  int nWord
){
  assert(nWord>=1);
  assert(zWord[0]=='$');
  assert(nWord==1 || zWord[1]!='{' || zWord[nWord-1]=='}');
  if( nWord>1 && zWord[1]=='{' ){
    zWord++;
    nWord -= 2;
  }else if( zWord[nWord-1]==')' ){
    int i;
    for(i=1; i<nWord && zWord[i]!='('; i++);
    if( i<nWord ){
      Buffer varname;
      int nInner;
      const uchar *zInner;

      int rc = thSubstWord(interp, &zWord[i+1], nWord-i-2);
      if( rc!=TH_OK ) return rc;

      zInner = Th_GetResult(interp, &nInner);
      thBufferInit(&varname);
      thBufferWrite(interp, &varname, &zWord[1], i);

/*
** 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 uchar *zWord,
  int nWord
){
  uchar c;

  assert(nWord>=2);
  assert(zWord[0]=='\\');

  switch( zWord[1] ){
    case 'x': {
      assert(nWord==4);

/*
** 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 uchar *zWord,
  int nWord
){
  int rc = TH_OK;
  Buffer output;
  int i;

  thBufferInit(&output);

      zWord++;
      nWord -= 2;
    }

    for(i=0; rc==TH_OK && i<nWord; i++){
      int nGet;

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

      switch( zWord[i] ){
        case '\\':
          xGet = thNextEscape; xSubst = thSubstEscape; 
          break;
        case '[':
          if( !interp->isListMode ){

      }

      rc = xGet(interp, &zWord[i], nWord-i, &nGet);
      if( rc==TH_OK ){
        rc = xSubst(interp, &zWord[i], nGet);
      }
      if( rc==TH_OK ){
        const uchar *zRes;
        int nRes;
        zRes = Th_GetResult(interp, &nRes);
        rc = thBufferWrite(interp, &output, zRes, nRes);
        i += (nGet-1);
      }
    }
  }

**   + 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 uchar *zInput, int nInput){
  int i;
  for(i=0; i<nInput && zInput[i]!='\n' && th_isspace(zInput[i]); i++);
  return ((i==nInput || zInput[i]=='\n')?1:0);
}

/*
** This function splits the supplied th1 list (contained in buffer zList,
** size nList) into elements and performs word-substitution on each
** element. If the Th_Interp.isListMode variable is true, then only
** escape sequences are substituted (used by the Th_SplitList() function).
** If Th_Interp.isListMode is false, then variable and command substitution
** is also performed (used by Th_Eval()).
**
** If zList/nList does not contain a valid list, TH_ERROR is returned
** and an error message stored in interp.
**
** If TH_OK is returned and pazElem is not NULL, the caller should free the
** pointer written to (*pazElem) using Th_Free(). This releases memory
** allocated for both the (*pazElem) and (*panElem) arrays. Example:
**
**     uchar **argv;
**     int *argl;
**     int argc;
**
**     // After this call, argv and argl point to valid arrays. The
**     // number of elements in each is argc.
**     //
**     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 uchar *zList,     /* Pointer to buffer containing input list */
  int nList,              /* Size of buffer pointed to by zList */
  uchar ***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;
  int nCount = 0;

  const uchar *zInput = zList;
  int nInput = nList;

  thBufferInit(&strbuf);
  thBufferInit(&lenbuf);

  while( nInput>0 ){
    const uchar *zWord;
    int nWord;

    thNextSpace(interp, zInput, nInput, &nWord);
    zInput += nWord;
    nInput = nList-(zInput-zList);

    if( TH_OK!=(rc = thNextWord(interp, zInput, nInput, &nWord, 0))

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

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

  return rc;
}

/*
** Evaluate the th1 script contained in the string (zProgram, nProgram)
** in the current stack frame.
*/
static int thEvalLocal(Th_Interp *interp, const uchar *zProgram, int nProgram){
  int rc = TH_OK;
  const uchar *zInput = zProgram;
  int nInput = nProgram;

  while( rc==TH_OK && nInput ){
    Th_HashEntry *pEntry;
    int nSpace;
    const uchar *zFirst;

    uchar **argv;
    int *argl;
    int argc;

    assert(nInput>=0);

    /* Skip a semi-colon */
    if( *zInput==';' ){

        Th_ErrorMessage(interp, "no such command: ", argv[0], argl[0]);
        rc = TH_ERROR;
      }

      /* Call the command procedure. */
      if( rc==TH_OK ){
        Th_Command *p = (Th_Command *)(pEntry->pData);
        const uchar **azArg = (const uchar **)argv;
        rc = p->xProc(interp, p->pContext, argc, azArg, argl);
      }
  
      /* If an error occured, add this command to the stack trace report. */
      if( rc==TH_ERROR ){
        uchar *zRes;
        int nRes;
        uchar *zStack = 0;
        int nStack = 0;
  
        zRes = Th_TakeResult(interp, &nRes);
        if( TH_OK==Th_GetVar(interp, (uchar *)"::th_stack_trace", -1) ){
          zStack = Th_TakeResult(interp, &nStack);
        }
        Th_ListAppend(interp, &zStack, &nStack, zFirst, zInput-zFirst);
        Th_SetVar(interp, (uchar *)"::th_stack_trace", -1, zStack, nStack);
        Th_SetResult(interp, zRes, nRes);
        Th_Free(interp, zRes);
        Th_Free(interp, zStack);
      }
    }

    Th_Free(interp, argv);

    p = interp->pFrame;
  }
  for(i=0; p && i<(iFrame*-1); i++){
    p = p->pCaller;
  }

  if( !p ){
    uchar *zFrame;
    int nFrame;
    Th_SetResultInt(interp, iFrame);
    zFrame = Th_TakeResult(interp, &nFrame);
    Th_ErrorMessage(interp, "no such frame:", zFrame, nFrame);
    Th_Free(interp, zFrame);
  }
  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 uchar *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.
  */

** false. Output string (*pzOuter, *pnOuter) is set to the variable name
** if it is a scalar reference, or the name of the array if it is an
** 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 uchar *zVarname,
  int nVarname,
  const uchar **pzOuter,     /* OUT: Pointer to scalar/array name */
  int *pnOuter,              /* OUT: Number of bytes at *pzOuter */
  const uchar **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 uchar *zOuter = zVarname;
  int nOuter;
  const uchar *zInner = 0;
  int nInner = 0;
  int isGlobal = 0;
  int i;

  if( nVarname<0 ){
    nVarname = th_strlen(zVarname);
  }

**
** 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 uchar *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. Othewise array==error */
){
  const uchar *zOuter;
  int nOuter;
  const uchar *zInner;
  int nInner;
  int isGlobal;

  Th_HashEntry *pEntry;
  Th_Frame *pFrame = interp->pFrame;
  Th_Variable *pValue;

** 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 uchar *zVar, int nVar){
  Th_Variable *pValue;

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

** 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 uchar *zVar, 
  int nVar,
  const uchar *zValue,
  int nValue
){
  Th_Variable *pValue;

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

/*
** 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 uchar *zLocal, int nLocal,   /* Local varname */
  int iFrame,                        /* Stack frame of linked var */
  const uchar *zLink, int nLink      /* Linked varname */
){
  Th_Frame *pSavedFrame = interp->pFrame;
  Th_Frame *pFrame;
  Th_HashEntry *pEntry;
  Th_Variable *pValue;

  pFrame = getFrame(interp, iFrame);

/*
** Input string (zVar, nVar) must contain the name of a scalar variable,
** an array, or an array member. If the identified variable exists, it
** is deleted and TH_OK returned. Otherwise, an error message is left
** in the interpreter result and TH_ERROR is returned.
*/
int Th_UnsetVar(Th_Interp *interp, const uchar *zVar, int nVar){
  Th_Variable *pValue;

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

}

/*
** 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.
*/
uchar *th_strdup(Th_Interp *interp, const uchar *z, int n){
  uchar *zRes;
  if( n<0 ){
    n = th_strlen(z);
  }
  zRes = Th_Malloc(interp, n+1);
  memcpy(zRes, z, n);
  zRes[n] = '\0';
  return zRes;

**     printf("%s %.*s", zPre, n, z);
**
** Example:
**
**     Th_ErrorMessage(interp, "no such variable:", zVarname, nVarname);
**
*/
int Th_ErrorMessage(Th_Interp *interp, const char *zPre, const uchar *z, int n){
  if( interp ){
    uchar *zRes = 0;
    int nRes = 0;
    int nPre = th_strlen(zPre);

    Th_SetVar(interp, (uchar *)"::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 uchar *)"\"", 1);
    }else{
      Th_StringAppend(interp, &zRes, &nRes, (const uchar *)" ", 1);
      Th_StringAppend(interp, &zRes, &nRes, z, n);
    }

    Th_SetResult(interp, zRes, nRes);
    Th_Free(interp, zRes);
  }

  return TH_OK;
}

/*
** Set the current interpreter result by taking a copy of the buffer
** pointed to by z, size n bytes. TH_OK is always returned.
*/
int Th_SetResult(Th_Interp *pInterp, const uchar *z, int n){

  /* Free the current result */
  Th_Free(pInterp, pInterp->zResult);
  pInterp->zResult = 0;
  pInterp->nResult = 0;

  if( n<0 ){
    n = th_strlen(z);
  }

  if( z && n>0 ){
    uchar *zResult;
    zResult = Th_Malloc(pInterp, n+1);
    memcpy(zResult, z, n);
    zResult[n] = '\0';
    pInterp->zResult = zResult;
    pInterp->nResult = n;
  }

  return TH_OK;
}

/*
** Return a pointer to the buffer containing the current interpreter
** result. If pN is not NULL, set *pN to the size of the returned
** buffer.
*/
const uchar *Th_GetResult(Th_Interp *pInterp, int *pN){
  assert(pInterp->zResult || pInterp->nResult==0);
  if( pN ){
    *pN = pInterp->nResult;
  }
  return (pInterp->zResult ? pInterp->zResult : (const uchar *)"");
}

/*
** Return a pointer to the buffer containing the current interpreter
** result. If pN is not NULL, set *pN to the size of the returned
** buffer.
**
** This function is the same as Th_GetResult() except that the
** caller is responsible for eventually calling Th_Free() on the
** returned buffer. The internal interpreter result is cleared
** after this function is called.
*/
uchar *Th_TakeResult(Th_Interp *pInterp, int *pN){
  if( pN ){
    *pN = pInterp->nResult;
  }
  if( pInterp->zResult ){
    uchar *zResult = pInterp->zResult;
    pInterp->zResult = 0;
    pInterp->nResult = 0;
    return zResult;
  }else{
    return (uchar *)Th_Malloc(pInterp, 1);
  }
}


/* 
** Wrappers around the supplied malloc() and free() 
*/

  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;

  pEntry = Th_HashFind(interp, interp->paCmd, (const uchar *)zName, -1, 1);
  if( pEntry->pData ){
    pCommand = pEntry->pData;
    if( pCommand->xDel ){
      pCommand->xDel(interp, pCommand->pContext);
    }
  }else{
    pCommand = Th_Malloc(interp, sizeof(Th_Command));

**
** 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 uchar *zName,            /* Existing command name */
  int nName,                     /* Number of bytes at zName */
  const uchar *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 ){

** should call Th_Free() on *pazElem only. Exactly one such call to
** Th_Free() must be made per call to Th_SplitList().
**
** Example:
**
**     int nElem;
**     int *anElem;
**     uchar **azElem;
**     int i;
**
**     Th_SplitList(interp, zList, nList, &azElem, &anElem, &nElem);
**     for(i=0; i<nElem; i++){
**       int nData = anElem[i];
**       uchar *zData = azElem[i];
**       ...
**     }
**
**     Th_Free(interp, azElem);
**
*/
int Th_SplitList(
  Th_Interp *interp,
  const uchar *zList,             /* Pointer to buffer containing list */
  int nList,                      /* Number of bytes at zList */
  uchar ***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;

**
** 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:
**
**     uchar *zList = 0;
**     int nList = 0;
**     for (...) {
**       uchar *zElem = <some expression>;
**       Th_ListAppend(interp, &zList, &nList, zElem, -1);
**     }
**     Th_SetResult(interp, zList, nList);
**     Th_Free(interp, zList);
**
*/
int Th_ListAppend(
  Th_Interp *interp,           /* Interpreter context */
  uchar **pzList,              /* IN/OUT: Ptr to ptr to list */
  int *pnList,                 /* IN/OUT: Current length of *pzList */
  const uchar *zElem,          /* Data to append */
  int nElem                    /* Length of nElem */
){
  Buffer output;
  int i;

  int hasSpecialChar = 0;
  int hasEscapeChar = 0;

    nElem = th_strlen(zElem);
  }
  if( output.nBuf>0 ){
    thBufferWrite(interp, &output, " ", 1);
  }

  for(i=0; i<nElem; i++){
    uchar c = zElem[i];
    if( th_isspecial(c) ) hasSpecialChar = 1;
    if( c=='\\' ) hasEscapeChar = 1;
    if( c=='{' ) nBrace++;
    if( c=='}' ) nBrace--;
  }

  if( nElem==0 || (!hasEscapeChar && hasSpecialChar && nBrace==0) ){
    thBufferWrite(interp, &output, "{", 1);
    thBufferWrite(interp, &output, zElem, nElem);
    thBufferWrite(interp, &output, "}", 1);
  }else{
    for(i=0; i<nElem; i++){
      uchar c = zElem[i];
      if( th_isspecial(c) ) thBufferWrite(interp, &output, "\\", 1);
      thBufferWrite(interp, &output, &c, 1);
    }
  }

  *pzList = output.zBuf;
  *pnList = output.nBuf;

  return TH_OK;
}

/*
** 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 */
  uchar **pzStr,               /* IN/OUT: Ptr to ptr to list */
  int *pnStr,                  /* IN/OUT: Current length of *pzStr */
  const uchar *zElem,          /* Data to append */
  int nElem                    /* Length of nElem */
){
  uchar *zNew;
  int nNew;

  if( nElem<0 ){
    nElem = th_strlen(zElem);
  }

  nNew = *pnStr + nElem;

typedef struct Expr Expr;
struct Expr {
  Operator *pOp;
  Expr *pParent;
  Expr *pLeft;
  Expr *pRight;

  uchar *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

/*
** 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 uchar *zInput, 
  int nInput, 
  int *pnLiteral
){
  int i;
  int seenDot = 0;
  for(i=0; i<nInput; i++){
    uchar c = zInput[i];
    if( (seenDot || c!='.') && !th_isdigit(c) ) break;
    if( c=='.' ) seenDot = 1;
  }
  *pnLiteral = i;
  return TH_OK;
}

    /* Argument values */
    int iLeft;
    int iRight;
    double fLeft;
    double fRight;

    /* Left and right arguments as strings */
    uchar *zLeft = 0; int nLeft;
    uchar *zRight = 0; int nRight;

    /* Evaluate left and right arguments, if they exist. */
    if( pExpr->pLeft ){
      rc = exprEval(interp, pExpr->pLeft);
      if( rc==TH_OK ){
        zLeft = Th_TakeResult(interp, &nLeft);
      }

}

/*
** 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 uchar *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;
  int nToken = 0;
  Expr **apToken = 0;

  for(i=0; rc==TH_OK && i<nExpr; ){
    uchar c = zExpr[i];
    if( th_isspace(c) ){                                /* White-space     */
      i++;
    }else{
      Expr *pNew = (Expr *)Th_Malloc(interp, sizeof(Expr));
      const uchar *z = &zExpr[i];

      switch (c) {
        case '0': case '1': case '2': case '3': case '4':
        case '5': case '6': case '7': case '8': case '9':
          thNextNumber(interp, z, nExpr-i, &pNew->nValue);
          break;

            int nOp;
            if( aOperator[j].iPrecedence==1 && nToken>0 ){
              Expr *pPrev = apToken[nToken-1];
              if( !pPrev->pOp || pPrev->pOp->eOp==OP_CLOSE_BRACKET ){
                continue;
              }
            }
            nOp = th_strlen((const uchar *)aOperator[j].zOp);
            if( (nExpr-i)>=nOp && 0==memcmp(aOperator[j].zOp, &zExpr[i], nOp) ){
              pNew->pOp = &aOperator[j];
              i += nOp;
              break;
            }
          }
        }

/*
** 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 uchar *zExpr, int nExpr){
  int rc;                           /* Return Code */
  int i;                            /* Loop counter */

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

  if( nExpr<0 ){

** 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 uchar *zKey,
  int nKey,
  int op                      /* -ve = delete, 0 = find, +ve = insert */
){
  unsigned int iKey = 0;
  int i;
  Th_HashEntry *pRet;
  Th_HashEntry **ppRet;

    *ppRet = pRet->pNext;
    Th_Free(interp, pRet);
    pRet = 0;
  }

  if( op>0 && !pRet ){
    pRet = (Th_HashEntry *)Th_Malloc(interp, sizeof(Th_HashEntry) + nKey);
    pRet->zKey = (uchar *)&pRet[1];
    pRet->nKey = nKey;
    memcpy(pRet->zKey, zKey, nKey);
    pRet->pNext = pHash->a[iKey];
    pHash->a[iKey] = pRet;
  }

  return pRet;
}

/*
** This function is the same as the standard strlen() function, except
** that it returns 0 (instead of being undefined) if the argument is
** a null pointer.
*/
int th_strlen(const unsigned char *zStr){
  int n = 0;
  if( zStr ){
    while( zStr[n] ) n++;
  }
  return n;
}

  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0,   /* 0xE. */
  0,  0,  0,  0,  0,  0,  0,  0,     0,  0,  0,  0,  0,  0,  0,  0    /* 0xF. */
};

/*
** Clone of the standard isspace() and isdigit function/macros.
*/
int th_isspace(unsigned char c){
  return (aCharProp[c] & 0x01);
}
int th_isdigit(unsigned char c){
  return (aCharProp[c] & 0x02);
}
int th_isspecial(unsigned char c){
  return (aCharProp[c] & 0x11);
}
int th_isalnum(unsigned char c){
  return (aCharProp[c] & 0x0A);
}

#ifndef LONGDOUBLE_TYPE
# define LONGDOUBLE_TYPE long double
#endif
typedef uchar u8;


/*
** Return TRUE if z is a pure numeric string.  Return FALSE if the
** string contains any character which is not part of a number. If
** the string is numeric and contains the '.' character, set *realnum
** to TRUE (otherwise FALSE).

** 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 uchar *z, int n, int *piOut){
  int i = 0;
  int iOut = 0;

  if( n<0 ){
    n = th_strlen(z);
  }

**
** 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 uchar *z, 
  int n, 
  double *pfOut
){
  if( !sqlite3IsNumber((const char *)z, 0) ){
    Th_ErrorMessage(interp, "expected number, got: \"", z, n);
    return TH_ERROR;
  }

  sqlite3AtoF((const char *)z, pfOut);
  return TH_OK;
}

/*
** Set the result of the interpreter to the th1 representation of
** the integer iVal and return TH_OK.
*/
int Th_SetResultInt(Th_Interp *interp, int iVal){
  int isNegative = 0;
  uchar zBuf[32];
  uchar *z = &zBuf[32];

  if( iVal<0 ){
    isNegative = 1;
    iVal = iVal * -1;
  }
  *(--z) = '\0';
  *(--z) = (uchar)(48+(iVal%10));
  while( (iVal = (iVal/10))>0 ){
    *(--z) = (uchar)(48+(iVal%10));
    assert(z>zBuf);
  }
  if( isNegative ){
    *(--z) = '-';
  }

  return Th_SetResult(interp, z, -1);
}

/*
** 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 */
  uchar zBuf[128];      /* Output buffer */
  uchar *z = zBuf;      /* Output cursor */
  int iDot = 0;         /* Digit after which to place decimal point */
  int iExp = 0;         /* Exponent (NN in eNN) */
  const uchar *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

    iExp = 0;
  }

  /* Output the digits in real value v. The value of iDot determines
   * where (if at all) the decimal point is placed.
   */
  for(i=0; i<=(iDot+1) || v>=insignificant; i++){
    *z++ = (uchar)(48 + (int)v);
    v = (v - ((double)(int)v)) * 10.0;
    insignificant *= 10.0;
    if( iDot==i ){
      *z++ = '.';
    }
  }

      *z++ = zExp[i];
    }
  }

  *z = '\0';
  return Th_SetResult(interp, zBuf, -1);
}

/*
** Set the result of the interpreter to the th1 representation of
** the pointer p and return TH_OK. The th1 representation can be
** converted back to a pointer using Th_ToPtr().
*/
int Th_SetResultPtr(Th_Interp *interp, void *p){
  char zBuf[32];
  char *z;
  int i;
  unsigned int v = (unsigned int)p;

  const char zHex[16] = "0123456789ABCDEF";

  assert( sizeof(unsigned int)==sizeof(void *) );

  zBuf[31] = '\0';
  z = &zBuf[30];

  for(i=0; i<(sizeof(unsigned int)*2); i++){
    *z-- = zHex[(v&0x0000000F)];
    v = v>>4;
  }

  *z-- = 'x';
  *z = '0';

  return Th_SetResult(interp, (uchar *)z, -1);
}

/*
** Convert input string (z, n) to a generic pointer. If the conversion
** is successful, store the result in *pp and return TH_OK.
**
** If the string cannot be converted to a pointer, return TH_ERROR. 
** If the interp argument is not NULL, leave an error message in the 
** interpreter result too.
*/
int Th_ToPtr(Th_Interp *interp, const uchar *z, int n, void **pp){
  unsigned int iPtr;
  int i;
  assert(sizeof(unsigned int)==sizeof(void *));

  if( n<3 || z[0]!='0' || z[1]!='x' ){
    goto error_out;
  }

  iPtr = 0;
  for(i=2; i<n; i++){
    int digit = thHexdigit(z[i]);
    if( digit<0 ){
      goto error_out;
    }
    iPtr = (iPtr<<4) + digit;
  }

  *pp = (void *)iPtr;
  return TH_OK;

error_out:
  Th_ErrorMessage(interp, "expected pointer, got: \"", z, n);
  return TH_ERROR;
}

/* This header file defines the external interface to the custom Scripting
** Language (TH) interpreter used to create test cases for SQLiteRT. The
** interpreted language and API are both based on Tcl.
*/

typedef unsigned char uchar;

/*
** Before creating an interpreter, the application must allocate and
** populate an instance of the following structure. It must remain valid
** for the lifetime of the interpreter.
*/
struct Th_Vtab {
  void *(*xMalloc)(unsigned int);

**   * 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 uchar *zProg, int nProg);

/*
** Evaluate a TH expression. The result is stored in the 
** interpreter result.
*/
int Th_Expr(Th_Interp *interp, const uchar *, 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_GetVar(Th_Interp *, const uchar *, int);
int Th_SetVar(Th_Interp *, const uchar *, int, const uchar *, int);
int Th_LinkVar(Th_Interp *, const uchar *, int, int, const uchar *, int);
int Th_UnsetVar(Th_Interp *, const uchar *, int);

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

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

/* 
** Delete or rename commands.
*/
int Th_RenameCommand(Th_Interp *, const uchar *, int, const uchar *, 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)

#define TH_BREAK    2
#define TH_RETURN   3
#define TH_CONTINUE 4

/* 
** Set and get the interpreter result. 
*/
int Th_SetResult(Th_Interp *, const uchar *, int);
const uchar *Th_GetResult(Th_Interp *, int *);
uchar *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 uchar *, 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 *, uchar **, int *, const uchar *, int);
int Th_SplitList(Th_Interp *, const uchar *, int, uchar ***, int **, int *);

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

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

/*
** Drop in replacements for the corresponding standard library functions.
*/
int th_strlen(const unsigned char *);
int th_isdigit(unsigned char);
int th_isspace(unsigned char);
int th_isalnum(unsigned char);
int th_isspecial(unsigned char);
uchar *th_strdup(Th_Interp *interp, const uchar *z, int n);

/*
** Interfaces to register the language extensions.
*/
int th_register_language(Th_Interp *interp);            /* th_lang.c */
int th_register_sqlite(Th_Interp *interp);              /* th_sqlite.c */
int th_register_vfs(Th_Interp *interp);                 /* th_vfs.c */
int th_register_testvfs(Th_Interp *interp);             /* th_testvfs.c */

/*
** General purpose hash table from th_lang.c.
*/
typedef struct Th_Hash      Th_Hash;
typedef struct Th_HashEntry Th_HashEntry;
struct Th_HashEntry {
  void *pData;
  uchar *zKey;
  int nKey;
  Th_HashEntry *pNext;     /* Internal use only */
};
Th_Hash *Th_HashNew(Th_Interp *);
void Th_HashDelete(Th_Interp *, Th_Hash *);
void Th_HashIterate(Th_Interp*,Th_Hash*,void (*x)(Th_HashEntry*, void*),void*);
Th_HashEntry *Th_HashFind(Th_Interp*, Th_Hash*, const uchar*, int, int);

/*
** Useful functions from th_lang.c.
*/
int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg);

typedef struct Th_SubCommand {char *zName; Th_CommandProc xProc;} Th_SubCommand;
int Th_CallSubCommand(Th_Interp*,void*,int,const uchar**,int*,Th_SubCommand*);

*/

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

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

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

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

  rc = Th_Eval(interp, 0, argv[1], -1);
  if( argc==3 ){
    int nResult;
    const uchar *zResult = Th_GetResult(interp, &nResult);
    Th_SetVar(interp, argv[2], argl[2], zResult, nResult);
  }

  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 uchar **argv, 
  int *argl
){
  int rc = TH_OK;

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

  const uchar *zResult;
  int nResult;

  if( argc<3 ){
    goto wrong_args;
  }

  for(i=0; i<argc && rc==TH_OK; i+=3){

**
**   expr expr
*/
static int expr_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc, 
  const uchar **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 uchar *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 uchar **argv, 
  int *argl
){
  int rc;
  int iCond;

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

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

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

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

  uchar **azElem;
  int *anElem;
  int nCount;

  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "lindex list index");
  }

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

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

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

  if( argc==3 ){

** 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 */
  uchar **azParam;           /* Parameter names */
  int *anParam;              /* Lengths of parameter names */
  uchar **azDefault;         /* Default values */
  int *anDefault;            /* Lengths of default values */
  int hasArgs;               /* True if there is an "args" parameter */
  uchar *zProgram;           /* Body of proc */
  int nProgram;              /* Number of bytes at zProgram */
  uchar *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 uchar **argv;
  int *argl;
};

/*
** Each time a command created using [proc] is invoked, a new
** th1 stack frame is allocated (for the proc's local variables) and
** this function invoked.

  /* 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])
  ){
    uchar *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 uchar *)"", 1);
    Th_WrongNumArgs(interp, zUsage);
    Th_Free(interp, zUsage);
    return TH_ERROR;
  }

  /* Populate the formal proc parameters. */
  for(i=0; i<p->nParam; i++){
    const uchar *zVal;
    int nVal;
    if( pArgs->argc>(i+1) ){
      zVal = pArgs->argv[i+1];
      nVal = pArgs->argl[i+1];
    }else{
      zVal = p->azDefault[i];
      nVal = p->anDefault[i];
    }
    Th_SetVar(interp, p->azParam[i], p->anParam[i], zVal, nVal);
  }

  /* Populate the "args" parameter, if it exists */
  if( p->hasArgs ){
    uchar *zArgs = 0;
    int nArgs = 0;
    for(i=p->nParam+1; i<pArgs->argc; i++){
      Th_ListAppend(interp, &zArgs, &nArgs, pArgs->argv[i], pArgs->argl[i]);
    }
    Th_SetVar(interp, (const uchar *)"args", -1, zArgs, nArgs);
  }

  Th_SetResult(interp, 0, 0);
  return Th_Eval(interp, 0, p->zProgram, p->nProgram);
}

/*
** 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 uchar **argv,
  int *argl
){
  int rc;

  ProcDefn *p = (ProcDefn *)pContext;
  ProcArgs procargs;

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

  ProcDefn *p;
  int nByte;
  int i;
  uchar *zSpace;

  uchar **azParam;
  int *anParam;
  int nParam;

  uchar *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(uchar *) + sizeof(int)) * nParam +    /* azParam, anParam */
      (sizeof(uchar *) + 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->hasArgs = 1;
    nParam--;
  }

  p->nParam    = nParam;
  p->azParam   = (uchar **)&p[1];
  p->anParam   = (int *)&p->azParam[nParam];
  p->azDefault = (uchar **)&p->anParam[nParam];
  p->anDefault = (int *)&p->azDefault[nParam];
  p->zProgram = (uchar *)&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++){
    uchar **az;
    int *an;
    int n;
    if( Th_SplitList(interp, azParam[i], anParam[i], &az, &an, &n) ){
      goto error_out;
    }
    if( n<1 || n>2 ){
      const char expected[] = "expected parameter, got \"";

    if( n==2 ){
      p->anDefault[i] = an[1];
      p->azDefault[i] = zSpace;
      memcpy(zSpace, az[1], an[1]);
      zSpace += an[1];
    }

    Th_StringAppend(interp, &zUsage, &nUsage, (const uchar *)" ", 1);
    if( n==2 ){
      Th_StringAppend(interp, &zUsage, &nUsage, (const uchar *)"?", 1);
      Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]);
      Th_StringAppend(interp, &zUsage, &nUsage, (const uchar *)"?", 1);
    }else{
      Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]);
    }

    Th_Free(interp, az);
  }
  assert( zSpace-(uchar *)p<=nByte );

  /* If there is an "args" parameter, append it to the end of the usage
  ** message. Set ProcDefn.zUsage to point at the usage message. It will
  ** be freed along with the rest of the proc-definition by proc_del().
  */
  if( p->hasArgs ){
    Th_StringAppend(interp, &zUsage, &nUsage, (const uchar *)" ?args...?", -1);
  }
  p->zUsage = zUsage;
  p->nUsage = nUsage;

  /* Register the new command with the th1 interpreter. */
  zName = (char *)argv[1];
  rc = Th_CreateCommand(interp, zName, proc_call1, (void *)p, proc_del);

**
**   rename oldcmd newcmd
*/
static int rename_command(
  Th_Interp *interp, 
  void *ctx, 
  int argc,
  const uchar **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 uchar **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 (int)ctx;
}

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

/*
** TH Syntax:
**
**   string compare STRING1 STRING2
*/
static int string_compare_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  const uchar *zRight; int nRight;
  const uchar *zLeft; int nLeft;

  int i;
  int iRes = 0;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string compare str1 str2");
  }

/*
** TH Syntax:
**
**   string first NEEDLE HAYSTACK
*/
static int string_first_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  const uchar *zNeedle;
  int nNeedle;
  const uchar *zHaystack;
  int nHaystack;
  int i;
  int iRes;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string first needle haystack");
  }

/*
** TH Syntax:
**
**   string is CLASS STRING
*/
static int string_is_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  int i;
  int iRes = 1;
  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string is class string");
  }
  if( argl[2]!=5 || 0!=memcmp(argv[2], "alnum", 5) ){

/*
** TH Syntax:
**
**   string last NEEDLE HAYSTACK
*/
static int string_last_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  const uchar *zNeedle;
  int nNeedle;
  const uchar *zHaystack;
  int nHaystack;
  int i;
  int iRes;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string first needle haystack");
  }

/*
** TH Syntax:
**
**   string length STRING
*/
static int string_length_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "string length string");
  }
  return Th_SetResultInt(interp, argl[2]);
}

/*
** TH Syntax:
**
**   string range STRING FIRST LAST
*/
static int string_range_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  int iStart;
  int iEnd;

  if( argc!=5 ){
    return Th_WrongNumArgs(interp, "string range string first last");
  }

/*
** TH Syntax:
**
**   string repeat STRING COUNT
*/
static int string_repeat_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  int n;
  int i;
  int nByte;
  uchar *zByte;

  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "string repeat string n");
  }
  if( Th_ToInt(interp, argv[3], argl[3], &n) ){
    return TH_ERROR;
  }

/*
** TH Syntax:
**
**   info exists VAR
*/
static int info_exists_command(
  Th_Interp *interp, void *ctx, int argc, const uchar **argv, int *argl
){
  int rc;

  if( argc!=3 ){
    return Th_WrongNumArgs(interp, "info exists var");
  }
  rc = Th_GetVar(interp, argv[2], argl[2]);
  Th_SetResultInt(interp, rc?0:1);
  return TH_OK;
}

/*
** TH Syntax:
**
**   unset VAR
*/
static int unset_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const uchar **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 uchar **argv,
  int *argl,
  Th_SubCommand *aSub
){
  int i;
  for(i=0; aSub[i].zName; i++){
    uchar *zName = (uchar *)aSub[i].zName;
    if( th_strlen(zName)==argl[1] && 0==memcmp(zName, argv[1], argl[1]) ){
      return aSub[i].xProc(interp, ctx, argc, argv, argl);
    }
  }

  Th_ErrorMessage(interp, "Expected sub-command, got:", argv[1], argl[1]);
  return TH_ERROR;

**   string range   STRING FIRST LAST
**   string repeat  STRING COUNT
*/
static int string_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const uchar **argv,
  int *argl
){
  Th_SubCommand aSub[] = {
    { "compare", string_compare_command },
    { "first",   string_first_command },
    { "is",      string_is_command },
    { "last",    string_last_command },

**
**   info exists VARNAME
*/
static int info_command(
  Th_Interp *interp, 
  void *ctx,
  int argc,
  const uchar **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 uchar *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;

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

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

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

** 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 uchar **argv, 
  int *argl
){
  int cnt = 0;
  cnt++;
  return TH_OK;
}

**
** Enable or disable the puts and hputs commands.
*/
static int enableOutputCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "enable_output BOOLEAN");
  }
  return Th_ToInt(interp, argv[1], argl[1], &enableOutput);
}

**
** Output STRING as HTML (html) or unchanged (puts).  
*/
static int putsCmd(
  Th_Interp *interp, 
  void *pConvert, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "puts STRING");
  }
  sendText((char*)argv[1], argl[1], pConvert!=0);
  return TH_OK;
}

/*
** TH command:      wiki STRING
**
** Render the input string as wiki.
*/
static int wikiCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "wiki STRING");
  }
  if( enableOutput ){
    Blob src;

** Escape all characters of STRING which have special meaning in HTML.
** Return a new string result.
*/
static int htmlizeCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  char *zOut;
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "htmlize STRING");
  }
  zOut = htmlize((char*)argv[1], argl[1]);
  Th_SetResult(interp, (unsigned char*)zOut, -1);
  free(zOut);
  return TH_OK;
}

/*
** TH command:      date
**
** Return a string which is the current time and date.
*/
static int dateCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  char *zOut = db_text("??", "SELECT datetime('now')");
  Th_SetResult(interp, (unsigned char*)zOut, -1);
  free(zOut);
  return TH_OK;
}

/*
** TH command:     hascap STRING
**
** Return true if the user has all of the capabilities listed in STRING.
*/
static int hascapCmd(
  Th_Interp *interp, 
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  if( argc!=2 ){
    return Th_WrongNumArgs(interp, "hascap STRING");
  }
  Th_SetResultInt(interp, login_has_capability((char*)argv[1],argl[1]));
  return TH_OK;

** If NUMLINES is greater than one then the display is a listbox
** with the number of lines given.
*/
static int comboboxCmd(
  Th_Interp *interp,
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "combobox NAME TEXT-LIST NUMLINES");
  }
  if( enableOutput ){
    int height;
    Blob list, elem, name;
    int nValue;
    const char *zValue;
    char *z, *zH;





    if( Th_ToInt(interp, argv[3], argl[3], &height) ) return TH_ERROR;
    blob_init(&list, (char*)argv[2], argl[2]);
    blob_init(&name, (char*)argv[1], argl[1]);
    zValue = Th_Fetch(blob_str(&name), &nValue);
    z = mprintf("<select name=\"%z\" size=\"%d\">", 
                 htmlize(blob_buffer(&name), blob_size(&name)), height);
    sendText(z, -1, 0);
    free(z);
    blob_reset(&name);
    while( blob_token(&list, &elem) ){
      zH = htmlize(blob_buffer(&elem), blob_size(&elem));
      if( zValue && blob_size(&elem)==nValue 
             && memcmp(zValue, blob_buffer(&elem), nValue)==0 ){
        z = mprintf("<option value=\"%s\" selected>%s</option>", zH, zH);
      }else{
        z = mprintf("<option value=\"%s\">%s</option>", zH, zH);
      }
      free(zH);
      sendText(z, -1, 0);
      free(z);
    }
    sendText("</select>", -1, 0);
    blob_reset(&list);
  }
  return TH_OK;
}

/*
** TH1 command:     linecount STRING MAX MIN
**
** Return one more than the number of \n characters in STRING.  But
** never return less than MIN or more than MAX.
*/
static int linecntCmd(
  Th_Interp *interp,
  void *p, 
  int argc, 
  const unsigned char **argv, 
  int *argl
){
  const uchar *z;
  int size, n, i;
  int iMin, iMax;
  if( argc!=4 ){
    return Th_WrongNumArgs(interp, "linecount STRING MAX MIN");
  }
  if( Th_ToInt(interp, argv[2], argl[2], &iMax) ) return TH_ERROR;
  if( Th_ToInt(interp, argv[3], argl[3], &iMin) ) return TH_ERROR;

/*
** Store a string value in a variable in the interpreter.
*/
void Th_Store(const char *zName, const char *zValue){
  Th_FossilInit();
  if( zValue ){
    Th_SetVar(g.interp, (uchar*)zName, -1, (uchar*)zValue, strlen(zValue));
  }
}

/*
** Unset a variable.
*/
void Th_Unstore(const char *zName){
  if( g.interp ){
    Th_UnsetVar(g.interp, (uchar*)zName, -1);
  }
}

/*
** Retrieve a string value from the interpreter.  If no such
** variable exists, return NULL.
*/
char *Th_Fetch(const char *zName, int *pSize){
  int rc;
  Th_FossilInit();
  rc = Th_GetVar(g.interp, (uchar*)zName, -1);
  if( rc==TH_OK ){
    return (char*)Th_GetResult(g.interp, pSize);
  }else{
    return 0;
  }
}

** This routine processes the template and writes the results
** on either stdout or into CGI.
*/
int Th_Render(const char *z){
  int i = 0;
  int n;
  int rc = TH_OK;
  uchar *zResult;
  Th_FossilInit();
  while( z[i] ){
    if( z[i]=='$' && (n = validVarName(&z[i+1]))>0 ){
      const char *zVar;
      int nVar;
      sendText(z, i, 0);
      if( z[i+1]=='<' ){
        /* Variables of the form $<aaa> */
        zVar = &z[i+2];
        nVar = n-2;
      }else{
        /* Variables of the form $aaa */
        zVar = &z[i+1];
        nVar = n;
      }
      rc = Th_GetVar(g.interp, (uchar*)zVar, nVar);
      z += i+1+n;
      i = 0;
      zResult = (uchar*)Th_GetResult(g.interp, &n);
      sendText((char*)zResult, n, n>nVar);
    }else if( z[i]=='<' && isBeginScriptTag(&z[i]) ){
      sendText(z, i, 0);
      z += i+5;
      for(i=0; z[i] && (z[i]!='<' || !isEndScriptTag(&z[i])); i++){}
      rc = Th_Eval(g.interp, 0, (const uchar*)z, i);
      if( rc!=TH_OK ) break;
      z += i;
      if( z[0] ){ z += 6; }
      i = 0;
    }else{
      i++;
    }
  }
  if( rc==TH_ERROR ){
    sendText("<hr><p><font color=\"red\"><b>ERROR: ", -1, 0);
    zResult = (uchar*)Th_GetResult(g.interp, &n);
    sendText((char*)zResult, n, 1);
    sendText("</b></font></p>", -1, 0);
  }else{
    sendText(z, i, 0);
  }
  return rc;
}

/*
** Create the subscript interpreter and load the "common" code.
*/
void ticket_init(void){
  const char *zConfig;
  Th_FossilInit();
  zConfig = ticket_common_code();
  Th_Eval(g.interp, 0, (const uchar*)zConfig, -1);
}

/*
** Recreate the ticket table.
*/
void ticket_create_table(int separateConnection){
  const char *zSql;