recctrl/regxread.c

   1 /*
   2  * Copyright (C) 1994-2001, Index Data
   3  * All rights reserved.
   4  *
   5  * $Log: regxread.c,v $
   6  * Revision 1.36  2001-05-22 21:02:26  adam
   7  * Fixes for Tcl UTF8 character handling.
   8  *
   9  * Revision 1.35  2001/03/29 21:31:31  adam
  10  * Fixed "record begin" for Tcl filter.
  11  *
  12  * Revision 1.34  2000/11/29 14:24:01  adam
  13  * Script configure uses yaz pthreads options. Added locking for
  14  * zebra_register_{lock,unlock}.
  15  *
  16  * Revision 1.33  1999/11/30 13:48:04  adam
  17  * Improved installation. Updated for inclusion of YAZ header files.
  18  *
  19  * Revision 1.32  1999/09/07 07:19:21  adam
  20  * Work on character mapping. Implemented replace rules.
  21  *
  22  * Revision 1.31  1999/07/14 13:05:29  adam
  23  * Tcl filter works with objects when TCL is version 8 or later; filter
  24  * works with strings otherwise (slow).
  25  *
  26  * Revision 1.30  1999/07/14 10:55:28  adam
  27  * Fixed memory leak.
  28  *
  29  * Revision 1.29  1999/07/12 07:27:54  adam
  30  * Improved speed of Tcl processing. Fixed one memory leak.
  31  *
  32  * Revision 1.28  1999/07/06 12:26:04  adam
  33  * Fixed filters so that MS-DOS CR is ignored.
  34  *
  35  * Revision 1.27  1999/06/28 13:25:40  quinn
  36  * Improved diagnostics for Tcl
  37  *
  38  * Revision 1.26  1999/05/26 07:49:14  adam
  39  * C++ compilation.
  40  *
  41  * Revision 1.25  1999/05/25 12:33:32  adam
  42  * Fixed bug in Tcl filter.
  43  *
  44  * Revision 1.24  1999/05/21 11:08:46  adam
  45  * Tcl filter attempts to read <filt>.tflt. Improvements to configure
  46  * script so that it reads uninstalled Tcl source.
  47  *
  48  * Revision 1.23  1999/05/20 12:57:18  adam
  49  * Implemented TCL filter. Updated recctrl system.
  50  *
  51  * Revision 1.22  1998/11/03 16:07:13  adam
  52  * Yet another fix.
  53  *
  54  * Revision 1.21  1998/11/03 15:43:39  adam
  55  * Fixed bug introduced by previous commit.
  56  *
  57  * Revision 1.20  1998/11/03 14:51:28  adam
  58  * Changed code so that it creates as few data1 nodes as possible.
  59  *
  60  * Revision 1.19  1998/11/03 10:22:39  adam
  61  * Fixed memory leak that could occur for when large data1 node were
  62  * concatenated. Data-type data1_nodes may have multiple nodes.
  63  *
  64  * Revision 1.18  1998/10/15 13:11:47  adam
  65  * Added support for option -record for "end element". When specified
  66  * end element will mark end-of-record when at outer-level.
  67  *
  68  * Revision 1.17  1998/07/01 10:13:51  adam
  69  * Minor fix.
  70  *
  71  * Revision 1.16  1998/06/30 15:15:09  adam
  72  * Tags are trimmed: white space removed before- and after the tag.
  73  *
  74  * Revision 1.15  1998/06/30 12:55:45  adam
  75  * Bug fix.
  76  *
  77  * Revision 1.14  1998/03/05 08:41:00  adam
  78  * Implemented rule contexts.
  79  *
  80  * Revision 1.13  1997/12/12 06:33:58  adam
  81  * Fixed bug that showed up when multiple filter where used.
  82  * Made one routine thread-safe.
  83  *
  84  * Revision 1.12  1997/11/18 10:03:24  adam
  85  * Member num_children removed from data1_node.
  86  *
  87  * Revision 1.11  1997/11/06 11:41:01  adam
  88  * Implemented "begin variant" for the sgml.regx filter.
  89  *
  90  * Revision 1.10  1997/10/31 12:36:12  adam
  91  * Minor change that avoids compiler warning.
  92  *
  93  * Revision 1.9  1997/09/29 09:02:49  adam
  94  * Fixed small bug (introduced by previous commit).
  95  *
  96  * Revision 1.8  1997/09/17 12:19:22  adam
  97  * Zebra version corresponds to YAZ version 1.4.
  98  * Changed Zebra server so that it doesn't depend on global common_resource.
  99  *
 100  * Revision 1.7  1997/07/15 16:33:07  adam
 101  * Check for zero length in execData.
 102  *
 103  * Revision 1.6  1997/02/24 10:41:51  adam
 104  * Cleanup of code and commented out the "end element-end-record" code.
 105  *
 106  * Revision 1.5  1997/02/19 16:22:33  adam
 107  * Fixed "end element" to terminate record in outer-most level.
 108  *
 109  * Revision 1.4  1997/02/12 20:42:58  adam
 110  * Changed some log messages.
 111  *
 112  * Revision 1.3  1996/11/08 14:05:33  adam
 113  * Bug fix: data1 node member u.tag.get_bytes weren't initialized.
 114  *
 115  * Revision 1.2  1996/10/29  14:02:09  adam
 116  * Doesn't use the global data1_tabpath (from YAZ). Instead the function
 117  * data1_get_tabpath is used.
 118  *
 119  * Revision 1.1  1996/10/11 10:57:30  adam
 120  * New module recctrl. Used to manage records (extract/retrieval).
 121  *
 122  * Revision 1.24  1996/06/17 14:25:31  adam
 123  * Removed LOG_DEBUG logs; can still be enabled by setting REGX_DEBUG.
 124  *
 125  * Revision 1.23  1996/06/04 10:19:00  adam
 126  * Minor changes - removed include of ctype.h.
 127  *
 128  * Revision 1.22  1996/06/03  15:23:13  adam
 129  * Bug fix: /../ BODY /../ - pattern didn't match EOF.
 130  *
 131  * Revision 1.21  1996/05/14  16:58:38  adam
 132  * Minor change.
 133  *
 134  * Revision 1.20  1996/05/01  13:46:36  adam
 135  * First work on multiple records in one file.
 136  * New option, -offset, to the "unread" command in the filter module.
 137  *
 138  * Revision 1.19  1996/02/12  16:18:20  adam
 139  * Yet another bug fix in implementation of unread command.
 140  *
 141  * Revision 1.18  1996/02/12  16:07:54  adam
 142  * Bug fix in new unread command.
 143  *
 144  * Revision 1.17  1996/02/12  15:56:11  adam
 145  * New code command: unread.
 146  *
 147  * Revision 1.16  1996/01/17  14:57:51  adam
 148  * Prototype changed for reader functions in extract/retrieve. File
 149  *  is identified by 'void *' instead of 'int.
 150  *
 151  * Revision 1.15  1996/01/08  19:15:47  adam
 152  * New input filter that works!
 153  *
 154  * Revision 1.14  1996/01/08  09:10:38  adam
 155  * Yet another complete rework on this module.
 156  *
 157  * Revision 1.13  1995/12/15  17:21:50  adam
 158  * This version is able to set data.formatted_text in data1-nodes.
 159  *
 160  * Revision 1.12  1995/12/15  16:20:10  adam
 161  * The filter files (*.flt) are read from the path given by data1_tabpath.
 162  *
 163  * Revision 1.11  1995/12/15  12:35:16  adam
 164  * Better logging.
 165  *
 166  * Revision 1.10  1995/12/15  10:35:36  adam
 167  * Misc. bug fixes.
 168  *
 169  * Revision 1.9  1995/12/14  16:38:48  adam
 170  * Completely new attempt to make regular expression parsing.
 171  *
 172  * Revision 1.8  1995/12/13  17:16:59  adam
 173  * Small changes.
 174  *
 175  * Revision 1.7  1995/12/13  16:51:58  adam
 176  * Modified to set last_child in data1_nodes.
 177  * Uses destroy handler to free up data text nodes.
 178  *
 179  * Revision 1.6  1995/12/13  13:45:37  quinn
 180  * Changed data1 to use nmem.
 181  *
 182  * Revision 1.5  1995/12/11  09:12:52  adam
 183  * The rec_get function returns NULL if record doesn't exist - will
 184  * happen in the server if the result set records have been deleted since
 185  * the creation of the set (i.e. the search).
 186  * The server saves a result temporarily if it is 'volatile', i.e. the
 187  * set is register dependent.
 188  *
 189  * Revision 1.4  1995/12/05  16:57:40  adam
 190  * More work on regular patterns.
 191  *
 192  * Revision 1.3  1995/12/05  09:37:09  adam
 193  * One malloc was renamed to xmalloc.
 194  *
 195  * Revision 1.2  1995/12/04  17:59:24  adam
 196  * More work on regular expression conversion.
 197  *
 198  * Revision 1.1  1995/12/04  14:25:30  adam
 199  * Started work on regular expression parsed input to structured records.
 200  *
 201  */
 202 #include <stdio.h>
 203 #include <assert.h>
 204 #include <string.h>
 205 #include <ctype.h>
 206
 207 #include <yaz/tpath.h>
 208 #include <zebrautl.h>
 209 #include <dfa.h>
 210 #include "grsread.h"
 211
 212 #if HAVE_TCL_H
 213 #include <tcl.h>
 214
 215 #if MAJOR_VERSION >= 8
 216 #define HAVE_TCL_OBJECTS
 217 #endif
 218 #endif
 219
 220 #define REGX_DEBUG 0
 221
 222 #define F_WIN_EOF 2000000000
 223 #define F_WIN_READ 1
 224
 225 #define REGX_EOF     0
 226 #define REGX_PATTERN 1
 227 #define REGX_BODY    2
 228 #define REGX_BEGIN   3
 229 #define REGX_END     4
 230 #define REGX_CODE    5
 231 #define REGX_CONTEXT 6
 232 #define REGX_INIT    7
 233
 234 struct regxCode {
 235     char *str;
 236 #if HAVE_TCL_OBJECTS
 237     Tcl_Obj *tcl_obj;
 238 #endif
 239 };
 240
 241 struct lexRuleAction {
 242     int which;
 243     union {
 244         struct {
 245             struct DFA *dfa;    /* REGX_PATTERN */
 246             int body;
 247         } pattern;
 248         struct regxCode *code;  /* REGX_CODE */
 249     } u;
 250     struct lexRuleAction *next;
 251 };
 252
 253 struct lexRuleInfo {
 254     int no;
 255     struct lexRuleAction *actionList;
 256 };
 257
 258 struct lexRule {
 259     struct lexRuleInfo info;
 260     struct lexRule *next;
 261 };
 262
 263 struct lexContext {
 264     char *name;
 265     struct DFA *dfa;
 266     struct lexRule *rules;
 267     struct lexRuleInfo **fastRule;
 268     int ruleNo;
 269     int initFlag;
 270
 271     struct lexRuleAction *beginActionList;
 272     struct lexRuleAction *endActionList;
 273     struct lexRuleAction *initActionList;
 274     struct lexContext *next;
 275 };
 276
 277 struct lexConcatBuf {
 278     int max;
 279     char *buf;
 280 };
 281
 282 struct lexSpec {
 283     char *name;
 284     struct lexContext *context;
 285
 286     struct lexContext **context_stack;
 287     int context_stack_size;
 288     int context_stack_top;
 289
 290     int lineNo;
 291     NMEM m;
 292     data1_handle dh;
 293 #if HAVE_TCL_H
 294     Tcl_Interp *tcl_interp;
 295 #endif
 296     void *f_win_fh;
 297     void (*f_win_ef)(void *, off_t);
 298
 299     int f_win_start;      /* first byte of buffer is this file offset */
 300     int f_win_end;        /* last byte of buffer is this offset - 1 */
 301     int f_win_size;       /* size of buffer */
 302     char *f_win_buf;      /* buffer itself */
 303     int (*f_win_rf)(void *, char *, size_t);
 304     off_t (*f_win_sf)(void *, off_t);
 305
 306     struct lexConcatBuf *concatBuf;
 307     int maxLevel;
 308     data1_node **d1_stack;
 309     int d1_level;
 310     int stop_flag;
 311
 312     int *arg_start;
 313     int *arg_end;
 314     int arg_no;
 315     int ptr;
 316 };
 317
 318 struct lexSpecs {
 319     struct lexSpec *spec;
 320 };
 321
 322 static char *f_win_get (struct lexSpec *spec, off_t start_pos, off_t end_pos,
 323                         int *size)
 324 {
 325     int i, r, off = start_pos - spec->f_win_start;
 326
 327     if (off >= 0 && end_pos <= spec->f_win_end)
 328     {
 329         *size = end_pos - start_pos;
 330         return spec->f_win_buf + off;
 331     }
 332     if (off < 0 || start_pos >= spec->f_win_end)
 333     {
 334         (*spec->f_win_sf)(spec->f_win_fh, start_pos);
 335         spec->f_win_start = start_pos;
 336
 337         if (!spec->f_win_buf)
 338             spec->f_win_buf = (char *) xmalloc (spec->f_win_size);
 339         *size = (*spec->f_win_rf)(spec->f_win_fh, spec->f_win_buf,
 340                                   spec->f_win_size);
 341         spec->f_win_end = spec->f_win_start + *size;
 342
 343         if (*size > end_pos - start_pos)
 344             *size = end_pos - start_pos;
 345         return spec->f_win_buf;
 346     }
 347     for (i = 0; i<spec->f_win_end - start_pos; i++)
 348         spec->f_win_buf[i] = spec->f_win_buf[i + off];
 349     r = (*spec->f_win_rf)(spec->f_win_fh,
 350                           spec->f_win_buf + i,
 351                           spec->f_win_size - i);
 352     spec->f_win_start = start_pos;
 353     spec->f_win_end += r;
 354     *size = i + r;
 355     if (*size > end_pos - start_pos)
 356         *size = end_pos - start_pos;
 357     return spec->f_win_buf;
 358 }
 359
 360 static int f_win_advance (struct lexSpec *spec, int *pos)
 361 {
 362     int size;
 363     char *buf;
 364
 365     if (*pos >= spec->f_win_start && *pos < spec->f_win_end)
 366         return spec->f_win_buf[(*pos)++ - spec->f_win_start];
 367     if (*pos == F_WIN_EOF)
 368         return 0;
 369     buf = f_win_get (spec, *pos, *pos+1, &size);
 370     if (size == 1)
 371     {
 372         (*pos)++;
 373         return *buf;
 374     }
 375     *pos = F_WIN_EOF;
 376     return 0;
 377 }
 378
 379 static void regxCodeDel (struct regxCode **pp)
 380 {
 381     struct regxCode *p = *pp;
 382     if (p)
 383     {
 384 #if HAVE_TCL_OBJECTS
 385         if (p->tcl_obj)
 386             Tcl_DecrRefCount (p->tcl_obj);
 387 #endif
 388         xfree (p->str);
 389         xfree (p);
 390         *pp = NULL;
 391     }
 392 }
 393
 394 static void regxCodeMk (struct regxCode **pp, const char *buf, int len)
 395 {
 396     struct regxCode *p;
 397
 398     p = (struct regxCode *) xmalloc (sizeof(*p));
 399     p->str = (char *) xmalloc (len+1);
 400     memcpy (p->str, buf, len);
 401     p->str[len] = '\0';
 402 #if HAVE_TCL_OBJECTS
 403     p->tcl_obj = Tcl_NewStringObj ((char *) buf, len);
 404     if (p->tcl_obj)
 405         Tcl_IncrRefCount (p->tcl_obj);
 406 #endif
 407     *pp = p;
 408 }
 409
 410 static struct DFA *lexSpecDFA (void)
 411 {
 412     struct DFA *dfa;
 413
 414     dfa = dfa_init ();
 415     dfa_parse_cmap_del (dfa, ' ');
 416     dfa_parse_cmap_del (dfa, '\t');
 417     dfa_parse_cmap_add (dfa, '/', 0);
 418     return dfa;
 419 }
 420
 421 static void actionListDel (struct lexRuleAction **rap)
 422 {
 423     struct lexRuleAction *ra1, *ra;
 424
 425     for (ra = *rap; ra; ra = ra1)
 426     {
 427         ra1 = ra->next;
 428         switch (ra->which)
 429         {
 430         case REGX_PATTERN:
 431             dfa_delete (&ra->u.pattern.dfa);
 432             break;
 433         case REGX_CODE:
 434             regxCodeDel (&ra->u.code);
 435             break;
 436         }
 437         xfree (ra);
 438     }
 439     *rap = NULL;
 440 }
 441
 442 static struct lexContext *lexContextCreate (const char *name)
 443 {
 444     struct lexContext *p = (struct lexContext *) xmalloc (sizeof(*p));
 445
 446     p->name = xstrdup (name);
 447     p->ruleNo = 1;
 448     p->initFlag = 0;
 449     p->dfa = lexSpecDFA ();
 450     p->rules = NULL;
 451     p->fastRule = NULL;
 452     p->beginActionList = NULL;
 453     p->endActionList = NULL;
 454     p->initActionList = NULL;
 455     p->next = NULL;
 456     return p;
 457 }
 458
 459 static void lexContextDestroy (struct lexContext *p)
 460 {
 461     struct lexRule *rp, *rp1;
 462
 463     dfa_delete (&p->dfa);
 464     xfree (p->fastRule);
 465     for (rp = p->rules; rp; rp = rp1)
 466     {
 467         rp1 = rp->next;
 468         actionListDel (&rp->info.actionList);
 469         xfree (rp);
 470     }
 471     actionListDel (&p->beginActionList);
 472     actionListDel (&p->endActionList);
 473     actionListDel (&p->initActionList);
 474     xfree (p->name);
 475     xfree (p);
 476 }
 477
 478 static struct lexSpec *lexSpecCreate (const char *name, data1_handle dh)
 479 {
 480     struct lexSpec *p;
 481     int i;
 482
 483     p = (struct lexSpec *) xmalloc (sizeof(*p));
 484     p->name = (char *) xmalloc (strlen(name)+1);
 485     strcpy (p->name, name);
 486
 487 #if HAVE_TCL_H
 488     p->tcl_interp = 0;
 489 #endif
 490     p->dh = dh;
 491     p->context = NULL;
 492     p->context_stack_size = 100;
 493     p->context_stack = (struct lexContext **)
 494         xmalloc (sizeof(*p->context_stack) * p->context_stack_size);
 495     p->f_win_buf = NULL;
 496
 497     p->maxLevel = 128;
 498     p->concatBuf = (struct lexConcatBuf *)
 499         xmalloc (sizeof(*p->concatBuf) * p->maxLevel);
 500     for (i = 0; i < p->maxLevel; i++)
 501     {
 502         p->concatBuf[i].max = 0;
 503         p->concatBuf[i].buf = 0;
 504     }
 505     p->d1_stack = (data1_node **) xmalloc (sizeof(*p->d1_stack) * p->maxLevel);
 506     p->d1_level = 0;
 507     return p;
 508 }
 509
 510 static void lexSpecDestroy (struct lexSpec **pp)
 511 {
 512     struct lexSpec *p;
 513     struct lexContext *lt;
 514     int i;
 515
 516     assert (pp);
 517     p = *pp;
 518     if (!p)
 519         return ;
 520
 521     for (i = 0; i < p->maxLevel; i++)
 522         xfree (p->concatBuf[i].buf);
 523     xfree (p->concatBuf);
 524
 525     lt = p->context;
 526     while (lt)
 527     {
 528         struct lexContext *lt_next = lt->next;
 529         lexContextDestroy (lt);
 530         lt = lt_next;
 531     }
 532 #if HAVE_TCL_OBJECTS
 533     if (p->tcl_interp)
 534         Tcl_DeleteInterp (p->tcl_interp);
 535 #endif
 536     xfree (p->name);
 537     xfree (p->f_win_buf);
 538     xfree (p->context_stack);
 539     xfree (p->d1_stack);
 540     xfree (p);
 541     *pp = NULL;
 542 }
 543
 544 static int readParseToken (const char **cpp, int *len)
 545 {
 546     const char *cp = *cpp;
 547     char cmd[32];
 548     int i, level;
 549
 550     while (*cp == ' ' || *cp == '\t' || *cp == '\n' || *cp == '\r')
 551         cp++;
 552     switch (*cp)
 553     {
 554     case '\0':
 555         return 0;
 556     case '/':
 557         *cpp = cp+1;
 558         return REGX_PATTERN;
 559     case '{':
 560         *cpp = cp+1;
 561         level = 1;
 562         while (*++cp)
 563         {
 564             if (*cp == '{')
 565                 level++;
 566             else if (*cp == '}')
 567             {
 568                 level--;
 569                 if (level == 0)
 570                     break;
 571             }
 572         }
 573         *len = cp - *cpp;
 574         return REGX_CODE;
 575     default:
 576         i = 0;
 577         while (1)
 578         {
 579             if (*cp >= 'a' && *cp <= 'z')
 580                 cmd[i] = *cp;
 581             else if (*cp >= 'A' && *cp <= 'Z')
 582                 cmd[i] = *cp + 'a' - 'A';
 583             else
 584                 break;
 585             if (i < (int) sizeof(cmd)-2)
 586                 i++;
 587             cp++;
 588         }
 589         cmd[i] = '\0';
 590         if (i == 0)
 591         {
 592             logf (LOG_WARN, "bad character %d %c", *cp, *cp);
 593             cp++;
 594             while (*cp && *cp != ' ' && *cp != '\t' &&
 595                    *cp != '\n' && *cp != '\r')
 596                 cp++;
 597             *cpp = cp;
 598             return 0;
 599         }
 600         *cpp = cp;
 601         if (!strcmp (cmd, "begin"))
 602             return REGX_BEGIN;
 603         else if (!strcmp (cmd, "end"))
 604             return REGX_END;
 605         else if (!strcmp (cmd, "body"))
 606             return REGX_BODY;
 607         else if (!strcmp (cmd, "context"))
 608             return REGX_CONTEXT;
 609         else if (!strcmp (cmd, "init"))
 610             return REGX_INIT;
 611         else
 612         {
 613             logf (LOG_WARN, "bad command %s", cmd);
 614             return 0;
 615         }
 616     }
 617 }
 618
 619 static int actionListMk (struct lexSpec *spec, const char *s,
 620                          struct lexRuleAction **ap)
 621 {
 622     int r, tok, len;
 623     int bodyMark = 0;
 624     const char *s0;
 625
 626     while ((tok = readParseToken (&s, &len)))
 627     {
 628         switch (tok)
 629         {
 630         case REGX_BODY:
 631             bodyMark = 1;
 632             continue;
 633         case REGX_CODE:
 634             *ap = (struct lexRuleAction *) xmalloc (sizeof(**ap));
 635             (*ap)->which = tok;
 636             regxCodeMk (&(*ap)->u.code, s, len);
 637             s += len+1;
 638             break;
 639         case REGX_PATTERN:
 640             *ap = (struct lexRuleAction *) xmalloc (sizeof(**ap));
 641             (*ap)->which = tok;
 642             (*ap)->u.pattern.body = bodyMark;
 643             bodyMark = 0;
 644             (*ap)->u.pattern.dfa = lexSpecDFA ();
 645             s0 = s;
 646             r = dfa_parse ((*ap)->u.pattern.dfa, &s);
 647             if (r || *s != '/')
 648             {
 649                 xfree (*ap);
 650                 *ap = NULL;
 651                 logf (LOG_WARN, "regular expression error '%.*s'", s-s0, s0);
 652                 return -1;
 653             }
 654             dfa_mkstate ((*ap)->u.pattern.dfa);
 655             s++;
 656             break;
 657         case REGX_BEGIN:
 658             logf (LOG_WARN, "cannot use BEGIN here");
 659             continue;
 660         case REGX_INIT:
 661             logf (LOG_WARN, "cannot use INIT here");
 662             continue;
 663         case REGX_END:
 664             *ap = (struct lexRuleAction *) xmalloc (sizeof(**ap));
 665             (*ap)->which = tok;
 666             break;
 667         }
 668         ap = &(*ap)->next;
 669     }
 670     *ap = NULL;
 671     return 0;
 672 }
 673
 674 int readOneSpec (struct lexSpec *spec, const char *s)
 675 {
 676     int len, r, tok;
 677     struct lexRule *rp;
 678     struct lexContext *lc;
 679
 680     tok = readParseToken (&s, &len);
 681     if (tok == REGX_CONTEXT)
 682     {
 683         char context_name[32];
 684         tok = readParseToken (&s, &len);
 685         if (tok != REGX_CODE)
 686         {
 687             logf (LOG_WARN, "missing name after CONTEXT keyword");
 688             return 0;
 689         }
 690         if (len > 31)
 691             len = 31;
 692         memcpy (context_name, s, len);
 693         context_name[len] = '\0';
 694         lc = lexContextCreate (context_name);
 695         lc->next = spec->context;
 696         spec->context = lc;
 697         return 0;
 698     }
 699     if (!spec->context)
 700         spec->context = lexContextCreate ("main");
 701
 702     switch (tok)
 703     {
 704     case REGX_BEGIN:
 705         actionListDel (&spec->context->beginActionList);
 706         actionListMk (spec, s, &spec->context->beginActionList);
 707         break;
 708     case REGX_END:
 709         actionListDel (&spec->context->endActionList);
 710         actionListMk (spec, s, &spec->context->endActionList);
 711         break;
 712     case REGX_INIT:
 713         actionListDel (&spec->context->initActionList);
 714         actionListMk (spec, s, &spec->context->initActionList);
 715         break;
 716     case REGX_PATTERN:
 717 #if REGX_DEBUG
 718         logf (LOG_LOG, "rule %d %s", spec->context->ruleNo, s);
 719 #endif
 720         r = dfa_parse (spec->context->dfa, &s);
 721         if (r)
 722         {
 723             logf (LOG_WARN, "regular expression error. r=%d", r);
 724             return -1;
 725         }
 726         if (*s != '/')
 727         {
 728             logf (LOG_WARN, "expects / at end of pattern. got %c", *s);
 729             return -1;
 730         }
 731         s++;
 732         rp = (struct lexRule *) xmalloc (sizeof(*rp));
 733         rp->info.no = spec->context->ruleNo++;
 734         rp->next = spec->context->rules;
 735         spec->context->rules = rp;
 736         actionListMk (spec, s, &rp->info.actionList);
 737     }
 738     return 0;
 739 }
 740
 741 int readFileSpec (struct lexSpec *spec)
 742 {
 743     struct lexContext *lc;
 744     int c, i, errors = 0;
 745     FILE *spec_inf = 0;
 746     WRBUF lineBuf;
 747     char fname[256];
 748
 749 #if HAVE_TCL_H
 750     if (spec->tcl_interp)
 751     {
 752         sprintf (fname, "%s.tflt", spec->name);
 753         spec_inf = yaz_path_fopen (data1_get_tabpath(spec->dh), fname, "r");
 754     }
 755 #endif
 756     if (!spec_inf)
 757     {
 758         sprintf (fname, "%s.flt", spec->name);
 759         spec_inf = yaz_path_fopen (data1_get_tabpath(spec->dh), fname, "r");
 760     }
 761     if (!spec_inf)
 762     {
 763         logf (LOG_ERRNO|LOG_WARN, "cannot read spec file %s", spec->name);
 764         return -1;
 765     }
 766     logf (LOG_LOG, "reading regx filter %s", fname);
 767 #if HAVE_TCL_H
 768     if (spec->tcl_interp)
 769         logf (LOG_LOG, "Tcl enabled");
 770 #endif
 771     lineBuf = wrbuf_alloc();
 772     spec->lineNo = 0;
 773     c = getc (spec_inf);
 774     while (c != EOF)
 775     {
 776         wrbuf_rewind (lineBuf);
 777         if (c == '#' || c == '\n' || c == ' ' || c == '\t' || c == '\r')
 778         {
 779             while (c != '\n' && c != EOF)
 780                 c = getc (spec_inf);
 781             spec->lineNo++;
 782             if (c == '\n')
 783                 c = getc (spec_inf);
 784         }
 785         else
 786         {
 787             int addLine = 0;
 788
 789             while (1)
 790             {
 791                 int c1 = c;
 792                 wrbuf_putc(lineBuf, c);
 793                 c = getc (spec_inf);
 794                 while (c == '\r')
 795                     c = getc (spec_inf);
 796                 if (c == EOF)
 797                     break;
 798                 if (c1 == '\n')
 799                 {
 800                     if (c != ' ' && c != '\t')
 801                         break;
 802                     addLine++;
 803                 }
 804             }
 805             wrbuf_putc(lineBuf, '\0');
 806             readOneSpec (spec, wrbuf_buf(lineBuf));
 807             spec->lineNo += addLine;
 808         }
 809     }
 810     fclose (spec_inf);
 811     wrbuf_free(lineBuf, 1);
 812
 813 #if 0
 814     debug_dfa_trav = 1;
 815     debug_dfa_tran = 1;
 816     debug_dfa_followpos = 1;
 817     dfa_verbose = 1;
 818 #endif
 819     for (lc = spec->context; lc; lc = lc->next)
 820     {
 821         struct lexRule *rp;
 822         lc->fastRule = (struct lexRuleInfo **)
 823             xmalloc (sizeof(*lc->fastRule) * lc->ruleNo);
 824         for (i = 0; i < lc->ruleNo; i++)
 825             lc->fastRule[i] = NULL;
 826         for (rp = lc->rules; rp; rp = rp->next)
 827             lc->fastRule[rp->info.no] = &rp->info;
 828         dfa_mkstate (lc->dfa);
 829     }
 830     if (errors)
 831         return -1;
 832
 833     return 0;
 834 }
 835
 836 #if 0
 837 static struct lexSpec *curLexSpec = NULL;
 838 #endif
 839
 840 static void execData (struct lexSpec *spec,
 841                       const char *ebuf, int elen, int formatted_text)
 842 {
 843     struct data1_node *res, *parent;
 844     int org_len;
 845
 846     if (elen == 0) /* shouldn't happen, but it does! */
 847         return ;
 848 #if REGX_DEBUG
 849     if (elen > 40)
 850         logf (LOG_LOG, "data (%d bytes) %.15s ... %.*s", elen,
 851               ebuf, 15, ebuf + elen-15);
 852     else if (elen > 0)
 853         logf (LOG_LOG, "data (%d bytes) %.*s", elen, elen, ebuf);
 854     else
 855         logf (LOG_LOG, "data (%d bytes)", elen);
 856 #endif
 857
 858     if (spec->d1_level <= 1)
 859         return;
 860
 861     parent = spec->d1_stack[spec->d1_level -1];
 862     assert (parent);
 863
 864     if ((res = spec->d1_stack[spec->d1_level]) && res->which == DATA1N_data)
 865         org_len = res->u.data.len;
 866     else
 867     {
 868         org_len = 0;
 869
 870         res = data1_mk_node (spec->dh, spec->m);
 871         res->parent = parent;
 872         res->which = DATA1N_data;
 873         res->u.data.what = DATA1I_text;
 874         res->u.data.len = 0;
 875         res->u.data.formatted_text = formatted_text;
 876 #if 0
 877         if (elen > DATA1_LOCALDATA)
 878             res->u.data.data = nmem_malloc (spec->m, elen);
 879         else
 880             res->u.data.data = res->lbuf;
 881         memcpy (res->u.data.data, ebuf, elen);
 882 #else
 883         res->u.data.data = 0;
 884 #endif
 885         res->root = parent->root;
 886
 887         parent->last_child = res;
 888         if (spec->d1_stack[spec->d1_level])
 889             spec->d1_stack[spec->d1_level]->next = res;
 890         else
 891             parent->child = res;
 892         spec->d1_stack[spec->d1_level] = res;
 893     }
 894     if (org_len + elen >= spec->concatBuf[spec->d1_level].max)
 895     {
 896         char *old_buf, *new_buf;
 897
 898         spec->concatBuf[spec->d1_level].max = org_len + elen + 256;
 899         new_buf = (char *) xmalloc (spec->concatBuf[spec->d1_level].max);
 900         if ((old_buf = spec->concatBuf[spec->d1_level].buf))
 901         {
 902             memcpy (new_buf, old_buf, org_len);
 903             xfree (old_buf);
 904         }
 905         spec->concatBuf[spec->d1_level].buf = new_buf;
 906     }
 907     memcpy (spec->concatBuf[spec->d1_level].buf + org_len, ebuf, elen);
 908     res->u.data.len += elen;
 909 }
 910
 911 static void execDataP (struct lexSpec *spec,
 912                        const char *ebuf, int elen, int formatted_text)
 913 {
 914     execData (spec, ebuf, elen, formatted_text);
 915 }
 916
 917 static void tagDataRelease (struct lexSpec *spec)
 918 {
 919     data1_node *res;
 920
 921     if ((res = spec->d1_stack[spec->d1_level]) &&
 922         res->which == DATA1N_data &&
 923         res->u.data.what == DATA1I_text)
 924     {
 925         assert (!res->u.data.data);
 926         assert (res->u.data.len > 0);
 927         if (res->u.data.len > DATA1_LOCALDATA)
 928             res->u.data.data = (char *) nmem_malloc (spec->m, res->u.data.len);
 929         else
 930             res->u.data.data = res->lbuf;
 931         memcpy (res->u.data.data, spec->concatBuf[spec->d1_level].buf,
 932                 res->u.data.len);
 933     }
 934 }
 935
 936 static void variantBegin (struct lexSpec *spec,
 937                           const char *class_str, int class_len,
 938                           const char *type_str, int type_len,
 939                           const char *value_str, int value_len)
 940 {
 941     struct data1_node *parent = spec->d1_stack[spec->d1_level -1];
 942     char tclass[DATA1_MAX_SYMBOL], ttype[DATA1_MAX_SYMBOL];
 943     data1_vartype *tp;
 944     int i;
 945     data1_node *res;
 946
 947     if (spec->d1_level == 0)
 948     {
 949         logf (LOG_WARN, "in variant begin. No record type defined");
 950         return ;
 951     }
 952     if (class_len >= DATA1_MAX_SYMBOL)
 953         class_len = DATA1_MAX_SYMBOL-1;
 954     memcpy (tclass, class_str, class_len);
 955     tclass[class_len] = '\0';
 956
 957     if (type_len >= DATA1_MAX_SYMBOL)
 958         type_len = DATA1_MAX_SYMBOL-1;
 959     memcpy (ttype, type_str, type_len);
 960     ttype[type_len] = '\0';
 961
 962 #if REGX_DEBUG
 963     logf (LOG_LOG, "variant begin %s %s (%d)", tclass, ttype,
 964           spec->d1_level);
 965 #endif
 966
 967     if (!(tp =
 968           data1_getvartypebyct(spec->dh, parent->root->u.root.absyn->varset,
 969                                tclass, ttype)))
 970         return;
 971
 972     if (parent->which != DATA1N_variant)
 973     {
 974         res = data1_mk_node (spec->dh, spec->m);
 975         res->parent = parent;
 976         res->which = DATA1N_variant;
 977         res->u.variant.type = 0;
 978         res->u.variant.value = 0;
 979         res->root = parent->root;
 980
 981         parent->last_child = res;
 982         if (spec->d1_stack[spec->d1_level])
 983         {
 984             tagDataRelease (spec);
 985             spec->d1_stack[spec->d1_level]->next = res;
 986         }
 987         else
 988             parent->child = res;
 989         spec->d1_stack[spec->d1_level] = res;
 990         spec->d1_stack[++(spec->d1_level)] = NULL;
 991     }
 992     for (i = spec->d1_level-1; spec->d1_stack[i]->which == DATA1N_variant; i--)
 993         if (spec->d1_stack[i]->u.variant.type == tp)
 994         {
 995             spec->d1_level = i;
 996             break;
 997         }
 998
 999 #if REGX_DEBUG
1000     logf (LOG_LOG, "variant node (%d)", spec->d1_level);
1001 #endif
1002     parent = spec->d1_stack[spec->d1_level-1];
1003     res = data1_mk_node (spec->dh, spec->m);
1004     res->parent = parent;
1005     res->which = DATA1N_variant;
1006     res->root = parent->root;
1007     res->u.variant.type = tp;
1008
1009     if (value_len >= DATA1_LOCALDATA)
1010         value_len =DATA1_LOCALDATA-1;
1011     memcpy (res->lbuf, value_str, value_len);
1012     res->lbuf[value_len] = '\0';
1013
1014     res->u.variant.value = res->lbuf;
1015
1016     parent->last_child = res;
1017     if (spec->d1_stack[spec->d1_level])
1018     {
1019         tagDataRelease (spec);
1020         spec->d1_stack[spec->d1_level]->next = res;
1021     }
1022     else
1023         parent->child = res;
1024     spec->d1_stack[spec->d1_level] = res;
1025     spec->d1_stack[++(spec->d1_level)] = NULL;
1026 }
1027
1028 static void tagStrip (const char **tag, int *len)
1029 {
1030     int i;
1031
1032     for (i = *len; i > 0 && isspace((*tag)[i-1]); --i)
1033         ;
1034     *len = i;
1035     for (i = 0; i < *len && isspace((*tag)[i]); i++)
1036         ;
1037     *tag += i;
1038     *len -= i;
1039 }
1040
1041 static void tagBegin (struct lexSpec *spec,
1042                       const char *tag, int len)
1043 {
1044     struct data1_node *parent;
1045     data1_element *elem = NULL;
1046     data1_node *partag;
1047     data1_node *res;
1048     data1_element *e = NULL;
1049     int localtag = 0;
1050
1051     if (spec->d1_level == 0)
1052     {
1053         logf (LOG_WARN, "in element begin. No record type defined");
1054         return ;
1055     }
1056     tagStrip (&tag, &len);
1057
1058     parent = spec->d1_stack[spec->d1_level -1];
1059     partag = get_parent_tag(spec->dh, parent);
1060
1061     res = data1_mk_node_type (spec->dh, spec->m, DATA1N_tag);
1062     res->parent = parent;
1063
1064     if (len >= DATA1_LOCALDATA)
1065         res->u.tag.tag = (char *) nmem_malloc (spec->m, len+1);
1066     else
1067         res->u.tag.tag = res->lbuf;
1068
1069     memcpy (res->u.tag.tag, tag, len);
1070     res->u.tag.tag[len] = '\0';
1071
1072 #if REGX_DEBUG
1073     logf (LOG_LOG, "begin tag %s (%d)", res->u.tag.tag, spec->d1_level);
1074 #endif
1075     if (parent->which == DATA1N_variant)
1076         return ;
1077     if (partag)
1078         if (!(e = partag->u.tag.element))
1079             localtag = 1;
1080
1081     elem = data1_getelementbytagname (spec->dh,
1082                                       spec->d1_stack[0]->u.root.absyn,
1083                                       e, res->u.tag.tag);
1084     res->u.tag.element = elem;
1085     res->root = parent->root;
1086
1087     parent->last_child = res;
1088     if (spec->d1_stack[spec->d1_level])
1089     {
1090         tagDataRelease (spec);
1091         spec->d1_stack[spec->d1_level]->next = res;
1092     }
1093     else
1094         parent->child = res;
1095     spec->d1_stack[spec->d1_level] = res;
1096     spec->d1_stack[++(spec->d1_level)] = NULL;
1097 }
1098
1099 static void tagEnd (struct lexSpec *spec, int min_level,
1100                     const char *tag, int len)
1101 {
1102     tagStrip (&tag, &len);
1103     while (spec->d1_level > min_level)
1104     {
1105         tagDataRelease (spec);
1106         (spec->d1_level)--;
1107         if (spec->d1_level == 0)
1108             break;
1109         if ((spec->d1_stack[spec->d1_level]->which == DATA1N_tag) &&
1110             (!tag ||
1111              (strlen(spec->d1_stack[spec->d1_level]->u.tag.tag) ==
1112               (size_t) len &&
1113               !memcmp (spec->d1_stack[spec->d1_level]->u.tag.tag, tag, len))))
1114             break;
1115     }
1116 #if REGX_DEBUG
1117     logf (LOG_LOG, "end tag (%d)", spec->d1_level);
1118 #endif
1119 }
1120
1121
1122 static int tryMatch (struct lexSpec *spec, int *pptr, int *mptr,
1123                      struct DFA *dfa)
1124 {
1125     struct DFA_state *state = dfa->states[0];
1126     struct DFA_tran *t;
1127     unsigned char c;
1128     unsigned char c_prev = 0;
1129     int ptr = *pptr;          /* current pointer */
1130     int start_ptr = *pptr;    /* first char of match */
1131     int last_ptr = 0;         /* last char of match */
1132     int last_rule = 0;        /* rule number of current match */
1133     int i;
1134
1135     while (1)
1136     {
1137         c = f_win_advance (spec, &ptr);
1138         if (ptr == F_WIN_EOF)
1139         {
1140             if (last_rule)
1141             {
1142                 *mptr = start_ptr;
1143                 *pptr = last_ptr;
1144                 return 1;
1145             }
1146             break;
1147         }
1148         t = state->trans;
1149         i = state->tran_no;
1150         while (1)
1151             if (--i < 0)
1152             {
1153                 if (last_rule)
1154                 {
1155                     *mptr = start_ptr;     /* match starts here */
1156                     *pptr = last_ptr;      /* match end here (+1) */
1157                     return 1;
1158                 }
1159                 state = dfa->states[0];
1160                 start_ptr = ptr;
1161                 c_prev = c;
1162                 break;
1163             }
1164             else if (c >= t->ch[0] && c <= t->ch[1])
1165             {
1166                 state = dfa->states[t->to];
1167                 if (state->rule_no)
1168                 {
1169                     if (c_prev == '\n')
1170                     {
1171                         last_rule = state->rule_no;
1172                         last_ptr = ptr;
1173                     }
1174                     else
1175                     {
1176                         last_rule = state->rule_nno;
1177                         last_ptr = ptr;
1178                     }
1179                 }
1180                 break;
1181             }
1182             else
1183                 t++;
1184     }
1185     return 0;
1186 }
1187
1188 static int execTok (struct lexSpec *spec, const char **src,
1189                     const char **tokBuf, int *tokLen)
1190 {
1191     const char *s = *src;
1192
1193     while (*s == ' ' || *s == '\t')
1194         s++;
1195     if (!*s)
1196         return 0;
1197     if (*s == '$' && s[1] >= '0' && s[1] <= '9')
1198     {
1199         int n = 0;
1200         s++;
1201         while (*s >= '0' && *s <= '9')
1202             n = n*10 + (*s++ -'0');
1203         if (spec->arg_no == 0)
1204         {
1205             *tokBuf = "";
1206             *tokLen = 0;
1207         }
1208         else
1209         {
1210             if (n >= spec->arg_no)
1211                 n = spec->arg_no-1;
1212             *tokBuf = f_win_get (spec, spec->arg_start[n], spec->arg_end[n],
1213                                  tokLen);
1214         }
1215     }
1216     else if (*s == '\"')
1217     {
1218         *tokBuf = ++s;
1219         while (*s && *s != '\"')
1220             s++;
1221         *tokLen = s - *tokBuf;
1222         if (*s)
1223             s++;
1224         *src = s;
1225     }
1226     else if (*s == '\n' || *s == ';')
1227     {
1228         *src = s+1;
1229         return 1;
1230     }
1231     else if (*s == '-')
1232     {
1233         *tokBuf = s++;
1234         while (*s && *s != ' ' && *s != '\t' && *s != '\n' && *s != '\r' &&
1235                *s != ';')
1236             s++;
1237         *tokLen = s - *tokBuf;
1238         *src = s;
1239         return 3;
1240     }
1241     else
1242     {
1243         *tokBuf = s++;
1244         while (*s && *s != ' ' && *s != '\t' && *s != '\n' && *s != '\r' &&
1245                *s != ';')
1246             s++;
1247         *tokLen = s - *tokBuf;
1248     }
1249     *src = s;
1250     return 2;
1251 }
1252
1253 static char *regxStrz (const char *src, int len, char *str)
1254 {
1255     if (len > 63)
1256         len = 63;
1257     memcpy (str, src, len);
1258     str[len] = '\0';
1259     return str;
1260 }
1261
1262 #if HAVE_TCL_H
1263 static int cmd_tcl_begin (ClientData clientData, Tcl_Interp *interp,
1264                           int argc, char **argv)
1265 {
1266     struct lexSpec *spec = (struct lexSpec *) clientData;
1267     if (argc < 2)
1268         return TCL_ERROR;
1269     if (!strcmp(argv[1], "record") && argc == 3)
1270     {
1271         char *absynName = argv[2];
1272         data1_absyn *absyn;
1273
1274 #if REGX_DEBUG
1275         logf (LOG_LOG, "begin record %s", absynName);
1276 #endif
1277         if (!(absyn = data1_get_absyn (spec->dh, absynName)))
1278             logf (LOG_WARN, "Unknown tagset: %s", absynName);
1279         else
1280         {
1281             data1_node *res;
1282
1283             res = data1_mk_node (spec->dh, spec->m);
1284             res->which = DATA1N_root;
1285             res->u.root.type =
1286                 data1_insert_string(spec->dh, res, spec->m, absynName);
1287             res->u.root.absyn = absyn;
1288             res->root = res;
1289
1290             spec->d1_stack[spec->d1_level] = res;
1291             spec->d1_stack[++(spec->d1_level)] = NULL;
1292         }
1293     }
1294     else if (!strcmp(argv[1], "element") && argc == 3)
1295     {
1296         tagBegin (spec, argv[2], strlen(argv[2]));
1297     }
1298     else if (!strcmp (argv[1], "variant") && argc == 5)
1299     {
1300         variantBegin (spec, argv[2], strlen(argv[2]),
1301                       argv[3], strlen(argv[3]),
1302                       argv[4], strlen(argv[4]));
1303     }
1304     else if (!strcmp (argv[1], "context") && argc == 3)
1305     {
1306         struct lexContext *lc = spec->context;
1307 #if REGX_DEBUG
1308         logf (LOG_LOG, "begin context %s",argv[2]);
1309 #endif
1310         while (lc && strcmp (argv[2], lc->name))
1311             lc = lc->next;
1312         if (lc)
1313         {
1314             spec->context_stack[++(spec->context_stack_top)] = lc;
1315         }
1316         else
1317             logf (LOG_WARN, "unknown context %s", argv[2]);
1318     }
1319     else
1320         return TCL_ERROR;
1321     return TCL_OK;
1322 }
1323
1324 static int cmd_tcl_end (ClientData clientData, Tcl_Interp *interp,
1325                         int argc, char **argv)
1326 {
1327     struct lexSpec *spec = (struct lexSpec *) clientData;
1328     if (argc < 2)
1329         return TCL_ERROR;
1330
1331     if (!strcmp (argv[1], "record"))
1332     {
1333         while (spec->d1_level)
1334         {
1335             tagDataRelease (spec);
1336             (spec->d1_level)--;
1337         }
1338 #if REGX_DEBUG
1339         logf (LOG_LOG, "end record");
1340 #endif
1341         spec->stop_flag = 1;
1342     }
1343     else if (!strcmp (argv[1], "element"))
1344     {
1345         int min_level = 1;
1346         char *element = 0;
1347         if (argc >= 3 && !strcmp(argv[2], "-record"))
1348         {
1349             min_level = 0;
1350             if (argc == 4)
1351                 element = argv[3];
1352         }
1353         else
1354             if (argc == 3)
1355                 element = argv[2];
1356         tagEnd (spec, min_level, element, (element ? strlen(element) : 0));
1357         if (spec->d1_level == 0)
1358         {
1359 #if REGX_DEBUG
1360             logf (LOG_LOG, "end element end records");
1361 #endif
1362             spec->stop_flag = 1;
1363         }
1364     }
1365     else if (!strcmp (argv[1], "context"))
1366     {
1367 #if REGX_DEBUG
1368         logf (LOG_LOG, "end context");
1369 #endif
1370         if (spec->context_stack_top)
1371             (spec->context_stack_top)--;
1372     }
1373     else
1374         return TCL_ERROR;
1375     return TCL_OK;
1376 }
1377
1378 static int cmd_tcl_data (ClientData clientData, Tcl_Interp *interp,
1379                          int argc, char **argv)
1380 {
1381     int argi = 1;
1382     int textFlag = 0;
1383     const char *element = 0;
1384     struct lexSpec *spec = (struct lexSpec *) clientData;
1385
1386     while (argi < argc)
1387     {
1388         if (!strcmp("-text", argv[argi]))
1389         {
1390             textFlag = 1;
1391             argi++;
1392         }
1393         else if (!strcmp("-element", argv[argi]))
1394         {
1395             argi++;
1396             if (argi < argc)
1397                 element = argv[argi++];
1398         }
1399         else
1400             break;
1401     }
1402     if (element)
1403         tagBegin (spec, element, strlen(element));
1404
1405     while (argi < argc)
1406     {
1407 #if TCL_MAJOR_VERSION > 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 0)
1408         Tcl_DString ds;
1409         char *native = Tcl_UtfToExternalDString(0, argv[argi], -1, &ds);
1410         execData (spec, native, strlen(native), textFlag);
1411         Tcl_DStringFree (&ds);
1412 #else
1413         execData (spec, argv[argi], strlen(argv[argi]), textFlag);
1414 #endif
1415         argi++;
1416     }
1417     if (element)
1418         tagEnd (spec, 1, NULL, 0);
1419     return TCL_OK;
1420 }
1421
1422 static int cmd_tcl_unread (ClientData clientData, Tcl_Interp *interp,
1423                            int argc, char **argv)
1424 {
1425     struct lexSpec *spec = (struct lexSpec *) clientData;
1426     int argi = 1;
1427     int offset = 0;
1428     int no;
1429
1430     while (argi < argc)
1431     {
1432         if (!strcmp("-offset", argv[argi]))
1433         {
1434             argi++;
1435             if (argi < argc)
1436             {
1437                 offset = atoi(argv[argi]);
1438                 argi++;
1439             }
1440         }
1441         else
1442             break;
1443     }
1444     if (argi != argc-1)
1445         return TCL_ERROR;
1446     no = atoi(argv[argi]);
1447     if (no >= spec->arg_no)
1448         no = spec->arg_no - 1;
1449     spec->ptr = spec->arg_start[no] + offset;
1450     return TCL_OK;
1451 }
1452
1453 static void execTcl (struct lexSpec *spec, struct regxCode *code)
1454 {
1455     int i;
1456     int ret;
1457     for (i = 0; i < spec->arg_no; i++)
1458     {
1459         char var_name[10], *var_buf;
1460         int var_len, ch;
1461
1462         sprintf (var_name, "%d", i);
1463         var_buf = f_win_get (spec, spec->arg_start[i], spec->arg_end[i],
1464                              &var_len);
1465         if (var_buf)
1466         {
1467             ch = var_buf[var_len];
1468             var_buf[var_len] = '\0';
1469             Tcl_SetVar (spec->tcl_interp, var_name, var_buf, 0);
1470             var_buf[var_len] = ch;
1471         }
1472     }
1473 #if HAVE_TCL_OBJECTS
1474     ret = Tcl_GlobalEvalObj(spec->tcl_interp, code->tcl_obj);
1475 #else
1476     ret = Tcl_GlobalEval (spec->tcl_interp, code->str);
1477 #endif
1478     if (ret != TCL_OK)
1479     {
1480         const char *err = Tcl_GetVar(spec->tcl_interp, "errorInfo", 0);
1481         logf(LOG_FATAL, "Tcl error, line=%d, \"%s\"\n%s",
1482             spec->tcl_interp->errorLine,
1483             spec->tcl_interp->result,
1484             err ? err : "[NO ERRORINFO]");
1485     }
1486 }
1487 /* HAVE_TCL_H */
1488 #endif
1489
1490 static void execCode (struct lexSpec *spec, struct regxCode *code)
1491 {
1492     const char *s = code->str;
1493     int cmd_len, r;
1494     const char *cmd_str;
1495
1496     r = execTok (spec, &s, &cmd_str, &cmd_len);
1497     while (r)
1498     {
1499         char *p, ptmp[64];
1500
1501         if (r == 1)
1502         {
1503             r = execTok (spec, &s, &cmd_str, &cmd_len);
1504             continue;
1505         }
1506         p = regxStrz (cmd_str, cmd_len, ptmp);
1507         if (!strcmp (p, "begin"))
1508         {
1509             r = execTok (spec, &s, &cmd_str, &cmd_len);
1510             if (r < 2)
1511             {
1512                 logf (LOG_WARN, "missing keyword after 'begin'");
1513                 continue;
1514             }
1515             p = regxStrz (cmd_str, cmd_len, ptmp);
1516             if (!strcmp (p, "record"))
1517             {
1518                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1519                 if (r < 2)
1520                     continue;
1521                 if (spec->d1_level == 0)
1522                 {
1523                     static char absynName[64];
1524                     data1_absyn *absyn;
1525
1526                     if (cmd_len > 63)
1527                         cmd_len = 63;
1528                     memcpy (absynName, cmd_str, cmd_len);
1529                     absynName[cmd_len] = '\0';
1530
1531 #if REGX_DEBUG
1532                     logf (LOG_LOG, "begin record %s", absynName);
1533 #endif
1534                     if (!(absyn = data1_get_absyn (spec->dh, absynName)))
1535                         logf (LOG_WARN, "Unknown tagset: %s", absynName);
1536                     else
1537                     {
1538                         data1_node *res;
1539
1540                         res = data1_mk_node (spec->dh, spec->m);
1541                         res->which = DATA1N_root;
1542                         res->u.root.type = absynName;
1543                         res->u.root.absyn = absyn;
1544                         res->root = res;
1545
1546                         spec->d1_stack[spec->d1_level] = res;
1547                         spec->d1_stack[++(spec->d1_level)] = NULL;
1548                     }
1549                 }
1550                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1551             }
1552             else if (!strcmp (p, "element"))
1553             {
1554                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1555                 if (r < 2)
1556                     continue;
1557                 tagBegin (spec, cmd_str, cmd_len);
1558                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1559             }
1560             else if (!strcmp (p, "variant"))
1561             {
1562                 int class_len;
1563                 const char *class_str = NULL;
1564                 int type_len;
1565                 const char *type_str = NULL;
1566                 int value_len;
1567                 const char *value_str = NULL;
1568                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1569                 if (r < 2)
1570                     continue;
1571                 class_str = cmd_str;
1572                 class_len = cmd_len;
1573                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1574                 if (r < 2)
1575                     continue;
1576                 type_str = cmd_str;
1577                 type_len = cmd_len;
1578
1579                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1580                 if (r < 2)
1581                     continue;
1582                 value_str = cmd_str;
1583                 value_len = cmd_len;
1584
1585                 variantBegin (spec, class_str, class_len,
1586                               type_str, type_len, value_str, value_len);
1587
1588
1589                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1590             }
1591             else if (!strcmp (p, "context"))
1592             {
1593                 if (r > 1)
1594                 {
1595                     struct lexContext *lc = spec->context;
1596                     r = execTok (spec, &s, &cmd_str, &cmd_len);
1597                     p = regxStrz (cmd_str, cmd_len, ptmp);
1598 #if REGX_DEBUG
1599                     logf (LOG_LOG, "begin context %s", p);
1600 #endif
1601                     while (lc && strcmp (p, lc->name))
1602                         lc = lc->next;
1603                     if (lc)
1604                         spec->context_stack[++(spec->context_stack_top)] = lc;
1605                     else
1606                         logf (LOG_WARN, "unknown context %s", p);
1607
1608                 }
1609                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1610             }
1611             else
1612             {
1613                 logf (LOG_WARN, "bad keyword '%s' after begin", p);
1614             }
1615         }
1616         else if (!strcmp (p, "end"))
1617         {
1618             r = execTok (spec, &s, &cmd_str, &cmd_len);
1619             if (r < 2)
1620             {
1621                 logf (LOG_WARN, "missing keyword after 'end'");
1622                 continue;
1623             }
1624             p = regxStrz (cmd_str, cmd_len, ptmp);
1625             if (!strcmp (p, "record"))
1626             {
1627                 while (spec->d1_level)
1628                 {
1629                     tagDataRelease (spec);
1630                     (spec->d1_level)--;
1631                 }
1632                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1633 #if REGX_DEBUG
1634                 logf (LOG_LOG, "end record");
1635 #endif
1636                 spec->stop_flag = 1;
1637             }
1638             else if (!strcmp (p, "element"))
1639             {
1640                 int min_level = 1;
1641                 while ((r = execTok (spec, &s, &cmd_str, &cmd_len)) == 3)
1642                 {
1643                     if (cmd_len==7 && !memcmp ("-record", cmd_str, cmd_len))
1644                         min_level = 0;
1645                 }
1646                 if (r > 2)
1647                 {
1648                     tagEnd (spec, min_level, cmd_str, cmd_len);
1649                     r = execTok (spec, &s, &cmd_str, &cmd_len);
1650                 }
1651                 else
1652                     tagEnd (spec, min_level, NULL, 0);
1653                 if (spec->d1_level == 0)
1654                 {
1655 #if REGX_DEBUG
1656                     logf (LOG_LOG, "end element end records");
1657 #endif
1658                     spec->stop_flag = 1;
1659                 }
1660
1661             }
1662             else if (!strcmp (p, "context"))
1663             {
1664 #if REGX_DEBUG
1665                 logf (LOG_LOG, "end context");
1666 #endif
1667                 if (spec->context_stack_top)
1668                     (spec->context_stack_top)--;
1669                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1670             }
1671             else
1672                 logf (LOG_WARN, "bad keyword '%s' after end", p);
1673         }
1674         else if (!strcmp (p, "data"))
1675         {
1676             int textFlag = 0;
1677             int element_len;
1678             const char *element_str = NULL;
1679
1680             while ((r = execTok (spec, &s, &cmd_str, &cmd_len)) == 3)
1681             {
1682                 if (cmd_len==5 && !memcmp ("-text", cmd_str, cmd_len))
1683                     textFlag = 1;
1684                 else if (cmd_len==8 && !memcmp ("-element", cmd_str, cmd_len))
1685                 {
1686                     r = execTok (spec, &s, &element_str, &element_len);
1687                     if (r < 2)
1688                         break;
1689                 }
1690                 else
1691                     logf (LOG_WARN, "bad data option: %.*s",
1692                           cmd_len, cmd_str);
1693             }
1694             if (r != 2)
1695             {
1696                 logf (LOG_WARN, "missing data item after data");
1697                 continue;
1698             }
1699             if (element_str)
1700                 tagBegin (spec, element_str, element_len);
1701             do
1702             {
1703                 execData (spec, cmd_str, cmd_len,textFlag);
1704                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1705             } while (r > 1);
1706             if (element_str)
1707                 tagEnd (spec, 1, NULL, 0);
1708         }
1709         else if (!strcmp (p, "unread"))
1710         {
1711             int no, offset;
1712             r = execTok (spec, &s, &cmd_str, &cmd_len);
1713             if (r==3 && cmd_len == 7 && !memcmp ("-offset", cmd_str, cmd_len))
1714             {
1715                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1716                 if (r < 2)
1717                 {
1718                     logf (LOG_WARN, "missing number after -offset");
1719                     continue;
1720                 }
1721                 p = regxStrz (cmd_str, cmd_len, ptmp);
1722                 offset = atoi (p);
1723                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1724             }
1725             else
1726                 offset = 0;
1727             if (r < 2)
1728             {
1729                 logf (LOG_WARN, "missing index after unread command");
1730                 continue;
1731             }
1732             if (cmd_len != 1 || *cmd_str < '0' || *cmd_str > '9')
1733             {
1734                 logf (LOG_WARN, "bad index after unread command");
1735                 continue;
1736             }
1737             else
1738             {
1739                 no = *cmd_str - '0';
1740                 if (no >= spec->arg_no)
1741                     no = spec->arg_no - 1;
1742                 spec->ptr = spec->arg_start[no] + offset;
1743             }
1744             r = execTok (spec, &s, &cmd_str, &cmd_len);
1745         }
1746         else if (!strcmp (p, "context"))
1747         {
1748             if (r > 1)
1749             {
1750                 struct lexContext *lc = spec->context;
1751                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1752                 p = regxStrz (cmd_str, cmd_len, ptmp);
1753
1754                 while (lc && strcmp (p, lc->name))
1755                     lc = lc->next;
1756                 if (lc)
1757                     spec->context_stack[spec->context_stack_top] = lc;
1758                 else
1759                     logf (LOG_WARN, "unknown context %s", p);
1760
1761             }
1762             r = execTok (spec, &s, &cmd_str, &cmd_len);
1763         }
1764         else
1765         {
1766             logf (LOG_WARN, "unknown code command '%.*s'", cmd_len, cmd_str);
1767             r = execTok (spec, &s, &cmd_str, &cmd_len);
1768             continue;
1769         }
1770         if (r > 1)
1771         {
1772             logf (LOG_WARN, "ignoring token %.*s", cmd_len, cmd_str);
1773             do {
1774                 r = execTok (spec, &s, &cmd_str, &cmd_len);
1775             } while (r > 1);
1776         }
1777     }
1778 }
1779
1780
1781 static int execAction (struct lexSpec *spec, struct lexRuleAction *ap,
1782                        int start_ptr, int *pptr)
1783 {
1784     int sptr;
1785     int arg_start[20];
1786     int arg_end[20];
1787     int arg_no = 1;
1788
1789     if (!ap)
1790         return 1;
1791     arg_start[0] = start_ptr;
1792     arg_end[0] = *pptr;
1793     spec->arg_start = arg_start;
1794     spec->arg_end = arg_end;
1795
1796     while (ap)
1797     {
1798         switch (ap->which)
1799         {
1800         case REGX_PATTERN:
1801             if (ap->u.pattern.body)
1802             {
1803                 arg_start[arg_no] = *pptr;
1804                 if (!tryMatch (spec, pptr, &sptr, ap->u.pattern.dfa))
1805                 {
1806                     arg_end[arg_no] = F_WIN_EOF;
1807                     arg_no++;
1808                     arg_start[arg_no] = F_WIN_EOF;
1809                     arg_end[arg_no] = F_WIN_EOF;
1810 /* return 1*/
1811                 }
1812                 else
1813                 {
1814                     arg_end[arg_no] = sptr;
1815                     arg_no++;
1816                     arg_start[arg_no] = sptr;
1817                     arg_end[arg_no] = *pptr;
1818                 }
1819             }
1820             else
1821             {
1822                 arg_start[arg_no] = *pptr;
1823                 if (!tryMatch (spec, pptr, &sptr, ap->u.pattern.dfa))
1824                     return 1;
1825                 if (sptr != arg_start[arg_no])
1826                     return 1;
1827                 arg_end[arg_no] = *pptr;
1828             }
1829             arg_no++;
1830             break;
1831         case REGX_CODE:
1832             spec->arg_no = arg_no;
1833             spec->ptr = *pptr;
1834 #if HAVE_TCL_H
1835             if (spec->tcl_interp)
1836                 execTcl(spec, ap->u.code);
1837             else
1838                 execCode (spec, ap->u.code);
1839 #else
1840             execCode (spec, ap->u.code);
1841 #endif
1842             *pptr = spec->ptr;
1843             if (spec->stop_flag)
1844                 return 0;
1845             break;
1846         case REGX_END:
1847             arg_start[arg_no] = *pptr;
1848             arg_end[arg_no] = F_WIN_EOF;
1849             arg_no++;
1850             *pptr = F_WIN_EOF;
1851         }
1852         ap = ap->next;
1853     }
1854     return 1;
1855 }
1856
1857 static int execRule (struct lexSpec *spec, struct lexContext *context,
1858                      int ruleNo, int start_ptr, int *pptr)
1859 {
1860 #if REGX_DEBUG
1861     logf (LOG_LOG, "exec rule %d", ruleNo);
1862 #endif
1863     return execAction (spec, context->fastRule[ruleNo]->actionList,
1864                        start_ptr, pptr);
1865 }
1866
1867 data1_node *lexNode (struct lexSpec *spec, int *ptr)
1868 {
1869     struct lexContext *context = spec->context_stack[spec->context_stack_top];
1870     struct DFA_state *state = context->dfa->states[0];
1871     struct DFA_tran *t;
1872     unsigned char c;
1873     unsigned char c_prev = '\n';
1874     int i;
1875     int last_rule = 0;        /* rule number of current match */
1876     int last_ptr = *ptr;      /* last char of match */
1877     int start_ptr = *ptr;     /* first char of match */
1878     int skip_ptr = *ptr;      /* first char of run */
1879
1880     while (1)
1881     {
1882         c = f_win_advance (spec, ptr);
1883         if (*ptr == F_WIN_EOF)
1884         {
1885             /* end of file met */
1886             if (last_rule)
1887             {
1888                 /* there was a match */
1889                 if (skip_ptr < start_ptr)
1890                 {
1891                     /* deal with chars that didn't match */
1892                     int size;
1893                     char *buf;
1894                     buf = f_win_get (spec, skip_ptr, start_ptr, &size);
1895                     execDataP (spec, buf, size, 0);
1896                 }
1897                 /* restore pointer */
1898                 *ptr = last_ptr;
1899                 /* execute rule */
1900                 if (!execRule (spec, context, last_rule, start_ptr, ptr))
1901                     break;
1902                 /* restore skip pointer */
1903                 skip_ptr = *ptr;
1904                 last_rule = 0;
1905             }
1906             else if (skip_ptr < *ptr)
1907             {
1908                 /* deal with chars that didn't match */
1909                 int size;
1910                 char *buf;
1911                 buf = f_win_get (spec, skip_ptr, *ptr, &size);
1912                 execDataP (spec, buf, size, 0);
1913             }
1914             if (*ptr == F_WIN_EOF)
1915                 break;
1916         }
1917         t = state->trans;
1918         i = state->tran_no;
1919         while (1)
1920             if (--i < 0)
1921             {   /* no transition for character c ... */
1922                 if (last_rule)
1923                 {
1924                     if (skip_ptr < start_ptr)
1925                     {
1926                         /* deal with chars that didn't match */
1927                         int size;
1928                         char *buf;
1929                         buf = f_win_get (spec, skip_ptr, start_ptr, &size);
1930                         execDataP (spec, buf, size, 0);
1931                     }
1932                     /* restore pointer */
1933                     *ptr = last_ptr;
1934                     if (!execRule (spec, context, last_rule, start_ptr, ptr))
1935                     {
1936                         if (spec->f_win_ef && *ptr != F_WIN_EOF)
1937                         {
1938 #if REGX_DEBUG
1939                             logf (LOG_LOG, "regx: endf ptr=%d", *ptr);
1940 #endif
1941                             (*spec->f_win_ef)(spec->f_win_fh, *ptr);
1942                         }
1943                         return NULL;
1944                     }
1945                     context = spec->context_stack[spec->context_stack_top];
1946                     skip_ptr = *ptr;
1947                     last_rule = 0;
1948                     last_ptr = start_ptr = *ptr;
1949                     if (start_ptr > 0)
1950                     {
1951                         --start_ptr;
1952                         c_prev = f_win_advance (spec, &start_ptr);
1953                     }
1954                 }
1955                 else
1956                 {
1957                     c_prev = f_win_advance (spec, &start_ptr);
1958                     *ptr = start_ptr;
1959                 }
1960                 state = context->dfa->states[0];
1961                 break;
1962             }
1963             else if (c >= t->ch[0] && c <= t->ch[1])
1964             {   /* transition ... */
1965                 state = context->dfa->states[t->to];
1966                 if (state->rule_no)
1967                 {
1968                     if (c_prev == '\n')
1969                     {
1970                         last_rule = state->rule_no;
1971                         last_ptr = *ptr;
1972                     }
1973                     else if (state->rule_nno)
1974                     {
1975                         last_rule = state->rule_nno;
1976                         last_ptr = *ptr;
1977                     }
1978                 }
1979                 break;
1980             }
1981             else
1982                 t++;
1983     }
1984     return NULL;
1985 }
1986
1987 static data1_node *lexRoot (struct lexSpec *spec, off_t offset,
1988                             const char *context_name)
1989 {
1990     struct lexContext *lt = spec->context;
1991     int ptr = offset;
1992
1993     spec->stop_flag = 0;
1994     spec->d1_level = 0;
1995     spec->context_stack_top = 0;
1996     while (lt)
1997     {
1998         if (!strcmp (lt->name, context_name))
1999             break;
2000         lt = lt->next;
2001     }
2002     if (!lt)
2003     {
2004         logf (LOG_WARN, "cannot find context %s", context_name);
2005         return NULL;
2006     }
2007     spec->context_stack[spec->context_stack_top] = lt;
2008     spec->d1_stack[spec->d1_level] = NULL;
2009 #if 1
2010     if (!lt->initFlag)
2011     {
2012         lt->initFlag = 1;
2013         execAction (spec, lt->initActionList, ptr, &ptr);
2014     }
2015 #endif
2016     execAction (spec, lt->beginActionList, ptr, &ptr);
2017     lexNode (spec, &ptr);
2018     while (spec->d1_level)
2019     {
2020         tagDataRelease (spec);
2021         (spec->d1_level)--;
2022     }
2023     execAction (spec, lt->endActionList, ptr, &ptr);
2024     return spec->d1_stack[0];
2025 }
2026
2027 void grs_destroy(void *clientData)
2028 {
2029     struct lexSpecs *specs = (struct lexSpecs *) clientData;
2030     if (specs->spec)
2031     {
2032         lexSpecDestroy(&specs->spec);
2033     }
2034     xfree (specs);
2035 }
2036
2037 void *grs_init(void)
2038 {
2039     struct lexSpecs *specs = (struct lexSpecs *) xmalloc (sizeof(*specs));
2040     specs->spec = 0;
2041     return specs;
2042 }
2043
2044 data1_node *grs_read_regx (struct grs_read_info *p)
2045 {
2046     int res;
2047     struct lexSpecs *specs = (struct lexSpecs *) p->clientData;
2048     struct lexSpec **curLexSpec = &specs->spec;
2049
2050 #if REGX_DEBUG
2051     logf (LOG_LOG, "grs_read_regx");
2052 #endif
2053     if (!*curLexSpec || strcmp ((*curLexSpec)->name, p->type))
2054     {
2055         if (*curLexSpec)
2056             lexSpecDestroy (curLexSpec);
2057         *curLexSpec = lexSpecCreate (p->type, p->dh);
2058         res = readFileSpec (*curLexSpec);
2059         if (res)
2060         {
2061             lexSpecDestroy (curLexSpec);
2062             return NULL;
2063         }
2064     }
2065     (*curLexSpec)->dh = p->dh;
2066     if (!p->offset)
2067     {
2068         (*curLexSpec)->f_win_start = 0;
2069         (*curLexSpec)->f_win_end = 0;
2070         (*curLexSpec)->f_win_rf = p->readf;
2071         (*curLexSpec)->f_win_sf = p->seekf;
2072         (*curLexSpec)->f_win_fh = p->fh;
2073         (*curLexSpec)->f_win_ef = p->endf;
2074         (*curLexSpec)->f_win_size = 500000;
2075     }
2076     (*curLexSpec)->m = p->mem;
2077     return lexRoot (*curLexSpec, p->offset, "main");
2078 }
2079
2080 static struct recTypeGrs regx_type = {
2081     "regx",
2082     grs_init,
2083     grs_destroy,
2084     grs_read_regx
2085 };
2086
2087 RecTypeGrs recTypeGrs_regx = &regx_type;
2088
2089 #if HAVE_TCL_H
2090 data1_node *grs_read_tcl (struct grs_read_info *p)
2091 {
2092     int res;
2093     struct lexSpecs *specs = (struct lexSpecs *) p->clientData;
2094     struct lexSpec **curLexSpec = &specs->spec;
2095
2096 #if REGX_DEBUG
2097     logf (LOG_LOG, "grs_read_tcl");
2098 #endif
2099     if (!*curLexSpec || strcmp ((*curLexSpec)->name, p->type))
2100     {
2101         Tcl_Interp *tcl_interp;
2102         if (*curLexSpec)
2103             lexSpecDestroy (curLexSpec);
2104         *curLexSpec = lexSpecCreate (p->type, p->dh);
2105         tcl_interp = (*curLexSpec)->tcl_interp = Tcl_CreateInterp();
2106         Tcl_CreateCommand (tcl_interp, "begin", cmd_tcl_begin, *curLexSpec, 0);
2107         Tcl_CreateCommand (tcl_interp, "end", cmd_tcl_end, *curLexSpec, 0);
2108         Tcl_CreateCommand (tcl_interp, "data", cmd_tcl_data, *curLexSpec, 0);
2109         Tcl_CreateCommand (tcl_interp, "unread", cmd_tcl_unread,
2110                            *curLexSpec, 0);
2111         res = readFileSpec (*curLexSpec);
2112         if (res)
2113         {
2114             lexSpecDestroy (curLexSpec);
2115             return NULL;
2116         }
2117     }
2118     (*curLexSpec)->dh = p->dh;
2119     if (!p->offset)
2120     {
2121         (*curLexSpec)->f_win_start = 0;
2122         (*curLexSpec)->f_win_end = 0;
2123         (*curLexSpec)->f_win_rf = p->readf;
2124         (*curLexSpec)->f_win_sf = p->seekf;
2125         (*curLexSpec)->f_win_fh = p->fh;
2126         (*curLexSpec)->f_win_ef = p->endf;
2127         (*curLexSpec)->f_win_size = 500000;
2128     }
2129     (*curLexSpec)->m = p->mem;
2130     return lexRoot (*curLexSpec, p->offset, "main");
2131 }
2132
2133 static struct recTypeGrs tcl_type = {
2134     "tcl",
2135     grs_init,
2136     grs_destroy,
2137     grs_read_tcl
2138 };
2139
2140 RecTypeGrs recTypeGrs_tcl = &tcl_type;
2141 #endif