view release on metacpan or  search on metacpan

lib/Asm/C.pm  view on Meta::CPAN

use Data::Dump qw(dump);
use Data::Table::Text qw(:all);
use feature qw(say current_sub);

#D1 Asm::C                                                                      # Extract macro values and structure details from C programs.

#D2 Structures                                                                  # Extract structure details from C programs.

my %extractCStructure;                                                          # Structured extracted from C files

sub extractCStructure($)                                                        # Extract the details of a structure
 {my ($input) = @_;                                                             # Input C file - a temporary one is ok

  return $extractCStructure{$input} if exists $extractCStructure{$input};       # Return cached value if it exists
  return undef unless confirmHasCommandLineCommand(q(gcc));                     # Check that we have gcc

  my $inputFile = -f $input ? $input : writeTempFile($input);                   # Make sure input is in a file

  my $e = qq(gcc -c -x c -fno-eliminate-unused-debug-symbols -fno-eliminate-unused-debug-types -gdwarf $inputFile -o a.out; readelf -w a.out; rm a.out);
  my @e = qx($e);                                                               # Structure details via dwarf debugging info
  my @s;                                                                        # Structure

lib/Asm/C.pm  view on Meta::CPAN

       }
      else
       {say STDERR "No base for offset: $type";
       }
     }
   }

  $extractCStructure{$input} = \%s                                              # Structure details
 } # extractCStructure

sub extractCField($$$)                                                          # Extract the details of a field in a structure in a C file
 {my ($input, $structure, $field) = @_;                                         # Input file, structure name,  field within structure
  if     (my $s = extractCStructure $input)                                     # Structures in file
   {if   (my $S = $$s{$structure})                                              # Found structure
     {if (my $F = $S->fields)                                                   # Structure has fields
       {return $$F{$field};                                                     # Field detail
       }
     }
   }
  undef                                                                         # Parse failed or no such structure
 } # extractCField

sub extractCFieldLoc($$$)                                                       # Extract the offset to the location of a field in a structure in a C file
 {my ($input, $structure, $field) = @_;                                         # Input file, structure name,  field within structure
  if (my $f = extractCField($input, $structure, $field))                        # Structures in file
   {return $f->loc;                                                             # Offset to field location
   }
  undef                                                                         # Parse failed or no such structure or no such field
 } # extractCFieldLoc

sub extractCFieldSize($$$)                                                      # Extract the size of a field in a structure in a C file
 {my ($input, $structure, $field) = @_;                                         # Input file, structure name,  field within structure
  if (my $f = extractCField($input, $structure, $field))                        # Structures in file
   {return $f->size;                                                            # Size of field
   }
  undef                                                                         # Parse failed or no such structure or no such field
 } # extractCFieldSize

sub extractCFieldType($$$)                                                      # Extract the type of a field in a structure in a C file
 {my ($input, $structure, $field) = @_;                                         # Input file, structure name,  field within structure
  if (my $f = extractCField($input, $structure, $field))                        # Structures in file
   {return $f->type;                                                            # Type of field
   }
  undef                                                                         # Parse failed or no such structure or no such field
 } # extractCFieldType

sub extractCStructureFields($$)                                                 # Extract the names of the fields in a C structure
 {my ($input, $structure) = @_;                                                 # Input file, structure name
  if (my $s = extractCStructure $input)                                         # Structures in file
   {if (my $S = $$s{$structure})                                                # Found structure
     {if (my $F = $S->fields)                                                   # Structure has fields
       {return sort keys %$F;                                                   # Return names of fields in structure in ascending order
       }
     }
   }
  ()                                                                            # Parse failed or no such structure
 } # extractCStructureSize

sub extractCStructureSize($$)                                                   # Extract the size of a C structure
 {my ($input, $structure) = @_;                                                 # Input file, structure name
  if (my $s = extractCStructure $input)                                         # Structures in file
   {if (my $S = $$s{$structure})                                                # Found structure
     {return $S->size;                                                          # Return structure size
     }
   }
  undef                                                                         # Parse failed or no such structure
 } # extractCStructureSize

#D2 Macros                                                                      # Extract macro values from C header files

my %extractMacroDefinitionsFromCHeaderFile;                                     # Cache macro definitions

sub extractMacroDefinitionsFromCHeaderFile($)                                   # Extract the macro definitions found in a C header file using gcc
 {my ($includeFile) = @_;                                                       # C Header file name as it would be entered in a C program
  my $d = $extractMacroDefinitionsFromCHeaderFile{$includeFile};                # Cached macro definitions
  return $d if $d;                                                              # Return cached value

  confirmHasCommandLineCommand("gcc");                                          # Check gcc
  my @l = qx(gcc -E -dM -include "$includeFile" - < /dev/null);                 # Use gcc to extract macro definitions

  my %d;
  for my $l(@l)                                                                 # Extract macro definitions
   {if ($l =~ m(\A#define\s+(\S+)\s+(\S+)(.*)))
     {$d{$1} = $2;
     }
   }

  $extractMacroDefinitionsFromCHeaderFile{$includeFile} = \%d;                  # Return definitions
 }

sub extractMacroDefinitionFromCHeaderFile($$)                                   # Extract a macro definitions found in a C header file using gcc
 {my ($includeFile, $macro) = @_;                                               # C Header file name as it would be entered in a C program, macro name
  if (my $d = extractMacroDefinitionsFromCHeaderFile($includeFile))             # Get macro definitions
   {return $$d{$macro};
   }
  undef
 }

#d
#-------------------------------------------------------------------------------
# Export - eeee