doarg.c

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