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