doarg.c

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