consarg.c

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