consarg.c

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