doarg.c

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