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