Thanks.  I'm cc'ing Dan Sugalski, who I believe still officially owns 
VMS::Device and VMS::Queue (and VMS::System et al., which may have similar 
issues).

At 6:33 PM -0500 2/28/06, Thomas Pfau wrote:
>I had meant to send this to the list but hit 'reply' instead of 'reply all'...
>
>--
>tom_p
>[EMAIL PROTECTED] -- http://nbpfaus.net/~pfau/
>
>
>Message-ID: <[EMAIL PROTECTED]>
>Date: Tue, 28 Feb 2006 18:31:58 -0500
>From: Thomas Pfau <[EMAIL PROTECTED]>
>User-Agent: Mozilla Thunderbird 1.0.7 (X11/20060107)
>X-Accept-Language: en-us, en
>MIME-Version: 1.0
>To: "Craig A. Berry" <[EMAIL PROTECTED]>
>Subject: Re: How to find memory leak?
>References: <[EMAIL PROTECTED]> <[EMAIL PROTECTED]>
>In-Reply-To: <[EMAIL PROTECTED]>
>Content-Type: text/plain; format=flowed
>Content-Transfer-Encoding: 7bit
>
>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/


-- 
________________________________________
Craig A. Berry
mailto:[EMAIL PROTECTED]

"... getting out of a sonnet is much more
 difficult than getting in."
                 Brad Leithauser

Reply via email to