consarg.c

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