home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / perl / Source / C / Consarg < prev    next >
Encoding:
Text File  |  1991-02-09  |  27.5 KB  |  1,192 lines
  1. /* $Header: consarg.c,v 3.0.1.8 91/01/11 17:37:31 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:    consarg.c,v $
  9.  * Revision 3.0.1.8  91/01/11  17:37:31  lwall
  10.  * patch42: assignment to a slice didn't supply an array context to RHS
  11.  * patch42: suppressed variable suicide on local($a,$b) = @_
  12.  * 
  13.  * Revision 3.0.1.7  90/10/15  15:55:28  lwall
  14.  * patch29: defined @foo was behaving inconsistently
  15.  * patch29: -5 % 5 was wrong
  16.  * patch29: package behavior is now more consistent
  17.  * 
  18.  * Revision 3.0.1.6  90/08/09  02:38:51  lwall
  19.  * patch19: fixed problem with % of negative number
  20.  * 
  21.  * Revision 3.0.1.5  90/03/27  15:36:45  lwall
  22.  * patch16: support for machines that can't cast negative floats to unsigned ints
  23.  * 
  24.  * Revision 3.0.1.4  90/03/12  16:24:40  lwall
  25.  * patch13: return (@array) did counter-intuitive things
  26.  * 
  27.  * Revision 3.0.1.3  90/02/28  16:47:54  lwall
  28.  * patch9: the x operator is now up to 10 times faster
  29.  * patch9: @_ clobbered by ($foo,$bar) = split
  30.  * 
  31.  * Revision 3.0.1.2  89/11/17  15:11:34  lwall
  32.  * patch5: defined $foo{'bar'} should not create element
  33.  * 
  34.  * Revision 3.0.1.1  89/11/11  04:14:30  lwall
  35.  * patch2: '-' x 26 made warnings about undefined value
  36.  * patch2: eval with no args caused strangeness
  37.  * patch2: local(@foo) didn't work, but local(@foo,$bar) did
  38.  * 
  39.  * Revision 3.0  89/10/18  15:10:30  lwall
  40.  * 3.0 baseline
  41.  * 
  42.  */
  43.  
  44. #include "EXTERN.h"
  45. #include "perl.h"
  46.  
  47. #include <math.h>
  48.  
  49. static int nothing_in_common PROTO((ARG *, ARG *));
  50. static int arg_common PROTO((ARG *, int, int));
  51. static int spat_common PROTO((SPAT *, int, int));
  52.  
  53. ARG *
  54. make_split(stab,arg,limarg)
  55. register STAB *stab;
  56. register ARG *arg;
  57. ARG *limarg;
  58. {
  59.     register SPAT *spat;
  60.  
  61.     if (arg->arg_type != O_MATCH) {
  62.     Newz(201,spat,1,SPAT);
  63.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  64.     curstash->tbl_spatroot = spat;
  65.  
  66.     spat->spat_runtime = arg;
  67.     arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  68.     }
  69.     Renew(arg,4,ARG);
  70.     arg->arg_len = 3;
  71.     if (limarg) {
  72.     if (limarg->arg_type == O_ITEM) {
  73.         Copy(limarg+1,arg+3,1,ARG);
  74.         limarg[1].arg_type = A_NULL;
  75.         arg_free(limarg);
  76.     }
  77.     else {
  78.         arg[3].arg_flags = 0;
  79.         arg[3].arg_type = A_EXPR;
  80.         arg[3].arg_ptr.arg_arg = limarg;
  81.     }
  82.     }
  83.     else
  84.     arg[3].arg_type = A_NULL;
  85.     arg->arg_type = O_SPLIT;
  86.     spat = arg[2].arg_ptr.arg_spat;
  87.     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
  88.     if (spat->spat_short) {    /* exact match can bypass regexec() */
  89.     if (!((spat->spat_flags & SPAT_SCANFIRST) &&
  90.         (spat->spat_flags & SPAT_ALL) )) {
  91.         str_free(spat->spat_short);
  92.         spat->spat_short = Nullstr;
  93.     }
  94.     }
  95.     return arg;
  96. }
  97.  
  98. ARG *
  99. mod_match(type,left,pat)
  100. int type;
  101. register ARG *left;
  102. register ARG *pat;
  103. {
  104.  
  105.     register SPAT *spat;
  106.     register ARG *newarg;
  107.  
  108.     if (!pat)
  109.     return Nullarg;
  110.  
  111.     if ((pat->arg_type == O_MATCH ||
  112.      pat->arg_type == O_SUBST ||
  113.      pat->arg_type == O_TRANS ||
  114.      pat->arg_type == O_SPLIT
  115.     ) &&
  116.     pat[1].arg_ptr.arg_stab == defstab ) {
  117.     switch (pat->arg_type) {
  118.     case O_MATCH:
  119.         newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
  120.         pat->arg_len,
  121.         left,Nullarg,Nullarg);
  122.         break;
  123.     case O_SUBST:
  124.         newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
  125.         pat->arg_len,
  126.         left,Nullarg,Nullarg));
  127.         break;
  128.     case O_TRANS:
  129.         newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
  130.         pat->arg_len,
  131.         left,Nullarg,Nullarg));
  132.         break;
  133.     case O_SPLIT:
  134.         newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
  135.         pat->arg_len,
  136.         left,Nullarg,Nullarg);
  137.         break;
  138.     }
  139.     if (pat->arg_len >= 2) {
  140.         newarg[2].arg_type = pat[2].arg_type;
  141.         newarg[2].arg_ptr = pat[2].arg_ptr;
  142.         newarg[2].arg_flags = pat[2].arg_flags;
  143.         if (pat->arg_len >= 3) {
  144.         newarg[3].arg_type = pat[3].arg_type;
  145.         newarg[3].arg_ptr = pat[3].arg_ptr;
  146.         newarg[3].arg_flags = pat[3].arg_flags;
  147.         }
  148.     }
  149.     Safefree(pat);
  150.     }
  151.     else {
  152.     Newz(202,spat,1,SPAT);
  153.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  154.     curstash->tbl_spatroot = spat;
  155.  
  156.     spat->spat_runtime = pat;
  157.     newarg = make_op(type,2,left,Nullarg,Nullarg);
  158.     newarg[2].arg_type = A_SPAT | A_DONT;
  159.     newarg[2].arg_ptr.arg_spat = spat;
  160.     }
  161.  
  162.     return newarg;
  163. }
  164.  
  165. ARG *
  166. make_op(type,newlen,arg1,arg2,arg3)
  167. int type;
  168. int newlen;
  169. ARG *arg1;
  170. ARG *arg2;
  171. ARG *arg3;
  172. {
  173.     register ARG *arg;
  174.     register ARG *chld;
  175.     register unsigned doarg;
  176.     register int i;
  177.     extern ARG *arg4;    /* should be normal arguments, really */
  178.     extern ARG *arg5;
  179.  
  180.     arg = op_new(newlen);
  181.     arg->arg_type = type;
  182.     if ((chld = arg1) != Nullarg) {
  183.     if (chld->arg_type == O_ITEM &&
  184.         (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
  185.          (i == A_LEXPR &&
  186.           (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  187.            chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  188.            chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
  189.     {
  190.         arg[1].arg_type = chld[1].arg_type;
  191.         arg[1].arg_ptr = chld[1].arg_ptr;
  192.         arg[1].arg_flags |= chld[1].arg_flags;
  193.         arg[1].arg_len = chld[1].arg_len;
  194.         free_arg(chld);
  195.     }
  196.     else {
  197.         arg[1].arg_type = A_EXPR;
  198.         arg[1].arg_ptr.arg_arg = chld;
  199.     }
  200.     }
  201.     if ((chld = arg2) != Nullarg) {
  202.     if (chld->arg_type == O_ITEM && 
  203.         (hoistable[chld[1].arg_type&A_MASK] || 
  204.          (type == O_ASSIGN && 
  205.           ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  206.         ||
  207.            (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
  208.         ||
  209.            (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
  210.           ) ) ) ) {
  211.         arg[2].arg_type = chld[1].arg_type;
  212.         arg[2].arg_ptr = chld[1].arg_ptr;
  213.         arg[2].arg_len = chld[1].arg_len;
  214.         free_arg(chld);
  215.     }
  216.     else {
  217.         arg[2].arg_type = A_EXPR;
  218.         arg[2].arg_ptr.arg_arg = chld;
  219.     }
  220.     }
  221.     if ((chld = arg3) != Nullarg) {
  222.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  223.         arg[3].arg_type = chld[1].arg_type;
  224.         arg[3].arg_ptr = chld[1].arg_ptr;
  225.         arg[3].arg_len = chld[1].arg_len;
  226.         free_arg(chld);
  227.     }
  228.     else {
  229.         arg[3].arg_type = A_EXPR;
  230.         arg[3].arg_ptr.arg_arg = chld;
  231.     }
  232.     }
  233.     if (newlen >= 4 && (chld = arg4) != Nullarg) {
  234.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  235.         arg[4].arg_type = chld[1].arg_type;
  236.         arg[4].arg_ptr = chld[1].arg_ptr;
  237.         arg[4].arg_len = chld[1].arg_len;
  238.         free_arg(chld);
  239.     }
  240.     else {
  241.         arg[4].arg_type = A_EXPR;
  242.         arg[4].arg_ptr.arg_arg = chld;
  243.     }
  244.     }
  245.     if (newlen >= 5 && (chld = arg5) != Nullarg) {
  246.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  247.         arg[5].arg_type = chld[1].arg_type;
  248.         arg[5].arg_ptr = chld[1].arg_ptr;
  249.         arg[5].arg_len = chld[1].arg_len;
  250.         free_arg(chld);
  251.     }
  252.     else {
  253.         arg[5].arg_type = A_EXPR;
  254.         arg[5].arg_ptr.arg_arg = chld;
  255.     }
  256.     }
  257.     doarg = opargs[type];
  258.     for (i = 1; i <= newlen; ++i) {
  259.     if (!(doarg & 1))
  260.         arg[i].arg_type |= A_DONT;
  261.     if (doarg & 2)
  262.         arg[i].arg_flags |= AF_ARYOK;
  263.     doarg >>= 2;
  264.     }
  265. #ifdef DEBUGGING
  266.     if (debug & 16) {
  267.     fprintf(stderr,"%p <= make_op(%s",arg,opname[arg->arg_type]);
  268.     if (arg1)
  269.         fprintf(stderr,",%s=%p",
  270.         argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
  271.     if (arg2)
  272.         fprintf(stderr,",%s=%p",
  273.         argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
  274.     if (arg3)
  275.         fprintf(stderr,",%s=%p",
  276.         argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
  277.     if (newlen >= 4)
  278.         fprintf(stderr,",%s=%p",
  279.         argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
  280.     if (newlen >= 5)
  281.         fprintf(stderr,",%s=%p",
  282.         argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
  283.     fprintf(stderr,")\n");
  284.     }
  285. #endif
  286.     evalstatic(arg);        /* see if we can consolidate anything */
  287.     return arg;
  288. }
  289.  
  290. void
  291. evalstatic(arg)
  292. register ARG *arg;
  293. {
  294.     register STR *str;
  295.     register STR *s1;
  296.     register STR *s2;
  297.     double value;        /* must not be register */
  298.     register char *tmps;
  299.     int i;
  300.     unsigned long tmplong;
  301.     long tmp2;
  302.  
  303.     if (!arg || !arg->arg_len)
  304.     return;
  305.  
  306.     if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) &&
  307.         (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
  308.     str = Str_new(20,0);
  309.     s1 = arg[1].arg_ptr.arg_str;
  310.     if (arg->arg_len > 1)
  311.         s2 = arg[2].arg_ptr.arg_str;
  312.     else
  313.         s2 = Nullstr;
  314.     switch (arg->arg_type) {
  315.     case O_AELEM:
  316.         i = (int)str_gnum(s2);
  317.         if (i < 32767 && i >= 0) {
  318.         arg->arg_type = O_ITEM;
  319.         arg->arg_len = 1;
  320.         arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
  321.         arg[1].arg_len = i;
  322.         str_free(s2);
  323.         }
  324.         /* FALL THROUGH */
  325.     default:
  326.         str_free(str);
  327.         str = Nullstr;        /* can't be evaluated yet */
  328.         break;
  329.     case O_CONCAT:
  330.         str_sset(str,s1);
  331.         str_scat(str,s2);
  332.         break;
  333.     case O_REPEAT:
  334.         i = (int)str_gnum(s2);
  335.         tmps = str_get(s1);
  336.         str_nset(str,"",0);
  337.         STR_GROW(str, i * s1->str_cur + 1);
  338.         repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
  339.         str->str_cur = i * s1->str_cur;
  340.         str->str_ptr[str->str_cur] = '\0';
  341.         break;
  342.     case O_MULTIPLY:
  343.         value = str_gnum(s1);
  344.         str_numset(str,value * str_gnum(s2));
  345.         break;
  346.     case O_DIVIDE:
  347.         value = str_gnum(s2);
  348.         if (value == 0.0)
  349.         yyerror("Illegal division by constant zero");
  350.         else
  351.         str_numset(str,str_gnum(s1) / value);
  352.         break;
  353.     case O_MODULO:
  354.         tmplong = (unsigned long)str_gnum(s2);
  355.         if (tmplong == 0L) {
  356.         yyerror("Illegal modulus of constant zero");
  357.         break;
  358.         }
  359.         tmp2 = (long)str_gnum(s1);
  360. #ifndef lint
  361.         if (tmp2 >= 0)
  362.         str_numset(str,(double)(tmp2 % tmplong));
  363.         else
  364.         str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  365. #else
  366.         tmp2 = tmp2;
  367. #endif
  368.         break;
  369.     case O_ADD:
  370.         value = str_gnum(s1);
  371.         str_numset(str,value + str_gnum(s2));
  372.         break;
  373.     case O_SUBTRACT:
  374.         value = str_gnum(s1);
  375.         str_numset(str,value - str_gnum(s2));
  376.         break;
  377.     case O_LEFT_SHIFT:
  378.         value = str_gnum(s1);
  379.         i = (int)str_gnum(s2);
  380. #ifndef lint
  381.         str_numset(str,(double)(((long)value) << i));
  382. #endif
  383.         break;
  384.     case O_RIGHT_SHIFT:
  385.         value = str_gnum(s1);
  386.         i = (int)str_gnum(s2);
  387. #ifndef lint
  388.         str_numset(str,(double)(((long)value) >> i));
  389. #endif
  390.         break;
  391.     case O_LT:
  392.         value = str_gnum(s1);
  393.         str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
  394.         break;
  395.     case O_GT:
  396.         value = str_gnum(s1);
  397.         str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
  398.         break;
  399.     case O_LE:
  400.         value = str_gnum(s1);
  401.         str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
  402.         break;
  403.     case O_GE:
  404.         value = str_gnum(s1);
  405.         str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
  406.         break;
  407.     case O_EQ:
  408.         if (dowarn) {
  409.         if ((!s1->str_nok && !looks_like_number(s1)) ||
  410.             (!s2->str_nok && !looks_like_number(s2)) )
  411.             warn("Possible use of == on string value");
  412.         }
  413.         value = str_gnum(s1);
  414.         str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
  415.         break;
  416.     case O_NE:
  417.         value = str_gnum(s1);
  418.         str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
  419.         break;
  420.     case O_NCMP:
  421.         value = str_gnum(s1);
  422.         value -= str_gnum(s2);
  423.         if (value > 0.0)
  424.         value = 1.0;
  425.         else if (value < 0.0)
  426.         value = -1.0;
  427.         str_numset(str,value);
  428.         break;
  429.     case O_BIT_AND:
  430.         value = str_gnum(s1);
  431. #ifndef lint
  432.         str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  433. #endif
  434.         break;
  435.     case O_XOR:
  436.         value = str_gnum(s1);
  437. #ifndef lint
  438.         str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  439. #endif
  440.         break;
  441.     case O_BIT_OR:
  442.         value = str_gnum(s1);
  443. #ifndef lint
  444.         str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  445. #endif
  446.         break;
  447.     case O_AND:
  448.         if (str_true(s1))
  449.         str_sset(str,s2);
  450.         else
  451.         str_sset(str,s1);
  452.         break;
  453.     case O_OR:
  454.         if (str_true(s1))
  455.         str_sset(str,s1);
  456.         else
  457.         str_sset(str,s2);
  458.         break;
  459.     case O_COND_EXPR:
  460.         if ((arg[3].arg_type & A_MASK) != A_SINGLE) {
  461.         str_free(str);
  462.         str = Nullstr;
  463.         }
  464.         else {
  465.         if (str_true(s1))
  466.             str_sset(str,s2);
  467.         else
  468.             str_sset(str,arg[3].arg_ptr.arg_str);
  469.         str_free(arg[3].arg_ptr.arg_str);
  470.         }
  471.         break;
  472.     case O_NEGATE:
  473.         str_numset(str,(double)(-str_gnum(s1)));
  474.         break;
  475.     case O_NOT:
  476.         str_numset(str,(double)(!str_true(s1)));
  477.         break;
  478.     case O_COMPLEMENT:
  479. #ifndef lint
  480.         str_numset(str,(double)(~U_L(str_gnum(s1))));
  481. #endif
  482.         break;
  483.     case O_SIN:
  484.         str_numset(str,sin(str_gnum(s1)));
  485.         break;
  486.     case O_COS:
  487.         str_numset(str,cos(str_gnum(s1)));
  488.         break;
  489.     case O_ATAN2:
  490.         value = str_gnum(s1);
  491.         str_numset(str,atan2(value, str_gnum(s2)));
  492.         break;
  493.     case O_POW:
  494.         value = str_gnum(s1);
  495.         str_numset(str,pow(value, str_gnum(s2)));
  496.         break;
  497.     case O_LENGTH:
  498.         str_numset(str, (double)str_len(s1));
  499.         break;
  500.     case O_SLT:
  501.         str_numset(str,(double)(str_cmp(s1,s2) < 0));
  502.         break;
  503.     case O_SGT:
  504.         str_numset(str,(double)(str_cmp(s1,s2) > 0));
  505.         break;
  506.     case O_SLE:
  507.         str_numset(str,(double)(str_cmp(s1,s2) <= 0));
  508.         break;
  509.     case O_SGE:
  510.         str_numset(str,(double)(str_cmp(s1,s2) >= 0));
  511.         break;
  512.     case O_SEQ:
  513.         str_numset(str,(double)(str_eq(s1,s2)));
  514.         break;
  515.     case O_SNE:
  516.         str_numset(str,(double)(!str_eq(s1,s2)));
  517.         break;
  518.     case O_SCMP:
  519.         str_numset(str,(double)(str_cmp(s1,s2)));
  520.         break;
  521.     case O_CRYPT:
  522. #ifdef CRYPT
  523.         tmps = str_get(s1);
  524.         str_set(str,crypt(tmps,str_get(s2)));
  525. #else
  526.         yyerror(
  527.         "The crypt() function is unimplemented due to excessive paranoia.");
  528. #endif
  529.         break;
  530.     case O_EXP:
  531.         str_numset(str,exp(str_gnum(s1)));
  532.         break;
  533.     case O_LOG:
  534.         str_numset(str,log(str_gnum(s1)));
  535.         break;
  536.     case O_SQRT:
  537.         str_numset(str,sqrt(str_gnum(s1)));
  538.         break;
  539.     case O_INT:
  540.         value = str_gnum(s1);
  541.         if (value >= 0.0)
  542.         (void)modf(value,&value);
  543.         else {
  544.         (void)modf(-value,&value);
  545.         value = -value;
  546.         }
  547.         str_numset(str,value);
  548.         break;
  549.     case O_ORD:
  550. #ifndef I286
  551.         str_numset(str,(double)(*str_get(s1)));
  552. #else
  553.         {
  554.         int  zapc;
  555.         char *zaps;
  556.  
  557.         zaps = str_get(s1);
  558.         zapc = (int) *zaps;
  559.         str_numset(str,(double)(zapc));
  560.         }
  561. #endif
  562.         break;
  563.     }
  564.     if (str) {
  565.         arg->arg_type = O_ITEM;    /* note arg1 type is already SINGLE */
  566.         str_free(s1);
  567.         str_free(s2);
  568.         arg[1].arg_ptr.arg_str = str;
  569.     }
  570.     }
  571. }
  572.  
  573. ARG *
  574. l(arg)
  575. register ARG *arg;
  576. {
  577.     register int i;
  578.     register ARG *arg1;
  579.     register ARG *arg2;
  580.     SPAT *spat;
  581.     int arghog = 0;
  582.  
  583.     i = arg[1].arg_type & A_MASK;
  584.  
  585.     arg->arg_flags |= AF_COMMON;    /* assume something in common */
  586.                     /* which forces us to copy things */
  587.  
  588.     if (i == A_ARYLEN) {
  589.     arg[1].arg_type = A_LARYLEN;
  590.     return arg;
  591.     }
  592.     if (i == A_ARYSTAB) {
  593.     arg[1].arg_type = A_LARYSTAB;
  594.     return arg;
  595.     }
  596.  
  597.     /* see if it's an array reference */
  598.  
  599.     if (i == A_EXPR || i == A_LEXPR) {
  600.     arg1 = arg[1].arg_ptr.arg_arg;
  601.  
  602.     if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
  603.                         /* assign to list */
  604.         if (arg->arg_len > 1) {
  605.         dehoist(arg,2);
  606.         arg2 = arg[2].arg_ptr.arg_arg;
  607.         if (nothing_in_common(arg1,arg2))
  608.             arg->arg_flags &= ~AF_COMMON;
  609.         if (arg->arg_type == O_ASSIGN) {
  610.             if (arg1->arg_flags & AF_LOCAL)
  611.             arg->arg_flags |= AF_LOCAL;
  612.             arg[1].arg_flags |= AF_ARYOK;
  613.             arg[2].arg_flags |= AF_ARYOK;
  614.         }
  615.         }
  616.         else if (arg->arg_type != O_CHOP)
  617.         arg->arg_type = O_ASSIGN;    /* possible local(); */
  618.         for (i = arg1->arg_len; i >= 1; i--) {
  619.         switch (arg1[i].arg_type) {
  620.         case A_STAR: case A_LSTAR:
  621.             arg1[i].arg_type = A_LSTAR;
  622.             break;
  623.         case A_STAB: case A_LVAL:
  624.             arg1[i].arg_type = A_LVAL;
  625.             break;
  626.         case A_ARYLEN: case A_LARYLEN:
  627.             arg1[i].arg_type = A_LARYLEN;
  628.             break;
  629.         case A_ARYSTAB: case A_LARYSTAB:
  630.             arg1[i].arg_type = A_LARYSTAB;
  631.             break;
  632.         case A_EXPR: case A_LEXPR:
  633.             arg1[i].arg_type = A_LEXPR;
  634.             switch(arg1[i].arg_ptr.arg_arg->arg_type) {
  635.             case O_ARRAY: case O_LARRAY:
  636.             arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
  637.             arghog = 1;
  638.             break;
  639.             case O_AELEM: case O_LAELEM:
  640.             arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
  641.             break;
  642.             case O_HASH: case O_LHASH:
  643.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
  644.             arghog = 1;
  645.             break;
  646.             case O_HELEM: case O_LHELEM:
  647.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
  648.             break;
  649.             case O_ASLICE: case O_LASLICE:
  650.             arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
  651.             break;
  652.             case O_HSLICE: case O_LHSLICE:
  653.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
  654.             break;
  655.             default:
  656.             goto ill_item;
  657.             }
  658.             break;
  659.         default:
  660.           ill_item:
  661.             (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
  662.               argname[arg1[i].arg_type&A_MASK]);
  663.             yyerror(tokenbuf);
  664.         }
  665.         }
  666.         if (arg->arg_len > 1) {
  667.         if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
  668.             arg2[3].arg_type = A_SINGLE;
  669.             arg2[3].arg_ptr.arg_str =
  670.               str_nmake((double)arg1->arg_len + 1); /* limit split len*/
  671.         }
  672.         }
  673.     }
  674.     else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
  675.         if (arg->arg_type == O_DEFINED)
  676.         arg1->arg_type = O_AELEM;
  677.         else
  678.         arg1->arg_type = O_LAELEM;
  679.     else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
  680.         arg1->arg_type = O_LARRAY;
  681.         if (arg->arg_len > 1) {
  682.         dehoist(arg,2);
  683.         arg2 = arg[2].arg_ptr.arg_arg;
  684.         if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
  685.             spat = arg2[2].arg_ptr.arg_spat;
  686.             if (!(spat->spat_flags & SPAT_ONCE) &&
  687.               nothing_in_common(arg1,spat->spat_repl)) {
  688.             spat->spat_repl[1].arg_ptr.arg_stab =
  689.                 arg1[1].arg_ptr.arg_stab;
  690.             spat->spat_flags |= SPAT_ONCE;
  691.             arg_free(arg1);    /* recursive */
  692.             free_arg(arg);    /* non-recursive */
  693.             return arg2;    /* split has builtin assign */
  694.             }
  695.         }
  696.         else if (nothing_in_common(arg1,arg2))
  697.             arg->arg_flags &= ~AF_COMMON;
  698.         if (arg->arg_type == O_ASSIGN) {
  699.             arg[1].arg_flags |= AF_ARYOK;
  700.             arg[2].arg_flags |= AF_ARYOK;
  701.         }
  702.         }
  703.         else if (arg->arg_type == O_ASSIGN)
  704.         arg[1].arg_flags |= AF_ARYOK;
  705.     }
  706.     else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
  707.         if (arg->arg_type == O_DEFINED)
  708.         arg1->arg_type = O_HELEM;    /* avoid creating one */
  709.         else
  710.         arg1->arg_type = O_LHELEM;
  711.     else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
  712.         arg1->arg_type = O_LHASH;
  713.         if (arg->arg_len > 1) {
  714.         dehoist(arg,2);
  715.         arg2 = arg[2].arg_ptr.arg_arg;
  716.         if (nothing_in_common(arg1,arg2))
  717.             arg->arg_flags &= ~AF_COMMON;
  718.         if (arg->arg_type == O_ASSIGN) {
  719.             arg[1].arg_flags |= AF_ARYOK;
  720.             arg[2].arg_flags |= AF_ARYOK;
  721.         }
  722.         }
  723.         else if (arg->arg_type == O_ASSIGN)
  724.         arg[1].arg_flags |= AF_ARYOK;
  725.     }
  726.     else if (arg1->arg_type == O_ASLICE) {
  727.         arg1->arg_type = O_LASLICE;
  728.         if (arg->arg_type == O_ASSIGN) {
  729.         dehoist(arg,2);
  730.         arg[1].arg_flags |= AF_ARYOK;
  731.         arg[2].arg_flags |= AF_ARYOK;
  732.         }
  733.     }
  734.     else if (arg1->arg_type == O_HSLICE) {
  735.         arg1->arg_type = O_LHSLICE;
  736.         if (arg->arg_type == O_ASSIGN) {
  737.         dehoist(arg,2);
  738.         arg[1].arg_flags |= AF_ARYOK;
  739.         arg[2].arg_flags |= AF_ARYOK;
  740.         }
  741.     }
  742.     else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
  743.       (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
  744.         arg[1].arg_type |= A_DONT;
  745.     }
  746.     else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
  747.         (void)l(arg1);
  748.         Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
  749.             /* grow string struct to hold an lstring struct */
  750.     }
  751.     else if (arg1->arg_type == O_ASSIGN) {
  752.         if (arg->arg_type == O_CHOP)
  753.         arg[1].arg_flags &= ~AF_ARYOK;    /* grandfather chop idiom */
  754.     }
  755.     else {
  756.         (void)sprintf(tokenbuf,
  757.           "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
  758.         yyerror(tokenbuf);
  759.     }
  760.     arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
  761.     if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
  762.         arg[1].arg_flags |= AF_ARYOK;
  763.         if (arg->arg_len > 1)
  764.         arg[2].arg_flags |= AF_ARYOK;
  765.     }
  766. #ifdef DEBUGGING
  767.     if (debug & 16)
  768.         fprintf(stderr,"lval LEXPR\n");
  769. #endif
  770.     return arg;
  771.     }
  772.     if (i == A_STAR || i == A_LSTAR) {
  773.     arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
  774.     return arg;
  775.     }
  776.  
  777.     /* not an array reference, should be a register name */
  778.  
  779.     if (i != A_STAB && i != A_LVAL) {
  780.     (void)sprintf(tokenbuf,
  781.       "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
  782.     yyerror(tokenbuf);
  783.     }
  784.     arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
  785. #ifdef DEBUGGING
  786.     if (debug & 16)
  787.     fprintf(stderr,"lval LVAL\n");
  788. #endif
  789.     return arg;
  790. }
  791.  
  792. ARG *
  793. fixl(type,arg)
  794. int type;
  795. ARG *arg;
  796. {
  797.     if (type == O_DEFINED || type == O_UNDEF) {
  798.     if (arg->arg_type != O_ITEM)
  799.         arg = hide_ary(arg);
  800.     if (arg->arg_type == O_ITEM) {
  801.         type = arg[1].arg_type & A_MASK;
  802.         if (type == A_EXPR || type == A_LEXPR)
  803.         arg[1].arg_type = A_LEXPR|A_DONT;
  804.     }
  805.     }
  806.     return arg;
  807. }
  808.  
  809. void
  810. dehoist(arg,i)
  811. ARG *arg;
  812. int i;
  813. {
  814.     ARG *tmparg;
  815.  
  816.     if (arg[i].arg_type != A_EXPR) {    /* dehoist */
  817.     tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
  818.     tmparg[1] = arg[i];
  819.     arg[i].arg_ptr.arg_arg = tmparg;
  820.     arg[i].arg_type = A_EXPR;
  821.     }
  822. }
  823.  
  824. ARG *
  825. addflags(i,flags,arg)
  826. int i;
  827. int flags;
  828. register ARG *arg;
  829. {
  830.     arg[i].arg_flags |= flags;
  831.     return arg;
  832. }
  833.  
  834. ARG *
  835. hide_ary(arg)
  836. ARG *arg;
  837. {
  838.     if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
  839.     return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
  840.     return arg;
  841. }
  842.  
  843. /* maybe do a join on multiple array dimensions */
  844.  
  845. ARG *
  846. jmaybe(arg)
  847. register ARG *arg;
  848. {
  849.     if (arg && arg->arg_type == O_COMMA) {
  850.     arg = listish(arg);
  851.     arg = make_op(O_JOIN, 2,
  852.         stab2arg(A_STAB,stabent(";",TRUE)),
  853.         make_list(arg),
  854.         Nullarg);
  855.     }
  856.     return arg;
  857. }
  858.  
  859. ARG *
  860. make_list(arg)
  861. register ARG *arg;
  862. {
  863.     register int i;
  864.     register ARG *node;
  865.     register ARG *nxtnode;
  866.     register int j;
  867.     STR *tmpstr;
  868.  
  869.     if (!arg) {
  870.     arg = op_new(0);
  871.     arg->arg_type = O_LIST;
  872.     }
  873.     if (arg->arg_type != O_COMMA) {
  874.     if (arg->arg_type != O_ARRAY)
  875.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  876.     return arg;
  877.     }
  878.     for (i = 2, node = arg; ; i++) {
  879.     if (node->arg_len < 2)
  880.         break;
  881.         if (node[1].arg_type != A_EXPR)
  882.         break;
  883.     node = node[1].arg_ptr.arg_arg;
  884.     if (node->arg_type != O_COMMA)
  885.         break;
  886.     }
  887.     if (i > 2) {
  888.     node = arg;
  889.     arg = op_new(i);
  890.     tmpstr = arg->arg_ptr.arg_str;
  891. #ifdef STRUCTCOPY
  892.     *arg = *node;        /* copy everything except the STR */
  893. #else
  894.     (void)bcopy((char *)node, (char *)arg, sizeof(ARG));
  895. #endif
  896.     arg->arg_ptr.arg_str = tmpstr;
  897.     for (j = i; ; ) {
  898. #ifdef STRUCTCOPY
  899.         arg[j] = node[2];
  900. #else
  901.         (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
  902. #endif
  903.         arg[j].arg_flags |= AF_ARYOK;
  904.         --j;        /* Bug in Xenix compiler */
  905.         if (j < 2) {
  906. #ifdef STRUCTCOPY
  907.         arg[1] = node[1];
  908. #else
  909.         (void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
  910. #endif
  911.         free_arg(node);
  912.         break;
  913.         }
  914.         nxtnode = node[1].arg_ptr.arg_arg;
  915.         free_arg(node);
  916.         node = nxtnode;
  917.     }
  918.     }
  919.     arg[1].arg_flags |= AF_ARYOK;
  920.     arg[2].arg_flags |= AF_ARYOK;
  921.     arg->arg_type = O_LIST;
  922.     arg->arg_len = i;
  923.     return arg;
  924. }
  925.  
  926. /* turn a single item into a list */
  927.  
  928. ARG *
  929. listish(arg)
  930. ARG *arg;
  931. {
  932.     if (arg->arg_flags & AF_LISTISH)
  933.     arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
  934.     return arg;
  935. }
  936.  
  937. ARG *
  938. maybelistish(optype, arg)
  939. int optype;
  940. ARG *arg;
  941. {
  942.     ARG *tmparg = arg;
  943.  
  944.     if (optype == O_RETURN && arg->arg_type == O_ITEM &&
  945.       arg[1].arg_type == A_EXPR &&
  946.       (tmparg = arg[1].arg_ptr.arg_arg) != Nullarg &&
  947.       ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
  948.     tmparg = listish(tmparg);
  949.     free_arg(arg);
  950.     arg = tmparg;
  951.     }
  952.     else if (optype == O_PRTF ||
  953.       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
  954.        arg->arg_type == O_F_OR_R) )
  955.     arg = listish(arg);
  956.     return arg;
  957. }
  958.  
  959. /* mark list of local variables */
  960.  
  961. ARG *
  962. localize(arg)
  963. ARG *arg;
  964. {
  965.     arg->arg_flags |= AF_LOCAL;
  966.     return arg;
  967. }
  968.  
  969. ARG *
  970. rcatmaybe(arg)
  971. ARG *arg;
  972. {
  973.     if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_READ) {
  974.     arg->arg_type = O_RCAT;    
  975.     arg[2].arg_type = arg[2].arg_ptr.arg_arg[1].arg_type;
  976.     arg[2].arg_ptr = arg[2].arg_ptr.arg_arg[1].arg_ptr;
  977.     free_arg(arg[2].arg_ptr.arg_arg);
  978.     }
  979.     return arg;
  980. }
  981.  
  982. ARG *
  983. stab2arg(atype,stab)
  984. int atype;
  985. register STAB *stab;
  986. {
  987.     register ARG *arg;
  988.  
  989.     arg = op_new(1);
  990.     arg->arg_type = O_ITEM;
  991.     arg[1].arg_type = atype;
  992.     arg[1].arg_ptr.arg_stab = stab;
  993.     return arg;
  994. }
  995.  
  996. ARG *
  997. cval_to_arg(cval)
  998. register char *cval;
  999. {
  1000.     register ARG *arg;
  1001.  
  1002.     arg = op_new(1);
  1003.     arg->arg_type = O_ITEM;
  1004.     arg[1].arg_type = A_SINGLE;
  1005.     arg[1].arg_ptr.arg_str = str_make(cval,0);
  1006.     Safefree(cval);
  1007.     return arg;
  1008. }
  1009.  
  1010. ARG *
  1011. op_new(numargs)
  1012. int numargs;
  1013. {
  1014.     register ARG *arg;
  1015.  
  1016.     Newz(203,arg, numargs + 1, ARG);
  1017.     arg->arg_ptr.arg_str = Str_new(21,0);
  1018.     arg->arg_len = numargs;
  1019.     return arg;
  1020. }
  1021.  
  1022. void
  1023. free_arg(arg)
  1024. ARG *arg;
  1025. {
  1026.     str_free(arg->arg_ptr.arg_str);
  1027.     Safefree(arg);
  1028. }
  1029.  
  1030. ARG *
  1031. make_match(type,expr,spat)
  1032. int type;
  1033. ARG *expr;
  1034. SPAT *spat;
  1035. {
  1036.     register ARG *arg;
  1037.  
  1038.     arg = make_op(type,2,expr,Nullarg,Nullarg);
  1039.  
  1040.     arg[2].arg_type = A_SPAT|A_DONT;
  1041.     arg[2].arg_ptr.arg_spat = spat;
  1042. #ifdef DEBUGGING
  1043.     if (debug & 16)
  1044.     fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
  1045. #endif
  1046.  
  1047.     if (type == O_SUBST || type == O_NSUBST) {
  1048.     if (arg[1].arg_type != A_STAB) {
  1049.         yyerror("Illegal lvalue");
  1050.     }
  1051.     arg[1].arg_type = A_LVAL;
  1052.     }
  1053.     return arg;
  1054. }
  1055.  
  1056. ARG *
  1057. cmd_to_arg(cmd)
  1058. CMD *cmd;
  1059. {
  1060.     register ARG *arg;
  1061.  
  1062.     arg = op_new(1);
  1063.     arg->arg_type = O_ITEM;
  1064.     arg[1].arg_type = A_CMD;
  1065.     arg[1].arg_ptr.arg_cmd = cmd;
  1066.     return arg;
  1067. }
  1068.  
  1069. /* Check two expressions to see if there is any identifier in common */
  1070.  
  1071. static int
  1072. nothing_in_common(arg1,arg2)
  1073. ARG *arg1;
  1074. ARG *arg2;
  1075. {
  1076.     static int thisexpr = 0;    /* I don't care if this wraps */
  1077.  
  1078.     thisexpr++;
  1079.     if (arg_common(arg1,thisexpr,1))
  1080.     return 0;    /* hit eval or do {} */
  1081.     stab_lastexpr(defstab) = thisexpr;        /* pretend to hit @_ */
  1082.     if (arg_common(arg2,thisexpr,0))
  1083.     return 0;    /* hit identifier again */
  1084.     return 1;
  1085. }
  1086.  
  1087. /* Recursively descend an expression and mark any identifier or check
  1088.  * it to see if it was marked already.
  1089.  */
  1090.  
  1091. static int
  1092. arg_common(arg,exprnum,marking)
  1093. register ARG *arg;
  1094. int exprnum;
  1095. int marking;
  1096. {
  1097.     register int i;
  1098.  
  1099.     if (!arg)
  1100.     return 0;
  1101.     for (i = arg->arg_len; i >= 1; i--) {
  1102.     switch (arg[i].arg_type & A_MASK) {
  1103.     case A_NULL:
  1104.         break;
  1105.     case A_LEXPR:
  1106.     case A_EXPR:
  1107.         if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
  1108.         return 1;
  1109.         break;
  1110.     case A_CMD:
  1111.         return 1;        /* assume hanky panky */
  1112.     case A_STAR:
  1113.     case A_LSTAR:
  1114.     case A_STAB:
  1115.     case A_LVAL:
  1116.     case A_ARYLEN:
  1117.     case A_LARYLEN:
  1118.         if (marking)
  1119.         stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
  1120.         else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
  1121.         return 1;
  1122.         break;
  1123.     case A_DOUBLE:
  1124.     case A_BACKTICK:
  1125.         {
  1126.         register char *s = arg[i].arg_ptr.arg_str->str_ptr;
  1127.         register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
  1128.         register STAB *stab;
  1129.  
  1130.         while (*s) {
  1131.             if (*s == '$' && s[1]) {
  1132.             s = scanreg(s,send,tokenbuf);
  1133.             stab = stabent(tokenbuf,TRUE);
  1134.             if (marking)
  1135.                 stab_lastexpr(stab) = exprnum;
  1136.             else if (stab_lastexpr(stab) == exprnum)
  1137.                 return 1;
  1138.             continue;
  1139.             }
  1140.             else if (*s == '\\' && s[1])
  1141.             s++;
  1142.             s++;
  1143.         }
  1144.         }
  1145.         break;
  1146.     case A_SPAT:
  1147.         if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
  1148.         return 1;
  1149.         break;
  1150.     case A_READ:
  1151.     case A_INDREAD:
  1152.     case A_GLOB:
  1153.     case A_WORD:
  1154.     case A_SINGLE:
  1155.         break;
  1156.     }
  1157.     }
  1158.     switch (arg->arg_type) {
  1159.     case O_ARRAY:
  1160.     case O_LARRAY:
  1161.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1162.         (void)aadd(arg[1].arg_ptr.arg_stab);
  1163.     break;
  1164.     case O_HASH:
  1165.     case O_LHASH:
  1166.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1167.         (void)hadd(arg[1].arg_ptr.arg_stab);
  1168.     break;
  1169.     case O_EVAL:
  1170.     case O_SUBR:
  1171.     case O_DBSUBR:
  1172.     return 1;
  1173.     }
  1174.     return 0;
  1175. }
  1176.  
  1177. static int
  1178. spat_common(spat,exprnum,marking)
  1179. register SPAT *spat;
  1180. int exprnum;
  1181. int marking;
  1182. {
  1183.     if (spat->spat_runtime)
  1184.     if (arg_common(spat->spat_runtime,exprnum,marking))
  1185.         return 1;
  1186.     if (spat->spat_repl) {
  1187.     if (arg_common(spat->spat_repl,exprnum,marking))
  1188.         return 1;
  1189.     }
  1190.     return 0;
  1191. }
  1192.