Print call sequence of a C program (See related posts)

   1  
   2  #!/usr/bin/perl 
   3  
   4  use FileHandle;
   5  use IPC::Open2;
   6  
   7  if (! (-e "tags")) {
   8    print "Cannot find tags, will run\n";
   9    $tagCmd = "ctags *.h *.c";
  10    print "\t$tagCmd\n";
  11    system($tagCmd) && die ("Make sure ctags is installed\n");
  12  }
  13  
  14  %breakId2Func = {};
  15  %func2Args = {};
  16  
  17  #if ($ARGV[0] eq "prepare") {
  18  #  exec('ctags *.h *.c');
  19    $exec = $ARGV[0];
  20    splice(@ARGV, 0, 1);
  21    
  22    $pid = open2(*Reader, *Writer, "gdb -annotate 3 --interpreter=mi $exec");
  23  
  24    while (<Reader>) {
  25      chop;
  26      last if ($_ eq "(gdb) ") 
  27    }    
  28    print Writer  "set print pretty on\n";
  29    while (<Reader>) {
  30      chop;
  31      last if ($_ eq "(gdb) ") 
  32    }    
  33  
  34    print Writer  "set print array on\n";
  35    while (<Reader>) {
  36      chop;
  37      last if ($_ eq "(gdb) ") 
  38    }    
  39    print Writer  "set print union on\n"; 
  40    while (<Reader>) {
  41      chop;
  42      last if ($_ eq "(gdb) ") 
  43    }    
  44    
  45    print "...\n";
  46    open(GREP, 'grep "f$" ./tags|') || die "Do you have ctags?\n";
  47    while (<GREP>) {
  48      ($func, $file, $regexp, $f) = split(/\t+/);
  49      $from = index($regexp, "(") + 1;
  50      $to = rindex($regexp, ")");
  51      $args = substr($regexp, $from, $to - $from);
  52  
  53      print Writer  "break $func\n";
  54      while (<Reader>) {
  55        # Store the number of the breakpoint, we will
  56         # need it later to determine when it's hit
  57        chop;
  58         if ($_ =~ /Breakpoint/) {
  59  	 $breakId = substr($_, length('~"Breakpoint '));
  60           $breakId = substr($breakId, 0, index($breakId, " "));
  61           $breakId2Func{$breakId} = $func;
  62         } 
  63         last if $_ eq "(gdb) ";
  64       }
  65  
  66      ##############################################################
  67      # I wrote this when I didn't realize I can call "info args"
  68      # But maybe saving this is still useful for more information
  69      # like figuring out the type of variable and printing more
  70      # info about it, in case it's some pointer to struct to whatever
  71      #
  72      # Save argument names for evaluation when breakpoint is hit    
  73      # @args = split(/,/, $args );
  74      #
  75      # @$func = ();
  76      # foreach $arg (@args) {
  77      #  @typeAndVar = split(/\s+/,$arg);
  78      #
  79      #  $$func[++$#$func] = $typeAndVar[$#typeAndVar];
  80      # }
  81      #    $func2Args{$func} = \@$func;
  82      #    *x = $func2Args{$func};
  83      #    print "$func > @x\n";
  84      # }
  85  
  86  
  87  print "Calling run @ARGV\n";
  88  print Writer "run @ARGV\n";
  89  
  90  $inBreak = 0;
  91  while (<Reader>) {
  92    chop;
  93    if ($_ =~ /Breakpoint/) {
  94      #      print "$_\n";
  95      $breakId = substr($_, length('~"Breakpoint '));
  96      $breakId = substr($breakId, 0, index($breakId, ","));
  97      
  98      $func = $breakId2Func{$breakId};
  99      $inBreak = $breakId;
 100      
 101      # Which one is better?
 102      print Writer "info args\n";
 103      # print Writer "-stack-list-arguments 1 0 0\n";
 104  
 105      print Writer "cont\n";
 106    }
 107    
 108    if ($inBreak) {
 109      if ($_ =~ /~\"Continuing./) {
 110        $inBreak = 0;
 111        print "***************************\n";
 112      } else {
 113        if ($_ ne "(gdb) " &&
 114  	  $_ ne "^done" &&
 115  	  $_ ne '~"\n"' &&
 116            $_ ne '&"cont\n"' &&
 117  	 $_ !~ /stopped/) {
 118  
 119  	$_ =~ s/\\[nt]//g;
 120  	$_ =~ s/\\032//g;
 121  	$_ =~ s/^~\"//g;
 122  	print "$_\n";
 123  	
 124        }
 125      }
 126    }
 127  }
 128