This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
msgrcv: properly downgrade the receive buffer
[perl5.git] / malloc.c
index 13a2f9f..01e84bf 100644 (file)
--- a/malloc.c
+++ b/malloc.c
 #define MIN_BUC_POW2 (sizeof(void*) > 4 ? 3 : 2) /* Allow for 4-byte arena. */
 #define MIN_BUCKET (MIN_BUC_POW2 * BUCKETS_PER_POW2)
 
-#if !(defined(I286) || defined(atarist))
-       /* take 2k unless the block is bigger than that */
-#  define LOG_OF_MIN_ARENA 11
-#else
-       /* take 16k unless the block is bigger than that 
-          (80286s like large segments!), probably good on the atari too */
-#  define LOG_OF_MIN_ARENA 14
-#endif
+#define LOG_OF_MIN_ARENA 11
 
 #if defined(DEBUGGING) && !defined(NO_RCHECK)
 #  define RCHECK
 #     define PERL_MAYBE_ALIVE  1
 #endif
 
+#ifndef MYMALLOC
+#  error "MYMALLOC is not defined"
+#endif
+
 #ifndef MUTEX_LOCK
 #  define MUTEX_LOCK(l)
 #endif 
  */
 #define u_short unsigned short
 
-/* 286 and atarist like big chunks, which gives too much overhead. */
-#if (defined(RCHECK) || defined(I286) || defined(atarist)) && defined(PACK_MALLOC)
+#if defined(RCHECK) && defined(PACK_MALLOC)
 #  undef PACK_MALLOC
 #endif 
 
@@ -470,12 +466,12 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
   };
 #  define BUCKET_SIZE_NO_SURPLUS(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT)))
 #  define BUCKET_SIZE_REAL(i) ((i) <= MAX_BUCKET_BY_TABLE              \
-                              ? buck_size[i]                           \
-                              : ((1 << ((i) >> BUCKET_POW2_SHIFT))     \
+                              ? ((size_t)buck_size[i])                 \
+                              : ((((size_t)1) << ((i) >> BUCKET_POW2_SHIFT)) \
                                  - MEM_OVERHEAD(i)                     \
                                  + POW2_OPTIMIZE_SURPLUS(i)))
 #else
-#  define BUCKET_SIZE_NO_SURPLUS(i) (1 << ((i) >> BUCKET_POW2_SHIFT))
+#  define BUCKET_SIZE_NO_SURPLUS(i) (((size_t)1) << ((i) >> BUCKET_POW2_SHIFT))
 #  define BUCKET_SIZE(i) (BUCKET_SIZE_NO_SURPLUS(i) + POW2_OPTIMIZE_SURPLUS(i))
 #  define BUCKET_SIZE_REAL(i) (BUCKET_SIZE(i) - MEM_OVERHEAD(i))
 #endif 
@@ -600,7 +596,7 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
 #  define MAX_PACKED_POW2 6
 #  define MAX_PACKED (MAX_PACKED_POW2 * BUCKETS_PER_POW2 + BUCKET_POW2_SHIFT)
 #  define MAX_POW2_ALGO ((1<<(MAX_PACKED_POW2 + 1)) - M_OVERHEAD)
-#  define TWOK_MASK ((1<<LOG_OF_MIN_ARENA) - 1)
+#  define TWOK_MASK nBIT_MASK(LOG_OF_MIN_ARENA)
 #  define TWOK_MASKED(x) (PTR2UV(x) & ~TWOK_MASK)
 #  define TWOK_SHIFT(x) (PTR2UV(x) & TWOK_MASK)
 #  define OV_INDEXp(block) (INT2PTR(u_char*,TWOK_MASKED(block)))
@@ -622,7 +618,7 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] =
 #ifdef IGNORE_SMALL_BAD_FREE
 #define FIRST_BUCKET_WITH_CHECK (6 * BUCKETS_PER_POW2) /* 64 */
 #  define N_BLKS(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK          \
-                        ? ((1<<LOG_OF_MIN_ARENA) - 1)/BUCKET_SIZE_NO_SURPLUS(bucket) \
+                        ? nBIT_MASK(LOG_OF_MIN_ARENA)/BUCKET_SIZE_NO_SURPLUS(bucket) \
                         : n_blks[bucket] )
 #else
 #  define N_BLKS(bucket) n_blks[bucket]
