consarg.c

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