cons.c

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