doarg.c

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