consarg.c

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