cons.c

   1 /* $Header: cons.c,v 4.0 91/03/20 01:05:51 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        cons.c,v $
   9  * Revision 4.0  91/03/20  01:05:51  lwall
  10  * 4.0 baseline.
  11  *
  12  */
  13
  14 #include "EXTERN.h"
  15 #include "perl.h"
  16 #include "perly.h"
  17
  18 extern char *tokename[];
  19 extern int yychar;
  20
  21 static int cmd_tosave();
  22 static int arg_tosave();
  23 static int spat_tosave();
  24
  25 static bool saw_return;
  26
  27 SUBR *
  28 make_sub(name,cmd)
  29 char *name;
  30 CMD *cmd;
  31 {
  32     register SUBR *sub;
  33     STAB *stab = stabent(name,TRUE);
  34
  35     Newz(101,sub,1,SUBR);
  36     if (stab_sub(stab)) {
  37         if (dowarn) {
  38             CMD *oldcurcmd = curcmd;
  39
  40             if (cmd)
  41                 curcmd = cmd;
  42             warn("Subroutine %s redefined",name);
  43             curcmd = oldcurcmd;
  44         }
  45         if (stab_sub(stab)->cmd) {
  46             cmd_free(stab_sub(stab)->cmd);
  47             stab_sub(stab)->cmd = Nullcmd;
  48             afree(stab_sub(stab)->tosave);
  49         }
  50         Safefree(stab_sub(stab));
  51     }
  52     stab_sub(stab) = sub;
  53     sub->filestab = curcmd->c_filestab;
  54     saw_return = FALSE;
  55     tosave = anew(Nullstab);
  56     tosave->ary_fill = 0;       /* make 1 based */
  57     (void)cmd_tosave(cmd,FALSE);        /* this builds the tosave array */
  58     sub->tosave = tosave;
  59     if (saw_return) {
  60         struct compcmd mycompblock;
  61
  62         mycompblock.comp_true = cmd;
  63         mycompblock.comp_alt = Nullcmd;
  64         cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
  65         saw_return = FALSE;
  66         cmd->c_flags |= CF_TERM;
  67     }
  68     sub->cmd = cmd;
  69     if (perldb) {
  70         STR *str;
  71         STR *tmpstr = str_mortal(&str_undef);
  72
  73         sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
  74           (long)subline);
  75         str = str_make(buf,0);
  76         str_cat(str,"-");
  77         sprintf(buf,"%ld",(long)curcmd->c_line);
  78         str_cat(str,buf);
  79         name = str_get(subname);
  80         stab_fullname(tmpstr,stab);
  81         hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
  82         str_set(subname,"main");
  83     }
  84     subline = 0;
  85     return sub;
  86 }
  87
  88 SUBR *
  89 make_usub(name, ix, subaddr, filename)
  90 char *name;
  91 int ix;
  92 int (*subaddr)();
  93 char *filename;
  94 {
  95     register SUBR *sub;
  96     STAB *stab = stabent(name,allstabs);
  97
  98     if (!stab)                          /* unused function */
  99         return Null(SUBR*);
 100     Newz(101,sub,1,SUBR);
 101     if (stab_sub(stab)) {
 102         if (dowarn)
 103             warn("Subroutine %s redefined",name);
 104         if (stab_sub(stab)->cmd) {
 105             cmd_free(stab_sub(stab)->cmd);
 106             stab_sub(stab)->cmd = Nullcmd;
 107             afree(stab_sub(stab)->tosave);
 108         }
 109         Safefree(stab_sub(stab));
 110     }
 111     stab_sub(stab) = sub;
 112     sub->filestab = fstab(filename);
 113     sub->usersub = subaddr;
 114     sub->userindex = ix;
 115     return sub;
 116 }
 117
 118 make_form(stab,fcmd)
 119 STAB *stab;
 120 FCMD *fcmd;
 121 {
 122     if (stab_form(stab)) {
 123         FCMD *tmpfcmd;
 124         FCMD *nextfcmd;
 125
 126         for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
 127             nextfcmd = tmpfcmd->f_next;
 128             if (tmpfcmd->f_expr)
 129                 arg_free(tmpfcmd->f_expr);
 130             if (tmpfcmd->f_unparsed)
 131                 str_free(tmpfcmd->f_unparsed);
 132             if (tmpfcmd->f_pre)
 133                 Safefree(tmpfcmd->f_pre);
 134             Safefree(tmpfcmd);
 135         }
 136     }
 137     stab_form(stab) = fcmd;
 138 }
 139
 140 CMD *
 141 block_head(tail)
 142 register CMD *tail;
 143 {
 144     CMD *head;
 145     register int opt;
 146     register int last_opt = 0;
 147     register STAB *last_stab = Nullstab;
 148     register int count = 0;
 149     register CMD *switchbeg = Nullcmd;
 150
 151     if (tail == Nullcmd) {
 152         return tail;
 153     }
 154     head = tail->c_head;
 155
 156     for (tail = head; tail; tail = tail->c_next) {
 157
 158         /* save one measly dereference at runtime */
 159         if (tail->c_type == C_IF) {
 160             if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
 161                 tail->c_flags |= CF_TERM;
 162         }
 163         else if (tail->c_type == C_EXPR) {
 164             ARG *arg;
 165
 166             if (tail->ucmd.acmd.ac_expr)
 167                 arg = tail->ucmd.acmd.ac_expr;
 168             else
 169                 arg = tail->c_expr;
 170             if (arg) {
 171                 if (arg->arg_type == O_RETURN)
 172                     tail->c_flags |= CF_TERM;
 173                 else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
 174                     tail->c_flags |= CF_TERM;
 175             }
 176         }
 177         if (!tail->c_next)
 178             tail->c_flags |= CF_TERM;
 179
 180         if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
 181             opt_arg(tail,1, tail->c_type == C_EXPR);
 182
 183         /* now do a little optimization on case-ish structures */
 184         switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
 185         case CFT_ANCHOR:
 186             if (stabent("*",FALSE)) {   /* bad assumption here!!! */
 187                 opt = 0;
 188                 break;
 189             }
 190             /* FALL THROUGH */
 191         case CFT_STROP:
 192             opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
 193             break;
 194         case CFT_CCLASS:
 195             opt = CFT_STROP;
 196             break;
 197         case CFT_NUMOP:
 198             opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
 199             if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
 200                 opt = 0;
 201             break;
 202         default:
 203             opt = 0;
 204         }
 205         if (opt && opt == last_opt && tail->c_stab == last_stab)
 206             count++;
 207         else {
 208             if (count >= 3) {           /* is this the breakeven point? */
 209                 if (last_opt == CFT_NUMOP)
 210                     make_nswitch(switchbeg,count);
 211                 else
 212                     make_cswitch(switchbeg,count);
 213             }
 214             if (opt) {
 215                 count = 1;
 216                 switchbeg = tail;
 217             }
 218             else
 219                 count = 0;
 220         }
 221         last_opt = opt;
 222         last_stab = tail->c_stab;
 223     }
 224     if (count >= 3) {           /* is this the breakeven point? */
 225         if (last_opt == CFT_NUMOP)
 226             make_nswitch(switchbeg,count);
 227         else
 228             make_cswitch(switchbeg,count);
 229     }
 230     return head;
 231 }
 232
 233 /* We've spotted a sequence of CMDs that all test the value of the same
 234  * spat.  Thus we can insert a SWITCH in front and jump directly
 235  * to the correct one.
 236  */
 237 make_cswitch(head,count)
 238 register CMD *head;
 239 int count;
 240 {
 241     register CMD *cur;
 242     register CMD **loc;
 243     register int i;
 244     register int min = 255;
 245     register int max = 0;
 246
 247     /* make a new head in the exact same spot */
 248     New(102,cur, 1, CMD);
 249 #ifdef STRUCTCOPY
 250     *cur = *head;
 251 #else
 252     Copy(head,cur,1,CMD);
 253 #endif
 254     Zero(head,1,CMD);
 255     head->c_type = C_CSWITCH;
 256     head->c_next = cur;         /* insert new cmd at front of list */
 257     head->c_stab = cur->c_stab;
 258
 259     Newz(103,loc,258,CMD*);
 260     loc++;                              /* lie a little */
 261     while (count--) {
 262         if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
 263             for (i = 0; i <= 255; i++) {
 264                 if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
 265                     loc[i] = cur;
 266                     if (i < min)
 267                         min = i;
 268                     if (i > max)
 269                         max = i;
 270                 }
 271             }
 272         }
 273         else {
 274             i = *cur->c_short->str_ptr & 255;
 275             if (!loc[i]) {
 276                 loc[i] = cur;
 277                 if (i < min)
 278                     min = i;
 279                 if (i > max)
 280                     max = i;
 281             }
 282         }
 283         cur = cur->c_next;
 284     }
 285     max++;
 286     if (min > 0)
 287         Copy(&loc[min],&loc[0], max - min, CMD*);
 288     loc--;
 289     min--;
 290     max -= min;
 291     for (i = 0; i <= max; i++)
 292         if (!loc[i])
 293             loc[i] = cur;
 294     Renew(loc,max+1,CMD*);      /* chop it down to size */
 295     head->ucmd.scmd.sc_offset = min;
 296     head->ucmd.scmd.sc_max = max;
 297     head->ucmd.scmd.sc_next = loc;
 298 }
 299
 300 make_nswitch(head,count)
 301 register CMD *head;
 302 int count;
 303 {
 304     register CMD *cur = head;
 305     register CMD **loc;
 306     register int i;
 307     register int min = 32767;
 308     register int max = -32768;
 309     int origcount = count;
 310     double value;               /* or your money back! */
 311     short changed;              /* so triple your money back! */
 312
 313     while (count--) {
 314         i = (int)str_gnum(cur->c_short);
 315         value = (double)i;
 316         if (value != cur->c_short->str_u.str_nval)
 317             return;             /* fractional values--just forget it */
 318         changed = i;
 319         if (changed != i)
 320             return;             /* too big for a short */
 321         if (cur->c_slen == O_LE)
 322             i++;
 323         else if (cur->c_slen == O_GE)   /* we only do < or > here */
 324             i--;
 325         if (i < min)
 326             min = i;
 327         if (i > max)
 328             max = i;
 329         cur = cur->c_next;
 330     }
 331     count = origcount;
 332     if (max - min > count * 2 + 10)             /* too sparse? */
 333         return;
 334
 335     /* now make a new head in the exact same spot */
 336     New(104,cur, 1, CMD);
 337 #ifdef STRUCTCOPY
 338     *cur = *head;
 339 #else
 340     Copy(head,cur,1,CMD);
 341 #endif
 342     Zero(head,1,CMD);
 343     head->c_type = C_NSWITCH;
 344     head->c_next = cur;         /* insert new cmd at front of list */
 345     head->c_stab = cur->c_stab;
 346
 347     Newz(105,loc, max - min + 3, CMD*);
 348     loc++;
 349     max -= min;
 350     max++;
 351     while (count--) {
 352         i = (int)str_gnum(cur->c_short);
 353         i -= min;
 354         switch(cur->c_slen) {
 355         case O_LE:
 356             i++;
 357         case O_LT:
 358             for (i--; i >= -1; i--)
 359                 if (!loc[i])
 360                     loc[i] = cur;
 361             break;
 362         case O_GE:
 363             i--;
 364         case O_GT:
 365             for (i++; i <= max; i++)
 366                 if (!loc[i])
 367                     loc[i] = cur;
 368             break;
 369         case O_EQ:
 370             if (!loc[i])
 371                 loc[i] = cur;
 372             break;
 373         }
 374         cur = cur->c_next;
 375     }
 376     loc--;
 377     min--;
 378     max++;
 379     for (i = 0; i <= max; i++)
 380         if (!loc[i])
 381             loc[i] = cur;
 382     head->ucmd.scmd.sc_offset = min;
 383     head->ucmd.scmd.sc_max = max;
 384     head->ucmd.scmd.sc_next = loc;
 385 }
 386
 387 CMD *
 388 append_line(head,tail)
 389 register CMD *head;
 390 register CMD *tail;
 391 {
 392     if (tail == Nullcmd)
 393         return head;
 394     if (!tail->c_head)                  /* make sure tail is well formed */
 395         tail->c_head = tail;
 396     if (head != Nullcmd) {
 397         tail = tail->c_head;            /* get to start of tail list */
 398         if (!head->c_head)
 399             head->c_head = head;        /* start a new head list */
 400         while (head->c_next) {
 401             head->c_next->c_head = head->c_head;
 402             head = head->c_next;        /* get to end of head list */
 403         }
 404         head->c_next = tail;            /* link to end of old list */
 405         tail->c_head = head->c_head;    /* propagate head pointer */
 406     }
 407     while (tail->c_next) {
 408         tail->c_next->c_head = tail->c_head;
 409         tail = tail->c_next;
 410     }
 411     return tail;
 412 }
 413
 414 CMD *
 415 dodb(cur)
 416 CMD *cur;
 417 {
 418     register CMD *cmd;
 419     register CMD *head = cur->c_head;
 420     STR *str;
 421
 422     if (!head)
 423         head = cur;
 424     if (!head->c_line)
 425         return cur;
 426     str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
 427     if (str == &str_undef || str->str_nok)
 428         return cur;
 429     str->str_u.str_nval = (double)head->c_line;
 430     str->str_nok = 1;
 431     Newz(106,cmd,1,CMD);
 432     str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
 433     str->str_magic->str_u.str_cmd = cmd;
 434     cmd->c_type = C_EXPR;
 435     cmd->ucmd.acmd.ac_stab = Nullstab;
 436     cmd->ucmd.acmd.ac_expr = Nullarg;
 437     cmd->c_expr = make_op(O_SUBR, 2,
 438         stab2arg(A_WORD,DBstab),
 439         Nullarg,
 440         Nullarg);
 441     cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
 442     cmd->c_line = head->c_line;
 443     cmd->c_label = head->c_label;
 444     cmd->c_filestab = curcmd->c_filestab;
 445     cmd->c_stash = curstash;
 446     return append_line(cmd, cur);
 447 }
 448
 449 CMD *
 450 make_acmd(type,stab,cond,arg)
 451 int type;
 452 STAB *stab;
 453 ARG *cond;
 454 ARG *arg;
 455 {
 456     register CMD *cmd;
 457
 458     Newz(107,cmd,1,CMD);
 459     cmd->c_type = type;
 460     cmd->ucmd.acmd.ac_stab = stab;
 461     cmd->ucmd.acmd.ac_expr = arg;
 462     cmd->c_expr = cond;
 463     if (cond)
 464         cmd->c_flags |= CF_COND;
 465     if (cmdline == NOLINE)
 466         cmd->c_line = curcmd->c_line;
 467     else {
 468         cmd->c_line = cmdline;
 469         cmdline = NOLINE;
 470     }
 471     cmd->c_filestab = curcmd->c_filestab;
 472     cmd->c_stash = curstash;
 473     if (perldb)
 474         cmd = dodb(cmd);
 475     return cmd;
 476 }
 477
 478 CMD *
 479 make_ccmd(type,arg,cblock)
 480 int type;
 481 ARG *arg;
 482 struct compcmd cblock;
 483 {
 484     register CMD *cmd;
 485
 486     Newz(108,cmd, 1, CMD);
 487     cmd->c_type = type;
 488     cmd->c_expr = arg;
 489     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
 490     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
 491     if (arg)
 492         cmd->c_flags |= CF_COND;
 493     if (cmdline == NOLINE)
 494         cmd->c_line = curcmd->c_line;
 495     else {
 496         cmd->c_line = cmdline;
 497         cmdline = NOLINE;
 498     }
 499     cmd->c_filestab = curcmd->c_filestab;
 500     cmd->c_stash = curstash;
 501     if (perldb)
 502         cmd = dodb(cmd);
 503     return cmd;
 504 }
 505
 506 CMD *
 507 make_icmd(type,arg,cblock)
 508 int type;
 509 ARG *arg;
 510 struct compcmd cblock;
 511 {
 512     register CMD *cmd;
 513     register CMD *alt;
 514     register CMD *cur;
 515     register CMD *head;
 516     struct compcmd ncblock;
 517
 518     Newz(109,cmd, 1, CMD);
 519     head = cmd;
 520     cmd->c_type = type;
 521     cmd->c_expr = arg;
 522     cmd->ucmd.ccmd.cc_true = cblock.comp_true;
 523     cmd->ucmd.ccmd.cc_alt = cblock.comp_alt;
 524     if (arg)
 525         cmd->c_flags |= CF_COND;
 526     if (cmdline == NOLINE)
 527         cmd->c_line = curcmd->c_line;
 528     else {
 529         cmd->c_line = cmdline;
 530         cmdline = NOLINE;
 531     }
 532     cmd->c_filestab = curcmd->c_filestab;
 533     cmd->c_stash = curstash;
 534     cur = cmd;
 535     alt = cblock.comp_alt;
 536     while (alt && alt->c_type == C_ELSIF) {
 537         cur = alt;
 538         alt = alt->ucmd.ccmd.cc_alt;
 539     }
 540     if (alt) {                  /* a real life ELSE at the end? */
 541         ncblock.comp_true = alt;
 542         ncblock.comp_alt = Nullcmd;
 543         alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
 544         cur->ucmd.ccmd.cc_alt = alt;
 545     }
 546     else
 547         alt = cur;              /* no ELSE, so cur is proxy ELSE */
 548
 549     cur = cmd;
 550     while (cmd) {               /* now point everyone at the ELSE */
 551         cur = cmd;
 552         cmd = cur->ucmd.ccmd.cc_alt;
 553         cur->c_head = head;
 554         if (cur->c_type == C_ELSIF)
 555             cur->c_type = C_IF;
 556         if (cur->c_type == C_IF)
 557             cur->ucmd.ccmd.cc_alt = alt;
 558         if (cur == alt)
 559             break;
 560         cur->c_next = cmd;
 561     }
 562     if (perldb)
 563         cur = dodb(cur);
 564     return cur;
 565 }
 566
 567 void
 568 opt_arg(cmd,fliporflop,acmd)
 569 register CMD *cmd;
 570 int fliporflop;
 571 int acmd;
 572 {
 573     register ARG *arg;
 574     int opt = CFT_EVAL;
 575     int sure = 0;
 576     ARG *arg2;
 577     int context = 0;    /* 0 = normal, 1 = before &&, 2 = before || */
 578     int flp = fliporflop;
 579
 580     if (!cmd)
 581         return;
 582     if (!(arg = cmd->c_expr)) {
 583         cmd->c_flags &= ~CF_COND;
 584         return;
 585     }
 586
 587     /* Can we turn && and || into if and unless? */
 588
 589     if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM) &&
 590       (arg->arg_type == O_AND || arg->arg_type == O_OR) ) {
 591         dehoist(arg,1);
 592         arg[2].arg_type &= A_MASK;      /* don't suppress eval */
 593         dehoist(arg,2);
 594         cmd->ucmd.acmd.ac_expr = arg[2].arg_ptr.arg_arg;
 595         cmd->c_expr = arg[1].arg_ptr.arg_arg;
 596         if (arg->arg_type == O_OR)
 597             cmd->c_flags ^= CF_INVERT;          /* || is like unless */
 598         arg->arg_len = 0;
 599         free_arg(arg);
 600         arg = cmd->c_expr;
 601     }
 602
 603     /* Turn "if (!expr)" into "unless (expr)" */
 604
 605     if (!(cmd->c_flags & CF_TERM)) {            /* unless return value wanted */
 606         while (arg->arg_type == O_NOT) {
 607             dehoist(arg,1);
 608             cmd->c_flags ^= CF_INVERT;          /* flip sense of cmd */
 609             cmd->c_expr = arg[1].arg_ptr.arg_arg; /* hoist the rest of expr */
 610             free_arg(arg);
 611             arg = cmd->c_expr;                  /* here we go again */
 612         }
 613     }
 614
 615     if (!arg->arg_len) {                /* sanity check */
 616         cmd->c_flags |= opt;
 617         return;
 618     }
 619
 620     /* for "cond .. cond" we set up for the initial check */
 621
 622     if (arg->arg_type == O_FLIP)
 623         context |= 4;
 624
 625     /* for "cond && expr" and "cond || expr" we can ignore expr, sort of */
 626
 627   morecontext:
 628     if (arg->arg_type == O_AND)
 629         context |= 1;
 630     else if (arg->arg_type == O_OR)
 631         context |= 2;
 632     if (context && (arg[flp].arg_type & A_MASK) == A_EXPR) {
 633         arg = arg[flp].arg_ptr.arg_arg;
 634         flp = 1;
 635         if (arg->arg_type == O_AND || arg->arg_type == O_OR)
 636             goto morecontext;
 637     }
 638     if ((context & 3) == 3)
 639         return;
 640
 641     if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
 642         cmd->c_flags |= opt;
 643         if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
 644           && cmd->c_expr->arg_type == O_ITEM) {
 645             arg[flp].arg_flags &= ~AF_POST;     /* prefer ++$foo to $foo++ */
 646             arg[flp].arg_flags |= AF_PRE;       /*  if value not wanted */
 647         }
 648         return;                         /* side effect, can't optimize */
 649     }
 650
 651     if (arg->arg_type == O_ITEM || arg->arg_type == O_FLIP ||
 652       arg->arg_type == O_AND || arg->arg_type == O_OR) {
 653         if ((arg[flp].arg_type & A_MASK) == A_SINGLE) {
 654             opt = (str_true(arg[flp].arg_ptr.arg_str) ? CFT_TRUE : CFT_FALSE);
 655             cmd->c_short = str_smake(arg[flp].arg_ptr.arg_str);
 656             goto literal;
 657         }
 658         else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
 659           (arg[flp].arg_type & A_MASK) == A_LVAL) {
 660             cmd->c_stab  = arg[flp].arg_ptr.arg_stab;
 661             if (!context)
 662                 arg[flp].arg_ptr.arg_stab = Nullstab;
 663             opt = CFT_REG;
 664           literal:
 665             if (!context) {     /* no && or ||? */
 666                 arg_free(arg);
 667                 cmd->c_expr = Nullarg;
 668             }
 669             if (!(context & 1))
 670                 cmd->c_flags |= CF_EQSURE;
 671             if (!(context & 2))
 672                 cmd->c_flags |= CF_NESURE;
 673         }
 674     }
 675     else if (arg->arg_type == O_MATCH || arg->arg_type == O_SUBST ||
 676              arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
 677         if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
 678                 (arg[2].arg_type & A_MASK) == A_SPAT &&
 679                 arg[2].arg_ptr.arg_spat->spat_short ) {
 680             cmd->c_stab  = arg[1].arg_ptr.arg_stab;
 681             cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
 682             cmd->c_slen  = arg[2].arg_ptr.arg_spat->spat_slen;
 683             if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ALL &&
 684                 !(arg[2].arg_ptr.arg_spat->spat_flags & SPAT_ONCE) &&
 685                 (arg->arg_type == O_MATCH || arg->arg_type == O_NMATCH) )
 686                 sure |= CF_EQSURE;              /* (SUBST must be forced even */
 687                                                 /* if we know it will work.) */
 688             if (arg->arg_type != O_SUBST) {
 689                 arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
 690                 arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
 691             }
 692             sure |= CF_NESURE;          /* normally only sure if it fails */
 693             if (arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST)
 694                 cmd->c_flags |= CF_FIRSTNEG;
 695             if (context & 1) {          /* only sure if thing is false */
 696                 if (cmd->c_flags & CF_FIRSTNEG)
 697                     sure &= ~CF_NESURE;
 698                 else
 699                     sure &= ~CF_EQSURE;
 700             }
 701             else if (context & 2) {     /* only sure if thing is true */
 702                 if (cmd->c_flags & CF_FIRSTNEG)
 703                     sure &= ~CF_EQSURE;
 704                 else
 705                     sure &= ~CF_NESURE;
 706             }
 707             if (sure & (CF_EQSURE|CF_NESURE)) { /* if we know anything*/
 708                 if (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_SCANFIRST)
 709                     opt = CFT_SCAN;
 710                 else
 711                     opt = CFT_ANCHOR;
 712                 if (sure == (CF_EQSURE|CF_NESURE)       /* really sure? */
 713                     && arg->arg_type == O_MATCH
 714                     && context & 4
 715                     && fliporflop == 1) {
 716                     spat_free(arg[2].arg_ptr.arg_spat);
 717                     arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
 718                 }
 719                 else
 720                     cmd->c_spat = arg[2].arg_ptr.arg_spat;
 721                 cmd->c_flags |= sure;
 722             }
 723         }
 724     }
 725     else if (arg->arg_type == O_SEQ || arg->arg_type == O_SNE ||
 726              arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
 727         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
 728             if (arg[2].arg_type == A_SINGLE) {
 729                 char *junk = str_get(arg[2].arg_ptr.arg_str);
 730
 731                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
 732                 cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
 733                 cmd->c_slen  = cmd->c_short->str_cur+1;
 734                 switch (arg->arg_type) {
 735                 case O_SLT: case O_SGT:
 736                     sure |= CF_EQSURE;
 737                     cmd->c_flags |= CF_FIRSTNEG;
 738                     break;
 739                 case O_SNE:
 740                     cmd->c_flags |= CF_FIRSTNEG;
 741                     /* FALL THROUGH */
 742                 case O_SEQ:
 743                     sure |= CF_NESURE|CF_EQSURE;
 744                     break;
 745                 }
 746                 if (context & 1) {      /* only sure if thing is false */
 747                     if (cmd->c_flags & CF_FIRSTNEG)
 748                         sure &= ~CF_NESURE;
 749                     else
 750                         sure &= ~CF_EQSURE;
 751                 }
 752                 else if (context & 2) { /* only sure if thing is true */
 753                     if (cmd->c_flags & CF_FIRSTNEG)
 754                         sure &= ~CF_EQSURE;
 755                     else
 756                         sure &= ~CF_NESURE;
 757                 }
 758                 if (sure & (CF_EQSURE|CF_NESURE)) {
 759                     opt = CFT_STROP;
 760                     cmd->c_flags |= sure;
 761                 }
 762             }
 763         }
 764     }
 765     else if (arg->arg_type == O_EQ || arg->arg_type == O_NE ||
 766              arg->arg_type == O_LE || arg->arg_type == O_GE ||
 767              arg->arg_type == O_LT || arg->arg_type == O_GT) {
 768         if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
 769             if (arg[2].arg_type == A_SINGLE) {
 770                 cmd->c_stab  = arg[1].arg_ptr.arg_stab;
 771                 if (dowarn) {
 772                     STR *str = arg[2].arg_ptr.arg_str;
 773
 774                     if ((!str->str_nok && !looks_like_number(str)))
 775                         warn("Possible use of == on string value");
 776                 }
 777                 cmd->c_short = str_nmake(str_gnum(arg[2].arg_ptr.arg_str));
 778                 cmd->c_slen = arg->arg_type;
 779                 sure |= CF_NESURE|CF_EQSURE;
 780                 if (context & 1) {      /* only sure if thing is false */
 781                     sure &= ~CF_EQSURE;
 782                 }
 783                 else if (context & 2) { /* only sure if thing is true */
 784                     sure &= ~CF_NESURE;
 785                 }
 786                 if (sure & (CF_EQSURE|CF_NESURE)) {
 787                     opt = CFT_NUMOP;
 788                     cmd->c_flags |= sure;
 789                 }
 790             }
 791         }
 792     }
 793     else if (arg->arg_type == O_ASSIGN &&
 794              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
 795              arg[1].arg_ptr.arg_stab == defstab &&
 796              arg[2].arg_type == A_EXPR ) {
 797         arg2 = arg[2].arg_ptr.arg_arg;
 798         if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
 799             opt = CFT_GETS;
 800             cmd->c_stab = arg2[1].arg_ptr.arg_stab;
 801             if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
 802                 free_arg(arg2);
 803                 arg[2].arg_ptr.arg_arg = Nullarg;
 804                 free_arg(arg);
 805                 cmd->c_expr = Nullarg;
 806             }
 807         }
 808     }
 809     else if (arg->arg_type == O_CHOP &&
 810              (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) ) {
 811         opt = CFT_CHOP;
 812         cmd->c_stab = arg[1].arg_ptr.arg_stab;
 813         free_arg(arg);
 814         cmd->c_expr = Nullarg;
 815     }
 816     if (context & 4)
 817         opt |= CF_FLIP;
 818     cmd->c_flags |= opt;
 819
 820     if (cmd->c_flags & CF_FLIP) {
 821         if (fliporflop == 1) {
 822             arg = cmd->c_expr;  /* get back to O_FLIP arg */
 823             New(110,arg[3].arg_ptr.arg_cmd, 1, CMD);
 824             Copy(cmd, arg[3].arg_ptr.arg_cmd, 1, CMD);
 825             New(111,arg[4].arg_ptr.arg_cmd,1,CMD);
 826             Copy(cmd, arg[4].arg_ptr.arg_cmd, 1, CMD);
 827             opt_arg(arg[4].arg_ptr.arg_cmd,2,acmd);
 828             arg->arg_len = 2;           /* this is a lie */
 829         }
 830         else {
 831             if ((opt & CF_OPTIMIZE) == CFT_EVAL)
 832                 cmd->c_flags = (cmd->c_flags & ~CF_OPTIMIZE) | CFT_UNFLIP;
 833         }
 834     }
 835 }
 836
 837 CMD *
 838 add_label(lbl,cmd)
 839 char *lbl;
 840 register CMD *cmd;
 841 {
 842     if (cmd)
 843         cmd->c_label = lbl;
 844     return cmd;
 845 }
 846
 847 CMD *
 848 addcond(cmd, arg)
 849 register CMD *cmd;
 850 register ARG *arg;
 851 {
 852     cmd->c_expr = arg;
 853     cmd->c_flags |= CF_COND;
 854     return cmd;
 855 }
 856
 857 CMD *
 858 addloop(cmd, arg)
 859 register CMD *cmd;
 860 register ARG *arg;
 861 {
 862     void while_io();
 863
 864     cmd->c_expr = arg;
 865     cmd->c_flags |= CF_COND|CF_LOOP;
 866
 867     if (!(cmd->c_flags & CF_INVERT))
 868         while_io(cmd);          /* add $_ =, if necessary */
 869
 870     if (cmd->c_type == C_BLOCK)
 871         cmd->c_flags &= ~CF_COND;
 872     else {
 873         arg = cmd->ucmd.acmd.ac_expr;
 874         if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
 875             cmd->c_flags &= ~CF_COND;  /* "do {} while" happens at least once */
 876         if (arg && (arg->arg_flags & AF_DEPR) &&
 877           (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
 878             cmd->c_flags &= ~CF_COND;  /* likewise for "do subr() while" */
 879     }
 880     return cmd;
 881 }
 882
 883 CMD *
 884 invert(cmd)
 885 CMD *cmd;
 886 {
 887     register CMD *targ = cmd;
 888     if (targ->c_head)
 889         targ = targ->c_head;
 890     if (targ->c_flags & CF_DBSUB)
 891         targ = targ->c_next;
 892     targ->c_flags ^= CF_INVERT;
 893     return cmd;
 894 }
 895
 896 yyerror(s)
 897 char *s;
 898 {
 899     char tmpbuf[258];
 900     char tmp2buf[258];
 901     char *tname = tmpbuf;
 902
 903     if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
 904       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
 905         while (isspace(*oldoldbufptr))
 906             oldoldbufptr++;
 907         strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
 908         tmp2buf[bufptr - oldoldbufptr] = '\0';
 909         sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
 910     }
 911     else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
 912       oldbufptr != bufptr) {
 913         while (isspace(*oldbufptr))
 914             oldbufptr++;
 915         strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
 916         tmp2buf[bufptr - oldbufptr] = '\0';
 917         sprintf(tname,"next token \"%s\"",tmp2buf);
 918     }
 919     else if (yychar > 256)
 920         tname = "next token ???";
 921     else if (!yychar)
 922         (void)strcpy(tname,"at EOF");
 923     else if (yychar < 32)
 924         (void)sprintf(tname,"next char ^%c",yychar+64);
 925     else if (yychar == 127)
 926         (void)strcpy(tname,"at EOF");
 927     else
 928         (void)sprintf(tname,"next char %c",yychar);
 929     (void)sprintf(buf, "%s in file %s at line %d, %s\n",
 930       s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
 931     if (curcmd->c_line == multi_end && multi_start < multi_end)
 932         sprintf(buf+strlen(buf),
 933           "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
 934           multi_open,multi_close,multi_start);
 935     if (in_eval)
 936         str_cat(stab_val(stabent("@",TRUE)),buf);
 937     else
 938         fputs(buf,stderr);
 939     if (++error_count >= 10)
 940         fatal("%s has too many errors.\n",
 941         stab_val(curcmd->c_filestab)->str_ptr);
 942 }
 943
 944 void
 945 while_io(cmd)
 946 register CMD *cmd;
 947 {
 948     register ARG *arg = cmd->c_expr;
 949     STAB *asgnstab;
 950
 951     /* hoist "while (<channel>)" up into command block */
 952
 953     if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_READ) {
 954         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
 955         cmd->c_flags |= CFT_GETS;       /* and set it to do the input */
 956         cmd->c_stab = arg[1].arg_ptr.arg_stab;
 957         if (stab_io(arg[1].arg_ptr.arg_stab)->flags & IOF_ARGV) {
 958             cmd->c_expr = l(make_op(O_ASSIGN, 2,        /* fake up "$_ =" */
 959                stab2arg(A_LVAL,defstab), arg, Nullarg));
 960         }
 961         else {
 962             free_arg(arg);
 963             cmd->c_expr = Nullarg;
 964         }
 965     }
 966     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_INDREAD) {
 967         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
 968         cmd->c_flags |= CFT_INDGETS;    /* and set it to do the input */
 969         cmd->c_stab = arg[1].arg_ptr.arg_stab;
 970         free_arg(arg);
 971         cmd->c_expr = Nullarg;
 972     }
 973     else if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_GLOB) {
 974         if ((cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY)
 975             asgnstab = cmd->c_stab;
 976         else
 977             asgnstab = defstab;
 978         cmd->c_expr = l(make_op(O_ASSIGN, 2,    /* fake up "$foo =" */
 979            stab2arg(A_LVAL,asgnstab), arg, Nullarg));
 980         cmd->c_flags &= ~CF_OPTIMIZE;   /* clear optimization type */
 981     }
 982 }
 983
 984 CMD *
 985 wopt(cmd)
 986 register CMD *cmd;
 987 {
 988     register CMD *tail;
 989     CMD *newtail;
 990     register int i;
 991
 992     if (cmd->c_expr && (cmd->c_flags & CF_OPTIMIZE) == CFT_FALSE)
 993         opt_arg(cmd,1, cmd->c_type == C_EXPR);
 994
 995     while_io(cmd);              /* add $_ =, if necessary */
 996
 997     /* First find the end of the true list */
 998
 999     tail = cmd->ucmd.ccmd.cc_true;
1000     if (tail == Nullcmd)
1001         return cmd;
1002     New(112,newtail, 1, CMD);   /* guaranteed continue */
1003     for (;;) {
1004         /* optimize "next" to point directly to continue block */
1005         if (tail->c_type == C_EXPR &&
1006             tail->ucmd.acmd.ac_expr &&
1007             tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1008             (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1009              (cmd->c_label &&
1010               strEQ(cmd->c_label,
1011                     tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1012         {
1013             arg_free(tail->ucmd.acmd.ac_expr);
1014             tail->ucmd.acmd.ac_expr = Nullarg;
1015             tail->c_type = C_NEXT;
1016             if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1017                 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1018             else
1019                 tail->ucmd.ccmd.cc_alt = newtail;
1020             tail->ucmd.ccmd.cc_true = Nullcmd;
1021         }
1022         else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1023             if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
1024                 tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
1025             else
1026                 tail->ucmd.ccmd.cc_alt = newtail;
1027         }
1028         else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1029             if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1030                 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1031                     if (!tail->ucmd.scmd.sc_next[i])
1032                         tail->ucmd.scmd.sc_next[i] = cmd->ucmd.ccmd.cc_alt;
1033             }
1034             else {
1035                 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1036                     if (!tail->ucmd.scmd.sc_next[i])
1037                         tail->ucmd.scmd.sc_next[i] = newtail;
1038             }
1039         }
1040
1041         if (!tail->c_next)
1042             break;
1043         tail = tail->c_next;
1044     }
1045
1046     /* if there's a continue block, link it to true block and find end */
1047
1048     if (cmd->ucmd.ccmd.cc_alt != Nullcmd) {
1049         tail->c_next = cmd->ucmd.ccmd.cc_alt;
1050         tail = tail->c_next;
1051         for (;;) {
1052             /* optimize "next" to point directly to continue block */
1053             if (tail->c_type == C_EXPR &&
1054                 tail->ucmd.acmd.ac_expr &&
1055                 tail->ucmd.acmd.ac_expr->arg_type == O_NEXT &&
1056                 (tail->ucmd.acmd.ac_expr->arg_len == 0 ||
1057                  (cmd->c_label &&
1058                   strEQ(cmd->c_label,
1059                         tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
1060             {
1061                 arg_free(tail->ucmd.acmd.ac_expr);
1062                 tail->ucmd.acmd.ac_expr = Nullarg;
1063                 tail->c_type = C_NEXT;
1064                 tail->ucmd.ccmd.cc_alt = newtail;
1065                 tail->ucmd.ccmd.cc_true = Nullcmd;
1066             }
1067             else if (tail->c_type == C_IF && !tail->ucmd.ccmd.cc_alt) {
1068                 tail->ucmd.ccmd.cc_alt = newtail;
1069             }
1070             else if (tail->c_type == C_CSWITCH || tail->c_type == C_NSWITCH) {
1071                 for (i = tail->ucmd.scmd.sc_max; i >= 0; i--)
1072                     if (!tail->ucmd.scmd.sc_next[i])
1073                         tail->ucmd.scmd.sc_next[i] = newtail;
1074             }
1075
1076             if (!tail->c_next)
1077                 break;
1078             tail = tail->c_next;
1079         }
1080         for ( ; tail->c_next; tail = tail->c_next) ;
1081     }
1082
1083     /* Here's the real trick: link the end of the list back to the beginning,
1084      * inserting a "last" block to break out of the loop.  This saves one or
1085      * two procedure calls every time through the loop, because of how cmd_exec
1086      * does tail recursion.
1087      */
1088
1089     tail->c_next = newtail;
1090     tail = newtail;
1091     if (!cmd->ucmd.ccmd.cc_alt)
1092         cmd->ucmd.ccmd.cc_alt = tail;   /* every loop has a continue now */
1093
1094 #ifndef lint
1095     (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
1096 #endif
1097     tail->c_type = C_EXPR;
1098     tail->c_flags ^= CF_INVERT;         /* turn into "last unless" */
1099     tail->c_next = tail->ucmd.ccmd.cc_true;     /* loop directly back to top */
1100     tail->ucmd.acmd.ac_expr = make_op(O_LAST,0,Nullarg,Nullarg,Nullarg);
1101     tail->ucmd.acmd.ac_stab = Nullstab;
1102     return cmd;
1103 }
1104
1105 CMD *
1106 over(eachstab,cmd)
1107 STAB *eachstab;
1108 register CMD *cmd;
1109 {
1110     /* hoist "for $foo (@bar)" up into command block */
1111
1112     cmd->c_flags &= ~CF_OPTIMIZE;       /* clear optimization type */
1113     cmd->c_flags |= CFT_ARRAY;          /* and set it to do the iteration */
1114     cmd->c_stab = eachstab;
1115     cmd->c_short = str_new(0);          /* just to save a field in struct cmd */
1116     cmd->c_short->str_u.str_useful = -1;
1117
1118     return cmd;
1119 }
1120
1121 cmd_free(cmd)
1122 register CMD *cmd;
1123 {
1124     register CMD *tofree;
1125     register CMD *head = cmd;
1126
1127     while (cmd) {
1128         if (cmd->c_type != C_WHILE) {   /* WHILE block is duplicated */
1129             if (cmd->c_label) {
1130                 Safefree(cmd->c_label);
1131                 cmd->c_label = Nullch;
1132             }
1133             if (cmd->c_short) {
1134                 str_free(cmd->c_short);
1135                 cmd->c_short = Nullstr;
1136             }
1137             if (cmd->c_expr) {
1138                 arg_free(cmd->c_expr);
1139                 cmd->c_expr = Nullarg;
1140             }
1141         }
1142         switch (cmd->c_type) {
1143         case C_WHILE:
1144         case C_BLOCK:
1145         case C_ELSE:
1146         case C_IF:
1147             if (cmd->ucmd.ccmd.cc_true) {
1148                 cmd_free(cmd->ucmd.ccmd.cc_true);
1149                 cmd->ucmd.ccmd.cc_true = Nullcmd;
1150             }
1151             break;
1152         case C_EXPR:
1153             if (cmd->ucmd.acmd.ac_expr) {
1154                 arg_free(cmd->ucmd.acmd.ac_expr);
1155                 cmd->ucmd.acmd.ac_expr = Nullarg;
1156             }
1157             break;
1158         }
1159         tofree = cmd;
1160         cmd = cmd->c_next;
1161         if (tofree != head)             /* to get Saber to shut up */
1162             Safefree(tofree);
1163         if (cmd && cmd == head)         /* reached end of while loop */
1164             break;
1165     }
1166     Safefree(head);
1167 }
1168
1169 arg_free(arg)
1170 register ARG *arg;
1171 {
1172     register int i;
1173
1174     for (i = 1; i <= arg->arg_len; i++) {
1175         switch (arg[i].arg_type & A_MASK) {
1176         case A_NULL:
1177             if (arg->arg_type == O_TRANS) {
1178                 Safefree(arg[i].arg_ptr.arg_cval);
1179                 arg[i].arg_ptr.arg_cval = Nullch;
1180             }
1181             break;
1182         case A_LEXPR:
1183             if (arg->arg_type == O_AASSIGN &&
1184               arg[i].arg_ptr.arg_arg->arg_type == O_LARRAY) {
1185                 char *name =
1186                   stab_name(arg[i].arg_ptr.arg_arg[1].arg_ptr.arg_stab);
1187
1188                 if (strnEQ("_GEN_",name, 5))    /* array for foreach */
1189                     hdelete(defstash,name,strlen(name));
1190             }
1191             /* FALL THROUGH */
1192         case A_EXPR:
1193             arg_free(arg[i].arg_ptr.arg_arg);
1194             arg[i].arg_ptr.arg_arg = Nullarg;
1195             break;
1196         case A_CMD:
1197             cmd_free(arg[i].arg_ptr.arg_cmd);
1198             arg[i].arg_ptr.arg_cmd = Nullcmd;
1199             break;
1200         case A_WORD:
1201         case A_STAB:
1202         case A_LVAL:
1203         case A_READ:
1204         case A_GLOB:
1205         case A_ARYLEN:
1206         case A_LARYLEN:
1207         case A_ARYSTAB:
1208         case A_LARYSTAB:
1209             break;
1210         case A_SINGLE:
1211         case A_DOUBLE:
1212         case A_BACKTICK:
1213             str_free(arg[i].arg_ptr.arg_str);
1214             arg[i].arg_ptr.arg_str = Nullstr;
1215             break;
1216         case A_SPAT:
1217             spat_free(arg[i].arg_ptr.arg_spat);
1218             arg[i].arg_ptr.arg_spat = Nullspat;
1219             break;
1220         }
1221     }
1222     free_arg(arg);
1223 }
1224
1225 spat_free(spat)
1226 register SPAT *spat;
1227 {
1228     register SPAT *sp;
1229     HENT *entry;
1230
1231     if (spat->spat_runtime) {
1232         arg_free(spat->spat_runtime);
1233         spat->spat_runtime = Nullarg;
1234     }
1235     if (spat->spat_repl) {
1236         arg_free(spat->spat_repl);
1237         spat->spat_repl = Nullarg;
1238     }
1239     if (spat->spat_short) {
1240         str_free(spat->spat_short);
1241         spat->spat_short = Nullstr;
1242     }
1243     if (spat->spat_regexp) {
1244         regfree(spat->spat_regexp);
1245         spat->spat_regexp = Null(REGEXP*);
1246     }
1247
1248     /* now unlink from spat list */
1249
1250     for (entry = defstash->tbl_array['_']; entry; entry = entry->hent_next) {
1251         register HASH *stash;
1252         STAB *stab = (STAB*)entry->hent_val;
1253
1254         if (!stab)
1255             continue;
1256         stash = stab_hash(stab);
1257         if (!stash || stash->tbl_spatroot == Null(SPAT*))
1258             continue;
1259         if (stash->tbl_spatroot == spat)
1260             stash->tbl_spatroot = spat->spat_next;
1261         else {
1262             for (sp = stash->tbl_spatroot;
1263               sp && sp->spat_next != spat;
1264               sp = sp->spat_next)
1265                 ;
1266             if (sp)
1267                 sp->spat_next = spat->spat_next;
1268         }
1269     }
1270     Safefree(spat);
1271 }
1272
1273 /* Recursively descend a command sequence and push the address of any string
1274  * that needs saving on recursion onto the tosave array.
1275  */
1276
1277 static int
1278 cmd_tosave(cmd,willsave)
1279 register CMD *cmd;
1280 int willsave;                           /* willsave passes down the tree */
1281 {
1282     register CMD *head = cmd;
1283     int shouldsave = FALSE;             /* shouldsave passes up the tree */
1284     int tmpsave;
1285     register CMD *lastcmd = Nullcmd;
1286
1287     while (cmd) {
1288         if (cmd->c_expr)
1289             shouldsave |= arg_tosave(cmd->c_expr,willsave);
1290         switch (cmd->c_type) {
1291         case C_WHILE:
1292             if (cmd->ucmd.ccmd.cc_true) {
1293                 tmpsave = cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1294
1295                 /* Here we check to see if the temporary array generated for
1296                  * a foreach needs to be localized because of recursion.
1297                  */
1298                 if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
1299                     if (lastcmd &&
1300                       lastcmd->c_type == C_EXPR &&
1301                       lastcmd->c_expr) {
1302                         ARG *arg = lastcmd->c_expr;
1303
1304                         if (arg->arg_type == O_ASSIGN &&
1305                             arg[1].arg_type == A_LEXPR &&
1306                             arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
1307                             strnEQ("_GEN_",
1308                               stab_name(
1309                                 arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
1310                               5)) {     /* array generated for foreach */
1311                             (void)localize(arg);
1312                         }
1313                     }
1314
1315                     /* in any event, save the iterator */
1316
1317                     (void)apush(tosave,cmd->c_short);
1318                 }
1319                 shouldsave |= tmpsave;
1320             }
1321             break;
1322         case C_BLOCK:
1323         case C_ELSE:
1324         case C_IF:
1325             if (cmd->ucmd.ccmd.cc_true)
1326                 shouldsave |= cmd_tosave(cmd->ucmd.ccmd.cc_true,willsave);
1327             break;
1328         case C_EXPR:
1329             if (cmd->ucmd.acmd.ac_expr)
1330                 shouldsave |= arg_tosave(cmd->ucmd.acmd.ac_expr,willsave);
1331             break;
1332         }
1333         lastcmd = cmd;
1334         cmd = cmd->c_next;
1335         if (cmd && cmd == head)         /* reached end of while loop */
1336             break;
1337     }
1338     return shouldsave;
1339 }
1340
1341 static int
1342 arg_tosave(arg,willsave)
1343 register ARG *arg;
1344 int willsave;
1345 {
1346     register int i;
1347     int shouldsave = FALSE;
1348
1349     for (i = arg->arg_len; i >= 1; i--) {
1350         switch (arg[i].arg_type & A_MASK) {
1351         case A_NULL:
1352             break;
1353         case A_LEXPR:
1354         case A_EXPR:
1355             shouldsave |= arg_tosave(arg[i].arg_ptr.arg_arg,shouldsave);
1356             break;
1357         case A_CMD:
1358             shouldsave |= cmd_tosave(arg[i].arg_ptr.arg_cmd,shouldsave);
1359             break;
1360         case A_WORD:
1361         case A_STAB:
1362         case A_LVAL:
1363         case A_READ:
1364         case A_GLOB:
1365         case A_ARYLEN:
1366         case A_SINGLE:
1367         case A_DOUBLE:
1368         case A_BACKTICK:
1369             break;
1370         case A_SPAT:
1371             shouldsave |= spat_tosave(arg[i].arg_ptr.arg_spat);
1372             break;
1373         }
1374     }
1375     switch (arg->arg_type) {
1376     case O_RETURN:
1377         saw_return = TRUE;
1378         break;
1379     case O_EVAL:
1380     case O_SUBR:
1381         shouldsave = TRUE;
1382         break;
1383     }
1384     if (willsave)
1385         (void)apush(tosave,arg->arg_ptr.arg_str);
1386     return shouldsave;
1387 }
1388
1389 static int
1390 spat_tosave(spat)
1391 register SPAT *spat;
1392 {
1393     int shouldsave = FALSE;
1394
1395     if (spat->spat_runtime)
1396         shouldsave |= arg_tosave(spat->spat_runtime,FALSE);
1397     if (spat->spat_repl) {
1398         shouldsave |= arg_tosave(spat->spat_repl,FALSE);
1399     }
1400
1401     return shouldsave;
1402 }
1403