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