recctrl/regxread.c

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