@@ -690,7 +686,7 @@ static const u_short blk_shift[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] =
 
 #ifdef PACK_MALLOC
 #  define MEM_OVERHEAD(bucket) \
-  (bucket <= MAX_PACKED ? 0 : M_OVERHEAD)
+  (bucket <= MAX_PACKED ? ((size_t)0) : M_OVERHEAD)
 #  ifdef SMALL_BUCKET_VIA_TABLE
 #    define START_SHIFTS_BUCKET ((MAX_PACKED_POW2 + 1) * BUCKETS_PER_POW2)
 #    define START_SHIFT MAX_PACKED_POW2
@@ -756,23 +752,14 @@ static const char bucket_of[] =
 #  define POW2_OPTIMIZE_ADJUST(nbytes)                         \
    ((nbytes >= FIRST_BIG_BOUND) ? nbytes -= PERL_PAGESIZE : 0)
 #  define POW2_OPTIMIZE_SURPLUS(bucket)                                \
-   ((bucket >= FIRST_BIG_POW2 * BUCKETS_PER_POW2) ? PERL_PAGESIZE : 0)
+   ((size_t)((bucket >= FIRST_BIG_POW2 * BUCKETS_PER_POW2) ? PERL_PAGESIZE : 0))
 
 #else  /* !TWO_POT_OPTIMIZE */
 #  define POW2_OPTIMIZE_ADJUST(nbytes)
-#  define POW2_OPTIMIZE_SURPLUS(bucket) 0
+#  define POW2_OPTIMIZE_SURPLUS(bucket) ((size_t)0)
 #endif /* !TWO_POT_OPTIMIZE */
 
-#ifdef HAS_64K_LIMIT
-#  define BARK_64K_LIMIT(what,nbytes,size)                             \
-       if (nbytes > 0xffff) {                                          \
-               PerlIO_printf(PerlIO_stderr(),                          \
-                             "%s too large: %lx\n", what, size);       \
-               my_exit(1);                                             \
-       }
-#else /* !HAS_64K_LIMIT */
-#  define BARK_64K_LIMIT(what,nbytes,size)
-#endif /* !HAS_64K_LIMIT */
+#define BARK_64K_LIMIT(what,nbytes,size)
 
 #ifndef MIN_SBRK
 #  define MIN_SBRK 2048
@@ -795,7 +782,7 @@ static const char bucket_of[] =
 #  define SBRK_FAILURE_PRICE 50
 #endif 
 
-static void    morecore        (register int bucket);
+static void    morecore        (int bucket);
 #  if defined(DEBUGGING)
 static void    botch           (const char *diag, const char *s, const char *file, int line);
 #  endif
@@ -835,32 +822,14 @@ static    union overhead *nextf[NBUCKETS];
 #ifdef USE_PERL_SBRK
 # define sbrk(a) Perl_sbrk(a)
 Malloc_t Perl_sbrk (int size);
-#else
-# ifndef HAS_SBRK_PROTO /* <unistd.h> usually takes care of this */
+#elif !defined(HAS_SBRK_PROTO) /* <unistd.h> usually takes care of this */
 extern Malloc_t sbrk(int);
-# endif
 #endif
 
 #ifndef MIN_SBRK_FRAC1000      /* Backward compatibility */
 #  define MIN_SBRK_FRAC1000    (MIN_SBRK_FRAC * 10)
 #endif
 
-#ifndef START_EXTERN_C
-#  ifdef __cplusplus
-#    define START_EXTERN_C     extern "C" {
-#  else
-#    define START_EXTERN_C
-#  endif
-#endif
-
-#ifndef END_EXTERN_C
-#  ifdef __cplusplus
-#    define END_EXTERN_C               };
-#  else
-#    define END_EXTERN_C
-#  endif
-#endif
-
 #include "malloc_ctl.h"
 
 #ifndef NO_MALLOC_DYNAMIC_CFG
@@ -1012,27 +981,9 @@ get_emergency_buffer(IV *size)
     return pv;
 }
 
-/* Returns 0 on success, -1 on bad alignment, -2 if not implemented */
-int
-set_emergency_buffer(char *b, IV size)
-{
-    if (PTR2UV(b) & (NEEDED_ALIGNMENT - 1))
-       return -1;
-    if (MallocCfg[MallocCfg_emergency_buffer_prepared_size])
-       add_to_chain((void*)emergency_buffer_prepared,
-                    MallocCfg[MallocCfg_emergency_buffer_prepared_size], 0);
-    emergency_buffer_prepared = b;
-    MallocCfg[MallocCfg_emergency_buffer_prepared_size] = size;
-    return 0;
-}
 #    define GET_EMERGENCY_BUFFER(p)    get_emergency_buffer(p)
 #  else                /* NO_MALLOC_DYNAMIC_CFG */
 #    define GET_EMERGENCY_BUFFER(p)    NULL
