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