doarg.c

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