type value; \
char c[sizeof(type)]; \
} u; \
- register I32 i; \
- register I32 s = 0; \
+ register U32 i; \
+ register U32 s = 0; \
for (i = 0; i < sizeof(u.c); i++, s += 8) { \
u.c[i] = (n >> s) & 0xFF; \
} \
type value; \
char c[sizeof(type)]; \
} u; \
- register I32 i; \
- register I32 s = 0; \
+ register U32 i; \
+ register U32 s = 0; \
u.value = n; \
n = 0; \
for (i = 0; i < sizeof(u.c); i++, s += 8) { \
type value; \
char c[sizeof(type)]; \
} u; \
- register I32 i; \
- register I32 s = 8*(sizeof(u.c)-1); \
+ register U32 i; \
+ register U32 s = 8*(sizeof(u.c)-1); \
for (i = 0; i < sizeof(u.c); i++, s -= 8) { \
u.c[i] = (n >> s) & 0xFF; \
} \
type value; \
char c[sizeof(type)]; \
} u; \
- register I32 i; \
- register I32 s = 8*(sizeof(u.c)-1); \
+ register U32 i; \
+ register U32 s = 8*(sizeof(u.c)-1); \
u.value = n; \
n = 0; \
for (i = 0; i < sizeof(u.c); i++, s -= 8) { \
/* If we managed to get status pipe check for exec fail */
if (did_pipes && pid > 0) {
int errkid;
- int n = 0, n1;
+ unsigned n = 0;
+ SSize_t n1;
while (n < sizeof(int)) {
n1 = PerlLIO_read(pp[0],
PL_forkprocess = pid;
if (did_pipes && pid > 0) {
int errkid;
- int n = 0, n1;
+ unsigned n = 0;
+ SSize_t n1;
while (n < sizeof(int)) {
n1 = PerlLIO_read(pp[0],
if (len == 2 && tmpbuf[0] == '.')
seen_dot = 1;
#endif
+#ifdef HAS_STRLCAT
+ (void)strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len);
+#else
/* FIXME? Convert to memcpy by storing previous strlen(scriptname)
*/
(void)strcpy(tmpbuf + len, scriptname);
+#endif /* #ifdef HAS_STRLCAT */
#endif /* !VMS */
#ifdef SEARCH_EXTS
void
Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
{
- const char * const func =
- op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
- op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
- op < 0 ? "" : /* handle phoney cases */
- PL_op_desc[op];
- const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
- const char * const type = OP_IS_SOCKET(op)
- || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
- ? "socket" : "filehandle";
const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
}
if (ckWARN(warn_type)) {
+ const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+ const char * const func =
+ op == OP_READLINE ? "readline" : /* "<HANDLE>" not nice */
+ op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */
+ op < 0 ? "" : /* handle phoney cases */
+ PL_op_desc[op];
+ const char * const type = OP_IS_SOCKET(op)
+ || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
+ ? "socket" : "filehandle";
if (name && *name) {
Perl_warner(aTHX_ packWARN(warn_type),
"%s%s on %s %s %s", func, pars, vile, type, name);
if ( SvNOK(ver) ) /* may get too much accuracy */
{
char tbuf[64];
- const STRLEN len = my_sprintf(tbuf,"%.9"NVgf, SvNVX(ver));
+#ifdef USE_SNPRINTF
+ const STRLEN len = snprintf(tbuf, sizeof(tbuf), "%.9"NVgf, SvNVX(ver));
+#else
+ const STRLEN len = my_sprintf(tbuf, "%.9"NVgf, SvNVX(ver));
+#endif /* #ifdef USE_SNPRINTF */
version = savepvn(tbuf, len);
}
#ifdef SvVOK
#ifdef PERL_MEM_LOG
+/*
+ * PERL_MEM_LOG: the Perl_mem_log_..() will be compiled.
+ *
+ * PERL_MEM_LOG_ENV: if defined, during run time the environment
+ * variable PERL_MEM_LOG will be consulted, and if the integer value
+ * of that is true, the logging will happen. (The default is to
+ * always log if the PERL_MEM_LOG define was in effect.)
+ */
+
+/*
+ * PERL_MEM_LOG_SPRINTF_BUF_SIZE: size of a (stack-allocated) buffer
+ * the Perl_mem_log_...() will use (either via sprintf or snprintf).
+ */
#define PERL_MEM_LOG_SPRINTF_BUF_SIZE 128
+/*
+ * PERL_MEM_LOG_FD: the file descriptor the Perl_mem_log_...() will
+ * log to. You can also define in compile time PERL_MEM_LOG_ENV_FD,
+ * in which case the environment variable PERL_MEM_LOG_FD will be
+ * consulted for the file descriptor number to use.
+ */
+#ifndef PERL_MEM_LOG_FD
+# define PERL_MEM_LOG_FD 2 /* If STDERR is too boring for you. */
+#endif
+
Malloc_t
Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
{
#ifdef PERL_MEM_LOG_STDERR
- /* We can't use PerlIO for obvious reasons. */
- char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
- const STRLEN len = my_sprintf(buf,
- "alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf"\n",
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(newalloc));
- PerlLIO_write(2, buf, len);
+# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
+ char *s;
+# endif
+# ifdef PERL_MEM_LOG_ENV
+ s = getenv("PERL_MEM_LOG");
+ if (s ? atoi(s) : 0)
+# endif
+ {
+ /* We can't use SVs or PerlIO for obvious reasons,
+ * so we'll use stdio and low-level IO instead. */
+ char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
+# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+ struct timeval tv;
+ gettimeofday(&tv, 0);
+ {
+ const STRLEN len =
+# ifdef USE_SNPRINTF
+ snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ "%10d.%06d: alloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf"\n",
+ (int)tv.tv_sec, (int)tv.tv_usec,
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(newalloc));
+# else
+ my_sprintf(buf,
+ "%10d.%06d: alloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf"\n",
+ (int)tv.tv_sec, (int)tv.tv_usec,
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(newalloc));
+# endif
+# else
+ const STRLEN len =
+# ifdef USE_SNPRINTF
+ snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ "alloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf"\n",
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(newalloc));
+# else
+ my_sprintf(buf,
+ "alloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf"\n",
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(newalloc));
+# endif
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+ s = PerlEnv_getenv("PERL_MEM_LOG_FD");
+ PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
+# else
+ PerlLIO_write(PERL_MEM_LOG_FD, buf, len);
+#endif
+ }
+ }
#endif
return newalloc;
}
Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
{
#ifdef PERL_MEM_LOG_STDERR
- /* We can't use PerlIO for obvious reasons. */
- char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
- const STRLEN len = my_sprintf(buf, "realloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(oldalloc),
- PTR2UV(newalloc));
- PerlLIO_write(2, buf, len);
+# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
+ char *s;
+# endif
+# ifdef PERL_MEM_LOG_ENV
+ s = PerlEnv_getenv("PERL_MEM_LOG");
+ if (s ? atoi(s) : 0)
+# endif
+ {
+ /* We can't use SVs or PerlIO for obvious reasons,
+ * so we'll use stdio and low-level IO instead. */
+ char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
+# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+ struct timeval tv;
+ gettimeofday(&tv, 0);
+ {
+ const STRLEN len =
+# ifdef USE_SNPRINTF
+ snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ "%10d.%06d: realloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+ (int)tv.tv_sec, (int)tv.tv_usec,
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(oldalloc),
+ PTR2UV(newalloc));
+# else
+ my_sprintf(buf,
+ "%10d.%06d: realloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+ (int)tv.tv_sec, (int)tv.tv_usec,
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(oldalloc),
+ PTR2UV(newalloc));
+# endif
+# else
+ const STRLEN len =
+# ifdef USE_SNPRINTF
+ snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ "realloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(oldalloc),
+ PTR2UV(newalloc));
+# else
+ my_sprintf(buf,
+ "realloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+ filename, linenumber, funcname, n, typesize,
+ typename, n * typesize, PTR2UV(oldalloc),
+ PTR2UV(newalloc));
+# endif
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+ s = PerlEnv_getenv("PERL_MEM_LOG_FD");
+ PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
+# else
+ PerlLIO_write(PERL_MEM_LOG_FD, buf, len);
+# endif
+ }
+ }
#endif
return newalloc;
}
Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname)
{
#ifdef PERL_MEM_LOG_STDERR
- /* We can't use PerlIO for obvious reasons. */
- char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
- const STRLEN len = my_sprintf(buf, "free: %s:%d:%s: %"UVxf"\n",
- filename, linenumber, funcname,
- PTR2UV(oldalloc));
- PerlLIO_write(2, buf, len);
+# if defined(PERL_MEM_LOG_ENV) || defined(PERL_MEM_LOG_ENV_FD)
+ char *s;
+# endif
+# ifdef PERL_MEM_LOG_ENV
+ s = PerlEnv_getenv("PERL_MEM_LOG");
+ if (s ? atoi(s) : 0)
+# endif
+ {
+ /* We can't use SVs or PerlIO for obvious reasons,
+ * so we'll use stdio and low-level IO instead. */
+ char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE];
+# if defined(PERL_MEM_LOG_TIMESTAMP) && defined(HAS_GETTIMEOFDAY)
+ struct timeval tv;
+ gettimeofday(&tv, 0);
+ {
+ const STRLEN len =
+# ifdef USE_SNPRINTF
+ snprintf(buf,
+ PERL_MEM_LOG_SPRINTF_BUF_SIZE,
+ "%10d.%06d: free: %s:%d:%s: %"UVxf"\n",
+ (int)tv.tv_sec, (int)tv.tv_usec,
+ filename, linenumber, funcname,
+ PTR2UV(oldalloc));
+# else
+ my_sprintf(buf,
+ "%10d.%06d: free: %s:%d:%s: %"UVxf"\n",
+ (int)tv.tv_sec, (int)tv.tv_usec,
+ filename, linenumber, funcname,
+ PTR2UV(oldalloc));
+# endif
+# else
+ const STRLEN len =
+ my_sprintf(buf,
+ "free: %s:%d:%s: %"UVxf"\n",
+ filename, linenumber, funcname,
+ PTR2UV(oldalloc));
+# endif
+# ifdef PERL_MEM_LOG_ENV_FD
+ s = PerlEnv_getenv("PERL_MEM_LOG_FD");
+ PerlLIO_write(s ? atoi(s) : PERL_MEM_LOG_FD, buf, len);
+# else
+ PerlLIO_write(PERL_MEM_LOG_FD, buf, len);
+# endif
+ }
+ }
#endif
return oldalloc;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff