cons.c

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