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