Re: several compilation problems on VMS in perl@32039

[perl5.git] / malloc.c

diff --git a/malloc.c b/malloc.c
index 521248a..ce406d2 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1156,17 +1156,16 @@ perl_get_emergency_buffer(IV *size)
     dTHX;
     /* First offense, give a possibility to recover by dieing. */
     /* No malloc involved here: */
-    GV **gvp = (GV**)hv_fetch(PL_defstash, "^M", 2, 0);
     SV *sv;
     char *pv;
-    STRLEN n_a;
+    GV **gvp = (GV**)hv_fetchs(PL_defstash, "^M", FALSE);
 
-    if (!gvp) gvp = (GV**)hv_fetch(PL_defstash, "\015", 1, 0);
+    if (!gvp) gvp = (GV**)hv_fetchs(PL_defstash, "\015", FALSE);
     if (!gvp || !(sv = GvSV(*gvp)) || !SvPOK(sv) 
         || (SvLEN(sv) < (1<<LOG_OF_MIN_ARENA) - M_OVERHEAD))
         return NULL;           /* Now die die die... */
     /* Got it, now detach SvPV: */
-    pv = SvPV(sv, n_a);
+    pv = SvPV_nolen(sv);
     /* Check alignment: */
     if ((PTR2UV(pv) - sizeof(union overhead)) & (NEEDED_ALIGNMENT - 1)) {
         PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
@@ -1174,7 +1173,7 @@ perl_get_emergency_buffer(IV *size)
     }
 
     SvPOK_off(sv);
-    SvPV_set(sv, Nullch);
+    SvPV_set(sv, NULL);
     SvCUR_set(sv, 0);
     SvLEN_set(sv, 0);
     *size = malloced_size(pv) + M_OVERHEAD;
@@ -1250,7 +1249,7 @@ emergency_sbrk(MEM_SIZE size)
        if (emergency_buffer_size) {
            add_to_chain(emergency_buffer, emergency_buffer_size, 0);
            emergency_buffer_size = 0;
-           emergency_buffer = Nullch;
+           emergency_buffer = NULL;
            have = 1;
        }
 
@@ -1277,7 +1276,7 @@ emergency_sbrk(MEM_SIZE size)
     MALLOC_UNLOCK;
     emergency_sbrk_croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
     /* NOTREACHED */
-    return Nullch;
+    return NULL;
 }
 
 #else /*  !defined(PERL_EMERGENCY_SBRK) */
@@ -1292,10 +1291,12 @@ write2(char *mess)
 
 #ifdef DEBUGGING
 #undef ASSERT
-#define        ASSERT(p,diag)   if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__);  else
+#define        ASSERT(p,diag)   if (!(p)) botch(diag,STRINGIFY(p),__FILE__,__LINE__);
+
 static void
 botch(char *diag, char *s, char *file, int line)
 {
+    dVAR;
     if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
        goto do_write;
     else {
@@ -1409,6 +1410,7 @@ cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill)
 Malloc_t
 Perl_malloc(register size_t nbytes)
 {
+        dVAR;
        register union overhead *p;
        register int bucket;
        register MEM_SIZE shiftr;
@@ -1666,6 +1668,7 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size)
 static union overhead *
 getpages(MEM_SIZE needed, int *nblksp, int bucket)
 {
+    dVAR;
     /* Need to do (possibly expensive) system call. Try to
        optimize it for rare calling. */
     MEM_SIZE require = needed - sbrked_remains;
@@ -1866,6 +1869,7 @@ getpages_adjacent(MEM_SIZE require)
 static void
 morecore(register int bucket)
 {
+        dVAR;
        register union overhead *ovp;
        register int rnu;       /* 2^rnu bytes will be requested */
        int nblks;              /* become nblks blocks of the desired size */
@@ -1998,11 +2002,12 @@ morecore(register int bucket)
 }
 
 Free_t
-Perl_mfree(void *mp)
+Perl_mfree(Malloc_t where)
 {
+        dVAR;
        register MEM_SIZE size;
        register union overhead *ovp;
-       char *cp = (char*)mp;
+       char *cp = (char*)where;
 #ifdef PACK_MALLOC
        u_char bucket;
 #endif 
@@ -2104,6 +2109,7 @@ Perl_mfree(void *mp)
 Malloc_t
 Perl_realloc(void *mp, size_t nbytes)
 {
+        dVAR;
        register MEM_SIZE onb;
        union overhead *ovp;
        char *res;
@@ -2142,7 +2148,7 @@ Perl_realloc(void *mp, size_t nbytes)
                    bad_free_warn = (pbf) ? atoi(pbf) : 1;
                }
                if (!bad_free_warn)
-                   return Nullch;
+                   return NULL;
 #ifdef RCHECK
 #ifdef PERL_CORE
                {
@@ -2170,7 +2176,7 @@ Perl_realloc(void *mp, size_t nbytes)
                warn("%s", "Bad realloc() ignored");
 #endif
 #endif
-               return Nullch;                  /* sanity */
+               return NULL;                    /* sanity */
            }
 
        onb = BUCKET_SIZE_REAL(bucket);
@@ -2319,7 +2325,7 @@ Perl_strdup(const char *s)
     MEM_SIZE l = strlen(s);
     char *s1 = (char *)Perl_malloc(l+1);
 
-    return CopyD(s, s1, (MEM_SIZE)(l+1), char);
+    return (char *)CopyD(s, s1, (MEM_SIZE)(l+1), char);
 }
 
 #ifdef PERL_CORE
@@ -2342,7 +2348,7 @@ Perl_putenv(char *a)
   if (l < sizeof(buf))
       var = buf;
   else
-      var = Perl_malloc(l + 1);
+      var = (char *)Perl_malloc(l + 1);
   Copy(a, var, l, char);
   var[l + 1] = 0;
   my_setenv(var, val+1);
@@ -2355,7 +2361,7 @@ Perl_putenv(char *a)
 MEM_SIZE
 Perl_malloced_size(void *p)
 {
-    union overhead *ovp = (union overhead *)
+    union overhead * const ovp = (union overhead *)
        ((caddr_t)p - sizeof (union overhead) * CHUNK_SHIFT);
     const int bucket = OV_INDEX(ovp);
 #ifdef RCHECK