projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perl 4.0 patch 29: patch #20, continued
[p5sagit/p5-mst-13.2.git] / doarg.c
CommitLineData
8adcabd8 1/* $RCSfile: doarg.c,v $$Revision: 4.0.1.6 $$Date: 92/06/08 12:34:30 $
a687059c 2 *
6e21c824 3 * Copyright (c) 1991, Larry Wall
a687059c 4 *
6e21c824 5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
a687059c 7 *
8 * $Log: doarg.c,v $
8adcabd8 9 * Revision 4.0.1.6 92/06/08 12:34:30 lwall
10 * patch20: removed implicit int declarations on funcions
11 * patch20: pattern modifiers i and o didn't interact right
12 * patch20: join() now pre-extends target string to avoid excessive copying
13 * patch20: fixed confusion between a *var's real name and its effective name
14 * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
15 * patch20: usersub routines didn't reclaim temp values soon enough
16 * patch20: ($<,$>) = ... didn't work on some architectures
17 * patch20: added Atari ST portability
18 *
988174c1 19 * Revision 4.0.1.5 91/11/11 16:31:58 lwall
20 * patch19: added little-endian pack/unpack options
21 *
db4e6270 22 * Revision 4.0.1.4 91/11/05 16:35:06 lwall
23 * patch11: /$foo/o optimizer could access deallocated data
24 * patch11: minimum match length calculation in regexp is now cumulative
25 * patch11: added some support for 64-bit integers
26 * patch11: prepared for ctype implementations that don't define isascii()
27 * patch11: sprintf() now supports any length of s field
28 * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
29 * patch11: defined(&$foo) and undef(&$foo) didn't work
30 *
1462b684 31 * Revision 4.0.1.3 91/06/10 01:18:41 lwall
32 * patch10: pack(hh,1) dumped core
33 *
6e21c824 34 * Revision 4.0.1.2 91/06/07 10:42:17 lwall
35 * patch4: new copyright notice
36 * patch4: // wouldn't use previous pattern if it started with a null character
37 * patch4: //o and s///o now optimize themselves fully at runtime
38 * patch4: added global modifier for pattern matches
39 * patch4: undef @array disabled "@array" interpolation
40 * patch4: chop("") was returning "\0" rather than ""
41 * patch4: vector logical operations &, | and ^ sometimes returned null string
42 * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
43 *
1c3d792e 44 * Revision 4.0.1.1 91/04/11 17:40:14 lwall
45 * patch1: fixed undefined environ problem
46 * patch1: fixed debugger coredump on subroutines
47 *
fe14fcc3 48 * Revision 4.0 91/03/20 01:06:42 lwall
49 * 4.0 baseline.
a687059c 50 *
51 */
52
53#include "EXTERN.h"
54#include "perl.h"
55
6eb13c3b 56#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
a687059c 57#include <signal.h>
ff8e2863 58#endif
a687059c 59
60extern unsigned char fold[];
61
b1248f16 62#ifdef BUGGY_MSC
63 #pragma function(memcmp)
64#endif /* BUGGY_MSC */
65
8adcabd8 66static void doencodes();
67
a687059c 68int
69do_subst(str,arg,sp)
70STR *str;
71ARG *arg;
72int sp;
73{
74 register SPAT *spat;
75 SPAT *rspat;
76 register STR *dstr;
77 register char *s = str_get(str);
78 char *strend = s + str->str_cur;
79 register char *m;
80 char *c;
81 register char *d;
82 int clen;
83 int iters = 0;
afd9f252 84 int maxiters = (strend - s) + 10;
a687059c 85 register int i;
86 bool once;
87 char *orig;
88 int safebase;
89
90 rspat = spat = arg[2].arg_ptr.arg_spat;
91 if (!spat || !s)
92 fatal("panic: do_subst");
93 else if (spat->spat_runtime) {
94 nointrp = "|)";
95 (void)eval(spat->spat_runtime,G_SCALAR,sp);
96 m = str_get(dstr = stack->ary_array[sp+1]);
97 nointrp = "";
fe14fcc3 98 if (spat->spat_regexp) {
a687059c 99 regfree(spat->spat_regexp);
fe14fcc3 100 spat->spat_regexp = Null(REGEXP*); /* required if regcomp pukes */
101 }
a687059c 102 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
ff8e2863 103 spat->spat_flags & SPAT_FOLD);
a687059c 104 if (spat->spat_flags & SPAT_KEEP) {
8adcabd8 105 if (!(spat->spat_flags & SPAT_FOLD))
106 scanconst(spat, m, dstr->str_cur);
a687059c 107 arg_free(spat->spat_runtime); /* it won't change, so */
108 spat->spat_runtime = Nullarg; /* no point compiling again */
6e21c824 109 hoistmust(spat);
110 if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
111 curcmd->c_flags &= ~CF_OPTIMIZE;
112 opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
113 }
a687059c 114 }
115 }
116#ifdef DEBUGGING
117 if (debug & 8) {
118 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
119 }
120#endif
121 safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
122 !sawampersand);
6e21c824 123 if (!spat->spat_regexp->prelen && lastspat)
a687059c 124 spat = lastspat;
125 orig = m = s;
126 if (hint) {
127 if (hint < s || hint > strend)
128 fatal("panic: hint in do_match");
129 s = hint;
130 hint = Nullch;
131 if (spat->spat_regexp->regback >= 0) {
132 s -= spat->spat_regexp->regback;
133 if (s < m)
134 s = m;
135 }
136 else
137 s = m;
138 }
139 else if (spat->spat_short) {
140 if (spat->spat_flags & SPAT_SCANFIRST) {
141 if (str->str_pok & SP_STUDIED) {
142 if (screamfirst[spat->spat_short->str_rare] < 0)
143 goto nope;
144 else if (!(s = screaminstr(str,spat->spat_short)))
145 goto nope;
146 }
147#ifndef lint
148 else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
149 spat->spat_short)))
150 goto nope;
151#endif
152 if (s && spat->spat_regexp->regback >= 0) {
153 ++spat->spat_short->str_u.str_useful;
154 s -= spat->spat_regexp->regback;
155 if (s < m)
156 s = m;
157 }
158 else
159 s = m;
160 }
161 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
162 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
163 goto nope;
164 if (--spat->spat_short->str_u.str_useful < 0) {
165 str_free(spat->spat_short);
166 spat->spat_short = Nullstr; /* opt is being useless */
167 }
168 }
6e21c824 169 once = !(rspat->spat_flags & SPAT_GLOBAL);
a687059c 170 if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
171 if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
172 dstr = rspat->spat_repl[1].arg_ptr.arg_str;
173 else { /* constant over loop, anyway */
174 (void)eval(rspat->spat_repl,G_SCALAR,sp);
175 dstr = stack->ary_array[sp+1];
176 }
177 c = str_get(dstr);
178 clen = dstr->str_cur;
db4e6270 179 if (clen <= spat->spat_regexp->minlen) {
a687059c 180 /* can do inplace substitution */
663a0e37 181 if (regexec(spat->spat_regexp, s, strend, orig, 0,
a687059c 182 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
183 if (spat->spat_regexp->subbase) /* oops, no we can't */
184 goto long_way;
185 d = s;
186 lastspat = spat;
187 str->str_pok = SP_VALID; /* disable possible screamer */
188 if (once) {
189 m = spat->spat_regexp->startp[0];
190 d = spat->spat_regexp->endp[0];
191 s = orig;
192 if (m - s > strend - d) { /* faster to shorten from end */
193 if (clen) {
8adcabd8 194 Copy(c, m, clen, char);
a687059c 195 m += clen;
196 }
197 i = strend - d;
198 if (i > 0) {
8adcabd8 199 Move(d, m, i, char);
a687059c 200 m += i;
201 }
202 *m = '\0';
203 str->str_cur = m - s;
204 STABSET(str);
205 str_numset(arg->arg_ptr.arg_str, 1.0);
206 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
207 return sp;
208 }
db4e6270 209 /*SUPPRESS 560*/
a687059c 210 else if (i = m - s) { /* faster from front */
211 d -= clen;
212 m = d;
213 str_chop(str,d-i);
214 s += i;
215 while (i--)
216 *--d = *--s;
217 if (clen)
8adcabd8 218 Copy(c, m, clen, char);
a687059c 219 STABSET(str);
220 str_numset(arg->arg_ptr.arg_str, 1.0);
221 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
222 return sp;
223 }
224 else if (clen) {
225 d -= clen;
226 str_chop(str,d);
8adcabd8 227 Copy(c,d,clen,char);
a687059c 228 STABSET(str);
229 str_numset(arg->arg_ptr.arg_str, 1.0);
230 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
231 return sp;
232 }
233 else {
234 str_chop(str,d);
235 STABSET(str);
236 str_numset(arg->arg_ptr.arg_str, 1.0);
237 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
238 return sp;
239 }
240 /* NOTREACHED */
241 }
242 do {
afd9f252 243 if (iters++ > maxiters)
a687059c 244 fatal("Substitution loop");
245 m = spat->spat_regexp->startp[0];
db4e6270 246 /*SUPPRESS 560*/
a687059c 247 if (i = m - s) {
248 if (s != d)
8adcabd8 249 Move(s,d,i,char);
a687059c 250 d += i;
251 }
252 if (clen) {
8adcabd8 253 Copy(c,d,clen,char);
a687059c 254 d += clen;
255 }
256 s = spat->spat_regexp->endp[0];
663a0e37 257 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
258 Nullstr, TRUE)); /* (don't match same null twice) */
a687059c 259 if (s != d) {
260 i = strend - s;
261 str->str_cur = d - str->str_ptr + i;
8adcabd8 262 Move(s,d,i+1,char); /* include the Null */
a687059c 263 }
264 STABSET(str);
265 str_numset(arg->arg_ptr.arg_str, (double)iters);
266 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
267 return sp;
268 }
269 str_numset(arg->arg_ptr.arg_str, 0.0);
270 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
271 return sp;
272 }
273 }
274 else
275 c = Nullch;
663a0e37 276 if (regexec(spat->spat_regexp, s, strend, orig, 0,
a687059c 277 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
278 long_way:
279 dstr = Str_new(25,str_len(str));
280 str_nset(dstr,m,s-m);
281 if (spat->spat_regexp->subbase)
282 curspat = spat;
283 lastspat = spat;
284 do {
afd9f252 285 if (iters++ > maxiters)
a687059c 286 fatal("Substitution loop");
287 if (spat->spat_regexp->subbase
288 && spat->spat_regexp->subbase != orig) {
289 m = s;
290 s = orig;
291 orig = spat->spat_regexp->subbase;
292 s = orig + (m - s);
293 strend = s + (strend - m);
294 }
295 m = spat->spat_regexp->startp[0];
296 str_ncat(dstr,s,m-s);
297 s = spat->spat_regexp->endp[0];
298 if (c) {
299 if (clen)
300 str_ncat(dstr,c,clen);
301 }
302 else {
fe14fcc3 303 char *mysubbase = spat->spat_regexp->subbase;
304
305 spat->spat_regexp->subbase = Nullch; /* so recursion works */
a687059c 306 (void)eval(rspat->spat_repl,G_SCALAR,sp);
307 str_scat(dstr,stack->ary_array[sp+1]);
fe14fcc3 308 if (spat->spat_regexp->subbase)
309 Safefree(spat->spat_regexp->subbase);
310 spat->spat_regexp->subbase = mysubbase;
a687059c 311 }
312 if (once)
313 break;
663a0e37 314 } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
a687059c 315 safebase));
316 str_ncat(dstr,s,strend - s);
317 str_replace(str,dstr);
318 STABSET(str);
319 str_numset(arg->arg_ptr.arg_str, (double)iters);
320 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
321 return sp;
322 }
323 str_numset(arg->arg_ptr.arg_str, 0.0);
324 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
325 return sp;
326
327nope:
328 ++spat->spat_short->str_u.str_useful;
329 str_numset(arg->arg_ptr.arg_str, 0.0);
330 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
331 return sp;
332}
b1248f16 333#ifdef BUGGY_MSC
334 #pragma intrinsic(memcmp)
335#endif /* BUGGY_MSC */
a687059c 336
337int
338do_trans(str,arg)
339STR *str;
20188a90 340ARG *arg;
a687059c 341{
20188a90 342 register short *tbl;
a687059c 343 register char *s;
344 register int matches = 0;
345 register int ch;
346 register char *send;
20188a90 347 register char *d;
348 register int squash = arg[2].arg_len & 1;
a687059c 349
20188a90 350 tbl = (short*) arg[2].arg_ptr.arg_cval;
a687059c 351 s = str_get(str);
352 send = s + str->str_cur;
353 if (!tbl || !s)
354 fatal("panic: do_trans");
355#ifdef DEBUGGING
356 if (debug & 8) {
357 deb("2.TBL\n");
358 }
359#endif
20188a90 360 if (!arg[2].arg_len) {
361 while (s < send) {
362 if ((ch = tbl[*s & 0377]) >= 0) {
363 matches++;
364 *s = ch;
365 }
366 s++;
367 }
368 }
369 else {
370 d = s;
371 while (s < send) {
372 if ((ch = tbl[*s & 0377]) >= 0) {
373 *d = ch;
374 if (matches++ && squash) {
375 if (d[-1] == *d)
376 matches--;
377 else
378 d++;
379 }
380 else
381 d++;
382 }
383 else if (ch == -1) /* -1 is unmapped character */
384 *d++ = *s; /* -2 is delete character */
385 s++;
a687059c 386 }
20188a90 387 matches += send - d; /* account for disappeared chars */
388 *d = '\0';
389 str->str_cur = d - str->str_ptr;
a687059c 390 }
391 STABSET(str);
392 return matches;
393}
394
395void
396do_join(str,arglast)
397register STR *str;
398int *arglast;
399{
400 register STR **st = stack->ary_array;
8adcabd8 401 int sp = arglast[1];
a687059c 402 register int items = arglast[2] - sp;
403 register char *delim = str_get(st[sp]);
8adcabd8 404 register STRLEN len;
a687059c 405 int delimlen = st[sp]->str_cur;
406
8adcabd8 407 st += sp + 1;
408
409 len = delimlen * (items - 1);
410 if (str->str_len < len + items) { /* current length is way too short */
411 while (items-- > 0) {
412 if (*st)
413 len += (*st)->str_cur;
414 st++;
415 }
416 STR_GROW(str, len + 1); /* so try to pre-extend */
417
418 items = arglast[2] - sp;
419 st -= items;
420 }
421
a687059c 422 if (items-- > 0)
fe14fcc3 423 str_sset(str, *st++);
a687059c 424 else
425 str_set(str,"");
8adcabd8 426 len = delimlen;
427 if (len) {
57ebbfd0 428 for (; items > 0; items--,st++) {
8adcabd8 429 str_ncat(str,delim,len);
57ebbfd0 430 str_scat(str,*st);
431 }
432 }
433 else {
434 for (; items > 0; items--,st++)
435 str_scat(str,*st);
a687059c 436 }
437 STABSET(str);
438}
439
440void
441do_pack(str,arglast)
442register STR *str;
443int *arglast;
444{
445 register STR **st = stack->ary_array;
446 register int sp = arglast[1];
447 register int items;
448 register char *pat = str_get(st[sp]);
449 register char *patend = pat + st[sp]->str_cur;
450 register int len;
451 int datumtype;
452 STR *fromstr;
db4e6270 453 /*SUPPRESS 442*/
a687059c 454 static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
455 static char *space10 = " ";
456
457 /* These must not be in registers: */
458 char achar;
459 short ashort;
460 int aint;
afd9f252 461 unsigned int auint;
a687059c 462 long along;
afd9f252 463 unsigned long aulong;
db4e6270 464#ifdef QUAD
465 quad aquad;
466 unsigned quad auquad;
467#endif
a687059c 468 char *aptr;
ff8e2863 469 float afloat;
470 double adouble;
a687059c 471
472 items = arglast[2] - sp;
473 st += ++sp;
474 str_nset(str,"",0);
475 while (pat < patend) {
476#define NEXTFROM (items-- > 0 ? *st++ : &str_no)
477 datumtype = *pat++;
ff8e2863 478 if (*pat == '*') {
479 len = index("@Xxu",datumtype) ? 0 : items;
480 pat++;
481 }
db4e6270 482 else if (isDIGIT(*pat)) {
afd9f252 483 len = *pat++ - '0';
db4e6270 484 while (isDIGIT(*pat))
afd9f252 485 len = (len * 10) + (*pat++ - '0');
a687059c 486 }
487 else
488 len = 1;
489 switch(datumtype) {
490 default:
491 break;
ff8e2863 492 case '%':
493 fatal("% may only be used in unpack");
494 case '@':
495 len -= str->str_cur;
496 if (len > 0)
497 goto grow;
498 len = -len;
499 if (len > 0)
500 goto shrink;
501 break;
502 case 'X':
503 shrink:
57ebbfd0 504 if (str->str_cur < len)
ff8e2863 505 fatal("X outside of string");
57ebbfd0 506 str->str_cur -= len;
ff8e2863 507 str->str_ptr[str->str_cur] = '\0';
508 break;
a687059c 509 case 'x':
ff8e2863 510 grow:
a687059c 511 while (len >= 10) {
512 str_ncat(str,null10,10);
513 len -= 10;
514 }
515 str_ncat(str,null10,len);
516 break;
517 case 'A':
518 case 'a':
519 fromstr = NEXTFROM;
520 aptr = str_get(fromstr);
ff8e2863 521 if (pat[-1] == '*')
522 len = fromstr->str_cur;
a687059c 523 if (fromstr->str_cur > len)
524 str_ncat(str,aptr,len);
ff2452de 525 else {
a687059c 526 str_ncat(str,aptr,fromstr->str_cur);
ff2452de 527 len -= fromstr->str_cur;
528 if (datumtype == 'A') {
529 while (len >= 10) {
530 str_ncat(str,space10,10);
531 len -= 10;
532 }
533 str_ncat(str,space10,len);
a687059c 534 }
ff2452de 535 else {
536 while (len >= 10) {
537 str_ncat(str,null10,10);
538 len -= 10;
539 }
540 str_ncat(str,null10,len);
a687059c 541 }
a687059c 542 }
543 break;
7e1cf235 544 case 'B':
545 case 'b':
546 {
547 char *savepat = pat;
1462b684 548 int saveitems;
7e1cf235 549
550 fromstr = NEXTFROM;
1462b684 551 saveitems = items;
7e1cf235 552 aptr = str_get(fromstr);
553 if (pat[-1] == '*')
554 len = fromstr->str_cur;
555 pat = aptr;
556 aint = str->str_cur;
557 str->str_cur += (len+7)/8;
558 STR_GROW(str, str->str_cur + 1);
559 aptr = str->str_ptr + aint;
560 if (len > fromstr->str_cur)
561 len = fromstr->str_cur;
562 aint = len;
563 items = 0;
564 if (datumtype == 'B') {
565 for (len = 0; len++ < aint;) {
566 items |= *pat++ & 1;
567 if (len & 7)
568 items <<= 1;
569 else {
570 *aptr++ = items & 0xff;
571 items = 0;
572 }
573 }
574 }
575 else {
576 for (len = 0; len++ < aint;) {
577 if (*pat++ & 1)
578 items |= 128;
579 if (len & 7)
580 items >>= 1;
581 else {
582 *aptr++ = items & 0xff;
583 items = 0;
584 }
585 }
586 }
587 if (aint & 7) {
588 if (datumtype == 'B')
589 items <<= 7 - (aint & 7);
590 else
591 items >>= 7 - (aint & 7);
592 *aptr++ = items & 0xff;
593 }
594 pat = str->str_ptr + str->str_cur;
595 while (aptr <= pat)
596 *aptr++ = '\0';
597
598 pat = savepat;
599 items = saveitems;
600 }
601 break;
602 case 'H':
603 case 'h':
604 {
605 char *savepat = pat;
1462b684 606 int saveitems;
7e1cf235 607
608 fromstr = NEXTFROM;
1462b684 609 saveitems = items;
7e1cf235 610 aptr = str_get(fromstr);
611 if (pat[-1] == '*')
612 len = fromstr->str_cur;
613 pat = aptr;
614 aint = str->str_cur;
615 str->str_cur += (len+1)/2;
616 STR_GROW(str, str->str_cur + 1);
617 aptr = str->str_ptr + aint;
618 if (len > fromstr->str_cur)
619 len = fromstr->str_cur;
620 aint = len;
621 items = 0;
622 if (datumtype == 'H') {
623 for (len = 0; len++ < aint;) {
db4e6270 624 if (isALPHA(*pat))
7e1cf235 625 items |= ((*pat++ & 15) + 9) & 15;
626 else
627 items |= *pat++ & 15;
628 if (len & 1)
629 items <<= 4;
630 else {
631 *aptr++ = items & 0xff;
632 items = 0;
633 }
634 }
635 }
636 else {
637 for (len = 0; len++ < aint;) {
db4e6270 638 if (isALPHA(*pat))
7e1cf235 639 items |= (((*pat++ & 15) + 9) & 15) << 4;
640 else
641 items |= (*pat++ & 15) << 4;
642 if (len & 1)
643 items >>= 4;
644 else {
645 *aptr++ = items & 0xff;
646 items = 0;
647 }
648 }
649 }
650 if (aint & 1)
651 *aptr++ = items & 0xff;
652 pat = str->str_ptr + str->str_cur;
653 while (aptr <= pat)
654 *aptr++ = '\0';
655
656 pat = savepat;
657 items = saveitems;
658 }
659 break;
a687059c 660 case 'C':
661 case 'c':
662 while (len-- > 0) {
663 fromstr = NEXTFROM;
664 aint = (int)str_gnum(fromstr);
665 achar = aint;
666 str_ncat(str,&achar,sizeof(char));
667 }
668 break;
ff8e2863 669 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
670 case 'f':
671 case 'F':
672 while (len-- > 0) {
673 fromstr = NEXTFROM;
674 afloat = (float)str_gnum(fromstr);
675 str_ncat(str, (char *)&afloat, sizeof (float));
676 }
677 break;
678 case 'd':
679 case 'D':
680 while (len-- > 0) {
681 fromstr = NEXTFROM;
682 adouble = (double)str_gnum(fromstr);
683 str_ncat(str, (char *)&adouble, sizeof (double));
684 }
685 break;
a687059c 686 case 'n':
687 while (len-- > 0) {
688 fromstr = NEXTFROM;
689 ashort = (short)str_gnum(fromstr);
fe14fcc3 690#ifdef HAS_HTONS
a687059c 691 ashort = htons(ashort);
692#endif
693 str_ncat(str,(char*)&ashort,sizeof(short));
694 }
695 break;
988174c1 696 case 'v':
697 while (len-- > 0) {
698 fromstr = NEXTFROM;
699 ashort = (short)str_gnum(fromstr);
700#ifdef HAS_HTOVS
701 ashort = htovs(ashort);
702#endif
703 str_ncat(str,(char*)&ashort,sizeof(short));
704 }
705 break;
a687059c 706 case 'S':
707 case 's':
708 while (len-- > 0) {
709 fromstr = NEXTFROM;
710 ashort = (short)str_gnum(fromstr);
711 str_ncat(str,(char*)&ashort,sizeof(short));
712 }
713 break;
714 case 'I':
afd9f252 715 while (len-- > 0) {
716 fromstr = NEXTFROM;
b1248f16 717 auint = U_I(str_gnum(fromstr));
afd9f252 718 str_ncat(str,(char*)&auint,sizeof(unsigned int));
719 }
720 break;
a687059c 721 case 'i':
722 while (len-- > 0) {
723 fromstr = NEXTFROM;
724 aint = (int)str_gnum(fromstr);
725 str_ncat(str,(char*)&aint,sizeof(int));
726 }
727 break;
728 case 'N':
729 while (len-- > 0) {
730 fromstr = NEXTFROM;
7e1cf235 731 aulong = U_L(str_gnum(fromstr));
fe14fcc3 732#ifdef HAS_HTONL
7e1cf235 733 aulong = htonl(aulong);
a687059c 734#endif
7e1cf235 735 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
a687059c 736 }
737 break;
988174c1 738 case 'V':
739 while (len-- > 0) {
740 fromstr = NEXTFROM;
741 aulong = U_L(str_gnum(fromstr));
742#ifdef HAS_HTOVL
743 aulong = htovl(aulong);
744#endif
745 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
746 }
747 break;
a687059c 748 case 'L':
afd9f252 749 while (len-- > 0) {
750 fromstr = NEXTFROM;
b1248f16 751 aulong = U_L(str_gnum(fromstr));
afd9f252 752 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
753 }
754 break;
a687059c 755 case 'l':
756 while (len-- > 0) {
757 fromstr = NEXTFROM;
758 along = (long)str_gnum(fromstr);
759 str_ncat(str,(char*)&along,sizeof(long));
760 }
761 break;
db4e6270 762#ifdef QUAD
763 case 'Q':
764 while (len-- > 0) {
765 fromstr = NEXTFROM;
766 auquad = (unsigned quad)str_gnum(fromstr);
767 str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
768 }
769 break;
770 case 'q':
771 while (len-- > 0) {
772 fromstr = NEXTFROM;
773 aquad = (quad)str_gnum(fromstr);
774 str_ncat(str,(char*)&aquad,sizeof(quad));
775 }
776 break;
777#endif /* QUAD */
a687059c 778 case 'p':
779 while (len-- > 0) {
780 fromstr = NEXTFROM;
781 aptr = str_get(fromstr);
782 str_ncat(str,(char*)&aptr,sizeof(char*));
783 }
784 break;
ff8e2863 785 case 'u':
786 fromstr = NEXTFROM;
787 aptr = str_get(fromstr);
788 aint = fromstr->str_cur;
789 STR_GROW(str,aint * 4 / 3);
790 if (len <= 1)
791 len = 45;
792 else
793 len = len / 3 * 3;
794 while (aint > 0) {
795 int todo;
796
797 if (aint > len)
798 todo = len;
799 else
800 todo = aint;
801 doencodes(str, aptr, todo);
802 aint -= todo;
803 aptr += todo;
804 }
805 break;
a687059c 806 }
807 }
808 STABSET(str);
809}
810#undef NEXTFROM
811
8adcabd8 812static void
ff8e2863 813doencodes(str, s, len)
814register STR *str;
815register char *s;
816register int len;
817{
818 char hunk[5];
819
820 *hunk = len + ' ';
821 str_ncat(str, hunk, 1);
822 hunk[4] = '\0';
823 while (len > 0) {
824 hunk[0] = ' ' + (077 & (*s >> 2));
825 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
826 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
827 hunk[3] = ' ' + (077 & (s[2] & 077));
828 str_ncat(str, hunk, 4);
829 s += 3;
830 len -= 3;
831 }
fe14fcc3 832 for (s = str->str_ptr; *s; s++) {
833 if (*s == ' ')
834 *s = '`';
835 }
ff8e2863 836 str_ncat(str, "\n", 1);
837}
838
a687059c 839void
840do_sprintf(str,len,sarg)
841register STR *str;
842register int len;
843register STR **sarg;
844{
845 register char *s;
846 register char *t;
57ebbfd0 847 register char *f;
a687059c 848 bool dolong;
db4e6270 849#ifdef QUAD
850 bool doquad;
851#endif /* QUAD */
a687059c 852 char ch;
853 static STR *sargnull = &str_no;
854 register char *send;
db4e6270 855 register STR *arg;
a687059c 856 char *xs;
857 int xlen;
db4e6270 858 int pre;
859 int post;
afd9f252 860 double value;
a687059c 861
862 str_set(str,"");
863 len--; /* don't count pattern string */
db4e6270 864 t = s = str_get(*sarg);
a687059c 865 send = s + (*sarg)->str_cur;
866 sarg++;
57ebbfd0 867 for ( ; ; len--) {
db4e6270 868
869 /*SUPPRESS 560*/
870 if (len <= 0 || !(arg = *sarg++))
871 arg = sargnull;
872
873 /*SUPPRESS 530*/
57ebbfd0 874 for ( ; t < send && *t != '%'; t++) ;
a687059c 875 if (t >= send)
57ebbfd0 876 break; /* end of format string, ignore extra args */
877 f = t;
878 *buf = '\0';
879 xs = buf;
db4e6270 880#ifdef QUAD
881 doquad =
882#endif /* QUAD */
57ebbfd0 883 dolong = FALSE;
db4e6270 884 pre = post = 0;
57ebbfd0 885 for (t++; t < send; t++) {
a687059c 886 switch (*t) {
887 default:
888 ch = *(++t);
889 *t = '\0';
57ebbfd0 890 (void)sprintf(xs,f);
db4e6270 891 len++, sarg--;
7e1cf235 892 xlen = strlen(xs);
a687059c 893 break;
894 case '0': case '1': case '2': case '3': case '4':
895 case '5': case '6': case '7': case '8': case '9':
57ebbfd0 896 case '.': case '#': case '-': case '+': case ' ':
897 continue;
a687059c 898 case 'l':
db4e6270 899#ifdef QUAD
900 if (dolong) {
901 dolong = FALSE;
902 doquad = TRUE;
903 } else
904#endif
a687059c 905 dolong = TRUE;
57ebbfd0 906 continue;
a687059c 907 case 'c':
bf38876a 908 ch = *(++t);
909 *t = '\0';
db4e6270 910 xlen = (int)str_gnum(arg);
57ebbfd0 911 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
912 *xs = xlen;
913 xs[1] = '\0';
7e1cf235 914 xlen = 1;
bf38876a 915 }
7e1cf235 916 else {
57ebbfd0 917 (void)sprintf(xs,f,xlen);
7e1cf235 918 xlen = strlen(xs);
919 }
a687059c 920 break;
bf38876a 921 case 'D':
922 dolong = TRUE;
923 /* FALL THROUGH */
924 case 'd':
a687059c 925 ch = *(++t);
926 *t = '\0';
db4e6270 927#ifdef QUAD
928 if (doquad)
929 (void)sprintf(buf,s,(quad)str_gnum(arg));
930 else
931#endif
a687059c 932 if (dolong)
db4e6270 933 (void)sprintf(xs,f,(long)str_gnum(arg));
a687059c 934 else
db4e6270 935 (void)sprintf(xs,f,(int)str_gnum(arg));
7e1cf235 936 xlen = strlen(xs);
a687059c 937 break;
bf38876a 938 case 'X': case 'O':
939 dolong = TRUE;
940 /* FALL THROUGH */
941 case 'x': case 'o': case 'u':
942 ch = *(++t);
943 *t = '\0';
db4e6270 944 value = str_gnum(arg);
945#ifdef QUAD
946 if (doquad)
947 (void)sprintf(buf,s,(unsigned quad)value);
948 else
949#endif
bf38876a 950 if (dolong)
57ebbfd0 951 (void)sprintf(xs,f,U_L(value));
bf38876a 952 else
57ebbfd0 953 (void)sprintf(xs,f,U_I(value));
7e1cf235 954 xlen = strlen(xs);
bf38876a 955 break;
a687059c 956 case 'E': case 'e': case 'f': case 'G': case 'g':
957 ch = *(++t);
958 *t = '\0';
db4e6270 959 (void)sprintf(xs,f,str_gnum(arg));
7e1cf235 960 xlen = strlen(xs);
a687059c 961 break;
962 case 's':
963 ch = *(++t);
964 *t = '\0';
db4e6270 965 xs = str_get(arg);
966 xlen = arg->str_cur;
1c3d792e 967 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
968 && xlen == sizeof(STBP)) {
20188a90 969 STR *tmpstr = Str_new(24,0);
970
8adcabd8 971 stab_efullname(tmpstr, ((STAB*)arg)); /* a stab value! */
20188a90 972 sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
973 /* reformat to non-binary */
a687059c 974 xs = tokenbuf;
975 xlen = strlen(tokenbuf);
20188a90 976 str_free(tmpstr);
a687059c 977 }
57ebbfd0 978 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
db4e6270 979 break; /* so handle simple cases */
980 }
981 else if (f[1] == '-') {
982 char *mp = index(f, '.');
983 int min = atoi(f+2);
984
985 if (xlen < min)
986 post = min - xlen;
987 else if (mp) {
988 int max = atoi(mp+1);
989
990 if (xlen > max)
991 xlen = max;
992 }
993 break;
994 }
995 else if (isDIGIT(f[1])) {
996 char *mp = index(f, '.');
997 int min = atoi(f+1);
998
999 if (xlen < min)
1000 pre = min - xlen;
1001 else if (mp) {
1002 int max = atoi(mp+1);
1003
1004 if (xlen > max)
1005 xlen = max;
1006 }
1007 break;
57ebbfd0 1008 }
1009 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
1010 *t = ch;
1011 (void)sprintf(buf,tokenbuf+64,xs);
1012 xs = buf;
7e1cf235 1013 xlen = strlen(xs);
a687059c 1014 break;
1015 }
57ebbfd0 1016 /* end of switch, copy results */
1017 *t = ch;
db4e6270 1018 STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
57ebbfd0 1019 str_ncat(str, s, f - s);
db4e6270 1020 if (pre) {
1021 repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
1022 str->str_cur += pre;
1023 }
57ebbfd0 1024 str_ncat(str, xs, xlen);
db4e6270 1025 if (post) {
1026 repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
1027 str->str_cur += post;
1028 }
a687059c 1029 s = t;
57ebbfd0 1030 break; /* break from for loop */
a687059c 1031 }
a687059c 1032 }
57ebbfd0 1033 str_ncat(str, s, t - s);
a687059c 1034 STABSET(str);
1035}
1036
1037STR *
1038do_push(ary,arglast)
1039register ARRAY *ary;
1040int *arglast;
1041{
1042 register STR **st = stack->ary_array;
1043 register int sp = arglast[1];
1044 register int items = arglast[2] - sp;
1045 register STR *str = &str_undef;
1046
1047 for (st += ++sp; items > 0; items--,st++) {
1048 str = Str_new(26,0);
1049 if (*st)
1050 str_sset(str,*st);
1051 (void)apush(ary,str);
1052 }
1053 return str;
1054}
1055
fe14fcc3 1056void
a687059c 1057do_unshift(ary,arglast)
1058register ARRAY *ary;
1059int *arglast;
1060{
1061 register STR **st = stack->ary_array;
1062 register int sp = arglast[1];
1063 register int items = arglast[2] - sp;
1064 register STR *str;
1065 register int i;
1066
1067 aunshift(ary,items);
1068 i = 0;
1069 for (st += ++sp; i < items; i++,st++) {
1070 str = Str_new(27,0);
1071 str_sset(str,*st);
1072 (void)astore(ary,i,str);
1073 }
1074}
1075
1076int
1077do_subr(arg,gimme,arglast)
1078register ARG *arg;
1079int gimme;
1080int *arglast;
1081{
1082 register STR **st = stack->ary_array;
1083 register int sp = arglast[1];
1084 register int items = arglast[2] - sp;
1085 register SUBR *sub;
8adcabd8 1086 SPAT * VOLATILE oldspat = curspat;
20188a90 1087 STR *str;
a687059c 1088 STAB *stab;
a687059c 1089 int oldsave = savestack->ary_fill;
1090 int oldtmps_base = tmps_base;
20188a90 1091 int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
1092 register CSV *csv;
a687059c 1093
1094 if ((arg[1].arg_type & A_MASK) == A_WORD)
1095 stab = arg[1].arg_ptr.arg_stab;
1096 else {
db4e6270 1097 STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
a687059c 1098
1099 if (tmpstr)
1100 stab = stabent(str_get(tmpstr),TRUE);
1101 else
1102 stab = Nullstab;
1103 }
1104 if (!stab)
1105 fatal("Undefined subroutine called");
1c3d792e 1106 if (!(sub = stab_sub(stab))) {
1107 STR *tmpstr = arg[0].arg_ptr.arg_str;
1108
8adcabd8 1109 stab_efullname(tmpstr, stab);
1c3d792e 1110 fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
1111 }
fe14fcc3 1112 if (arg->arg_type == O_DBSUBR && !sub->usersub) {
20188a90 1113 str = stab_val(DBsub);
1114 saveitem(str);
8adcabd8 1115 stab_efullname(str,stab);
20188a90 1116 sub = stab_sub(DBsub);
1117 if (!sub)
1118 fatal("No DBsub routine");
a687059c 1119 }
20188a90 1120 str = Str_new(15, sizeof(CSV));
1121 str->str_state = SS_SCSV;
1122 (void)apush(savestack,str);
1123 csv = (CSV*)str->str_ptr;
1124 csv->sub = sub;
1125 csv->stab = stab;
1126 csv->curcsv = curcsv;
1127 csv->curcmd = curcmd;
1128 csv->depth = sub->depth;
1129 csv->wantarray = gimme;
1130 csv->hasargs = hasargs;
1131 curcsv = csv;
8adcabd8 1132 tmps_base = tmps_max;
20188a90 1133 if (sub->usersub) {
7e1cf235 1134 csv->hasargs = 0;
1135 csv->savearray = Null(ARRAY*);;
1136 csv->argarray = Null(ARRAY*);
20188a90 1137 st[sp] = arg->arg_ptr.arg_str;
1138 if (!hasargs)
1139 items = 0;
8adcabd8 1140 sp = (*sub->usersub)(sub->userindex,sp,items);
a687059c 1141 }
8adcabd8 1142 else {
1143 if (hasargs) {
1144 csv->savearray = stab_xarray(defstab);
1145 csv->argarray = afake(defstab, items, &st[sp+1]);
1146 stab_xarray(defstab) = csv->argarray;
1147 }
1148 sub->depth++;
1149 if (sub->depth >= 2) { /* save temporaries on recursion? */
1150 if (sub->depth == 100 && dowarn)
1151 warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
1152 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
1153 }
1154 sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
a687059c 1155 }
a687059c 1156
8adcabd8 1157 st = stack->ary_array;
a687059c 1158 tmps_base = oldtmps_base;
20188a90 1159 for (items = arglast[0] + 1; items <= sp; items++)
fe14fcc3 1160 st[items] = str_mortal(st[items]);
20188a90 1161 /* in case restore wipes old str */
1162 restorelist(oldsave);
8adcabd8 1163 curspat = oldspat;
a687059c 1164 return sp;
1165}
1166
1167int
1168do_assign(arg,gimme,arglast)
1169register ARG *arg;
1170int gimme;
1171int *arglast;
1172{
1173
1174 register STR **st = stack->ary_array;
1175 STR **firstrelem = st + arglast[1] + 1;
1176 STR **firstlelem = st + arglast[0] + 1;
1177 STR **lastrelem = st + arglast[2];
1178 STR **lastlelem = st + arglast[1];
1179 register STR **relem;
1180 register STR **lelem;
1181
1182 register STR *str;
1183 register ARRAY *ary;
1184 register int makelocal;
1185 HASH *hash;
1186 int i;
1187
db4e6270 1188 makelocal = (arg->arg_flags & AF_LOCAL) != 0;
afd9f252 1189 localizing = makelocal;
a687059c 1190 delaymagic = DM_DELAY; /* catch simultaneous items */
1191
1192 /* If there's a common identifier on both sides we have to take
1193 * special care that assigning the identifier on the left doesn't
1194 * clobber a value on the right that's used later in the list.
1195 */
1196 if (arg->arg_flags & AF_COMMON) {
1197 for (relem = firstrelem; relem <= lastrelem; relem++) {
db4e6270 1198 /*SUPPRESS 560*/
a687059c 1199 if (str = *relem)
fe14fcc3 1200 *relem = str_mortal(str);
a687059c 1201 }
1202 }
1203 relem = firstrelem;
1204 lelem = firstlelem;
1205 ary = Null(ARRAY*);
1206 hash = Null(HASH*);
1207 while (lelem <= lastlelem) {
1208 str = *lelem++;
1209 if (str->str_state >= SS_HASH) {
1210 if (str->str_state == SS_ARY) {
1211 if (makelocal)
1212 ary = saveary(str->str_u.str_stab);
1213 else {
1214 ary = stab_array(str->str_u.str_stab);
1215 ary->ary_fill = -1;
1216 }
1217 i = 0;
1218 while (relem <= lastrelem) { /* gobble up all the rest */
1219 str = Str_new(28,0);
1220 if (*relem)
afd9f252 1221 str_sset(str,*relem);
1222 *(relem++) = str;
a687059c 1223 (void)astore(ary,i++,str);
1224 }
1225 }
1226 else if (str->str_state == SS_HASH) {
1227 char *tmps;
1228 STR *tmpstr;
20188a90 1229 int magic = 0;
1230 STAB *tmpstab = str->str_u.str_stab;
a687059c 1231
1232 if (makelocal)
1233 hash = savehash(str->str_u.str_stab);
1234 else {
1235 hash = stab_hash(str->str_u.str_stab);
20188a90 1236 if (tmpstab == envstab) {
1237 magic = 'E';
1238 environ[0] = Nullch;
1239 }
1240 else if (tmpstab == sigstab) {
1241 magic = 'S';
1242#ifndef NSIG
1243#define NSIG 32
1244#endif
1245 for (i = 1; i < NSIG; i++)
1246 signal(i, SIG_DFL); /* crunch, crunch, crunch */
1247 }
1248#ifdef SOME_DBM
1249 else if (hash->tbl_dbm)
1250 magic = 'D';
1251#endif
1252 hclear(hash, magic == 'D'); /* wipe any dbm file too */
1253
a687059c 1254 }
1255 while (relem < lastrelem) { /* gobble up all the rest */
1256 if (*relem)
1257 str = *(relem++);
1258 else
1259 str = &str_no, relem++;
1260 tmps = str_get(str);
1261 tmpstr = Str_new(29,0);
1262 if (*relem)
afd9f252 1263 str_sset(tmpstr,*relem); /* value */
1264 *(relem++) = tmpstr;
a687059c 1265 (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
20188a90 1266 if (magic) {
1267 str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
1268 stabset(tmpstr->str_magic, tmpstr);
1269 }
a687059c 1270 }
1271 }
1272 else
1273 fatal("panic: do_assign");
1274 }
1275 else {
1276 if (makelocal)
1277 saveitem(str);
afd9f252 1278 if (relem <= lastrelem) {
1279 str_sset(str, *relem);
1280 *(relem++) = str;
1281 }
1282 else {
20188a90 1283 str_sset(str, &str_undef);
afd9f252 1284 if (gimme == G_ARRAY) {
1285 i = ++lastrelem - firstrelem;
1286 relem++; /* tacky, I suppose */
1287 astore(stack,i,str);
1288 if (st != stack->ary_array) {
1289 st = stack->ary_array;
1290 firstrelem = st + arglast[1] + 1;
1291 firstlelem = st + arglast[0] + 1;
1292 lastlelem = st + arglast[1];
1293 lastrelem = st + i;
1294 relem = lastrelem + 1;
1295 }
1296 }
1297 }
a687059c 1298 STABSET(str);
1299 }
1300 }
8adcabd8 1301 if (delaymagic & ~DM_DELAY) {
1302 if (delaymagic & DM_UID) {
fe14fcc3 1303#ifdef HAS_SETREUID
8adcabd8 1304 (void)setreuid(uid,euid);
1305#else /* not HAS_SETREUID */
1306#ifdef HAS_SETRUID
1307 if ((delaymagic & DM_UID) == DM_RUID) {
1308 (void)setruid(uid);
1309 delaymagic =~ DM_RUID;
1310 }
1311#endif /* HAS_SETRUID */
1312#ifdef HAS_SETEUID
1313 if ((delaymagic & DM_UID) == DM_EUID) {
1314 (void)seteuid(uid);
1315 delaymagic =~ DM_EUID;
1316 }
1317#endif /* HAS_SETEUID */
1318 if (delaymagic & DM_UID) {
1319 if (uid != euid)
1320 fatal("No setreuid available");
1321 (void)setuid(uid);
1322 }
1323#endif /* not HAS_SETREUID */
1324 uid = (int)getuid();
1325 euid = (int)geteuid();
ff8e2863 1326 }
8adcabd8 1327 if (delaymagic & DM_GID) {
fe14fcc3 1328#ifdef HAS_SETREGID
8adcabd8 1329 (void)setregid(gid,egid);
1330#else /* not HAS_SETREGID */
1331#ifdef HAS_SETRGID
1332 if ((delaymagic & DM_GID) == DM_RGID) {
1333 (void)setrgid(gid);
1334 delaymagic =~ DM_RGID;
1335 }
1336#endif /* HAS_SETRGID */
1337#ifdef HAS_SETEGID
1338 if ((delaymagic & DM_GID) == DM_EGID) {
1339 (void)setegid(gid);
1340 delaymagic =~ DM_EGID;
1341 }
1342#endif /* HAS_SETEGID */
1343 if (delaymagic & DM_GID) {
1344 if (gid != egid)
1345 fatal("No setregid available");
1346 (void)setgid(gid);
1347 }
1348#endif /* not HAS_SETREGID */
1349 gid = (int)getgid();
1350 egid = (int)getegid();
ff8e2863 1351 }
a687059c 1352 }
1353 delaymagic = 0;
afd9f252 1354 localizing = FALSE;
a687059c 1355 if (gimme == G_ARRAY) {
1356 i = lastrelem - firstrelem + 1;
1357 if (ary || hash)
1358 Copy(firstrelem, firstlelem, i, STR*);
1359 return arglast[0] + i;
1360 }
1361 else {
1362 str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
1363 *firstlelem = arg->arg_ptr.arg_str;
1364 return arglast[0] + 1;
1365 }
1366}
1367
db4e6270 1368int /*SUPPRESS 590*/
a687059c 1369do_study(str,arg,gimme,arglast)
1370STR *str;
1371ARG *arg;
1372int gimme;
1373int *arglast;
1374{
1375 register unsigned char *s;
1376 register int pos = str->str_cur;
1377 register int ch;
1378 register int *sfirst;
1379 register int *snext;
1380 static int maxscream = -1;
1381 static STR *lastscream = Nullstr;
1382 int retval;
1383 int retarg = arglast[0] + 1;
1384
1385#ifndef lint
1386 s = (unsigned char*)(str_get(str));
1387#else
1388 s = Null(unsigned char*);
1389#endif
1390 if (lastscream)
1391 lastscream->str_pok &= ~SP_STUDIED;
1392 lastscream = str;
1393 if (pos <= 0) {
1394 retval = 0;
1395 goto ret;
1396 }
1397 if (pos > maxscream) {
1398 if (maxscream < 0) {
1399 maxscream = pos + 80;
1400 New(301,screamfirst, 256, int);
1401 New(302,screamnext, maxscream, int);
1402 }
1403 else {
1404 maxscream = pos + pos / 4;
1405 Renew(screamnext, maxscream, int);
1406 }
1407 }
1408
1409 sfirst = screamfirst;
1410 snext = screamnext;
1411
1412 if (!sfirst || !snext)
1413 fatal("do_study: out of memory");
1414
1415 for (ch = 256; ch; --ch)
1416 *sfirst++ = -1;
1417 sfirst -= 256;
1418
1419 while (--pos >= 0) {
1420 ch = s[pos];
1421 if (sfirst[ch] >= 0)
1422 snext[pos] = sfirst[ch] - pos;
1423 else
1424 snext[pos] = -pos;
1425 sfirst[ch] = pos;
1426
1427 /* If there were any case insensitive searches, we must assume they
1428 * all are. This speeds up insensitive searches much more than
1429 * it slows down sensitive ones.
1430 */
1431 if (sawi)
1432 sfirst[fold[ch]] = pos;
1433 }
1434
1435 str->str_pok |= SP_STUDIED;
1436 retval = 1;
1437 ret:
1438 str_numset(arg->arg_ptr.arg_str,(double)retval);
1439 stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1440 return retarg;
1441}
1442
db4e6270 1443int /*SUPPRESS 590*/
a687059c 1444do_defined(str,arg,gimme,arglast)
1445STR *str;
1446register ARG *arg;
1447int gimme;
1448int *arglast;
1449{
1450 register int type;
1451 register int retarg = arglast[0] + 1;
1452 int retval;
6eb13c3b 1453 ARRAY *ary;
1454 HASH *hash;
a687059c 1455
1456 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1457 fatal("Illegal argument to defined()");
1458 arg = arg[1].arg_ptr.arg_arg;
1459 type = arg->arg_type;
1460
db4e6270 1461 if (type == O_SUBR || type == O_DBSUBR) {
1462 if ((arg[1].arg_type & A_MASK) == A_WORD)
1463 retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1464 else {
1465 STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
1466
1467 retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
1468 }
1469 }
6eb13c3b 1470 else if (type == O_ARRAY || type == O_LARRAY ||
1471 type == O_ASLICE || type == O_LASLICE )
1472 retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
1473 && ary->ary_max >= 0 );
1474 else if (type == O_HASH || type == O_LHASH ||
1475 type == O_HSLICE || type == O_LHSLICE )
1476 retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
1477 && hash->tbl_array);
a687059c 1478 else
1479 retval = FALSE;
1480 str_numset(str,(double)retval);
1481 stack->ary_array[retarg] = str;
1482 return retarg;
1483}
1484
db4e6270 1485int /*SUPPRESS 590*/
a687059c 1486do_undef(str,arg,gimme,arglast)
1487STR *str;
1488register ARG *arg;
1489int gimme;
1490int *arglast;
1491{
1492 register int type;
1493 register STAB *stab;
1494 int retarg = arglast[0] + 1;
1495
1496 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1497 fatal("Illegal argument to undef()");
1498 arg = arg[1].arg_ptr.arg_arg;
1499 type = arg->arg_type;
1500
1501 if (type == O_ARRAY || type == O_LARRAY) {
1502 stab = arg[1].arg_ptr.arg_stab;
1503 afree(stab_xarray(stab));
6e21c824 1504 stab_xarray(stab) = anew(stab); /* so "@array" still works */
a687059c 1505 }
1506 else if (type == O_HASH || type == O_LHASH) {
1507 stab = arg[1].arg_ptr.arg_stab;
20188a90 1508 if (stab == envstab)
1509 environ[0] = Nullch;
1510 else if (stab == sigstab) {
1511 int i;
1512
1513 for (i = 1; i < NSIG; i++)
1514 signal(i, SIG_DFL); /* munch, munch, munch */
1515 }
1516 (void)hfree(stab_xhash(stab), TRUE);
a687059c 1517 stab_xhash(stab) = Null(HASH*);
1518 }
1519 else if (type == O_SUBR || type == O_DBSUBR) {
1520 stab = arg[1].arg_ptr.arg_stab;
db4e6270 1521 if ((arg[1].arg_type & A_MASK) != A_WORD) {
1522 STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
1523
1524 if (tmpstr)
1525 stab = stabent(str_get(tmpstr),TRUE);
1526 else
1527 stab = Nullstab;
1528 }
1529 if (stab && stab_sub(stab)) {
fe14fcc3 1530 cmd_free(stab_sub(stab)->cmd);
1531 stab_sub(stab)->cmd = Nullcmd;
1532 afree(stab_sub(stab)->tosave);
1533 Safefree(stab_sub(stab));
1534 stab_sub(stab) = Null(SUBR*);
1535 }
a687059c 1536 }
1537 else
1538 fatal("Can't undefine that kind of object");
1539 str_numset(str,0.0);
1540 stack->ary_array[retarg] = str;
1541 return retarg;
1542}
1543
1544int
1545do_vec(lvalue,astr,arglast)
1546int lvalue;
1547STR *astr;
1548int *arglast;
1549{
1550 STR **st = stack->ary_array;
1551 int sp = arglast[0];
1552 register STR *str = st[++sp];
1553 register int offset = (int)str_gnum(st[++sp]);
1554 register int size = (int)str_gnum(st[++sp]);
1555 unsigned char *s = (unsigned char*)str_get(str);
1556 unsigned long retnum;
1557 int len;
1558
1559 sp = arglast[1];
1560 offset *= size; /* turn into bit offset */
1561 len = (offset + size + 7) / 8;
1562 if (offset < 0 || size < 1)
1563 retnum = 0;
1564 else if (!lvalue && len > str->str_cur)
1565 retnum = 0;
1566 else {
1567 if (len > str->str_cur) {
1568 STR_GROW(str,len);
8adcabd8 1569 (void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
a687059c 1570 str->str_cur = len;
1571 }
1572 s = (unsigned char*)str_get(str);
1573 if (size < 8)
1574 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1575 else {
1576 offset >>= 3;
1577 if (size == 8)
1578 retnum = s[offset];
1579 else if (size == 16)
db4e6270 1580 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
a687059c 1581 else if (size == 32)
db4e6270 1582 retnum = ((unsigned long) s[offset] << 24) +
1583 ((unsigned long) s[offset + 1] << 16) +
a687059c 1584 (s[offset + 2] << 8) + s[offset+3];
1585 }
1586
1587 if (lvalue) { /* it's an lvalue! */
1588 struct lstring *lstr = (struct lstring*)astr;
1589
1590 astr->str_magic = str;
1591 st[sp]->str_rare = 'v';
1592 lstr->lstr_offset = offset;
1593 lstr->lstr_len = size;
1594 }
1595 }
1596
1597 str_numset(astr,(double)retnum);
1598 st[sp] = astr;
1599 return sp;
1600}
1601
1602void
1603do_vecset(mstr,str)
1604STR *mstr;
1605STR *str;
1606{
1607 struct lstring *lstr = (struct lstring*)str;
1608 register int offset;
1609 register int size;
1610 register unsigned char *s = (unsigned char*)mstr->str_ptr;
b1248f16 1611 register unsigned long lval = U_L(str_gnum(str));
a687059c 1612 int mask;
1613
1614 mstr->str_rare = 0;
1615 str->str_magic = Nullstr;
1616 offset = lstr->lstr_offset;
1617 size = lstr->lstr_len;
1618 if (size < 8) {
1619 mask = (1 << size) - 1;
1620 size = offset & 7;
1621 lval &= mask;
1622 offset >>= 3;
1623 s[offset] &= ~(mask << size);
1624 s[offset] |= lval << size;
1625 }
1626 else {
1627 if (size == 8)
1628 s[offset] = lval & 255;
1629 else if (size == 16) {
1630 s[offset] = (lval >> 8) & 255;
1631 s[offset+1] = lval & 255;
1632 }
1633 else if (size == 32) {
1634 s[offset] = (lval >> 24) & 255;
1635 s[offset+1] = (lval >> 16) & 255;
1636 s[offset+2] = (lval >> 8) & 255;
1637 s[offset+3] = lval & 255;
1638 }
1639 }
1640}
1641
8adcabd8 1642void
a687059c 1643do_chop(astr,str)
1644register STR *astr;
1645register STR *str;
1646{
1647 register char *tmps;
1648 register int i;
1649 ARRAY *ary;
1650 HASH *hash;
1651 HENT *entry;
1652
1653 if (!str)
1654 return;
1655 if (str->str_state == SS_ARY) {
1656 ary = stab_array(str->str_u.str_stab);
1657 for (i = 0; i <= ary->ary_fill; i++)
1658 do_chop(astr,ary->ary_array[i]);
1659 return;
1660 }
1661 if (str->str_state == SS_HASH) {
1662 hash = stab_hash(str->str_u.str_stab);
1663 (void)hiterinit(hash);
db4e6270 1664 /*SUPPRESS 560*/
a687059c 1665 while (entry = hiternext(hash))
1666 do_chop(astr,hiterval(hash,entry));
1667 return;
1668 }
1669 tmps = str_get(str);
6e21c824 1670 if (tmps && str->str_cur) {
1671 tmps += str->str_cur - 1;
1672 str_nset(astr,tmps,1); /* remember last char */
1673 *tmps = '\0'; /* wipe it out */
1674 str->str_cur = tmps - str->str_ptr;
1675 str->str_nok = 0;
1676 STABSET(str);
1677 }
1678 else
1679 str_nset(astr,"",0);
a687059c 1680}
1681
8adcabd8 1682void
a687059c 1683do_vop(optype,str,left,right)
1684STR *str;
1685STR *left;
1686STR *right;
1687{
fe14fcc3 1688 register char *s;
a687059c 1689 register char *l = str_get(left);
1690 register char *r = str_get(right);
1691 register int len;
1692
1693 len = left->str_cur;
1694 if (len > right->str_cur)
1695 len = right->str_cur;
1696 if (str->str_cur > len)
1697 str->str_cur = len;
1698 else if (str->str_cur < len) {
1699 STR_GROW(str,len);
8adcabd8 1700 (void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
a687059c 1701 str->str_cur = len;
fe14fcc3 1702 }
6e21c824 1703 str->str_pok = 1;
1704 str->str_nok = 0;
fe14fcc3 1705 s = str->str_ptr;
1706 if (!s) {
1707 str_nset(str,"",0);
1708 s = str->str_ptr;
a687059c 1709 }
1710 switch (optype) {
1711 case O_BIT_AND:
1712 while (len--)
1713 *s++ = *l++ & *r++;
1714 break;
1715 case O_XOR:
1716 while (len--)
1717 *s++ = *l++ ^ *r++;
1718 goto mop_up;
1719 case O_BIT_OR:
1720 while (len--)
1721 *s++ = *l++ | *r++;
1722 mop_up:
1723 len = str->str_cur;
1724 if (right->str_cur > len)
1725 str_ncat(str,right->str_ptr+len,right->str_cur - len);
1726 else if (left->str_cur > len)
1727 str_ncat(str,left->str_ptr+len,left->str_cur - len);
1728 break;
1729 }
1730}
1731
1732int
1733do_syscall(arglast)
1734int *arglast;
1735{
1736 register STR **st = stack->ary_array;
1737 register int sp = arglast[1];
1738 register int items = arglast[2] - sp;
8adcabd8 1739#ifdef atarist
1740 unsigned long arg[14]; /* yes, we really need that many ! */
1741#else
6e21c824 1742 unsigned long arg[8];
8adcabd8 1743#endif
a687059c 1744 register int i = 0;
1745 int retval = -1;
1746
fe14fcc3 1747#ifdef HAS_SYSCALL
a687059c 1748#ifdef TAINT
1749 for (st += ++sp; items--; st++)
1750 tainted |= (*st)->str_tainted;
1751 st = stack->ary_array;
1752 sp = arglast[1];
1753 items = arglast[2] - sp;
1754#endif
1755#ifdef TAINT
1756 taintproper("Insecure dependency in syscall");
1757#endif
1758 /* This probably won't work on machines where sizeof(long) != sizeof(int)
1759 * or where sizeof(long) != sizeof(char*). But such machines will
1760 * not likely have syscall implemented either, so who cares?
1761 */
1762 while (items--) {
1763 if (st[++sp]->str_nok || !i)
6e21c824 1764 arg[i++] = (unsigned long)str_gnum(st[sp]);
a687059c 1765#ifndef lint
1766 else
6e21c824 1767 arg[i++] = (unsigned long)st[sp]->str_ptr;
a687059c 1768#endif /* lint */
1769 }
1770 sp = arglast[1];
1771 items = arglast[2] - sp;
1772 switch (items) {
1773 case 0:
1774 fatal("Too few args to syscall");
1775 case 1:
1776 retval = syscall(arg[0]);
1777 break;
1778 case 2:
1779 retval = syscall(arg[0],arg[1]);
1780 break;
1781 case 3:
1782 retval = syscall(arg[0],arg[1],arg[2]);
1783 break;
1784 case 4:
1785 retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1786 break;
1787 case 5:
1788 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1789 break;
1790 case 6:
1791 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1792 break;
1793 case 7:
1794 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1795 break;
1796 case 8:
1797 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1798 arg[7]);
1799 break;
8adcabd8 1800#ifdef atarist
1801 case 9:
1802 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1803 arg[7], arg[8]);
1804 break;
1805 case 10:
1806 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1807 arg[7], arg[8], arg[9]);
1808 break;
1809 case 11:
1810 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1811 arg[7], arg[8], arg[9], arg[10]);
1812 break;
1813 case 12:
1814 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1815 arg[7], arg[8], arg[9], arg[10], arg[11]);
1816 break;
1817 case 13:
1818 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1819 arg[7], arg[8], arg[9], arg[10], arg[11], arg[12]);
1820 break;
1821 case 14:
1822 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1823 arg[7], arg[8], arg[9], arg[10], arg[11], arg[12], arg[13]);
1824 break;
1825#endif /* atarist */
a687059c 1826 }
afd9f252 1827 return retval;
a687059c 1828#else
1829 fatal("syscall() unimplemented");
1830#endif
1831}
1832
1833
Unnamed repository; edit this file to name it for gitweb.