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