consarg.c

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