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