# ifndef warn
# define warn(mess, arg) fprintf(stderr, (mess), (arg))
# endif
-# ifndef warn
+# ifndef warn2
# define warn2(mess, arg1) fprintf(stderr, (mess), (arg1), (arg2))
# endif
# ifdef DEBUG_m
# ifndef pTHX
# define pTHX void
# define pTHX_
-# define dTHX extern int Perl___notused
+# ifdef HASATTRIBUTE
+# define dTHX extern int Perl___notused PERL_UNUSED_DECL
+# else
+# define dTHX extern int Perl___notused
+# endif
# define WITH_THX(s) s
# endif
# ifndef PERL_GET_INTERP
# undef DEBUG_m
# define DEBUG_m(a) \
STMT_START { \
- if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \
+ if (PERL_GET_INTERP) { dTHX; if (DEBUG_m_TEST) { a; } } \
} STMT_END
#endif
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
-# define BIG_SIZE (1<<16) /* 64K */
-# endif
+#ifdef PERL_CORE
#ifdef I_MACH_CTHREADS
# undef MUTEX_LOCK
#endif
#ifdef USE_PERL_SBRK
-#define sbrk(a) Perl_sbrk(a)
+# define sbrk(a) Perl_sbrk(a)
Malloc_t Perl_sbrk (int size);
-#else
-#ifdef DONT_DECLARE_STD
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
#else
+# ifndef HAS_SBRK_PROTO /* <unistd.h> usually takes care of this */
extern Malloc_t sbrk(int);
-#endif
+# endif
#endif
#ifdef DEBUGGING_MSTATS
static u_int goodsbrk;
+# ifdef PERL_EMERGENCY_SBRK
+
+# ifndef BIG_SIZE
+# define BIG_SIZE (1<<16) /* 64K */
+# endif
+
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
static int no_mem; /* 0 if the last request for more memory succeeded.
return Nullch;
}
-#else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
+# else /* !defined(PERL_EMERGENCY_SBRK) */
# define emergency_sbrk(size) -1
-#endif /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */
+# endif
+#endif /* ifdef PERL_CORE */
#ifdef DEBUGGING
#undef ASSERT
POW2_OPTIMIZE_ADJUST(nbytes);
nbytes += M_OVERHEAD;
nbytes = (nbytes + 3) &~ 3;
+#if defined(PACK_MALLOC) && !defined(SMALL_BUCKET_VIA_TABLE)
do_shifts:
+#endif
shiftr = (nbytes - 1) >> START_SHIFT;
bucket = START_SHIFTS_BUCKET;
/* apart from this loop, this is O(1) */
{
dTHX;
if (!PL_nomemok) {
+#if defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC)
+ PerlIO_puts(PerlIO_stderr(),"Out of memory!\n");
+#else
char buff[80];
char *eb = buff + sizeof(buff) - 1;
char *s = eb;
} while (n /= 10);
PerlIO_puts(PerlIO_stderr(),s);
PerlIO_puts(PerlIO_stderr()," bytes!\n");
+#endif /* defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) */
my_exit(1);
}
}
DEBUG_m(PerlIO_printf(Perl_debug_log,
"0x%"UVxf": (%05lu) malloc %ld bytes\n",
- PTR2UV(p+1), (unsigned long)(PL_an++),
+ PTR2UV(p), (unsigned long)(PL_an++),
(long)size));
/* remove from linked list */
sbrked_remains = require - needed;
last_op = cp;
}
+#if !defined(PLAIN_MALLOC) && !defined(NO_FANCY_MALLOC)
no_mem = 0;
+#endif
last_sbrk_top = cp + require;
#ifdef DEBUGGING_MSTATS
goodsbrk += require;
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored",
+ Perl_warner(aTHX_ WARN_MALLOC, "%s free() ignored (RMAGIC, PERL_CORE)",
ovp->ov_rmagic == RMAGIC - 1 ?
"Duplicate" : "Bad");
}
#else
- warn("%s free() ignored",
+ warn("%s free() ignored (RMAGIC)",
ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad");
#endif
#else
{
dTHX;
if (!PERL_IS_ALIVE || !PL_curcop || ckWARN_d(WARN_MALLOC))
- Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored");
+ Perl_warner(aTHX_ WARN_MALLOC, "%s", "Bad free() ignored (PERL_CORE)");
}
#else
warn("%s", "Bad free() ignored");