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