consarg.c

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