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