-int
-set_emergency_buffer(char *b, IV size)
-{
-    return -1;
-}
 #  endif
 
 static Malloc_t
@@ -1046,7 +997,9 @@ emergency_sbrk(MEM_SIZE size)
        /* Give the possibility to recover, but avoid an infinite cycle. */
        MALLOC_UNLOCK;
        emergency_buffer_last_req = size;
-       emergency_sbrk_croak("Out of memory during \"large\" request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
+       emergency_sbrk_croak("Out of memory during \"large\" request for %" UVuf
+                             " bytes, total sbrk() is %" UVuf " bytes",
+                             (UV)size, (UV)(goodsbrk + sbrk_slack));
     }
 
     if ((MEM_SIZE)emergency_buffer_size >= rsize) {
@@ -1090,8 +1043,10 @@ emergency_sbrk(MEM_SIZE size)
     }
   do_croak:
     MALLOC_UNLOCK;
-    emergency_sbrk_croak("Out of memory during request for %"UVuf" bytes, total sbrk() is %"UVuf" bytes", (UV)size, (UV)(goodsbrk + sbrk_slack));
-    assert(0); /* NOTREACHED */
+    emergency_sbrk_croak("Out of memory during request for %" UVuf
+                         " bytes, total sbrk() is %" UVuf " bytes",
+                         (UV)size, (UV)(goodsbrk + sbrk_slack));
+    NOT_REACHED; /* NOTREACHED */
     return NULL;
 }
 
@@ -1099,11 +1054,8 @@ emergency_sbrk(MEM_SIZE size)
 #  define emergency_sbrk(size) -1
 #endif /* defined PERL_EMERGENCY_SBRK */
 
-static void
-write2(const char *mess)
-{
-  write(2, mess, strlen(mess));
-}
+/* Don't use PerlIO buffered writes as they allocate memory. */
+#define MYMALLOC_WRITE2STDERR(s) PERL_UNUSED_RESULT(PerlLIO_write(PerlIO_fileno(PerlIO_stderr()),s,strlen(s)))
 
 #ifdef DEBUGGING
 #undef ASSERT
@@ -1112,7 +1064,6 @@ write2(const char *mess)
 static void
 botch(const char *diag, const char *s, const char *file, int line)
 {
-    dVAR;
     dTHX;
     if (!(PERL_MAYBE_ALIVE && PERL_GET_THX))
        goto do_write;
@@ -1121,13 +1072,13 @@ botch(const char *diag, const char *s, const char *file, int line)
                          "assertion botched (%s?): %s %s:%d\n",
                          diag, s, file, line) != 0) {
         do_write:              /* Can be initializing interpreter */
-           write2("assertion botched (");
-           write2(diag);
-           write2("?): ");
-           write2(s);
-           write2(" (");
-           write2(file);
-           write2(":");
+           MYMALLOC_WRITE2STDERR("assertion botched (");
+           MYMALLOC_WRITE2STDERR(diag);
+           MYMALLOC_WRITE2STDERR("?): ");
+           MYMALLOC_WRITE2STDERR(s);
+           MYMALLOC_WRITE2STDERR(" (");
+           MYMALLOC_WRITE2STDERR(file);
+           MYMALLOC_WRITE2STDERR(":");
            {
              char linebuf[10];
              char *s = linebuf + sizeof(linebuf) - 1;
@@ -1136,9 +1087,9 @@ botch(const char *diag, const char *s, const char *file, int line)
              do {
                *--s = '0' + (n % 10);
              } while (n /= 10);
-             write2(s);
+             MYMALLOC_WRITE2STDERR(s);
            }
-           write2(")\n");
+           MYMALLOC_WRITE2STDERR(")\n");
        }
        PerlProc_abort();
     }
@@ -1223,12 +1174,16 @@ cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill)
 #  define FILLCHECK_DEADBEEF(s, n)     ((void)0)
 #endif
 
