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