This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 5
[perl5.git] / util.c
1 /* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:00 $
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:        util.c,v $
9  * Revision 4.1  92/08/07  18:29:00  lwall
10  * 
11  * Revision 4.0.1.6  92/06/11  21:18:47  lwall
12  * patch34: boneheaded typo in my_bcopy()
13  * 
14  * Revision 4.0.1.5  92/06/08  16:08:37  lwall
15  * patch20: removed implicit int declarations on functions
16  * patch20: Perl now distinguishes overlapped copies from non-overlapped
17  * patch20: fixed confusion between a *var's real name and its effective name
18  * patch20: bcopy() and memcpy() now tested for overlap safety
19  * patch20: added Atari ST portability
20  * 
21  * Revision 4.0.1.4  91/11/11  16:48:54  lwall
22  * patch19: study was busted by 4.018
23  * patch19: added little-endian pack/unpack options
24  * 
25  * Revision 4.0.1.3  91/11/05  19:18:26  lwall
26  * patch11: safe malloc code now integrated into Perl's malloc when possible
27  * patch11: strchr("little", "longer string") could visit faraway places
28  * patch11: warn '-' x 10000 dumped core
29  * patch11: forked exec on non-existent program now issues a warning
30  * 
31  * Revision 4.0.1.2  91/06/07  12:10:42  lwall
32  * patch4: new copyright notice
33  * patch4: made some allowances for "semi-standard" C
34  * patch4: strchr() could blow up searching for null string
35  * patch4: taintchecks could improperly modify parent in vfork()
36  * patch4: exec would close files even if you cleared close-on-exec flag
37  * 
38  * Revision 4.0.1.1  91/04/12  09:19:25  lwall
39  * patch1: random cleanup in cpp namespace
40  * 
41  * Revision 4.0  91/03/20  01:56:39  lwall
42  * 4.0 baseline.
43  * 
44  */
45 /*SUPPRESS 112*/
46
47 #include "EXTERN.h"
48 #include "perl.h"
49
50 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
51 #include <signal.h>
52 #endif
53
54 #ifdef I_VFORK
55 #  include <vfork.h>
56 #endif
57
58 #ifdef I_VARARGS
59 #  include <varargs.h>
60 #endif
61
62 #ifdef I_FCNTL
63 #  include <fcntl.h>
64 #endif
65 #ifdef I_SYS_FILE
66 #  include <sys/file.h>
67 #endif
68
69 #define FLUSH
70
71 #ifndef safemalloc
72
73 /* paranoid version of malloc */
74
75 /* NOTE:  Do not call the next three routines directly.  Use the macros
76  * in handy.h, so that we can easily redefine everything to do tracking of
77  * allocated hunks back to the original New to track down any memory leaks.
78  */
79
80 char *
81 safemalloc(size)
82 #ifdef MSDOS
83 unsigned long size;
84 #else
85 MEM_SIZE size;
86 #endif /* MSDOS */
87 {
88     char *ptr;
89 #ifndef STANDARD_C
90     char *malloc();
91 #endif /* ! STANDARD_C */
92
93 #ifdef MSDOS
94         if (size > 0xffff) {
95                 fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
96                 my_exit(1);
97         }
98 #endif /* MSDOS */
99 #ifdef DEBUGGING
100     if ((long)size < 0)
101         croak("panic: malloc");
102 #endif
103     ptr = malloc(size?size:1);  /* malloc(0) is NASTY on our system */
104 #if !(defined(I286) || defined(atarist))
105     DEBUG_m(fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
106 #else
107     DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
108 #endif
109     if (ptr != Nullch)
110         return ptr;
111     else if (nomemok)
112         return Nullch;
113     else {
114         fputs(no_mem,stderr) FLUSH;
115         my_exit(1);
116     }
117     /*NOTREACHED*/
118 }
119
120 /* paranoid version of realloc */
121
122 char *
123 saferealloc(where,size)
124 char *where;
125 #ifndef MSDOS
126 MEM_SIZE size;
127 #else
128 unsigned long size;
129 #endif /* MSDOS */
130 {
131     char *ptr;
132 #ifndef STANDARD_C
133     char *realloc();
134 #endif /* ! STANDARD_C */
135
136 #ifdef MSDOS
137         if (size > 0xffff) {
138                 fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
139                 my_exit(1);
140         }
141 #endif /* MSDOS */
142     if (!where)
143         croak("Null realloc");
144 #ifdef DEBUGGING
145     if ((long)size < 0)
146         croak("panic: realloc");
147 #endif
148     ptr = realloc(where,size?size:1);   /* realloc(0) is NASTY on our system */
149
150 #if !(defined(I286) || defined(atarist))
151     DEBUG_m( {
152         fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
153         fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
154     } )
155 #else
156     DEBUG_m( {
157         fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
158         fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
159     } )
160 #endif
161
162     if (ptr != Nullch)
163         return ptr;
164     else if (nomemok)
165         return Nullch;
166     else {
167         fputs(no_mem,stderr) FLUSH;
168         my_exit(1);
169     }
170     /*NOTREACHED*/
171 }
172
173 /* safe version of free */
174
175 void
176 safefree(where)
177 char *where;
178 {
179 #if !(defined(I286) || defined(atarist))
180     DEBUG_m( fprintf(stderr,"0x%x: (%05d) free\n",where,an++));
181 #else
182     DEBUG_m( fprintf(stderr,"0x%lx: (%05d) free\n",where,an++));
183 #endif
184     if (where) {
185         /*SUPPRESS 701*/
186         free(where);
187     }
188 }
189
190 #endif /* !safemalloc */
191
192 #ifdef LEAKTEST
193
194 #define ALIGN sizeof(long)
195
196 char *
197 safexmalloc(x,size)
198 I32 x;
199 MEM_SIZE size;
200 {
201     register char *where;
202
203     where = safemalloc(size + ALIGN);
204     xcount[x]++;
205     where[0] = x % 100;
206     where[1] = x / 100;
207     return where + ALIGN;
208 }
209
210 char *
211 safexrealloc(where,size)
212 char *where;
213 MEM_SIZE size;
214 {
215     return saferealloc(where - ALIGN, size + ALIGN) + ALIGN;
216 }
217
218 void
219 safexfree(where)
220 char *where;
221 {
222     I32 x;
223
224     if (!where)
225         return;
226     where -= ALIGN;
227     x = where[0] + 100 * where[1];
228     xcount[x]--;
229     safefree(where);
230 }
231
232 static void
233 xstat()
234 {
235     register I32 i;
236
237     for (i = 0; i < MAXXCOUNT; i++) {
238         if (xcount[i] > lastxcount[i]) {
239             fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
240             lastxcount[i] = xcount[i];
241         }
242     }
243 }
244
245 #endif /* LEAKTEST */
246
247 /* copy a string up to some (non-backslashed) delimiter, if any */
248
249 char *
250 cpytill(to,from,fromend,delim,retlen)
251 register char *to;
252 register char *from;
253 register char *fromend;
254 register I32 delim;
255 I32 *retlen;
256 {
257     char *origto = to;
258
259     for (; from < fromend; from++,to++) {
260         if (*from == '\\') {
261             if (from[1] == delim)
262                 from++;
263             else if (from[1] == '\\')
264                 *to++ = *from++;
265         }
266         else if (*from == delim)
267             break;
268         *to = *from;
269     }
270     *to = '\0';
271     *retlen = to - origto;
272     return from;
273 }
274
275 /* return ptr to little string in big string, NULL if not found */
276 /* This routine was donated by Corey Satten. */
277
278 char *
279 instr(big, little)
280 register char *big;
281 register char *little;
282 {
283     register char *s, *x;
284     register I32 first;
285
286     if (!little)
287         return big;
288     first = *little++;
289     if (!first)
290         return big;
291     while (*big) {
292         if (*big++ != first)
293             continue;
294         for (x=big,s=little; *s; /**/ ) {
295             if (!*x)
296                 return Nullch;
297             if (*s++ != *x++) {
298                 s--;
299                 break;
300             }
301         }
302         if (!*s)
303             return big-1;
304     }
305     return Nullch;
306 }
307
308 /* same as instr but allow embedded nulls */
309
310 char *
311 ninstr(big, bigend, little, lend)
312 register char *big;
313 register char *bigend;
314 char *little;
315 char *lend;
316 {
317     register char *s, *x;
318     register I32 first = *little;
319     register char *littleend = lend;
320
321     if (!first && little > littleend)
322         return big;
323     if (bigend - big < littleend - little)
324         return Nullch;
325     bigend -= littleend - little++;
326     while (big <= bigend) {
327         if (*big++ != first)
328             continue;
329         for (x=big,s=little; s < littleend; /**/ ) {
330             if (*s++ != *x++) {
331                 s--;
332                 break;
333             }
334         }
335         if (s >= littleend)
336             return big-1;
337     }
338     return Nullch;
339 }
340
341 /* reverse of the above--find last substring */
342
343 char *
344 rninstr(big, bigend, little, lend)
345 register char *big;
346 char *bigend;
347 char *little;
348 char *lend;
349 {
350     register char *bigbeg;
351     register char *s, *x;
352     register I32 first = *little;
353     register char *littleend = lend;
354
355     if (!first && little > littleend)
356         return bigend;
357     bigbeg = big;
358     big = bigend - (littleend - little++);
359     while (big >= bigbeg) {
360         if (*big-- != first)
361             continue;
362         for (x=big+2,s=little; s < littleend; /**/ ) {
363             if (*s++ != *x++) {
364                 s--;
365                 break;
366             }
367         }
368         if (s >= littleend)
369             return big+1;
370     }
371     return Nullch;
372 }
373
374 void
375 fbm_compile(sv, iflag)
376 SV *sv;
377 I32 iflag;
378 {
379     register unsigned char *s;
380     register unsigned char *table;
381     register U32 i;
382     register U32 len = SvCUR(sv);
383     I32 rarest = 0;
384     U32 frequency = 256;
385
386     Sv_Grow(sv,len+258);
387     table = (unsigned char*)(SvPVX(sv) + len + 1);
388     s = table - 2;
389     for (i = 0; i < 256; i++) {
390         table[i] = len;
391     }
392     i = 0;
393     while (s >= (unsigned char*)(SvPVX(sv)))
394     {
395         if (table[*s] == len) {
396 #ifndef pdp11
397             if (iflag)
398                 table[*s] = table[fold[*s]] = i;
399 #else
400             if (iflag) {
401                 I32 j;
402                 j = fold[*s];
403                 table[j] = i;
404                 table[*s] = i;
405             }
406 #endif /* pdp11 */
407             else
408                 table[*s] = i;
409         }
410         s--,i++;
411     }
412     sv_upgrade(sv, SVt_PVBM);
413     sv_magic(sv, 0, 'B', 0, 0);                 /* deep magic */
414     SvVALID_on(sv);
415
416     s = (unsigned char*)(SvPVX(sv));            /* deeper magic */
417     if (iflag) {
418         register U32 tmp, foldtmp;
419         SvCASEFOLD_on(sv);
420         for (i = 0; i < len; i++) {
421             tmp=freq[s[i]];
422             foldtmp=freq[fold[s[i]]];
423             if (tmp < frequency && foldtmp < frequency) {
424                 rarest = i;
425                 /* choose most frequent among the two */
426                 frequency = (tmp > foldtmp) ? tmp : foldtmp;
427             }
428         }
429     }
430     else {
431         for (i = 0; i < len; i++) {
432             if (freq[s[i]] < frequency) {
433                 rarest = i;
434                 frequency = freq[s[i]];
435             }
436         }
437     }
438     BmRARE(sv) = s[rarest];
439     BmPREVIOUS(sv) = rarest;
440     DEBUG_r(fprintf(stderr,"rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
441 }
442
443 char *
444 fbm_instr(big, bigend, littlestr)
445 unsigned char *big;
446 register unsigned char *bigend;
447 SV *littlestr;
448 {
449     register unsigned char *s;
450     register I32 tmp;
451     register I32 littlelen;
452     register unsigned char *little;
453     register unsigned char *table;
454     register unsigned char *olds;
455     register unsigned char *oldlittle;
456
457     if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
458         if (!SvPOK(littlestr) || !SvPVX(littlestr))
459             return (char*)big;
460         return ninstr((char*)big,(char*)bigend,
461                 SvPVX(littlestr), SvPVX(littlestr) + SvCUR(littlestr));
462     }
463
464     littlelen = SvCUR(littlestr);
465     if (SvTAIL(littlestr) && !multiline) {      /* tail anchored? */
466         if (littlelen > bigend - big)
467             return Nullch;
468         little = (unsigned char*)SvPVX(littlestr);
469         if (SvCASEFOLD(littlestr)) {    /* oops, fake it */
470             big = bigend - littlelen;           /* just start near end */
471             if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
472                 big--;
473         }
474         else {
475             s = bigend - littlelen;
476             if (*s == *little && bcmp(s,little,littlelen)==0)
477                 return (char*)s;                /* how sweet it is */
478             else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
479               && s > big) {
480                     s--;
481                 if (*s == *little && bcmp(s,little,littlelen)==0)
482                     return (char*)s;
483             }
484             return Nullch;
485         }
486     }
487     table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1);
488     if (--littlelen >= bigend - big)
489         return Nullch;
490     s = big + littlelen;
491     oldlittle = little = table - 2;
492     if (SvCASEFOLD(littlestr)) {        /* case insensitive? */
493         if (s < bigend) {
494           top1:
495             /*SUPPRESS 560*/
496             if (tmp = table[*s]) {
497 #ifdef POINTERRIGOR
498                 if (bigend - s > tmp) {
499                     s += tmp;
500                     goto top1;
501                 }
502 #else
503                 if ((s += tmp) < bigend)
504                     goto top1;
505 #endif
506                 return Nullch;
507             }
508             else {
509                 tmp = littlelen;        /* less expensive than calling strncmp() */
510                 olds = s;
511                 while (tmp--) {
512                     if (*--s == *--little || fold[*s] == *little)
513                         continue;
514                     s = olds + 1;       /* here we pay the price for failure */
515                     little = oldlittle;
516                     if (s < bigend)     /* fake up continue to outer loop */
517                         goto top1;
518                     return Nullch;
519                 }
520                 return (char *)s;
521             }
522         }
523     }
524     else {
525         if (s < bigend) {
526           top2:
527             /*SUPPRESS 560*/
528             if (tmp = table[*s]) {
529 #ifdef POINTERRIGOR
530                 if (bigend - s > tmp) {
531                     s += tmp;
532                     goto top2;
533                 }
534 #else
535                 if ((s += tmp) < bigend)
536                     goto top2;
537 #endif
538                 return Nullch;
539             }
540             else {
541                 tmp = littlelen;        /* less expensive than calling strncmp() */
542                 olds = s;
543                 while (tmp--) {
544                     if (*--s == *--little)
545                         continue;
546                     s = olds + 1;       /* here we pay the price for failure */
547                     little = oldlittle;
548                     if (s < bigend)     /* fake up continue to outer loop */
549                         goto top2;
550                     return Nullch;
551                 }
552                 return (char *)s;
553             }
554         }
555     }
556     return Nullch;
557 }
558
559 char *
560 screaminstr(bigstr, littlestr)
561 SV *bigstr;
562 SV *littlestr;
563 {
564     register unsigned char *s, *x;
565     register unsigned char *big;
566     register I32 pos;
567     register I32 previous;
568     register I32 first;
569     register unsigned char *little;
570     register unsigned char *bigend;
571     register unsigned char *littleend;
572
573     if ((pos = screamfirst[BmRARE(littlestr)]) < 0) 
574         return Nullch;
575     little = (unsigned char *)(SvPVX(littlestr));
576     littleend = little + SvCUR(littlestr);
577     first = *little++;
578     previous = BmPREVIOUS(littlestr);
579     big = (unsigned char *)(SvPVX(bigstr));
580     bigend = big + SvCUR(bigstr);
581     while (pos < previous) {
582         if (!(pos += screamnext[pos]))
583             return Nullch;
584     }
585 #ifdef POINTERRIGOR
586     if (SvCASEFOLD(littlestr)) {        /* case insignificant? */
587         do {
588             if (big[pos-previous] != first && big[pos-previous] != fold[first])
589                 continue;
590             for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
591                 if (x >= bigend)
592                     return Nullch;
593                 if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
594                     s--;
595                     break;
596                 }
597             }
598             if (s == littleend)
599                 return (char *)(big+pos-previous);
600         } while (
601                 pos += screamnext[pos]  /* does this goof up anywhere? */
602             );
603     }
604     else {
605         do {
606             if (big[pos-previous] != first)
607                 continue;
608             for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
609                 if (x >= bigend)
610                     return Nullch;
611                 if (*s++ != *x++) {
612                     s--;
613                     break;
614                 }
615             }
616             if (s == littleend)
617                 return (char *)(big+pos-previous);
618         } while ( pos += screamnext[pos] );
619     }
620 #else /* !POINTERRIGOR */
621     big -= previous;
622     if (SvCASEFOLD(littlestr)) {        /* case insignificant? */
623         do {
624             if (big[pos] != first && big[pos] != fold[first])
625                 continue;
626             for (x=big+pos+1,s=little; s < littleend; /**/ ) {
627                 if (x >= bigend)
628                     return Nullch;
629                 if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
630                     s--;
631                     break;
632                 }
633             }
634             if (s == littleend)
635                 return (char *)(big+pos);
636         } while (
637                 pos += screamnext[pos]  /* does this goof up anywhere? */
638             );
639     }
640     else {
641         do {
642             if (big[pos] != first)
643                 continue;
644             for (x=big+pos+1,s=little; s < littleend; /**/ ) {
645                 if (x >= bigend)
646                     return Nullch;
647                 if (*s++ != *x++) {
648                     s--;
649                     break;
650                 }
651             }
652             if (s == littleend)
653                 return (char *)(big+pos);
654         } while (
655                 pos += screamnext[pos]
656             );
657     }
658 #endif /* POINTERRIGOR */
659     return Nullch;
660 }
661
662 I32
663 ibcmp(a,b,len)
664 register char *a;
665 register char *b;
666 register I32 len;
667 {
668     while (len--) {
669         if (*a == *b) {
670             a++,b++;
671             continue;
672         }
673         if (fold[*a++] == *b++)
674             continue;
675         return 1;
676     }
677     return 0;
678 }
679
680 /* copy a string to a safe spot */
681
682 char *
683 savestr(sv)
684 char *sv;
685 {
686     register char *newaddr;
687
688     New(902,newaddr,strlen(sv)+1,char);
689     (void)strcpy(newaddr,sv);
690     return newaddr;
691 }
692
693 /* same thing but with a known length */
694
695 char *
696 nsavestr(sv, len)
697 char *sv;
698 register I32 len;
699 {
700     register char *newaddr;
701
702     New(903,newaddr,len+1,char);
703     Copy(sv,newaddr,len,char);          /* might not be null terminated */
704     newaddr[len] = '\0';                /* is now */
705     return newaddr;
706 }
707
708 /* grow a static string to at least a certain length */
709
710 void
711 pv_grow(strptr,curlen,newlen)
712 char **strptr;
713 I32 *curlen;
714 I32 newlen;
715 {
716     if (newlen > *curlen) {             /* need more room? */
717         if (*curlen)
718             Renew(*strptr,newlen,char);
719         else
720             New(905,*strptr,newlen,char);
721         *curlen = newlen;
722     }
723 }
724
725 #ifndef I_VARARGS
726 /*VARARGS1*/
727 char *
728 mess(pat,a1,a2,a3,a4)
729 char *pat;
730 long a1, a2, a3, a4;
731 {
732     char *s;
733     I32 usermess = strEQ(pat,"%s");
734     SV *tmpstr;
735
736     s = buf;
737     if (usermess) {
738         tmpstr = sv_mortalcopy(&sv_undef);
739         sv_setpv(tmpstr, (char*)a1);
740         *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
741     }
742     else {
743         (void)sprintf(s,pat,a1,a2,a3,a4);
744         s += strlen(s);
745     }
746
747     if (s[-1] != '\n') {
748         if (curcop->cop_line) {
749             (void)sprintf(s," at %s line %ld",
750               SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
751             s += strlen(s);
752         }
753         if (last_in_gv &&
754             GvIO(last_in_gv) &&
755             GvIO(last_in_gv)->lines ) {
756             (void)sprintf(s,", <%s> %s %ld",
757               last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
758               strEQ(rs,"\n") ? "line" : "chunk", 
759               (long)GvIO(last_in_gv)->lines);
760             s += strlen(s);
761         }
762         (void)strcpy(s,".\n");
763         if (usermess)
764             sv_catpv(tmpstr,buf+1);
765     }
766     if (usermess)
767         return SvPVX(tmpstr);
768     else
769         return buf;
770 }
771
772 /*VARARGS1*/
773 void croak(pat,a1,a2,a3,a4)
774 char *pat;
775 long a1, a2, a3, a4;
776 {
777     char *tmps;
778     char *message;
779
780     message = mess(pat,a1,a2,a3,a4);
781     fputs(message,stderr);
782     (void)fflush(stderr);
783     if (e_fp)
784         (void)UNLINK(e_tmpname);
785     statusvalue >>= 8;
786     my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
787 }
788
789 /*VARARGS1*/
790 void warn(pat,a1,a2,a3,a4)
791 char *pat;
792 long a1, a2, a3, a4;
793 {
794     char *message;
795
796     message = mess(pat,a1,a2,a3,a4);
797     fputs(message,stderr);
798 #ifdef LEAKTEST
799     DEBUG_L(xstat());
800 #endif
801     (void)fflush(stderr);
802 }
803 #else
804 /*VARARGS0*/
805 char *
806 mess(args)
807 va_list args;
808 {
809     char *pat;
810     char *s;
811     SV *tmpstr;
812     I32 usermess;
813 #ifndef HAS_VPRINTF
814 #ifdef CHARVSPRINTF
815     char *vsprintf();
816 #else
817     I32 vsprintf();
818 #endif
819 #endif
820
821     pat = va_arg(args, char *);
822     s = buf;
823     usermess = strEQ(pat, "%s");
824     if (usermess) {
825         tmpstr = sv_mortalcopy(&sv_undef);
826         sv_setpv(tmpstr, va_arg(args, char *));
827         *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
828     }
829     else {
830         (void) vsprintf(s,pat,args);
831         s += strlen(s);
832     }
833
834     if (s[-1] != '\n') {
835         if (curcop->cop_line) {
836             (void)sprintf(s," at %s line %ld",
837               SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
838             s += strlen(s);
839         }
840         if (last_in_gv &&
841             GvIO(last_in_gv) &&
842             GvIO(last_in_gv)->lines ) {
843             (void)sprintf(s,", <%s> %s %ld",
844               last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
845               strEQ(rs,"\n") ? "line" : "chunk", 
846               (long)GvIO(last_in_gv)->lines);
847             s += strlen(s);
848         }
849         (void)strcpy(s,".\n");
850         if (usermess)
851             sv_catpv(tmpstr,buf+1);
852     }
853
854     if (usermess)
855         return SvPVX(tmpstr);
856     else
857         return buf;
858 }
859
860 /*VARARGS0*/
861 void
862 #ifdef __STDC__
863 croak(char* pat,...)
864 #else
865 croak(va_alist)
866 va_dcl
867 #endif
868 {
869     va_list args;
870     char *tmps;
871     char *message;
872
873     va_start(args);
874     message = mess(args);
875     va_end(args);
876     if (restartop = die_where(message))
877         longjmp(top_env, 3);
878     fputs(message,stderr);
879     (void)fflush(stderr);
880     if (e_fp)
881         (void)UNLINK(e_tmpname);
882     statusvalue >>= 8;
883     my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
884 }
885
886 /*VARARGS0*/
887 #ifdef __STDC__
888 void warn(char* pat,...)
889 #else
890 void warn(va_alist)
891 va_dcl
892 #endif
893 {
894     va_list args;
895     char *message;
896
897     va_start(args);
898     message = mess(args);
899     va_end(args);
900
901     fputs(message,stderr);
902 #ifdef LEAKTEST
903     DEBUG_L(xstat());
904 #endif
905     (void)fflush(stderr);
906 }
907 #endif
908
909 void
910 my_setenv(nam,val)
911 char *nam, *val;
912 {
913     register I32 i=setenv_getix(nam);           /* where does it go? */
914
915     if (environ == origenviron) {       /* need we copy environment? */
916         I32 j;
917         I32 max;
918         char **tmpenv;
919
920         /*SUPPRESS 530*/
921         for (max = i; environ[max]; max++) ;
922         New(901,tmpenv, max+2, char*);
923         for (j=0; j<max; j++)           /* copy environment */
924             tmpenv[j] = savestr(environ[j]);
925         tmpenv[max] = Nullch;
926         environ = tmpenv;               /* tell exec where it is now */
927     }
928     if (!val) {
929         while (environ[i]) {
930             environ[i] = environ[i+1];
931             i++;
932         }
933         return;
934     }
935     if (!environ[i]) {                  /* does not exist yet */
936         Renew(environ, i+2, char*);     /* just expand it a bit */
937         environ[i+1] = Nullch;  /* make sure it's null terminated */
938     }
939     else
940         Safefree(environ[i]);
941     New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
942 #ifndef MSDOS
943     (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
944 #else
945     /* MS-DOS requires environment variable names to be in uppercase */
946     /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
947      * some utilities and applications may break because they only look
948      * for upper case strings. (Fixed strupr() bug here.)]
949      */
950     strcpy(environ[i],nam); strupr(environ[i]);
951     (void)sprintf(environ[i] + strlen(nam),"=%s",val);
952 #endif /* MSDOS */
953 }
954
955 I32
956 setenv_getix(nam)
957 char *nam;
958 {
959     register I32 i, len = strlen(nam);
960
961     for (i = 0; environ[i]; i++) {
962         if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
963             break;                      /* strnEQ must come first to avoid */
964     }                                   /* potential SEGV's */
965     return i;
966 }
967
968 #ifdef EUNICE
969 I32
970 unlnk(f)        /* unlink all versions of a file */
971 char *f;
972 {
973     I32 i;
974
975     for (i = 0; unlink(f) >= 0; i++) ;
976     return i ? 0 : -1;
977 }
978 #endif
979
980 #if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
981 char *
982 my_bcopy(from,to,len)
983 register char *from;
984 register char *to;
985 register I32 len;
986 {
987     char *retval = to;
988
989     if (from - to >= 0) {
990         while (len--)
991             *to++ = *from++;
992     }
993     else {
994         to += len;
995         from += len;
996         while (len--)
997             *(--to) = *(--from);
998     }
999     return retval;
1000 }
1001 #endif
1002
1003 #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
1004 char *
1005 my_bzero(loc,len)
1006 register char *loc;
1007 register I32 len;
1008 {
1009     char *retval = loc;
1010
1011     while (len--)
1012         *loc++ = 0;
1013     return retval;
1014 }
1015 #endif
1016
1017 #ifndef HAS_MEMCMP
1018 I32
1019 my_memcmp(s1,s2,len)
1020 register unsigned char *s1;
1021 register unsigned char *s2;
1022 register I32 len;
1023 {
1024     register I32 tmp;
1025
1026     while (len--) {
1027         if (tmp = *s1++ - *s2++)
1028             return tmp;
1029     }
1030     return 0;
1031 }
1032 #endif /* HAS_MEMCMP */
1033
1034 #ifdef I_VARARGS
1035 #ifndef HAS_VPRINTF
1036
1037 #ifdef CHARVSPRINTF
1038 char *
1039 #else
1040 int
1041 #endif
1042 vsprintf(dest, pat, args)
1043 char *dest, *pat, *args;
1044 {
1045     FILE fakebuf;
1046
1047     fakebuf._ptr = dest;
1048     fakebuf._cnt = 32767;
1049 #ifndef _IOSTRG
1050 #define _IOSTRG 0
1051 #endif
1052     fakebuf._flag = _IOWRT|_IOSTRG;
1053     _doprnt(pat, args, &fakebuf);       /* what a kludge */
1054     (void)putc('\0', &fakebuf);
1055 #ifdef CHARVSPRINTF
1056     return(dest);
1057 #else
1058     return 0;           /* perl doesn't use return value */
1059 #endif
1060 }
1061
1062 int
1063 vfprintf(fd, pat, args)
1064 FILE *fd;
1065 char *pat, *args;
1066 {
1067     _doprnt(pat, args, fd);
1068     return 0;           /* wrong, but perl doesn't use the return value */
1069 }
1070 #endif /* HAS_VPRINTF */
1071 #endif /* I_VARARGS */
1072
1073 /*
1074  * I think my_swap(), htonl() and ntohl() have never been used.
1075  * perl.h contains last-chance references to my_swap(), my_htonl()
1076  * and my_ntohl().  I presume these are the intended functions;
1077  * but htonl() and ntohl() have the wrong names.  There are no
1078  * functions my_htonl() and my_ntohl() defined anywhere.
1079  * -DWS
1080  */
1081 #ifdef MYSWAP
1082 #if BYTEORDER != 0x4321
1083 short
1084 my_swap(s)
1085 short s;
1086 {
1087 #if (BYTEORDER & 1) == 0
1088     short result;
1089
1090     result = ((s & 255) << 8) + ((s >> 8) & 255);
1091     return result;
1092 #else
1093     return s;
1094 #endif
1095 }
1096
1097 long
1098 htonl(l)
1099 register long l;
1100 {
1101     union {
1102         long result;
1103         char c[sizeof(long)];
1104     } u;
1105
1106 #if BYTEORDER == 0x1234
1107     u.c[0] = (l >> 24) & 255;
1108     u.c[1] = (l >> 16) & 255;
1109     u.c[2] = (l >> 8) & 255;
1110     u.c[3] = l & 255;
1111     return u.result;
1112 #else
1113 #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
1114     croak("Unknown BYTEORDER\n");
1115 #else
1116     register I32 o;
1117     register I32 s;
1118
1119     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1120         u.c[o & 0xf] = (l >> s) & 255;
1121     }
1122     return u.result;
1123 #endif
1124 #endif
1125 }
1126
1127 long
1128 ntohl(l)
1129 register long l;
1130 {
1131     union {
1132         long l;
1133         char c[sizeof(long)];
1134     } u;
1135
1136 #if BYTEORDER == 0x1234
1137     u.c[0] = (l >> 24) & 255;
1138     u.c[1] = (l >> 16) & 255;
1139     u.c[2] = (l >> 8) & 255;
1140     u.c[3] = l & 255;
1141     return u.l;
1142 #else
1143 #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
1144     croak("Unknown BYTEORDER\n");
1145 #else
1146     register I32 o;
1147     register I32 s;
1148
1149     u.l = l;
1150     l = 0;
1151     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1152         l |= (u.c[o & 0xf] & 255) << s;
1153     }
1154     return l;
1155 #endif
1156 #endif
1157 }
1158
1159 #endif /* BYTEORDER != 0x4321 */
1160 #endif /* MYSWAP */
1161
1162 /*
1163  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
1164  * If these functions are defined,
1165  * the BYTEORDER is neither 0x1234 nor 0x4321.
1166  * However, this is not assumed.
1167  * -DWS
1168  */
1169
1170 #define HTOV(name,type)                                         \
1171         type                                                    \
1172         name (n)                                                \
1173         register type n;                                        \
1174         {                                                       \
1175             union {                                             \
1176                 type value;                                     \
1177                 char c[sizeof(type)];                           \
1178             } u;                                                \
1179             register I32 i;                                     \
1180             register I32 s;                                     \
1181             for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
1182                 u.c[i] = (n >> s) & 0xFF;                       \
1183             }                                                   \
1184             return u.value;                                     \
1185         }
1186
1187 #define VTOH(name,type)                                         \
1188         type                                                    \
1189         name (n)                                                \
1190         register type n;                                        \
1191         {                                                       \
1192             union {                                             \
1193                 type value;                                     \
1194                 char c[sizeof(type)];                           \
1195             } u;                                                \
1196             register I32 i;                                     \
1197             register I32 s;                                     \
1198             u.value = n;                                        \
1199             n = 0;                                              \
1200             for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
1201                 n += (u.c[i] & 0xFF) << s;                      \
1202             }                                                   \
1203             return n;                                           \
1204         }
1205
1206 #if defined(HAS_HTOVS) && !defined(htovs)
1207 HTOV(htovs,short)
1208 #endif
1209 #if defined(HAS_HTOVL) && !defined(htovl)
1210 HTOV(htovl,long)
1211 #endif
1212 #if defined(HAS_VTOHS) && !defined(vtohs)
1213 VTOH(vtohs,short)
1214 #endif
1215 #if defined(HAS_VTOHL) && !defined(vtohl)
1216 VTOH(vtohl,long)
1217 #endif
1218
1219 #ifndef DOSISH
1220 FILE *
1221 my_popen(cmd,mode)
1222 char    *cmd;
1223 char    *mode;
1224 {
1225     int p[2];
1226     register I32 this, that;
1227     register I32 pid;
1228     SV *sv;
1229     I32 doexec = strNE(cmd,"-");
1230
1231     if (pipe(p) < 0)
1232         return Nullfp;
1233     this = (*mode == 'w');
1234     that = !this;
1235     if (tainting) {
1236         if (doexec) {
1237             taint_env();
1238             taint_proper("Insecure %s%s", "EXEC");
1239         }
1240     }
1241     while ((pid = (doexec?vfork():fork())) < 0) {
1242         if (errno != EAGAIN) {
1243             close(p[this]);
1244             if (!doexec)
1245                 croak("Can't fork");
1246             return Nullfp;
1247         }
1248         sleep(5);
1249     }
1250     if (pid == 0) {
1251         GV* tmpgv;
1252
1253 #define THIS that
1254 #define THAT this
1255         close(p[THAT]);
1256         if (p[THIS] != (*mode == 'r')) {
1257             dup2(p[THIS], *mode == 'r');
1258             close(p[THIS]);
1259         }
1260         if (doexec) {
1261 #if !defined(HAS_FCNTL) || !defined(FFt_SETFD)
1262             int fd;
1263
1264 #ifndef NOFILE
1265 #define NOFILE 20
1266 #endif
1267             for (fd = maxsysfd + 1; fd < NOFILE; fd++)
1268                 close(fd);
1269 #endif
1270             do_exec(cmd);       /* may or may not use the shell */
1271             warn("Can't exec \"%s\": %s", cmd, strerror(errno));
1272             _exit(1);
1273         }
1274         /*SUPPRESS 560*/
1275         if (tmpgv = gv_fetchpv("$",TRUE))
1276             sv_setiv(GvSV(tmpgv),(I32)getpid());
1277         forkprocess = 0;
1278         hv_clear(pidstatus);    /* we have no children */
1279         return Nullfp;
1280 #undef THIS
1281 #undef THAT
1282     }
1283     do_execfree();      /* free any memory malloced by child on vfork */
1284     close(p[that]);
1285     if (p[that] < p[this]) {
1286         dup2(p[this], p[that]);
1287         close(p[this]);
1288         p[this] = p[that];
1289     }
1290     sv = *av_fetch(fdpid,p[this],TRUE);
1291     SvUPGRADE(sv,SVt_IV);
1292     SvIVX(sv) = pid;
1293     forkprocess = pid;
1294     return fdopen(p[this], mode);
1295 }
1296 #else
1297 #ifdef atarist
1298 FILE *popen();
1299 FILE *
1300 my_popen(cmd,mode)
1301 char    *cmd;
1302 char    *mode;
1303 {
1304     return popen(cmd, mode);
1305 }
1306 #endif
1307
1308 #endif /* !DOSISH */
1309
1310 #ifdef NOTDEF
1311 dump_fds(s)
1312 char *s;
1313 {
1314     int fd;
1315     struct stat tmpstatbuf;
1316
1317     fprintf(stderr,"%s", s);
1318     for (fd = 0; fd < 32; fd++) {
1319         if (fstat(fd,&tmpstatbuf) >= 0)
1320             fprintf(stderr," %d",fd);
1321     }
1322     fprintf(stderr,"\n");
1323 }
1324 #endif
1325
1326 #ifndef HAS_DUP2
1327 dup2(oldfd,newfd)
1328 int oldfd;
1329 int newfd;
1330 {
1331 #if defined(HAS_FCNTL) && defined(FFt_DUPFD)
1332     close(newfd);
1333     fcntl(oldfd, FFt_DUPFD, newfd);
1334 #else
1335     int fdtmp[256];
1336     I32 fdx = 0;
1337     int fd;
1338
1339     if (oldfd == newfd)
1340         return 0;
1341     close(newfd);
1342     while ((fd = dup(oldfd)) != newfd)  /* good enough for low fd's */
1343         fdtmp[fdx++] = fd;
1344     while (fdx > 0)
1345         close(fdtmp[--fdx]);
1346 #endif
1347 }
1348 #endif
1349
1350 #ifndef DOSISH
1351 I32
1352 my_pclose(ptr)
1353 FILE *ptr;
1354 {
1355 #ifdef VOIDSIG
1356     void (*hstat)(), (*istat)(), (*qstat)();
1357 #else
1358     int (*hstat)(), (*istat)(), (*qstat)();
1359 #endif
1360     int status;
1361     SV *sv;
1362     int pid;
1363
1364     sv = *av_fetch(fdpid,fileno(ptr),TRUE);
1365     pid = SvIVX(sv);
1366     av_store(fdpid,fileno(ptr),Nullsv);
1367     fclose(ptr);
1368 #ifdef UTS
1369     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
1370 #endif
1371     hstat = signal(SIGHUP, SIG_IGN);
1372     istat = signal(SIGINT, SIG_IGN);
1373     qstat = signal(SIGQUIT, SIG_IGN);
1374     pid = wait4pid(pid, &status, 0);
1375     signal(SIGHUP, hstat);
1376     signal(SIGINT, istat);
1377     signal(SIGQUIT, qstat);
1378     return(pid < 0 ? pid : status);
1379 }
1380
1381 I32
1382 wait4pid(pid,statusp,flags)
1383 int pid;
1384 int *statusp;
1385 int flags;
1386 {
1387     I32 result;
1388     SV *sv;
1389     SV** svp;
1390     char spid[16];
1391
1392     if (!pid)
1393         return -1;
1394     if (pid > 0) {
1395         sprintf(spid, "%d", pid);
1396         svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
1397         if (svp && *svp != &sv_undef) {
1398             *statusp = SvIVX(*svp);
1399             hv_delete(pidstatus,spid,strlen(spid));
1400             return pid;
1401         }
1402     }
1403     else {
1404         HE *entry;
1405
1406         hv_iterinit(pidstatus);
1407         if (entry = hv_iternext(pidstatus)) {
1408             pid = atoi(hv_iterkey(entry,statusp));
1409             sv = hv_iterval(pidstatus,entry);
1410             *statusp = SvIVX(sv);
1411             sprintf(spid, "%d", pid);
1412             hv_delete(pidstatus,spid,strlen(spid));
1413             return pid;
1414         }
1415     }
1416 #ifdef HAS_WAIT4
1417     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
1418 #else
1419 #ifdef HAS_WAITPID
1420     return waitpid(pid,statusp,flags);
1421 #else
1422     if (flags)
1423         croak("Can't do waitpid with flags");
1424     else {
1425         while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
1426             pidgone(result,*statusp);
1427         if (result < 0)
1428             *statusp = -1;
1429     }
1430     return result;
1431 #endif
1432 #endif
1433 }
1434 #endif /* !DOSISH */
1435
1436 void
1437 /*SUPPRESS 590*/
1438 pidgone(pid,status)
1439 int pid;
1440 int status;
1441 {
1442     register SV *sv;
1443     char spid[16];
1444
1445     sprintf(spid, "%d", pid);
1446     sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
1447     SvUPGRADE(sv,SVt_IV);
1448     SvIVX(sv) = status;
1449     return;
1450 }
1451
1452 #ifdef atarist
1453 int pclose();
1454 I32
1455 my_pclose(ptr)
1456 FILE *ptr;
1457 {
1458     return pclose(ptr);
1459 }
1460 #endif
1461
1462 void
1463 repeatcpy(to,from,len,count)
1464 register char *to;
1465 register char *from;
1466 I32 len;
1467 register I32 count;
1468 {
1469     register I32 todo;
1470     register char *frombase = from;
1471
1472     if (len == 1) {
1473         todo = *from;
1474         while (count-- > 0)
1475             *to++ = todo;
1476         return;
1477     }
1478     while (count-- > 0) {
1479         for (todo = len; todo > 0; todo--) {
1480             *to++ = *from++;
1481         }
1482         from = frombase;
1483     }
1484 }
1485
1486 #ifndef CASTNEGFLOAT
1487 U32
1488 cast_ulong(f)
1489 double f;
1490 {
1491     long along;
1492
1493 #if CASTFLAGS & 2
1494 #   define BIGDOUBLE 2147483648.0
1495     if (f >= BIGDOUBLE)
1496         return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
1497 #endif
1498     if (f >= 0.0)
1499         return (unsigned long)f;
1500     along = (long)f;
1501     return (unsigned long)along;
1502 }
1503 # undef BIGDOUBLE
1504 #endif
1505
1506 #ifndef CASTI32
1507 I32
1508 cast_i32(f)
1509 double f;
1510 {
1511 #   define BIGDOUBLE 2147483648.0        /* Assume 32 bit int's ! */
1512 #   define BIGNEGDOUBLE (-2147483648.0)
1513     if (f >= BIGDOUBLE)
1514         return (I32)fmod(f, BIGDOUBLE);
1515     if (f <= BIGNEGDOUBLE)
1516         return (I32)fmod(f, BIGNEGDOUBLE);
1517     return (I32) f;
1518 }
1519 # undef BIGDOUBLE
1520 # undef BIGNEGDOUBLE
1521 #endif
1522
1523 #ifndef HAS_RENAME
1524 I32
1525 same_dirent(a,b)
1526 char *a;
1527 char *b;
1528 {
1529     char *fa = strrchr(a,'/');
1530     char *fb = strrchr(b,'/');
1531     struct stat tmpstatbuf1;
1532     struct stat tmpstatbuf2;
1533 #ifndef MAXPATHLEN
1534 #define MAXPATHLEN 1024
1535 #endif
1536     char tmpbuf[MAXPATHLEN+1];
1537
1538     if (fa)
1539         fa++;
1540     else
1541         fa = a;
1542     if (fb)
1543         fb++;
1544     else
1545         fb = b;
1546     if (strNE(a,b))
1547         return FALSE;
1548     if (fa == a)
1549         strcpy(tmpbuf,".");
1550     else
1551         strncpy(tmpbuf, a, fa - a);
1552     if (stat(tmpbuf, &tmpstatbuf1) < 0)
1553         return FALSE;
1554     if (fb == b)
1555         strcpy(tmpbuf,".");
1556     else
1557         strncpy(tmpbuf, b, fb - b);
1558     if (stat(tmpbuf, &tmpstatbuf2) < 0)
1559         return FALSE;
1560     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
1561            tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
1562 }
1563 #endif /* !HAS_RENAME */
1564
1565 unsigned long
1566 scan_oct(start, len, retlen)
1567 char *start;
1568 I32 len;
1569 I32 *retlen;
1570 {
1571     register char *s = start;
1572     register unsigned long retval = 0;
1573
1574     while (len-- && *s >= '0' && *s <= '7') {
1575         retval <<= 3;
1576         retval |= *s++ - '0';
1577     }
1578     *retlen = s - start;
1579     return retval;
1580 }
1581
1582 unsigned long
1583 scan_hex(start, len, retlen)
1584 char *start;
1585 I32 len;
1586 I32 *retlen;
1587 {
1588     register char *s = start;
1589     register unsigned long retval = 0;
1590     char *tmp;
1591
1592     while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
1593         retval <<= 4;
1594         retval |= (tmp - hexdigit) & 15;
1595         s++;
1596     }
1597     *retlen = s - start;
1598     return retval;
1599 }