-int
-S_ajust_size_and_find_bucket(size_t *nbytes_p)
+STATIC int
+S_adjust_size_and_find_bucket(size_t *nbytes_p)
 {
-       MEM_SIZE shiftr;
+       MEM_SIZE shiftr;
        int bucket;
-       size_t nbytes = *nbytes_p;
+       size_t nbytes;
+
+       PERL_ARGS_ASSERT_ADJUST_SIZE_AND_FIND_BUCKET;
+
+       nbytes = *nbytes_p;
 
        /*
         * Convert amount of memory requested into
@@ -1267,24 +1222,44 @@ S_ajust_size_and_find_bucket(size_t *nbytes_p)
        return bucket;
 }
 
+/*
+These have the same interfaces as the C lib ones, so are considered documented
+
+=for apidoc malloc
+=for apidoc calloc
+=for apidoc realloc
+=cut
+*/
+
 Malloc_t
 Perl_malloc(size_t nbytes)
 {
-        dVAR;
-       register union overhead *p;
-       register int bucket;
-
+       union overhead *p;
+       int bucket;
 #if defined(DEBUGGING) || defined(RCHECK)
        MEM_SIZE size = nbytes;
 #endif
 
+        /* A structure that has more than PTRDIFF_MAX bytes is unfortunately
+         * legal in C, but in such, if two elements are far enough apart, we
+         * can't legally find out how far apart they are.  Limit the size of a
+         * malloc so that pointer subtraction in the same structure is always
+         * well defined */
+        if (nbytes > PTRDIFF_MAX) {
+            dTHX;
+            MYMALLOC_WRITE2STDERR("Memory requests are limited to PTRDIFF_MAX"
+                                  " bytes to prevent possible undefined"
+                                  " behavior");
+            return NULL;
+        }
+
        BARK_64K_LIMIT("Allocation",nbytes,nbytes);
 #ifdef DEBUGGING
        if ((long)nbytes < 0)
            croak("%s", "panic: malloc");
 #endif
 
-       bucket = S_ajust_size_and_find_bucket(&nbytes);
+       bucket = adjust_size_and_find_bucket(&nbytes);
        MALLOC_LOCK;
        /*
         * If nothing in hash bucket right now,
@@ -1298,14 +1273,14 @@ Perl_malloc(size_t nbytes)
                    dTHX;
                    if (!PL_nomemok) {
 #if defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC)
-                       PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
+                       MYMALLOC_WRITE2STDERR("Out of memory!\n");
 #else
                        char buff[80];
                        char *eb = buff + sizeof(buff) - 1;
                        char *s = eb;
                        size_t n = nbytes;
 
-                       PerlIO_puts(PerlIO_stderr(),"Out of memory during request for ");
+                       MYMALLOC_WRITE2STDERR("Out of memory during request for ");
 #if defined(DEBUGGING) || defined(RCHECK)
                        n = size;
 #endif
@@ -1313,15 +1288,15 @@ Perl_malloc(size_t nbytes)
                        do {
                            *--s = '0' + (n % 10);
                        } while (n /= 10);
-                       PerlIO_puts(PerlIO_stderr(),s);
-                       PerlIO_puts(PerlIO_stderr()," bytes, total sbrk() is ");
+                       MYMALLOC_WRITE2STDERR(s);
+                       MYMALLOC_WRITE2STDERR(" bytes, total sbrk() is ");
                        s = eb;
                        n = goodsbrk + sbrk_slack;
                        do {
                            *--s = '0' + (n % 10);
                        } while (n /= 10);
-                       PerlIO_puts(PerlIO_stderr(),s);
-                       PerlIO_puts(PerlIO_stderr()," bytes!\n");
+                       MYMALLOC_WRITE2STDERR(s);
+                       MYMALLOC_WRITE2STDERR(" bytes!\n");
 #endif /* defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) */
                        my_exit(1);
                    }
@@ -1336,7 +1311,7 @@ Perl_malloc(size_t nbytes)
             || (p && PTR2UV(p) < (1<<LOG_OF_MIN_ARENA)) ) {
            dTHX;
            PerlIO_printf(PerlIO_stderr(),
-                         "Unaligned pointer in the free chain 0x%"UVxf"\n",
+                         "Unaligned pointer in the free chain 0x%" UVxf "\n",
                          PTR2UV(p));
        }
        if ( (PTR2UV(p->ov_next) & (MEM_ALIGNBYTES - 1))
@@ -1344,7 +1319,7 @@ Perl_malloc(size_t nbytes)
            dTHX;
            PerlIO_printf(PerlIO_stderr(),
                          "Unaligned \"next\" pointer in the free "
-                         "chain 0x%"UVxf" at 0x%"UVxf"\n",
+                         "chain 0x%" UVxf " at 0x%" UVxf "\n",
                          PTR2UV(p->ov_next), PTR2UV(p));
        }
 #endif
