consarg.c

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