doarg.c

   1 /* $Header: doarg.c,v 3.0.1.3 90/02/28 16:56:58 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:        doarg.c,v $
   9  * Revision 3.0.1.3  90/02/28  16:56:58  lwall
  10  * patch9: split now can split into more than 10000 elements
  11  * patch9: sped up pack and unpack
  12  * patch9: pack of unsigned ints and longs blew up some places
  13  * patch9: sun3 can't cast negative float to unsigned int or long
  14  * patch9: local($.) didn't work
  15  * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
  16  * patch9: syscall returned stack size rather than value of system call
  17  *
  18  * Revision 3.0.1.2  89/12/21  19:52:15  lwall
  19  * patch7: a pattern wouldn't match a null string before the first character
  20  * patch7: certain patterns didn't match correctly at end of string
  21  *
  22  * Revision 3.0.1.1  89/11/11  04:17:20  lwall
  23  * patch2: printf %c, %D, %X and %O didn't work right
  24  * patch2: printf of unsigned vs signed needed separate casts on some machines
  25  *
  26  * Revision 3.0  89/10/18  15:10:41  lwall
  27  * 3.0 baseline
  28  *
  29  */
  30
  31 #include "EXTERN.h"
  32 #include "perl.h"
  33
  34 #include <signal.h>
  35
  36 extern unsigned char fold[];
  37
  38 int wantarray;
  39
  40 int
  41 do_subst(str,arg,sp)
  42 STR *str;
  43 ARG *arg;
  44 int sp;
  45 {
  46     register SPAT *spat;
  47     SPAT *rspat;
  48     register STR *dstr;
  49     register char *s = str_get(str);
  50     char *strend = s + str->str_cur;
  51     register char *m;
  52     char *c;
  53     register char *d;
  54     int clen;
  55     int iters = 0;
  56     int maxiters = (strend - s) + 10;
  57     register int i;
  58     bool once;
  59     char *orig;
  60     int safebase;
  61
  62     rspat = spat = arg[2].arg_ptr.arg_spat;
  63     if (!spat || !s)
  64         fatal("panic: do_subst");
  65     else if (spat->spat_runtime) {
  66         nointrp = "|)";
  67         (void)eval(spat->spat_runtime,G_SCALAR,sp);
  68         m = str_get(dstr = stack->ary_array[sp+1]);
  69         nointrp = "";
  70         if (spat->spat_regexp)
  71             regfree(spat->spat_regexp);
  72         spat->spat_regexp = regcomp(m,m+dstr->str_cur,
  73             spat->spat_flags & SPAT_FOLD,1);
  74         if (spat->spat_flags & SPAT_KEEP) {
  75             arg_free(spat->spat_runtime);       /* it won't change, so */
  76             spat->spat_runtime = Nullarg;       /* no point compiling again */
  77         }
  78     }
  79 #ifdef DEBUGGING
  80     if (debug & 8) {
  81         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
  82     }
  83 #endif
  84     safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
  85       !sawampersand);
  86     if (!*spat->spat_regexp->precomp && lastspat)
  87         spat = lastspat;
  88     orig = m = s;
  89     if (hint) {
  90         if (hint < s || hint > strend)
  91             fatal("panic: hint in do_match");
  92         s = hint;
  93         hint = Nullch;
  94         if (spat->spat_regexp->regback >= 0) {
  95             s -= spat->spat_regexp->regback;
  96             if (s < m)
  97                 s = m;
  98         }
  99         else
 100             s = m;
 101     }
 102     else if (spat->spat_short) {
 103         if (spat->spat_flags & SPAT_SCANFIRST) {
 104             if (str->str_pok & SP_STUDIED) {
 105                 if (screamfirst[spat->spat_short->str_rare] < 0)
 106                     goto nope;
 107                 else if (!(s = screaminstr(str,spat->spat_short)))
 108                     goto nope;
 109             }
 110 #ifndef lint
 111             else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
 112               spat->spat_short)))
 113                 goto nope;
 114 #endif
 115             if (s && spat->spat_regexp->regback >= 0) {
 116                 ++spat->spat_short->str_u.str_useful;
 117                 s -= spat->spat_regexp->regback;
 118                 if (s < m)
 119                     s = m;
 120             }
 121             else
 122                 s = m;
 123         }
 124         else if (!multiline && (*spat->spat_short->str_ptr != *s ||
 125           bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
 126             goto nope;
 127         if (--spat->spat_short->str_u.str_useful < 0) {
 128             str_free(spat->spat_short);
 129             spat->spat_short = Nullstr; /* opt is being useless */
 130         }
 131     }
 132     once = ((rspat->spat_flags & SPAT_ONCE) != 0);
 133     if (rspat->spat_flags & SPAT_CONST) {       /* known replacement string? */
 134         if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
 135             dstr = rspat->spat_repl[1].arg_ptr.arg_str;
 136         else {                                  /* constant over loop, anyway */
 137             (void)eval(rspat->spat_repl,G_SCALAR,sp);
 138             dstr = stack->ary_array[sp+1];
 139         }
 140         c = str_get(dstr);
 141         clen = dstr->str_cur;
 142         if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
 143                                         /* can do inplace substitution */
 144             if (regexec(spat->spat_regexp, s, strend, orig, 0,
 145               str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
 146                 if (spat->spat_regexp->subbase) /* oops, no we can't */
 147                     goto long_way;
 148                 d = s;
 149                 lastspat = spat;
 150                 str->str_pok = SP_VALID;        /* disable possible screamer */
 151                 if (once) {
 152                     m = spat->spat_regexp->startp[0];
 153                     d = spat->spat_regexp->endp[0];
 154                     s = orig;
 155                     if (m - s > strend - d) {   /* faster to shorten from end */
 156                         if (clen) {
 157                             (void)bcopy(c, m, clen);
 158                             m += clen;
 159                         }
 160                         i = strend - d;
 161                         if (i > 0) {
 162                             (void)bcopy(d, m, i);
 163                             m += i;
 164                         }
 165                         *m = '\0';
 166                         str->str_cur = m - s;
 167                         STABSET(str);
 168                         str_numset(arg->arg_ptr.arg_str, 1.0);
 169                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 170                         return sp;
 171                     }
 172                     else if (i = m - s) {       /* faster from front */
 173                         d -= clen;
 174                         m = d;
 175                         str_chop(str,d-i);
 176                         s += i;
 177                         while (i--)
 178                             *--d = *--s;
 179                         if (clen)
 180                             (void)bcopy(c, m, clen);
 181                         STABSET(str);
 182                         str_numset(arg->arg_ptr.arg_str, 1.0);
 183                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 184                         return sp;
 185                     }
 186                     else if (clen) {
 187                         d -= clen;
 188                         str_chop(str,d);
 189                         (void)bcopy(c,d,clen);
 190                         STABSET(str);
 191                         str_numset(arg->arg_ptr.arg_str, 1.0);
 192                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 193                         return sp;
 194                     }
 195                     else {
 196                         str_chop(str,d);
 197                         STABSET(str);
 198                         str_numset(arg->arg_ptr.arg_str, 1.0);
 199                         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 200                         return sp;
 201                     }
 202                     /* NOTREACHED */
 203                 }
 204                 do {
 205                     if (iters++ > maxiters)
 206                         fatal("Substitution loop");
 207                     m = spat->spat_regexp->startp[0];
 208                     if (i = m - s) {
 209                         if (s != d)
 210                             (void)bcopy(s,d,i);
 211                         d += i;
 212                     }
 213                     if (clen) {
 214                         (void)bcopy(c,d,clen);
 215                         d += clen;
 216                     }
 217                     s = spat->spat_regexp->endp[0];
 218                 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
 219                     Nullstr, TRUE));    /* (don't match same null twice) */
 220                 if (s != d) {
 221                     i = strend - s;
 222                     str->str_cur = d - str->str_ptr + i;
 223                     (void)bcopy(s,d,i+1);               /* include the Null */
 224                 }
 225                 STABSET(str);
 226                 str_numset(arg->arg_ptr.arg_str, (double)iters);
 227                 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 228                 return sp;
 229             }
 230             str_numset(arg->arg_ptr.arg_str, 0.0);
 231             stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 232             return sp;
 233         }
 234     }
 235     else
 236         c = Nullch;
 237     if (regexec(spat->spat_regexp, s, strend, orig, 0,
 238       str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
 239     long_way:
 240         dstr = Str_new(25,str_len(str));
 241         str_nset(dstr,m,s-m);
 242         if (spat->spat_regexp->subbase)
 243             curspat = spat;
 244         lastspat = spat;
 245         do {
 246             if (iters++ > maxiters)
 247                 fatal("Substitution loop");
 248             if (spat->spat_regexp->subbase
 249               && spat->spat_regexp->subbase != orig) {
 250                 m = s;
 251                 s = orig;
 252                 orig = spat->spat_regexp->subbase;
 253                 s = orig + (m - s);
 254                 strend = s + (strend - m);
 255             }
 256             m = spat->spat_regexp->startp[0];
 257             str_ncat(dstr,s,m-s);
 258             s = spat->spat_regexp->endp[0];
 259             if (c) {
 260                 if (clen)
 261                     str_ncat(dstr,c,clen);
 262             }
 263             else {
 264                 (void)eval(rspat->spat_repl,G_SCALAR,sp);
 265                 str_scat(dstr,stack->ary_array[sp+1]);
 266             }
 267             if (once)
 268                 break;
 269         } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
 270             safebase));
 271         str_ncat(dstr,s,strend - s);
 272         str_replace(str,dstr);
 273         STABSET(str);
 274         str_numset(arg->arg_ptr.arg_str, (double)iters);
 275         stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 276         return sp;
 277     }
 278     str_numset(arg->arg_ptr.arg_str, 0.0);
 279     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 280     return sp;
 281
 282 nope:
 283     ++spat->spat_short->str_u.str_useful;
 284     str_numset(arg->arg_ptr.arg_str, 0.0);
 285     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
 286     return sp;
 287 }
 288
 289 int
 290 do_trans(str,arg)
 291 STR *str;
 292 register ARG *arg;
 293 {
 294     register char *tbl;
 295     register char *s;
 296     register int matches = 0;
 297     register int ch;
 298     register char *send;
 299
 300     tbl = arg[2].arg_ptr.arg_cval;
 301     s = str_get(str);
 302     send = s + str->str_cur;
 303     if (!tbl || !s)
 304         fatal("panic: do_trans");
 305 #ifdef DEBUGGING
 306     if (debug & 8) {
 307         deb("2.TBL\n");
 308     }
 309 #endif
 310     while (s < send) {
 311         if (ch = tbl[*s & 0377]) {
 312             matches++;
 313             *s = ch;
 314         }
 315         s++;
 316     }
 317     STABSET(str);
 318     return matches;
 319 }
 320
 321 void
 322 do_join(str,arglast)
 323 register STR *str;
 324 int *arglast;
 325 {
 326     register STR **st = stack->ary_array;
 327     register int sp = arglast[1];
 328     register int items = arglast[2] - sp;
 329     register char *delim = str_get(st[sp]);
 330     int delimlen = st[sp]->str_cur;
 331
 332     st += ++sp;
 333     if (items-- > 0)
 334         str_sset(str,*st++);
 335     else
 336         str_set(str,"");
 337     for (; items > 0; items--,st++) {
 338         str_ncat(str,delim,delimlen);
 339         str_scat(str,*st);
 340     }
 341     STABSET(str);
 342 }
 343
 344 void
 345 do_pack(str,arglast)
 346 register STR *str;
 347 int *arglast;
 348 {
 349     register STR **st = stack->ary_array;
 350     register int sp = arglast[1];
 351     register int items;
 352     register char *pat = str_get(st[sp]);
 353     register char *patend = pat + st[sp]->str_cur;
 354     register int len;
 355     int datumtype;
 356     STR *fromstr;
 357     static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
 358     static char *space10 = "          ";
 359
 360     /* These must not be in registers: */
 361     char achar;
 362     short ashort;
 363     int aint;
 364     unsigned int auint;
 365     long along;
 366     unsigned long aulong;
 367     char *aptr;
 368
 369     items = arglast[2] - sp;
 370     st += ++sp;
 371     str_nset(str,"",0);
 372     while (pat < patend) {
 373 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
 374         datumtype = *pat++;
 375         if (isdigit(*pat)) {
 376             len = *pat++ - '0';
 377             while (isdigit(*pat))
 378                 len = (len * 10) + (*pat++ - '0');
 379         }
 380         else
 381             len = 1;
 382         switch(datumtype) {
 383         default:
 384             break;
 385         case 'x':
 386             while (len >= 10) {
 387                 str_ncat(str,null10,10);
 388                 len -= 10;
 389             }
 390             str_ncat(str,null10,len);
 391             break;
 392         case 'A':
 393         case 'a':
 394             fromstr = NEXTFROM;
 395             aptr = str_get(fromstr);
 396             if (fromstr->str_cur > len)
 397                 str_ncat(str,aptr,len);
 398             else
 399                 str_ncat(str,aptr,fromstr->str_cur);
 400             len -= fromstr->str_cur;
 401             if (datumtype == 'A') {
 402                 while (len >= 10) {
 403                     str_ncat(str,space10,10);
 404                     len -= 10;
 405                 }
 406                 str_ncat(str,space10,len);
 407             }
 408             else {
 409                 while (len >= 10) {
 410                     str_ncat(str,null10,10);
 411                     len -= 10;
 412                 }
 413                 str_ncat(str,null10,len);
 414             }
 415             break;
 416         case 'C':
 417         case 'c':
 418             while (len-- > 0) {
 419                 fromstr = NEXTFROM;
 420                 aint = (int)str_gnum(fromstr);
 421                 achar = aint;
 422                 str_ncat(str,&achar,sizeof(char));
 423             }
 424             break;
 425         case 'n':
 426             while (len-- > 0) {
 427                 fromstr = NEXTFROM;
 428                 ashort = (short)str_gnum(fromstr);
 429 #ifdef HTONS
 430                 ashort = htons(ashort);
 431 #endif
 432                 str_ncat(str,(char*)&ashort,sizeof(short));
 433             }
 434             break;
 435         case 'S':
 436         case 's':
 437             while (len-- > 0) {
 438                 fromstr = NEXTFROM;
 439                 ashort = (short)str_gnum(fromstr);
 440                 str_ncat(str,(char*)&ashort,sizeof(short));
 441             }
 442             break;
 443         case 'I':
 444             while (len-- > 0) {
 445                 fromstr = NEXTFROM;
 446                 auint = (unsigned int)str_gnum(fromstr);
 447                 str_ncat(str,(char*)&auint,sizeof(unsigned int));
 448             }
 449             break;
 450         case 'i':
 451             while (len-- > 0) {
 452                 fromstr = NEXTFROM;
 453                 aint = (int)str_gnum(fromstr);
 454                 str_ncat(str,(char*)&aint,sizeof(int));
 455             }
 456             break;
 457         case 'N':
 458             while (len-- > 0) {
 459                 fromstr = NEXTFROM;
 460                 along = (long)str_gnum(fromstr);
 461 #ifdef HTONL
 462                 along = htonl(along);
 463 #endif
 464                 str_ncat(str,(char*)&along,sizeof(long));
 465             }
 466             break;
 467         case 'L':
 468             while (len-- > 0) {
 469                 fromstr = NEXTFROM;
 470                 aulong = (unsigned long)str_gnum(fromstr);
 471                 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
 472             }
 473             break;
 474         case 'l':
 475             while (len-- > 0) {
 476                 fromstr = NEXTFROM;
 477                 along = (long)str_gnum(fromstr);
 478                 str_ncat(str,(char*)&along,sizeof(long));
 479             }
 480             break;
 481         case 'p':
 482             while (len-- > 0) {
 483                 fromstr = NEXTFROM;
 484                 aptr = str_get(fromstr);
 485                 str_ncat(str,(char*)&aptr,sizeof(char*));
 486             }
 487             break;
 488         }
 489     }
 490     STABSET(str);
 491 }
 492 #undef NEXTFROM
 493
 494 void
 495 do_sprintf(str,len,sarg)
 496 register STR *str;
 497 register int len;
 498 register STR **sarg;
 499 {
 500     register char *s;
 501     register char *t;
 502     bool dolong;
 503     char ch;
 504     static STR *sargnull = &str_no;
 505     register char *send;
 506     char *xs;
 507     int xlen;
 508     double value;
 509
 510     str_set(str,"");
 511     len--;                      /* don't count pattern string */
 512     s = str_get(*sarg);
 513     send = s + (*sarg)->str_cur;
 514     sarg++;
 515     for ( ; s < send; len--) {
 516         if (len <= 0 || !*sarg) {
 517             sarg = &sargnull;
 518             len = 0;
 519         }
 520         dolong = FALSE;
 521         for (t = s; t < send && *t != '%'; t++) ;
 522         if (t >= send)
 523             break;              /* not enough % patterns, oh well */
 524         for (t++; *sarg && t < send && t != s; t++) {
 525             switch (*t) {
 526             default:
 527                 ch = *(++t);
 528                 *t = '\0';
 529                 (void)sprintf(buf,s);
 530                 s = t;
 531                 *(t--) = ch;
 532                 len++;
 533                 break;
 534             case '0': case '1': case '2': case '3': case '4':
 535             case '5': case '6': case '7': case '8': case '9':
 536             case '.': case '#': case '-': case '+':
 537                 break;
 538             case 'l':
 539                 dolong = TRUE;
 540                 break;
 541             case 'c':
 542                 ch = *(++t);
 543                 *t = '\0';
 544                 xlen = (int)str_gnum(*(sarg++));
 545                 if (strEQ(t-2,"%c")) {  /* some printfs fail on null chars */
 546                     *buf = xlen;
 547                     str_ncat(str,s,t - s - 2);
 548                     str_ncat(str,buf,1);  /* so handle simple case */
 549                     *buf = '\0';
 550                 }
 551                 else
 552                     (void)sprintf(buf,s,xlen);
 553                 s = t;
 554                 *(t--) = ch;
 555                 break;
 556             case 'D':
 557                 dolong = TRUE;
 558                 /* FALL THROUGH */
 559             case 'd':
 560                 ch = *(++t);
 561                 *t = '\0';
 562                 if (dolong)
 563                     (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
 564                 else
 565                     (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
 566                 s = t;
 567                 *(t--) = ch;
 568                 break;
 569             case 'X': case 'O':
 570                 dolong = TRUE;
 571                 /* FALL THROUGH */
 572             case 'x': case 'o': case 'u':
 573                 ch = *(++t);
 574                 *t = '\0';
 575                 value = str_gnum(*(sarg++));
 576 #if defined(sun) && !defined(sparc)
 577                 if (value < 0.0) {              /* sigh */
 578                     if (dolong)
 579                         (void)sprintf(buf,s,(long)value);
 580                     else
 581                         (void)sprintf(buf,s,(int)value);
 582                 }
 583                 else
 584 #endif
 585                 if (dolong)
 586                     (void)sprintf(buf,s,(unsigned long)value);
 587                 else
 588                     (void)sprintf(buf,s,(unsigned int)value);
 589                 s = t;
 590                 *(t--) = ch;
 591                 break;
 592             case 'E': case 'e': case 'f': case 'G': case 'g':
 593                 ch = *(++t);
 594                 *t = '\0';
 595                 (void)sprintf(buf,s,str_gnum(*(sarg++)));
 596                 s = t;
 597                 *(t--) = ch;
 598                 break;
 599             case 's':
 600                 ch = *(++t);
 601                 *t = '\0';
 602                 xs = str_get(*sarg);
 603                 xlen = (*sarg)->str_cur;
 604                 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'a' && xs[3] == 'b'
 605                   && xlen == sizeof(STBP) && strlen(xs) < xlen) {
 606                     xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
 607                     sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */
 608                     xs = tokenbuf;
 609                     xlen = strlen(tokenbuf);
 610                 }
 611                 if (strEQ(t-2,"%s")) {  /* some printfs fail on >128 chars */
 612                     *buf = '\0';
 613                     str_ncat(str,s,t - s - 2);
 614                     str_ncat(str,xs,xlen);  /* so handle simple case */
 615                 }
 616                 else
 617                     (void)sprintf(buf,s,xs);
 618                 sarg++;
 619                 s = t;
 620                 *(t--) = ch;
 621                 break;
 622             }
 623         }
 624         if (s < t && t >= send) {
 625             str_cat(str,s);
 626             s = t;
 627             break;
 628         }
 629         str_cat(str,buf);
 630     }
 631     if (*s) {
 632         (void)sprintf(buf,s,0,0,0,0);
 633         str_cat(str,buf);
 634     }
 635     STABSET(str);
 636 }
 637
 638 STR *
 639 do_push(ary,arglast)
 640 register ARRAY *ary;
 641 int *arglast;
 642 {
 643     register STR **st = stack->ary_array;
 644     register int sp = arglast[1];
 645     register int items = arglast[2] - sp;
 646     register STR *str = &str_undef;
 647
 648     for (st += ++sp; items > 0; items--,st++) {
 649         str = Str_new(26,0);
 650         if (*st)
 651             str_sset(str,*st);
 652         (void)apush(ary,str);
 653     }
 654     return str;
 655 }
 656
 657 int
 658 do_unshift(ary,arglast)
 659 register ARRAY *ary;
 660 int *arglast;
 661 {
 662     register STR **st = stack->ary_array;
 663     register int sp = arglast[1];
 664     register int items = arglast[2] - sp;
 665     register STR *str;
 666     register int i;
 667
 668     aunshift(ary,items);
 669     i = 0;
 670     for (st += ++sp; i < items; i++,st++) {
 671         str = Str_new(27,0);
 672         str_sset(str,*st);
 673         (void)astore(ary,i,str);
 674     }
 675 }
 676
 677 int
 678 do_subr(arg,gimme,arglast)
 679 register ARG *arg;
 680 int gimme;
 681 int *arglast;
 682 {
 683     register STR **st = stack->ary_array;
 684     register int sp = arglast[1];
 685     register int items = arglast[2] - sp;
 686     register SUBR *sub;
 687     ARRAY *savearray;
 688     STAB *stab;
 689     char *oldfile = filename;
 690     int oldsave = savestack->ary_fill;
 691     int oldtmps_base = tmps_base;
 692
 693     if ((arg[1].arg_type & A_MASK) == A_WORD)
 694         stab = arg[1].arg_ptr.arg_stab;
 695     else {
 696         STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
 697
 698         if (tmpstr)
 699             stab = stabent(str_get(tmpstr),TRUE);
 700         else
 701             stab = Nullstab;
 702     }
 703     if (!stab)
 704         fatal("Undefined subroutine called");
 705     sub = stab_sub(stab);
 706     if (!sub)
 707         fatal("Undefined subroutine \"%s\" called", stab_name(stab));
 708     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 709         savearray = stab_xarray(defstab);
 710         stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
 711     }
 712     savelong(&sub->depth);
 713     sub->depth++;
 714     saveint(&wantarray);
 715     wantarray = gimme;
 716     if (sub->depth >= 2) {      /* save temporaries on recursion? */
 717         if (sub->depth == 100 && dowarn)
 718             warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 719         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
 720     }
 721     filename = sub->filename;
 722     tmps_base = tmps_max;
 723     sp = cmd_exec(sub->cmd,gimme,--sp);         /* so do it already */
 724     st = stack->ary_array;
 725
 726     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 727         afree(stab_xarray(defstab));  /* put back old $_[] */
 728         stab_xarray(defstab) = savearray;
 729     }
 730     filename = oldfile;
 731     tmps_base = oldtmps_base;
 732     if (savestack->ary_fill > oldsave) {
 733         for (items = arglast[0] + 1; items <= sp; items++)
 734             st[items] = str_static(st[items]);
 735                 /* in case restore wipes old str */
 736         restorelist(oldsave);
 737     }
 738     return sp;
 739 }
 740
 741 int
 742 do_dbsubr(arg,gimme,arglast)
 743 register ARG *arg;
 744 int gimme;
 745 int *arglast;
 746 {
 747     register STR **st = stack->ary_array;
 748     register int sp = arglast[1];
 749     register int items = arglast[2] - sp;
 750     register SUBR *sub;
 751     ARRAY *savearray;
 752     STR *str;
 753     STAB *stab;
 754     char *oldfile = filename;
 755     int oldsave = savestack->ary_fill;
 756     int oldtmps_base = tmps_base;
 757
 758     if ((arg[1].arg_type & A_MASK) == A_WORD)
 759         stab = arg[1].arg_ptr.arg_stab;
 760     else {
 761         STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
 762
 763         if (tmpstr)
 764             stab = stabent(str_get(tmpstr),TRUE);
 765         else
 766             stab = Nullstab;
 767     }
 768     if (!stab)
 769         fatal("Undefined subroutine called");
 770     sub = stab_sub(stab);
 771     if (!sub)
 772         fatal("Undefined subroutine \"%s\" called", stab_name(stab));
 773 /* begin differences */
 774     str = stab_val(DBsub);
 775     saveitem(str);
 776     str_set(str,stab_name(stab));
 777     sub = stab_sub(DBsub);
 778     if (!sub)
 779         fatal("No DBsub routine");
 780 /* end differences */
 781     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 782         savearray = stab_xarray(defstab);
 783         stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
 784     }
 785     savelong(&sub->depth);
 786     sub->depth++;
 787     saveint(&wantarray);
 788     wantarray = gimme;
 789     if (sub->depth >= 2) {      /* save temporaries on recursion? */
 790         if (sub->depth == 100 && dowarn)
 791             warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
 792         savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
 793     }
 794     filename = sub->filename;
 795     tmps_base = tmps_max;
 796     sp = cmd_exec(sub->cmd,gimme, --sp);        /* so do it already */
 797     st = stack->ary_array;
 798
 799     if ((arg[2].arg_type & A_MASK) != A_NULL) {
 800         afree(stab_xarray(defstab));  /* put back old $_[] */
 801         stab_xarray(defstab) = savearray;
 802     }
 803     filename = oldfile;
 804     tmps_base = oldtmps_base;
 805     if (savestack->ary_fill > oldsave) {
 806         for (items = arglast[0] + 1; items <= sp; items++)
 807             st[items] = str_static(st[items]);
 808                 /* in case restore wipes old str */
 809         restorelist(oldsave);
 810     }
 811     return sp;
 812 }
 813
 814 int
 815 do_assign(arg,gimme,arglast)
 816 register ARG *arg;
 817 int gimme;
 818 int *arglast;
 819 {
 820
 821     register STR **st = stack->ary_array;
 822     STR **firstrelem = st + arglast[1] + 1;
 823     STR **firstlelem = st + arglast[0] + 1;
 824     STR **lastrelem = st + arglast[2];
 825     STR **lastlelem = st + arglast[1];
 826     register STR **relem;
 827     register STR **lelem;
 828
 829     register STR *str;
 830     register ARRAY *ary;
 831     register int makelocal;
 832     HASH *hash;
 833     int i;
 834
 835     makelocal = (arg->arg_flags & AF_LOCAL);
 836     localizing = makelocal;
 837     delaymagic = DM_DELAY;              /* catch simultaneous items */
 838
 839     /* If there's a common identifier on both sides we have to take
 840      * special care that assigning the identifier on the left doesn't
 841      * clobber a value on the right that's used later in the list.
 842      */
 843     if (arg->arg_flags & AF_COMMON) {
 844         for (relem = firstrelem; relem <= lastrelem; relem++) {
 845             if (str = *relem)
 846                 *relem = str_static(str);
 847         }
 848     }
 849     relem = firstrelem;
 850     lelem = firstlelem;
 851     ary = Null(ARRAY*);
 852     hash = Null(HASH*);
 853     while (lelem <= lastlelem) {
 854         str = *lelem++;
 855         if (str->str_state >= SS_HASH) {
 856             if (str->str_state == SS_ARY) {
 857                 if (makelocal)
 858                     ary = saveary(str->str_u.str_stab);
 859                 else {
 860                     ary = stab_array(str->str_u.str_stab);
 861                     ary->ary_fill = -1;
 862                 }
 863                 i = 0;
 864                 while (relem <= lastrelem) {    /* gobble up all the rest */
 865                     str = Str_new(28,0);
 866                     if (*relem)
 867                         str_sset(str,*relem);
 868                     *(relem++) = str;
 869                     (void)astore(ary,i++,str);
 870                 }
 871             }
 872             else if (str->str_state == SS_HASH) {
 873                 char *tmps;
 874                 STR *tmpstr;
 875
 876                 if (makelocal)
 877                     hash = savehash(str->str_u.str_stab);
 878                 else {
 879                     hash = stab_hash(str->str_u.str_stab);
 880                     hclear(hash);
 881                 }
 882                 while (relem < lastrelem) {     /* gobble up all the rest */
 883                     if (*relem)
 884                         str = *(relem++);
 885                     else
 886                         str = &str_no, relem++;
 887                     tmps = str_get(str);
 888                     tmpstr = Str_new(29,0);
 889                     if (*relem)
 890                         str_sset(tmpstr,*relem);        /* value */
 891                     *(relem++) = tmpstr;
 892                     (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
 893                 }
 894             }
 895             else
 896                 fatal("panic: do_assign");
 897         }
 898         else {
 899             if (makelocal)
 900                 saveitem(str);
 901             if (relem <= lastrelem) {
 902                 str_sset(str, *relem);
 903                 *(relem++) = str;
 904             }
 905             else {
 906                 str_nset(str, "", 0);
 907                 if (gimme == G_ARRAY) {
 908                     i = ++lastrelem - firstrelem;
 909                     relem++;            /* tacky, I suppose */
 910                     astore(stack,i,str);
 911                     if (st != stack->ary_array) {
 912                         st = stack->ary_array;
 913                         firstrelem = st + arglast[1] + 1;
 914                         firstlelem = st + arglast[0] + 1;
 915                         lastlelem = st + arglast[1];
 916                         lastrelem = st + i;
 917                         relem = lastrelem + 1;
 918                     }
 919                 }
 920             }
 921             STABSET(str);
 922         }
 923     }
 924     if (delaymagic > 1) {
 925 #ifdef SETREUID
 926         if (delaymagic & DM_REUID)
 927             setreuid(uid,euid);
 928 #endif
 929 #ifdef SETREGID
 930         if (delaymagic & DM_REGID)
 931             setregid(gid,egid);
 932 #endif
 933     }
 934     delaymagic = 0;
 935     localizing = FALSE;
 936     if (gimme == G_ARRAY) {
 937         i = lastrelem - firstrelem + 1;
 938         if (ary || hash)
 939             Copy(firstrelem, firstlelem, i, STR*);
 940         return arglast[0] + i;
 941     }
 942     else {
 943         str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
 944         *firstlelem = arg->arg_ptr.arg_str;
 945         return arglast[0] + 1;
 946     }
 947 }
 948
 949 int
 950 do_study(str,arg,gimme,arglast)
 951 STR *str;
 952 ARG *arg;
 953 int gimme;
 954 int *arglast;
 955 {
 956     register unsigned char *s;
 957     register int pos = str->str_cur;
 958     register int ch;
 959     register int *sfirst;
 960     register int *snext;
 961     static int maxscream = -1;
 962     static STR *lastscream = Nullstr;
 963     int retval;
 964     int retarg = arglast[0] + 1;
 965
 966 #ifndef lint
 967     s = (unsigned char*)(str_get(str));
 968 #else
 969     s = Null(unsigned char*);
 970 #endif
 971     if (lastscream)
 972         lastscream->str_pok &= ~SP_STUDIED;
 973     lastscream = str;
 974     if (pos <= 0) {
 975         retval = 0;
 976         goto ret;
 977     }
 978     if (pos > maxscream) {
 979         if (maxscream < 0) {
 980             maxscream = pos + 80;
 981             New(301,screamfirst, 256, int);
 982             New(302,screamnext, maxscream, int);
 983         }
 984         else {
 985             maxscream = pos + pos / 4;
 986             Renew(screamnext, maxscream, int);
 987         }
 988     }
 989
 990     sfirst = screamfirst;
 991     snext = screamnext;
 992
 993     if (!sfirst || !snext)
 994         fatal("do_study: out of memory");
 995
 996     for (ch = 256; ch; --ch)
 997         *sfirst++ = -1;
 998     sfirst -= 256;
 999
1000     while (--pos >= 0) {
1001         ch = s[pos];
1002         if (sfirst[ch] >= 0)
1003             snext[pos] = sfirst[ch] - pos;
1004         else
1005             snext[pos] = -pos;
1006         sfirst[ch] = pos;
1007
1008         /* If there were any case insensitive searches, we must assume they
1009          * all are.  This speeds up insensitive searches much more than
1010          * it slows down sensitive ones.
1011          */
1012         if (sawi)
1013             sfirst[fold[ch]] = pos;
1014     }
1015
1016     str->str_pok |= SP_STUDIED;
1017     retval = 1;
1018   ret:
1019     str_numset(arg->arg_ptr.arg_str,(double)retval);
1020     stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1021     return retarg;
1022 }
1023
1024 int
1025 do_defined(str,arg,gimme,arglast)
1026 STR *str;
1027 register ARG *arg;
1028 int gimme;
1029 int *arglast;
1030 {
1031     register int type;
1032     register int retarg = arglast[0] + 1;
1033     int retval;
1034
1035     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1036         fatal("Illegal argument to defined()");
1037     arg = arg[1].arg_ptr.arg_arg;
1038     type = arg->arg_type;
1039
1040     if (type == O_ARRAY || type == O_LARRAY)
1041         retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
1042     else if (type == O_HASH || type == O_LHASH)
1043         retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
1044     else if (type == O_SUBR || type == O_DBSUBR)
1045         retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1046     else if (type == O_ASLICE || type == O_LASLICE)
1047         retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
1048     else if (type == O_HSLICE || type == O_LHSLICE)
1049         retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
1050     else
1051         retval = FALSE;
1052     str_numset(str,(double)retval);
1053     stack->ary_array[retarg] = str;
1054     return retarg;
1055 }
1056
1057 int
1058 do_undef(str,arg,gimme,arglast)
1059 STR *str;
1060 register ARG *arg;
1061 int gimme;
1062 int *arglast;
1063 {
1064     register int type;
1065     register STAB *stab;
1066     int retarg = arglast[0] + 1;
1067
1068     if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1069         fatal("Illegal argument to undef()");
1070     arg = arg[1].arg_ptr.arg_arg;
1071     type = arg->arg_type;
1072
1073     if (type == O_ARRAY || type == O_LARRAY) {
1074         stab = arg[1].arg_ptr.arg_stab;
1075         afree(stab_xarray(stab));
1076         stab_xarray(stab) = Null(ARRAY*);
1077     }
1078     else if (type == O_HASH || type == O_LHASH) {
1079         stab = arg[1].arg_ptr.arg_stab;
1080         (void)hfree(stab_xhash(stab));
1081         stab_xhash(stab) = Null(HASH*);
1082     }
1083     else if (type == O_SUBR || type == O_DBSUBR) {
1084         stab = arg[1].arg_ptr.arg_stab;
1085         cmd_free(stab_sub(stab)->cmd);
1086         afree(stab_sub(stab)->tosave);
1087         Safefree(stab_sub(stab));
1088         stab_sub(stab) = Null(SUBR*);
1089     }
1090     else
1091         fatal("Can't undefine that kind of object");
1092     str_numset(str,0.0);
1093     stack->ary_array[retarg] = str;
1094     return retarg;
1095 }
1096
1097 int
1098 do_vec(lvalue,astr,arglast)
1099 int lvalue;
1100 STR *astr;
1101 int *arglast;
1102 {
1103     STR **st = stack->ary_array;
1104     int sp = arglast[0];
1105     register STR *str = st[++sp];
1106     register int offset = (int)str_gnum(st[++sp]);
1107     register int size = (int)str_gnum(st[++sp]);
1108     unsigned char *s = (unsigned char*)str_get(str);
1109     unsigned long retnum;
1110     int len;
1111
1112     sp = arglast[1];
1113     offset *= size;             /* turn into bit offset */
1114     len = (offset + size + 7) / 8;
1115     if (offset < 0 || size < 1)
1116         retnum = 0;
1117     else if (!lvalue && len > str->str_cur)
1118         retnum = 0;
1119     else {
1120         if (len > str->str_cur) {
1121             STR_GROW(str,len);
1122             (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1123             str->str_cur = len;
1124         }
1125         s = (unsigned char*)str_get(str);
1126         if (size < 8)
1127             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1128         else {
1129             offset >>= 3;
1130             if (size == 8)
1131                 retnum = s[offset];
1132             else if (size == 16)
1133                 retnum = (s[offset] << 8) + s[offset+1];
1134             else if (size == 32)
1135                 retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
1136                         (s[offset + 2] << 8) + s[offset+3];
1137         }
1138
1139         if (lvalue) {                      /* it's an lvalue! */
1140             struct lstring *lstr = (struct lstring*)astr;
1141
1142             astr->str_magic = str;
1143             st[sp]->str_rare = 'v';
1144             lstr->lstr_offset = offset;
1145             lstr->lstr_len = size;
1146         }
1147     }
1148
1149     str_numset(astr,(double)retnum);
1150     st[sp] = astr;
1151     return sp;
1152 }
1153
1154 void
1155 do_vecset(mstr,str)
1156 STR *mstr;
1157 STR *str;
1158 {
1159     struct lstring *lstr = (struct lstring*)str;
1160     register int offset;
1161     register int size;
1162     register unsigned char *s = (unsigned char*)mstr->str_ptr;
1163     register unsigned long lval = (unsigned long)str_gnum(str);
1164     int mask;
1165
1166     mstr->str_rare = 0;
1167     str->str_magic = Nullstr;
1168     offset = lstr->lstr_offset;
1169     size = lstr->lstr_len;
1170     if (size < 8) {
1171         mask = (1 << size) - 1;
1172         size = offset & 7;
1173         lval &= mask;
1174         offset >>= 3;
1175         s[offset] &= ~(mask << size);
1176         s[offset] |= lval << size;
1177     }
1178     else {
1179         if (size == 8)
1180             s[offset] = lval & 255;
1181         else if (size == 16) {
1182             s[offset] = (lval >> 8) & 255;
1183             s[offset+1] = lval & 255;
1184         }
1185         else if (size == 32) {
1186             s[offset] = (lval >> 24) & 255;
1187             s[offset+1] = (lval >> 16) & 255;
1188             s[offset+2] = (lval >> 8) & 255;
1189             s[offset+3] = lval & 255;
1190         }
1191     }
1192 }
1193
1194 do_chop(astr,str)
1195 register STR *astr;
1196 register STR *str;
1197 {
1198     register char *tmps;
1199     register int i;
1200     ARRAY *ary;
1201     HASH *hash;
1202     HENT *entry;
1203
1204     if (!str)
1205         return;
1206     if (str->str_state == SS_ARY) {
1207         ary = stab_array(str->str_u.str_stab);
1208         for (i = 0; i <= ary->ary_fill; i++)
1209             do_chop(astr,ary->ary_array[i]);
1210         return;
1211     }
1212     if (str->str_state == SS_HASH) {
1213         hash = stab_hash(str->str_u.str_stab);
1214         (void)hiterinit(hash);
1215         while (entry = hiternext(hash))
1216             do_chop(astr,hiterval(hash,entry));
1217         return;
1218     }
1219     tmps = str_get(str);
1220     if (!tmps)
1221         return;
1222     tmps += str->str_cur - (str->str_cur != 0);
1223     str_nset(astr,tmps,1);      /* remember last char */
1224     *tmps = '\0';                               /* wipe it out */
1225     str->str_cur = tmps - str->str_ptr;
1226     str->str_nok = 0;
1227 }
1228
1229 do_vop(optype,str,left,right)
1230 STR *str;
1231 STR *left;
1232 STR *right;
1233 {
1234     register char *s = str_get(str);
1235     register char *l = str_get(left);
1236     register char *r = str_get(right);
1237     register int len;
1238
1239     len = left->str_cur;
1240     if (len > right->str_cur)
1241         len = right->str_cur;
1242     if (str->str_cur > len)
1243         str->str_cur = len;
1244     else if (str->str_cur < len) {
1245         STR_GROW(str,len);
1246         (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1247         str->str_cur = len;
1248         s = str_get(str);
1249     }
1250     switch (optype) {
1251     case O_BIT_AND:
1252         while (len--)
1253             *s++ = *l++ & *r++;
1254         break;
1255     case O_XOR:
1256         while (len--)
1257             *s++ = *l++ ^ *r++;
1258         goto mop_up;
1259     case O_BIT_OR:
1260         while (len--)
1261             *s++ = *l++ | *r++;
1262       mop_up:
1263         len = str->str_cur;
1264         if (right->str_cur > len)
1265             str_ncat(str,right->str_ptr+len,right->str_cur - len);
1266         else if (left->str_cur > len)
1267             str_ncat(str,left->str_ptr+len,left->str_cur - len);
1268         break;
1269     }
1270 }
1271
1272 int
1273 do_syscall(arglast)
1274 int *arglast;
1275 {
1276     register STR **st = stack->ary_array;
1277     register int sp = arglast[1];
1278     register int items = arglast[2] - sp;
1279     long arg[8];
1280     register int i = 0;
1281     int retval = -1;
1282
1283 #ifdef SYSCALL
1284 #ifdef TAINT
1285     for (st += ++sp; items--; st++)
1286         tainted |= (*st)->str_tainted;
1287     st = stack->ary_array;
1288     sp = arglast[1];
1289     items = arglast[2] - sp;
1290 #endif
1291 #ifdef TAINT
1292     taintproper("Insecure dependency in syscall");
1293 #endif
1294     /* This probably won't work on machines where sizeof(long) != sizeof(int)
1295      * or where sizeof(long) != sizeof(char*).  But such machines will
1296      * not likely have syscall implemented either, so who cares?
1297      */
1298     while (items--) {
1299         if (st[++sp]->str_nok || !i)
1300             arg[i++] = (long)str_gnum(st[sp]);
1301 #ifndef lint
1302         else
1303             arg[i++] = (long)st[sp]->str_ptr;
1304 #endif /* lint */
1305     }
1306     sp = arglast[1];
1307     items = arglast[2] - sp;
1308     switch (items) {
1309     case 0:
1310         fatal("Too few args to syscall");
1311     case 1:
1312         retval = syscall(arg[0]);
1313         break;
1314     case 2:
1315         retval = syscall(arg[0],arg[1]);
1316         break;
1317     case 3:
1318         retval = syscall(arg[0],arg[1],arg[2]);
1319         break;
1320     case 4:
1321         retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1322         break;
1323     case 5:
1324         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1325         break;
1326     case 6:
1327         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1328         break;
1329     case 7:
1330         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1331         break;
1332     case 8:
1333         retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1334           arg[7]);
1335         break;
1336     }
1337     return retval;
1338 #else
1339     fatal("syscall() unimplemented");
1340 #endif
1341 }
1342
1343