cons.c

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