home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / util.c < prev    next >
C/C++ Source or Header  |  1996-03-25  |  36KB  |  1,813 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. /* Initialize locale (and the fold[] array).*/
  357. int
  358. perl_init_i18nl14n(printwarn)    
  359.     int printwarn;
  360. {
  361.     int ok = 1;
  362.     /* returns
  363.      *    1 = set ok or not applicable,
  364.      *    0 = fallback to C locale,
  365.      *   -1 = fallback to C locale failed
  366.      */
  367. #if defined(HAS_SETLOCALE) && defined(LC_CTYPE)
  368.     char * lang     = getenv("LANG");
  369.     char * lc_all   = getenv("LC_ALL");
  370.     char * lc_ctype = getenv("LC_CTYPE");
  371.     int i;
  372.  
  373.     if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) {
  374.     if (printwarn) {
  375.         fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n");
  376.         fprintf(stderr,
  377.           "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n",
  378.           lc_all   ? lc_all   : "(null)",
  379.           lc_ctype ? lc_ctype : "(null)",
  380.           lang     ? lang     : "(null)"
  381.           );
  382.         fprintf(stderr, "warning: falling back to the \"C\" locale.\n");
  383.     }
  384.     ok = 0;
  385.     if (setlocale(LC_CTYPE, "C") == NULL)
  386.         ok = -1;
  387.     }
  388.  
  389.     for (i = 0; i < 256; i++) {
  390.     if (isUPPER(i)) fold[i] = toLOWER(i);
  391.     else if (isLOWER(i)) fold[i] = toUPPER(i);
  392.     else fold[i] = i;
  393.     }
  394. #endif
  395.     return ok;
  396. }
  397.  
  398. void
  399. fbm_compile(sv, iflag)
  400. SV *sv;
  401. I32 iflag;
  402. {
  403.     register unsigned char *s;
  404.     register unsigned char *table;
  405.     register U32 i;
  406.     register U32 len = SvCUR(sv);
  407.     I32 rarest = 0;
  408.     U32 frequency = 256;
  409.  
  410.     if (len > 255)
  411.     return;            /* can't have offsets that big */
  412.     Sv_Grow(sv,len+258);
  413.     table = (unsigned char*)(SvPVX(sv) + len + 1);
  414.     s = table - 2;
  415.     for (i = 0; i < 256; i++) {
  416.     table[i] = len;
  417.     }
  418.     i = 0;
  419.     while (s >= (unsigned char*)(SvPVX(sv)))
  420.     {
  421.     if (table[*s] == len) {
  422. #ifndef pdp11
  423.         if (iflag)
  424.         table[*s] = table[fold[*s]] = i;
  425. #else
  426.         if (iflag) {
  427.         I32 j;
  428.         j = fold[*s];
  429.         table[j] = i;
  430.         table[*s] = i;
  431.         }
  432. #endif /* pdp11 */
  433.         else
  434.         table[*s] = i;
  435.     }
  436.     s--,i++;
  437.     }
  438.     sv_upgrade(sv, SVt_PVBM);
  439.     sv_magic(sv, Nullsv, 'B', Nullch, 0);            /* deep magic */
  440.     SvVALID_on(sv);
  441.  
  442.     s = (unsigned char*)(SvPVX(sv));        /* deeper magic */
  443.     if (iflag) {
  444.     register U32 tmp, foldtmp;
  445.     SvCASEFOLD_on(sv);
  446.     for (i = 0; i < len; i++) {
  447.         tmp=freq[s[i]];
  448.         foldtmp=freq[fold[s[i]]];
  449.         if (tmp < frequency && foldtmp < frequency) {
  450.         rarest = i;
  451.         /* choose most frequent among the two */
  452.         frequency = (tmp > foldtmp) ? tmp : foldtmp;
  453.         }
  454.     }
  455.     }
  456.     else {
  457.     for (i = 0; i < len; i++) {
  458.         if (freq[s[i]] < frequency) {
  459.         rarest = i;
  460.         frequency = freq[s[i]];
  461.         }
  462.     }
  463.     }
  464.     BmRARE(sv) = s[rarest];
  465.     BmPREVIOUS(sv) = rarest;
  466.     DEBUG_r(fprintf(stderr,"rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
  467. }
  468.  
  469. char *
  470. fbm_instr(big, bigend, littlestr)
  471. unsigned char *big;
  472. register unsigned char *bigend;
  473. SV *littlestr;
  474. {
  475.     register unsigned char *s;
  476.     register I32 tmp;
  477.     register I32 littlelen;
  478.     register unsigned char *little;
  479.     register unsigned char *table;
  480.     register unsigned char *olds;
  481.     register unsigned char *oldlittle;
  482.  
  483.     if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
  484.     STRLEN len;
  485.     char *l = SvPV(littlestr,len);
  486.     if (!len)
  487.         return (char*)big;
  488.     return ninstr((char*)big,(char*)bigend, l, l + len);
  489.     }
  490.  
  491.     littlelen = SvCUR(littlestr);
  492.     if (SvTAIL(littlestr) && !multiline) {    /* tail anchored? */
  493.     if (littlelen > bigend - big)
  494.         return Nullch;
  495.     little = (unsigned char*)SvPVX(littlestr);
  496.     if (SvCASEFOLD(littlestr)) {    /* oops, fake it */
  497.         big = bigend - littlelen;        /* just start near end */
  498.         if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
  499.         big--;
  500.     }
  501.     else {
  502.         s = bigend - littlelen;
  503.         if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
  504.         return (char*)s;        /* how sweet it is */
  505.         else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
  506.           && s > big) {
  507.             s--;
  508.         if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
  509.             return (char*)s;
  510.         }
  511.         return Nullch;
  512.     }
  513.     }
  514.     table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1);
  515.     if (--littlelen >= bigend - big)
  516.     return Nullch;
  517.     s = big + littlelen;
  518.     oldlittle = little = table - 2;
  519.     if (SvCASEFOLD(littlestr)) {    /* case insensitive? */
  520.     if (s < bigend) {
  521.       top1:
  522.         /*SUPPRESS 560*/
  523.         if (tmp = table[*s]) {
  524. #ifdef POINTERRIGOR
  525.         if (bigend - s > tmp) {
  526.             s += tmp;
  527.             goto top1;
  528.         }
  529. #else
  530.         if ((s += tmp) < bigend)
  531.             goto top1;
  532. #endif
  533.         return Nullch;
  534.         }
  535.         else {
  536.         tmp = littlelen;    /* less expensive than calling strncmp() */
  537.         olds = s;
  538.         while (tmp--) {
  539.             if (*--s == *--little || fold[*s] == *little)
  540.             continue;
  541.             s = olds + 1;    /* here we pay the price for failure */
  542.             little = oldlittle;
  543.             if (s < bigend)    /* fake up continue to outer loop */
  544.             goto top1;
  545.             return Nullch;
  546.         }
  547.         return (char *)s;
  548.         }
  549.     }
  550.     }
  551.     else {
  552.     if (s < bigend) {
  553.       top2:
  554.         /*SUPPRESS 560*/
  555.         if (tmp = table[*s]) {
  556. #ifdef POINTERRIGOR
  557.         if (bigend - s > tmp) {
  558.             s += tmp;
  559.             goto top2;
  560.         }
  561. #else
  562.         if ((s += tmp) < bigend)
  563.             goto top2;
  564. #endif
  565.         return Nullch;
  566.         }
  567.         else {
  568.         tmp = littlelen;    /* less expensive than calling strncmp() */
  569.         olds = s;
  570.         while (tmp--) {
  571.             if (*--s == *--little)
  572.             continue;
  573.             s = olds + 1;    /* here we pay the price for failure */
  574.             little = oldlittle;
  575.             if (s < bigend)    /* fake up continue to outer loop */
  576.             goto top2;
  577.             return Nullch;
  578.         }
  579.         return (char *)s;
  580.         }
  581.     }
  582.     }
  583.     return Nullch;
  584. }
  585.  
  586. char *
  587. screaminstr(bigstr, littlestr)
  588. SV *bigstr;
  589. SV *littlestr;
  590. {
  591.     register unsigned char *s, *x;
  592.     register unsigned char *big;
  593.     register I32 pos;
  594.     register I32 previous;
  595.     register I32 first;
  596.     register unsigned char *little;
  597.     register unsigned char *bigend;
  598.     register unsigned char *littleend;
  599.  
  600.     if ((pos = screamfirst[BmRARE(littlestr)]) < 0) 
  601.     return Nullch;
  602.     little = (unsigned char *)(SvPVX(littlestr));
  603.     littleend = little + SvCUR(littlestr);
  604.     first = *little++;
  605.     previous = BmPREVIOUS(littlestr);
  606.     big = (unsigned char *)(SvPVX(bigstr));
  607.     bigend = big + SvCUR(bigstr);
  608.     while (pos < previous) {
  609.     if (!(pos += screamnext[pos]))
  610.         return Nullch;
  611.     }
  612. #ifdef POINTERRIGOR
  613.     if (SvCASEFOLD(littlestr)) {    /* case insignificant? */
  614.     do {
  615.         if (big[pos-previous] != first && big[pos-previous] != fold[first])
  616.         continue;
  617.         for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  618.         if (x >= bigend)
  619.             return Nullch;
  620.         if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
  621.             s--;
  622.             break;
  623.         }
  624.         }
  625.         if (s == littleend)
  626.         return (char *)(big+pos-previous);
  627.     } while (
  628.         pos += screamnext[pos]    /* does this goof up anywhere? */
  629.         );
  630.     }
  631.     else {
  632.     do {
  633.         if (big[pos-previous] != first)
  634.         continue;
  635.         for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
  636.         if (x >= bigend)
  637.             return Nullch;
  638.         if (*s++ != *x++) {
  639.             s--;
  640.             break;
  641.         }
  642.         }
  643.         if (s == littleend)
  644.         return (char *)(big+pos-previous);
  645.     } while ( pos += screamnext[pos] );
  646.     }
  647. #else /* !POINTERRIGOR */
  648.     big -= previous;
  649.     if (SvCASEFOLD(littlestr)) {    /* case insignificant? */
  650.     do {
  651.         if (big[pos] != first && big[pos] != fold[first])
  652.         continue;
  653.         for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  654.         if (x >= bigend)
  655.             return Nullch;
  656.         if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
  657.             s--;
  658.             break;
  659.         }
  660.         }
  661.         if (s == littleend)
  662.         return (char *)(big+pos);
  663.     } while (
  664.         pos += screamnext[pos]    /* does this goof up anywhere? */
  665.         );
  666.     }
  667.     else {
  668.     do {
  669.         if (big[pos] != first)
  670.         continue;
  671.         for (x=big+pos+1,s=little; s < littleend; /**/ ) {
  672.         if (x >= bigend)
  673.             return Nullch;
  674.         if (*s++ != *x++) {
  675.             s--;
  676.             break;
  677.         }
  678.         }
  679.         if (s == littleend)
  680.         return (char *)(big+pos);
  681.     } while (
  682.         pos += screamnext[pos]
  683.         );
  684.     }
  685. #endif /* POINTERRIGOR */
  686.     return Nullch;
  687. }
  688.  
  689. I32
  690. ibcmp(a,b,len)
  691. register U8 *a;
  692. register U8 *b;
  693. register I32 len;
  694. {
  695.     while (len--) {
  696.     if (*a == *b) {
  697.         a++,b++;
  698.         continue;
  699.     }
  700.     if (fold[*a++] == *b++)
  701.         continue;
  702.     return 1;
  703.     }
  704.     return 0;
  705. }
  706.  
  707. /* copy a string to a safe spot */
  708.  
  709. char *
  710. savepv(sv)
  711. char *sv;
  712. {
  713.     register char *newaddr;
  714.  
  715.     New(902,newaddr,strlen(sv)+1,char);
  716.     (void)strcpy(newaddr,sv);
  717.     return newaddr;
  718. }
  719.  
  720. /* same thing but with a known length */
  721.  
  722. char *
  723. savepvn(sv, len)
  724. char *sv;
  725. register I32 len;
  726. {
  727.     register char *newaddr;
  728.  
  729.     New(903,newaddr,len+1,char);
  730.     Copy(sv,newaddr,len,char);        /* might not be null terminated */
  731.     newaddr[len] = '\0';        /* is now */
  732.     return newaddr;
  733. }
  734.  
  735. #if !defined(I_STDARG) && !defined(I_VARARGS)
  736.  
  737. /*
  738.  * Fallback on the old hackers way of doing varargs
  739.  */
  740.  
  741. /*VARARGS1*/
  742. char *
  743. mess(pat,a1,a2,a3,a4)
  744. char *pat;
  745. long a1, a2, a3, a4;
  746. {
  747.     char *s;
  748.     char *s_start;
  749.     I32 usermess = strEQ(pat,"%s");
  750.     SV *tmpstr;
  751.  
  752.     s = s_start = buf;
  753.     if (usermess) {
  754.     tmpstr = sv_newmortal();
  755.     sv_setpv(tmpstr, (char*)a1);
  756.     *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
  757.     }
  758.     else {
  759.     (void)sprintf(s,pat,a1,a2,a3,a4);
  760.     s += strlen(s);
  761.     }
  762.  
  763.     if (s[-1] != '\n') {
  764.     if (dirty)
  765.         strcpy(s, " during global destruction.\n");
  766.     else {
  767.         if (curcop->cop_line) {
  768.         (void)sprintf(s," at %s line %ld",
  769.           SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
  770.         s += strlen(s);
  771.         }
  772.         if (GvIO(last_in_gv) &&
  773.         IoLINES(GvIOp(last_in_gv)) ) {
  774.         (void)sprintf(s,", <%s> %s %ld",
  775.           last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
  776.           strEQ(rs,"\n") ? "line" : "chunk", 
  777.           (long)IoLINES(GvIOp(last_in_gv)));
  778.         s += strlen(s);
  779.         }
  780.         (void)strcpy(s,".\n");
  781.         s += 2;
  782.     }
  783.     if (usermess)
  784.         sv_catpv(tmpstr,buf+1);
  785.     }
  786.  
  787.     if (s - s_start >= sizeof(buf)) {    /* Ooops! */
  788.     if (usermess)
  789.         fputs(SvPVX(tmpstr), stderr);
  790.     else
  791.         fputs(buf, stderr);
  792.     fputs("panic: message overflow - memory corrupted!\n",stderr);
  793.     my_exit(1);
  794.     }
  795.     if (usermess)
  796.     return SvPVX(tmpstr);
  797.     else
  798.     return buf;
  799. }
  800.  
  801. /*VARARGS1*/
  802. void croak(pat,a1,a2,a3,a4)
  803. char *pat;
  804. long a1, a2, a3, a4;
  805. {
  806.     char *tmps;
  807.     char *message;
  808.     HV *stash;
  809.     GV *gv;
  810.     CV *cv;
  811.  
  812.     message = mess(pat,a1,a2,a3,a4);
  813.     if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  814.     dSP;
  815.  
  816.     PUSHMARK(sp);
  817.     EXTEND(sp, 1);
  818.     PUSHs(sv_2mortal(newSVpv(message,0)));
  819.     PUTBACK;
  820.     perl_call_sv((SV*)cv, G_DISCARD);
  821.     }
  822.     if (in_eval) {
  823.     restartop = die_where(message);
  824.     Siglongjmp(top_env, 3);
  825.     }
  826.     fputs(message,stderr);
  827.     (void)Fflush(stderr);
  828.     if (e_tmpname) {
  829.     if (e_fp) {
  830.         fclose(e_fp);
  831.         e_fp = Nullfp;
  832.     }
  833.     (void)UNLINK(e_tmpname);
  834.     Safefree(e_tmpname);
  835.     e_tmpname = Nullch;
  836.     }
  837.     statusvalue = SHIFTSTATUS(statusvalue);
  838. #ifdef VMS
  839.     my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
  840. #else
  841.     my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
  842. #endif
  843. }
  844.  
  845. /*VARARGS1*/
  846. void warn(pat,a1,a2,a3,a4)
  847. char *pat;
  848. long a1, a2, a3, a4;
  849. {
  850.     char *message;
  851.     SV *sv;
  852.     HV *stash;
  853.     GV *gv;
  854.     CV *cv;
  855.  
  856.     message = mess(pat,a1,a2,a3,a4);
  857.     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  858.     dSP;
  859.  
  860.     PUSHMARK(sp);
  861.     EXTEND(sp, 1);
  862.     PUSHs(sv_2mortal(newSVpv(message,0)));
  863.     PUTBACK;
  864.     perl_call_sv((SV*)cv, G_DISCARD);
  865.     }
  866.     else {
  867.     fputs(message,stderr);
  868. #ifdef LEAKTEST
  869.     DEBUG_L(xstat());
  870. #endif
  871.     (void)Fflush(stderr);
  872.     }
  873. }
  874.  
  875. #else /* !defined(I_STDARG) && !defined(I_VARARGS) */
  876.  
  877. #ifdef I_STDARG
  878. char *
  879. mess(char *pat, va_list *args)
  880. #else
  881. /*VARARGS0*/
  882. char *
  883. mess(pat, args)
  884.     char *pat;
  885.     va_list *args;
  886. #endif
  887. {
  888.     char *s;
  889.     char *s_start;
  890.     SV *tmpstr;
  891.     I32 usermess;
  892. #ifndef HAS_VPRINTF
  893. #ifdef USE_CHAR_VSPRINTF
  894.     char *vsprintf();
  895. #else
  896.     I32 vsprintf();
  897. #endif
  898. #endif
  899.  
  900.     s = s_start = buf;
  901.     usermess = strEQ(pat, "%s");
  902.     if (usermess) {
  903.     tmpstr = sv_newmortal();
  904.     sv_setpv(tmpstr, va_arg(*args, char *));
  905.     *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
  906.     }
  907.     else {
  908.     (void) vsprintf(s,pat,*args);
  909.     s += strlen(s);
  910.     }
  911.     va_end(*args);
  912.  
  913.     if (s[-1] != '\n') {
  914.     if (dirty)
  915.         strcpy(s, " during global destruction.\n");
  916.     else {
  917.         if (curcop->cop_line) {
  918.         (void)sprintf(s," at %s line %ld",
  919.           SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
  920.         s += strlen(s);
  921.         }
  922.         if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
  923.         bool line_mode = (RsSIMPLE(rs) &&
  924.                   SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
  925.         (void)sprintf(s,", <%s> %s %ld",
  926.           last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
  927.           line_mode ? "line" : "chunk", 
  928.           (long)IoLINES(GvIOp(last_in_gv)));
  929.         s += strlen(s);
  930.         }
  931.         (void)strcpy(s,".\n");
  932.         s += 2;
  933.     }
  934.     if (usermess)
  935.         sv_catpv(tmpstr,buf+1);
  936.     }
  937.  
  938.     if (s - s_start >= sizeof(buf)) {    /* Ooops! */
  939.     if (usermess)
  940.         fputs(SvPVX(tmpstr), stderr);
  941.     else
  942.         fputs(buf, stderr);
  943.     fputs("panic: message overflow - memory corrupted!\n",stderr);
  944.     my_exit(1);
  945.     }
  946.     if (usermess)
  947.     return SvPVX(tmpstr);
  948.     else
  949.     return buf;
  950. }
  951.  
  952. #ifdef I_STDARG
  953. void
  954. croak(char* pat, ...)
  955. #else
  956. /*VARARGS0*/
  957. void
  958. croak(pat, va_alist)
  959.     char *pat;
  960.     va_dcl
  961. #endif
  962. {
  963.     va_list args;
  964.     char *message;
  965.     HV *stash;
  966.     GV *gv;
  967.     CV *cv;
  968.  
  969. #ifdef I_STDARG
  970.     va_start(args, pat);
  971. #else
  972.     va_start(args);
  973. #endif
  974.     message = mess(pat, &args);
  975.     va_end(args);
  976.     if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  977.     dSP;
  978.  
  979.     PUSHMARK(sp);
  980.     EXTEND(sp, 1);
  981.     PUSHs(sv_2mortal(newSVpv(message,0)));
  982.     PUTBACK;
  983.     perl_call_sv((SV*)cv, G_DISCARD);
  984.     }
  985.     if (in_eval) {
  986.     restartop = die_where(message);
  987.     Siglongjmp(top_env, 3);
  988.     }
  989.     fputs(message,stderr);
  990.     (void)Fflush(stderr);
  991.     if (e_tmpname) {
  992.     if (e_fp) {
  993.         fclose(e_fp);
  994.         e_fp = Nullfp;
  995.     }
  996.     (void)UNLINK(e_tmpname);
  997.     Safefree(e_tmpname);
  998.     e_tmpname = Nullch;
  999.     }
  1000.     statusvalue = SHIFTSTATUS(statusvalue);
  1001. #ifdef VMS
  1002.     my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
  1003. #else
  1004.     my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
  1005. #endif
  1006. }
  1007.  
  1008. void
  1009. #ifdef I_STDARG
  1010. warn(char* pat,...)
  1011. #else
  1012. /*VARARGS0*/
  1013. warn(pat,va_alist)
  1014.     char *pat;
  1015.     va_dcl
  1016. #endif
  1017. {
  1018.     va_list args;
  1019.     char *message;
  1020.     HV *stash;
  1021.     GV *gv;
  1022.     CV *cv;
  1023.  
  1024. #ifdef I_STDARG
  1025.     va_start(args, pat);
  1026. #else
  1027.     va_start(args);
  1028. #endif
  1029.     message = mess(pat, &args);
  1030.     va_end(args);
  1031.  
  1032.     if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
  1033.     dSP;
  1034.  
  1035.     PUSHMARK(sp);
  1036.     EXTEND(sp, 1);
  1037.     PUSHs(sv_2mortal(newSVpv(message,0)));
  1038.     PUTBACK;
  1039.     perl_call_sv((SV*)cv, G_DISCARD);
  1040.     }
  1041.     else {
  1042.     fputs(message,stderr);
  1043. #ifdef LEAKTEST
  1044.     DEBUG_L(xstat());
  1045. #endif
  1046.     (void)Fflush(stderr);
  1047.     }
  1048. }
  1049. #endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
  1050.  
  1051. #ifndef VMS  /* VMS' my_setenv() is in VMS.c */
  1052. void
  1053. my_setenv(nam,val)
  1054. char *nam, *val;
  1055. {
  1056.     register I32 i=setenv_getix(nam);        /* where does it go? */
  1057.  
  1058.     if (environ == origenviron) {    /* need we copy environment? */
  1059.     I32 j;
  1060.     I32 max;
  1061.     char **tmpenv;
  1062.  
  1063.     /*SUPPRESS 530*/
  1064.     for (max = i; environ[max]; max++) ;
  1065.     New(901,tmpenv, max+2, char*);
  1066.     for (j=0; j<max; j++)        /* copy environment */
  1067.         tmpenv[j] = savepv(environ[j]);
  1068.     tmpenv[max] = Nullch;
  1069.     environ = tmpenv;        /* tell exec where it is now */
  1070.     }
  1071.     if (!val) {
  1072.     while (environ[i]) {
  1073.         environ[i] = environ[i+1];
  1074.         i++;
  1075.     }
  1076.     return;
  1077.     }
  1078.     if (!environ[i]) {            /* does not exist yet */
  1079.     Renew(environ, i+2, char*);    /* just expand it a bit */
  1080.     environ[i+1] = Nullch;    /* make sure it's null terminated */
  1081.     }
  1082.     else
  1083.     Safefree(environ[i]);
  1084.     New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
  1085. #ifndef MSDOS
  1086.     (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
  1087. #else
  1088.     /* MS-DOS requires environment variable names to be in uppercase */
  1089.     /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
  1090.      * some utilities and applications may break because they only look
  1091.      * for upper case strings. (Fixed strupr() bug here.)]
  1092.      */
  1093.     strcpy(environ[i],nam); strupr(environ[i]);
  1094.     (void)sprintf(environ[i] + strlen(nam),"=%s",val);
  1095. #endif /* MSDOS */
  1096. }
  1097.  
  1098. I32
  1099. setenv_getix(nam)
  1100. char *nam;
  1101. {
  1102.     register I32 i, len = strlen(nam);
  1103.  
  1104.     for (i = 0; environ[i]; i++) {
  1105.     if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
  1106.         break;            /* strnEQ must come first to avoid */
  1107.     }                    /* potential SEGV's */
  1108.     return i;
  1109. }
  1110. #endif /* !VMS */
  1111.  
  1112. #ifdef UNLINK_ALL_VERSIONS
  1113. I32
  1114. unlnk(f)    /* unlink all versions of a file */
  1115. char *f;
  1116. {
  1117.     I32 i;
  1118.  
  1119.     for (i = 0; unlink(f) >= 0; i++) ;
  1120.     return i ? 0 : -1;
  1121. }
  1122. #endif
  1123.  
  1124. #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
  1125. char *
  1126. my_bcopy(from,to,len)
  1127. register char *from;
  1128. register char *to;
  1129. register I32 len;
  1130. {
  1131.     char *retval = to;
  1132.  
  1133.     if (from - to >= 0) {
  1134.     while (len--)
  1135.         *to++ = *from++;
  1136.     }
  1137.     else {
  1138.     to += len;
  1139.     from += len;
  1140.     while (len--)
  1141.         *(--to) = *(--from);
  1142.     }
  1143.     return retval;
  1144. }
  1145. #endif
  1146.  
  1147. #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
  1148. char *
  1149. my_bzero(loc,len)
  1150. register char *loc;
  1151. register I32 len;
  1152. {
  1153.     char *retval = loc;
  1154.  
  1155.     while (len--)
  1156.     *loc++ = 0;
  1157.     return retval;
  1158. }
  1159. #endif
  1160.  
  1161. #ifndef HAS_MEMCMP
  1162. I32
  1163. my_memcmp(s1,s2,len)
  1164. register unsigned char *s1;
  1165. register unsigned char *s2;
  1166. register I32 len;
  1167. {
  1168.     register I32 tmp;
  1169.  
  1170.     while (len--) {
  1171.     if (tmp = *s1++ - *s2++)
  1172.         return tmp;
  1173.     }
  1174.     return 0;
  1175. }
  1176. #endif /* HAS_MEMCMP */
  1177.  
  1178. #if defined(I_STDARG) || defined(I_VARARGS)
  1179. #ifndef HAS_VPRINTF
  1180.  
  1181. #ifdef USE_CHAR_VSPRINTF
  1182. char *
  1183. #else
  1184. int
  1185. #endif
  1186. vsprintf(dest, pat, args)
  1187. char *dest, *pat, *args;
  1188. {
  1189.     FILE fakebuf;
  1190.  
  1191.     fakebuf._ptr = dest;
  1192.     fakebuf._cnt = 32767;
  1193. #ifndef _IOSTRG
  1194. #define _IOSTRG 0
  1195. #endif
  1196.     fakebuf._flag = _IOWRT|_IOSTRG;
  1197.     _doprnt(pat, args, &fakebuf);    /* what a kludge */
  1198.     (void)putc('\0', &fakebuf);
  1199. #ifdef USE_CHAR_VSPRINTF
  1200.     return(dest);
  1201. #else
  1202.     return 0;        /* perl doesn't use return value */
  1203. #endif
  1204. }
  1205.  
  1206. int
  1207. vfprintf(fd, pat, args)
  1208. FILE *fd;
  1209. char *pat, *args;
  1210. {
  1211.     _doprnt(pat, args, fd);
  1212.     return 0;        /* wrong, but perl doesn't use the return value */
  1213. }
  1214. #endif /* HAS_VPRINTF */
  1215. #endif /* I_VARARGS || I_STDARGS */
  1216.  
  1217. #ifdef MYSWAP
  1218. #if BYTEORDER != 0x4321
  1219. short
  1220. #ifndef CAN_PROTOTYPE
  1221. my_swap(s)
  1222. short s;
  1223. #else
  1224. my_swap(short s)
  1225. #endif
  1226. {
  1227. #if (BYTEORDER & 1) == 0
  1228.     short result;
  1229.  
  1230.     result = ((s & 255) << 8) + ((s >> 8) & 255);
  1231.     return result;
  1232. #else
  1233.     return s;
  1234. #endif
  1235. }
  1236.  
  1237. long
  1238. #ifndef CAN_PROTOTYPE
  1239. my_htonl(l)
  1240. register long l;
  1241. #else
  1242. my_htonl(long l)
  1243. #endif
  1244. {
  1245.     union {
  1246.     long result;
  1247.     char c[sizeof(long)];
  1248.     } u;
  1249.  
  1250. #if BYTEORDER == 0x1234
  1251.     u.c[0] = (l >> 24) & 255;
  1252.     u.c[1] = (l >> 16) & 255;
  1253.     u.c[2] = (l >> 8) & 255;
  1254.     u.c[3] = l & 255;
  1255.     return u.result;
  1256. #else
  1257. #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
  1258.     croak("Unknown BYTEORDER\n");
  1259. #else
  1260.     register I32 o;
  1261.     register I32 s;
  1262.  
  1263.     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
  1264.     u.c[o & 0xf] = (l >> s) & 255;
  1265.     }
  1266.     return u.result;
  1267. #endif
  1268. #endif
  1269. }
  1270.  
  1271. long
  1272. #ifndef CAN_PROTOTYPE
  1273. my_ntohl(l)
  1274. register long l;
  1275. #else
  1276. my_ntohl(long l)
  1277. #endif
  1278. {
  1279.     union {
  1280.     long l;
  1281.     char c[sizeof(long)];
  1282.     } u;
  1283.  
  1284. #if BYTEORDER == 0x1234
  1285.     u.c[0] = (l >> 24) & 255;
  1286.     u.c[1] = (l >> 16) & 255;
  1287.     u.c[2] = (l >> 8) & 255;
  1288.     u.c[3] = l & 255;
  1289.     return u.l;
  1290. #else
  1291. #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
  1292.     croak("Unknown BYTEORDER\n");
  1293. #else
  1294.     register I32 o;
  1295.     register I32 s;
  1296.  
  1297.     u.l = l;
  1298.     l = 0;
  1299.     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
  1300.     l |= (u.c[o & 0xf] & 255) << s;
  1301.     }
  1302.     return l;
  1303. #endif
  1304. #endif
  1305. }
  1306.  
  1307. #endif /* BYTEORDER != 0x4321 */
  1308. #endif /* MYSWAP */
  1309.  
  1310. /*
  1311.  * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
  1312.  * If these functions are defined,
  1313.  * the BYTEORDER is neither 0x1234 nor 0x4321.
  1314.  * However, this is not assumed.
  1315.  * -DWS
  1316.  */
  1317.  
  1318. #define HTOV(name,type)                        \
  1319.     type                            \
  1320.     name (n)                        \
  1321.     register type n;                    \
  1322.     {                            \
  1323.         union {                        \
  1324.         type value;                    \
  1325.         char c[sizeof(type)];                \
  1326.         } u;                        \
  1327.         register I32 i;                    \
  1328.         register I32 s;                    \
  1329.         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1330.         u.c[i] = (n >> s) & 0xFF;            \
  1331.         }                            \
  1332.         return u.value;                    \
  1333.     }
  1334.  
  1335. #define VTOH(name,type)                        \
  1336.     type                            \
  1337.     name (n)                        \
  1338.     register type n;                    \
  1339.     {                            \
  1340.         union {                        \
  1341.         type value;                    \
  1342.         char c[sizeof(type)];                \
  1343.         } u;                        \
  1344.         register I32 i;                    \
  1345.         register I32 s;                    \
  1346.         u.value = n;                    \
  1347.         n = 0;                        \
  1348.         for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {    \
  1349.         n += (u.c[i] & 0xFF) << s;            \
  1350.         }                            \
  1351.         return n;                        \
  1352.     }
  1353.  
  1354. #if defined(HAS_HTOVS) && !defined(htovs)
  1355. HTOV(htovs,short)
  1356. #endif
  1357. #if defined(HAS_HTOVL) && !defined(htovl)
  1358. HTOV(htovl,long)
  1359. #endif
  1360. #if defined(HAS_VTOHS) && !defined(vtohs)
  1361. VTOH(vtohs,short)
  1362. #endif
  1363. #if defined(HAS_VTOHL) && !defined(vtohl)
  1364. VTOH(vtohl,long)
  1365. #endif
  1366.  
  1367. #if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in
  1368.                        VMS.c, same with OS/2. */
  1369. FILE *
  1370. my_popen(cmd,mode)
  1371. char    *cmd;
  1372. char    *mode;
  1373. {
  1374.     int p[2];
  1375.     register I32 this, that;
  1376.     register I32 pid;
  1377.     SV *sv;
  1378.     I32 doexec = strNE(cmd,"-");
  1379.  
  1380.     if (pipe(p) < 0)
  1381.     return Nullfp;
  1382.     this = (*mode == 'w');
  1383.     that = !this;
  1384.     if (tainting) {
  1385.     if (doexec) {
  1386.         taint_env();
  1387.         taint_proper("Insecure %s%s", "EXEC");
  1388.     }
  1389.     }
  1390.     while ((pid = (doexec?vfork():fork())) < 0) {
  1391.     if (errno != EAGAIN) {
  1392.         close(p[this]);
  1393.         if (!doexec)
  1394.         croak("Can't fork");
  1395.         return Nullfp;
  1396.     }
  1397.     sleep(5);
  1398.     }
  1399.     if (pid == 0) {
  1400.     GV* tmpgv;
  1401.  
  1402. #define THIS that
  1403. #define THAT this
  1404.     close(p[THAT]);
  1405.     if (p[THIS] != (*mode == 'r')) {
  1406.         dup2(p[THIS], *mode == 'r');
  1407.         close(p[THIS]);
  1408.     }
  1409.     if (doexec) {
  1410. #if !defined(HAS_FCNTL) || !defined(F_SETFD)
  1411.         int fd;
  1412.  
  1413. #ifndef NOFILE
  1414. #define NOFILE 20
  1415. #endif
  1416.         for (fd = maxsysfd + 1; fd < NOFILE; fd++)
  1417.         close(fd);
  1418. #endif
  1419.         do_exec(cmd);    /* may or may not use the shell */
  1420.         _exit(1);
  1421.     }
  1422.     /*SUPPRESS 560*/
  1423.     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
  1424.         sv_setiv(GvSV(tmpgv),(I32)getpid());
  1425.     forkprocess = 0;
  1426.     hv_clear(pidstatus);    /* we have no children */
  1427.     return Nullfp;
  1428. #undef THIS
  1429. #undef THAT
  1430.     }
  1431.     do_execfree();    /* free any memory malloced by child on vfork */
  1432.     close(p[that]);
  1433.     if (p[that] < p[this]) {
  1434.     dup2(p[this], p[that]);
  1435.     close(p[this]);
  1436.     p[this] = p[that];
  1437.     }
  1438.     sv = *av_fetch(fdpid,p[this],TRUE);
  1439.     (void)SvUPGRADE(sv,SVt_IV);
  1440.     SvIVX(sv) = pid;
  1441.     forkprocess = pid;
  1442.     return fdopen(p[this], mode);
  1443. }
  1444. #else
  1445. #if defined(atarist)
  1446. FILE *popen();
  1447. FILE *
  1448. my_popen(cmd,mode)
  1449. char    *cmd;
  1450. char    *mode;
  1451. {
  1452.     return popen(cmd, mode);
  1453. }
  1454. #endif
  1455.  
  1456. #endif /* !DOSISH */
  1457.  
  1458. #ifdef DUMP_FDS
  1459. dump_fds(s)
  1460. char *s;
  1461. {
  1462.     int fd;
  1463.     struct stat tmpstatbuf;
  1464.  
  1465.     fprintf(stderr,"%s", s);
  1466.     for (fd = 0; fd < 32; fd++) {
  1467.     if (Fstat(fd,&tmpstatbuf) >= 0)
  1468.         fprintf(stderr," %d",fd);
  1469.     }
  1470.     fprintf(stderr,"\n");
  1471. }
  1472. #endif
  1473.  
  1474. #ifndef HAS_DUP2
  1475. int
  1476. dup2(oldfd,newfd)
  1477. int oldfd;
  1478. int newfd;
  1479. {
  1480. #if defined(HAS_FCNTL) && defined(F_DUPFD)
  1481.     if (oldfd == newfd)
  1482.     return oldfd;
  1483.     close(newfd);
  1484.     return fcntl(oldfd, F_DUPFD, newfd);
  1485. #else
  1486.     int fdtmp[256];
  1487.     I32 fdx = 0;
  1488.     int fd;
  1489.  
  1490.     if (oldfd == newfd)
  1491.     return oldfd;
  1492.     close(newfd);
  1493.     while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
  1494.     fdtmp[fdx++] = fd;
  1495.     while (fdx > 0)
  1496.     close(fdtmp[--fdx]);
  1497.     return fd;
  1498. #endif
  1499. }
  1500. #endif
  1501.  
  1502. #if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
  1503. I32
  1504. my_pclose(ptr)
  1505. FILE *ptr;
  1506. {
  1507.     Signal_t (*hstat)(), (*istat)(), (*qstat)();
  1508.     int status;
  1509.     SV **svp;
  1510.     int pid;
  1511.  
  1512.     svp = av_fetch(fdpid,fileno(ptr),TRUE);
  1513.     pid = (int)SvIVX(*svp);
  1514.     SvREFCNT_dec(*svp);
  1515.     *svp = &sv_undef;
  1516.     fclose(ptr);
  1517. #ifdef UTS
  1518.     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
  1519. #endif
  1520.     hstat = signal(SIGHUP, SIG_IGN);
  1521.     istat = signal(SIGINT, SIG_IGN);
  1522.     qstat = signal(SIGQUIT, SIG_IGN);
  1523.     do {
  1524.     pid = wait4pid(pid, &status, 0);
  1525.     } while (pid == -1 && errno == EINTR);
  1526.     signal(SIGHUP, hstat);
  1527.     signal(SIGINT, istat);
  1528.     signal(SIGQUIT, qstat);
  1529.     return(pid < 0 ? pid : status);
  1530. }
  1531. #endif /* !DOSISH */
  1532.  
  1533. #if  !defined(DOSISH) || defined(OS2)
  1534. I32
  1535. wait4pid(pid,statusp,flags)
  1536. int pid;
  1537. int *statusp;
  1538. int flags;
  1539. {
  1540.     SV *sv;
  1541.     SV** svp;
  1542.     char spid[16];
  1543.  
  1544.     if (!pid)
  1545.     return -1;
  1546.     if (pid > 0) {
  1547.     sprintf(spid, "%d", pid);
  1548.     svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
  1549.     if (svp && *svp != &sv_undef) {
  1550.         *statusp = SvIVX(*svp);
  1551.         (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
  1552.         return pid;
  1553.     }
  1554.     }
  1555.     else {
  1556.     HE *entry;
  1557.  
  1558.     hv_iterinit(pidstatus);
  1559.     if (entry = hv_iternext(pidstatus)) {
  1560.         pid = atoi(hv_iterkey(entry,(I32*)statusp));
  1561.         sv = hv_iterval(pidstatus,entry);
  1562.         *statusp = SvIVX(sv);
  1563.         sprintf(spid, "%d", pid);
  1564.         (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
  1565.         return pid;
  1566.     }
  1567.     }
  1568. #ifdef HAS_WAITPID
  1569.     return waitpid(pid,statusp,flags);
  1570. #else
  1571. #ifdef HAS_WAIT4
  1572.     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
  1573. #else
  1574.     {
  1575.     I32 result;
  1576.     if (flags)
  1577.         croak("Can't do waitpid with flags");
  1578.     else {
  1579.         while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
  1580.         pidgone(result,*statusp);
  1581.         if (result < 0)
  1582.         *statusp = -1;
  1583.     }
  1584.     return result;
  1585.     }
  1586. #endif
  1587. #endif
  1588. }
  1589. #endif /* !DOSISH */
  1590.  
  1591. void
  1592. /*SUPPRESS 590*/
  1593. pidgone(pid,status)
  1594. int pid;
  1595. int status;
  1596. {
  1597.     register SV *sv;
  1598.     char spid[16];
  1599.  
  1600.     sprintf(spid, "%d", pid);
  1601.     sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
  1602.     (void)SvUPGRADE(sv,SVt_IV);
  1603.     SvIVX(sv) = status;
  1604.     return;
  1605. }
  1606.  
  1607. #if defined(atarist) || defined(OS2)
  1608. int pclose();
  1609. I32
  1610. my_pclose(ptr)
  1611. FILE *ptr;
  1612. {
  1613.     return pclose(ptr);
  1614. }
  1615. #endif
  1616.  
  1617. void
  1618. repeatcpy(to,from,len,count)
  1619. register char *to;
  1620. register char *from;
  1621. I32 len;
  1622. register I32 count;
  1623. {
  1624.     register I32 todo;
  1625.     register char *frombase = from;
  1626.  
  1627.     if (len == 1) {
  1628.     todo = *from;
  1629.     while (count-- > 0)
  1630.         *to++ = todo;
  1631.     return;
  1632.     }
  1633.     while (count-- > 0) {
  1634.     for (todo = len; todo > 0; todo--) {
  1635.         *to++ = *from++;
  1636.     }
  1637.     from = frombase;
  1638.     }
  1639. }
  1640.  
  1641. #ifndef CASTNEGFLOAT
  1642. U32
  1643. cast_ulong(f)
  1644. double f;
  1645. {
  1646.     long along;
  1647.  
  1648. #if CASTFLAGS & 2
  1649. #   define BIGDOUBLE 2147483648.0
  1650.     if (f >= BIGDOUBLE)
  1651.     return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
  1652. #endif
  1653.     if (f >= 0.0)
  1654.     return (unsigned long)f;
  1655.     along = (long)f;
  1656.     return (unsigned long)along;
  1657. }
  1658. # undef BIGDOUBLE
  1659. #endif
  1660.  
  1661. #ifndef CASTI32
  1662.  
  1663. /* Look for MAX and MIN integral values.  If we can't find them,
  1664.    we'll use 32-bit two's complement defaults.
  1665. */
  1666. #ifndef LONG_MAX
  1667. #  ifdef MAXLONG    /* Often used in <values.h> */
  1668. #    define LONG_MAX MAXLONG
  1669. #  else
  1670. #    define LONG_MAX        2147483647L
  1671. #  endif
  1672. #endif
  1673.  
  1674. #ifndef LONG_MIN
  1675. #    define LONG_MIN        (-LONG_MAX - 1)
  1676. #endif
  1677.  
  1678. #ifndef ULONG_MAX
  1679. #  ifdef MAXULONG 
  1680. #    define LONG_MAX MAXULONG
  1681. #  else
  1682. #    define ULONG_MAX       4294967295L
  1683. #  endif
  1684. #endif
  1685.  
  1686. /* Unfortunately, on some systems the cast_uv() function doesn't
  1687.    work with the system-supplied definition of ULONG_MAX.  The
  1688.    comparison  (f >= ULONG_MAX) always comes out true.  It must be a
  1689.    problem with the compiler constant folding.
  1690.  
  1691.    In any case, this workaround should be fine on any two's complement
  1692.    system.  If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
  1693.    ccflags.
  1694.            --Andy Dougherty      <doughera@lafcol.lafayette.edu>
  1695. */
  1696. #ifndef MY_ULONG_MAX
  1697. #  define MY_ULONG_MAX ((UV)LONG_MAX * (UV)2 + (UV)1)
  1698. #endif
  1699.  
  1700. I32
  1701. cast_i32(f)
  1702. double f;
  1703. {
  1704.     if (f >= LONG_MAX)
  1705.     return (I32) LONG_MAX;
  1706.     if (f <= LONG_MIN)
  1707.     return (I32) LONG_MIN;
  1708.     return (I32) f;
  1709. }
  1710.  
  1711. IV
  1712. cast_iv(f)
  1713. double f;
  1714. {
  1715.     if (f >= LONG_MAX)
  1716.     return (IV) LONG_MAX;
  1717.     if (f <= LONG_MIN)
  1718.     return (IV) LONG_MIN;
  1719.     return (IV) f;
  1720. }
  1721.  
  1722. UV
  1723. cast_uv(f)
  1724. double f;
  1725. {
  1726.     if (f >= MY_ULONG_MAX)
  1727.     return (UV) MY_ULONG_MAX;
  1728.     return (UV) f;
  1729. }
  1730.  
  1731. #endif
  1732.  
  1733. #ifndef HAS_RENAME
  1734. I32
  1735. same_dirent(a,b)
  1736. char *a;
  1737. char *b;
  1738. {
  1739.     char *fa = strrchr(a,'/');
  1740.     char *fb = strrchr(b,'/');
  1741.     struct stat tmpstatbuf1;
  1742.     struct stat tmpstatbuf2;
  1743. #ifndef MAXPATHLEN
  1744. #define MAXPATHLEN 1024
  1745. #endif
  1746.     char tmpbuf[MAXPATHLEN+1];
  1747.  
  1748.     if (fa)
  1749.     fa++;
  1750.     else
  1751.     fa = a;
  1752.     if (fb)
  1753.     fb++;
  1754.     else
  1755.     fb = b;
  1756.     if (strNE(a,b))
  1757.     return FALSE;
  1758.     if (fa == a)
  1759.     strcpy(tmpbuf,".");
  1760.     else
  1761.     strncpy(tmpbuf, a, fa - a);
  1762.     if (Stat(tmpbuf, &tmpstatbuf1) < 0)
  1763.     return FALSE;
  1764.     if (fb == b)
  1765.     strcpy(tmpbuf,".");
  1766.     else
  1767.     strncpy(tmpbuf, b, fb - b);
  1768.     if (Stat(tmpbuf, &tmpstatbuf2) < 0)
  1769.     return FALSE;
  1770.     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
  1771.        tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
  1772. }
  1773. #endif /* !HAS_RENAME */
  1774.  
  1775. unsigned long
  1776. scan_oct(start, len, retlen)
  1777. char *start;
  1778. I32 len;
  1779. I32 *retlen;
  1780. {
  1781.     register char *s = start;
  1782.     register unsigned long retval = 0;
  1783.  
  1784.     while (len && *s >= '0' && *s <= '7') {
  1785.     retval <<= 3;
  1786.     retval |= *s++ - '0';
  1787.     len--;
  1788.     }
  1789.     if (dowarn && len && (*s == '8' || *s == '9'))
  1790.     warn("Illegal octal digit ignored");
  1791.     *retlen = s - start;
  1792.     return retval;
  1793. }
  1794.  
  1795. unsigned long
  1796. scan_hex(start, len, retlen)
  1797. char *start;
  1798. I32 len;
  1799. I32 *retlen;
  1800. {
  1801.     register char *s = start;
  1802.     register unsigned long retval = 0;
  1803.     char *tmp;
  1804.  
  1805.     while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
  1806.     retval <<= 4;
  1807.     retval |= (tmp - hexdigit) & 15;
  1808.     s++;
  1809.     }
  1810.     *retlen = s - start;
  1811.     return retval;
  1812. }
  1813.