Fri Feb 03 19:09:56 2012: Request 74578 was acted upon. Transaction: Correspondence added by DOUGW Queue: Win32-API Subject: Win32::API::Struct not aligned on 64 bit Broken in: 0.64 Severity: Normal Owner: Nobody Requestors: do...@cpan.org Status: open Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=74578 >
On Fri Feb 03 18:36:54 2012, DOUGW wrote: > On Fri Feb 03 18:35:45 2012, DOUGW wrote: > > > > That said, Win32::API::getPack() and the calls to it are wrong. It > > I mean Win32::API::Struct::getUnpack. Sorry for the confusion. I have a patch for this pack/unpack issue (the align is still off). I'm using the struct as the basis for the unpack via getUnpack() to get the size and unpack template. Unfortunately, I've switched from AS perl to Strawberry, and upgraded to 5.14. Now the program works ok, but I get "Free to wrong pool" when the program exits. I'll try re-installing Win32::API. Or I'm going to see what happens when I use AS perl again.
--- Struct_orig.pm 2012-02-03 15:39:35 -0800 +++ Struct.pm 2012-02-03 15:52:38 -0800 @@ -200,9 +200,10 @@ $packing .= $subpacking; $packed_size += $subpacksize; } else { + my $repeat = 1; if($type =~ /\w\*(\d+)/) { - my $size = $1; - $type = "a$size"; + $repeat = $1; + $type = "a$repeat"; } DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $type\n"; @@ -215,9 +216,9 @@ } push(@recipients, $self); $type_size = Win32::API::Type::sizeof($orig); - $type_align = (($packed_size + $type_size) % $type_size); + $type_align = (($packed_size + ($type_size*$repeat)) % $type_size); $packing .= "x" x $type_align . $type; - $packed_size += $type_size + $type_align; + $packed_size += ($type_size*$repeat) + $type_align; } } @@ -253,32 +254,33 @@ foreach my $member (@{ $self->{typedef} }) { ($name, $type, $orig) = @$member; if($type eq '>') { - my($subpacking, @subitems, $subpacksize) = $self->{$name}->getUnpack(); + my($subpacking, $subpacksize, @subitems) = $self->{$name}->getUnpack(); DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $subpacking\n"; $packing .= $subpacking; $packed_size += $subpacksize; push(@items, @subitems); } else { + my $repeat = 1; if($type =~ /\w\*(\d+)/) { - my $size = $1; - $type = "Z$size"; + my $repeat = $1; + $type = "Z$repeat"; } DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $type\n"; $type_size = Win32::API::Type::sizeof($orig); - $type_align = (($packed_size + $type_size) % $type_size); + $type_align = (($packed_size + ( $type_size * $repeat )) % $type_size); $packing .= "x" x $type_align . $type; - $packed_size += $type_size + $type_align; + $packed_size += ( $type_size * $repeat ) + $type_align; push(@items, $name); } } DEBUG "(PM)Struct::getUnpack($self->{__typedef__}): unpack($packing, @items)\n"; - return($packing, @items, $packed_size); + return($packing, $packed_size, @items); } sub Unpack { my $self = shift; - my($packing, @items) = $self->getUnpack(); + my($packing, undef, @items) = $self->getUnpack(); my @itemvalue = unpack($packing, $self->{buffer}); DEBUG "(PM)Struct::Unpack: unpack($packing, buffer) = @itemvalue\n"; foreach my $i (0..$#items) {