# Which allocator to use if PERL_SBRK_VIA_MALLOC
SYSTEM_ALLOC(a) malloc(a)
+ # Minimal alignment (in bytes, should be a power of 2) of SYSTEM_ALLOC
+ SYSTEM_ALLOC_ALIGNMENT MEM_ALIGNBYTES
+
# Disable memory overwrite checking with DEBUGGING. Memory and speed
# optimization, error reporting pessimization.
NO_RCHECK undef
# Type returned by free()
Free_t void
+ # Very fatal condition reporting function (cannot call any )
+ fatalcroak(arg) write(2,arg,strlen(arg)) + exit(2)
+
# Fatal error reporting function
croak(format, arg) warn(idem) + exit(1)
warn(format, arg) fprintf(stderr, idem)
# Locking/unlocking for MT operation
- MALLOC_LOCK MUTEX_LOCK(PL_malloc_mutex)
- MALLOC_UNLOCK MUTEX_UNLOCK(PL_malloc_mutex)
+ MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex)
+ MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex)
# Locking/unlocking mutex for MT operation
MUTEX_LOCK(l) void
#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))
+#if !(defined(I286) || defined(atarist) || defined(__MINT__))
/* take 2k unless the block is bigger than that */
# define LOG_OF_MIN_ARENA 11
#else
#endif
#ifndef MALLOC_LOCK
-# define MALLOC_LOCK MUTEX_LOCK(PL_malloc_mutex)
+# define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex)
#endif
#ifndef MALLOC_UNLOCK
-# define MALLOC_UNLOCK MUTEX_UNLOCK(PL_malloc_mutex)
+# define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex)
#endif
+# ifndef fatalcroak /* make depend */
+# define fatalcroak(mess) (write(2, (mess), strlen(mess)), exit(2))
+# endif
+
#ifdef DEBUGGING
# undef DEBUG_m
# define DEBUG_m(a) if (PL_debug & 128) a
#endif
+/*
+ * Layout of memory:
+ * ~~~~~~~~~~~~~~~~
+ * The memory is broken into "blocks" which occupy multiples of 2K (and
+ * generally speaking, have size "close" to a power of 2). The addresses
+ * of such *unused* blocks are kept in nextf[i] with big enough i. (nextf
+ * is an array of linked lists.) (Addresses of used blocks are not known.)
+ *
+ * Moreover, since the algorithm may try to "bite" smaller blocks of out
+ * of unused bigger ones, there are also regions of "irregular" size,
+ * managed separately, by a linked list chunk_chain.
+ *
+ * The third type of storage is the sbrk()ed-but-not-yet-used space, its
+ * end and size are kept in last_sbrk_top and sbrked_remains.
+ *
+ * Growing blocks "in place":
+ * ~~~~~~~~~~~~~~~~~~~~~~~~~
+ * The address of the block with the greatest address is kept in last_op
+ * (if not known, last_op is 0). If it is known that the memory above
+ * last_op is not continuous, or contains a chunk from chunk_chain,
+ * last_op is set to 0.
+ *
+ * The chunk with address last_op may be grown by expanding into
+ * sbrk()ed-but-not-yet-used space, or trying to sbrk() more continuous
+ * memory.
+ *
+ * Management of last_op:
+ * ~~~~~~~~~~~~~~~~~~~~~
+ *
+ * free() never changes the boundaries of blocks, so is not relevant.
+ *
+ * The only way realloc() may change the boundaries of blocks is if it
+ * grows a block "in place". However, in the case of success such a
+ * chunk is automatically last_op, and it remains last_op. In the case
+ * of failure getpages_adjacent() clears last_op.
+ *
+ * malloc() may change blocks by calling morecore() only.
+ *
+ * morecore() may create new blocks by:
+ * a) biting pieces from chunk_chain (cannot create one above last_op);
+ * b) biting a piece from an unused block (if block was last_op, this
+ * may create a chunk from chain above last_op, thus last_op is
+ * invalidated in such a case).
+ * c) biting of sbrk()ed-but-not-yet-used space. This creates
+ * a block which is last_op.
+ * d) Allocating new pages by calling getpages();
+ *
+ * getpages() creates a new block. It marks last_op at the bottom of
+ * the chunk of memory it returns.
+ *
+ * Active pages footprint:
+ * ~~~~~~~~~~~~~~~~~~~~~~
+ * Note that we do not need to traverse the lists in nextf[i], just take
+ * the first element of this list. However, we *need* to traverse the
+ * list in chunk_chain, but most the time it should be a very short one,
+ * so we do not step on a lot of pages we are not going to use.
+ *
+ * Flaws:
+ * ~~~~~
+ * get_from_bigger_buckets(): forget to increment price => Quite
+ * aggressive.
+ */
+
/* I don't much care whether these are defined in sys/types.h--LAW */
#define u_char unsigned char
#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(I286) || defined(atarist) || defined(__MINT__)) && defined(PACK_MALLOC)
# undef PACK_MALLOC
#endif
# endif
};
+# define NEEDED_ALIGNMENT 0x800 /* 2k boundaries */
+# define WANTED_ALIGNMENT 0x800 /* 2k boundaries */
+
#else /* !PACK_MALLOC */
# define OV_MAGIC(block,bucket) (block)->ov_magic
# define OV_INDEX(block) (block)->ov_index
# define CHUNK_SHIFT 1
# define MAX_PACKED -1
+# define NEEDED_ALIGNMENT MEM_ALIGNBYTES
+# define WANTED_ALIGNMENT 0x400 /* 1k boundaries */
+
#endif /* !PACK_MALLOC */
#define M_OVERHEAD (sizeof(union overhead) + RSLOP)
SV *sv;
char *pv;
int have = 0;
+ STRLEN n_a;
if (emergency_buffer_size) {
add_to_chain(emergency_buffer, emergency_buffer_size, 0);
return (char *)-1; /* Now die die die... */
}
/* Got it, now detach SvPV: */
- pv = SvPV(sv, PL_na);
+ pv = SvPV(sv, n_a);
/* Check alignment: */
- if (((UV)(pv - sizeof(union overhead))) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
+ if (((UV)(pv - sizeof(union overhead))) & (NEEDED_ALIGNMENT - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
return (char *)-1; /* die die die */
}
/* Common case, anything is fine. */
sbrk_good++;
ovp = (union overhead *) (cp - sbrked_remains);
+ last_op = cp - sbrked_remains;
sbrked_remains = require - (needed - sbrked_remains);
} else if (cp == (char *)-1) { /* no more room! */
ovp = (union overhead *)emergency_sbrk(needed);
if (ovp == (union overhead *)-1)
return 0;
+ if (((char*)ovp) > last_op) { /* Cannot happen with current emergency_sbrk() */
+ last_op = 0;
+ }
return ovp;
} else { /* Non-continuous or first sbrk(). */
long add = sbrked_remains;
/* Second, check alignment. */
slack = 0;
-#ifndef atarist /* on the atari we dont have to worry about this */
+#if !defined(atarist) && !defined(__MINT__) /* on the atari we dont have to worry about this */
# ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */
-
- /* CHUNK_SHIFT is 1 for PACK_MALLOC, 0 otherwise. */
- if ((UV)cp & (0x7FF >> CHUNK_SHIFT)) { /* Not aligned. */
- slack = (0x800 >> CHUNK_SHIFT)
- - ((UV)cp & (0x7FF >> CHUNK_SHIFT));
+ /* WANTED_ALIGNMENT may be more than NEEDED_ALIGNMENT, but this may
+ improve performance of memory access. */
+ if ((UV)cp & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */
+ slack = WANTED_ALIGNMENT - ((UV)cp & (WANTED_ALIGNMENT - 1));
add += slack;
}
# endif
-#endif /* atarist */
+#endif /* !atarist && !MINT */
if (add) {
DEBUG_m(PerlIO_printf(Perl_debug_log,
#ifdef PACK_MALLOC
if (slack) {
MALLOC_UNLOCK;
- croak("%s", "panic: Off-page sbrk");
+ fatalcroak("panic: Off-page sbrk\n");
}
#endif
if (sbrked_remains) {
* and deduct from block count to reflect.
*/
+# if NEEDED_ALIGNMENT > MEM_ALIGNBYTES
+ if ((UV)ovp & (NEEDED_ALIGNMENT - 1))
+ fatalcroak("Misalignment of sbrk()\n");
+ else
+# endif
#ifndef I286 /* Again, this should always be ok on an 80286 */
- if ((UV)ovp & 7) {
- ovp = (union overhead *)(((UV)ovp + 8) & ~7);
+ if ((UV)ovp & (MEM_ALIGNBYTES - 1)) {
DEBUG_m(PerlIO_printf(Perl_debug_log,
"fixing sbrk(): %d bytes off machine alignement\n",
- (int)((UV)ovp & 7)));
+ (int)((UV)ovp & (MEM_ALIGNBYTES - 1))));
+ ovp = (union overhead *)(((UV)ovp + MEM_ALIGNBYTES) &
+ (MEM_ALIGNBYTES - 1));
(*nblksp)--;
# if defined(DEBUGGING_MSTATS)
/* This is only approx. if TWO_POT_OPTIMIZE: */
- sbrk_slack += (1 << bucket);
+ sbrk_slack += (1 << (bucket >> BUCKET_POW2_SHIFT));
# endif
}
#endif
+ ; /* Finish `else' */
sbrked_remains = require - needed;
+ last_op = cp;
}
last_sbrk_top = cp + require;
- last_op = (char*) cp;
#ifdef DEBUGGING_MSTATS
goodsbrk += require;
#endif
*
* 980701 Dominic Dunlop <domo@computer.org>
*/
-# define SYSTEM_ALLOC(a) ((void *)(((unsigned)malloc((a)+6)+6)&~7))
+# define SYSTEM_ALLOC_ALIGNMENT 2
# endif
# ifdef PERL_SBRK_VIA_MALLOC
# ifndef SYSTEM_ALLOC
# define SYSTEM_ALLOC(a) malloc(a)
# endif
+# ifndef SYSTEM_ALLOC_ALIGNMENT
+# define SYSTEM_ALLOC_ALIGNMENT MEM_ALIGNBYTES
+# endif
# endif /* PERL_SBRK_VIA_MALLOC */
size = PERLSBRK_64_K;
small = 1;
}
+# if NEEDED_ALIGNMENT > SYSTEM_ALLOC_ALIGNMENT
+ size += NEEDED_ALIGNMENT - SYSTEM_ALLOC_ALIGNMENT;
+# endif
got = (IV)SYSTEM_ALLOC(size);
-#ifdef PACK_MALLOC
- got = (got + 0x7ff) & ~0x7ff;
-#endif
+# if NEEDED_ALIGNMENT > SYSTEM_ALLOC_ALIGNMENT
+ got = (got + NEEDED_ALIGNMENT - 1) & (NEEDED_ALIGNMENT - 1);
+# endif
if (small) {
/* Chunk is small, register the rest for future allocs. */
Perl_sbrk_oldchunk = got + reqsize;
projects / p5sagit/p5-mst-13.2.git / blobdiff