cons.c

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