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