projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
perl 3.0 patch #12 patch #9, continued
[p5sagit/p5-mst-13.2.git] / dolist.c
CommitLineData
afd9f252 1/* $Header: dolist.c,v 3.0.1.5 90/02/28 17:09:44 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: dolist.c,v $
afd9f252 9 * Revision 3.0.1.5 90/02/28 17:09:44 lwall
10 * patch9: split now can split into more than 10000 elements
11 * patch9: @_ clobbered by ($foo,$bar) = split
12 * patch9: sped up pack and unpack
13 * patch9: unpack of single item now works in a scalar context
14 * patch9: slices ignored value of $[
15 * patch9: grep now returns number of items matched in scalar context
16 * patch9: grep iterations no longer in the regexp context of previous iteration
17 *
663a0e37 18 * Revision 3.0.1.4 89/12/21 19:58:46 lwall
19 * patch7: grep(1,@array) didn't work
20 * patch7: /$pat/; //; wrongly freed runtime pattern twice
21 *
0d3e774c 22 * Revision 3.0.1.3 89/11/17 15:14:45 lwall
23 * patch5: grep() occasionally loses arguments or dumps core
24 *
bf38876a 25 * Revision 3.0.1.2 89/11/11 04:28:17 lwall
26 * patch2: non-existent slice values are now undefined rather than null
27 *
03a14243 28 * Revision 3.0.1.1 89/10/26 23:11:51 lwall
29 * patch1: split in a subroutine wrongly freed referenced arguments
30 * patch1: reverse didn't work
31 *
a687059c 32 * Revision 3.0 89/10/18 15:11:02 lwall
33 * 3.0 baseline
34 *
35 */
36
37#include "EXTERN.h"
38#include "perl.h"
39
40
41int
42do_match(str,arg,gimme,arglast)
43STR *str;
44register ARG *arg;
45int gimme;
46int *arglast;
47{
48 register STR **st = stack->ary_array;
49 register SPAT *spat = arg[2].arg_ptr.arg_spat;
50 register char *t;
51 register int sp = arglast[0] + 1;
52 STR *srchstr = st[sp];
53 register char *s = str_get(st[sp]);
54 char *strend = s + st[sp]->str_cur;
55 STR *tmpstr;
56
57 if (!spat) {
58 if (gimme == G_ARRAY)
59 return --sp;
60 str_set(str,Yes);
61 STABSET(str);
62 st[sp] = str;
63 return sp;
64 }
65 if (!s)
66 fatal("panic: do_match");
67 if (spat->spat_flags & SPAT_USED) {
68#ifdef DEBUGGING
69 if (debug & 8)
70 deb("2.SPAT USED\n");
71#endif
72 if (gimme == G_ARRAY)
73 return --sp;
74 str_set(str,No);
75 STABSET(str);
76 st[sp] = str;
77 return sp;
78 }
79 --sp;
80 if (spat->spat_runtime) {
81 nointrp = "|)";
82 sp = eval(spat->spat_runtime,G_SCALAR,sp);
83 st = stack->ary_array;
84 t = str_get(tmpstr = st[sp--]);
85 nointrp = "";
86#ifdef DEBUGGING
87 if (debug & 8)
88 deb("2.SPAT /%s/\n",t);
89#endif
90 if (spat->spat_regexp)
91 regfree(spat->spat_regexp);
92 spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
93 spat->spat_flags & SPAT_FOLD,1);
94 if (!*spat->spat_regexp->precomp && lastspat)
95 spat = lastspat;
96 if (spat->spat_flags & SPAT_KEEP) {
663a0e37 97 if (spat->spat_runtime)
98 arg_free(spat->spat_runtime); /* it won't change, so */
a687059c 99 spat->spat_runtime = Nullarg; /* no point compiling again */
100 }
101 if (!spat->spat_regexp->nparens)
102 gimme = G_SCALAR; /* accidental array context? */
103 if (regexec(spat->spat_regexp, s, strend, s, 0,
104 srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
105 gimme == G_ARRAY)) {
106 if (spat->spat_regexp->subbase)
107 curspat = spat;
108 lastspat = spat;
109 goto gotcha;
110 }
111 else {
112 if (gimme == G_ARRAY)
113 return sp;
114 str_sset(str,&str_no);
115 STABSET(str);
116 st[++sp] = str;
117 return sp;
118 }
119 }
120 else {
121#ifdef DEBUGGING
122 if (debug & 8) {
123 char ch;
124
125 if (spat->spat_flags & SPAT_ONCE)
126 ch = '?';
127 else
128 ch = '/';
129 deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
130 }
131#endif
132 if (!*spat->spat_regexp->precomp && lastspat)
133 spat = lastspat;
134 t = s;
135 if (hint) {
136 if (hint < s || hint > strend)
137 fatal("panic: hint in do_match");
138 s = hint;
139 hint = Nullch;
140 if (spat->spat_regexp->regback >= 0) {
141 s -= spat->spat_regexp->regback;
142 if (s < t)
143 s = t;
144 }
145 else
146 s = t;
147 }
148 else if (spat->spat_short) {
149 if (spat->spat_flags & SPAT_SCANFIRST) {
150 if (srchstr->str_pok & SP_STUDIED) {
151 if (screamfirst[spat->spat_short->str_rare] < 0)
152 goto nope;
153 else if (!(s = screaminstr(srchstr,spat->spat_short)))
154 goto nope;
155 else if (spat->spat_flags & SPAT_ALL)
156 goto yup;
157 }
158#ifndef lint
159 else if (!(s = fbminstr((unsigned char*)s,
160 (unsigned char*)strend, spat->spat_short)))
161 goto nope;
162#endif
163 else if (spat->spat_flags & SPAT_ALL)
164 goto yup;
165 if (s && spat->spat_regexp->regback >= 0) {
166 ++spat->spat_short->str_u.str_useful;
167 s -= spat->spat_regexp->regback;
168 if (s < t)
169 s = t;
170 }
171 else
172 s = t;
173 }
174 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
175 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
176 goto nope;
177 if (--spat->spat_short->str_u.str_useful < 0) {
178 str_free(spat->spat_short);
179 spat->spat_short = Nullstr; /* opt is being useless */
180 }
181 }
182 if (!spat->spat_regexp->nparens)
183 gimme = G_SCALAR; /* accidental array context? */
184 if (regexec(spat->spat_regexp, s, strend, t, 0,
185 srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
186 gimme == G_ARRAY)) {
187 if (spat->spat_regexp->subbase)
188 curspat = spat;
189 lastspat = spat;
190 if (spat->spat_flags & SPAT_ONCE)
191 spat->spat_flags |= SPAT_USED;
192 goto gotcha;
193 }
194 else {
195 if (gimme == G_ARRAY)
196 return sp;
197 str_sset(str,&str_no);
198 STABSET(str);
199 st[++sp] = str;
200 return sp;
201 }
202 }
203 /*NOTREACHED*/
204
205 gotcha:
206 if (gimme == G_ARRAY) {
207 int iters, i, len;
208
209 iters = spat->spat_regexp->nparens;
210 if (sp + iters >= stack->ary_max) {
211 astore(stack,sp + iters, Nullstr);
212 st = stack->ary_array; /* possibly realloced */
213 }
214
215 for (i = 1; i <= iters; i++) {
216 st[++sp] = str_static(&str_no);
217 if (s = spat->spat_regexp->startp[i]) {
218 len = spat->spat_regexp->endp[i] - s;
219 if (len > 0)
220 str_nset(st[sp],s,len);
221 }
222 }
223 return sp;
224 }
225 else {
226 str_sset(str,&str_yes);
227 STABSET(str);
228 st[++sp] = str;
229 return sp;
230 }
231
232yup:
233 ++spat->spat_short->str_u.str_useful;
234 lastspat = spat;
235 if (spat->spat_flags & SPAT_ONCE)
236 spat->spat_flags |= SPAT_USED;
237 if (sawampersand) {
238 char *tmps;
239
240 tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
241 tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
242 spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
243 curspat = spat;
244 }
245 str_sset(str,&str_yes);
246 STABSET(str);
247 st[++sp] = str;
248 return sp;
249
250nope:
251 ++spat->spat_short->str_u.str_useful;
252 if (gimme == G_ARRAY)
253 return sp;
254 str_sset(str,&str_no);
255 STABSET(str);
256 st[++sp] = str;
257 return sp;
258}
259
260int
261do_split(str,spat,limit,gimme,arglast)
262STR *str;
263register SPAT *spat;
264register int limit;
265int gimme;
266int *arglast;
267{
268 register ARRAY *ary = stack;
269 STR **st = ary->ary_array;
270 register int sp = arglast[0] + 1;
271 register char *s = str_get(st[sp]);
272 char *strend = s + st[sp--]->str_cur;
273 register STR *dstr;
274 register char *m;
275 int iters = 0;
afd9f252 276 int maxiters = (strend - s) + 10;
a687059c 277 int i;
278 char *orig;
279 int origlimit = limit;
280 int realarray = 0;
281
282 if (!spat || !s)
283 fatal("panic: do_split");
284 else if (spat->spat_runtime) {
285 nointrp = "|)";
286 sp = eval(spat->spat_runtime,G_SCALAR,sp);
287 st = stack->ary_array;
288 m = str_get(dstr = st[sp--]);
289 nointrp = "";
290 if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) {
291 str_set(dstr,"\\s+");
292 m = dstr->str_ptr;
293 spat->spat_flags |= SPAT_SKIPWHITE;
294 }
295 if (spat->spat_regexp)
296 regfree(spat->spat_regexp);
297 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
298 spat->spat_flags & SPAT_FOLD,1);
299 if (spat->spat_flags & SPAT_KEEP ||
300 (spat->spat_runtime->arg_type == O_ITEM &&
301 (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
302 arg_free(spat->spat_runtime); /* it won't change, so */
303 spat->spat_runtime = Nullarg; /* no point compiling again */
304 }
305 }
306#ifdef DEBUGGING
307 if (debug & 8) {
308 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
309 }
310#endif
311 ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
afd9f252 312 if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
a687059c 313 realarray = 1;
03a14243 314 if (!(ary->ary_flags & ARF_REAL)) {
315 ary->ary_flags |= ARF_REAL;
316 for (i = ary->ary_fill; i >= 0; i--)
317 ary->ary_array[i] = Nullstr; /* don't free mere refs */
318 }
a687059c 319 ary->ary_fill = -1;
320 sp = -1; /* temporarily switch stacks */
321 }
322 else
323 ary = stack;
324 orig = s;
325 if (spat->spat_flags & SPAT_SKIPWHITE) {
326 while (isspace(*s))
327 s++;
328 }
329 if (!limit)
afd9f252 330 limit = maxiters + 2;
a687059c 331 if (spat->spat_short) {
332 i = spat->spat_short->str_cur;
333 if (i == 1) {
334 i = *spat->spat_short->str_ptr;
335 while (--limit) {
336 for (m = s; m < strend && *m != i; m++) ;
337 if (m >= strend)
338 break;
339 if (realarray)
340 dstr = Str_new(30,m-s);
341 else
342 dstr = str_static(&str_undef);
343 str_nset(dstr,s,m-s);
344 (void)astore(ary, ++sp, dstr);
345 s = m + 1;
346 }
347 }
348 else {
349#ifndef lint
350 while (s < strend && --limit &&
351 (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
352 spat->spat_short)) )
353#endif
354 {
355 if (realarray)
356 dstr = Str_new(31,m-s);
357 else
358 dstr = str_static(&str_undef);
359 str_nset(dstr,s,m-s);
360 (void)astore(ary, ++sp, dstr);
361 s = m + i;
362 }
363 }
364 }
365 else {
afd9f252 366 maxiters += (strend - s) * spat->spat_regexp->nparens;
a687059c 367 while (s < strend && --limit &&
368 regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
369 if (spat->spat_regexp->subbase
370 && spat->spat_regexp->subbase != orig) {
371 m = s;
372 s = orig;
373 orig = spat->spat_regexp->subbase;
374 s = orig + (m - s);
375 strend = s + (strend - m);
376 }
377 m = spat->spat_regexp->startp[0];
378 if (realarray)
379 dstr = Str_new(32,m-s);
380 else
381 dstr = str_static(&str_undef);
382 str_nset(dstr,s,m-s);
383 (void)astore(ary, ++sp, dstr);
384 if (spat->spat_regexp->nparens) {
385 for (i = 1; i <= spat->spat_regexp->nparens; i++) {
386 s = spat->spat_regexp->startp[i];
387 m = spat->spat_regexp->endp[i];
388 if (realarray)
389 dstr = Str_new(33,m-s);
390 else
391 dstr = str_static(&str_undef);
392 str_nset(dstr,s,m-s);
393 (void)astore(ary, ++sp, dstr);
394 }
395 }
396 s = spat->spat_regexp->endp[0];
397 }
398 }
399 if (realarray)
400 iters = sp + 1;
401 else
402 iters = sp - arglast[0];
afd9f252 403 if (iters > maxiters)
a687059c 404 fatal("Split loop");
405 if (s < strend || origlimit) { /* keep field after final delim? */
406 if (realarray)
407 dstr = Str_new(34,strend-s);
408 else
409 dstr = str_static(&str_undef);
410 str_nset(dstr,s,strend-s);
411 (void)astore(ary, ++sp, dstr);
412 iters++;
413 }
414 else {
415#ifndef I286
416 while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
417 iters--,sp--;
418#else
419 char *zaps;
420 int zapb;
421
422 if (iters > 0) {
423 zaps = str_get(afetch(ary,sp,FALSE));
424 zapb = (int) *zaps;
425 }
426
427 while (iters > 0 && (!zapb)) {
428 iters--,sp--;
429 if (iters > 0) {
430 zaps = str_get(afetch(ary,iters-1,FALSE));
431 zapb = (int) *zaps;
432 }
433 }
434#endif
435 }
436 if (realarray) {
437 ary->ary_fill = sp;
438 if (gimme == G_ARRAY) {
439 sp++;
440 astore(stack, arglast[0] + 1 + sp, Nullstr);
441 Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
442 return arglast[0] + sp;
443 }
444 }
445 else {
446 if (gimme == G_ARRAY)
447 return sp;
448 }
449 sp = arglast[0] + 1;
450 str_numset(str,(double)iters);
451 STABSET(str);
452 st[sp] = str;
453 return sp;
454}
455
456int
457do_unpack(str,gimme,arglast)
458STR *str;
459int gimme;
460int *arglast;
461{
462 STR **st = stack->ary_array;
463 register int sp = arglast[0] + 1;
464 register char *pat = str_get(st[sp++]);
465 register char *s = str_get(st[sp]);
466 char *strend = s + st[sp--]->str_cur;
467 register char *patend = pat + st[sp]->str_cur;
468 int datumtype;
469 register int len;
470
471 /* These must not be in registers: */
472 char achar;
473 short ashort;
474 int aint;
475 long along;
476 unsigned char auchar;
477 unsigned short aushort;
478 unsigned int auint;
479 unsigned long aulong;
480 char *aptr;
481
afd9f252 482 if (gimme != G_ARRAY) { /* arrange to do first one only */
483 patend = pat+1;
484 if (*pat == 'a' || *pat == 'A') {
485 while (isdigit(*patend))
486 patend++;
487 }
a687059c 488 }
489 sp--;
490 while (pat < patend) {
491 datumtype = *pat++;
492 if (isdigit(*pat)) {
afd9f252 493 len = *pat++ - '0';
a687059c 494 while (isdigit(*pat))
afd9f252 495 len = (len * 10) + (*pat++ - '0');
a687059c 496 }
497 else
498 len = 1;
499 switch(datumtype) {
500 default:
501 break;
502 case 'x':
503 s += len;
504 break;
505 case 'A':
506 case 'a':
507 if (s + len > strend)
508 len = strend - s;
509 str = Str_new(35,len);
510 str_nset(str,s,len);
511 s += len;
512 if (datumtype == 'A') {
513 aptr = s; /* borrow register */
514 s = str->str_ptr + len - 1;
515 while (s >= str->str_ptr && (!*s || isspace(*s)))
516 s--;
517 *++s = '\0';
518 str->str_cur = s - str->str_ptr;
519 s = aptr; /* unborrow register */
520 }
521 (void)astore(stack, ++sp, str_2static(str));
522 break;
523 case 'c':
524 while (len-- > 0) {
525 if (s + sizeof(char) > strend)
526 achar = 0;
527 else {
528 bcopy(s,(char*)&achar,sizeof(char));
529 s += sizeof(char);
530 }
531 str = Str_new(36,0);
532 aint = achar;
533 if (aint >= 128) /* fake up signed chars */
534 aint -= 256;
535 str_numset(str,(double)aint);
536 (void)astore(stack, ++sp, str_2static(str));
537 }
538 break;
539 case 'C':
540 while (len-- > 0) {
541 if (s + sizeof(unsigned char) > strend)
542 auchar = 0;
543 else {
544 bcopy(s,(char*)&auchar,sizeof(unsigned char));
545 s += sizeof(unsigned char);
546 }
547 str = Str_new(37,0);
548 auint = auchar; /* some can't cast uchar to double */
549 str_numset(str,(double)auint);
550 (void)astore(stack, ++sp, str_2static(str));
551 }
552 break;
553 case 's':
554 while (len-- > 0) {
555 if (s + sizeof(short) > strend)
556 ashort = 0;
557 else {
558 bcopy(s,(char*)&ashort,sizeof(short));
559 s += sizeof(short);
560 }
561 str = Str_new(38,0);
562 str_numset(str,(double)ashort);
563 (void)astore(stack, ++sp, str_2static(str));
564 }
565 break;
566 case 'n':
567 case 'S':
568 while (len-- > 0) {
569 if (s + sizeof(unsigned short) > strend)
570 aushort = 0;
571 else {
572 bcopy(s,(char*)&aushort,sizeof(unsigned short));
573 s += sizeof(unsigned short);
574 }
575 str = Str_new(39,0);
576#ifdef NTOHS
577 if (datumtype == 'n')
578 aushort = ntohs(aushort);
579#endif
580 str_numset(str,(double)aushort);
581 (void)astore(stack, ++sp, str_2static(str));
582 }
583 break;
584 case 'i':
585 while (len-- > 0) {
586 if (s + sizeof(int) > strend)
587 aint = 0;
588 else {
589 bcopy(s,(char*)&aint,sizeof(int));
590 s += sizeof(int);
591 }
592 str = Str_new(40,0);
593 str_numset(str,(double)aint);
594 (void)astore(stack, ++sp, str_2static(str));
595 }
596 break;
597 case 'I':
598 while (len-- > 0) {
599 if (s + sizeof(unsigned int) > strend)
600 auint = 0;
601 else {
602 bcopy(s,(char*)&auint,sizeof(unsigned int));
603 s += sizeof(unsigned int);
604 }
605 str = Str_new(41,0);
606 str_numset(str,(double)auint);
607 (void)astore(stack, ++sp, str_2static(str));
608 }
609 break;
610 case 'l':
611 while (len-- > 0) {
612 if (s + sizeof(long) > strend)
613 along = 0;
614 else {
615 bcopy(s,(char*)&along,sizeof(long));
616 s += sizeof(long);
617 }
618 str = Str_new(42,0);
619 str_numset(str,(double)along);
620 (void)astore(stack, ++sp, str_2static(str));
621 }
622 break;
623 case 'N':
624 case 'L':
625 while (len-- > 0) {
626 if (s + sizeof(unsigned long) > strend)
627 aulong = 0;
628 else {
629 bcopy(s,(char*)&aulong,sizeof(unsigned long));
630 s += sizeof(unsigned long);
631 }
632 str = Str_new(43,0);
633#ifdef NTOHL
634 if (datumtype == 'N')
635 aulong = ntohl(aulong);
636#endif
637 str_numset(str,(double)aulong);
638 (void)astore(stack, ++sp, str_2static(str));
639 }
640 break;
641 case 'p':
642 while (len-- > 0) {
643 if (s + sizeof(char*) > strend)
644 aptr = 0;
645 else {
646 bcopy(s,(char*)&aptr,sizeof(char*));
647 s += sizeof(char*);
648 }
649 str = Str_new(44,0);
650 if (aptr)
651 str_set(str,aptr);
652 (void)astore(stack, ++sp, str_2static(str));
653 }
654 break;
655 }
656 }
657 return sp;
658}
659
660int
661do_slice(stab,numarray,lval,gimme,arglast)
662register STAB *stab;
663int numarray;
664int lval;
665int gimme;
666int *arglast;
667{
668 register STR **st = stack->ary_array;
669 register int sp = arglast[1];
670 register int max = arglast[2];
671 register char *tmps;
672 register int len;
673 register int magic = 0;
674
675 if (lval && !numarray) {
676 if (stab == envstab)
677 magic = 'E';
678 else if (stab == sigstab)
679 magic = 'S';
680#ifdef SOME_DBM
681 else if (stab_hash(stab)->tbl_dbm)
682 magic = 'D';
683#endif /* SOME_DBM */
684 }
685
686 if (gimme == G_ARRAY) {
687 if (numarray) {
688 while (sp < max) {
689 if (st[++sp]) {
afd9f252 690 st[sp-1] = afetch(stab_array(stab),
691 ((int)str_gnum(st[sp])) - arybase, lval);
a687059c 692 }
693 else
bf38876a 694 st[sp-1] = &str_undef;
a687059c 695 }
696 }
697 else {
698 while (sp < max) {
699 if (st[++sp]) {
700 tmps = str_get(st[sp]);
701 len = st[sp]->str_cur;
702 st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval);
703 if (magic)
704 str_magic(st[sp-1],stab,magic,tmps,len);
705 }
706 else
bf38876a 707 st[sp-1] = &str_undef;
a687059c 708 }
709 }
710 sp--;
711 }
712 else {
713 if (numarray) {
714 if (st[max])
afd9f252 715 st[sp] = afetch(stab_array(stab),
716 ((int)str_gnum(st[max])) - arybase, lval);
a687059c 717 else
bf38876a 718 st[sp] = &str_undef;
a687059c 719 }
720 else {
721 if (st[max]) {
722 tmps = str_get(st[max]);
723 len = st[max]->str_cur;
724 st[sp] = hfetch(stab_hash(stab),tmps,len, lval);
725 if (magic)
726 str_magic(st[sp],stab,magic,tmps,len);
727 }
728 else
bf38876a 729 st[sp] = &str_undef;
a687059c 730 }
731 }
732 return sp;
733}
734
735int
736do_grep(arg,str,gimme,arglast)
737register ARG *arg;
738STR *str;
739int gimme;
740int *arglast;
741{
742 STR **st = stack->ary_array;
0d3e774c 743 register int dst = arglast[1];
744 register int src = dst + 1;
a687059c 745 register int sp = arglast[2];
746 register int i = sp - arglast[1];
747 int oldsave = savestack->ary_fill;
afd9f252 748 SPAT *oldspat = curspat;
a687059c 749
750 savesptr(&stab_val(defstab));
663a0e37 751 if ((arg[1].arg_type & A_MASK) != A_EXPR) {
752 arg[1].arg_type &= A_MASK;
a687059c 753 dehoist(arg,1);
663a0e37 754 arg[1].arg_type |= A_DONT;
755 }
a687059c 756 arg = arg[1].arg_ptr.arg_arg;
757 while (i-- > 0) {
0d3e774c 758 stab_val(defstab) = st[src];
a687059c 759 (void)eval(arg,G_SCALAR,sp);
0d3e774c 760 st = stack->ary_array;
a687059c 761 if (str_true(st[sp+1]))
0d3e774c 762 st[dst++] = st[src];
a687059c 763 src++;
afd9f252 764 curspat = oldspat;
a687059c 765 }
766 restorelist(oldsave);
767 if (gimme != G_ARRAY) {
afd9f252 768 str_numset(str,(double)(dst - arglast[1]));
a687059c 769 STABSET(str);
770 st[arglast[0]+1] = str;
771 return arglast[0]+1;
772 }
0d3e774c 773 return arglast[0] + (dst - arglast[1]);
a687059c 774}
775
776int
777do_reverse(str,gimme,arglast)
778STR *str;
779int gimme;
780int *arglast;
781{
782 STR **st = stack->ary_array;
783 register STR **up = &st[arglast[1]];
784 register STR **down = &st[arglast[2]];
785 register int i = arglast[2] - arglast[1];
786
787 if (gimme != G_ARRAY) {
788 str_sset(str,&str_undef);
789 STABSET(str);
790 st[arglast[0]+1] = str;
791 return arglast[0]+1;
792 }
793 while (i-- > 0) {
794 *up++ = *down;
03a14243 795 if (i-- > 0)
796 *down-- = *up;
a687059c 797 }
03a14243 798 i = arglast[2] - arglast[1];
799 Copy(down+1,up,i/2,STR*);
a687059c 800 return arglast[2] - 1;
801}
802
803static CMD *sortcmd;
804static STAB *firststab = Nullstab;
805static STAB *secondstab = Nullstab;
806
807int
808do_sort(str,stab,gimme,arglast)
809STR *str;
810STAB *stab;
811int gimme;
812int *arglast;
813{
814 STR **st = stack->ary_array;
815 int sp = arglast[1];
816 register STR **up;
817 register int max = arglast[2] - sp;
818 register int i;
819 int sortcmp();
820 int sortsub();
821 STR *oldfirst;
822 STR *oldsecond;
823 ARRAY *oldstack;
824 static ARRAY *sortstack = Null(ARRAY*);
825
826 if (gimme != G_ARRAY) {
827 str_sset(str,&str_undef);
828 STABSET(str);
829 st[sp] = str;
830 return sp;
831 }
832 up = &st[sp];
833 for (i = 0; i < max; i++) {
834 if ((*up = up[1]) && !(*up)->str_pok)
835 (void)str_2ptr(*up);
836 up++;
837 }
838 sp--;
839 if (max > 1) {
840 if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
841 int oldtmps_base = tmps_base;
842
843 if (!sortstack) {
844 sortstack = anew(Nullstab);
845 sortstack->ary_flags = 0;
846 }
847 oldstack = stack;
848 stack = sortstack;
849 tmps_base = tmps_max;
850 if (!firststab) {
851 firststab = stabent("a",TRUE);
852 secondstab = stabent("b",TRUE);
853 }
854 oldfirst = stab_val(firststab);
855 oldsecond = stab_val(secondstab);
856#ifndef lint
857 qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
858#else
859 qsort(Nullch,max,sizeof(STR*),sortsub);
860#endif
861 stab_val(firststab) = oldfirst;
862 stab_val(secondstab) = oldsecond;
863 tmps_base = oldtmps_base;
864 stack = oldstack;
865 }
866#ifndef lint
867 else
868 qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
869#endif
870 }
871 up = &st[arglast[1]];
872 while (max > 0 && !*up)
873 max--,up--;
874 return sp+max;
875}
876
877int
878sortsub(str1,str2)
879STR **str1;
880STR **str2;
881{
882 if (!*str1)
883 return -1;
884 if (!*str2)
885 return 1;
886 stab_val(firststab) = *str1;
887 stab_val(secondstab) = *str2;
888 cmd_exec(sortcmd,G_SCALAR,-1);
889 return (int)str_gnum(*stack->ary_array);
890}
891
892sortcmp(strp1,strp2)
893STR **strp1;
894STR **strp2;
895{
896 register STR *str1 = *strp1;
897 register STR *str2 = *strp2;
898 int retval;
899
900 if (!str1)
901 return -1;
902 if (!str2)
903 return 1;
904
905 if (str1->str_cur < str2->str_cur) {
906 if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
907 return retval;
908 else
909 return -1;
910 }
911 else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
912 return retval;
913 else if (str1->str_cur == str2->str_cur)
914 return 0;
915 else
916 return 1;
917}
918
919int
920do_range(gimme,arglast)
921int gimme;
922int *arglast;
923{
924 STR **st = stack->ary_array;
925 register int sp = arglast[0];
926 register int i = (int)str_gnum(st[sp+1]);
927 register ARRAY *ary = stack;
928 register STR *str;
929 int max = (int)str_gnum(st[sp+2]);
930
931 if (gimme != G_ARRAY)
932 fatal("panic: do_range");
933
934 while (i <= max) {
935 (void)astore(ary, ++sp, str = str_static(&str_no));
936 str_numset(str,(double)i++);
937 }
938 return sp;
939}
940
941int
942do_tms(str,gimme,arglast)
943STR *str;
944int gimme;
945int *arglast;
946{
947 STR **st = stack->ary_array;
948 register int sp = arglast[0];
949
950 if (gimme != G_ARRAY) {
951 str_sset(str,&str_undef);
952 STABSET(str);
953 st[++sp] = str;
954 return sp;
955 }
956 (void)times(&timesbuf);
957
958#ifndef HZ
959#define HZ 60
960#endif
961
962#ifndef lint
963 (void)astore(stack,++sp,
964 str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
965 (void)astore(stack,++sp,
966 str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
967 (void)astore(stack,++sp,
968 str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
969 (void)astore(stack,++sp,
970 str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
971#else
972 (void)astore(stack,++sp,
973 str_2static(str_nmake(0.0)));
974#endif
975 return sp;
976}
977
978int
979do_time(str,tmbuf,gimme,arglast)
980STR *str;
981struct tm *tmbuf;
982int gimme;
983int *arglast;
984{
985 register ARRAY *ary = stack;
986 STR **st = ary->ary_array;
987 register int sp = arglast[0];
988
989 if (!tmbuf || gimme != G_ARRAY) {
990 str_sset(str,&str_undef);
991 STABSET(str);
992 st[++sp] = str;
993 return sp;
994 }
995 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
996 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
997 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
998 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
999 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
1000 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
1001 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
1002 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
1003 (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
1004 return sp;
1005}
1006
1007int
1008do_kv(str,hash,kv,gimme,arglast)
1009STR *str;
1010HASH *hash;
1011int kv;
1012int gimme;
1013int *arglast;
1014{
1015 register ARRAY *ary = stack;
1016 STR **st = ary->ary_array;
1017 register int sp = arglast[0];
1018 int i;
1019 register HENT *entry;
1020 char *tmps;
1021 STR *tmpstr;
1022 int dokeys = (kv == O_KEYS || kv == O_HASH);
1023 int dovalues = (kv == O_VALUES || kv == O_HASH);
1024
1025 if (gimme != G_ARRAY) {
1026 str_sset(str,&str_undef);
1027 STABSET(str);
1028 st[++sp] = str;
1029 return sp;
1030 }
1031 (void)hiterinit(hash);
1032 while (entry = hiternext(hash)) {
1033 if (dokeys) {
1034 tmps = hiterkey(entry,&i);
1035 (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
1036 }
1037 if (dovalues) {
1038 tmpstr = Str_new(45,0);
1039#ifdef DEBUGGING
1040 if (debug & 8192) {
1041 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1042 hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1043 str_set(tmpstr,buf);
1044 }
1045 else
1046#endif
1047 str_sset(tmpstr,hiterval(hash,entry));
1048 (void)astore(ary,++sp,str_2static(tmpstr));
1049 }
1050 }
1051 return sp;
1052}
1053
1054int
1055do_each(str,hash,gimme,arglast)
1056STR *str;
1057HASH *hash;
1058int gimme;
1059int *arglast;
1060{
1061 STR **st = stack->ary_array;
1062 register int sp = arglast[0];
1063 static STR *mystrk = Nullstr;
1064 HENT *entry = hiternext(hash);
1065 int i;
1066 char *tmps;
1067
1068 if (mystrk) {
1069 str_free(mystrk);
1070 mystrk = Nullstr;
1071 }
1072
1073 if (entry) {
1074 if (gimme == G_ARRAY) {
1075 tmps = hiterkey(entry, &i);
1076 st[++sp] = mystrk = str_make(tmps,i);
1077 }
1078 st[++sp] = str;
1079 str_sset(str,hiterval(hash,entry));
1080 STABSET(str);
1081 return sp;
1082 }
1083 else
1084 return sp;
1085}
Unnamed repository; edit this file to name it for gitweb.