@@ -1353,8 +1328,9 @@ Perl_malloc(size_t nbytes)
        MALLOC_UNLOCK;
 
        DEBUG_m(PerlIO_printf(Perl_debug_log,
-                             "0x%"UVxf": (%05lu) malloc %ld bytes\n",
-                             PTR2UV((Malloc_t)(p + CHUNK_SHIFT)), (unsigned long)(PL_an++),
+                             "%p: (%05lu) malloc %ld bytes\n",
+                             (Malloc_t)(p + CHUNK_SHIFT),
+                              (unsigned long)(PL_an++),
                              (long)size));
 
        FILLCHECK_DEADBEEF((unsigned char*)(p + CHUNK_SHIFT),
@@ -1493,7 +1469,6 @@ 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;
@@ -1549,20 +1524,16 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket)
        /* Second, check alignment. */
        slack = 0;
 
-#if !defined(atarist) /* on the atari we dont have to worry about this */
-#  ifndef I286         /* The sbrk(0) call on the I286 always returns the next segment */
        /* WANTED_ALIGNMENT may be more than NEEDED_ALIGNMENT, but this may
           improve performance of memory access. */
        if (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */
            slack = WANTED_ALIGNMENT - (PTR2UV(cp) & (WANTED_ALIGNMENT - 1));
            add += slack;
        }
-#  endif
-#endif /* !atarist */
                
        if (add) {
            DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                                 "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignement,\t%ld were assumed to come from the tail of the previous sbrk\n",
+                                 "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignment,\t%ld were assumed to come from the tail of the previous sbrk\n",
                                  (long)add, (long) slack,
                                  (long) sbrked_remains));
            newcp = (char *)sbrk(add);
@@ -1619,7 +1590,6 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket)
            fatalcroak("Misalignment of sbrk()\n");
        else
 #  endif
