Commit | Line | Data |
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 | |
25 | int |
26 | do_match(str,arg,gimme,arglast) |
27 | STR *str; |
28 | register ARG *arg; |
29 | int gimme; |
30 | int *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 | |
215 | yup: |
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 | |
233 | nope: |
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 | |
243 | int |
244 | do_split(str,spat,limit,gimme,arglast) |
245 | STR *str; |
246 | register SPAT *spat; |
247 | register int limit; |
248 | int gimme; |
249 | int *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 | |
437 | int |
438 | do_unpack(str,gimme,arglast) |
439 | STR *str; |
440 | int gimme; |
441 | int *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 | |
640 | int |
641 | do_slice(stab,numarray,lval,gimme,arglast) |
642 | register STAB *stab; |
643 | int numarray; |
644 | int lval; |
645 | int gimme; |
646 | int *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 | |
714 | int |
715 | do_grep(arg,str,gimme,arglast) |
716 | register ARG *arg; |
717 | STR *str; |
718 | int gimme; |
719 | int *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 | |
749 | int |
750 | do_reverse(str,gimme,arglast) |
751 | STR *str; |
752 | int gimme; |
753 | int *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 | |
776 | static CMD *sortcmd; |
777 | static STAB *firststab = Nullstab; |
778 | static STAB *secondstab = Nullstab; |
779 | |
780 | int |
781 | do_sort(str,stab,gimme,arglast) |
782 | STR *str; |
783 | STAB *stab; |
784 | int gimme; |
785 | int *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 | |
850 | int |
851 | sortsub(str1,str2) |
852 | STR **str1; |
853 | STR **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 | |
865 | sortcmp(strp1,strp2) |
866 | STR **strp1; |
867 | STR **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 | |
892 | int |
893 | do_range(gimme,arglast) |
894 | int gimme; |
895 | int *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 | |
914 | int |
915 | do_tms(str,gimme,arglast) |
916 | STR *str; |
917 | int gimme; |
918 | int *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(×buf); |
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 | |
951 | int |
952 | do_time(str,tmbuf,gimme,arglast) |
953 | STR *str; |
954 | struct tm *tmbuf; |
955 | int gimme; |
956 | int *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 | |
980 | int |
981 | do_kv(str,hash,kv,gimme,arglast) |
982 | STR *str; |
983 | HASH *hash; |
984 | int kv; |
985 | int gimme; |
986 | int *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 | |
1027 | int |
1028 | do_each(str,hash,gimme,arglast) |
1029 | STR *str; |
1030 | HASH *hash; |
1031 | int gimme; |
1032 | int *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 | } |