doarg.c

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