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