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