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