cons.c

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