1 #!/usr/bin/gvpr -f
   2 // Compute the forward partition of the chosen function
   3 //
   4 // Run with graph ... | return-paths | subg-fwd -a functionname
   5 //       or graph ... | subg-fwd
   6 
   7 
   8 BEGIN {
   9         // Find the immediate parent subgraph of this object
  10         graph_t find_owner(obj_t o, graph_t g)
  11         {
  12                 graph_t g1;
  13                 for (g1 = fstsubg(g); g1; g1 = nxtsubg(g1))
  14                         if(isIn(g1,o)) return g1;
  15                 return NULL;
  16         }
  17 }
  18 
  19 BEG_G {
  20         graph_t sg = subg ($, sprintf("incoming-%s", ARGV[0]));
  21         graph_t returns = graph("return-edges", ""); // Temporary graph to hold return edges
  22         graph_t target, g, g2;
  23         node_t n;
  24         edge_t e;
  25         int i;
  26 
  27         $tvtype = TV_fwd;
  28 
  29         // find the ep corresponding to ARG[0]
  30         for (g = fstsubg($G); g; g = nxtsubg(g)) {
  31                 if(g.fun == ARGV[0]) {
  32                         n = node($,g.ep);
  33                         $tvroot = n;
  34                         n.style = "filled";
  35                         target = g;
  36                         break;
  37                 }
  38         }
  39         if(!target) {
  40                 printf(2, "Function %s not found\n", ARGV[0]);
  41                 exit(1);
  42         }
  43 }
  44 
  45 // Preserve external functions
  46 E [op == "extern"] {
  47         subnode (sg, head);
  48 }
  49 
  50 // Move unused return edges into a separate graph so they don't get followed
  51 N [op == "ret"] {
  52         for (e = fstout($); e; e = nxtout(e))
  53                 if (e.op == "ret" && !isIn(sg, e.head)) {
  54                         clone(returns, e);
  55                         delete($G, e);
  56                 }
  57 }
  58 
  59 // Recover elided return edge for this target node
  60 N [op == "target" && indegree == 1] {
  61         n = copy(returns, $);
  62         e = fstin(n); // each target node can only have one return edge
  63         e = edge(copy(sg, e.tail), $, "recovered"); // clone should work here, but doesn't
  64         copyA(fstin(n), e);
  65 }
  66 
  67 // Copy relevant nodes
  68 N {
  69         $tvroot = NULL;
  70 
  71         g = find_owner($, $G);
  72         if(g && g != sg)
  73                 subnode (copy(sg, g), $);
  74 }
  75 
  76 END_G {
  77         induce(sg);
  78         write(sg);
  79 }