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