consarg.c

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