-#ifndef I286   /* Again, this should always be ok on an 80286 */
        if (PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)) {
            DEBUG_m(PerlIO_printf(Perl_debug_log, 
                                  "fixing sbrk(): %d bytes off machine alignment\n",
@@ -1632,7 +1602,6 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket)
            sbrk_slack += (1 << (bucket >> BUCKET_POW2_SHIFT));
 # endif
        }
-#endif
        ;                               /* Finish "else" */
        sbrked_remains = require - needed;
        last_op = cp;
@@ -1692,23 +1661,23 @@ getpages_adjacent(MEM_SIZE require)
  * Allocate more memory to the indicated bucket.
  */
 static void
-morecore(register int bucket)
+morecore(int bucket)
 {
-        dVAR;
-       register union overhead *ovp;
-       register int rnu;       /* 2^rnu bytes will be requested */
+       union overhead *ovp;
+       int rnu;       /* 2^rnu bytes will be requested */
        int nblks;              /* become nblks blocks of the desired size */
-       register MEM_SIZE siz, needed;
+       MEM_SIZE siz, needed;
        static int were_called = 0;
 
        if (nextf[bucket])
                return;
 #ifndef NO_PERL_MALLOC_ENV
        if (!were_called) {
-           /* It's the our first time.  Initialize ourselves */
+           /* It's our first time.  Initialize ourselves */
            were_called = 1;    /* Avoid a loop */
            if (!MallocCfg[MallocCfg_skip_cfg_env]) {
-               char *s = getenv("PERL_MALLOC_OPT"), *t = s, *off;
+               char *s = getenv("PERL_MALLOC_OPT"), *t = s;
+                const char *off;
                const char *opts = PERL_MALLOC_OPT_CHARS;
                int changed = 0;
 
@@ -1717,7 +1686,7 @@ morecore(register int bucket)
                    IV val = 0;
 
                    t += 2;
-                   while (*t <= '9' && *t >= '0')
+                   while (isDIGIT(*t))
                        val = 10*val + *t++ - '0';
                    if (!*t || *t == ';') {
                        if (MallocCfg[off - opts] != val)
@@ -1728,9 +1697,10 @@ morecore(register int bucket)
                    }
                }
                if (t && *t) {
-                   write2("Unrecognized part of PERL_MALLOC_OPT: \"");
-                   write2(t);
-                   write2("\"\n");
+                   dTHX;
+                   MYMALLOC_WRITE2STDERR("Unrecognized part of PERL_MALLOC_OPT: \"");
+                   MYMALLOC_WRITE2STDERR(t);
+                   MYMALLOC_WRITE2STDERR("\"\n");
                }
                if (changed)
                    MallocCfg[MallocCfg_cfg_env_read] = 1;
@@ -1829,16 +1799,15 @@ morecore(register int bucket)
 Free_t
 Perl_mfree(Malloc_t where)
 {
-        dVAR;
-       register MEM_SIZE size;
-       register union overhead *ovp;
+       MEM_SIZE size;
+       union overhead *ovp;
        char *cp = (char*)where;
 #ifdef PACK_MALLOC
        u_char bucket;
 #endif 
 
        DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                             "0x%"UVxf": (%05lu) free\n",
+                             "0x%" UVxf ": (%05lu) free\n",
                              PTR2UV(cp), (unsigned long)(PL_an++)));
 
        if (cp == NULL)
@@ -1863,7 +1832,7 @@ Perl_mfree(Malloc_t where)
                if (bad_free_warn == -1) {
                    dTHX;
                    char *pbf = PerlEnv_getenv("PERL_BADFREE");
-                   bad_free_warn = (pbf) ? atoi(pbf) : 1;
+                   bad_free_warn = (pbf) ? strNE("0", pbf) : 1;
                }
                if (!bad_free_warn)
                    return;
@@ -1925,12 +1894,11 @@ Perl_mfree(Malloc_t where)
 Malloc_t
 Perl_realloc(void *mp, size_t nbytes)
 {
-        dVAR;
-       register MEM_SIZE onb;
+       MEM_SIZE onb;
        union overhead *ovp;
        char *res;
        int prev_bucket;
-       register int bucket;
+       int bucket;
        int incr;               /* 1 if does not fit, -1 if "easily" fits in a
                                   smaller bucket, otherwise 0.  */
        char *cp = (char*)mp;
@@ -1961,7 +1929,7 @@ Perl_realloc(void *mp, size_t nbytes)
                if (bad_free_warn == -1) {
                    dTHX;
                    char *pbf = PerlEnv_getenv("PERL_BADFREE");
-                   bad_free_warn = (pbf) ? atoi(pbf) : 1;
+                   bad_free_warn = (pbf) ? strNE("0", pbf) : 1;
                }
                if (!bad_free_warn)
                    return NULL;
@@ -2065,7 +2033,7 @@ Perl_realloc(void *mp, size_t nbytes)
 #endif
                res = cp;
                DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                             "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n",
+                             "0x%" UVxf ": (%05lu) realloc %ld bytes inplace\n",
                              PTR2UV(res),(unsigned long)(PL_an++),
                              (long)size));
        } else if (incr == 1 && (cp - M_OVERHEAD == last_op) 
@@ -2103,7 +2071,7 @@ Perl_realloc(void *mp, size_t nbytes)
        } else {
          hard_way:
            DEBUG_m(PerlIO_printf(Perl_debug_log, 
-                             "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n",
+                             "0x%" UVxf ": (%05lu) realloc %ld bytes the hard way\n",
                              PTR2UV(cp),(unsigned long)(PL_an++),
                              (long)size));
            if ((res = (char*)Perl_malloc(nbytes)) == NULL)
@@ -2116,7 +2084,7 @@ Perl_realloc(void *mp, size_t nbytes)
 }
 
 Malloc_t
