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