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