gvpr/subg-rev

   1 #!/usr/bin/gvpr -f
   2 // Compute the reverse partition of the chosen function
   3 //
   4 // Run with graph ... | return-paths | subg-rev -a functionname
   5
   6
   7 BEGIN {
   8         // Find the immediate parent subgraph of this object
   9         graph_t find_owner(obj_t o, graph_t g)
  10         {
  11                 graph_t g1;
  12                 for (g1 = fstsubg(g); g1; g1 = nxtsubg(g1))
  13                         if(isIn(g1,o)) return g1;
  14                 return NULL;
  15         }
  16 }
  17
  18 BEG_G {
  19         graph_t calls[]; // Crude hash table for tracking who calls what
  20         graph_t sg = subg ($, "reachable");
  21         graph_t target, g, g2;
  22         edge_t e;
  23         int i;
  24
  25         $tvtype = TV_rev;
  26
  27         // find the ep corresponding to ARG[0]
  28         for (g = fstsubg($G); g; g = nxtsubg(g)) {
  29                 if(g.fun == ARGV[0]) {
  30                         node_t n;
  31                         n = node($,g.ep);
  32                         $tvroot = n;
  33                         n.style = "filled";
  34                         target = g;
  35                         break;
  36                 }
  37         }
  38         if(!target) {
  39                 printf(2, "Function %s not found\n", ARGV[0]);
  40                 exit(1);
  41         }
  42
  43         // Add the incoming call edges to the allowed call list
  44         i = 0;
  45         for(e = fstin(n); e; e = nxtin(e)) {
  46                 if (e.op = "call") {
  47                         g2 = find_owner(e.tail, $G);
  48                         calls[sprintf("%s%d", g2.name, ++i)] = g;
  49                 }
  50         }
  51 }
  52
  53
  54 E [op == "ret"] {
  55
  56         // This is a return edge. Allow the corresponding call
  57         g = find_owner(head, $G);
  58         i = 0;
  59         while(calls[sprintf("%s%d", g.name, ++i)]) {
  60         }
  61         calls[sprintf("%s%d", g.name, i)] = find_owner(tail, $G);
  62         g2 = find_owner(tail, $G);
  63 }
  64
  65
  66 N [split == 1] {
  67
  68         // Ignore returns back to the target function
  69         for (e = fstin($); e; e = nxtin(e))
  70                 if (e.op == "ret" && isIn(target,e.tail))
  71                         delete($G,e);
  72 }
  73
  74 N {
  75         $tvroot = NULL;
  76
  77         for (e = fstin($); e; e = nxtin(e)) {
  78                 if (e.op == "call") {
  79                         int found = 0;
  80                         g = find_owner(e.tail, $G);
  81                         i = 0;
  82                         while(calls[sprintf("%s%d", g.name, ++i)]) {
  83                                 if (isIn(calls[sprintf("%s%d", g.name, i)],e.head))
  84                                         found = 1;
  85                         }
  86                         g2 = find_owner(e.head, $G);
  87                         if (!found) delete($G, e);
  88                 }
  89         }
  90
  91         for (g = fstsubg($G); g; g = nxtsubg(g)) {
  92                 if(isIn(g,$) && g != sg) {
  93                         subnode (copy(sg, g), $);
  94                 }
  95         }
  96 }
  97
  98 END_G {
  99         induce(sg);
 100         write(sg);
 101 }