cons.c

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