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