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