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