consarg.c

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