doarg.c

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