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