retoglob.c

   1 /*
   2  * re2glob - C implementation
   3  * (c) 2007 ActiveState Software Inc.
   4  */
   5
   6 #include <tcl.h>
   7
   8 #define DEBUG 0
   9
  10 static void
  11 ExpChopNested _ANSI_ARGS_ ((Tcl_UniChar** xstr,
  12                             int*          xstrlen,
  13                             Tcl_UniChar   open,
  14                             Tcl_UniChar   close));
  15
  16 static Tcl_UniChar*
  17 ExpLiteral _ANSI_ARGS_ ((Tcl_UniChar* nexto,
  18                          Tcl_UniChar* str,
  19                          int          strlen));
  20
  21 static Tcl_UniChar*
  22 ExpCollapseStar _ANSI_ARGS_ ((Tcl_UniChar* src,
  23                               Tcl_UniChar* last));
  24 static Tcl_UniChar*
  25 ExpCollapseQForward _ANSI_ARGS_ ((Tcl_UniChar* src,
  26                                   Tcl_UniChar* last));
  27
  28 static Tcl_UniChar*
  29 ExpCollapseQBack _ANSI_ARGS_ ((Tcl_UniChar* src,
  30                                Tcl_UniChar* last));
  31
  32 static Tcl_UniChar
  33 ExpBackslash _ANSI_ARGS_ ((char prefix,
  34                          Tcl_UniChar* str,
  35                          int          strlen));
  36
  37 static int
  38 ExpCountStar _ANSI_ARGS_ ((Tcl_UniChar* src, Tcl_UniChar* last));
  39
  40
  41 static char*
  42 xxx (Tcl_UniChar* x, int xl)
  43 {
  44   static Tcl_DString ds;
  45   Tcl_DStringInit (&ds);
  46   return Tcl_UniCharToUtfDString (x,xl,&ds);
  47 }
  48
  49
  50 Tcl_Obj*
  51 exp_retoglob (
  52     Tcl_UniChar* str,
  53     int          strlen)
  54 {
  55   /*
  56    * Output: x2 size of input (literal where every character has to be
  57    * quoted.
  58    * Location: For next translated unit, in output.
  59    * Size of last generated unit, in characters.
  60    * Stack of output locations at opening parens. x1 size of input.
  61    * Location for next location on stack.
  62    */
  63
  64   static Tcl_UniChar litprefix [] = {'*','*','*','='};
  65   static Tcl_UniChar areprefix [] = {'*','*','*',':'};
  66   static Tcl_UniChar areopts   [] = {'(','?'};
  67   static Tcl_UniChar nocapture [] = {'?',':'};
  68   static Tcl_UniChar lookhas   [] = {'?','='};
  69   static Tcl_UniChar looknot   [] = {'?','!'};
  70   static Tcl_UniChar xcomment  [] = {'?','#'};
  71
  72   static Tcl_UniChar classa  [] = {'[','.'};
  73   static Tcl_UniChar classb  [] = {'[','='};
  74   static Tcl_UniChar classc  [] = {'[',':'};
  75
  76
  77   int lastsz, expanded;
  78   Tcl_UniChar*  out;
  79   Tcl_UniChar*  nexto;
  80   Tcl_UniChar** paren;
  81   Tcl_UniChar** nextp;
  82   Tcl_Obj*     glob = NULL;
  83   Tcl_UniChar* mark;
  84   Tcl_UniChar  ch;
  85
  86   /*
  87    * Set things up.
  88    */
  89
  90   out    = nexto = (Tcl_UniChar*)  Tcl_Alloc (strlen*2*sizeof (Tcl_UniChar));
  91   paren  = nextp = (Tcl_UniChar**) Tcl_Alloc (strlen*  sizeof (Tcl_UniChar*));
  92   lastsz = -1;
  93   expanded = 0;
  94
  95   /*
  96    * Start processing ...
  97    */
  98
  99 #define CHOP(n)  {str += (n); strlen -= (n);}
 100 #define CHOPC(c) {while (*str != (c) && strlen) CHOP(1) ;}
 101 #define EMIT(c)  {lastsz = 1; *nexto++ = (c);}
 102 #define EMITX(c) {lastsz++;   *nexto++ = (c);}
 103 #define MATCH(lit) ((strlen >= (sizeof (lit)/sizeof (Tcl_UniChar))) && (0 == Tcl_UniCharNcmp (str,(lit),sizeof(lit)/sizeof (Tcl_UniChar))))
 104 #define MATCHC(c) (strlen && (*str == (c)))
 105 #define PUSHPAREN {*nextp++ = nexto;}
 106 #define UNEMIT {nexto -= lastsz; lastsz = -1;}
 107   /* Tcl_UniCharIsDigit ? */
 108 #define MATCH_DIGIT (MATCHC ('0') || MATCHC ('1') || \
 109           MATCHC ('2') || MATCHC ('3') || \
 110           MATCHC ('4') || MATCHC ('5') || \
 111           MATCHC ('6') || MATCHC ('7') || \
 112           MATCHC ('8') || MATCHC ('9'))
 113 #define MATCH_HEXDIGIT (MATCH_DIGIT || \
 114                        MATCHC ('a') || MATCHC ('A') || \
 115                        MATCHC ('b') || MATCHC ('B') || \
 116                        MATCHC ('c') || MATCHC ('C') || \
 117                        MATCHC ('d') || MATCHC ('D') || \
 118                        MATCHC ('e') || MATCHC ('E') || \
 119                        MATCHC ('f') || MATCHC ('F'))
 120 #define EMITC(c) {if (((c) == '\\') || \
 121                       ((c) == '*') || \
 122                       ((c) == '?') || \
 123                       ((c) == '$') || \
 124                       ((c) == '^') || \
 125                       ((c) == '[')) { \
 126                         EMIT ('\\'); EMITX ((c)); \
 127                       } else { \
 128                         EMIT ((c));}}
 129 #define MATCH_AREOPTS(c) (c == 'b' || c == 'c' || \
 130           c == 'e' || c == 'i' || c == 'm' || c == 'n' || \
 131           c == 'p' || c == 'q' || c == 's' || c == 't' || \
 132           c == 'w' || c == 'x')
 133
 134 #if DEBUG
 135 #define LOG if (1) fprintf
 136 #define FF fflush (stderr)
 137 #define MARK(s) LOG (stderr,#s "\n"); FF;
 138 #else
 139 #define LOG if (0) fprintf
 140 #define FF
 141 #define MARK(s)
 142 #endif
 143
 144   /* ***= -> literal string follows */
 145
 146   LOG (stderr,"RE-2-GLOB '%s'\n", xxx(str,strlen)); FF;
 147
 148   if (MATCH (litprefix)) {
 149     CHOP (4);
 150     nexto = ExpLiteral (nexto, str, strlen);
 151     goto done;
 152   }
 153
 154   /* ***: -> RE is ARE. Always for Expect. Therefore ignore */
 155
 156   if (MATCH (areprefix)) {
 157     CHOP (4);
 158     LOG (stderr,"ARE '%s'\n", xxx(str,strlen)); FF;
 159   }
 160
 161   /* (?xyz) ARE options, in {bceimnpqstwx}. Not validating that the
 162    * options are legal. We assume that the RE is valid.
 163    */
 164
 165   if (MATCH (areopts)) { /* "(?" */
 166     Tcl_UniChar* save = str;
 167     Tcl_UniChar* stop;
 168     int stoplen;
 169     int save_strlen = strlen;
 170     int all_ARE_opts = 1;
 171
 172     /* First, ensure that this is actually an ARE opts string.
 173      * It could be something else (e.g., a non-capturing block).
 174      */
 175     CHOP (2);
 176     mark = str; CHOPC (')');
 177     stop = str;       /* Remember closing parens location, allows */
 178     stoplen = strlen; /* us to avoid a second CHOPC run later */
 179
 180     while (mark < str) {
 181       if (MATCH_AREOPTS(*mark)) {
 182         mark++;
 183       } else {
 184         all_ARE_opts = 0;
 185         break;
 186       }
 187     }
 188
 189     /* Reset back to our entry point. */
 190     str    = save;
 191     strlen = save_strlen;
 192
 193     if (all_ARE_opts) {
 194       /* Now actually perform the ARE option processing */
 195       LOG (stderr, "%s\n", "Processing AREOPTS"); FF;
 196
 197       CHOP (2);
 198       mark = str;
 199       /* Equivalent to CHOPC (')') */
 200       str    = stop;
 201       strlen = stoplen;
 202
 203       while (mark < str) {
 204         if (*mark == 'q') {
 205           CHOP (1);
 206           nexto = ExpLiteral (nexto, str, strlen);
 207           goto done;
 208         } else if (*mark == 'x') {
 209           expanded = 1;
 210           LOG (stderr,"EXPANDED\n"); FF;
 211         }
 212         mark++;
 213       }
 214       CHOP (1);
 215     }
 216   }
 217
 218   while (strlen) {
 219
 220     LOG (stderr,"'%s' <-- ",xxx(out,nexto-out)); FF;
 221     LOG (stderr,"'%s'\n",   xxx(str,strlen));    FF;
 222
 223     if (expanded) {
 224       /* Expanded syntax, whitespace and comments, ignore. */
 225       while (MATCHC (' ')  ||
 226              MATCHC (0x9) ||
 227              MATCHC (0xa)) CHOP (1);
 228       if (MATCHC ('#')) {
 229         CHOPC (0xa);
 230         if (strlen) CHOP (1);
 231         continue;
 232       }
 233     }
 234
 235     if (MATCHC ('|')) {
 236       /* branching is too complex */
 237       goto error;
 238     } else if (MATCHC ('(')) {
 239       /* open parens */
 240       CHOP (1);
 241       if (MATCH (nocapture)) { /* "?:" */
 242         /* non capturing -save location */
 243         PUSHPAREN;
 244         CHOP (2);
 245       } else if (MATCH (lookhas) || /* "?=" */
 246                  MATCH (looknot)) { /* "?!" */
 247         /* lookahead - ignore */
 248         CHOP (2);
 249         ExpChopNested (&str, &strlen, '(', ')');
 250       } else if (MATCH (xcomment)) { /* "?#" */
 251         /* comment - ignore */
 252         CHOPC (')'); CHOP (1);
 253       } else {
 254         /* plain capturing */
 255         PUSHPAREN;
 256       }
 257     } else if (MATCHC (')')) {
 258       /* Closing parens. */
 259       CHOP (1);
 260       /* Everything coming after the saved result is new, and
 261        * collapsed into a single entry for a possible coming operator
 262        * to handle.
 263        */
 264       nextp --; /* Back to last save */
 265       mark   = *nextp; /* Location where generation for this parens started */
 266       lastsz = (nexto - mark); /* This many chars generated */
 267       /* Now lastsz has the correct value for a possibly following
 268        * UNEMIT
 269        */
 270     } else if (MATCHC ('$') || MATCHC ('^')) {
 271       /* anchor constraints - ignore */
 272       CHOP (1);
 273     } else if (MATCHC ('[')) {
 274       /* Classes - reduce to any char [[=chars=]] [[.chars.]]
 275        * [[:name:]] [chars] Count brackets to find end.
 276
 277        * These are a bit complicated ... [= =], [. .], [: {] sequences
 278        * always have to be complete. '[' does NOT nest otherwise.  And
 279        * a ']' after the opening '[' (with only '^' allowed to
 280        * intervene is a character, not the closing bracket. We have to
 281        * process the class in pieces to handle all this. The Tcl level
 282        * implementations (0-2 all have bugs one way or other, all
 283        * different.
 284        */
 285
 286       int first   = 1;
 287       int allowed = 1;
 288       CHOP (1);
 289       while (strlen) {
 290         if (first && MATCHC ('^')) {
 291           /* ^ as first keeps allowed ok for one more cycle */
 292           CHOP (1);
 293           first = 0;
 294           continue;
 295         } else if (allowed && MATCHC (']')) {
 296           /* Not a closing bracket! */
 297           CHOP (1);
 298         } else if (MATCHC (']')) {
 299           /* Closing bracket found */
 300           CHOP (1);
 301           break;
 302         } else if (MATCH (classa) ||
 303                    MATCH (classb) ||
 304                    MATCH (classc)) {
 305           Tcl_UniChar delim[2];
 306           delim[0] = str [1];
 307           delim[1] = ']';
 308           CHOP (2);
 309           while (!MATCH (delim)) CHOP (1);
 310           CHOP (2);
 311         } else {
 312           /* Any char in class */
 313           CHOP (1);
 314         }
 315         /* Reset flags handling start of class */
 316         allowed = first = 0;
 317       }
 318
 319       EMIT ('?');
 320     } else if (MATCHC ('\\')) {
 321       /* Escapes */
 322       CHOP (1);
 323       if (MATCHC ('d') || MATCHC ('D') ||
 324           MATCHC ('s') || MATCHC ('S') ||
 325           MATCHC ('w') || MATCHC ('W')) {
 326         /* Class shorthands - reduce to any char */
 327         EMIT ('?');
 328         CHOP (1);
 329       } else if (MATCHC ('m') || MATCHC ('M') ||
 330                  MATCHC ('y') || MATCHC ('Y') ||
 331                  MATCHC ('A') || MATCHC ('Z')) {
 332         /* constraint escapes - ignore */
 333         CHOP (1);
 334       } else if (MATCHC ('B')) {
 335         /* Backslash */
 336         EMIT  ('\\');
 337         EMITX ('\\');
 338         CHOP (1);
 339       } else if (MATCHC ('0')) {
 340         /* Escape NULL */
 341         EMIT ('\0');
 342         CHOP (1);
 343       } else if (MATCHC ('e')) {
 344         /* Escape ESC */
 345         EMIT ('\033');
 346         CHOP (1);
 347       } else if (MATCHC ('a')) {
 348         /* Escape \a */
 349         EMIT (0x7);
 350         CHOP (1);
 351       } else if (MATCHC ('b')) {
 352         /* Escape \b */
 353         EMIT (0x8);
 354         CHOP (1);
 355       } else if (MATCHC ('f')) {
 356         /* Escape \f */
 357         EMIT (0xc);
 358         CHOP (1);
 359       } else if (MATCHC ('n')) {
 360         /* Escape \n */
 361         EMIT (0xa);
 362         CHOP (1);
 363       } else if (MATCHC ('r')) {
 364         /* Escape \r */
 365         EMIT (0xd);
 366         CHOP (1);
 367       } else if (MATCHC ('t')) {
 368         /* Escape \t */
 369         EMIT (0x9);
 370         CHOP (1);
 371       } else if (MATCHC ('v')) {
 372         /* Escape \v */
 373         EMIT (0xb);
 374         CHOP (1);
 375       } else if (MATCHC ('c') && (strlen >= 2)) {
 376         /* Escape \cX - reduce to (.) */
 377         EMIT ('?');
 378         CHOP (2);
 379       } else if (MATCHC ('x')) {
 380         CHOP (1);
 381         if (MATCH_HEXDIGIT) {
 382           /* Escape hex character */
 383           mark = str;
 384           while (MATCH_HEXDIGIT) CHOP (1);
 385           if ((str - mark) > 2) { mark = str - 2; }
 386           ch = ExpBackslash ('x',mark,str-mark);
 387           EMITC (ch);
 388         } else {
 389           /* Without hex digits following this is a plain char */
 390           EMIT ('x');
 391         }
 392       } else if (MATCHC ('u')) {
 393         /*  Escapes unicode short. */
 394         CHOP (1);
 395         mark = str;
 396         CHOP (4);
 397         ch = ExpBackslash ('u',mark,str-mark);
 398         EMITC (ch);
 399       } else if (MATCHC ('U')) {
 400         /* Escapes unicode long. */
 401         CHOP (1);
 402         mark = str;
 403         CHOP (8);
 404         ch = ExpBackslash ('U',mark,str-mark);
 405         EMITC (ch);
 406       } else if (MATCH_DIGIT) {
 407         /* Escapes, octal, and backreferences - reduce (.*) */
 408         CHOP (1);
 409         while (MATCH_DIGIT) CHOP (1);
 410         EMIT ('*');
 411       } else {
 412         /* Plain escaped characters - copy over, requote */
 413         EMITC (*str);
 414         CHOP (1);
 415       }
 416     } else if (MATCHC ('{')) {
 417       /* Non-greedy and greedy bounds - reduce to (*) */
 418       CHOP (1);
 419       if (MATCH_DIGIT) {
 420         /* Locate closing brace and remove operator */
 421         CHOPC ('}'); CHOP (1);
 422         /* Remove optional greedy quantifier */
 423         if (MATCHC ('?')) { CHOP (1);}
 424         UNEMIT;
 425         EMIT ('*');
 426       } else {
 427         /* Brace is plain character, copy over */
 428         EMIT ('{');
 429         /* CHOP already done */
 430       }
 431     } else if (MATCHC ('*') ||
 432                MATCHC ('+') ||
 433                MATCHC ('?')) {
 434       /* (Non-)greedy operators - reduce to (*) */
 435       CHOP (1);
 436       /* Remove optional greedy quantifier */
 437       if (MATCHC ('?')) { CHOP (1);}
 438       UNEMIT;
 439       EMIT ('*');
 440     } else if (MATCHC ('.')) {
 441       /* anychar - copy over */
 442       EMIT ('?');
 443       CHOP (1);
 444     } else {
 445       /* Plain char, copy over. */
 446       EMIT (*str);
 447       CHOP (1);
 448     }
 449   }
 450
 451   LOG (stderr,"'%s' <-- ",xxx(out,nexto-out)); FF;
 452   LOG (stderr,"'%s'\n",   xxx(str,strlen));    FF;
 453
 454   /*
 455    * Clean up the output a bit (collapse *-sequences and absorb ?'s
 456    * into adjacent *'s.
 457    */
 458
 459   MARK (QF)
 460   nexto = ExpCollapseQForward (out,nexto);
 461   LOG (stderr,"QF '%s'\n",xxx(out,nexto-out)); FF;
 462
 463   MARK (QB)
 464   nexto = ExpCollapseQBack    (out,nexto);
 465   LOG (stderr,"QB '%s'\n",xxx(out,nexto-out)); FF;
 466
 467   MARK (QS)
 468   nexto = ExpCollapseStar     (out,nexto);
 469   LOG (stderr,"ST '%s'\n",xxx(out,nexto-out)); FF;
 470
 471   /*
 472    * Heuristic: if there are more than two *s, the risk is far too
 473    * large that the result actually is slower than the normal re
 474    * matching.  So bail out.
 475    */
 476   if (ExpCountStar (out,nexto) > 2) {
 477       goto error;
 478   }
 479
 480   /*
 481    * Check if the result is actually useful.
 482    * Empty or just a *, or ? are not. A series
 483    * of ?'s is borderline, as they semi-count
 484    * the buffer.
 485    */
 486
 487   if ((nexto == out) ||
 488       (((nexto-out) == 1) &&
 489        ((*out == '*') ||
 490         (*out == '?')))) {
 491     goto error;
 492   }
 493
 494   /*
 495    * Result generation and cleanup.
 496    */
 497  done:
 498   LOG (stderr,"RESULT_ '%s'\n", xxx(out,nexto-out)); FF;
 499   glob = Tcl_NewUnicodeObj (out,(nexto-out));
 500   goto cleanup;
 501
 502  error:
 503   LOG (stderr,"RESULT_ ERROR\n"); FF;
 504
 505  cleanup:
 506   Tcl_Free ((char*)out);
 507   Tcl_Free ((char*)paren);
 508
 509   return glob;
 510 }
 511
 512 static void
 513 #ifdef _AIX
 514 ExpChopNested (Tcl_UniChar** xstr,
 515                int*          xstrlen,
 516                Tcl_UniChar   open,
 517                Tcl_UniChar   close)
 518 #else
 519 ExpChopNested (xstr,xstrlen, open, close)
 520      Tcl_UniChar** xstr;
 521      int*          xstrlen;
 522      Tcl_UniChar   open;
 523      Tcl_UniChar   close;
 524 #endif
 525 {
 526   Tcl_UniChar* str    = *xstr;
 527   int          strlen = *xstrlen;
 528   int          level = 0;
 529
 530   while (strlen) {
 531     if (MATCHC (open)) {
 532       level ++;
 533     } else if (MATCHC (close)) {
 534       level --;
 535       if (level < 0) {
 536         CHOP (1);
 537         break;
 538       }
 539     }
 540     CHOP (1);
 541   }
 542
 543   *xstr = str;
 544   *xstrlen = strlen;
 545 }
 546
 547 static Tcl_UniChar*
 548 ExpLiteral (nexto, str, strlen)
 549      Tcl_UniChar* nexto;
 550      Tcl_UniChar* str;
 551      int          strlen;
 552 {
 553   int lastsz;
 554
 555   LOG (stderr,"LITERAL '%s'\n", xxx(str,strlen)); FF;
 556
 557   while (strlen) {
 558     EMITC (*str);
 559     CHOP (1);
 560   }
 561   return nexto;
 562 }
 563
 564 static Tcl_UniChar
 565 #ifdef _AIX
 566 ExpBackslash (char prefix,
 567               Tcl_UniChar* str,
 568               int          strlen)
 569 #else
 570 ExpBackslash (prefix, str, strlen)
 571      char prefix;
 572      Tcl_UniChar* str;
 573      int          strlen;
 574 #endif
 575 {
 576   /* strlen <= 8 */
 577   char buf[20];
 578   char dst[TCL_UTF_MAX+1];
 579   Tcl_UniChar ch;
 580   int at = 0;
 581
 582   /* Construct an utf backslash sequence we can throw to Tcl */
 583
 584   buf [at++] = '\\';
 585   buf [at++] = prefix;
 586   while (strlen) {
 587     buf [at++] = *str++;
 588     strlen --;
 589   }
 590
 591   Tcl_UtfBackslash (buf, NULL, dst);
 592   TclUtfToUniChar (dst, &ch);
 593   return ch;
 594 }
 595
 596 static Tcl_UniChar*
 597 ExpCollapseStar (src, last)
 598      Tcl_UniChar* src;
 599      Tcl_UniChar* last;
 600 {
 601   Tcl_UniChar* dst, *base;
 602   int skip = 0;
 603   int star = 0;
 604
 605   /* Collapses series of *'s into a single *. State machine. The
 606    * complexity is due to the need of handling escaped characters.
 607    */
 608
 609   LOG (stderr,"Q-STAR\n"); FF;
 610
 611   for (dst = base = src; src < last;) {
 612
 613     LOG (stderr,"@%1d /%1d '%s' <-- ", star,skip,xxx(base,dst-base)); FF;
 614     LOG (stderr,"'%s'\n",   xxx(src,last-src));  FF;
 615
 616     if (skip) {
 617       skip = 0;
 618       star = 0;
 619     } else if (*src == '\\') {
 620       skip = 1; /* Copy next char, whatever its value */
 621       star = 0;
 622     } else if (*src == '*') {
 623       if (star) {
 624         /* Previous char was *, do not copy the current * to collapse
 625          * the sequence
 626          */
 627         src++;
 628         continue;
 629       }
 630       star = 1; /* *-series starts here */
 631     } else {
 632       star = 0;
 633     }
 634     *dst++ = *src++;
 635   }
 636
 637   LOG (stderr,"@%1d /%1d '%s' <-- ", star,skip,xxx(base,dst-base)); FF;
 638   LOG (stderr,"'%s'\n",   xxx(src,last-src));  FF;
 639
 640   return dst;
 641 }
 642
 643 static Tcl_UniChar*
 644 ExpCollapseQForward (src, last)
 645      Tcl_UniChar* src;
 646      Tcl_UniChar* last;
 647 {
 648   Tcl_UniChar* dst, *base;
 649   int skip = 0;
 650   int quest = 0;
 651
 652   /* Collapses series of ?'s coming after a *. State machine. The
 653    * complexity is due to the need of handling escaped characters.
 654    */
 655
 656   LOG (stderr,"Q-Forward\n"); FF;
 657
 658   for (dst = base = src; src < last;) {
 659
 660     LOG (stderr,"?%1d /%1d '%s' <-- ", quest,skip,xxx(base,dst-base)); FF;
 661     LOG (stderr,"'%s'\n",   xxx(src,last-src));  FF;
 662
 663     if (skip) {
 664       skip = 0;
 665       quest = 0;
 666     } else if (*src == '\\') {
 667       skip = 1;
 668       quest = 0;
 669       /* Copy next char, whatever its value */
 670     } else if (*src == '?') {
 671       if (quest) {
 672         /* Previous char was *, do not copy the current ? to collapse
 673          * the sequence
 674          */
 675         src++;
 676         continue;
 677       }
 678     } else if (*src == '*') {
 679       quest = 1;
 680     } else {
 681       quest = 0;
 682     }
 683     *dst++ = *src++;
 684   }
 685
 686   LOG (stderr,"?%1d /%1d '%s' <-- ", quest,skip,xxx(base,dst-base)); FF;
 687   LOG (stderr,"'%s'\n",   xxx(src,last-src));  FF;
 688   return dst;
 689 }
 690
 691 static Tcl_UniChar*
 692 ExpCollapseQBack (src, last)
 693      Tcl_UniChar* src;
 694      Tcl_UniChar* last;
 695 {
 696   Tcl_UniChar* dst, *base;
 697   int skip = 0;
 698
 699   /* Collapses series of ?'s coming before a *. State machine. The
 700    * complexity is due to the need of handling escaped characters.
 701    */
 702
 703   LOG (stderr,"Q-Backward\n"); FF;
 704
 705   for (dst = base = src; src < last;) {
 706     LOG (stderr,"/%1d '%s' <-- ",skip,xxx(base,dst-base)); FF;
 707     LOG (stderr,"'%s'\n",   xxx(src,last-src));  FF;
 708
 709     if (skip) {
 710       skip = 0;
 711     } else if (*src == '\\') {
 712       skip = 1;
 713       /* Copy next char, whatever its value */
 714     } else if (*src == '*') {
 715       /* Move backward in the output while the previous character is
 716        * an unescaped question mark. If there is a previous character,
 717        * or a character before that..
 718        */
 719
 720       while ((((dst-base) > 2)  && (dst[-1] == '?') && (dst[-2] != '\\')) ||
 721              (((dst-base) == 1) && (dst[-1] == '?'))) {
 722         dst --;
 723       }
 724     }
 725     *dst++ = *src++;
 726   }
 727
 728   LOG (stderr,"/%1d '%s' <-- \n",skip,xxx(base,dst-base)); FF;
 729   LOG (stderr,"'%s'\n",   xxx(src,last-src));  FF;
 730   return dst;
 731 }
 732
 733 static int
 734 ExpCountStar (src, last)
 735     Tcl_UniChar* src;
 736     Tcl_UniChar* last;
 737 {
 738     int skip = 0;
 739     int stars = 0;
 740
 741     /* Count number of *'s. State machine. The complexity is due to the
 742      * need of handling escaped characters.
 743      */
 744
 745     for (; src < last; src++) {
 746         if (skip) {
 747             skip = 0;
 748         } else if (*src == '\\') {
 749             skip = 1;
 750         } else if (*src == '*') {
 751             stars++;
 752         }
 753     }
 754
 755     return stars;
 756 }
 757
 758 #undef CHOP
 759 #undef CHOPC
 760 #undef EMIT
 761 #undef EMITX
 762 #undef MATCH
 763 #undef MATCHC
 764 #undef MATCH_DIGIT
 765 #undef MATCH_HEXDIGIT
 766 #undef PUSHPAREN
 767 #undef UNEMIT