--- Begin Message ---
Craig A. Berry wrote:
At 6:30 PM -0500 2/24/06, Thomas Pfau wrote:
What facilities are in perl to debug memory allocation issues?
You can run your script with the memory debug option enabled:
$ perl -"Dm" myscript.pl
That will log the memory allocations and deallocations, at least when
Perl's memory API is used.
I had to rebuild my perl since it wasn't built with -DDEBUGGING. Took
the opportunity to upgrade from 5.8.6 to 5.8.8.
Anyway, with the new perl, the info above, and a little script to match
allocations to deallocations, I managed to find some major leaks in
VMS::Device and VMS::Queue. Patches below. These have not been
extensively tested but my scripts now run with significantly less
leakage. It appears to still leak small amounts of memory but nothing
like before.
--- vms-device-0_08/device.xs Mon Dec 18 17:13:04 2000
+++ vms-device-0_09/device.xs Mon Feb 27 13:09:08 2006
@@ -2700,7 +2700,7 @@
/* Did it go OK? */
if (status == SS$_NORMAL) {
/* Looks like it */
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
for (i = 0; i < DevInfoCount; i++) {
switch(OurDataList[i].ReturnType) {
case IS_STRING:
@@ -2854,7 +2854,7 @@
{
HV *AllPurposeHV;
if (!strcmp(InfoName, "DEVCHAR")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
dev_bit_test(AllPurposeHV, REC, BitmapValue);
dev_bit_test(AllPurposeHV, CCL, BitmapValue);
dev_bit_test(AllPurposeHV, TRM, BitmapValue);
@@ -2885,7 +2885,7 @@
dev_bit_test(AllPurposeHV, WCK, BitmapValue);
} else {
if (!strcmp(InfoName, "DEVCHAR2")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
dev_bit_test(AllPurposeHV, CLU, BitmapValue);
dev_bit_test(AllPurposeHV, DET, BitmapValue);
dev_bit_test(AllPurposeHV, RTT, BitmapValue);
@@ -2915,7 +2915,7 @@
dev_bit_test(AllPurposeHV, NOFE, BitmapValue);
} else {
if (!strcmp(InfoName, "STS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
ucb_bit_test(AllPurposeHV, TIM, BitmapValue)
ucb_bit_test(AllPurposeHV, INT, BitmapValue)
ucb_bit_test(AllPurposeHV, ERLOGIP, BitmapValue)
@@ -2935,7 +2935,7 @@
ucb_bit_test(AllPurposeHV, DELETEUCB, BitmapValue)
} else {
if (!strcmp(InfoName, "TT_CHARSET")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
ttc_bit_test(AllPurposeHV, HANGUL, BitmapValue);
ttc_bit_test(AllPurposeHV, HANYU, BitmapValue);
ttc_bit_test(AllPurposeHV, HANZI, BitmapValue);
@@ -2944,7 +2944,7 @@
ttc_bit_test(AllPurposeHV, THAI, BitmapValue);
}}}}
if (AllPurposeHV) {
- XPUSHs(newRV((SV *)AllPurposeHV));
+ XPUSHs(newRV_noinc((SV *)AllPurposeHV));
} else {
XPUSHs(&PL_sv_undef);
}
--- vms-queue-0_57/queue.xs Wed May 30 17:18:05 2001
+++ vms-queue-0_58/queue.xs Mon Feb 27 12:25:30 2006
@@ -1031,7 +1031,7 @@
{
HV *AllPurposeHV;
if (!strcmp(InfoName, "FORM_FLAGS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_FORM_SHEET_FEED, "FORM_SHEET_FEED",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_FORM_TRUNCATE, "FORM_TRUNCATE",
@@ -1039,7 +1039,7 @@
bit_test(AllPurposeHV, QUI$M_FORM_WRAP, "FORM_WRAP", BitmapValue);
} else {
if (!strcmp(InfoName, "FILE_FLAGS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_FILE_BURST, "FILE_BURST",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_FILE_DELETE, "FILE_DELETE",
@@ -1058,14 +1058,14 @@
BitmapValue);
} else {
if (!strcmp(InfoName, "FILE_STATUS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_FILE_CHECKPOINTED, "FILE_CHECKPOINTED",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_FILE_EXECUTING, "FILE_EXECUTING",
BitmapValue);
} else {
if (!strcmp(InfoName, "JOB_FLAGS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_JOB_CPU_LIMIT, "JOB_CPU_LIMIT",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_JOB_ERROR_RETENTION,
"JOB_ERROR_RETENTION", BitmapValue);
@@ -1096,7 +1096,7 @@
bit_test(AllPurposeHV, QUI$M_JOB_WSQUOTA, "JOB_WSQUOTA", BitmapValue);
} else {
if (!strcmp(InfoName, "JOB_STATUS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_JOB_ABORTING, "JOB_ABORTING",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_JOB_EXECUTING, "JOB_EXECUTING",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_JOB_HOLDING, "JOB_HOLDING", BitmapValue);
@@ -1112,7 +1112,7 @@
BitmapValue);
} else {
if (!strcmp(InfoName, "MANAGER_FLAGS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_MANAGER_FAILOVER, "MANAGER_FAILOVER",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_MANAGER_RUNNING, "MANAGER_RUNNING",
@@ -1127,7 +1127,7 @@
BitmapValue);
} else {
if (!strcmp(InfoName, "PENDING_JOB_REASON")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_PEND_CHAR_MISMATCH, "PEND_CHAR_MISMATCH",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_PEND_JOB_SIZE_MAX, "PEND_JOB_SIZE_MAX",
@@ -1144,7 +1144,7 @@
"PEND_STOCK_MISMATCH", BitmapValue);
} else {
if (!strcmp(InfoName, "QUEUE_FLAGS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_QUEUE_ACL_SPECIFIED,
"QUEUE_ACL_SPECIFIED", BitmapValue);
bit_test(AllPurposeHV, QUI$M_QUEUE_AUTOSTART, "QUEUE_AUTOSTART",
@@ -1199,7 +1199,7 @@
BitmapValue);
} else {
if (!strcmp(InfoName, "QUEUE_STATUS")) {
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
bit_test(AllPurposeHV, QUI$M_QUEUE_ALIGNING, "QUEUE_ALIGNING",
BitmapValue);
bit_test(AllPurposeHV, QUI$M_QUEUE_AUTOSTART_INACTIVE,
@@ -1377,7 +1377,7 @@
if ((status == SS$_NORMAL) && (GenericIOSB.sts == JBC$_NORMAL)) {
unsigned int *timeptr;
/* Looks like it */
- AllPurposeHV = newHV();
+ AllPurposeHV = (HV*)sv_2mortal((SV*)newHV());
for (i = 0; i < LocalIndex; i++) {
switch(OurDataList[i].ReturnType) {
case IS_STRING:
--
tom_p
[EMAIL PROTECTED] -- http://nbpfaus.net/~pfau/
--- End Message ---
