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