# Type of size argument for allocation functions
MEM_SIZE unsigned long
+ # size of void*
+ PTRSIZE 4
+
# Maximal value in LONG
LONG_MAX 0x7FFFFFFF
warn(format, arg) fprintf(stderr, idem)
# Locking/unlocking for MT operation
- MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex)
- MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&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
# ifndef Malloc_t
# define Malloc_t void *
# endif
+# ifndef PTRSIZE
+# define PTRSIZE 4
+# endif
# ifndef MEM_SIZE
# define MEM_SIZE unsigned long
# endif
#endif
#ifndef MALLOC_LOCK
-# define MALLOC_LOCK MUTEX_LOCK_NOCONTEXT(&PL_malloc_mutex)
+# define MALLOC_LOCK MUTEX_LOCK(&PL_malloc_mutex)
#endif
#ifndef MALLOC_UNLOCK
-# define MALLOC_UNLOCK MUTEX_UNLOCK_NOCONTEXT(&PL_malloc_mutex)
+# define MALLOC_UNLOCK MUTEX_UNLOCK(&PL_malloc_mutex)
#endif
# ifndef fatalcroak /* make depend */
double strut; /* alignment problems */
#endif
struct {
- u_char ovu_magic; /* magic number */
u_char ovu_index; /* bucket # */
+ u_char ovu_magic; /* magic number */
#ifdef RCHECK
u_short ovu_size; /* actual block size */
u_int ovu_rmagic; /* range magic number */
# define SBRK_FAILURE_PRICE 50
#endif
+static void morecore (register int bucket);
+# if defined(DEBUGGING)
+static void botch (char *diag, char *s);
+# endif
+static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip);
+static void* get_from_chain (MEM_SIZE size);
+static void* get_from_bigger_buckets(int bucket, MEM_SIZE size);
+static union overhead *getpages (MEM_SIZE needed, int *nblksp, int bucket);
+static int getpages_adjacent(MEM_SIZE require);
+
#if defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)
# ifndef BIG_SIZE
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
-static int findbucket (union overhead *freep, int srchlen);
-static void morecore (register int bucket);
-# if defined(DEBUGGING)
-static void botch (char *diag, char *s);
-# endif
-static void add_to_chain (void *p, MEM_SIZE size, MEM_SIZE chip);
-static Malloc_t emergency_sbrk (MEM_SIZE size);
-static void* get_from_chain (MEM_SIZE size);
-static void* get_from_bigger_buckets(int bucket, MEM_SIZE size);
-static union overhead *getpages (int needed, int *nblksp, int bucket);
-static int getpages_adjacent(int require);
-
static Malloc_t
emergency_sbrk(MEM_SIZE size)
{
# define emergency_sbrk(size) -1
#endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
+#ifndef BITS_IN_PTR
+# define BITS_IN_PTR (8*PTRSIZE)
+#endif
+
/*
* nextf[i] is the pointer to the next free block of size 2^i. The
* smallest allocatable block is 8 bytes. The overhead information
* precedes the data area returned to the user.
*/
-#define NBUCKETS (32*BUCKETS_PER_POW2 + 1)
+#define NBUCKETS (BITS_IN_PTR*BUCKETS_PER_POW2 + 1)
static union overhead *nextf[NBUCKETS];
#if defined(PURIFY) && !defined(USE_PERL_SBRK)
}
static union overhead *
-getpages(int needed, int *nblksp, int bucket)
+getpages(MEM_SIZE needed, int *nblksp, int bucket)
{
/* Need to do (possibly expensive) system call. Try to
optimize it for rare calling. */
MEM_SIZE require = needed - sbrked_remains;
char *cp;
union overhead *ovp;
- int slack = 0;
+ MEM_SIZE slack = 0;
if (sbrk_good > 0) {
if (!last_sbrk_top && require < FIRST_SBRK)
}
static int
-getpages_adjacent(int require)
+getpages_adjacent(MEM_SIZE require)
{
if (require <= sbrked_remains) {
sbrked_remains -= require;
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(WARN_MALLOC, "%s free() ignored",
+ Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored",
ovp->ov_rmagic == RMAGIC - 1 ?
"Duplicate" : "Bad");
}
#endif
#else
#ifdef PERL_CORE
- if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(WARN_MALLOC, "%s", "Bad free() ignored");
+ {
+ dTHX;
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored");
+ }
#else
warn("%s", "Bad free() ignored");
#endif
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(WARN_MALLOC, "%srealloc() %signored",
+ Perl_warner(aTHX_ WARN_MALLOC, "%srealloc() %signored",
(ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "),
ovp->ov_rmagic == RMAGIC - 1
? "of freed memory " : "");
#endif
#else
#ifdef PERL_CORE
- if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(WARN_MALLOC, "%s", "Bad realloc() ignored");
+ {
+ dTHX;
+ if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
+ Perl_warner(aTHX_ WARN_MALLOC, "%s",
+ "Bad realloc() ignored");
+ }
#else
warn("%s", "Bad realloc() ignored");
#endif
return ((Malloc_t)res);
}
-/*
- * Search ``srchlen'' elements of each free list for a block whose
- * header starts at ``freep''. If srchlen is -1 search the whole list.
- * Return bucket number, or -1 if not found.
- */
-static int
-findbucket(union overhead *freep, int srchlen)
-{
- register union overhead *p;
- register int i, j;
-
- for (i = 0; i < NBUCKETS; i++) {
- j = 0;
- for (p = nextf[i]; p && j != srchlen; p = p->ov_next) {
- if (p == freep)
- return (i);
- j++;
- }
- }
- return (-1);
-}
-
Malloc_t
Perl_calloc(register size_t elements, register size_t size)
{
(long)BUCKET_SIZE(MIN_BUCKET),
(long)BUCKET_SIZE_REAL(buffer.topbucket),
(long)BUCKET_SIZE(buffer.topbucket));
- PerlIO_printf(Perl_error_log, "%8d free:", buffer.totfree);
+ PerlIO_printf(Perl_error_log, "%8ld 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)
buffer.nfree[i]);
}
#endif
- PerlIO_printf(Perl_error_log, "\n%8d used:", buffer.total - buffer.totfree);
+ PerlIO_printf(Perl_error_log, "\n%8ld 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)
buffer.ntotal[i] - buffer.nfree[i]);
}
#endif
- PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n",
+ PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %ld/%ld:%ld. Odd ends: pad+heads+chain+tail: %ld+%ld+%ld+%ld.\n",
buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good,
buffer.sbrk_slack, buffer.start_slack,
buffer.total_chain, buffer.sbrked_remains);
# if defined(__MACHTEN_PPC__) || defined(NeXT) || defined(__NeXT__) || defined(PURIFY)
# define PERL_SBRK_VIA_MALLOC
-/*
- * MachTen's malloc() returns a buffer aligned on a two-byte boundary.
- * While this is adequate, it may slow down access to longer data
- * types by forcing multiple memory accesses. It also causes
- * complaints when RCHECK is in force. So we allocate six bytes
- * more than we need to, and return an address rounded up to an
- * eight-byte boundary.
- *
- * 980701 Dominic Dunlop <domo@computer.org>
- */
-# define SYSTEM_ALLOC_ALIGNMENT 2
# endif
# ifdef PERL_SBRK_VIA_MALLOC