- const STRLEN len =
- my_snprintf(buf,
- sizeof(buf),
-# ifdef PERL_MEM_LOG_TIMESTAMP
- "%10d.%06d: "
-# endif
- "alloc: %s:%d:%s: %"IVdf" %"UVuf
- " %s = %"IVdf": %"UVxf"\n",
-# ifdef PERL_MEM_LOG_TIMESTAMP
- (int)tv.tv_sec, (int)tv.tv_usec,
-# endif
- filename, linenumber, funcname, n, typesize,
- typename, n * typesize, PTR2UV(newalloc));
-# 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
+ STRLEN len;
+ int fd = atoi(pmlenv);
+ if (!fd)
+ fd = PERL_MEM_LOG_FD;
+
+ if (strchr(pmlenv, 't')) {
+ len = my_snprintf(buf, sizeof(buf),
+ MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG);
+ PerlLIO_write(fd, buf, len);
+ }
+ switch (mlt) {
+ case MLT_ALLOC:
+ len = my_snprintf(buf, sizeof(buf),
+ "alloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf"\n",
+ filename, linenumber, funcname, n, typesize,
+ type_name, n * typesize, PTR2UV(newalloc));
+ break;
+ case MLT_REALLOC:
+ len = my_snprintf(buf, sizeof(buf),
+ "realloc: %s:%d:%s: %"IVdf" %"UVuf
+ " %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+ filename, linenumber, funcname, n, typesize,
+ type_name, n * typesize, PTR2UV(oldalloc),
+ PTR2UV(newalloc));
+ break;
+ case MLT_FREE:
+ len = my_snprintf(buf, sizeof(buf),
+ "free: %s:%d:%s: %"UVxf"\n",
+ filename, linenumber, funcname,
+ PTR2UV(oldalloc));
+ break;
+ case MLT_NEW_SV:
+ case MLT_DEL_SV:
+ len = my_snprintf(buf, sizeof(buf),
+ "%s_SV: %s:%d:%s: %"UVxf SV_LOG_SERIAL_FMT "\n",
+ mlt == MLT_NEW_SV ? "new" : "del",
+ filename, linenumber, funcname,
+ PTR2UV(sv) _SV_LOG_SERIAL_ARG(sv));
+ break;
+ default:
+ len = 0;
+ }
+ PerlLIO_write(fd, buf, len);