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
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)
463ee0b2 101 croak("panic: malloc");
34de22dd 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 142 if (!where)
463ee0b2 143 croak("Null realloc");
34de22dd
LW
144#ifdef DEBUGGING
145 if ((long)size < 0)
463ee0b2 146 croak("panic: realloc");
34de22dd 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);
463ee0b2 387 table = (unsigned char*)(SvPVX(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;
463ee0b2 393 while (s >= (unsigned char*)(SvPVX(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
463ee0b2 416 s = (unsigned char*)(SvPVX(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 457 if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
463ee0b2 458 if (!SvPOK(littlestr) || !SvPVX(littlestr))
d48672a2 459 return (char*)big;
9f68db38 460 return ninstr((char*)big,(char*)bigend,
463ee0b2 461 SvPVX(littlestr), SvPVX(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;
463ee0b2 468 little = (unsigned char*)SvPVX(littlestr);
79072805 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 }
463ee0b2 487 table = (unsigned char*)(SvPVX(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;
463ee0b2 575 little = (unsigned char *)(SvPVX(littlestr));
79072805 576 littleend = little + SvCUR(littlestr);
378cc40b 577 first = *little++;
79072805 578 previous = BmPREVIOUS(littlestr);
463ee0b2 579 big = (unsigned char *)(SvPVX(bigstr));
79072805 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);
463ee0b2 740 *s++ = SvPVX(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",
463ee0b2 750 SvPVX(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)
463ee0b2 767 return SvPVX(tmpstr);
de3bb511
LW
768 else
769 return buf;
378cc40b
LW
770}
771
8d063cd8 772/*VARARGS1*/
463ee0b2 773void croak(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);
de3bb511 781 fputs(message,stderr);
a687059c 782 (void)fflush(stderr);
8d063cd8 783 if (e_fp)
a687059c 784 (void)UNLINK(e_tmpname);
378cc40b 785 statusvalue >>= 8;
79072805 786 my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
378cc40b
LW
787}
788
789/*VARARGS1*/
7c0587c8 790void warn(pat,a1,a2,a3,a4)
378cc40b 791char *pat;
a687059c 792long a1, a2, a3, a4;
378cc40b 793{
de3bb511
LW
794 char *message;
795
796 message = mess(pat,a1,a2,a3,a4);
797 fputs(message,stderr);
a687059c 798#ifdef LEAKTEST
79072805 799 DEBUG_L(xstat());
a687059c
LW
800#endif
801 (void)fflush(stderr);
8d063cd8 802}
a687059c
LW
803#else
804/*VARARGS0*/
de3bb511 805char *
a687059c
LW
806mess(args)
807va_list args;
808{
809 char *pat;
810 char *s;
79072805
LW
811 SV *tmpstr;
812 I32 usermess;
d48672a2 813#ifndef HAS_VPRINTF
a687059c
LW
814#ifdef CHARVSPRINTF
815 char *vsprintf();
816#else
79072805 817 I32 vsprintf();
a687059c 818#endif
d48672a2 819#endif
a687059c 820
a687059c 821 pat = va_arg(args, char *);
de3bb511
LW
822 s = buf;
823 usermess = strEQ(pat, "%s");
824 if (usermess) {
79072805
LW
825 tmpstr = sv_mortalcopy(&sv_undef);
826 sv_setpv(tmpstr, va_arg(args, char *));
463ee0b2 827 *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
de3bb511
LW
828 }
829 else {
830 (void) vsprintf(s,pat,args);
831 s += strlen(s);
832 }
a687059c 833
a687059c 834 if (s[-1] != '\n') {
79072805 835 if (curcop->cop_line) {
20188a90 836 (void)sprintf(s," at %s line %ld",
463ee0b2 837 SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
a687059c
LW
838 s += strlen(s);
839 }
79072805
LW
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);
a687059c
LW
847 s += strlen(s);
848 }
849 (void)strcpy(s,".\n");
de3bb511 850 if (usermess)
79072805 851 sv_catpv(tmpstr,buf+1);
a687059c 852 }
de3bb511
LW
853
854 if (usermess)
463ee0b2 855 return SvPVX(tmpstr);
de3bb511
LW
856 else
857 return buf;
a687059c
LW
858}
859
860/*VARARGS0*/
79072805 861void
463ee0b2
LW
862#ifdef __STDC__
863croak(char* pat,...)
864#else
865croak(va_alist)
a687059c 866va_dcl
463ee0b2 867#endif
a687059c
LW
868{
869 va_list args;
9f68db38 870 char *tmps;
de3bb511 871 char *message;
a687059c 872
a687059c 873 va_start(args);
de3bb511 874 message = mess(args);
a687059c 875 va_end(args);
79072805
LW
876 if (restartop = die_where(message))
877 longjmp(top_env, 3);
de3bb511 878 fputs(message,stderr);
a687059c
LW
879 (void)fflush(stderr);
880 if (e_fp)
881 (void)UNLINK(e_tmpname);
882 statusvalue >>= 8;
79072805 883 my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
a687059c
LW
884}
885
886/*VARARGS0*/
463ee0b2
LW
887#ifdef __STDC__
888void warn(char* pat,...)
889#else
7c0587c8 890void warn(va_alist)
a687059c 891va_dcl
463ee0b2 892#endif
a687059c
LW
893{
894 va_list args;
de3bb511 895 char *message;
a687059c 896
a687059c 897 va_start(args);
de3bb511 898 message = mess(args);
a687059c
LW
899 va_end(args);
900
de3bb511 901 fputs(message,stderr);
a687059c 902#ifdef LEAKTEST
79072805 903 DEBUG_L(xstat());
a687059c
LW
904#endif
905 (void)fflush(stderr);
906}
907#endif
8d063cd8 908
8d063cd8 909void
7c0587c8 910my_setenv(nam,val)
8d063cd8
LW
911char *nam, *val;
912{
79072805 913 register I32 i=setenv_getix(nam); /* where does it go? */
8d063cd8 914
fe14fcc3 915 if (environ == origenviron) { /* need we copy environment? */
79072805
LW
916 I32 j;
917 I32 max;
fe14fcc3
LW
918 char **tmpenv;
919
de3bb511 920 /*SUPPRESS 530*/
fe14fcc3
LW
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 }
a687059c
LW
928 if (!val) {
929 while (environ[i]) {
930 environ[i] = environ[i+1];
931 i++;
932 }
933 return;
934 }
8d063cd8 935 if (!environ[i]) { /* does not exist yet */
fe14fcc3 936 Renew(environ, i+2, char*); /* just expand it a bit */
8d063cd8
LW
937 environ[i+1] = Nullch; /* make sure it's null terminated */
938 }
fe14fcc3
LW
939 else
940 Safefree(environ[i]);
a687059c 941 New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
62b28dd9 942#ifndef MSDOS
a687059c 943 (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
62b28dd9
LW
944#else
945 /* MS-DOS requires environment variable names to be in uppercase */
fe14fcc3
LW
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]);
62b28dd9
LW
951 (void)sprintf(environ[i] + strlen(nam),"=%s",val);
952#endif /* MSDOS */
8d063cd8
LW
953}
954
79072805
LW
955I32
956setenv_getix(nam)
8d063cd8
LW
957char *nam;
958{
79072805 959 register I32 i, len = strlen(nam);
8d063cd8
LW
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}
378cc40b
LW
967
968#ifdef EUNICE
79072805 969I32
378cc40b
LW
970unlnk(f) /* unlink all versions of a file */
971char *f;
972{
79072805 973 I32 i;
378cc40b
LW
974
975 for (i = 0; unlink(f) >= 0; i++) ;
976 return i ? 0 : -1;
977}
978#endif
979
7c0587c8 980#if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
378cc40b 981char *
7c0587c8 982my_bcopy(from,to,len)
378cc40b
LW
983register char *from;
984register char *to;
79072805 985register I32 len;
378cc40b
LW
986{
987 char *retval = to;
988
7c0587c8
LW
989 if (from - to >= 0) {
990 while (len--)
991 *to++ = *from++;
992 }
993 else {
994 to += len;
995 from += len;
996 while (len--)
faf8582f 997 *(--to) = *(--from);
7c0587c8 998 }
378cc40b
LW
999 return retval;
1000}
ffed7fef 1001#endif
378cc40b 1002
7c0587c8 1003#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
378cc40b 1004char *
7c0587c8 1005my_bzero(loc,len)
378cc40b 1006register char *loc;
79072805 1007register I32 len;
378cc40b
LW
1008{
1009 char *retval = loc;
1010
1011 while (len--)
1012 *loc++ = 0;
1013 return retval;
1014}
1015#endif
7c0587c8
LW
1016
1017#ifndef HAS_MEMCMP
79072805 1018I32
7c0587c8
LW
1019my_memcmp(s1,s2,len)
1020register unsigned char *s1;
1021register unsigned char *s2;
79072805 1022register I32 len;
7c0587c8 1023{
79072805 1024 register I32 tmp;
7c0587c8
LW
1025
1026 while (len--) {
1027 if (tmp = *s1++ - *s2++)
1028 return tmp;
1029 }
1030 return 0;
1031}
1032#endif /* HAS_MEMCMP */
a687059c 1033
35c8bce7 1034#ifdef I_VARARGS
fe14fcc3 1035#ifndef HAS_VPRINTF
a687059c
LW
1036
1037#ifdef CHARVSPRINTF
1038char *
1039#else
1040int
1041#endif
1042vsprintf(dest, pat, args)
1043char *dest, *pat, *args;
1044{
1045 FILE fakebuf;
1046
1047 fakebuf._ptr = dest;
1048 fakebuf._cnt = 32767;
35c8bce7
LW
1049#ifndef _IOSTRG
1050#define _IOSTRG 0
1051#endif
a687059c
LW
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
a687059c
LW
1062int
1063vfprintf(fd, pat, args)
1064FILE *fd;
1065char *pat, *args;
1066{
1067 _doprnt(pat, args, fd);
1068 return 0; /* wrong, but perl doesn't use the return value */
1069}
fe14fcc3 1070#endif /* HAS_VPRINTF */
35c8bce7 1071#endif /* I_VARARGS */
a687059c 1072
988174c1
LW
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 */
a687059c 1081#ifdef MYSWAP
ffed7fef 1082#if BYTEORDER != 0x4321
a687059c
LW
1083short
1084my_swap(s)
1085short 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
1097long
1098htonl(l)
1099register long l;
1100{
1101 union {
1102 long result;
ffed7fef 1103 char c[sizeof(long)];
a687059c
LW
1104 } u;
1105
ffed7fef 1106#if BYTEORDER == 0x1234
a687059c
LW
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
ffed7fef 1113#if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
463ee0b2 1114 croak("Unknown BYTEORDER\n");
a687059c 1115#else
79072805
LW
1116 register I32 o;
1117 register I32 s;
a687059c 1118
ffed7fef
LW
1119 for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1120 u.c[o & 0xf] = (l >> s) & 255;
a687059c
LW
1121 }
1122 return u.result;
1123#endif
1124#endif
1125}
1126
1127long
1128ntohl(l)
1129register long l;
1130{
1131 union {
1132 long l;
ffed7fef 1133 char c[sizeof(long)];
a687059c
LW
1134 } u;
1135
ffed7fef 1136#if BYTEORDER == 0x1234
a687059c
LW
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
ffed7fef 1143#if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
463ee0b2 1144 croak("Unknown BYTEORDER\n");
a687059c 1145#else
79072805
LW
1146 register I32 o;
1147 register I32 s;
a687059c
LW
1148
1149 u.l = l;
1150 l = 0;
ffed7fef
LW
1151 for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1152 l |= (u.c[o & 0xf] & 255) << s;
a687059c
LW
1153 }
1154 return l;
1155#endif
1156#endif
1157}
1158
ffed7fef 1159#endif /* BYTEORDER != 0x4321 */
988174c1
LW
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; \
79072805
LW
1179 register I32 i; \
1180 register I32 s; \
988174c1
LW
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; \
79072805
LW
1196 register I32 i; \
1197 register I32 s; \
988174c1
LW
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)
1207HTOV(htovs,short)
1208#endif
1209#if defined(HAS_HTOVL) && !defined(htovl)
1210HTOV(htovl,long)
1211#endif
1212#if defined(HAS_VTOHS) && !defined(vtohs)
1213VTOH(vtohs,short)
1214#endif
1215#if defined(HAS_VTOHL) && !defined(vtohl)
1216VTOH(vtohl,long)
1217#endif
a687059c 1218
7c0587c8 1219#ifndef DOSISH
a687059c 1220FILE *
79072805 1221my_popen(cmd,mode)
a687059c
LW
1222char *cmd;
1223char *mode;
1224{
1225 int p[2];
79072805
LW
1226 register I32 this, that;
1227 register I32 pid;
1228 SV *sv;
1229 I32 doexec = strNE(cmd,"-");
a687059c
LW
1230
1231 if (pipe(p) < 0)
1232 return Nullfp;
1233 this = (*mode == 'w');
1234 that = !this;
463ee0b2
LW
1235 if (tainting) {
1236 if (doexec) {
1237 taint_env();
1238 taint_proper("Insecure %s%s", "EXEC");
1239 }
d48672a2 1240 }
a687059c
LW
1241 while ((pid = (doexec?vfork():fork())) < 0) {
1242 if (errno != EAGAIN) {
1243 close(p[this]);
1244 if (!doexec)
463ee0b2 1245 croak("Can't fork");
a687059c
LW
1246 return Nullfp;
1247 }
1248 sleep(5);
1249 }
1250 if (pid == 0) {
79072805
LW
1251 GV* tmpgv;
1252
a687059c
LW
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) {
79072805 1261#if !defined(HAS_FCNTL) || !defined(FFt_SETFD)
ae986130
LW
1262 int fd;
1263
1264#ifndef NOFILE
1265#define NOFILE 20
1266#endif
d48672a2 1267 for (fd = maxsysfd + 1; fd < NOFILE; fd++)
ae986130
LW
1268 close(fd);
1269#endif
a687059c 1270 do_exec(cmd); /* may or may not use the shell */
de3bb511 1271 warn("Can't exec \"%s\": %s", cmd, strerror(errno));
a687059c
LW
1272 _exit(1);
1273 }
de3bb511 1274 /*SUPPRESS 560*/
463ee0b2 1275 if (tmpgv = gv_fetchpv("$",TRUE))
79072805 1276 sv_setiv(GvSV(tmpgv),(I32)getpid());
9f68db38 1277 forkprocess = 0;
463ee0b2 1278 hv_clear(pidstatus); /* we have no children */
a687059c
LW
1279 return Nullfp;
1280#undef THIS
1281#undef THAT
1282 }
62b28dd9 1283 do_execfree(); /* free any memory malloced by child on vfork */
a687059c 1284 close(p[that]);
62b28dd9
LW
1285 if (p[that] < p[this]) {
1286 dup2(p[this], p[that]);
1287 close(p[this]);
1288 p[this] = p[that];
1289 }
79072805
LW
1290 sv = *av_fetch(fdpid,p[this],TRUE);
1291 SvUPGRADE(sv,SVt_IV);
463ee0b2 1292 SvIVX(sv) = pid;
a687059c
LW
1293 forkprocess = pid;
1294 return fdopen(p[this], mode);
1295}
7c0587c8
LW
1296#else
1297#ifdef atarist
1298FILE *popen();
1299FILE *
79072805 1300my_popen(cmd,mode)
7c0587c8
LW
1301char *cmd;
1302char *mode;
1303{
1304 return popen(cmd, mode);
1305}
1306#endif
1307
1308#endif /* !DOSISH */
a687059c 1309
ae986130 1310#ifdef NOTDEF
79072805 1311dump_fds(s)
ae986130
LW
1312char *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
fe14fcc3 1326#ifndef HAS_DUP2
a687059c
LW
1327dup2(oldfd,newfd)
1328int oldfd;
1329int newfd;
1330{
79072805 1331#if defined(HAS_FCNTL) && defined(FFt_DUPFD)
62b28dd9 1332 close(newfd);
79072805 1333 fcntl(oldfd, FFt_DUPFD, newfd);
62b28dd9 1334#else
d48672a2 1335 int fdtmp[256];
79072805 1336 I32 fdx = 0;
ae986130
LW
1337 int fd;
1338
fe14fcc3
LW
1339 if (oldfd == newfd)
1340 return 0;
a687059c 1341 close(newfd);
ae986130
LW
1342 while ((fd = dup(oldfd)) != newfd) /* good enough for low fd's */
1343 fdtmp[fdx++] = fd;
1344 while (fdx > 0)
1345 close(fdtmp[--fdx]);
62b28dd9 1346#endif
a687059c
LW
1347}
1348#endif
1349
7c0587c8 1350#ifndef DOSISH
79072805
LW
1351I32
1352my_pclose(ptr)
a687059c
LW
1353FILE *ptr;
1354{
a687059c
LW
1355#ifdef VOIDSIG
1356 void (*hstat)(), (*istat)(), (*qstat)();
1357#else
1358 int (*hstat)(), (*istat)(), (*qstat)();
1359#endif
1360 int status;
79072805 1361 SV *sv;
20188a90 1362 int pid;
a687059c 1363
79072805 1364 sv = *av_fetch(fdpid,fileno(ptr),TRUE);
463ee0b2 1365 pid = SvIVX(sv);
79072805 1366 av_store(fdpid,fileno(ptr),Nullsv);
a687059c 1367 fclose(ptr);
7c0587c8
LW
1368#ifdef UTS
1369 if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
1370#endif
a687059c
LW
1371 hstat = signal(SIGHUP, SIG_IGN);
1372 istat = signal(SIGINT, SIG_IGN);
1373 qstat = signal(SIGQUIT, SIG_IGN);
20188a90
LW
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
79072805 1381I32
20188a90
LW
1382wait4pid(pid,statusp,flags)
1383int pid;
1384int *statusp;
1385int flags;
1386{
79072805
LW
1387 I32 result;
1388 SV *sv;
1389 SV** svp;
20188a90
LW
1390 char spid[16];
1391
1392 if (!pid)
1393 return -1;
20188a90
LW
1394 if (pid > 0) {
1395 sprintf(spid, "%d", pid);
79072805
LW
1396 svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
1397 if (svp && *svp != &sv_undef) {
463ee0b2 1398 *statusp = SvIVX(*svp);
79072805 1399 hv_delete(pidstatus,spid,strlen(spid));
20188a90
LW
1400 return pid;
1401 }
1402 }
1403 else {
79072805 1404 HE *entry;
20188a90 1405
79072805
LW
1406 hv_iterinit(pidstatus);
1407 if (entry = hv_iternext(pidstatus)) {
1408 pid = atoi(hv_iterkey(entry,statusp));
1409 sv = hv_iterval(pidstatus,entry);
463ee0b2 1410 *statusp = SvIVX(sv);
20188a90 1411 sprintf(spid, "%d", pid);
79072805 1412 hv_delete(pidstatus,spid,strlen(spid));
20188a90
LW
1413 return pid;
1414 }
1415 }
79072805
LW
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
20188a90 1422 if (flags)
463ee0b2 1423 croak("Can't do waitpid with flags");
a687059c 1424 else {
20188a90
LW
1425 while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
1426 pidgone(result,*statusp);
a687059c 1427 if (result < 0)
20188a90 1428 *statusp = -1;
a687059c 1429 }
e5d73d77 1430 return result;
a687059c 1431#endif
20188a90 1432#endif
a687059c 1433}
7c0587c8 1434#endif /* !DOSISH */
a687059c 1435
7c0587c8 1436void
de3bb511 1437/*SUPPRESS 590*/
a687059c
LW
1438pidgone(pid,status)
1439int pid;
1440int status;
1441{
79072805 1442 register SV *sv;
20188a90 1443 char spid[16];
a687059c 1444
20188a90 1445 sprintf(spid, "%d", pid);
79072805
LW
1446 sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
1447 SvUPGRADE(sv,SVt_IV);
463ee0b2 1448 SvIVX(sv) = status;
20188a90 1449 return;
a687059c
LW
1450}
1451
7c0587c8
LW
1452#ifdef atarist
1453int pclose();
79072805
LW
1454I32
1455my_pclose(ptr)
7c0587c8 1456FILE *ptr;
a687059c 1457{
7c0587c8 1458 return pclose(ptr);
a687059c 1459}
7c0587c8 1460#endif
9f68db38
LW
1461
1462void
1463repeatcpy(to,from,len,count)
1464register char *to;
1465register char *from;
79072805
LW
1466I32 len;
1467register I32 count;
9f68db38 1468{
79072805 1469 register I32 todo;
9f68db38
LW
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}
0f85fab0
LW
1485
1486#ifndef CASTNEGFLOAT
463ee0b2 1487U32
79072805 1488cast_ulong(f)
0f85fab0
LW
1489double f;
1490{
1491 long along;
1492
27e2fb84 1493#if CASTFLAGS & 2
34de22dd
LW
1494# define BIGDOUBLE 2147483648.0
1495 if (f >= BIGDOUBLE)
1496 return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
1497#endif
0f85fab0
LW
1498 if (f >= 0.0)
1499 return (unsigned long)f;
1500 along = (long)f;
1501 return (unsigned long)along;
1502}
ed6116ce
LW
1503# undef BIGDOUBLE
1504#endif
1505
1506#ifndef CASTI32
1507I32
1508cast_i32(f)
1509double 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
0f85fab0 1521#endif
62b28dd9 1522
fe14fcc3 1523#ifndef HAS_RENAME
79072805 1524I32
62b28dd9
LW
1525same_dirent(a,b)
1526char *a;
1527char *b;
1528{
93a17b20
LW
1529 char *fa = strrchr(a,'/');
1530 char *fb = strrchr(b,'/');
62b28dd9
LW
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)
6eb13c3b 1549 strcpy(tmpbuf,".");
62b28dd9
LW
1550 else
1551 strncpy(tmpbuf, a, fa - a);
1552 if (stat(tmpbuf, &tmpstatbuf1) < 0)
1553 return FALSE;
1554 if (fb == b)
6eb13c3b 1555 strcpy(tmpbuf,".");
62b28dd9
LW
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}
fe14fcc3
LW
1563#endif /* !HAS_RENAME */
1564
1565unsigned long
79072805 1566scan_oct(start, len, retlen)
fe14fcc3 1567char *start;
79072805
LW
1568I32 len;
1569I32 *retlen;
fe14fcc3
LW
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
1582unsigned long
79072805 1583scan_hex(start, len, retlen)
fe14fcc3 1584char *start;
79072805
LW
1585I32 len;
1586I32 *retlen;
fe14fcc3
LW
1587{
1588 register char *s = start;
1589 register unsigned long retval = 0;
1590 char *tmp;
1591
93a17b20 1592 while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
fe14fcc3
LW
1593 retval <<= 4;
1594 retval |= (tmp - hexdigit) & 15;
1595 s++;
1596 }
1597 *retlen = s - start;
1598 return retval;
1599}