X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=b72a8f2fefada9f2efd2a5561b922ae9cbf3bb0e;hb=dc507217b3331807446df6e7f16977ee2fdc418e;hp=1cab029d6ee636ffcae5f161dbb7d05612b3335a;hpb=2a45baeabe2db1c5939737d9a253ed11845363b6;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index 1cab029..b72a8f2 100644
--- a/util.c
+++ b/util.c
@@ -336,6 +336,37 @@ S_xstat(pTHX_ int flag)
 
 #endif /* LEAKTEST */
 
+/* These must be defined when not using Perl's malloc for binary
+ * compatibility */
+
+#ifndef MYMALLOC
+
+Malloc_t Perl_malloc (MEM_SIZE nbytes)
+{
+    dTHXs;
+    return PerlMem_malloc(nbytes);
+}
+
+Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size)
+{
+    dTHXs;
+    return PerlMem_calloc(elements, size);
+}
+
+Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes)
+{
+    dTHXs;
+    return PerlMem_realloc(where, nbytes);
+}
+
+Free_t   Perl_mfree (Malloc_t where)
+{
+    dTHXs;
+    PerlMem_free(where);
+}
+
+#endif
+
 /* copy a string up to some (non-backslashed) delimiter, if any */
 
 char *
@@ -692,16 +723,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 	  top2:
 	    /*SUPPRESS 560*/
 	    if ((tmp = table[*s])) {
-#ifdef POINTERRIGOR
-		if (bigend - s > tmp) {
-		    s += tmp;
-		    goto top2;
-		}
-		s += tmp;
-#else
 		if ((s += tmp) < bigend)
 		    goto top2;
-#endif
 		goto check_end;
 	    }
 	    else {		/* less expensive than calling strncmp() */
@@ -795,25 +818,6 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
 	if (!(pos += PL_screamnext[pos]))
 	    goto cant_find;
     }
-#ifdef POINTERRIGOR
-    do {
-	if (pos >= stop_pos) break;
-	if (big[pos-previous] != first)
-	    continue;
-	for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
-	    if (*s++ != *x++) {
-		s--;
-		break;
-	    }
-	}
-	if (s == littleend) {
-	    *old_posp = pos;
-	    if (!last) return (char *)(big+pos-previous);
-	    found = 1;
-	}
-    } while ( pos += PL_screamnext[pos] );
-    return (last && found) ? (char *)(big+(*old_posp)-previous) : Nullch;
-#else /* !POINTERRIGOR */
     big -= previous;
     do {
 	if (pos >= stop_pos) break;
@@ -833,7 +837,6 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     } while ( pos += PL_screamnext[pos] );
     if (last && found)
 	return (char *)(big+(*old_posp));
-#endif /* POINTERRIGOR */
   check_tail:
     if (!SvTAIL(littlestr) || (end_shift > 0))
 	return Nullch;
@@ -2051,7 +2054,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     return PerlIO_fdopen(p[This], mode);
 }
 #else
-#if defined(atarist) || defined(DJGPP)
+#if defined(atarist)
 FILE *popen();
 PerlIO *
 Perl_my_popen(pTHX_ char *cmd, char *mode)
@@ -2063,6 +2066,20 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     */
     return PerlIO_importFILE(popen(cmd, mode), 0);
 }
+#else
+#if defined(DJGPP)
+FILE *djgpp_popen();
+PerlIO *
+Perl_my_popen(pTHX_ char *cmd, char *mode)
+{
+    PERL_FLUSHALL_FOR_CHILD;
+    /* Call system's popen() to get a FILE *, then import it.
+       used 0 for 2nd parameter to PerlIO_importFILE;
+       apparently not used
+    */
+    return PerlIO_importFILE(djgpp_popen(cmd, mode), 0);
+}
+#endif
 #endif
 
 #endif /* !DOSISH */
@@ -2367,7 +2384,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status)
     return;
 }
 
-#if defined(atarist) || defined(OS2) || defined(DJGPP)
+#if defined(atarist) || defined(OS2)
 int pclose();
 #ifdef HAS_FORK
 int					/* Cannot prototype with I32
@@ -2381,9 +2398,20 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     /* Needs work for PerlIO ! */
     FILE *f = PerlIO_findFILE(ptr);
     I32 result = pclose(f);
+    PerlIO_releaseFILE(ptr,f);
+    return result;
+}
+#endif
+
 #if defined(DJGPP)
+int djgpp_pclose();
+I32
+Perl_my_pclose(pTHX_ PerlIO *ptr)
+{
+    /* Needs work for PerlIO ! */
+    FILE *f = PerlIO_findFILE(ptr);
+    I32 result = djgpp_pclose(f);
     result = (result << 8) & 0xff00;
-#endif
     PerlIO_releaseFILE(ptr,f);
     return result;
 }
@@ -2823,7 +2851,7 @@ Perl_condpair_magic(pTHX_ SV *sv)
 	    mg->mg_len = sizeof(cp);
 	    UNLOCK_CRED_MUTEX;		/* XXX need separate mutex? */
 	    DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
-					   "%p: condpair_magic %p\n", thr, sv));)
+					   "%p: condpair_magic %p\n", thr, sv)));
 	}
     }
     return mg;
@@ -2850,7 +2878,7 @@ Perl_sv_lock(pTHX_ SV *osv)
 	MgOWNER(mg) = thr;
 	DEBUG_S(PerlIO_printf(Perl_debug_log,
 			      "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
-			      PTR2UV(thr), PTR2UV(sv));)
+			      PTR2UV(thr), PTR2UV(sv)));
 	MUTEX_UNLOCK(MgMUTEXP(mg));
 	SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
     }
@@ -3589,7 +3617,7 @@ return FALSE
         (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
 
 /*
-=for apidoc sv_getcwd
+=for apidoc getcwd_sv
 
 Fill the sv with current working directory
 
@@ -3605,7 +3633,7 @@ Fill the sv with current working directory
  *     back into. */
 
 int
-Perl_sv_getcwd(pTHX_ register SV *sv)
+Perl_getcwd_sv(pTHX_ register SV *sv)
 {
 #ifndef PERL_MICRO