summaryrefslogtreecommitdiff
path: root/src/th_lang.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/th_lang.c')
-rw-r--r--src/th_lang.c1470
1 files changed, 1470 insertions, 0 deletions
diff --git a/src/th_lang.c b/src/th_lang.c
new file mode 100644
index 0000000..a72a219
--- /dev/null
+++ b/src/th_lang.c
@@ -0,0 +1,1470 @@
+
+/*
+** 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>
+#include <assert.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?");
+ }
+
+ rc = Th_Eval(interp, 0, argv[1], -1);
+ if( argc==3 ){
+ int nResult;
+ const char *zResult = Th_GetResult(interp, &nResult);
+ Th_SetVar(interp, argv[2], TH1_LEN(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 char **argv,
+ int *argl
+){
+ int rc = TH_OK;
+
+ int iCond; /* Result of evaluating expression */
+ int i;
+
+ const char *zResult;
+ int nResult;
+
+ if( argc<3 ){
+ goto wrong_args;
+ }
+
+ for(i=0; i<argc && rc==TH_OK; i+=3){
+ if( i>argc-3 ){
+ i = argc-3;
+ iCond = 1;
+ }else{
+ if( TH_OK!=Th_Expr(interp, argv[i+1], argl[i+1]) ){
+ return TH_ERROR;
+ }
+ zResult = Th_GetResult(interp, &nResult);
+ rc = Th_ToInt(interp, zResult, nResult, &iCond);
+ }
+ if( iCond && rc==TH_OK ){
+ rc = Th_Eval(interp, 0, argv[i+2], -1);
+ break;
+ }
+ }
+
+ 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:
+**
+** foreach VARLIST LIST SCRIPT
+*/
+static int foreach_command(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl
+){
+ int rc;
+ char **azVar = 0;
+ int *anVar;
+ int nVar;
+ char **azValue = 0;
+ int *anValue;
+ int nValue;
+ int ii, jj;
+ int bTaint = 0;
+
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "foreach varlist list script");
+ }
+ rc = Th_SplitList(interp, argv[1], argl[1], &azVar, &anVar, &nVar);
+ if( rc ) return rc;
+ TH1_XFER_TAINT(bTaint, argl[2]);
+ rc = Th_SplitList(interp, argv[2], argl[2], &azValue, &anValue, &nValue);
+ for(ii=0; rc==TH_OK && ii<=nValue-nVar; ii+=nVar){
+ for(jj=0; jj<nVar; jj++){
+ int x = anValue[ii+jj];
+ TH1_XFER_TAINT(x, bTaint);
+ Th_SetVar(interp, azVar[jj], anVar[jj], azValue[ii+jj], x);
+ }
+ rc = eval_loopbody(interp, argv[3], argl[3]);
+ }
+ if( rc==TH_BREAK ) rc = TH_OK;
+ Th_Free(interp, azVar);
+ Th_Free(interp, azValue);
+ 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;
+ int bTaint = 0;
+
+ for(i=1; i<argc; i++){
+ TH1_XFER_TAINT(bTaint,argl[i]);
+ Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]);
+ }
+
+ TH1_XFER_TAINT(nList, bTaint);
+ Th_SetResult(interp, zList, nList);
+ Th_Free(interp, zList);
+
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** lappend var ?arg1? ?arg2? ...?
+**
+** Interpret the content of variable var as a list. Create var if it
+** does not already exist. Append each argument as a new list element.
+*/
+static int lappend_command(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl
+){
+ char *zList = 0;
+ int nList = 0;
+ int i, rc;
+ int bTaint = 0;
+
+ if( argc<2 ){
+ return Th_WrongNumArgs(interp, "lappend var ...");
+ }
+ rc = Th_GetVar(interp, argv[1], argl[1]);
+ if( rc==TH_OK ){
+ zList = Th_TakeResult(interp, &nList);
+ }
+
+ TH1_XFER_TAINT(bTaint, nList);
+ for(i=2; i<argc; i++){
+ TH1_XFER_TAINT(bTaint, argl[i]);
+ Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]);
+ }
+
+ TH1_XFER_TAINT(nList, bTaint);
+ Th_SetVar(interp, argv[1], argl[1], zList, nList);
+ 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;
+ int nCount;
+ int bTaint = 0;
+
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "lindex list index");
+ }
+
+ if( TH_OK!=Th_ToInt(interp, argv[2], argl[2], &iElem) ){
+ return TH_ERROR;
+ }
+
+ TH1_XFER_TAINT(bTaint, argl[1]);
+ rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount);
+ if( rc==TH_OK ){
+ if( iElem<nCount && iElem>=0 ){
+ int sz = anElem[iElem];
+ TH1_XFER_TAINT(sz, bTaint);
+ Th_SetResult(interp, azElem[iElem], sz);
+ }else{
+ Th_SetResult(interp, 0, 0);
+ }
+ 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");
+ }
+
+ rc = Th_SplitList(interp, argv[1], argl[1], 0, 0, &nElem);
+ if( rc==TH_OK ){
+ Th_SetResultInt(interp, nElem);
+ }
+
+ return rc;
+}
+
+/*
+** TH Syntax:
+**
+** lsearch list string
+*/
+static int lsearch_command(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl
+){
+ int rc;
+ char **azElem;
+ int *anElem;
+ int nCount;
+ int i;
+
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "lsearch list string");
+ }
+
+ rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount);
+ if( rc==TH_OK ){
+ int nn = TH1_LEN(argl[2]);
+ Th_SetResultInt(interp, -1);
+ for(i=0; i<nCount; i++){
+ if( TH1_LEN(anElem[i])==nn && 0==memcmp(azElem[i], argv[2], nn) ){
+ Th_SetResultInt(interp, i);
+ break;
+ }
+ }
+ Th_Free(interp, azElem);
+ }
+
+ 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;
+};
+
+/*
+** 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.
+**
+** Argument pContext1 points to the associated ProcDefn structure.
+** Argument pContext2 points to a ProcArgs structure that contains
+** the arguments passed to this specific invocation of the proc.
+*/
+static int proc_call2(Th_Interp *interp, void *pContext1, void *pContext2){
+ 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);
+ Th_WrongNumArgs(interp, zUsage);
+ Th_Free(interp, zUsage);
+ return TH_ERROR;
+ }
+
+ /* Populate the formal proc parameters. */
+ for(i=0; i<p->nParam; i++){
+ const char *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 ){
+ char *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 char *)"args", -1, zArgs, nArgs);
+ if(zArgs){
+ Th_Free(interp, zArgs);
+ }
+ }
+
+ 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 char **argv,
+ int *argl
+){
+ int rc;
+
+ ProcDefn *p = (ProcDefn *)pContext;
+ ProcArgs procargs;
+
+ /* Call function proc_call2(), which will call Th_Eval() to evaluate
+ ** the body of the [proc], in a new Th stack frame. This is so that
+ ** the proc body has its own local variable context.
+ */
+ procargs.argc = argc;
+ procargs.argv = argv;
+ procargs.argl = argl;
+ rc = Th_InFrame(interp, proc_call2, (void *)p, (void *)&procargs);
+
+ if( rc==TH_RETURN ){
+ rc = TH_OK;
+ }
+ if( rc==TH_RETURN2 ){
+ rc = TH_RETURN;
+ }
+ 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;
+ const 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], TH1_LEN(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 */
+ TH1_LEN(argl[3]) + /* zProgram */
+ TH1_LEN(argl[2]); /* Space for copies of param names and dflt 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( nParam>0 ){
+ if( TH1_LEN(anParam[nParam-1])==4
+ && 0==memcmp(azParam[nParam-1], "args", 4)
+ ){
+ p->hasArgs = 1;
+ nParam--;
+ }
+ }
+
+ p->nParam = nParam;
+ p->azParam = (char **)&p[1];
+ 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], TH1_LEN(argl[3]));
+ p->nProgram = TH1_LEN(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;
+ }
+ if( n<1 || n>2 ){
+ const char expected[] = "expected parameter, got \"";
+ Th_ErrorMessage(interp, expected, azParam[i], anParam[i]);
+ Th_Free(interp, az);
+ goto error_out;
+ }
+ p->anParam[i] = an[0];
+ p->azParam[i] = zSpace;
+ memcpy(zSpace, az[0], an[0]);
+ zSpace += an[0];
+ 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 char *)" ", 1);
+ if( n==2 ){
+ Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"?", 1);
+ Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]);
+ Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"?", 1);
+ }else{
+ Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]);
+ }
+
+ Th_Free(interp, az);
+ }
+ assert( zSpace-(char *)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 char *)" ?args...?", -1);
+ }
+ p->zUsage = zUsage;
+ p->nUsage = nUsage;
+
+ /* Register the new command with the th1 interpreter. */
+ zName = argv[1];
+ rc = Th_CreateCommand(interp, zName, proc_call1, (void *)p, proc_del);
+ if( rc==TH_OK ){
+ Th_SetResult(interp, 0, 0);
+ }
+
+ Th_Free(interp, azParam);
+ return TH_OK;
+
+ 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], TH1_LEN(argl[1]),
+ argv[2], TH1_LEN(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 ){
+ int rc = Th_ToInt(interp, argv[2], argl[2], &iCode);
+ if( rc!=TH_OK ){
+ return rc;
+ }
+ }
+ if( argc==2 || argc==4 ){
+ Th_SetResult(interp, argv[argc-1], argl[argc-1]);
+ }
+ return iCode;
+}
+
+/*
+** TH Syntax:
+**
+** string compare STRING1 STRING2
+*/
+static int string_compare_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ const char *zRight; int nRight;
+ const char *zLeft; int nLeft;
+
+ int i;
+ int iRes = 0;
+
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string compare str1 str2");
+ }
+
+ zLeft = argv[2];
+ nLeft = TH1_LEN(argl[2]);
+ zRight = argv[3];
+ nRight = TH1_LEN(argl[3]);
+
+ for(i=0; iRes==0 && i<nLeft && i<nRight; i++){
+ iRes = zLeft[i]-zRight[i];
+ }
+ 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
+*/
+static int string_first_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int nNeedle;
+ int nHaystack;
+ int iRes = -1;
+
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string first needle haystack");
+ }
+
+ nNeedle = TH1_LEN(argl[2]);
+ nHaystack = TH1_LEN(argl[3]);
+
+ if( nNeedle && nHaystack && nNeedle<=nHaystack ){
+ const char *zNeedle = argv[2];
+ const char *zHaystack = argv[3];
+ int i;
+
+ 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 index STRING INDEX
+*/
+static int string_index_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int iIndex;
+
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string index string index");
+ }
+
+ if( TH1_LEN(argl[3])==3 && 0==memcmp("end", argv[3], 3) ){
+ iIndex = TH1_LEN(argl[2])-1;
+ }else if( Th_ToInt(interp, argv[3], argl[3], &iIndex) ){
+ Th_ErrorMessage(
+ interp, "Expected \"end\" or integer, got:", argv[3], argl[3]);
+ return TH_ERROR;
+ }
+
+ if( iIndex>=0 && iIndex<TH1_LEN(argl[2]) ){
+ int sz = 1;
+ TH1_XFER_TAINT(sz, argl[2]);
+ return Th_SetResult(interp, &argv[2][iIndex], sz);
+ }else{
+ return Th_SetResult(interp, 0, 0);
+ }
+}
+
+/*
+** TH Syntax:
+**
+** string is CLASS STRING
+*/
+static int string_is_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string is class string");
+ }
+ if( TH1_LEN(argl[2])==5 && 0==memcmp(argv[2], "alnum", 5) ){
+ int i;
+ int iRes = 1;
+
+ for(i=0; i<TH1_LEN(argl[3]); i++){
+ if( !th_isalnum(argv[3][i]) ){
+ iRes = 0;
+ }
+ }
+
+ return Th_SetResultInt(interp, iRes);
+ }else if( TH1_LEN(argl[2])==6 && 0==memcmp(argv[2], "double", 6) ){
+ double fVal;
+ if( Th_ToDouble(interp, argv[3], argl[3], &fVal)==TH_OK ){
+ return Th_SetResultInt(interp, 1);
+ }
+ return Th_SetResultInt(interp, 0);
+ }else if( TH1_LEN(argl[2])==7 && 0==memcmp(argv[2], "integer", 7) ){
+ int iVal;
+ if( Th_ToInt(interp, argv[3], argl[3], &iVal)==TH_OK ){
+ return Th_SetResultInt(interp, 1);
+ }
+ return Th_SetResultInt(interp, 0);
+ }else if( TH1_LEN(argl[2])==4 && 0==memcmp(argv[2], "list", 4) ){
+ if( Th_SplitList(interp, argv[3], argl[3], 0, 0, 0)==TH_OK ){
+ return Th_SetResultInt(interp, 1);
+ }
+ return Th_SetResultInt(interp, 0);
+ }else if( TH1_LEN(argl[2])==7 && 0==memcmp(argv[2], "tainted", 7) ){
+ return Th_SetResultInt(interp, TH1_TAINTED(argl[3]));
+ }else{
+ Th_ErrorMessage(interp,
+ "Expected alnum, double, integer, list, or tainted, got:",
+ argv[2], TH1_LEN(argl[2]));
+ return TH_ERROR;
+ }
+}
+
+/*
+** TH Syntax:
+**
+** string last NEEDLE HAYSTACK
+*/
+static int string_last_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int nNeedle;
+ int nHaystack;
+ int iRes = -1;
+
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string last needle haystack");
+ }
+
+ nNeedle = TH1_LEN(argl[2]);
+ nHaystack = TH1_LEN(argl[3]);
+
+ if( nNeedle && nHaystack && nNeedle<=nHaystack ){
+ const char *zNeedle = argv[2];
+ const char *zHaystack = argv[3];
+ int i;
+
+ for(i=nHaystack-nNeedle; i>=0; i--){
+ if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){
+ iRes = i;
+ break;
+ }
+ }
+ }
+
+ return Th_SetResultInt(interp, iRes);
+}
+
+/*
+** TH Syntax:
+**
+** string length STRING
+*/
+static int string_length_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "string length string");
+ }
+ return Th_SetResultInt(interp, TH1_LEN(argl[2]));
+}
+
+/*
+** TH Syntax:
+**
+** string match PATTERN STRING
+**
+*/
+static int string_match_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ extern char *fossil_strndup(const char*,ssize_t);
+ extern void fossil_free(void*);
+ char *zPat, *zStr;
+ int rc;
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string match pattern string");
+ }
+ zPat = fossil_strndup(argv[2],TH1_LEN(argl[2]));
+ zStr = fossil_strndup(argv[3],TH1_LEN(argl[3]));
+ rc = sqlite3_strglob(zPat,zStr);
+ fossil_free(zPat);
+ fossil_free(zStr);
+ return Th_SetResultInt(interp, !rc);
+}
+
+/*
+** TH Syntax:
+**
+** string range STRING FIRST LAST
+*/
+static int string_range_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int iStart;
+ int iEnd;
+ int sz;
+
+ if( argc!=5 ){
+ return Th_WrongNumArgs(interp, "string range string first last");
+ }
+
+ if( TH1_LEN(argl[4])==3 && 0==memcmp("end", argv[4], 3) ){
+ iEnd = TH1_LEN(argl[2]);
+ }else if( Th_ToInt(interp, argv[4], argl[4], &iEnd) ){
+ Th_ErrorMessage(
+ interp, "Expected \"end\" or integer, got:", argv[4], TH1_LEN(argl[4]));
+ return TH_ERROR;
+ }
+ if( Th_ToInt(interp, argv[3], argl[3], &iStart) ){
+ return TH_ERROR;
+ }
+
+ if( iStart<0 ) iStart = 0;
+ if( iEnd>=TH1_LEN(argl[2]) ) iEnd = TH1_LEN(argl[2])-1;
+ if( iStart>iEnd ) iEnd = iStart-1;
+ sz = iEnd - iStart + 1;
+ TH1_XFER_TAINT(sz, argl[2]);
+
+ return Th_SetResult(interp, &argv[2][iStart], sz);
+}
+
+/*
+** TH Syntax:
+**
+** string repeat STRING COUNT
+*/
+static int string_repeat_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int n;
+ int i;
+ int sz;
+ long long int nByte;
+ char *zByte;
+
+ if( argc!=4 ){
+ return Th_WrongNumArgs(interp, "string repeat string n");
+ }
+ if( Th_ToInt(interp, argv[3], argl[3], &n) ){
+ return TH_ERROR;
+ }
+
+ nByte = n;
+ sz = TH1_LEN(argl[2]);
+ nByte *= sz;
+ TH1_SIZECHECK(nByte+1);
+ zByte = Th_Malloc(interp, nByte+1);
+ for(i=0; i<nByte; i+=sz){
+ memcpy(&zByte[i], argv[2], sz);
+ }
+
+ n = nByte;
+ TH1_XFER_TAINT(n, argl[2]);
+ Th_SetResult(interp, zByte, n);
+ Th_Free(interp, zByte);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** string trim STRING
+** string trimleft STRING
+** string trimright STRING
+*/
+static int string_trim_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int n;
+ const char *z;
+
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "string trim string");
+ }
+ z = argv[2];
+ n = TH1_LEN(argl[2]);
+ if( TH1_LEN(argl[1])<5 || argv[1][4]=='l' ){
+ while( n && th_isspace(z[0]) ){ z++; n--; }
+ }
+ if( TH1_LEN(argl[1])<5 || argv[1][4]=='r' ){
+ while( n && th_isspace(z[n-1]) ){ n--; }
+ }
+ TH1_XFER_TAINT(n, argl[2]);
+ Th_SetResult(interp, z, n);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** info exists VARNAME
+*/
+static int info_exists_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int rc;
+
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "info exists var");
+ }
+ rc = Th_ExistsVar(interp, argv[2], TH1_LEN(argl[2]));
+ Th_SetResultInt(interp, rc);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** info commands
+*/
+static int info_commands_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int rc;
+ char *zElem = 0;
+ int nElem = 0;
+
+ if( argc!=2 ){
+ return Th_WrongNumArgs(interp, "info commands");
+ }
+ rc = Th_ListAppendCommands(interp, &zElem, &nElem);
+ if( rc!=TH_OK ){
+ return rc;
+ }
+ Th_SetResult(interp, zElem, nElem);
+ if( zElem ) Th_Free(interp, zElem);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** info vars
+*/
+static int info_vars_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int rc;
+ char *zElem = 0;
+ int nElem = 0;
+
+ if( argc!=2 ){
+ return Th_WrongNumArgs(interp, "info vars");
+ }
+ rc = Th_ListAppendVariables(interp, &zElem, &nElem);
+ if( rc!=TH_OK ){
+ return rc;
+ }
+ Th_SetResult(interp, zElem, nElem);
+ if( zElem ) Th_Free(interp, zElem);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** array exists VARNAME
+*/
+static int array_exists_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int rc;
+
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "array exists var");
+ }
+ rc = Th_ExistsArrayVar(interp, argv[2], TH1_LEN(argl[2]));
+ Th_SetResultInt(interp, rc);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** array names VARNAME
+*/
+static int array_names_command(
+ Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl
+){
+ int rc;
+ char *zElem = 0;
+ int nElem = 0;
+
+ if( argc!=3 ){
+ return Th_WrongNumArgs(interp, "array names varname");
+ }
+ rc = Th_ListAppendArray(interp, argv[2], TH1_LEN(argl[2]), &zElem, &nElem);
+ if( rc!=TH_OK ){
+ return rc;
+ }
+ Th_SetResult(interp, zElem, nElem);
+ if( zElem ) Th_Free(interp, zElem);
+ return TH_OK;
+}
+
+/*
+** TH Syntax:
+**
+** unset VARNAME
+*/
+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], TH1_LEN(argl[1]));
+}
+
+int Th_CallSubCommand(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl,
+ const Th_SubCommand *aSub
+){
+ if( argc>1 ){
+ int i;
+ for(i=0; aSub[i].zName; i++){
+ const char *zName = aSub[i].zName;
+ if( th_strlen(zName)==TH1_LEN(argl[1])
+ && 0==memcmp(zName, argv[1], TH1_LEN(argl[1])) ){
+ return aSub[i].xProc(interp, ctx, argc, argv, argl);
+ }
+ }
+ }
+ if(argc<2){
+ Th_ErrorMessage(interp, "Expected sub-command for",
+ argv[0], TH1_LEN(argl[0]));
+ }else{
+ Th_ErrorMessage(interp, "Expected sub-command, got:",
+ argv[1], TH1_LEN(argl[1]));
+ }
+ return TH_ERROR;
+}
+
+/*
+** TH Syntax:
+**
+** string compare STR1 STR2
+** string first NEEDLE HAYSTACK ?STARTINDEX?
+** string index STRING INDEX
+** string is CLASS STRING
+** string last NEEDLE HAYSTACK ?STARTINDEX?
+** string length STRING
+** string range STRING FIRST LAST
+** string repeat STRING COUNT
+** string trim STRING
+** string trimleft STRING
+** string trimright STRING
+*/
+static int string_command(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl
+){
+ static const Th_SubCommand aSub[] = {
+ { "compare", string_compare_command },
+ { "first", string_first_command },
+ { "index", string_index_command },
+ { "is", string_is_command },
+ { "last", string_last_command },
+ { "length", string_length_command },
+ { "match", string_match_command },
+ { "range", string_range_command },
+ { "repeat", string_repeat_command },
+ { "trim", string_trim_command },
+ { "trimleft", string_trim_command },
+ { "trimright", string_trim_command },
+ { 0, 0 }
+ };
+ return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
+}
+
+/*
+** TH Syntax:
+**
+** info commands
+** info exists VARNAME
+** info vars
+*/
+static int info_command(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl
+){
+ static const Th_SubCommand aSub[] = {
+ { "commands", info_commands_command },
+ { "exists", info_exists_command },
+ { "vars", info_vars_command },
+ { 0, 0 }
+ };
+ return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub);
+}
+
+/*
+** TH Syntax:
+**
+** array exists VARNAME
+** array names VARNAME
+*/
+static int array_command(
+ Th_Interp *interp,
+ void *ctx,
+ int argc,
+ const char **argv,
+ int *argl
+){
+ static const Th_SubCommand aSub[] = {
+ { "exists", array_exists_command },
+ { "names", array_names_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;
+ }else if( zFrame[0]=='#' ){
+ int rc = Th_ToInt(interp, &zFrame[1], nFrame-1, &iFrame);
+ if( rc!=TH_OK ) return rc;
+ iFrame = iFrame + 1;
+ }else{
+ return TH_ERROR;
+ }
+ *piFrame = iFrame;
+ return TH_OK;
+}
+
+/*
+** 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!=2 && argc!=3 ){
+ return Th_WrongNumArgs(interp, "uplevel ?level? script...");
+ }
+ if( argc==3 && TH_OK!=thToFrame(interp, argv[1], TH1_LEN(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], TH1_LEN(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], TH1_LEN(argl[i+1]),
+ iFrame, argv[i], TH1_LEN(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
+){
+ static unsigned int cnt = 0;
+ if( (cnt++)==0xffffffff ) printf("too many TH3 breakpoints\n");
+ return TH_OK;
+}
+
+/*
+** Register the built-in th1 language commands with interpreter interp.
+** Usually this is called soon after interpreter creation.
+*/
+int th_register_language(Th_Interp *interp){
+ /* Array of built-in commands. */
+ struct _Command {
+ const char *zName;
+ Th_CommandProc xProc;
+ void *pContext;
+ } aCommand[] = {
+ {"array", array_command, 0},
+ {"catch", catch_command, 0},
+ {"expr", expr_command, 0},
+ {"for", for_command, 0},
+ {"foreach", foreach_command, 0},
+ {"if", if_command, 0},
+ {"info", info_command, 0},
+ {"lappend", lappend_command, 0},
+ {"lindex", lindex_command, 0},
+ {"list", list_command, 0},
+ {"llength", llength_command, 0},
+ {"lsearch", lsearch_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}
+ };
+ size_t i;
+
+ /* Add the language commands. */
+ for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){
+ void *ctx;
+ if ( !aCommand[i].zName || !aCommand[i].xProc ) continue;
+ ctx = aCommand[i].pContext;
+ Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0);
+ }
+
+ return TH_OK;
+}
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-17 07:11:52 +0000