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