[padb] r354 committed - Move the logic for finding dll finding from the C code to the perl...
padb at googlecode.com
padb at googlecode.com
Mon Dec 7 21:59:58 GMT 2009
Revision: 354
Author: apittman
Date: Mon Dec 7 13:59:10 2009
Log: Move the logic for finding dll finding from the C code to the perl
code, minfo now just calls fetch_dll_name() in a loop until it
returns null, all the complex string handling code is handled
in padb itself.
http://code.google.com/p/padb/source/detail?r=354
Modified:
/trunk/src/minfo.c
/trunk/src/padb
=======================================
--- /trunk/src/minfo.c Mon Dec 7 04:22:42 2009
+++ /trunk/src/minfo.c Mon Dec 7 13:59:10 2009
@@ -370,6 +370,21 @@
free(ans);
return 0;
}
+
+/* Fetch a string from a remote memory location, making sure there is
+ * enough memory locally to store our copy. Return mqs_ok on success */
+void *fetch_dll_name ()
+{
+ char ans[1024];
+ int i;
+
+ i = ask("dll_filename",ans);
+ if ( i != 0 ) {
+
+ return NULL;
+ }
+ return strdup(ans);
+}
int fetch_image (char *local)
{
@@ -561,82 +576,28 @@
return 0;
}
-#define PATH_MAX 1024
-
-/* Try and load a valid dll from the locations array, loop over the array
- * trying each one in turn. Return 0 if and when we managed to load one,
- * -1 otherwise
- */
-int find_and_load_dll_from_loc_array() {
- void **remote_array;
- char *dll_name;
- void *locations = find_sym("sym","mpimsgq_dll_locations");
-
- if ( locations == NULL )
- return -1;
-
- if ( find_data(NULL,(mqs_taddr_t)locations,sizeof(void
*),&remote_array) != mqs_ok ) {
- return -1;
- }
-
- if ( (dll_name = malloc(PATH_MAX)) == NULL )
- return -1;
+void find_and_load_dll()
+{
+ char *dll_name = fetch_dll_name();
+
+ if ( ! dll_name ) {
+ die("No DLL to load");
+ }
do {
- void *remote_entry = NULL;
-
- if ( find_data(NULL,(mqs_taddr_t)remote_array,sizeof(void
*),&remote_entry) != mqs_ok )
- goto error_out;
-
- if ( remote_entry == NULL )
- goto error_out;
-
- memset(dll_name,0,PATH_MAX);
-
- if ( fetch_string(NULL,dll_name,(mqs_taddr_t)remote_entry,PATH_MAX) !=
mqs_ok ) {
- goto error_out;
-
- } else {
- if ( load_msgq_dll(dll_name) == 0 ) {
- free(dll_name);
- return mqs_ok;
- }
- }
- remote_array++;
- } while ( 1 );
-
-error_out:
- free(dll_name);
- return -1;
-}
-
-void find_and_load_dll()
-{
- char *dll_name;
-
- dll_name = getenv("MPINFO_DLL");
- if ( dll_name != NULL ) {
- if ( load_msgq_dll(dll_name) != 0 ) {
- die("Could not load symbols from dll");
- }
- return;
- }
-
- /* Try the new (proposed) dll specification mechanism */
- if ( find_and_load_dll_from_loc_array() == mqs_ok )
- return;
-
- void *base = find_sym("sym","MPIR_dll_name");
- if ( base == NULL ) {
- die("Could not find MPIR_dll_name symbol");
- }
- dll_name = malloc(PATH_MAX);
- if ( fetch_string(NULL,dll_name,(mqs_taddr_t)base,PATH_MAX) != 0 ) {
- die("Could not read value of MPIR_dll_name");
- }
- if ( load_msgq_dll(dll_name) != 0 ) {
- die("Could not load symbols from dll");
- }
+
+ if ( load_msgq_dll(dll_name) == mqs_ok )
+ {
+ free(dll_name);
+ return;
+ }
+
+ free(dll_name);
+ dll_name = fetch_dll_name();
+
+ } while ( dll_name != NULL );
+
+ die("Could not find a loadable dll");
}
int
=======================================
--- /trunk/src/padb Mon Dec 7 11:12:04 2009
+++ /trunk/src/padb Mon Dec 7 13:59:10 2009
@@ -1087,7 +1087,7 @@
return -1;
} else {
- if ( length $str < 10 ) {
+ if ( length $str < 9 ) {
return hex $str;
}
@@ -6129,16 +6129,62 @@
}
sub run_minfo {
- my ( $gdb, $vp ) = @_;
+ my ( $carg, $gdb, $vp ) = @_;
my $h = {
hpid => -1,
tracepid => -1,
attached => 0,
- debug => 0,
+ debug => 1,
};
$h->{fd}{err} = *M_ERROR;
+
+ my @all_dll_filenames;
+
+ if ( defined $carg->{mpi_dll} ) {
+ push @all_dll_filenames, $carg->{mpi_dll};
+ } else {
+ my $loc = gdb_var_addr( $gdb, 'mpimsgq_dll_locations' );
+
+ if ($loc) {
+ my $psize = gdb_type_size( $gdb, 'void *' );
+ my $base = $loc;
+ my $filename;
+
+ $base = gdb_read_pointer( $gdb, $base );
+
+ do {
+ my $strp = gdb_read_pointer( $gdb, $base );
+ $filename = gdb_string( $gdb, 1024, $strp );
+ if ( defined $filename ) {
+ push @all_dll_filenames, $filename;
+ }
+ $base = _hex($base) + $psize;
+ } while ( defined $filename );
+ }
+
+ my $base = gdb_var_addr( $gdb, 'MPIR_dll_name' );
+ if ( not defined $base ) {
+ target_error( $vp,
+'Process does not appear to be using MPI (No MPIR_dll_name symbol)'
+ );
+ return;
+ }
+ my $filename = gdb_string( $gdb, 1024, $base );
+ push @all_dll_filenames, $filename;
+ }
+
+ my @dll_filenames;
+
+ my %files;
+ foreach my $filename (@all_dll_filenames) {
+ next unless -f ($filename);
+ next if defined $files{$filename};
+
+ push @dll_filenames, $filename;
+ $files{$filename} = 1;
+ }
my $cmd = $inner_conf{minfo};
$h->{hpid} = open3( $h->{fd}{wtr}, $h->{fd}{rdr}, *M_ERROR, $cmd )
@@ -6206,7 +6252,21 @@
chomp $r;
my $cmd = substr $r, 0, 4;
- if ( $cmd eq 'req:' ) {
+ if ( $r eq 'req: dll_filename' ) {
+ $stats{dll_files}++;
+ my $filename = shift @dll_filenames;
+ my $res = 'fail';
+ if ( defined $filename ) {
+ $res = "ok $filename";
+ }
+
+ print {$out} "$res\n";
+
+ if ( defined $h->{debugfd} ) {
+ print { $h->{debugfd} } "$res\n";
+ }
+
+ } elsif ( $cmd eq 'req:' ) {
my $res = minfo_handle_query( $gdb, $vp, $r, \%stats );
# Some things *do* fail here, symbol lookups for example,
@@ -6380,24 +6440,8 @@
return;
}
- my $base = gdb_var_addr( $g, 'MPIR_dll_name' );
- if ( not defined $base ) {
- target_error( $vp,
- 'Process does not appear to be using MPI (No MPIR_dll_name
symbol)'
- );
- }
-
- if ( defined $carg->{mpi_dll} ) {
- $ENV{MPINFO_DLL} = $carg->{mpi_dll};
- } else {
- if ( not defined $base ) {
- gdb_detach($g);
- gdb_quit($g);
- return;
- }
- }
-
- my @mq = run_minfo( $g, $vp );
+ my @mq = fetch_mpi_queue_gdb( $carg, $vp, $pid, $g );
+
gdb_detach($g);
gdb_quit($g);
return @mq;
@@ -6406,23 +6450,7 @@
# As above but take a gdb handle
sub fetch_mpi_queue_gdb {
my ( $carg, $vp, $pid, $g ) = @_;
-
- my $base = gdb_var_addr( $g, 'MPIR_dll_name' );
- if ( not defined $base ) {
- target_error( $vp,
- 'Process does not appear to be using MPI (No MPIR_dll_name
symbol)'
- );
- }
-
- if ( defined $carg->{mpi_dll} ) {
- $ENV{MPINFO_DLL} = $carg->{mpi_dll};
- } else {
- if ( not defined $base ) {
- return;
- }
- }
-
- my @mq = run_minfo( $g, $vp );
+ my @mq = run_minfo( $carg, $g, $vp );
return @mq;
}
@@ -6430,7 +6458,7 @@
my ( $carg, $vp, $pid ) = @_;
my @mq = fetch_mpi_queue( $carg, $vp, $pid );
- return unless $mq[0];
+
foreach my $o (@mq) {
output( $vp, $o );
}
@@ -6451,7 +6479,6 @@
foreach my $o (@mq) {
output( $vp, $o );
}
-
return;
}
More information about the padb-devel
mailing list