*/
#ifndef lint
-#ifdef DEBUGGING
-#define RCHECK
-#endif
+# if defined(DEBUGGING) && !defined(NO_RCHECK)
+# define RCHECK
+# endif
/*
* malloc.c (Caltech) 2/21/82
* Chris Kingsley, kingsley@cit-20.
register int bucket = 0;
register MEM_SIZE shiftr;
-#ifdef PERL_CORE
#if defined(DEBUGGING) || defined(RCHECK)
MEM_SIZE size = nbytes;
#endif
+#ifdef PERL_CORE
#ifdef HAS_64K_LIMIT
if (nbytes > 0xffff) {
- PerlIO_printf(PerlIO_stderr(), "Allocation too large: %lx\n", (long)nbytes);
+ PerlIO_printf(PerlIO_stderr(),
+ "Allocation too large: %lx\n", (long)nbytes);
my_exit(1);
}
#endif /* HAS_64K_LIMIT */
#ifdef DEBUGGING
if ((long)nbytes < 0)
- croak("panic: malloc");
+ croak("panic: malloc");
#endif
#endif /* PERL_CORE */
* space used per block for accounting.
*/
#ifdef PACK_MALLOC
- if (nbytes > MAX_2_POT_ALGO) {
+ if (nbytes == 0)
+ nbytes = 1;
+ else if (nbytes > MAX_2_POT_ALGO)
#endif
+ {
#ifdef TWO_POT_OPTIMIZE
- if (nbytes >= FIRST_BIG_BOUND) {
- nbytes -= PERL_PAGESIZE;
- }
+ if (nbytes >= FIRST_BIG_BOUND)
+ nbytes -= PERL_PAGESIZE;
#endif
- nbytes += M_OVERHEAD;
- nbytes = (nbytes + 3) &~ 3;
-#ifdef PACK_MALLOC
- } else if (nbytes == 0) {
- nbytes = 1;
+ nbytes += M_OVERHEAD;
+ nbytes = (nbytes + 3) &~ 3;
}
-#endif
shiftr = (nbytes - 1) >> 2;
/* apart from this loop, this is O(1) */
while (shiftr >>= 1)
}
#ifdef PERL_CORE
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",
- (unsigned long)(p+1),an++,(long)size));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) malloc %ld bytes\n",
+ (unsigned long)(p+1),(unsigned long)(an++),(long)size));
#endif /* PERL_CORE */
/* remove from linked list */
#ifndef atarist /* on the atari we dont have to worry about this */
op = (union overhead *)sbrk(0);
# ifndef I286
-# ifdef PACK_MALLOC
- if ((u_int)op & 0x7ff)
- (void)sbrk(slack = 2048 - ((u_int)op & 0x7ff));
-# else
- if ((u_int)op & 0x3ff)
- (void)sbrk(slack = 1024 - ((u_int)op & 0x3ff));
-# endif
+ if ((UV)op & (0x7FF >> CHUNK_SHIFT)) {
+ slack = (0x800 >> CHUNK_SHIFT) - ((UV)op & (0x7FF >> CHUNK_SHIFT));
+ (void)sbrk(slack);
# if defined(DEBUGGING_MSTATS)
- sbrk_slack += slack;
+ sbrk_slack += slack;
# endif
+ }
# else
/* The sbrk(0) call on the I286 always returns the next segment */
# endif
*/
#ifndef I286
# ifdef PACK_MALLOC
- if ((u_int)op & 0x7ff)
+ if ((UV)op & 0x7FF)
croak("panic: Off-page sbrk");
# endif
- if ((u_int)op & 7) {
- op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
+ if ((UV)op & 7) {
+ op = (union overhead *)(((UV)op + 8) & ~7);
nblks--;
}
#else
#endif
#ifdef PERL_CORE
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(unsigned long)cp,an++));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05lu) free\n",(unsigned long)cp,(unsigned long)(an++)));
#endif /* PERL_CORE */
if (cp == NULL)
#ifdef PACK_MALLOC
bucket = OV_INDEX(op);
#endif
-#ifdef DEBUGGING
- ASSERT(OV_MAGIC(op, bucket) == MAGIC); /* make sure it was in use */
-#else
if (OV_MAGIC(op, bucket) != MAGIC) {
- static bad_free_warn = -1;
+ static int bad_free_warn = -1;
if (bad_free_warn == -1) {
char *pbf = getenv("PERL_BADFREE");
bad_free_warn = (pbf) ? atoi(pbf) : 1;
#endif
return; /* sanity */
}
-#endif
#ifdef RCHECK
ASSERT(op->ov_rmagic == RMAGIC);
if (OV_INDEX(op) <= MAX_SHORT_BUCKET)
int was_alloced = 0;
char *cp = (char*)mp;
-#ifdef PERL_CORE
#ifdef DEBUGGING
MEM_SIZE size = nbytes;
#endif
+#ifdef PERL_CORE
#ifdef HAS_64K_LIMIT
if (nbytes > 0xffff) {
- PerlIO_printf(PerlIO_stderr(), "Reallocation too large: %lx\n", size);
+ PerlIO_printf(PerlIO_stderr(),
+ "Reallocation too large: %lx\n", size);
my_exit(1);
}
#endif /* HAS_64K_LIMIT */
#ifdef PERL_CORE
#ifdef DEBUGGING
if (debug & 128) {
- PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) rfree\n",(unsigned long)res,an++);
- PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05d) realloc %ld bytes\n",
- (unsigned long)res,an++,(long)size);
+ PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) rfree\n",(unsigned long)res,(unsigned long)(an++));
+ PerlIO_printf(PerlIO_stderr(), "0x%lx: (%05lu) realloc %ld bytes\n",
+ (unsigned long)res,(unsigned long)(an++),(long)size);
}
#endif
#endif /* PERL_CORE */