|
1
|
|
|
2
|
/* |
|
3
|
** This file contains the implementation of all of the TH language |
|
4
|
** built-in commands. |
|
5
|
** |
|
6
|
** All built-in commands are implemented using the public interface |
|
7
|
** declared in th.h, so this file serves as both a part of the language |
|
8
|
** implementation and an example of how to extend the language with |
|
9
|
** new commands. |
|
10
|
*/ |
|
11
|
|
|
12
|
#include "config.h" |
|
13
|
#include "th.h" |
|
14
|
#include <string.h> |
|
15
|
#include <assert.h> |
|
16
|
|
|
17
|
int Th_WrongNumArgs(Th_Interp *interp, const char *zMsg){ |
|
18
|
Th_ErrorMessage(interp, "wrong # args: should be \"", zMsg, -1); |
|
19
|
return TH_ERROR; |
|
20
|
} |
|
21
|
|
|
22
|
/* |
|
23
|
** Syntax: |
|
24
|
** |
|
25
|
** catch script ?varname? |
|
26
|
*/ |
|
27
|
static int catch_command( |
|
28
|
Th_Interp *interp, |
|
29
|
void *ctx, |
|
30
|
int argc, |
|
31
|
const char **argv, |
|
32
|
int *argl |
|
33
|
){ |
|
34
|
int rc; |
|
35
|
|
|
36
|
if( argc!=2 && argc!=3 ){ |
|
37
|
return Th_WrongNumArgs(interp, "catch script ?varname?"); |
|
38
|
} |
|
39
|
|
|
40
|
rc = Th_Eval(interp, 0, argv[1], -1); |
|
41
|
if( argc==3 ){ |
|
42
|
int nResult; |
|
43
|
const char *zResult = Th_GetResult(interp, &nResult); |
|
44
|
Th_SetVar(interp, argv[2], TH1_LEN(argl[2]), zResult, nResult); |
|
45
|
} |
|
46
|
|
|
47
|
Th_SetResultInt(interp, rc); |
|
48
|
return TH_OK; |
|
49
|
} |
|
50
|
|
|
51
|
/* |
|
52
|
** TH Syntax: |
|
53
|
** |
|
54
|
** if expr1 body1 ?elseif expr2 body2? ? ?else? bodyN? |
|
55
|
*/ |
|
56
|
static int if_command( |
|
57
|
Th_Interp *interp, |
|
58
|
void *ctx, |
|
59
|
int argc, |
|
60
|
const char **argv, |
|
61
|
int *argl |
|
62
|
){ |
|
63
|
int rc = TH_OK; |
|
64
|
|
|
65
|
int iCond; /* Result of evaluating expression */ |
|
66
|
int i; |
|
67
|
|
|
68
|
const char *zResult; |
|
69
|
int nResult; |
|
70
|
|
|
71
|
if( argc<3 ){ |
|
72
|
goto wrong_args; |
|
73
|
} |
|
74
|
|
|
75
|
for(i=0; i<argc && rc==TH_OK; i+=3){ |
|
76
|
if( i>argc-3 ){ |
|
77
|
i = argc-3; |
|
78
|
iCond = 1; |
|
79
|
}else{ |
|
80
|
if( TH_OK!=Th_Expr(interp, argv[i+1], argl[i+1]) ){ |
|
81
|
return TH_ERROR; |
|
82
|
} |
|
83
|
zResult = Th_GetResult(interp, &nResult); |
|
84
|
rc = Th_ToInt(interp, zResult, nResult, &iCond); |
|
85
|
} |
|
86
|
if( iCond && rc==TH_OK ){ |
|
87
|
rc = Th_Eval(interp, 0, argv[i+2], -1); |
|
88
|
break; |
|
89
|
} |
|
90
|
} |
|
91
|
|
|
92
|
return rc; |
|
93
|
|
|
94
|
wrong_args: |
|
95
|
return Th_WrongNumArgs(interp, "if ..."); |
|
96
|
} |
|
97
|
|
|
98
|
/* |
|
99
|
** TH Syntax: |
|
100
|
** |
|
101
|
** expr expr |
|
102
|
*/ |
|
103
|
static int expr_command( |
|
104
|
Th_Interp *interp, |
|
105
|
void *ctx, |
|
106
|
int argc, |
|
107
|
const char **argv, |
|
108
|
int *argl |
|
109
|
){ |
|
110
|
if( argc!=2 ){ |
|
111
|
return Th_WrongNumArgs(interp, "expr expression"); |
|
112
|
} |
|
113
|
|
|
114
|
return Th_Expr(interp, argv[1], argl[1]); |
|
115
|
} |
|
116
|
|
|
117
|
/* |
|
118
|
** Evaluate the th1 script (zBody, nBody) in the local stack frame. |
|
119
|
** Return the result of the evaluation, except if the result |
|
120
|
** is TH_CONTINUE, return TH_OK instead. |
|
121
|
*/ |
|
122
|
static int eval_loopbody(Th_Interp *interp, const char *zBody, int nBody){ |
|
123
|
int rc = Th_Eval(interp, 0, zBody, nBody); |
|
124
|
if( rc==TH_CONTINUE ){ |
|
125
|
rc = TH_OK; |
|
126
|
} |
|
127
|
return rc; |
|
128
|
} |
|
129
|
|
|
130
|
/* |
|
131
|
** TH Syntax: |
|
132
|
** |
|
133
|
** for init condition incr script |
|
134
|
*/ |
|
135
|
static int for_command( |
|
136
|
Th_Interp *interp, |
|
137
|
void *ctx, |
|
138
|
int argc, |
|
139
|
const char **argv, |
|
140
|
int *argl |
|
141
|
){ |
|
142
|
int rc; |
|
143
|
int iCond; |
|
144
|
|
|
145
|
if( argc!=5 ){ |
|
146
|
return Th_WrongNumArgs(interp, "for init condition incr script"); |
|
147
|
} |
|
148
|
|
|
149
|
/* Evaluate the 'init' script */ |
|
150
|
rc = Th_Eval(interp, 0, argv[1], -1); |
|
151
|
|
|
152
|
while( rc==TH_OK |
|
153
|
&& TH_OK==(rc = Th_Expr(interp, argv[2], -1)) |
|
154
|
&& TH_OK==(rc = Th_ToInt(interp, Th_GetResult(interp, 0), -1, &iCond)) |
|
155
|
&& iCond |
|
156
|
&& TH_OK==(rc = eval_loopbody(interp, argv[4], argl[4])) |
|
157
|
){ |
|
158
|
rc = Th_Eval(interp, 0, argv[3], -1); |
|
159
|
} |
|
160
|
|
|
161
|
if( rc==TH_BREAK ) rc = TH_OK; |
|
162
|
return rc; |
|
163
|
} |
|
164
|
|
|
165
|
/* |
|
166
|
** TH Syntax: |
|
167
|
** |
|
168
|
** foreach VARLIST LIST SCRIPT |
|
169
|
*/ |
|
170
|
static int foreach_command( |
|
171
|
Th_Interp *interp, |
|
172
|
void *ctx, |
|
173
|
int argc, |
|
174
|
const char **argv, |
|
175
|
int *argl |
|
176
|
){ |
|
177
|
int rc; |
|
178
|
char **azVar = 0; |
|
179
|
int *anVar; |
|
180
|
int nVar; |
|
181
|
char **azValue = 0; |
|
182
|
int *anValue; |
|
183
|
int nValue; |
|
184
|
int ii, jj; |
|
185
|
int bTaint = 0; |
|
186
|
|
|
187
|
if( argc!=4 ){ |
|
188
|
return Th_WrongNumArgs(interp, "foreach varlist list script"); |
|
189
|
} |
|
190
|
rc = Th_SplitList(interp, argv[1], argl[1], &azVar, &anVar, &nVar); |
|
191
|
if( rc ) return rc; |
|
192
|
TH1_XFER_TAINT(bTaint, argl[2]); |
|
193
|
rc = Th_SplitList(interp, argv[2], argl[2], &azValue, &anValue, &nValue); |
|
194
|
for(ii=0; rc==TH_OK && ii<=nValue-nVar; ii+=nVar){ |
|
195
|
for(jj=0; jj<nVar; jj++){ |
|
196
|
int x = anValue[ii+jj]; |
|
197
|
TH1_XFER_TAINT(x, bTaint); |
|
198
|
Th_SetVar(interp, azVar[jj], anVar[jj], azValue[ii+jj], x); |
|
199
|
} |
|
200
|
rc = eval_loopbody(interp, argv[3], argl[3]); |
|
201
|
} |
|
202
|
if( rc==TH_BREAK ) rc = TH_OK; |
|
203
|
Th_Free(interp, azVar); |
|
204
|
Th_Free(interp, azValue); |
|
205
|
return rc; |
|
206
|
} |
|
207
|
|
|
208
|
|
|
209
|
/* |
|
210
|
** TH Syntax: |
|
211
|
** |
|
212
|
** list ?arg1 ?arg2? ...? |
|
213
|
*/ |
|
214
|
static int list_command( |
|
215
|
Th_Interp *interp, |
|
216
|
void *ctx, |
|
217
|
int argc, |
|
218
|
const char **argv, |
|
219
|
int *argl |
|
220
|
){ |
|
221
|
char *zList = 0; |
|
222
|
int nList = 0; |
|
223
|
int i; |
|
224
|
int bTaint = 0; |
|
225
|
|
|
226
|
for(i=1; i<argc; i++){ |
|
227
|
TH1_XFER_TAINT(bTaint,argl[i]); |
|
228
|
Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]); |
|
229
|
} |
|
230
|
|
|
231
|
TH1_XFER_TAINT(nList, bTaint); |
|
232
|
Th_SetResult(interp, zList, nList); |
|
233
|
Th_Free(interp, zList); |
|
234
|
|
|
235
|
return TH_OK; |
|
236
|
} |
|
237
|
|
|
238
|
/* |
|
239
|
** TH Syntax: |
|
240
|
** |
|
241
|
** lappend var ?arg1? ?arg2? ...? |
|
242
|
** |
|
243
|
** Interpret the content of variable var as a list. Create var if it |
|
244
|
** does not already exist. Append each argument as a new list element. |
|
245
|
*/ |
|
246
|
static int lappend_command( |
|
247
|
Th_Interp *interp, |
|
248
|
void *ctx, |
|
249
|
int argc, |
|
250
|
const char **argv, |
|
251
|
int *argl |
|
252
|
){ |
|
253
|
char *zList = 0; |
|
254
|
int nList = 0; |
|
255
|
int i, rc; |
|
256
|
int bTaint = 0; |
|
257
|
|
|
258
|
if( argc<2 ){ |
|
259
|
return Th_WrongNumArgs(interp, "lappend var ..."); |
|
260
|
} |
|
261
|
rc = Th_GetVar(interp, argv[1], argl[1]); |
|
262
|
if( rc==TH_OK ){ |
|
263
|
zList = Th_TakeResult(interp, &nList); |
|
264
|
} |
|
265
|
|
|
266
|
TH1_XFER_TAINT(bTaint, nList); |
|
267
|
for(i=2; i<argc; i++){ |
|
268
|
TH1_XFER_TAINT(bTaint, argl[i]); |
|
269
|
Th_ListAppend(interp, &zList, &nList, argv[i], argl[i]); |
|
270
|
} |
|
271
|
|
|
272
|
TH1_XFER_TAINT(nList, bTaint); |
|
273
|
Th_SetVar(interp, argv[1], argl[1], zList, nList); |
|
274
|
Th_SetResult(interp, zList, nList); |
|
275
|
Th_Free(interp, zList); |
|
276
|
|
|
277
|
return TH_OK; |
|
278
|
} |
|
279
|
|
|
280
|
|
|
281
|
/* |
|
282
|
** TH Syntax: |
|
283
|
** |
|
284
|
** lindex list index |
|
285
|
*/ |
|
286
|
static int lindex_command( |
|
287
|
Th_Interp *interp, |
|
288
|
void *ctx, |
|
289
|
int argc, |
|
290
|
const char **argv, |
|
291
|
int *argl |
|
292
|
){ |
|
293
|
int iElem; |
|
294
|
int rc; |
|
295
|
|
|
296
|
char **azElem; |
|
297
|
int *anElem; |
|
298
|
int nCount; |
|
299
|
int bTaint = 0; |
|
300
|
|
|
301
|
if( argc!=3 ){ |
|
302
|
return Th_WrongNumArgs(interp, "lindex list index"); |
|
303
|
} |
|
304
|
|
|
305
|
if( TH_OK!=Th_ToInt(interp, argv[2], argl[2], &iElem) ){ |
|
306
|
return TH_ERROR; |
|
307
|
} |
|
308
|
|
|
309
|
TH1_XFER_TAINT(bTaint, argl[1]); |
|
310
|
rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount); |
|
311
|
if( rc==TH_OK ){ |
|
312
|
if( iElem<nCount && iElem>=0 ){ |
|
313
|
int sz = anElem[iElem]; |
|
314
|
TH1_XFER_TAINT(sz, bTaint); |
|
315
|
Th_SetResult(interp, azElem[iElem], sz); |
|
316
|
}else{ |
|
317
|
Th_SetResult(interp, 0, 0); |
|
318
|
} |
|
319
|
Th_Free(interp, azElem); |
|
320
|
} |
|
321
|
|
|
322
|
return rc; |
|
323
|
} |
|
324
|
|
|
325
|
/* |
|
326
|
** TH Syntax: |
|
327
|
** |
|
328
|
** llength list |
|
329
|
*/ |
|
330
|
static int llength_command( |
|
331
|
Th_Interp *interp, |
|
332
|
void *ctx, |
|
333
|
int argc, |
|
334
|
const char **argv, |
|
335
|
int *argl |
|
336
|
){ |
|
337
|
int nElem; |
|
338
|
int rc; |
|
339
|
|
|
340
|
if( argc!=2 ){ |
|
341
|
return Th_WrongNumArgs(interp, "llength list"); |
|
342
|
} |
|
343
|
|
|
344
|
rc = Th_SplitList(interp, argv[1], argl[1], 0, 0, &nElem); |
|
345
|
if( rc==TH_OK ){ |
|
346
|
Th_SetResultInt(interp, nElem); |
|
347
|
} |
|
348
|
|
|
349
|
return rc; |
|
350
|
} |
|
351
|
|
|
352
|
/* |
|
353
|
** TH Syntax: |
|
354
|
** |
|
355
|
** lsearch list string |
|
356
|
*/ |
|
357
|
static int lsearch_command( |
|
358
|
Th_Interp *interp, |
|
359
|
void *ctx, |
|
360
|
int argc, |
|
361
|
const char **argv, |
|
362
|
int *argl |
|
363
|
){ |
|
364
|
int rc; |
|
365
|
char **azElem; |
|
366
|
int *anElem; |
|
367
|
int nCount; |
|
368
|
int i; |
|
369
|
|
|
370
|
if( argc!=3 ){ |
|
371
|
return Th_WrongNumArgs(interp, "lsearch list string"); |
|
372
|
} |
|
373
|
|
|
374
|
rc = Th_SplitList(interp, argv[1], argl[1], &azElem, &anElem, &nCount); |
|
375
|
if( rc==TH_OK ){ |
|
376
|
int nn = TH1_LEN(argl[2]); |
|
377
|
Th_SetResultInt(interp, -1); |
|
378
|
for(i=0; i<nCount; i++){ |
|
379
|
if( TH1_LEN(anElem[i])==nn && 0==memcmp(azElem[i], argv[2], nn) ){ |
|
380
|
Th_SetResultInt(interp, i); |
|
381
|
break; |
|
382
|
} |
|
383
|
} |
|
384
|
Th_Free(interp, azElem); |
|
385
|
} |
|
386
|
|
|
387
|
return rc; |
|
388
|
} |
|
389
|
|
|
390
|
/* |
|
391
|
** TH Syntax: |
|
392
|
** |
|
393
|
** set varname ?value? |
|
394
|
*/ |
|
395
|
static int set_command( |
|
396
|
Th_Interp *interp, |
|
397
|
void *ctx, |
|
398
|
int argc, |
|
399
|
const char **argv, |
|
400
|
int *argl |
|
401
|
){ |
|
402
|
if( argc!=2 && argc!=3 ){ |
|
403
|
return Th_WrongNumArgs(interp, "set varname ?value?"); |
|
404
|
} |
|
405
|
|
|
406
|
if( argc==3 ){ |
|
407
|
Th_SetVar(interp, argv[1], argl[1], argv[2], argl[2]); |
|
408
|
} |
|
409
|
return Th_GetVar(interp, argv[1], argl[1]); |
|
410
|
} |
|
411
|
|
|
412
|
/* |
|
413
|
** When a new command is created using the built-in [proc] command, an |
|
414
|
** instance of the following structure is allocated and populated. A |
|
415
|
** pointer to the structure is passed as the context (second) argument |
|
416
|
** to function proc_call1() when the new command is executed. |
|
417
|
*/ |
|
418
|
typedef struct ProcDefn ProcDefn; |
|
419
|
struct ProcDefn { |
|
420
|
int nParam; /* Number of formal (non "args") parameters */ |
|
421
|
char **azParam; /* Parameter names */ |
|
422
|
int *anParam; /* Lengths of parameter names */ |
|
423
|
char **azDefault; /* Default values */ |
|
424
|
int *anDefault; /* Lengths of default values */ |
|
425
|
int hasArgs; /* True if there is an "args" parameter */ |
|
426
|
char *zProgram; /* Body of proc */ |
|
427
|
int nProgram; /* Number of bytes at zProgram */ |
|
428
|
char *zUsage; /* Usage message */ |
|
429
|
int nUsage; /* Number of bytes at zUsage */ |
|
430
|
}; |
|
431
|
|
|
432
|
/* This structure is used to temporarily store arguments passed to an |
|
433
|
** invocation of a command created using [proc]. A pointer to an |
|
434
|
** instance is passed as the second argument to the proc_call2() function. |
|
435
|
*/ |
|
436
|
typedef struct ProcArgs ProcArgs; |
|
437
|
struct ProcArgs { |
|
438
|
int argc; |
|
439
|
const char **argv; |
|
440
|
int *argl; |
|
441
|
}; |
|
442
|
|
|
443
|
/* |
|
444
|
** Each time a command created using [proc] is invoked, a new |
|
445
|
** th1 stack frame is allocated (for the proc's local variables) and |
|
446
|
** this function invoked. |
|
447
|
** |
|
448
|
** Argument pContext1 points to the associated ProcDefn structure. |
|
449
|
** Argument pContext2 points to a ProcArgs structure that contains |
|
450
|
** the arguments passed to this specific invocation of the proc. |
|
451
|
*/ |
|
452
|
static int proc_call2(Th_Interp *interp, void *pContext1, void *pContext2){ |
|
453
|
int i; |
|
454
|
ProcDefn *p = (ProcDefn *)pContext1; |
|
455
|
ProcArgs *pArgs = (ProcArgs *)pContext2; |
|
456
|
|
|
457
|
/* Check if there are the right number of arguments. If there are |
|
458
|
** not, generate a usage message for the command. |
|
459
|
*/ |
|
460
|
if( (pArgs->argc>(p->nParam+1) && !p->hasArgs) |
|
461
|
|| (pArgs->argc<=(p->nParam) && !p->azDefault[pArgs->argc-1]) |
|
462
|
){ |
|
463
|
char *zUsage = 0; |
|
464
|
int nUsage = 0; |
|
465
|
Th_StringAppend(interp, &zUsage, &nUsage, pArgs->argv[0], pArgs->argl[0]); |
|
466
|
Th_StringAppend(interp, &zUsage, &nUsage, p->zUsage, p->nUsage); |
|
467
|
Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"", 1); |
|
468
|
Th_WrongNumArgs(interp, zUsage); |
|
469
|
Th_Free(interp, zUsage); |
|
470
|
return TH_ERROR; |
|
471
|
} |
|
472
|
|
|
473
|
/* Populate the formal proc parameters. */ |
|
474
|
for(i=0; i<p->nParam; i++){ |
|
475
|
const char *zVal; |
|
476
|
int nVal; |
|
477
|
if( pArgs->argc>(i+1) ){ |
|
478
|
zVal = pArgs->argv[i+1]; |
|
479
|
nVal = pArgs->argl[i+1]; |
|
480
|
}else{ |
|
481
|
zVal = p->azDefault[i]; |
|
482
|
nVal = p->anDefault[i]; |
|
483
|
} |
|
484
|
Th_SetVar(interp, p->azParam[i], p->anParam[i], zVal, nVal); |
|
485
|
} |
|
486
|
|
|
487
|
/* Populate the "args" parameter, if it exists */ |
|
488
|
if( p->hasArgs ){ |
|
489
|
char *zArgs = 0; |
|
490
|
int nArgs = 0; |
|
491
|
for(i=p->nParam+1; i<pArgs->argc; i++){ |
|
492
|
Th_ListAppend(interp, &zArgs, &nArgs, pArgs->argv[i], pArgs->argl[i]); |
|
493
|
} |
|
494
|
Th_SetVar(interp, (const char *)"args", -1, zArgs, nArgs); |
|
495
|
if(zArgs){ |
|
496
|
Th_Free(interp, zArgs); |
|
497
|
} |
|
498
|
} |
|
499
|
|
|
500
|
Th_SetResult(interp, 0, 0); |
|
501
|
return Th_Eval(interp, 0, p->zProgram, p->nProgram); |
|
502
|
} |
|
503
|
|
|
504
|
/* |
|
505
|
** This function is the command callback registered for all commands |
|
506
|
** created using the [proc] command. The second argument, pContext, |
|
507
|
** is a pointer to the associated ProcDefn structure. |
|
508
|
*/ |
|
509
|
static int proc_call1( |
|
510
|
Th_Interp *interp, |
|
511
|
void *pContext, |
|
512
|
int argc, |
|
513
|
const char **argv, |
|
514
|
int *argl |
|
515
|
){ |
|
516
|
int rc; |
|
517
|
|
|
518
|
ProcDefn *p = (ProcDefn *)pContext; |
|
519
|
ProcArgs procargs; |
|
520
|
|
|
521
|
/* Call function proc_call2(), which will call Th_Eval() to evaluate |
|
522
|
** the body of the [proc], in a new Th stack frame. This is so that |
|
523
|
** the proc body has its own local variable context. |
|
524
|
*/ |
|
525
|
procargs.argc = argc; |
|
526
|
procargs.argv = argv; |
|
527
|
procargs.argl = argl; |
|
528
|
rc = Th_InFrame(interp, proc_call2, (void *)p, (void *)&procargs); |
|
529
|
|
|
530
|
if( rc==TH_RETURN ){ |
|
531
|
rc = TH_OK; |
|
532
|
} |
|
533
|
if( rc==TH_RETURN2 ){ |
|
534
|
rc = TH_RETURN; |
|
535
|
} |
|
536
|
return rc; |
|
537
|
} |
|
538
|
|
|
539
|
/* |
|
540
|
** This function is registered as the delete callback for all commands |
|
541
|
** created using the built-in [proc] command. It is called automatically |
|
542
|
** when a command created using [proc] is deleted. |
|
543
|
** |
|
544
|
** It frees the ProcDefn structure allocated when the command was created. |
|
545
|
*/ |
|
546
|
static void proc_del(Th_Interp *interp, void *pContext){ |
|
547
|
ProcDefn *p = (ProcDefn *)pContext; |
|
548
|
Th_Free(interp, (void *)p->zUsage); |
|
549
|
Th_Free(interp, (void *)p); |
|
550
|
} |
|
551
|
|
|
552
|
/* |
|
553
|
** TH Syntax: |
|
554
|
** |
|
555
|
** proc name arglist code |
|
556
|
*/ |
|
557
|
static int proc_command( |
|
558
|
Th_Interp *interp, |
|
559
|
void *ctx, |
|
560
|
int argc, |
|
561
|
const char **argv, |
|
562
|
int *argl |
|
563
|
){ |
|
564
|
int rc; |
|
565
|
const char *zName; |
|
566
|
|
|
567
|
ProcDefn *p; |
|
568
|
int nByte; |
|
569
|
int i; |
|
570
|
char *zSpace; |
|
571
|
|
|
572
|
char **azParam; |
|
573
|
int *anParam; |
|
574
|
int nParam; |
|
575
|
|
|
576
|
char *zUsage = 0; /* Build up a usage message here */ |
|
577
|
int nUsage = 0; /* Number of bytes at zUsage */ |
|
578
|
|
|
579
|
if( argc!=4 ){ |
|
580
|
return Th_WrongNumArgs(interp, "proc name arglist code"); |
|
581
|
} |
|
582
|
if( Th_SplitList(interp, argv[2], TH1_LEN(argl[2]), |
|
583
|
&azParam, &anParam, &nParam) ){ |
|
584
|
return TH_ERROR; |
|
585
|
} |
|
586
|
|
|
587
|
/* Allocate the new ProcDefn structure. */ |
|
588
|
nByte = sizeof(ProcDefn) + /* ProcDefn structure */ |
|
589
|
(sizeof(char *) + sizeof(int)) * nParam + /* azParam, anParam */ |
|
590
|
(sizeof(char *) + sizeof(int)) * nParam + /* azDefault, anDefault */ |
|
591
|
TH1_LEN(argl[3]) + /* zProgram */ |
|
592
|
TH1_LEN(argl[2]); /* Space for copies of param names and dflt values */ |
|
593
|
p = (ProcDefn *)Th_Malloc(interp, nByte); |
|
594
|
|
|
595
|
/* If the last parameter in the parameter list is "args", then set the |
|
596
|
** ProcDefn.hasArgs flag. The "args" parameter does not require an |
|
597
|
** entry in the ProcDefn.azParam[] or ProcDefn.azDefault[] arrays. |
|
598
|
*/ |
|
599
|
if( nParam>0 ){ |
|
600
|
if( TH1_LEN(anParam[nParam-1])==4 |
|
601
|
&& 0==memcmp(azParam[nParam-1], "args", 4) |
|
602
|
){ |
|
603
|
p->hasArgs = 1; |
|
604
|
nParam--; |
|
605
|
} |
|
606
|
} |
|
607
|
|
|
608
|
p->nParam = nParam; |
|
609
|
p->azParam = (char **)&p[1]; |
|
610
|
p->anParam = (int *)&p->azParam[nParam]; |
|
611
|
p->azDefault = (char **)&p->anParam[nParam]; |
|
612
|
p->anDefault = (int *)&p->azDefault[nParam]; |
|
613
|
p->zProgram = (char *)&p->anDefault[nParam]; |
|
614
|
memcpy(p->zProgram, argv[3], TH1_LEN(argl[3])); |
|
615
|
p->nProgram = TH1_LEN(argl[3]); |
|
616
|
zSpace = &p->zProgram[p->nProgram]; |
|
617
|
|
|
618
|
for(i=0; i<nParam; i++){ |
|
619
|
char **az; |
|
620
|
int *an; |
|
621
|
int n; |
|
622
|
if( Th_SplitList(interp, azParam[i], anParam[i], &az, &an, &n) ){ |
|
623
|
goto error_out; |
|
624
|
} |
|
625
|
if( n<1 || n>2 ){ |
|
626
|
const char expected[] = "expected parameter, got \""; |
|
627
|
Th_ErrorMessage(interp, expected, azParam[i], anParam[i]); |
|
628
|
Th_Free(interp, az); |
|
629
|
goto error_out; |
|
630
|
} |
|
631
|
p->anParam[i] = an[0]; |
|
632
|
p->azParam[i] = zSpace; |
|
633
|
memcpy(zSpace, az[0], an[0]); |
|
634
|
zSpace += an[0]; |
|
635
|
if( n==2 ){ |
|
636
|
p->anDefault[i] = an[1]; |
|
637
|
p->azDefault[i] = zSpace; |
|
638
|
memcpy(zSpace, az[1], an[1]); |
|
639
|
zSpace += an[1]; |
|
640
|
} |
|
641
|
|
|
642
|
Th_StringAppend(interp, &zUsage, &nUsage, (const char *)" ", 1); |
|
643
|
if( n==2 ){ |
|
644
|
Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"?", 1); |
|
645
|
Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]); |
|
646
|
Th_StringAppend(interp, &zUsage, &nUsage, (const char *)"?", 1); |
|
647
|
}else{ |
|
648
|
Th_StringAppend(interp, &zUsage, &nUsage, az[0], an[0]); |
|
649
|
} |
|
650
|
|
|
651
|
Th_Free(interp, az); |
|
652
|
} |
|
653
|
assert( zSpace-(char *)p<=nByte ); |
|
654
|
|
|
655
|
/* If there is an "args" parameter, append it to the end of the usage |
|
656
|
** message. Set ProcDefn.zUsage to point at the usage message. It will |
|
657
|
** be freed along with the rest of the proc-definition by proc_del(). |
|
658
|
*/ |
|
659
|
if( p->hasArgs ){ |
|
660
|
Th_StringAppend(interp, &zUsage, &nUsage, (const char *)" ?args...?", -1); |
|
661
|
} |
|
662
|
p->zUsage = zUsage; |
|
663
|
p->nUsage = nUsage; |
|
664
|
|
|
665
|
/* Register the new command with the th1 interpreter. */ |
|
666
|
zName = argv[1]; |
|
667
|
rc = Th_CreateCommand(interp, zName, proc_call1, (void *)p, proc_del); |
|
668
|
if( rc==TH_OK ){ |
|
669
|
Th_SetResult(interp, 0, 0); |
|
670
|
} |
|
671
|
|
|
672
|
Th_Free(interp, azParam); |
|
673
|
return TH_OK; |
|
674
|
|
|
675
|
error_out: |
|
676
|
Th_Free(interp, azParam); |
|
677
|
Th_Free(interp, zUsage); |
|
678
|
return TH_ERROR; |
|
679
|
} |
|
680
|
|
|
681
|
/* |
|
682
|
** TH Syntax: |
|
683
|
** |
|
684
|
** rename oldcmd newcmd |
|
685
|
*/ |
|
686
|
static int rename_command( |
|
687
|
Th_Interp *interp, |
|
688
|
void *ctx, |
|
689
|
int argc, |
|
690
|
const char **argv, |
|
691
|
int *argl |
|
692
|
){ |
|
693
|
if( argc!=3 ){ |
|
694
|
return Th_WrongNumArgs(interp, "rename oldcmd newcmd"); |
|
695
|
} |
|
696
|
return Th_RenameCommand(interp, argv[1], TH1_LEN(argl[1]), |
|
697
|
argv[2], TH1_LEN(argl[2])); |
|
698
|
} |
|
699
|
|
|
700
|
/* |
|
701
|
** TH Syntax: |
|
702
|
** |
|
703
|
** break ?value...? |
|
704
|
** continue ?value...? |
|
705
|
** ok ?value...? |
|
706
|
** error ?value...? |
|
707
|
*/ |
|
708
|
static int simple_command( |
|
709
|
Th_Interp *interp, |
|
710
|
void *ctx, |
|
711
|
int argc, |
|
712
|
const char **argv, |
|
713
|
int *argl |
|
714
|
){ |
|
715
|
if( argc!=1 && argc!=2 ){ |
|
716
|
return Th_WrongNumArgs(interp, "return ?value?"); |
|
717
|
} |
|
718
|
if( argc==2 ){ |
|
719
|
Th_SetResult(interp, argv[1], argl[1]); |
|
720
|
} |
|
721
|
return FOSSIL_PTR_TO_INT(ctx); |
|
722
|
} |
|
723
|
|
|
724
|
/* |
|
725
|
** TH Syntax: |
|
726
|
** |
|
727
|
** return ?-code code? ?value? |
|
728
|
*/ |
|
729
|
static int return_command( |
|
730
|
Th_Interp *interp, |
|
731
|
void *ctx, |
|
732
|
int argc, |
|
733
|
const char **argv, |
|
734
|
int *argl |
|
735
|
){ |
|
736
|
int iCode = TH_RETURN; |
|
737
|
if( argc<1 || argc>4 ){ |
|
738
|
return Th_WrongNumArgs(interp, "return ?-code code? ?value?"); |
|
739
|
} |
|
740
|
if( argc>2 ){ |
|
741
|
int rc = Th_ToInt(interp, argv[2], argl[2], &iCode); |
|
742
|
if( rc!=TH_OK ){ |
|
743
|
return rc; |
|
744
|
} |
|
745
|
} |
|
746
|
if( argc==2 || argc==4 ){ |
|
747
|
Th_SetResult(interp, argv[argc-1], argl[argc-1]); |
|
748
|
} |
|
749
|
return iCode; |
|
750
|
} |
|
751
|
|
|
752
|
/* |
|
753
|
** TH Syntax: |
|
754
|
** |
|
755
|
** string compare STRING1 STRING2 |
|
756
|
*/ |
|
757
|
static int string_compare_command( |
|
758
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
759
|
){ |
|
760
|
const char *zRight; int nRight; |
|
761
|
const char *zLeft; int nLeft; |
|
762
|
|
|
763
|
int i; |
|
764
|
int iRes = 0; |
|
765
|
|
|
766
|
if( argc!=4 ){ |
|
767
|
return Th_WrongNumArgs(interp, "string compare str1 str2"); |
|
768
|
} |
|
769
|
|
|
770
|
zLeft = argv[2]; |
|
771
|
nLeft = TH1_LEN(argl[2]); |
|
772
|
zRight = argv[3]; |
|
773
|
nRight = TH1_LEN(argl[3]); |
|
774
|
|
|
775
|
for(i=0; iRes==0 && i<nLeft && i<nRight; i++){ |
|
776
|
iRes = zLeft[i]-zRight[i]; |
|
777
|
} |
|
778
|
if( iRes==0 ){ |
|
779
|
iRes = nLeft-nRight; |
|
780
|
} |
|
781
|
|
|
782
|
if( iRes<0 ) iRes = -1; |
|
783
|
if( iRes>0 ) iRes = 1; |
|
784
|
|
|
785
|
return Th_SetResultInt(interp, iRes); |
|
786
|
} |
|
787
|
|
|
788
|
/* |
|
789
|
** TH Syntax: |
|
790
|
** |
|
791
|
** string first NEEDLE HAYSTACK |
|
792
|
*/ |
|
793
|
static int string_first_command( |
|
794
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
795
|
){ |
|
796
|
int nNeedle; |
|
797
|
int nHaystack; |
|
798
|
int iRes = -1; |
|
799
|
|
|
800
|
if( argc!=4 ){ |
|
801
|
return Th_WrongNumArgs(interp, "string first needle haystack"); |
|
802
|
} |
|
803
|
|
|
804
|
nNeedle = TH1_LEN(argl[2]); |
|
805
|
nHaystack = TH1_LEN(argl[3]); |
|
806
|
|
|
807
|
if( nNeedle && nHaystack && nNeedle<=nHaystack ){ |
|
808
|
const char *zNeedle = argv[2]; |
|
809
|
const char *zHaystack = argv[3]; |
|
810
|
int i; |
|
811
|
|
|
812
|
for(i=0; i<=(nHaystack-nNeedle); i++){ |
|
813
|
if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){ |
|
814
|
iRes = i; |
|
815
|
break; |
|
816
|
} |
|
817
|
} |
|
818
|
} |
|
819
|
|
|
820
|
return Th_SetResultInt(interp, iRes); |
|
821
|
} |
|
822
|
|
|
823
|
/* |
|
824
|
** TH Syntax: |
|
825
|
** |
|
826
|
** string index STRING INDEX |
|
827
|
*/ |
|
828
|
static int string_index_command( |
|
829
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
830
|
){ |
|
831
|
int iIndex; |
|
832
|
|
|
833
|
if( argc!=4 ){ |
|
834
|
return Th_WrongNumArgs(interp, "string index string index"); |
|
835
|
} |
|
836
|
|
|
837
|
if( TH1_LEN(argl[3])==3 && 0==memcmp("end", argv[3], 3) ){ |
|
838
|
iIndex = TH1_LEN(argl[2])-1; |
|
839
|
}else if( Th_ToInt(interp, argv[3], argl[3], &iIndex) ){ |
|
840
|
Th_ErrorMessage( |
|
841
|
interp, "Expected \"end\" or integer, got:", argv[3], argl[3]); |
|
842
|
return TH_ERROR; |
|
843
|
} |
|
844
|
|
|
845
|
if( iIndex>=0 && iIndex<TH1_LEN(argl[2]) ){ |
|
846
|
int sz = 1; |
|
847
|
TH1_XFER_TAINT(sz, argl[2]); |
|
848
|
return Th_SetResult(interp, &argv[2][iIndex], sz); |
|
849
|
}else{ |
|
850
|
return Th_SetResult(interp, 0, 0); |
|
851
|
} |
|
852
|
} |
|
853
|
|
|
854
|
/* |
|
855
|
** TH Syntax: |
|
856
|
** |
|
857
|
** string is CLASS STRING |
|
858
|
*/ |
|
859
|
static int string_is_command( |
|
860
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
861
|
){ |
|
862
|
if( argc!=4 ){ |
|
863
|
return Th_WrongNumArgs(interp, "string is class string"); |
|
864
|
} |
|
865
|
if( TH1_LEN(argl[2])==5 && 0==memcmp(argv[2], "alnum", 5) ){ |
|
866
|
int i; |
|
867
|
int iRes = 1; |
|
868
|
|
|
869
|
for(i=0; i<TH1_LEN(argl[3]); i++){ |
|
870
|
if( !th_isalnum(argv[3][i]) ){ |
|
871
|
iRes = 0; |
|
872
|
} |
|
873
|
} |
|
874
|
|
|
875
|
return Th_SetResultInt(interp, iRes); |
|
876
|
}else if( TH1_LEN(argl[2])==6 && 0==memcmp(argv[2], "double", 6) ){ |
|
877
|
double fVal; |
|
878
|
if( Th_ToDouble(interp, argv[3], argl[3], &fVal)==TH_OK ){ |
|
879
|
return Th_SetResultInt(interp, 1); |
|
880
|
} |
|
881
|
return Th_SetResultInt(interp, 0); |
|
882
|
}else if( TH1_LEN(argl[2])==7 && 0==memcmp(argv[2], "integer", 7) ){ |
|
883
|
int iVal; |
|
884
|
if( Th_ToInt(interp, argv[3], argl[3], &iVal)==TH_OK ){ |
|
885
|
return Th_SetResultInt(interp, 1); |
|
886
|
} |
|
887
|
return Th_SetResultInt(interp, 0); |
|
888
|
}else if( TH1_LEN(argl[2])==4 && 0==memcmp(argv[2], "list", 4) ){ |
|
889
|
if( Th_SplitList(interp, argv[3], argl[3], 0, 0, 0)==TH_OK ){ |
|
890
|
return Th_SetResultInt(interp, 1); |
|
891
|
} |
|
892
|
return Th_SetResultInt(interp, 0); |
|
893
|
}else if( TH1_LEN(argl[2])==7 && 0==memcmp(argv[2], "tainted", 7) ){ |
|
894
|
return Th_SetResultInt(interp, TH1_TAINTED(argl[3])); |
|
895
|
}else{ |
|
896
|
Th_ErrorMessage(interp, |
|
897
|
"Expected alnum, double, integer, list, or tainted, got:", |
|
898
|
argv[2], TH1_LEN(argl[2])); |
|
899
|
return TH_ERROR; |
|
900
|
} |
|
901
|
} |
|
902
|
|
|
903
|
/* |
|
904
|
** TH Syntax: |
|
905
|
** |
|
906
|
** string last NEEDLE HAYSTACK |
|
907
|
*/ |
|
908
|
static int string_last_command( |
|
909
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
910
|
){ |
|
911
|
int nNeedle; |
|
912
|
int nHaystack; |
|
913
|
int iRes = -1; |
|
914
|
|
|
915
|
if( argc!=4 ){ |
|
916
|
return Th_WrongNumArgs(interp, "string last needle haystack"); |
|
917
|
} |
|
918
|
|
|
919
|
nNeedle = TH1_LEN(argl[2]); |
|
920
|
nHaystack = TH1_LEN(argl[3]); |
|
921
|
|
|
922
|
if( nNeedle && nHaystack && nNeedle<=nHaystack ){ |
|
923
|
const char *zNeedle = argv[2]; |
|
924
|
const char *zHaystack = argv[3]; |
|
925
|
int i; |
|
926
|
|
|
927
|
for(i=nHaystack-nNeedle; i>=0; i--){ |
|
928
|
if( 0==memcmp(zNeedle, &zHaystack[i], nNeedle) ){ |
|
929
|
iRes = i; |
|
930
|
break; |
|
931
|
} |
|
932
|
} |
|
933
|
} |
|
934
|
|
|
935
|
return Th_SetResultInt(interp, iRes); |
|
936
|
} |
|
937
|
|
|
938
|
/* |
|
939
|
** TH Syntax: |
|
940
|
** |
|
941
|
** string length STRING |
|
942
|
*/ |
|
943
|
static int string_length_command( |
|
944
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
945
|
){ |
|
946
|
if( argc!=3 ){ |
|
947
|
return Th_WrongNumArgs(interp, "string length string"); |
|
948
|
} |
|
949
|
return Th_SetResultInt(interp, TH1_LEN(argl[2])); |
|
950
|
} |
|
951
|
|
|
952
|
/* |
|
953
|
** TH Syntax: |
|
954
|
** |
|
955
|
** string match PATTERN STRING |
|
956
|
** |
|
957
|
*/ |
|
958
|
static int string_match_command( |
|
959
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
960
|
){ |
|
961
|
extern char *fossil_strndup(const char*,ssize_t); |
|
962
|
extern void fossil_free(void*); |
|
963
|
char *zPat, *zStr; |
|
964
|
int rc; |
|
965
|
if( argc!=4 ){ |
|
966
|
return Th_WrongNumArgs(interp, "string match pattern string"); |
|
967
|
} |
|
968
|
zPat = fossil_strndup(argv[2],TH1_LEN(argl[2])); |
|
969
|
zStr = fossil_strndup(argv[3],TH1_LEN(argl[3])); |
|
970
|
rc = sqlite3_strglob(zPat,zStr); |
|
971
|
fossil_free(zPat); |
|
972
|
fossil_free(zStr); |
|
973
|
return Th_SetResultInt(interp, !rc); |
|
974
|
} |
|
975
|
|
|
976
|
/* |
|
977
|
** TH Syntax: |
|
978
|
** |
|
979
|
** string range STRING FIRST LAST |
|
980
|
*/ |
|
981
|
static int string_range_command( |
|
982
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
983
|
){ |
|
984
|
int iStart; |
|
985
|
int iEnd; |
|
986
|
int sz; |
|
987
|
|
|
988
|
if( argc!=5 ){ |
|
989
|
return Th_WrongNumArgs(interp, "string range string first last"); |
|
990
|
} |
|
991
|
|
|
992
|
if( TH1_LEN(argl[4])==3 && 0==memcmp("end", argv[4], 3) ){ |
|
993
|
iEnd = TH1_LEN(argl[2]); |
|
994
|
}else if( Th_ToInt(interp, argv[4], argl[4], &iEnd) ){ |
|
995
|
Th_ErrorMessage( |
|
996
|
interp, "Expected \"end\" or integer, got:", argv[4], TH1_LEN(argl[4])); |
|
997
|
return TH_ERROR; |
|
998
|
} |
|
999
|
if( Th_ToInt(interp, argv[3], argl[3], &iStart) ){ |
|
1000
|
return TH_ERROR; |
|
1001
|
} |
|
1002
|
|
|
1003
|
if( iStart<0 ) iStart = 0; |
|
1004
|
if( iEnd>=TH1_LEN(argl[2]) ) iEnd = TH1_LEN(argl[2])-1; |
|
1005
|
if( iStart>iEnd ) iEnd = iStart-1; |
|
1006
|
sz = iEnd - iStart + 1; |
|
1007
|
TH1_XFER_TAINT(sz, argl[2]); |
|
1008
|
|
|
1009
|
return Th_SetResult(interp, &argv[2][iStart], sz); |
|
1010
|
} |
|
1011
|
|
|
1012
|
/* |
|
1013
|
** TH Syntax: |
|
1014
|
** |
|
1015
|
** string repeat STRING COUNT |
|
1016
|
*/ |
|
1017
|
static int string_repeat_command( |
|
1018
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1019
|
){ |
|
1020
|
int n; |
|
1021
|
int i; |
|
1022
|
int sz; |
|
1023
|
long long int nByte; |
|
1024
|
char *zByte; |
|
1025
|
|
|
1026
|
if( argc!=4 ){ |
|
1027
|
return Th_WrongNumArgs(interp, "string repeat string n"); |
|
1028
|
} |
|
1029
|
if( Th_ToInt(interp, argv[3], argl[3], &n) ){ |
|
1030
|
return TH_ERROR; |
|
1031
|
} |
|
1032
|
|
|
1033
|
nByte = n; |
|
1034
|
sz = TH1_LEN(argl[2]); |
|
1035
|
nByte *= sz; |
|
1036
|
TH1_SIZECHECK(nByte+1); |
|
1037
|
zByte = Th_Malloc(interp, nByte+1); |
|
1038
|
for(i=0; i<nByte; i+=sz){ |
|
1039
|
memcpy(&zByte[i], argv[2], sz); |
|
1040
|
} |
|
1041
|
|
|
1042
|
n = nByte; |
|
1043
|
TH1_XFER_TAINT(n, argl[2]); |
|
1044
|
Th_SetResult(interp, zByte, n); |
|
1045
|
Th_Free(interp, zByte); |
|
1046
|
return TH_OK; |
|
1047
|
} |
|
1048
|
|
|
1049
|
/* |
|
1050
|
** TH Syntax: |
|
1051
|
** |
|
1052
|
** string trim STRING |
|
1053
|
** string trimleft STRING |
|
1054
|
** string trimright STRING |
|
1055
|
*/ |
|
1056
|
static int string_trim_command( |
|
1057
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1058
|
){ |
|
1059
|
int n; |
|
1060
|
const char *z; |
|
1061
|
|
|
1062
|
if( argc!=3 ){ |
|
1063
|
return Th_WrongNumArgs(interp, "string trim string"); |
|
1064
|
} |
|
1065
|
z = argv[2]; |
|
1066
|
n = TH1_LEN(argl[2]); |
|
1067
|
if( TH1_LEN(argl[1])<5 || argv[1][4]=='l' ){ |
|
1068
|
while( n && th_isspace(z[0]) ){ z++; n--; } |
|
1069
|
} |
|
1070
|
if( TH1_LEN(argl[1])<5 || argv[1][4]=='r' ){ |
|
1071
|
while( n && th_isspace(z[n-1]) ){ n--; } |
|
1072
|
} |
|
1073
|
TH1_XFER_TAINT(n, argl[2]); |
|
1074
|
Th_SetResult(interp, z, n); |
|
1075
|
return TH_OK; |
|
1076
|
} |
|
1077
|
|
|
1078
|
/* |
|
1079
|
** TH Syntax: |
|
1080
|
** |
|
1081
|
** info exists VARNAME |
|
1082
|
*/ |
|
1083
|
static int info_exists_command( |
|
1084
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1085
|
){ |
|
1086
|
int rc; |
|
1087
|
|
|
1088
|
if( argc!=3 ){ |
|
1089
|
return Th_WrongNumArgs(interp, "info exists var"); |
|
1090
|
} |
|
1091
|
rc = Th_ExistsVar(interp, argv[2], TH1_LEN(argl[2])); |
|
1092
|
Th_SetResultInt(interp, rc); |
|
1093
|
return TH_OK; |
|
1094
|
} |
|
1095
|
|
|
1096
|
/* |
|
1097
|
** TH Syntax: |
|
1098
|
** |
|
1099
|
** info commands |
|
1100
|
*/ |
|
1101
|
static int info_commands_command( |
|
1102
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1103
|
){ |
|
1104
|
int rc; |
|
1105
|
char *zElem = 0; |
|
1106
|
int nElem = 0; |
|
1107
|
|
|
1108
|
if( argc!=2 ){ |
|
1109
|
return Th_WrongNumArgs(interp, "info commands"); |
|
1110
|
} |
|
1111
|
rc = Th_ListAppendCommands(interp, &zElem, &nElem); |
|
1112
|
if( rc!=TH_OK ){ |
|
1113
|
return rc; |
|
1114
|
} |
|
1115
|
Th_SetResult(interp, zElem, nElem); |
|
1116
|
if( zElem ) Th_Free(interp, zElem); |
|
1117
|
return TH_OK; |
|
1118
|
} |
|
1119
|
|
|
1120
|
/* |
|
1121
|
** TH Syntax: |
|
1122
|
** |
|
1123
|
** info vars |
|
1124
|
*/ |
|
1125
|
static int info_vars_command( |
|
1126
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1127
|
){ |
|
1128
|
int rc; |
|
1129
|
char *zElem = 0; |
|
1130
|
int nElem = 0; |
|
1131
|
|
|
1132
|
if( argc!=2 ){ |
|
1133
|
return Th_WrongNumArgs(interp, "info vars"); |
|
1134
|
} |
|
1135
|
rc = Th_ListAppendVariables(interp, &zElem, &nElem); |
|
1136
|
if( rc!=TH_OK ){ |
|
1137
|
return rc; |
|
1138
|
} |
|
1139
|
Th_SetResult(interp, zElem, nElem); |
|
1140
|
if( zElem ) Th_Free(interp, zElem); |
|
1141
|
return TH_OK; |
|
1142
|
} |
|
1143
|
|
|
1144
|
/* |
|
1145
|
** TH Syntax: |
|
1146
|
** |
|
1147
|
** array exists VARNAME |
|
1148
|
*/ |
|
1149
|
static int array_exists_command( |
|
1150
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1151
|
){ |
|
1152
|
int rc; |
|
1153
|
|
|
1154
|
if( argc!=3 ){ |
|
1155
|
return Th_WrongNumArgs(interp, "array exists var"); |
|
1156
|
} |
|
1157
|
rc = Th_ExistsArrayVar(interp, argv[2], TH1_LEN(argl[2])); |
|
1158
|
Th_SetResultInt(interp, rc); |
|
1159
|
return TH_OK; |
|
1160
|
} |
|
1161
|
|
|
1162
|
/* |
|
1163
|
** TH Syntax: |
|
1164
|
** |
|
1165
|
** array names VARNAME |
|
1166
|
*/ |
|
1167
|
static int array_names_command( |
|
1168
|
Th_Interp *interp, void *ctx, int argc, const char **argv, int *argl |
|
1169
|
){ |
|
1170
|
int rc; |
|
1171
|
char *zElem = 0; |
|
1172
|
int nElem = 0; |
|
1173
|
|
|
1174
|
if( argc!=3 ){ |
|
1175
|
return Th_WrongNumArgs(interp, "array names varname"); |
|
1176
|
} |
|
1177
|
rc = Th_ListAppendArray(interp, argv[2], TH1_LEN(argl[2]), &zElem, &nElem); |
|
1178
|
if( rc!=TH_OK ){ |
|
1179
|
return rc; |
|
1180
|
} |
|
1181
|
Th_SetResult(interp, zElem, nElem); |
|
1182
|
if( zElem ) Th_Free(interp, zElem); |
|
1183
|
return TH_OK; |
|
1184
|
} |
|
1185
|
|
|
1186
|
/* |
|
1187
|
** TH Syntax: |
|
1188
|
** |
|
1189
|
** unset VARNAME |
|
1190
|
*/ |
|
1191
|
static int unset_command( |
|
1192
|
Th_Interp *interp, |
|
1193
|
void *ctx, |
|
1194
|
int argc, |
|
1195
|
const char **argv, |
|
1196
|
int *argl |
|
1197
|
){ |
|
1198
|
if( argc!=2 ){ |
|
1199
|
return Th_WrongNumArgs(interp, "unset var"); |
|
1200
|
} |
|
1201
|
return Th_UnsetVar(interp, argv[1], TH1_LEN(argl[1])); |
|
1202
|
} |
|
1203
|
|
|
1204
|
int Th_CallSubCommand( |
|
1205
|
Th_Interp *interp, |
|
1206
|
void *ctx, |
|
1207
|
int argc, |
|
1208
|
const char **argv, |
|
1209
|
int *argl, |
|
1210
|
const Th_SubCommand *aSub |
|
1211
|
){ |
|
1212
|
if( argc>1 ){ |
|
1213
|
int i; |
|
1214
|
for(i=0; aSub[i].zName; i++){ |
|
1215
|
const char *zName = aSub[i].zName; |
|
1216
|
if( th_strlen(zName)==TH1_LEN(argl[1]) |
|
1217
|
&& 0==memcmp(zName, argv[1], TH1_LEN(argl[1])) ){ |
|
1218
|
return aSub[i].xProc(interp, ctx, argc, argv, argl); |
|
1219
|
} |
|
1220
|
} |
|
1221
|
} |
|
1222
|
if(argc<2){ |
|
1223
|
Th_ErrorMessage(interp, "Expected sub-command for", |
|
1224
|
argv[0], TH1_LEN(argl[0])); |
|
1225
|
}else{ |
|
1226
|
Th_ErrorMessage(interp, "Expected sub-command, got:", |
|
1227
|
argv[1], TH1_LEN(argl[1])); |
|
1228
|
} |
|
1229
|
return TH_ERROR; |
|
1230
|
} |
|
1231
|
|
|
1232
|
/* |
|
1233
|
** TH Syntax: |
|
1234
|
** |
|
1235
|
** string compare STR1 STR2 |
|
1236
|
** string first NEEDLE HAYSTACK ?STARTINDEX? |
|
1237
|
** string index STRING INDEX |
|
1238
|
** string is CLASS STRING |
|
1239
|
** string last NEEDLE HAYSTACK ?STARTINDEX? |
|
1240
|
** string length STRING |
|
1241
|
** string range STRING FIRST LAST |
|
1242
|
** string repeat STRING COUNT |
|
1243
|
** string trim STRING |
|
1244
|
** string trimleft STRING |
|
1245
|
** string trimright STRING |
|
1246
|
*/ |
|
1247
|
static int string_command( |
|
1248
|
Th_Interp *interp, |
|
1249
|
void *ctx, |
|
1250
|
int argc, |
|
1251
|
const char **argv, |
|
1252
|
int *argl |
|
1253
|
){ |
|
1254
|
static const Th_SubCommand aSub[] = { |
|
1255
|
{ "compare", string_compare_command }, |
|
1256
|
{ "first", string_first_command }, |
|
1257
|
{ "index", string_index_command }, |
|
1258
|
{ "is", string_is_command }, |
|
1259
|
{ "last", string_last_command }, |
|
1260
|
{ "length", string_length_command }, |
|
1261
|
{ "match", string_match_command }, |
|
1262
|
{ "range", string_range_command }, |
|
1263
|
{ "repeat", string_repeat_command }, |
|
1264
|
{ "trim", string_trim_command }, |
|
1265
|
{ "trimleft", string_trim_command }, |
|
1266
|
{ "trimright", string_trim_command }, |
|
1267
|
{ 0, 0 } |
|
1268
|
}; |
|
1269
|
return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); |
|
1270
|
} |
|
1271
|
|
|
1272
|
/* |
|
1273
|
** TH Syntax: |
|
1274
|
** |
|
1275
|
** info commands |
|
1276
|
** info exists VARNAME |
|
1277
|
** info vars |
|
1278
|
*/ |
|
1279
|
static int info_command( |
|
1280
|
Th_Interp *interp, |
|
1281
|
void *ctx, |
|
1282
|
int argc, |
|
1283
|
const char **argv, |
|
1284
|
int *argl |
|
1285
|
){ |
|
1286
|
static const Th_SubCommand aSub[] = { |
|
1287
|
{ "commands", info_commands_command }, |
|
1288
|
{ "exists", info_exists_command }, |
|
1289
|
{ "vars", info_vars_command }, |
|
1290
|
{ 0, 0 } |
|
1291
|
}; |
|
1292
|
return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); |
|
1293
|
} |
|
1294
|
|
|
1295
|
/* |
|
1296
|
** TH Syntax: |
|
1297
|
** |
|
1298
|
** array exists VARNAME |
|
1299
|
** array names VARNAME |
|
1300
|
*/ |
|
1301
|
static int array_command( |
|
1302
|
Th_Interp *interp, |
|
1303
|
void *ctx, |
|
1304
|
int argc, |
|
1305
|
const char **argv, |
|
1306
|
int *argl |
|
1307
|
){ |
|
1308
|
static const Th_SubCommand aSub[] = { |
|
1309
|
{ "exists", array_exists_command }, |
|
1310
|
{ "names", array_names_command }, |
|
1311
|
{ 0, 0 } |
|
1312
|
}; |
|
1313
|
return Th_CallSubCommand(interp, ctx, argc, argv, argl, aSub); |
|
1314
|
} |
|
1315
|
|
|
1316
|
/* |
|
1317
|
** Convert the script level frame specification (used by the commands |
|
1318
|
** [uplevel] and [upvar]) in (zFrame, nFrame) to an integer frame as |
|
1319
|
** used by Th_LinkVar() and Th_Eval(). If successful, write the integer |
|
1320
|
** frame level to *piFrame and return TH_OK. Otherwise, return TH_ERROR |
|
1321
|
** and leave an error message in the interpreter result. |
|
1322
|
*/ |
|
1323
|
static int thToFrame( |
|
1324
|
Th_Interp *interp, |
|
1325
|
const char *zFrame, |
|
1326
|
int nFrame, |
|
1327
|
int *piFrame |
|
1328
|
){ |
|
1329
|
int iFrame; |
|
1330
|
if( th_isdigit(zFrame[0]) ){ |
|
1331
|
int rc = Th_ToInt(interp, zFrame, nFrame, &iFrame); |
|
1332
|
if( rc!=TH_OK ) return rc; |
|
1333
|
iFrame = iFrame * -1; |
|
1334
|
}else if( zFrame[0]=='#' ){ |
|
1335
|
int rc = Th_ToInt(interp, &zFrame[1], nFrame-1, &iFrame); |
|
1336
|
if( rc!=TH_OK ) return rc; |
|
1337
|
iFrame = iFrame + 1; |
|
1338
|
}else{ |
|
1339
|
return TH_ERROR; |
|
1340
|
} |
|
1341
|
*piFrame = iFrame; |
|
1342
|
return TH_OK; |
|
1343
|
} |
|
1344
|
|
|
1345
|
/* |
|
1346
|
** TH Syntax: |
|
1347
|
** |
|
1348
|
** uplevel ?LEVEL? SCRIPT |
|
1349
|
*/ |
|
1350
|
static int uplevel_command( |
|
1351
|
Th_Interp *interp, |
|
1352
|
void *ctx, |
|
1353
|
int argc, |
|
1354
|
const char **argv, |
|
1355
|
int *argl |
|
1356
|
){ |
|
1357
|
int iFrame = -1; |
|
1358
|
|
|
1359
|
if( argc!=2 && argc!=3 ){ |
|
1360
|
return Th_WrongNumArgs(interp, "uplevel ?level? script..."); |
|
1361
|
} |
|
1362
|
if( argc==3 && TH_OK!=thToFrame(interp, argv[1], TH1_LEN(argl[1]), &iFrame) ){ |
|
1363
|
return TH_ERROR; |
|
1364
|
} |
|
1365
|
return Th_Eval(interp, iFrame, argv[argc-1], -1); |
|
1366
|
} |
|
1367
|
|
|
1368
|
/* |
|
1369
|
** TH Syntax: |
|
1370
|
** |
|
1371
|
** upvar ?FRAME? OTHERVAR MYVAR ?OTHERVAR MYVAR ...? |
|
1372
|
*/ |
|
1373
|
static int upvar_command( |
|
1374
|
Th_Interp *interp, |
|
1375
|
void *ctx, |
|
1376
|
int argc, |
|
1377
|
const char **argv, |
|
1378
|
int *argl |
|
1379
|
){ |
|
1380
|
int iVar = 1; |
|
1381
|
int iFrame = -1; |
|
1382
|
int rc = TH_OK; |
|
1383
|
int i; |
|
1384
|
|
|
1385
|
if( TH_OK==thToFrame(0, argv[1], TH1_LEN(argl[1]), &iFrame) ){ |
|
1386
|
iVar++; |
|
1387
|
} |
|
1388
|
if( argc==iVar || (argc-iVar)%2 ){ |
|
1389
|
return Th_WrongNumArgs(interp, |
|
1390
|
"upvar frame othervar myvar ?othervar myvar...?"); |
|
1391
|
} |
|
1392
|
for(i=iVar; rc==TH_OK && i<argc; i=i+2){ |
|
1393
|
rc = Th_LinkVar(interp, argv[i+1], TH1_LEN(argl[i+1]), |
|
1394
|
iFrame, argv[i], TH1_LEN(argl[i])); |
|
1395
|
} |
|
1396
|
return rc; |
|
1397
|
} |
|
1398
|
|
|
1399
|
/* |
|
1400
|
** TH Syntax: |
|
1401
|
** |
|
1402
|
** breakpoint ARGS |
|
1403
|
** |
|
1404
|
** This command does nothing at all. Its purpose in life is to serve |
|
1405
|
** as a point for setting breakpoints in a debugger. |
|
1406
|
*/ |
|
1407
|
static int breakpoint_command( |
|
1408
|
Th_Interp *interp, |
|
1409
|
void *ctx, |
|
1410
|
int argc, |
|
1411
|
const char **argv, |
|
1412
|
int *argl |
|
1413
|
){ |
|
1414
|
static unsigned int cnt = 0; |
|
1415
|
if( (cnt++)==0xffffffff ) printf("too many TH3 breakpoints\n"); |
|
1416
|
return TH_OK; |
|
1417
|
} |
|
1418
|
|
|
1419
|
/* |
|
1420
|
** Register the built-in th1 language commands with interpreter interp. |
|
1421
|
** Usually this is called soon after interpreter creation. |
|
1422
|
*/ |
|
1423
|
int th_register_language(Th_Interp *interp){ |
|
1424
|
/* Array of built-in commands. */ |
|
1425
|
struct _Command { |
|
1426
|
const char *zName; |
|
1427
|
Th_CommandProc xProc; |
|
1428
|
void *pContext; |
|
1429
|
} aCommand[] = { |
|
1430
|
{"array", array_command, 0}, |
|
1431
|
{"catch", catch_command, 0}, |
|
1432
|
{"expr", expr_command, 0}, |
|
1433
|
{"for", for_command, 0}, |
|
1434
|
{"foreach", foreach_command, 0}, |
|
1435
|
{"if", if_command, 0}, |
|
1436
|
{"info", info_command, 0}, |
|
1437
|
{"lappend", lappend_command, 0}, |
|
1438
|
{"lindex", lindex_command, 0}, |
|
1439
|
{"list", list_command, 0}, |
|
1440
|
{"llength", llength_command, 0}, |
|
1441
|
{"lsearch", lsearch_command, 0}, |
|
1442
|
{"proc", proc_command, 0}, |
|
1443
|
{"rename", rename_command, 0}, |
|
1444
|
{"set", set_command, 0}, |
|
1445
|
{"string", string_command, 0}, |
|
1446
|
{"unset", unset_command, 0}, |
|
1447
|
{"uplevel", uplevel_command, 0}, |
|
1448
|
{"upvar", upvar_command, 0}, |
|
1449
|
|
|
1450
|
{"breakpoint", breakpoint_command, 0}, |
|
1451
|
|
|
1452
|
{"return", return_command, 0}, |
|
1453
|
{"break", simple_command, (void *)TH_BREAK}, |
|
1454
|
{"continue", simple_command, (void *)TH_CONTINUE}, |
|
1455
|
{"error", simple_command, (void *)TH_ERROR}, |
|
1456
|
|
|
1457
|
{0, 0, 0} |
|
1458
|
}; |
|
1459
|
size_t i; |
|
1460
|
|
|
1461
|
/* Add the language commands. */ |
|
1462
|
for(i=0; i<(sizeof(aCommand)/sizeof(aCommand[0])); i++){ |
|
1463
|
void *ctx; |
|
1464
|
if ( !aCommand[i].zName || !aCommand[i].xProc ) continue; |
|
1465
|
ctx = aCommand[i].pContext; |
|
1466
|
Th_CreateCommand(interp, aCommand[i].zName, aCommand[i].xProc, ctx, 0); |
|
1467
|
} |
|
1468
|
|
|
1469
|
return TH_OK; |
|
1470
|
} |
|
1471
|
|