SPUG: Question for somebody -- Releasing memory
Daniel Pommert
dpommert at bestnet.com
Fri Nov 3 13:48:13 CST 2000
Here is the code that I refered to yesterday. There are 3 routines (and two
helper routines). The first is used to find any memory cycles. The second
is used to release all memory accessible from a reference. The third is a
Unix (System 5) method of getting your memory stats. Brief PODs are
included. These aren't perfect, but I found them very useful.
-- Daniel Pommert
##-------------------------------------------------------------------------
##
## f i n d _ c y c l e
##
## Find a reference cycle below the reference handed in as a parameter.
##
## Input:
## Parameter:
## $ref - The reference where scanning should begin
## Output:
## Return:
## Scalar context:
## Null if no cycle. A string describing how to get to looped
## item if there is a cycle.
## List context:
## Empty list if no cycle. 2 element list containing the deeper
## and shallower version of the duplicating reference loop.
##
=pod
=item B<find_cycle>
Find a reference cycle below the reference handed in as a parameter.
=over 4
=item S< Parameters:>
=item S< I<$ref>>
The reference where scanning should begin.
=item S< Returns:>
=item S< Scalar context:>
Null if no cycle. A string describing how to get to the looped item if
there is a cycle.
=item S< List context:>
Empty list if there is no cycle.
A two element list containing the deeper and shallower versions of the
duplicated reference loop.
=back
=cut
##
##-------------------------------------------------------------------------
sub find_cycle {
my ($ref) = @_;
# If not a reference, we are done
return '' unless defined($ref) && ref($ref);
# Pass off to recursive subroutine. It will return and empty string
# or the first cycle encountered.
_find_cycle_rec($ref, '');
}
##-------------------------------------------------------------------------
##
## _ f i n d _ c y c l e _ r e c
##
## Internal, recursive routine that supports find_cycle.
##
##-------------------------------------------------------------------------
sub _find_cycle_rec {
my ($ref, $path, %visited) = @_;
my ($frc_res, @frc_arr_res, $k, $v, $i);
# Have we been here before? Yes means cycle.
return (wantarray ? ($path, $visited{"$ref"}) : $path)
if exists $visited{"$ref"};
# So. We have a reference. Note it in the %visited table.
$visited{"$ref"} = $path;
# If scalar reference
if (ref($ref) eq 'REF') {
return _find_cycle_rec($$ref, "${path}->", %visited);
}
# If hash reference
elsif (ref($ref) eq 'HASH') {
return '' unless %$ref;
foreach $k (keys %$ref) {
$v = $ref->{$k};
next unless defined($v) && ref($v);
if (wantarray) {
@frc_arr_res = _find_cycle_rec($v, "${path}->{$k}",
%visited);
return @frc_arr_res if @frc_arr_res;
}
else {
$frc_res = _find_cycle_rec($v, "${path}->{$k}", %visited);
return $frc_res if defined($frc_res) && $frc_res ne '';
}
}
}
# If array reference
elsif (ref($ref) eq 'ARRAY') {
return '' unless @$ref;
foreach $i (0 .. $#{$ref}) {
$v = $ref->[$i];
next unless defined($v) && ref($v);
if (wantarray) {
@frc_arr_res = _find_cycle_rec($v, "${path}->[$i]",
%visited);
return @frc_arr_res if @frc_arr_res;
}
else {
$frc_res = _find_cycle_rec($v, "${path}->[$i]", %visited);
return $frc_res if defined($frc_res) && $frc_res ne '';
}
}
}
# We will ignore CODE and GLOB objects
elsif (ref($ref) eq 'CODE' || ref($ref) eq 'GLOB') {
return wantarray ? () : '';
}
# Otherwise, check the stringification.
# If a blessed hash
elsif ("$ref" =~ m/=HASH\(/) {
return '' unless %$ref;
foreach $k (keys %$ref) {
$v = $ref->{$k};
next unless defined($v) && ref($v);
if (wantarray) {
@frc_arr_res = _find_cycle_rec($v, "${path}->{$k}",
%visited);
return @frc_arr_res if @frc_arr_res;
}
else {
$frc_res = _find_cycle_rec($v, "${path}->{$k}", %visited);
return $frc_res if $frc_res ne '';
}
}
}
# If a blessed array reference
elsif ("$ref" =~ m/=ARRAY\(/) {
return '' unless @$ref;
foreach $i (0 .. $#{$ref}) {
$v = $ref->[$i];
next unless defined($v) && ref($v);
if (wantarray) {
@frc_arr_res = _find_cycle_rec($v, "${path}->[$i]",
%visited);
return @frc_arr_res if @frc_arr_res;
}
else {
$frc_res = _find_cycle_rec($v, "${path}->[$i]", %visited);
return $frc_res if defined($frc_res) && $frc_res ne '';
}
}
}
# Otherwise, we haven't found any cycles. Return a null string
return wantarray ? () : '';
}
##-------------------------------------------------------------------------
##
## d e l e t e _ s t r u c t u r e
##
## Recurse through structure heirarchy and delete everything.
##
## Input:
## Parameter:
## $ref - The reference where deletion should begin
## Output:
## Return: None
##
=pod
=item B<delete_structure>
Recurse through structure heirarchy and delete everything.
=over 4
=item S< Parameters:>
=item S< I<$ref>>
The reference where deletion should begin.
=item S< Returns:>
None.
=back
=cut
##
##-------------------------------------------------------------------------
sub delete_structure {
my ($ref) = @_;
# If not a reference, we are done
return unless defined($ref) && ref($ref);
# Pass off to recursive subroutine. It will return and empty string
# or the first cycle encountered.
_delete_structure_rec($ref);
}
##-------------------------------------------------------------------------
##
## _ d e l e t e _ s t r u c t u r e _ r e c
##
## Internal, recursive routine that supports delete_structure.
##
##-------------------------------------------------------------------------
sub _delete_structure_rec {
my ($ref, %visited) = @_;
my ($frc_res, @frc_arr_res, $k, $v, $i);
# Have we been here before? Yes means cycle. Just return. Will be
# handled at a higher level.
return if exists $visited{"$ref"};
# Don't follow non-references
return unless defined($ref) && ref($ref);
# So. We have a reference. Note it in the %visited table.
$visited{"$ref"} = 1;
# If scalar reference
if (ref($ref) eq 'REF') {
_find_cycle_rec($$ref, %visited);
undef $$ref;
return;
}
# If hash reference
elsif (ref($ref) eq 'HASH' || "$ref" =~ m/=HASH\(/) {
return unless %$ref;
foreach $k (keys %$ref) {
$v = $ref->{$k};
delete $ref->{$k};
_delete_structure_rec($v, %visited);
}
return;
}
# If array reference
elsif (ref($ref) eq 'ARRAY' || "$ref" =~ m/=ARRAY\(/) {
return unless @$ref;
while ($v = shift(@{$ref})) {
_delete_structure_rec($v, %visited);
}
return;
}
# We will ignore CODE and GLOB objects
elsif (ref($ref) eq 'CODE' || ref($ref) eq 'GLOB') {
return;
}
# Otherwise, flag that we don't know what to do
else {
print STDERR "utility::_delete_structure_rec: Don't know how to
delete $ref\n";
return;
}
}
##-------------------------------------------------------------------------
##
## g e t _ m e m _ s t a t s
##
## Find a reference cycle below the reference handed in as a parameter.
##
## Input:
## Parameters: None
## External:
## /proc/$$/status - Source of memory status information
## Output:
## Return:
## List context:
## Two elements: stack size in bytes, heap size in bytes
## Scalar context:
## A string describing the stack and heap size in bytes
##
=pod
=item B<get_mem_stats>
Find a reference cycle below the reference handed in as a parameter.
=over 4
=item S< Parameters:>
None.
=item S< Returns:>
=item S< Scalar context:>
A string describing the stack and heap size in bytes.
=item S< List context:>
Two elements: stack size in bytes, heap size in bytes.
=back
=cut
##
##-------------------------------------------------------------------------
sub get_mem_stats {
my ($status, $heap_sz, $stack_sz);
# Read the status. Return with bad values if there is a problem.
open (STATUS, "</proc/$$/status") or
return wantarray ? (-1, -1) : "Unable to open /proc/$$/status";
sysread (STATUS, $status, 1024) or
return wantarray ? (-1, -1) : "Unable to read /proc/$$/status";
close (STATUS);
# Decode it into stack and heap size
($heap_sz, $stack_sz) =
unpack('x52Ix4I', $status);
# Return appropriately
if (wantarray) {
return ($stack_sz, $heap_sz);
}
else {
# Put commas in numbers
1 while ($stack_sz =~ s/(\d)(\d\d\d)(?=\D|$)/$1,$2/);
1 while ($heap_sz =~ s/(\d)(\d\d\d)(?=\D|$)/$1,$2/);
return "Stack size=$stack_sz Heap size=$heap_sz";
}
}
-----Original Message-----
From: Daniel Pommert
To: 'Owskey, Tom '; 'spug-list at pm.org '
Sent: 11/2/00 2:15 PM
Subject: RE: SPUG: Question for somebody -- Releasing memory
As stated by everyone else, normally, when the last reference to an
object
is eliminated, the object is destroyed and the memory is released to the
memory pool.
There are some gotchya, however:
1) As mentioned above, sometimes the Perl system, itself has a memory
leak.
This is rare, is usually minor is size, and can usually be discounted.
2) Reference cycles can cause objects to never be considered to be
"free-able". I wrote a routine (which I don't have on me at my present
site) that will take a reference and trace down all of the accessible
references looking for reference cycles. You would put it in your
package's
DESTROY method and give it your $this or $self reference. It would tell
you
if that object contained or referred indirectly to something that had a
reference cycle. It is a recursive (set of) routine written in Perl.
Its
deficiency is that it can't peer into closures.
Another way that you could find where you might have a memory leak is to
get
your program to voluntarily cease execution and then use the caller
function
in your package's DESTROY method. If (I think) caller(1) says that it
was
called "during global destruction" then that object is being freed
during
Mark and Sweep phase of garbage collection. This means that that object
was
involved in a reference cycle and is (probably) garbage while the
program is
running.
When I was working on a large server program, I encountered some of
these
"DESTROYed during global destruction" situations that I was unable to
clean
up. I did use closures quite a bit and am suspicious that that may have
been the source of my problem.
I'll see if I can bring in the cycle finder routine and post it to this
group.
Daniel Pommert
BEST Consulting
(at) AT&T Wireless Systems
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
POST TO: spug-list at pm.org PROBLEMS: owner-spug-list at pm.org
Subscriptions; Email to majordomo at pm.org: ACTION LIST EMAIL
Replace ACTION by subscribe or unsubscribe, EMAIL by your Email-address
For daily traffic, use spug-list for LIST ; for weekly, spug-list-digest
Seattle Perl Users Group (SPUG) Home Page: http://www.halcyon.com/spug/
More information about the spug-list
mailing list