home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PERL4036.ZIP / consarg.c < prev    next >
C/C++ Source or Header  |  1993-02-08  |  29KB  |  1,290 lines

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