consarg.c

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