-Perl_calloc(register size_t elements, register size_t size)
+Perl_calloc(size_t elements, size_t size)
 {
     long sz = elements * size;
     Malloc_t p = Perl_malloc(sz);
@@ -2189,7 +2157,7 @@ Perl_malloced_size(void *p)
 MEM_SIZE
 Perl_malloc_good_size(size_t wanted)
 {
-    return BUCKET_SIZE_REAL(S_ajust_size_and_find_bucket(&wanted));
+    return BUCKET_SIZE_REAL(adjust_size_and_find_bucket(&wanted));
 }
 
 #  ifdef BUCKETS_ROOT2
@@ -2202,8 +2170,8 @@ int
 Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level)
 {
 #ifdef DEBUGGING_MSTATS
-       register int i, j;
-       register union overhead *p;
+       int i, j;
+       union overhead *p;
        struct chunk_chain_s* nextchain;
 
        PERL_ARGS_ASSERT_GET_MSTATS;
@@ -2264,7 +2232,7 @@ void
 Perl_dump_mstats(pTHX_ const char *s)
 {
 #ifdef DEBUGGING_MSTATS
-       register int i;
+       int i;
        perl_mstats_t buffer;
        UV nf[NBUCKETS];
        UV nt[NBUCKETS];
@@ -2277,18 +2245,20 @@ Perl_dump_mstats(pTHX_ const char *s)
 
        if (s)
            PerlIO_printf(Perl_error_log,
-                         "Memory allocation statistics %s (buckets %"IVdf"(%"IVdf")..%"IVdf"(%"IVdf")\n",
+                         "Memory allocation statistics %s (buckets %" IVdf
+                          "(%" IVdf ")..%" IVdf "(%" IVdf ")\n",
                          s, 
                          (IV)BUCKET_SIZE_REAL(MIN_BUCKET), 
                          (IV)BUCKET_SIZE_NO_SURPLUS(MIN_BUCKET),
                          (IV)BUCKET_SIZE_REAL(buffer.topbucket), 
                          (IV)BUCKET_SIZE_NO_SURPLUS(buffer.topbucket));
-       PerlIO_printf(Perl_error_log, "%8"IVdf" free:", buffer.totfree);
+        PerlIO_printf(Perl_error_log, "%8" IVdf " free:", buffer.totfree);
        for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
                PerlIO_printf(Perl_error_log, 
                              ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
-                              ? " %5"UVuf 
-                              : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)),
+                              ? " %5" UVuf
+                              : ((i < 12*BUCKETS_PER_POW2) ? " %3" UVuf
+                                                            : " %" UVuf)),
                              buffer.nfree[i]);
        }
 #ifdef BUCKETS_ROOT2
@@ -2301,12 +2271,13 @@ Perl_dump_mstats(pTHX_ const char *s)
                              buffer.nfree[i]);
        }
 #endif 
-       PerlIO_printf(Perl_error_log, "\n%8"IVdf" used:", buffer.total - buffer.totfree);
+        PerlIO_printf(Perl_error_log, "\n%8" IVdf " used:",
+                                      buffer.total - buffer.totfree);
        for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) {
                PerlIO_printf(Perl_error_log, 
                              ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2)
-                              ? " %5"IVdf
-                              : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)), 
+                              ? " %5" IVdf
+                              : ((i < 12*BUCKETS_PER_POW2) ? " %3" IVdf : " %" IVdf)),
                              buffer.ntotal[i] - buffer.nfree[i]);
        }
 #ifdef BUCKETS_ROOT2
@@ -2319,7 +2290,9 @@ Perl_dump_mstats(pTHX_ const char *s)
                              buffer.ntotal[i] - buffer.nfree[i]);
        }
 #endif 
-       PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %"IVdf"/%"IVdf":%"IVdf". Odd ends: pad+heads+chain+tail: %"IVdf"+%"IVdf"+%"IVdf"+%"IVdf".\n",
+       PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %" IVdf "/%" IVdf ":%"
+                      IVdf ". Odd ends: pad+heads+chain+tail: %" IVdf "+%"
+                      IVdf "+%" IVdf "+%" IVdf ".\n",
                      buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good,
                      buffer.sbrk_slack, buffer.start_slack,
                      buffer.total_chain, buffer.sbrked_remains);
@@ -2330,7 +2303,7 @@ Perl_dump_mstats(pTHX_ const char *s)
 
 #ifdef USE_PERL_SBRK
 
-#   if defined(NeXT) || defined(__NeXT__) || defined(PURIFY)
+#   if defined(PURIFY)
 #      define PERL_SBRK_VIA_MALLOC
 #   endif
 
@@ -2392,8 +2365,10 @@ Perl_sbrk(int size)
       }
     }
 
-    DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n",
-                   size, reqsize, Perl_sbrk_oldsize, PTR2UV(got)));
+    DEBUG_m(PerlIO_printf(Perl_debug_log,
+            "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"
+            UVxf "\n",
+            size, reqsize, Perl_sbrk_oldsize, PTR2UV(got)));
 
     return (void *)got;
 }
@@ -2401,11 +2376,5 @@ Perl_sbrk(int size)
 #endif /* ! defined USE_PERL_SBRK */
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */