This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XS::Typemap: silence compiler warning.
[perl5.git] / malloc.c
index f658489..79a8c89 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -755,16 +755,7 @@ static const char bucket_of[] =
 #  define POW2_OPTIMIZE_SURPLUS(bucket) 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
@@ -787,7 +778,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
@@ -1091,11 +1082,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) PerlLIO_write(PerlIO_fileno(PerlIO_stderr()),s,strlen(s))
 
 #ifdef DEBUGGING
 #undef ASSERT
@@ -1113,13 +1101,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;
@@ -1128,9 +1116,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();
     }
@@ -1215,12 +1203,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
@@ -1276,7 +1268,7 @@ Perl_malloc(size_t nbytes)
            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,
@@ -1290,14 +1282,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
@@ -1305,15 +1297,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);
                    }
@@ -1678,7 +1670,7 @@ getpages_adjacent(MEM_SIZE require)
  * Allocate more memory to the indicated bucket.
  */
 static void
-morecore(register int bucket)
+morecore(int bucket)
 {
         dVAR;
        union overhead *ovp;
@@ -1714,9 +1706,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;
@@ -2102,7 +2095,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);
@@ -2175,7 +2168,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