doarg.c

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