packing.pl

#!/usr/bin/env perl
#
# Calculate structure offsets by directly asking
# the currently configured compiler.
#
# This will be moved to Win32::API::Packing (or similar)
#
# $Id$

use strict;
use warnings;

use Data::Dumper;
use ExtUtils::CBuilder;
use File::Temp;

sub build_packing_code {
    my ($struct) = @_;

    if (!$struct || ref $struct ne 'ARRAY') {
        return;
    }

    # "void *" fails with MSVC with "unknown size of void *" error
    my $ptr_type = 'char *';

    my $code = <<END_OF_C;
#include <stdio.h>

/* Structure declaration */
struct s1 {
%s
};

struct s1 ts;

int main() {

	/* Start of struct pointer */
	${ptr_type}start = ($ptr_type) &ts;

	/* Moving "member" pointer */
	${ptr_type}p;

	/* Output struct member offsets */
%s
	return 0;
}
END_OF_C

    my @struct_decl   = ();
    my @struct_output = ();

    for my $member (@{$struct}) {
        push @struct_decl, qq{\t$member;};

        my ($type, $name) = split m{\s+}, $member, 2;
        $type =~ s{^\s*}{};
        $name =~ s{\s*$}{};

        push @struct_output,
            qq{\tp = ($ptr_type) &ts.$name;},
            qq{\tprintf("struct.$name\\t%d\\n", p - start);},
            q{};
    }

    $code = sprintf($code, join("\n", @struct_decl), join("\n", @struct_output));

    return $code;
}

sub compile_code {
    my ($code) = @_;

    my $fh = File::Temp->new(SUFFIX => '.c', UNLINK => 0);
    print $fh $code;
    close $fh;

    my $fname    = $fh->filename();
    my $exe_file = "$fname.exe";

    # Use ExtUtils::CBuilder ???
    my $cc     = 'gcc';
    my $cc_cmd = qq{$cc $fname -o $exe_file};
    my $status = system($cc_cmd);
    $status >>= 8;
    if ($status != 0) {
        die "Temp file $fname didn't compile: $!\n";
    }

    unlink $fname;
    return $exe_file;

}

sub compile_code_eucb {
    my ($code) = @_;

    my $fh = File::Temp->new(SUFFIX => '.c', UNLINK => 0);
    print $fh $code;
    close $fh;

    my $fname    = $fh->filename();
    my $exe_file = "$fname.exe";

    my $eucb = ExtUtils::CBuilder->new();
    my $obj_file = $eucb->compile(source => $fname);
    $exe_file = $eucb->link_executable(
        objects  => $obj_file,
        exe_file => $exe_file
    );
    unlink $fname;
    return $exe_file;
}

sub parse_packing_output {
    my ($exe_file) = @_;

    my @output = qx{$exe_file};
    if (!@output) {
        die "Couldn't get any packing info from $exe_file: $!\n";
    }

    my @struct;

    for (@output) {
        next if m{^\s*$};
        chomp;
        my ($member, $offset) = split "\t", $_, 2;
        push @struct, {name => $member, offset => $offset};
    }

    return \@struct;
}

my $struct = ['int i', 'char c1', 'char c2', 'char c3', 'int j',];

my $code = build_packing_code($struct);
my $exe  = compile_code_eucb($code);
if (!$exe) {
    die "Code didn't compile. Too bad.\n";
}

my $packing = parse_packing_output($exe);
print Dumper($packing);