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