citrun

watch C/C++ source code execute
Log | Files | Refs | LICENSE

mem.pm (1919B)


      1 package mem;
      2 
      3 use Inline C;
      4 use Modern::Perl;
      5 use POSIX;
      6 use if $^O eq 'MSWin32', 'mem_win32';
      7 use if $^O ne 'MSWin32', 'mem_unix';
      8 use autodie;
      9 
     10 sub new {
     11 	my ($class) = @_;
     12 
     13 	my $self = {};
     14 	bless($self, $class);
     15 
     16 	Inline->init();
     17 
     18 	get_mem( $self );
     19 
     20 	# These functions provided by C at the end of this file.
     21 	my $header_size = citrun_header_size();
     22 	my $node_fixed_size = citrun_node_size();
     23 
     24 	(	$self->{magic},
     25 		$self->{major}, $self->{minor},
     26 		$self->{pids}[0], $self->{pids}[1], $self->{pids}[2],
     27 		$self->{units},
     28 		$self->{loc},
     29 		$self->{progname},
     30 		$self->{cwd}
     31 	) = unpack("Z4I7Z1024Z1024", $self->{mem});
     32 
     33 	my %trans_units;
     34 	my $node_start = get_aligned_size($header_size);
     35 
     36 	while ($node_start < $self->{size}) {
     37 		# Struct field ordering controlled by citrun.h.
     38 		my $data = substr($self->{mem}, $node_start, $node_fixed_size);
     39 		my @struct_fields = unpack("IZ256Z256", $data);
     40 
     41 		# Store a hash of information we just found.
     42 		my $buf_size = $struct_fields[0];
     43 		$trans_units{ $struct_fields[2] } = {
     44 			size => $buf_size,
     45 			comp_file_name => $struct_fields[1],
     46 			exec_buf_pos => $node_start + $node_fixed_size
     47 		};
     48 
     49 		# Calculate where the end of this node is.
     50 		my $node_end = $node_start + $node_fixed_size + ($buf_size * 8);
     51 		$node_start = get_aligned_size($node_end);
     52 	}
     53 	$self->{trans_units} = \%trans_units;
     54 
     55 	return $self;
     56 }
     57 
     58 sub get_aligned_size {
     59 	my ($unaligned_size) = @_;
     60 
     61 	my $page_mask = $mem::os_allocsize - 1;
     62 	return ($unaligned_size + $page_mask) & ~$page_mask;
     63 }
     64 
     65 sub get_buffers {
     66 	my ($self, $tu_key) = @_;
     67 
     68 	my $tu = $self->{trans_units}->{$tu_key};
     69 	my $data = substr($self->{mem}, $tu->{exec_buf_pos}, $tu->{size} * 8);
     70 	my @execs = unpack("Q$tu->{size}", $data);
     71 
     72 	return \@execs;
     73 }
     74 
     75 1;
     76 __DATA__
     77 __C__
     78 #include "../include/citrun.h"
     79 
     80 size_t
     81 citrun_header_size()
     82 {
     83 	return sizeof(struct citrun_header);
     84 }
     85 
     86 size_t
     87 citrun_node_size()
     88 {
     89 	return sizeof(struct citrun_node);
     90 }