recctrl/regxread.c

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