projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 4_4_Lite1 development
[unix-history] / usr / src / contrib / perl-4.036 / dolist.c
CommitLineData
9b7d628a
C		 1/* $RCSfile: dolist.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 13:13:27 $
2 *
3 * Copyright (c) 1991, Larry Wall
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 * $Log: dolist.c,v $
9 * Revision 4.0.1.5 92/06/08 13:13:27 lwall
10 * patch20: g pattern modifer sometimes returned extra values
11 * patch20: m/$pattern/g didn't work
12 * patch20: pattern modifiers i and o didn't interact right
13 * patch20: @ in unpack failed too often
14 * patch20: Perl now distinguishes overlapped copies from non-overlapped
15 * patch20: slice on null list in scalar context returned random value
16 * patch20: splice with negative offset didn't work with $[ = 1
17 * patch20: fixed some memory leaks in splice
18 * patch20: scalar keys %array now counts keys for you
19 *
20 * Revision 4.0.1.4 91/11/11 16:33:19 lwall
21 * patch19: added little-endian pack/unpack options
22 * patch19: sort $subname was busted by changes in 4.018
23 *
24 * Revision 4.0.1.3 91/11/05 17:07:02 lwall
25 * patch11: prepared for ctype implementations that don't define isascii()
26 * patch11: /$foo/o optimizer could access deallocated data
27 * patch11: certain optimizations of //g in array context returned too many values
28 * patch11: regexp with no parens in array context returned wacky $`, $& and $'
29 * patch11: $' not set right on some //g
30 * patch11: added some support for 64-bit integers
31 * patch11: grep of a split lost its values
32 * patch11: added sort {} LIST
33 * patch11: multiple reallocations now avoided in 1 .. 100000
34 *
35 * Revision 4.0.1.2 91/06/10 01:22:15 lwall
36 * patch10: //g only worked first time through
37 *
38 * Revision 4.0.1.1 91/06/07 10:58:28 lwall
39 * patch4: new copyright notice
40 * patch4: added global modifier for pattern matches
41 * patch4: // wouldn't use previous pattern if it started with a null character
42 * patch4: //o and s///o now optimize themselves fully at runtime
43 * patch4: $` was busted inside s///
44 * patch4: caller($arg) didn't work except under debugger
45 *
46 * Revision 4.0 91/03/20 01:08:03 lwall
47 * 4.0 baseline.
48 *
49 */
50
51#include "EXTERN.h"
52#include "perl.h"
53
54static int sortcmp();
55static int sortsub();
56
57#ifdef BUGGY_MSC
58 #pragma function(memcmp)
59#endif /* BUGGY_MSC */
60
61int
62do_match(str,arg,gimme,arglast)
63STR *str;
64register ARG *arg;
65int gimme;
66int *arglast;
67{
68 register STR **st = stack->ary_array;
69 register SPAT *spat = arg[2].arg_ptr.arg_spat;
70 register char *t;
71 register int sp = arglast[0] + 1;
72 STR *srchstr = st[sp];
73 register char *s = str_get(st[sp]);
74 char *strend = s + st[sp]->str_cur;
75 STR *tmpstr;
76 char *myhint = hint;
77 int global;
78 int safebase;
79 char *truebase = s;
80 register REGEXP *rx = spat->spat_regexp;
81
82 hint = Nullch;
83 if (!spat) {
84 if (gimme == G_ARRAY)
85 return --sp;
86 str_set(str,Yes);
87 STABSET(str);
88 st[sp] = str;
89 return sp;
90 }
91 global = spat->spat_flags & SPAT_GLOBAL;
92 safebase = (gimme == G_ARRAY) || global;
93 if (!s)
94 fatal("panic: do_match");
95 if (spat->spat_flags & SPAT_USED) {
96#ifdef DEBUGGING
97 if (debug & 8)
98 deb("2.SPAT USED\n");
99#endif
100 if (gimme == G_ARRAY)
101 return --sp;
102 str_set(str,No);
103 STABSET(str);
104 st[sp] = str;
105 return sp;
106 }
107 --sp;
108 if (spat->spat_runtime) {
109 nointrp = "|)";
110 sp = eval(spat->spat_runtime,G_SCALAR,sp);
111 st = stack->ary_array;
112 t = str_get(tmpstr = st[sp--]);
113 nointrp = "";
114#ifdef DEBUGGING
115 if (debug & 8)
116 deb("2.SPAT /%s/\n",t);
117#endif
118 if (!global && rx)
119 regfree(rx);
120 spat->spat_regexp = Null(REGEXP*); /* crucial if regcomp aborts */
121 spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
122 spat->spat_flags & SPAT_FOLD);
123 if (!spat->spat_regexp->prelen && lastspat)
124 spat = lastspat;
125 if (spat->spat_flags & SPAT_KEEP) {
126 if (!(spat->spat_flags & SPAT_FOLD))
127 scanconst(spat,spat->spat_regexp->precomp,
128 spat->spat_regexp->prelen);
129 if (spat->spat_runtime)
130 arg_free(spat->spat_runtime); /* it won't change, so */
131 spat->spat_runtime = Nullarg; /* no point compiling again */
132 hoistmust(spat);
133 if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
134 curcmd->c_flags &= ~CF_OPTIMIZE;
135 opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
136 }
137 }
138 if (global) {
139 if (rx) {
140 if (rx->startp[0]) {
141 s = rx->endp[0];
142 if (s == rx->startp[0])
143 s++;
144 if (s > strend) {
145 regfree(rx);
146 rx = spat->spat_regexp;
147 goto nope;
148 }
149 }
150 regfree(rx);
151 }
152 }
153 else if (!spat->spat_regexp->nparens)
154 gimme = G_SCALAR; /* accidental array context? */
155 rx = spat->spat_regexp;
156 if (regexec(rx, s, strend, s, 0,
157 srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
158 safebase)) {
159 if (rx->subbase || global)
160 curspat = spat;
161 lastspat = spat;
162 goto gotcha;
163 }
164 else {
165 if (gimme == G_ARRAY)
166 return sp;
167 str_sset(str,&str_no);
168 STABSET(str);
169 st[++sp] = str;
170 return sp;
171 }
172 }
173 else {
174#ifdef DEBUGGING
175 if (debug & 8) {
176 char ch;
177
178 if (spat->spat_flags & SPAT_ONCE)
179 ch = '?';
180 else
181 ch = '/';
182 deb("2.SPAT %c%s%c\n",ch,rx->precomp,ch);
183 }
184#endif
185 if (!rx->prelen && lastspat) {
186 spat = lastspat;
187 rx = spat->spat_regexp;
188 }
189 t = s;
190 play_it_again:
191 if (global && rx->startp[0]) {
192 t = s = rx->endp[0];
193 if (s == rx->startp[0])
194 s++,t++;
195 if (s > strend)
196 goto nope;
197 }
198 if (myhint) {
199 if (myhint < s || myhint > strend)
200 fatal("panic: hint in do_match");
201 s = myhint;
202 if (rx->regback >= 0) {
203 s -= rx->regback;
204 if (s < t)
205 s = t;
206 }
207 else
208 s = t;
209 }
210 else if (spat->spat_short) {
211 if (spat->spat_flags & SPAT_SCANFIRST) {
212 if (srchstr->str_pok & SP_STUDIED) {
213 if (screamfirst[spat->spat_short->str_rare] < 0)
214 goto nope;
215 else if (!(s = screaminstr(srchstr,spat->spat_short)))
216 goto nope;
217 else if (spat->spat_flags & SPAT_ALL)
218 goto yup;
219 }
220#ifndef lint
221 else if (!(s = fbminstr((unsigned char*)s,
222 (unsigned char*)strend, spat->spat_short)))
223 goto nope;
224#endif
225 else if (spat->spat_flags & SPAT_ALL)
226 goto yup;
227 if (s && rx->regback >= 0) {
228 ++spat->spat_short->str_u.str_useful;
229 s -= rx->regback;
230 if (s < t)
231 s = t;
232 }
233 else
234 s = t;
235 }
236 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
237 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
238 goto nope;
239 if (--spat->spat_short->str_u.str_useful < 0) {
240 str_free(spat->spat_short);
241 spat->spat_short = Nullstr; /* opt is being useless */
242 }
243 }
244 if (!rx->nparens && !global) {
245 gimme = G_SCALAR; /* accidental array context? */
246 safebase = FALSE;
247 }
248 if (regexec(rx, s, strend, truebase, 0,
249 srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
250 safebase)) {
251 if (rx->subbase || global)
252 curspat = spat;
253 lastspat = spat;
254 if (spat->spat_flags & SPAT_ONCE)
255 spat->spat_flags |= SPAT_USED;
256 goto gotcha;
257 }
258 else {
259 if (global)
260 rx->startp[0] = Nullch;
261 if (gimme == G_ARRAY)
262 return sp;
263 str_sset(str,&str_no);
264 STABSET(str);
265 st[++sp] = str;
266 return sp;
267 }
268 }
269 /*NOTREACHED*/
270
271 gotcha:
272 if (gimme == G_ARRAY) {
273 int iters, i, len;
274
275 iters = rx->nparens;
276 if (global && !iters)
277 i = 1;
278 else
279 i = 0;
280 if (sp + iters + i >= stack->ary_max) {
281 astore(stack,sp + iters + i, Nullstr);
282 st = stack->ary_array; /* possibly realloced */
283 }
284
285 for (i = !i; i <= iters; i++) {
286 st[++sp] = str_mortal(&str_no);
287 /*SUPPRESS 560*/
288 if (s = rx->startp[i]) {
289 len = rx->endp[i] - s;
290 if (len > 0)
291 str_nset(st[sp],s,len);
292 }
293 }
294 if (global) {
295 truebase = rx->subbeg;
296 goto play_it_again;
297 }
298 return sp;
299 }
300 else {
301 str_sset(str,&str_yes);
302 STABSET(str);
303 st[++sp] = str;
304 return sp;
305 }
306
307yup:
308 ++spat->spat_short->str_u.str_useful;
309 lastspat = spat;
310 if (spat->spat_flags & SPAT_ONCE)
311 spat->spat_flags |= SPAT_USED;
312 if (global) {
313 rx->subbeg = t;
314 rx->subend = strend;
315 rx->startp[0] = s;
316 rx->endp[0] = s + spat->spat_short->str_cur;
317 curspat = spat;
318 goto gotcha;
319 }
320 if (sawampersand) {
321 char *tmps;
322
323 if (rx->subbase)
324 Safefree(rx->subbase);
325 tmps = rx->subbase = nsavestr(t,strend-t);
326 rx->subbeg = tmps;
327 rx->subend = tmps + (strend-t);
328 tmps = rx->startp[0] = tmps + (s - t);
329 rx->endp[0] = tmps + spat->spat_short->str_cur;
330 curspat = spat;
331 }
332 str_sset(str,&str_yes);
333 STABSET(str);
334 st[++sp] = str;
335 return sp;
336
337nope:
338 rx->startp[0] = Nullch;
339 if (spat->spat_short)
340 ++spat->spat_short->str_u.str_useful;
341 if (gimme == G_ARRAY)
342 return sp;
343 str_sset(str,&str_no);
344 STABSET(str);
345 st[++sp] = str;
346 return sp;
347}
348
349#ifdef BUGGY_MSC
350 #pragma intrinsic(memcmp)
351#endif /* BUGGY_MSC */
352
353int
354do_split(str,spat,limit,gimme,arglast)
355STR *str;
356register SPAT *spat;
357register int limit;
358int gimme;
359int *arglast;
360{
361 register ARRAY *ary = stack;
362 STR **st = ary->ary_array;
363 register int sp = arglast[0] + 1;
364 register char *s = str_get(st[sp]);
365 char *strend = s + st[sp--]->str_cur;
366 register STR *dstr;
367 register char *m;
368 int iters = 0;
369 int maxiters = (strend - s) + 10;
370 int i;
371 char *orig;
372 int origlimit = limit;
373 int realarray = 0;
374
375 if (!spat || !s)
376 fatal("panic: do_split");
377 else if (spat->spat_runtime) {
378 nointrp = "|)";
379 sp = eval(spat->spat_runtime,G_SCALAR,sp);
380 st = stack->ary_array;
381 m = str_get(dstr = st[sp--]);
382 nointrp = "";
383 if (*m == ' ' && dstr->str_cur == 1) {
384 str_set(dstr,"\\s+");
385 m = dstr->str_ptr;
386 spat->spat_flags |= SPAT_SKIPWHITE;
387 }
388 if (spat->spat_regexp) {
389 regfree(spat->spat_regexp);
390 spat->spat_regexp = Null(REGEXP*); /* avoid possible double free */
391 }
392 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
393 spat->spat_flags & SPAT_FOLD);
394 if (spat->spat_flags & SPAT_KEEP ||
395 (spat->spat_runtime->arg_type == O_ITEM &&
396 (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
397 arg_free(spat->spat_runtime); /* it won't change, so */
398 spat->spat_runtime = Nullarg; /* no point compiling again */
399 }
400 }
401#ifdef DEBUGGING
402 if (debug & 8) {
403 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
404 }
405#endif
406 ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
407 if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
408 realarray = 1;
409 if (!(ary->ary_flags & ARF_REAL)) {
410 ary->ary_flags |= ARF_REAL;
411 for (i = ary->ary_fill; i >= 0; i--)
412 ary->ary_array[i] = Nullstr; /* don't free mere refs */
413 }
414 ary->ary_fill = -1;
415 sp = -1; /* temporarily switch stacks */
416 }
417 else
418 ary = stack;
419 orig = s;
420 if (spat->spat_flags & SPAT_SKIPWHITE) {
421 while (isSPACE(*s))
422 s++;
423 }
424 if (!limit)
425 limit = maxiters + 2;
426 if (strEQ("\\s+",spat->spat_regexp->precomp)) {
427 while (--limit) {
428 /*SUPPRESS 530*/
429 for (m = s; m < strend && !isSPACE(*m); m++) ;
430 if (m >= strend)
431 break;
432 dstr = Str_new(30,m-s);
433 str_nset(dstr,s,m-s);
434 if (!realarray)
435 str_2mortal(dstr);
436 (void)astore(ary, ++sp, dstr);
437 /*SUPPRESS 530*/
438 for (s = m + 1; s < strend && isSPACE(*s); s++) ;
439 }
440 }
441 else if (strEQ("^",spat->spat_regexp->precomp)) {
442 while (--limit) {
443 /*SUPPRESS 530*/
444 for (m = s; m < strend && *m != '\n'; m++) ;
445 m++;
446 if (m >= strend)
447 break;
448 dstr = Str_new(30,m-s);
449 str_nset(dstr,s,m-s);
450 if (!realarray)
451 str_2mortal(dstr);
452 (void)astore(ary, ++sp, dstr);
453 s = m;
454 }
455 }
456 else if (spat->spat_short) {
457 i = spat->spat_short->str_cur;
458 if (i == 1) {
459 int fold = (spat->spat_flags & SPAT_FOLD);
460
461 i = *spat->spat_short->str_ptr;
462 if (fold && isUPPER(i))
463 i = tolower(i);
464 while (--limit) {
465 if (fold) {
466 for ( m = s;
467 m < strend && *m != i &&
468 (!isUPPER(*m) || tolower(*m) != i);
469 m++) /*SUPPRESS 530*/
470 ;
471 }
472 else /*SUPPRESS 530*/
473 for (m = s; m < strend && *m != i; m++) ;
474 if (m >= strend)
475 break;
476 dstr = Str_new(30,m-s);
477 str_nset(dstr,s,m-s);
478 if (!realarray)
479 str_2mortal(dstr);
480 (void)astore(ary, ++sp, dstr);
481 s = m + 1;
482 }
483 }
484 else {
485#ifndef lint
486 while (s < strend && --limit &&
487 (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
488 spat->spat_short)) )
489#endif
490 {
491 dstr = Str_new(31,m-s);
492 str_nset(dstr,s,m-s);
493 if (!realarray)
494 str_2mortal(dstr);
495 (void)astore(ary, ++sp, dstr);
496 s = m + i;
497 }
498 }
499 }
500 else {
501 maxiters += (strend - s) * spat->spat_regexp->nparens;
502 while (s < strend && --limit &&
503 regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
504 if (spat->spat_regexp->subbase
505 && spat->spat_regexp->subbase != orig) {
506 m = s;
507 s = orig;
508 orig = spat->spat_regexp->subbase;
509 s = orig + (m - s);
510 strend = s + (strend - m);
511 }
512 m = spat->spat_regexp->startp[0];
513 dstr = Str_new(32,m-s);
514 str_nset(dstr,s,m-s);
515 if (!realarray)
516 str_2mortal(dstr);
517 (void)astore(ary, ++sp, dstr);
518 if (spat->spat_regexp->nparens) {
519 for (i = 1; i <= spat->spat_regexp->nparens; i++) {
520 s = spat->spat_regexp->startp[i];
521 m = spat->spat_regexp->endp[i];
522 dstr = Str_new(33,m-s);
523 str_nset(dstr,s,m-s);
524 if (!realarray)
525 str_2mortal(dstr);
526 (void)astore(ary, ++sp, dstr);
527 }
528 }
529 s = spat->spat_regexp->endp[0];
530 }
531 }
532 if (realarray)
533 iters = sp + 1;
534 else
535 iters = sp - arglast[0];
536 if (iters > maxiters)
537 fatal("Split loop");
538 if (s < strend || origlimit) { /* keep field after final delim? */
539 dstr = Str_new(34,strend-s);
540 str_nset(dstr,s,strend-s);
541 if (!realarray)
542 str_2mortal(dstr);
543 (void)astore(ary, ++sp, dstr);
544 iters++;
545 }
546 else {
547#ifndef I286x
548 while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
549 iters--,sp--;
550#else
551 char *zaps;
552 int zapb;
553
554 if (iters > 0) {
555 zaps = str_get(afetch(ary,sp,FALSE));
556 zapb = (int) *zaps;
557 }
558
559 while (iters > 0 && (!zapb)) {
560 iters--,sp--;
561 if (iters > 0) {
562 zaps = str_get(afetch(ary,iters-1,FALSE));
563 zapb = (int) *zaps;
564 }
565 }
566#endif
567 }
568 if (realarray) {
569 ary->ary_fill = sp;
570 if (gimme == G_ARRAY) {
571 sp++;
572 astore(stack, arglast[0] + 1 + sp, Nullstr);
573 Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
574 return arglast[0] + sp;
575 }
576 }
577 else {
578 if (gimme == G_ARRAY)
579 return sp;
580 }
581 sp = arglast[0] + 1;
582 str_numset(str,(double)iters);
583 STABSET(str);
584 st[sp] = str;
585 return sp;
586}
587
588int
589do_unpack(str,gimme,arglast)
590STR *str;
591int gimme;
592int *arglast;
593{
594 STR **st = stack->ary_array;
595 register int sp = arglast[0] + 1;
596 register char *pat = str_get(st[sp++]);
597 register char *s = str_get(st[sp]);
598 char *strend = s + st[sp--]->str_cur;
599 char *strbeg = s;
600 register char *patend = pat + st[sp]->str_cur;
601 int datumtype;
602 register int len;
603 register int bits;
604
605 /* These must not be in registers: */
606 short ashort;
607 int aint;
608 long along;
609#ifdef QUAD
610 quad aquad;
611#endif
612 unsigned short aushort;
613 unsigned int auint;
614 unsigned long aulong;
615#ifdef QUAD
616 unsigned quad auquad;
617#endif
618 char *aptr;
619 float afloat;
620 double adouble;
621 int checksum = 0;
622 unsigned long culong;
623 double cdouble;
624
625 if (gimme != G_ARRAY) { /* arrange to do first one only */
626 /*SUPPRESS 530*/
627 for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
628 if (index("aAbBhH", *patend) || *pat == '%') {
629 patend++;
630 while (isDIGIT(*patend) || *patend == '*')
631 patend++;
632 }
633 else
634 patend++;
635 }
636 sp--;
637 while (pat < patend) {
638 reparse:
639 datumtype = *pat++;
640 if (pat >= patend)
641 len = 1;
642 else if (*pat == '*') {
643 len = strend - strbeg; /* long enough */
644 pat++;
645 }
646 else if (isDIGIT(*pat)) {
647 len = *pat++ - '0';
648 while (isDIGIT(*pat))
649 len = (len * 10) + (*pat++ - '0');
650 }
651 else
652 len = (datumtype != '@');
653 switch(datumtype) {
654 default:
655 break;
656 case '%':
657 if (len == 1 && pat[-1] != '1')
658 len = 16;
659 checksum = len;
660 culong = 0;
661 cdouble = 0;
662 if (pat < patend)
663 goto reparse;
664 break;
665 case '@':
666 if (len > strend - strbeg)
667 fatal("@ outside of string");
668 s = strbeg + len;
669 break;
670 case 'X':
671 if (len > s - strbeg)
672 fatal("X outside of string");
673 s -= len;
674 break;
675 case 'x':
676 if (len > strend - s)
677 fatal("x outside of string");
678 s += len;
679 break;
680 case 'A':
681 case 'a':
682 if (len > strend - s)
683 len = strend - s;
684 if (checksum)
685 goto uchar_checksum;
686 str = Str_new(35,len);
687 str_nset(str,s,len);
688 s += len;
689 if (datumtype == 'A') {
690 aptr = s; /* borrow register */
691 s = str->str_ptr + len - 1;
692 while (s >= str->str_ptr && (!*s || isSPACE(*s)))
693 s--;
694 *++s = '\0';
695 str->str_cur = s - str->str_ptr;
696 s = aptr; /* unborrow register */
697 }
698 (void)astore(stack, ++sp, str_2mortal(str));
699 break;
700 case 'B':
701 case 'b':
702 if (pat[-1] == '*' || len > (strend - s) * 8)
703 len = (strend - s) * 8;
704 str = Str_new(35, len + 1);
705 str->str_cur = len;
706 str->str_pok = 1;
707 aptr = pat; /* borrow register */
708 pat = str->str_ptr;
709 if (datumtype == 'b') {
710 aint = len;
711 for (len = 0; len < aint; len++) {
712 if (len & 7) /*SUPPRESS 595*/
713 bits >>= 1;
714 else
715 bits = *s++;
716 *pat++ = '0' + (bits & 1);
717 }
718 }
719 else {
720 aint = len;
721 for (len = 0; len < aint; len++) {
722 if (len & 7)
723 bits <<= 1;
724 else
725 bits = *s++;
726 *pat++ = '0' + ((bits & 128) != 0);
727 }
728 }
729 *pat = '\0';
730 pat = aptr; /* unborrow register */
731 (void)astore(stack, ++sp, str_2mortal(str));
732 break;
733 case 'H':
734 case 'h':
735 if (pat[-1] == '*' || len > (strend - s) * 2)
736 len = (strend - s) * 2;
737 str = Str_new(35, len + 1);
738 str->str_cur = len;
739 str->str_pok = 1;
740 aptr = pat; /* borrow register */
741 pat = str->str_ptr;
742 if (datumtype == 'h') {
743 aint = len;
744 for (len = 0; len < aint; len++) {
745 if (len & 1)
746 bits >>= 4;
747 else
748 bits = *s++;
749 *pat++ = hexdigit[bits & 15];
750 }
751 }
752 else {
753 aint = len;
754 for (len = 0; len < aint; len++) {
755 if (len & 1)
756 bits <<= 4;
757 else
758 bits = *s++;
759 *pat++ = hexdigit[(bits >> 4) & 15];
760 }
761 }
762 *pat = '\0';
763 pat = aptr; /* unborrow register */
764 (void)astore(stack, ++sp, str_2mortal(str));
765 break;
766 case 'c':
767 if (len > strend - s)
768 len = strend - s;
769 if (checksum) {
770 while (len-- > 0) {
771 aint = *s++;
772 if (aint >= 128) /* fake up signed chars */
773 aint -= 256;
774 culong += aint;
775 }
776 }
777 else {
778 while (len-- > 0) {
779 aint = *s++;
780 if (aint >= 128) /* fake up signed chars */
781 aint -= 256;
782 str = Str_new(36,0);
783 str_numset(str,(double)aint);
784 (void)astore(stack, ++sp, str_2mortal(str));
785 }
786 }
787 break;
788 case 'C':
789 if (len > strend - s)
790 len = strend - s;
791 if (checksum) {
792 uchar_checksum:
793 while (len-- > 0) {
794 auint = *s++ & 255;
795 culong += auint;
796 }
797 }
798 else {
799 while (len-- > 0) {
800 auint = *s++ & 255;
801 str = Str_new(37,0);
802 str_numset(str,(double)auint);
803 (void)astore(stack, ++sp, str_2mortal(str));
804 }
805 }
806 break;
807 case 's':
808 along = (strend - s) / sizeof(short);
809 if (len > along)
810 len = along;
811 if (checksum) {
812 while (len-- > 0) {
813 Copy(s,&ashort,1,short);
814 s += sizeof(short);
815 culong += ashort;
816 }
817 }
818 else {
819 while (len-- > 0) {
820 Copy(s,&ashort,1,short);
821 s += sizeof(short);
822 str = Str_new(38,0);
823 str_numset(str,(double)ashort);
824 (void)astore(stack, ++sp, str_2mortal(str));
825 }
826 }
827 break;
828 case 'v':
829 case 'n':
830 case 'S':
831 along = (strend - s) / sizeof(unsigned short);
832 if (len > along)
833 len = along;
834 if (checksum) {
835 while (len-- > 0) {
836 Copy(s,&aushort,1,unsigned short);
837 s += sizeof(unsigned short);
838#ifdef HAS_NTOHS
839 if (datumtype == 'n')
840 aushort = ntohs(aushort);
841#endif
842#ifdef HAS_VTOHS
843 if (datumtype == 'v')
844 aushort = vtohs(aushort);
845#endif
846 culong += aushort;
847 }
848 }
849 else {
850 while (len-- > 0) {
851 Copy(s,&aushort,1,unsigned short);
852 s += sizeof(unsigned short);
853 str = Str_new(39,0);
854#ifdef HAS_NTOHS
855 if (datumtype == 'n')
856 aushort = ntohs(aushort);
857#endif
858#ifdef HAS_VTOHS
859 if (datumtype == 'v')
860 aushort = vtohs(aushort);
861#endif
862 str_numset(str,(double)aushort);
863 (void)astore(stack, ++sp, str_2mortal(str));
864 }
865 }
866 break;
867 case 'i':
868 along = (strend - s) / sizeof(int);
869 if (len > along)
870 len = along;
871 if (checksum) {
872 while (len-- > 0) {
873 Copy(s,&aint,1,int);
874 s += sizeof(int);
875 if (checksum > 32)
876 cdouble += (double)aint;
877 else
878 culong += aint;
879 }
880 }
881 else {
882 while (len-- > 0) {
883 Copy(s,&aint,1,int);
884 s += sizeof(int);
885 str = Str_new(40,0);
886 str_numset(str,(double)aint);
887 (void)astore(stack, ++sp, str_2mortal(str));
888 }
889 }
890 break;
891 case 'I':
892 along = (strend - s) / sizeof(unsigned int);
893 if (len > along)
894 len = along;
895 if (checksum) {
896 while (len-- > 0) {
897 Copy(s,&auint,1,unsigned int);
898 s += sizeof(unsigned int);
899 if (checksum > 32)
900 cdouble += (double)auint;
901 else
902 culong += auint;
903 }
904 }
905 else {
906 while (len-- > 0) {
907 Copy(s,&auint,1,unsigned int);
908 s += sizeof(unsigned int);
909 str = Str_new(41,0);
910 str_numset(str,(double)auint);
911 (void)astore(stack, ++sp, str_2mortal(str));
912 }
913 }
914 break;
915 case 'l':
916 along = (strend - s) / sizeof(long);
917 if (len > along)
918 len = along;
919 if (checksum) {
920 while (len-- > 0) {
921 Copy(s,&along,1,long);
922 s += sizeof(long);
923 if (checksum > 32)
924 cdouble += (double)along;
925 else
926 culong += along;
927 }
928 }
929 else {
930 while (len-- > 0) {
931 Copy(s,&along,1,long);
932 s += sizeof(long);
933 str = Str_new(42,0);
934 str_numset(str,(double)along);
935 (void)astore(stack, ++sp, str_2mortal(str));
936 }
937 }
938 break;
939 case 'V':
940 case 'N':
941 case 'L':
942 along = (strend - s) / sizeof(unsigned long);
943 if (len > along)
944 len = along;
945 if (checksum) {
946 while (len-- > 0) {
947 Copy(s,&aulong,1,unsigned long);
948 s += sizeof(unsigned long);
949#ifdef HAS_NTOHL
950 if (datumtype == 'N')
951 aulong = ntohl(aulong);
952#endif
953#ifdef HAS_VTOHL
954 if (datumtype == 'V')
955 aulong = vtohl(aulong);
956#endif
957 if (checksum > 32)
958 cdouble += (double)aulong;
959 else
960 culong += aulong;
961 }
962 }
963 else {
964 while (len-- > 0) {
965 Copy(s,&aulong,1,unsigned long);
966 s += sizeof(unsigned long);
967 str = Str_new(43,0);
968#ifdef HAS_NTOHL
969 if (datumtype == 'N')
970 aulong = ntohl(aulong);
971#endif
972#ifdef HAS_VTOHL
973 if (datumtype == 'V')
974 aulong = vtohl(aulong);
975#endif
976 str_numset(str,(double)aulong);
977 (void)astore(stack, ++sp, str_2mortal(str));
978 }
979 }
980 break;
981 case 'p':
982 along = (strend - s) / sizeof(char*);
983 if (len > along)
984 len = along;
985 while (len-- > 0) {
986 if (sizeof(char*) > strend - s)
987 break;
988 else {
989 Copy(s,&aptr,1,char*);
990 s += sizeof(char*);
991 }
992 str = Str_new(44,0);
993 if (aptr)
994 str_set(str,aptr);
995 (void)astore(stack, ++sp, str_2mortal(str));
996 }
997 break;
998#ifdef QUAD
999 case 'q':
1000 while (len-- > 0) {
1001 if (s + sizeof(quad) > strend)
1002 aquad = 0;
1003 else {
1004 Copy(s,&aquad,1,quad);
1005 s += sizeof(quad);
1006 }
1007 str = Str_new(42,0);
1008 str_numset(str,(double)aquad);
1009 (void)astore(stack, ++sp, str_2mortal(str));
1010 }
1011 break;
1012 case 'Q':
1013 while (len-- > 0) {
1014 if (s + sizeof(unsigned quad) > strend)
1015 auquad = 0;
1016 else {
1017 Copy(s,&auquad,1,unsigned quad);
1018 s += sizeof(unsigned quad);
1019 }
1020 str = Str_new(43,0);
1021 str_numset(str,(double)auquad);
1022 (void)astore(stack, ++sp, str_2mortal(str));
1023 }
1024 break;
1025#endif
1026 /* float and double added gnb@melba.bby.oz.au 22/11/89 */
1027 case 'f':
1028 case 'F':
1029 along = (strend - s) / sizeof(float);
1030 if (len > along)
1031 len = along;
1032 if (checksum) {
1033 while (len-- > 0) {
1034 Copy(s, &afloat,1, float);
1035 s += sizeof(float);
1036 cdouble += afloat;
1037 }
1038 }
1039 else {
1040 while (len-- > 0) {
1041 Copy(s, &afloat,1, float);
1042 s += sizeof(float);
1043 str = Str_new(47, 0);
1044 str_numset(str, (double)afloat);
1045 (void)astore(stack, ++sp, str_2mortal(str));
1046 }
1047 }
1048 break;
1049 case 'd':
1050 case 'D':
1051 along = (strend - s) / sizeof(double);
1052 if (len > along)
1053 len = along;
1054 if (checksum) {
1055 while (len-- > 0) {
1056 Copy(s, &adouble,1, double);
1057 s += sizeof(double);
1058 cdouble += adouble;
1059 }
1060 }
1061 else {
1062 while (len-- > 0) {
1063 Copy(s, &adouble,1, double);
1064 s += sizeof(double);
1065 str = Str_new(48, 0);
1066 str_numset(str, (double)adouble);
1067 (void)astore(stack, ++sp, str_2mortal(str));
1068 }
1069 }
1070 break;
1071 case 'u':
1072 along = (strend - s) * 3 / 4;
1073 str = Str_new(42,along);
1074 while (s < strend && *s > ' ' && *s < 'a') {
1075 int a,b,c,d;
1076 char hunk[4];
1077
1078 hunk[3] = '\0';
1079 len = (*s++ - ' ') & 077;
1080 while (len > 0) {
1081 if (s < strend && *s >= ' ')
1082 a = (*s++ - ' ') & 077;
1083 else
1084 a = 0;
1085 if (s < strend && *s >= ' ')
1086 b = (*s++ - ' ') & 077;
1087 else
1088 b = 0;
1089 if (s < strend && *s >= ' ')
1090 c = (*s++ - ' ') & 077;
1091 else
1092 c = 0;
1093 if (s < strend && *s >= ' ')
1094 d = (*s++ - ' ') & 077;
1095 else
1096 d = 0;
1097 hunk[0] = a << 2 | b >> 4;
1098 hunk[1] = b << 4 | c >> 2;
1099 hunk[2] = c << 6 | d;
1100 str_ncat(str,hunk, len > 3 ? 3 : len);
1101 len -= 3;
1102 }
1103 if (*s == '\n')
1104 s++;
1105 else if (s[1] == '\n') /* possible checksum byte */
1106 s += 2;
1107 }
1108 (void)astore(stack, ++sp, str_2mortal(str));
1109 break;
1110 }
1111 if (checksum) {
1112 str = Str_new(42,0);
1113 if (index("fFdD", datumtype) ||
1114 (checksum > 32 && index("iIlLN", datumtype)) ) {
1115 double modf();
1116 double trouble;
1117
1118 adouble = 1.0;
1119 while (checksum >= 16) {
1120 checksum -= 16;
1121 adouble *= 65536.0;
1122 }
1123 while (checksum >= 4) {
1124 checksum -= 4;
1125 adouble *= 16.0;
1126 }
1127 while (checksum--)
1128 adouble *= 2.0;
1129 along = (1 << checksum) - 1;
1130 while (cdouble < 0.0)
1131 cdouble += adouble;
1132 cdouble = modf(cdouble / adouble, &trouble) * adouble;
1133 str_numset(str,cdouble);
1134 }
1135 else {
1136 if (checksum < 32) {
1137 along = (1 << checksum) - 1;
1138 culong &= (unsigned long)along;
1139 }
1140 str_numset(str,(double)culong);
1141 }
1142 (void)astore(stack, ++sp, str_2mortal(str));
1143 checksum = 0;
1144 }
1145 }
1146 return sp;
1147}
1148
1149int
1150do_slice(stab,str,numarray,lval,gimme,arglast)
1151STAB *stab;
1152STR *str;
1153int numarray;
1154int lval;
1155int gimme;
1156int *arglast;
1157{
1158 register STR **st = stack->ary_array;
1159 register int sp = arglast[1];
1160 register int max = arglast[2];
1161 register char *tmps;
1162 register int len;
1163 register int magic = 0;
1164 register ARRAY *ary;
1165 register HASH *hash;
1166 int oldarybase = arybase;
1167
1168 if (numarray) {
1169 if (numarray == 2) { /* a slice of a LIST */
1170 ary = stack;
1171 ary->ary_fill = arglast[3];
1172 arybase -= max + 1;
1173 st[sp] = str; /* make stack size available */
1174 str_numset(str,(double)(sp - 1));
1175 }
1176 else
1177 ary = stab_array(stab); /* a slice of an array */
1178 }
1179 else {
1180 if (lval) {
1181 if (stab == envstab)
1182 magic = 'E';
1183 else if (stab == sigstab)
1184 magic = 'S';
1185#ifdef SOME_DBM
1186 else if (stab_hash(stab)->tbl_dbm)
1187 magic = 'D';
1188#endif /* SOME_DBM */
1189 }
1190 hash = stab_hash(stab); /* a slice of an associative array */
1191 }
1192
1193 if (gimme == G_ARRAY) {
1194 if (numarray) {
1195 while (sp < max) {
1196 if (st[++sp]) {
1197 st[sp-1] = afetch(ary,
1198 ((int)str_gnum(st[sp])) - arybase, lval);
1199 }
1200 else
1201 st[sp-1] = &str_undef;
1202 }
1203 }
1204 else {
1205 while (sp < max) {
1206 if (st[++sp]) {
1207 tmps = str_get(st[sp]);
1208 len = st[sp]->str_cur;
1209 st[sp-1] = hfetch(hash,tmps,len, lval);
1210 if (magic)
1211 str_magic(st[sp-1],stab,magic,tmps,len);
1212 }
1213 else
1214 st[sp-1] = &str_undef;
1215 }
1216 }
1217 sp--;
1218 }
1219 else {
1220 if (sp == max)
1221 st[sp] = &str_undef;
1222 else if (numarray) {
1223 if (st[max])
1224 st[sp] = afetch(ary,
1225 ((int)str_gnum(st[max])) - arybase, lval);
1226 else
1227 st[sp] = &str_undef;
1228 }
1229 else {
1230 if (st[max]) {
1231 tmps = str_get(st[max]);
1232 len = st[max]->str_cur;
1233 st[sp] = hfetch(hash,tmps,len, lval);
1234 if (magic)
1235 str_magic(st[sp],stab,magic,tmps,len);
1236 }
1237 else
1238 st[sp] = &str_undef;
1239 }
1240 }
1241 arybase = oldarybase;
1242 return sp;
1243}
1244
1245int
1246do_splice(ary,gimme,arglast)
1247register ARRAY *ary;
1248int gimme;
1249int *arglast;
1250{
1251 register STR **st = stack->ary_array;
1252 register int sp = arglast[1];
1253 int max = arglast[2] + 1;
1254 register STR **src;
1255 register STR **dst;
1256 register int i;
1257 register int offset;
1258 register int length;
1259 int newlen;
1260 int after;
1261 int diff;
1262 STR **tmparyval;
1263
1264 if (++sp < max) {
1265 offset = (int)str_gnum(st[sp]);
1266 if (offset < 0)
1267 offset += ary->ary_fill + 1;
1268 else
1269 offset -= arybase;
1270 if (++sp < max) {
1271 length = (int)str_gnum(st[sp++]);
1272 if (length < 0)
1273 length = 0;
1274 }
1275 else
1276 length = ary->ary_max + 1; /* close enough to infinity */
1277 }
1278 else {
1279 offset = 0;
1280 length = ary->ary_max + 1;
1281 }
1282 if (offset < 0) {
1283 length += offset;
1284 offset = 0;
1285 if (length < 0)
1286 length = 0;
1287 }
1288 if (offset > ary->ary_fill + 1)
1289 offset = ary->ary_fill + 1;
1290 after = ary->ary_fill + 1 - (offset + length);
1291 if (after < 0) { /* not that much array */
1292 length += after; /* offset+length now in array */
1293 after = 0;
1294 if (!ary->ary_alloc) {
1295 afill(ary,0);
1296 afill(ary,-1);
1297 }
1298 }
1299
1300 /* At this point, sp .. max-1 is our new LIST */
1301
1302 newlen = max - sp;
1303 diff = newlen - length;
1304
1305 if (diff < 0) { /* shrinking the area */
1306 if (newlen) {
1307 New(451, tmparyval, newlen, STR*); /* so remember insertion */
1308 Copy(st+sp, tmparyval, newlen, STR*);
1309 }
1310
1311 sp = arglast[0] + 1;
1312 if (gimme == G_ARRAY) { /* copy return vals to stack */
1313 if (sp + length >= stack->ary_max) {
1314 astore(stack,sp + length, Nullstr);
1315 st = stack->ary_array;
1316 }
1317 Copy(ary->ary_array+offset, st+sp, length, STR*);
1318 if (ary->ary_flags & ARF_REAL) {
1319 for (i = length, dst = st+sp; i; i--)
1320 str_2mortal(*dst++); /* free them eventualy */
1321 }
1322 sp += length - 1;
1323 }
1324 else {
1325 st[sp] = ary->ary_array[offset+length-1];
1326 if (ary->ary_flags & ARF_REAL) {
1327 str_2mortal(st[sp]);
1328 for (i = length - 1, dst = &ary->ary_array[offset]; i > 0; i--)
1329 str_free(*dst++); /* free them now */
1330 }
1331 }
1332 ary->ary_fill += diff;
1333
1334 /* pull up or down? */
1335
1336 if (offset < after) { /* easier to pull up */
1337 if (offset) { /* esp. if nothing to pull */
1338 src = &ary->ary_array[offset-1];
1339 dst = src - diff; /* diff is negative */
1340 for (i = offset; i > 0; i--) /* can't trust Copy */
1341 *dst-- = *src--;
1342 }
1343 Zero(ary->ary_array, -diff, STR*);
1344 ary->ary_array -= diff; /* diff is negative */
1345 ary->ary_max += diff;
1346 }
1347 else {
1348 if (after) { /* anything to pull down? */
1349 src = ary->ary_array + offset + length;
1350 dst = src + diff; /* diff is negative */
1351 Move(src, dst, after, STR*);
1352 }
1353 Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*);
1354 /* avoid later double free */
1355 }
1356 if (newlen) {
1357 for (src = tmparyval, dst = ary->ary_array + offset;
1358 newlen; newlen--) {
1359 *dst = Str_new(46,0);
1360 str_sset(*dst++,*src++);
1361 }
1362 Safefree(tmparyval);
1363 }
1364 }
1365 else { /* no, expanding (or same) */
1366 if (length) {
1367 New(452, tmparyval, length, STR*); /* so remember deletion */
1368 Copy(ary->ary_array+offset, tmparyval, length, STR*);
1369 }
1370
1371 if (diff > 0) { /* expanding */
1372
1373 /* push up or down? */
1374
1375 if (offset < after && diff <= ary->ary_array - ary->ary_alloc) {
1376 if (offset) {
1377 src = ary->ary_array;
1378 dst = src - diff;
1379 Move(src, dst, offset, STR*);
1380 }
1381 ary->ary_array -= diff; /* diff is positive */
1382 ary->ary_max += diff;
1383 ary->ary_fill += diff;
1384 }
1385 else {
1386 if (ary->ary_fill + diff >= ary->ary_max) /* oh, well */
1387 astore(ary, ary->ary_fill + diff, Nullstr);
1388 else
1389 ary->ary_fill += diff;
1390 dst = ary->ary_array + ary->ary_fill;
1391 for (i = diff; i > 0; i--) {
1392 if (*dst) /* str was hanging around */
1393 str_free(*dst); /* after $#foo */
1394 dst--;
1395 }
1396 if (after) {
1397 dst = ary->ary_array + ary->ary_fill;
1398 src = dst - diff;
1399 for (i = after; i; i--) {
1400 *dst-- = *src--;
1401 }
1402 }
1403 }
1404 }
1405
1406 for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) {
1407 *dst = Str_new(46,0);
1408 str_sset(*dst++,*src++);
1409 }
1410 sp = arglast[0] + 1;
1411 if (gimme == G_ARRAY) { /* copy return vals to stack */
1412 if (length) {
1413 Copy(tmparyval, st+sp, length, STR*);
1414 if (ary->ary_flags & ARF_REAL) {
1415 for (i = length, dst = st+sp; i; i--)
1416 str_2mortal(*dst++); /* free them eventualy */
1417 }
1418 Safefree(tmparyval);
1419 }
1420 sp += length - 1;
1421 }
1422 else if (length--) {
1423 st[sp] = tmparyval[length];
1424 if (ary->ary_flags & ARF_REAL) {
1425 str_2mortal(st[sp]);
1426 while (length-- > 0)
1427 str_free(tmparyval[length]);
1428 }
1429 Safefree(tmparyval);
1430 }
1431 else
1432 st[sp] = &str_undef;
1433 }
1434 return sp;
1435}
1436
1437int
1438do_grep(arg,str,gimme,arglast)
1439register ARG *arg;
1440STR *str;
1441int gimme;
1442int *arglast;
1443{
1444 STR **st = stack->ary_array;
1445 register int dst = arglast[1];
1446 register int src = dst + 1;
1447 register int sp = arglast[2];
1448 register int i = sp - arglast[1];
1449 int oldsave = savestack->ary_fill;
1450 SPAT *oldspat = curspat;
1451 int oldtmps_base = tmps_base;
1452
1453 savesptr(&stab_val(defstab));
1454 tmps_base = tmps_max;
1455 if ((arg[1].arg_type & A_MASK) != A_EXPR) {
1456 arg[1].arg_type &= A_MASK;
1457 dehoist(arg,1);
1458 arg[1].arg_type |= A_DONT;
1459 }
1460 arg = arg[1].arg_ptr.arg_arg;
1461 while (i-- > 0) {
1462 if (st[src]) {
1463 st[src]->str_pok &= ~SP_TEMP;
1464 stab_val(defstab) = st[src];
1465 }
1466 else
1467 stab_val(defstab) = str_mortal(&str_undef);
1468 (void)eval(arg,G_SCALAR,sp);
1469 st = stack->ary_array;
1470 if (str_true(st[sp+1]))
1471 st[dst++] = st[src];
1472 src++;
1473 curspat = oldspat;
1474 }
1475 restorelist(oldsave);
1476 tmps_base = oldtmps_base;
1477 if (gimme != G_ARRAY) {
1478 str_numset(str,(double)(dst - arglast[1]));
1479 STABSET(str);
1480 st[arglast[0]+1] = str;
1481 return arglast[0]+1;
1482 }
1483 return arglast[0] + (dst - arglast[1]);
1484}
1485
1486int
1487do_reverse(arglast)
1488int *arglast;
1489{
1490 STR **st = stack->ary_array;
1491 register STR **up = &st[arglast[1]];
1492 register STR **down = &st[arglast[2]];
1493 register int i = arglast[2] - arglast[1];
1494
1495 while (i-- > 0) {
1496 *up++ = *down;
1497 if (i-- > 0)
1498 *down-- = *up;
1499 }
1500 i = arglast[2] - arglast[1];
1501 Move(down+1,up,i/2,STR*);
1502 return arglast[2] - 1;
1503}
1504
1505int
1506do_sreverse(str,arglast)
1507STR *str;
1508int *arglast;
1509{
1510 STR **st = stack->ary_array;
1511 register char *up;
1512 register char *down;
1513 register int tmp;
1514
1515 str_sset(str,st[arglast[2]]);
1516 up = str_get(str);
1517 if (str->str_cur > 1) {
1518 down = str->str_ptr + str->str_cur - 1;
1519 while (down > up) {
1520 tmp = *up;
1521 *up++ = *down;
1522 *down-- = tmp;
1523 }
1524 }
1525 STABSET(str);
1526 st[arglast[0]+1] = str;
1527 return arglast[0]+1;
1528}
1529
1530static CMD *sortcmd;
1531static HASH *sortstash = Null(HASH*);
1532static STAB *firststab = Nullstab;
1533static STAB *secondstab = Nullstab;
1534
1535int
1536do_sort(str,arg,gimme,arglast)
1537STR *str;
1538ARG *arg;
1539int gimme;
1540int *arglast;
1541{
1542 register STR **st = stack->ary_array;
1543 int sp = arglast[1];
1544 register STR **up;
1545 register int max = arglast[2] - sp;
1546 register int i;
1547 int sortcmp();
1548 int sortsub();
1549 STR *oldfirst;
1550 STR *oldsecond;
1551 ARRAY *oldstack;
1552 HASH *stash;
1553 STR *sortsubvar;
1554 static ARRAY *sortstack = Null(ARRAY*);
1555
1556 if (gimme != G_ARRAY) {
1557 str_sset(str,&str_undef);
1558 STABSET(str);
1559 st[sp] = str;
1560 return sp;
1561 }
1562 up = &st[sp];
1563 sortsubvar = *up;
1564 st += sp; /* temporarily make st point to args */
1565 for (i = 1; i <= max; i++) {
1566 /*SUPPRESS 560*/
1567 if (*up = st[i]) {
1568 if (!(*up)->str_pok)
1569 (void)str_2ptr(*up);
1570 else
1571 (*up)->str_pok &= ~SP_TEMP;
1572 up++;
1573 }
1574 }
1575 st -= sp;
1576 max = up - &st[sp];
1577 sp--;
1578 if (max > 1) {
1579 STAB *stab;
1580
1581 if (arg[1].arg_type == (A_CMD|A_DONT)) {
1582 sortcmd = arg[1].arg_ptr.arg_cmd;
1583 stash = curcmd->c_stash;
1584 }
1585 else {
1586 if ((arg[1].arg_type & A_MASK) == A_WORD)
1587 stab = arg[1].arg_ptr.arg_stab;
1588 else
1589 stab = stabent(str_get(sortsubvar),TRUE);
1590
1591 if (stab) {
1592 if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
1593 fatal("Undefined subroutine \"%s\" in sort",
1594 stab_ename(stab));
1595 stash = stab_estash(stab);
1596 }
1597 else
1598 sortcmd = Nullcmd;
1599 }
1600
1601 if (sortcmd) {
1602 int oldtmps_base = tmps_base;
1603
1604 if (!sortstack) {
1605 sortstack = anew(Nullstab);
1606 astore(sortstack, 0, Nullstr);
1607 aclear(sortstack);
1608 sortstack->ary_flags = 0;
1609 }
1610 oldstack = stack;
1611 stack = sortstack;
1612 tmps_base = tmps_max;
1613 if (sortstash != stash) {
1614 firststab = stabent("a",TRUE);
1615 secondstab = stabent("b",TRUE);
1616 sortstash = stash;
1617 }
1618 oldfirst = stab_val(firststab);
1619 oldsecond = stab_val(secondstab);
1620#ifndef lint
1621 qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
1622#else
1623 qsort(Nullch,max,sizeof(STR*),sortsub);
1624#endif
1625 stab_val(firststab) = oldfirst;
1626 stab_val(secondstab) = oldsecond;
1627 tmps_base = oldtmps_base;
1628 stack = oldstack;
1629 }
1630#ifndef lint
1631 else
1632 qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
1633#endif
1634 }
1635 return sp+max;
1636}
1637
1638static int
1639sortsub(str1,str2)
1640STR **str1;
1641STR **str2;
1642{
1643 stab_val(firststab) = *str1;
1644 stab_val(secondstab) = *str2;
1645 cmd_exec(sortcmd,G_SCALAR,-1);
1646 return (int)str_gnum(*stack->ary_array);
1647}
1648
1649static int
1650sortcmp(strp1,strp2)
1651STR **strp1;
1652STR **strp2;
1653{
1654 register STR *str1 = *strp1;
1655 register STR *str2 = *strp2;
1656 int retval;
1657
1658 if (str1->str_cur < str2->str_cur) {
1659 /*SUPPRESS 560*/
1660 if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
1661 return retval;
1662 else
1663 return -1;
1664 }
1665 /*SUPPRESS 560*/
1666 else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
1667 return retval;
1668 else if (str1->str_cur == str2->str_cur)
1669 return 0;
1670 else
1671 return 1;
1672}
1673
1674int
1675do_range(gimme,arglast)
1676int gimme;
1677int *arglast;
1678{
1679 STR **st = stack->ary_array;
1680 register int sp = arglast[0];
1681 register int i;
1682 register ARRAY *ary = stack;
1683 register STR *str;
1684 int max;
1685
1686 if (gimme != G_ARRAY)
1687 fatal("panic: do_range");
1688
1689 if (st[sp+1]->str_nok || !st[sp+1]->str_pok ||
1690 (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
1691 i = (int)str_gnum(st[sp+1]);
1692 max = (int)str_gnum(st[sp+2]);
1693 if (max > i)
1694 (void)astore(ary, sp + max - i + 1, Nullstr);
1695 while (i <= max) {
1696 (void)astore(ary, ++sp, str = str_mortal(&str_no));
1697 str_numset(str,(double)i++);
1698 }
1699 }
1700 else {
1701 STR *final = str_mortal(st[sp+2]);
1702 char *tmps = str_get(final);
1703
1704 str = str_mortal(st[sp+1]);
1705 while (!str->str_nok && str->str_cur <= final->str_cur &&
1706 strNE(str->str_ptr,tmps) ) {
1707 (void)astore(ary, ++sp, str);
1708 str = str_2mortal(str_smake(str));
1709 str_inc(str);
1710 }
1711 if (strEQ(str->str_ptr,tmps))
1712 (void)astore(ary, ++sp, str);
1713 }
1714 return sp;
1715}
1716
1717int
1718do_repeatary(arglast)
1719int *arglast;
1720{
1721 STR **st = stack->ary_array;
1722 register int sp = arglast[0];
1723 register int items = arglast[1] - sp;
1724 register int count = (int) str_gnum(st[arglast[2]]);
1725 register int i;
1726 int max;
1727
1728 max = items * count;
1729 if (max > 0 && sp + max > stack->ary_max) {
1730 astore(stack, sp + max, Nullstr);
1731 st = stack->ary_array;
1732 }
1733 if (count > 1) {
1734 for (i = arglast[1]; i > sp; i--)
1735 st[i]->str_pok &= ~SP_TEMP;
1736 repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1],
1737 items * sizeof(STR*), count);
1738 }
1739 sp += max;
1740
1741 return sp;
1742}
1743
1744int
1745do_caller(arg,maxarg,gimme,arglast)
1746ARG *arg;
1747int maxarg;
1748int gimme;
1749int *arglast;
1750{
1751 STR **st = stack->ary_array;
1752 register int sp = arglast[0];
1753 register CSV *csv = curcsv;
1754 STR *str;
1755 int count = 0;
1756
1757 if (!csv)
1758 fatal("There is no caller");
1759 if (maxarg)
1760 count = (int) str_gnum(st[sp+1]);
1761 for (;;) {
1762 if (!csv)
1763 return sp;
1764 if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
1765 count++;
1766 if (!count--)
1767 break;
1768 csv = csv->curcsv;
1769 }
1770 if (gimme != G_ARRAY) {
1771 STR *str = arg->arg_ptr.arg_str;
1772 str_set(str,csv->curcmd->c_stash->tbl_name);
1773 STABSET(str);
1774 st[++sp] = str;
1775 return sp;
1776 }
1777
1778#ifndef lint
1779 (void)astore(stack,++sp,
1780 str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) );
1781 (void)astore(stack,++sp,
1782 str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
1783 (void)astore(stack,++sp,
1784 str_2mortal(str_nmake((double)csv->curcmd->c_line)) );
1785 if (!maxarg)
1786 return sp;
1787 str = Str_new(49,0);
1788 stab_efullname(str, csv->stab);
1789 (void)astore(stack,++sp, str_2mortal(str));
1790 (void)astore(stack,++sp,
1791 str_2mortal(str_nmake((double)csv->hasargs)) );
1792 (void)astore(stack,++sp,
1793 str_2mortal(str_nmake((double)csv->wantarray)) );
1794 if (csv->hasargs) {
1795 ARRAY *ary = csv->argarray;
1796
1797 if (!dbargs)
1798 dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
1799 if (dbargs->ary_max < ary->ary_fill)
1800 astore(dbargs,ary->ary_fill,Nullstr);
1801 Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
1802 dbargs->ary_fill = ary->ary_fill;
1803 }
1804#else
1805 (void)astore(stack,++sp,
1806 str_2mortal(str_make("",0)));
1807#endif
1808 return sp;
1809}
1810
1811int
1812do_tms(str,gimme,arglast)
1813STR *str;
1814int gimme;
1815int *arglast;
1816{
1817#ifdef MSDOS
1818 return -1;
1819#else
1820 STR **st = stack->ary_array;
1821 register int sp = arglast[0];
1822
1823 if (gimme != G_ARRAY) {
1824 str_sset(str,&str_undef);
1825 STABSET(str);
1826 st[++sp] = str;
1827 return sp;
1828 }
1829 (void)times(&timesbuf);
1830
1831#ifndef HZ
1832#define HZ 60
1833#endif
1834
1835#ifndef lint
1836 (void)astore(stack,++sp,
1837 str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ)));
1838 (void)astore(stack,++sp,
1839 str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ)));
1840 (void)astore(stack,++sp,
1841 str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
1842 (void)astore(stack,++sp,
1843 str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
1844#else
1845 (void)astore(stack,++sp,
1846 str_2mortal(str_nmake(0.0)));
1847#endif
1848 return sp;
1849#endif
1850}
1851
1852int
1853do_time(str,tmbuf,gimme,arglast)
1854STR *str;
1855struct tm *tmbuf;
1856int gimme;
1857int *arglast;
1858{
1859 register ARRAY *ary = stack;
1860 STR **st = ary->ary_array;
1861 register int sp = arglast[0];
1862
1863 if (!tmbuf || gimme != G_ARRAY) {
1864 str_sset(str,&str_undef);
1865 STABSET(str);
1866 st[++sp] = str;
1867 return sp;
1868 }
1869 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec)));
1870 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min)));
1871 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour)));
1872 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday)));
1873 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon)));
1874 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year)));
1875 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday)));
1876 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday)));
1877 (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst)));
1878 return sp;
1879}
1880
1881int
1882do_kv(str,hash,kv,gimme,arglast)
1883STR *str;
1884HASH *hash;
1885int kv;
1886int gimme;
1887int *arglast;
1888{
1889 register ARRAY *ary = stack;
1890 STR **st = ary->ary_array;
1891 register int sp = arglast[0];
1892 int i;
1893 register HENT *entry;
1894 char *tmps;
1895 STR *tmpstr;
1896 int dokeys = (kv == O_KEYS || kv == O_HASH);
1897 int dovalues = (kv == O_VALUES || kv == O_HASH);
1898
1899 if (gimme != G_ARRAY) {
1900 i = 0;
1901 (void)hiterinit(hash);
1902 /*SUPPRESS 560*/
1903 while (entry = hiternext(hash)) {
1904 i++;
1905 }
1906 str_numset(str,(double)i);
1907 STABSET(str);
1908 st[++sp] = str;
1909 return sp;
1910 }
1911 (void)hiterinit(hash);
1912 /*SUPPRESS 560*/
1913 while (entry = hiternext(hash)) {
1914 if (dokeys) {
1915 tmps = hiterkey(entry,&i);
1916 if (!i)
1917 tmps = "";
1918 (void)astore(ary,++sp,str_2mortal(str_make(tmps,i)));
1919 }
1920 if (dovalues) {
1921 tmpstr = Str_new(45,0);
1922#ifdef DEBUGGING
1923 if (debug & 8192) {
1924 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1925 hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1926 str_set(tmpstr,buf);
1927 }
1928 else
1929#endif
1930 str_sset(tmpstr,hiterval(hash,entry));
1931 (void)astore(ary,++sp,str_2mortal(tmpstr));
1932 }
1933 }
1934 return sp;
1935}
1936
1937int
1938do_each(str,hash,gimme,arglast)
1939STR *str;
1940HASH *hash;
1941int gimme;
1942int *arglast;
1943{
1944 STR **st = stack->ary_array;
1945 register int sp = arglast[0];
1946 static STR *mystrk = Nullstr;
1947 HENT *entry = hiternext(hash);
1948 int i;
1949 char *tmps;
1950
1951 if (mystrk) {
1952 str_free(mystrk);
1953 mystrk = Nullstr;
1954 }
1955
1956 if (entry) {
1957 if (gimme == G_ARRAY) {
1958 tmps = hiterkey(entry, &i);
1959 if (!i)
1960 tmps = "";
1961 st[++sp] = mystrk = str_make(tmps,i);
1962 }
1963 st[++sp] = str;
1964 str_sset(str,hiterval(hash,entry));
1965 STABSET(str);
1966 return sp;
1967 }
1968 else
1969 return sp;
1970}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.