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