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