X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7c458fae0a6159ea505d310a91a4ffcf379153a2..86ea01eb2de6e15e79ff54031d7fabfb5f628d4e:/malloc.c

diff --git a/malloc.c b/malloc.c
index 98efdb4..69b6b95 100644
--- a/malloc.c
+++ b/malloc.c
@@ -197,14 +197,7 @@
 #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))
-	/* 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
@@ -260,6 +253,10 @@
 #     define PERL_MAYBE_ALIVE	1
 #endif
 
+#ifndef MYMALLOC
+#  error "MYMALLOC is not defined"
+#endif
+
 #ifndef MUTEX_LOCK
 #  define MUTEX_LOCK(l)
 #endif 
@@ -376,8 +373,7 @@
  */
 #define u_short unsigned short
 
-/* 286 likes big chunks, which gives too much overhead. */
-#if (defined(RCHECK) || defined(I286)) && defined(PACK_MALLOC)
+#if defined(RCHECK) && defined(PACK_MALLOC)
 #  undef PACK_MALLOC
 #endif 
 
@@ -763,16 +759,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
@@ -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
@@ -1012,27 +999,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
@@ -1091,7 +1060,7 @@ 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 */
+    NOT_REACHED; /* NOTREACHED */
     return NULL;
 }
 
@@ -1099,11 +1068,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
@@ -1121,13 +1087,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 +1102,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 +1189,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
@@ -1271,8 +1241,8 @@ 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;
@@ -1284,7 +1254,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,
@@ -1298,14 +1268,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 +1283,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);
 		    }
@@ -1549,18 +1519,16 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket)
 	/* Second, check alignment. */
 	slack = 0;
 
-#  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
 		
 	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);
@@ -1617,7 +1585,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",
@@ -1630,7 +1597,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;
@@ -1690,13 +1656,13 @@ 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])
@@ -1726,9 +1692,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;
@@ -1828,8 +1795,8 @@ 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;
@@ -1861,7 +1828,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;
@@ -1924,11 +1891,11 @@ 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;
@@ -1959,7 +1926,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;
@@ -2114,7 +2081,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);
@@ -2187,7 +2154,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
@@ -2200,8 +2167,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;
@@ -2262,7 +2229,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];
@@ -2328,7 +2295,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
 
@@ -2399,11 +2366,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:
  */