consarg.c

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