doarg.c.orig

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