3 files changed, 284 insertions, 0 deletions
diff --git a/gvpr/return-paths b/gvpr/return-paths
new file mode 100644
index 00000000..18297fea
--- /dev/null
+++ b/gvpr/return-paths
@@ -0,0 +1,106 @@
+// Split call sites into call site and return site nodes and add
+// return edges
+//
+// Run with graph ... | gvpr -f return-paths
+
+BEGIN {
+	// Find the immediate parent subgraph of this object
+	graph_t find_owner(obj_t o, graph_t g)
+	{
+		graph_t g1;
+		for (g1 = fstsubg(g); g1; g1 = nxtsubg(g1))
+			if(isIn(g1,o)) return g1;
+		return NULL;
+	}
+}
+
+BEG_G {
+	node_t calls[]; // Crude hash table for tracking who calls what
+	graph_t g,g2;
+	edge_t e,e2;
+	string idx;
+	node_t n, n2;
+	int i;
+
+	$tvtype = TV_en;
+}
+
+// Each call edge which hasn't already been seen
+E [op == "call" && tail.split != 1] {
+	int offset=0;
+
+	// Clear the label of this call
+	label = "";
+	g = find_owner(tail, $G);
+
+	// Consider each outgoing call. Split the node accordingly
+	n = tail;
+	for (e = fstout(tail); e; e = nxtout(e)) {
+		if (e.op == "call") {
+
+			// Split node
+			n2 = node(g, sprintf("%s%s%d", tail.name, "x", offset++));
+			copyA(tail, n2);
+			n2.line = e.line;
+			n2.label = e.line;
+			n2.col = e.col;
+			n2.split = 1;
+			n2.op = "target";
+
+			// Record this call
+			g2 = find_owner(e.head, $G);
+			i = 0;
+			while(calls[sprintf("%s%d", g2.name, ++i)]) {
+			}
+			calls[sprintf("%s%d", g2.name, i)] = n2;
+
+			// Connect original to split
+			e2 = edge(n, n2, "call");
+			e2.style = "dotted";
+			e2.weight = 50;
+
+			// Replace this outedge
+			if (n != tail) {
+				e2 = edge(n, e.head, "transformed-call");
+				copyA(e,e2);
+				e2.label = "";
+				delete($G,e);
+			}
+
+			// Record where we were
+			n = n2;
+		}
+	}
+
+	// Consider the outgoing control flow: move down to the bottom of
+	// the call sequence nodes
+	for (e = fstout(tail); e; e = nxtout(e)) {
+		if (e.op == "br") {
+			// Replace this outedge
+			e2 = edge(n,e.head,"transformed");
+			copyA(e,e2);
+			delete($G,e);
+		}
+	}
+}
+
+// Each return node: add edges back to the caller
+N [op == "ret"] {
+	for (g = fstsubg($G); g; g = nxtsubg(g)) {
+		if(isIn(g,$)) {
+			i = 0;
+			while(calls[sprintf("%s%d", g.name, ++i)]) {
+				e = edge($, calls[sprintf("%s%d", g.name, i)], "return");
+				e.style = "dotted";
+				e.op = "ret";
+				e.line = e.tail.line;
+				e.weight = 5;
+			}
+		}
+	}
+}
+
+
+END_G {
+	write($);
+}
diff --git a/gvpr/subg-fwd b/gvpr/subg-fwd
new file mode 100644
index 00000000..8950fa5c
--- /dev/null
+++ b/gvpr/subg-fwd
@@ -0,0 +1,78 @@
+// Compute the forward partition of the chosen function
+//
+// Run with graph ... | gvpr -f return-paths | gvpr -f subg-fwd -a functionname
+//       or graph ... | gvpr -f subg-fwd
+
+
+BEGIN {
+	// Find the immediate parent subgraph of this object
+	graph_t find_owner(obj_t o, graph_t g)
+	{
+		graph_t g1;
+		for (g1 = fstsubg(g); g1; g1 = nxtsubg(g1))
+			if(isIn(g1,o)) return g1;
+		return NULL;
+	}
+}
+
+BEG_G {
+	graph_t sg = subg ($, sprintf("incoming-%s", ARGV[0]));
+	graph_t returns = graph("return-edges", ""); // Temporary graph to hold return edges
+	graph_t target, g, g2;
+	node_t n;
+	edge_t e;
+	int i;
+
+	$tvtype = TV_fwd;
+
+	// find the ep corresponding to ARG[0]
+	for (g = fstsubg($G); g; g = nxtsubg(g)) {
+		if(g.fun == ARGV[0]) {
+			n = node($,g.ep);
+			$tvroot = n;
+			n.style = "filled";
+			target = g;
+			break;
+		}
+	}
+	if(!target) {
+		printf(2, "Function %s not found\n", ARGV[0]);
+		exit(1);
+	}
+}
+
+// Preserve external functions
+E [op == "extern"] {
+	subnode (sg, head);
+}
+
+// Move unused return edges into a separate graph so they don't get followed
+N [op == "ret"] {
+	for (e = fstout($); e; e = nxtout(e))
+		if (e.op == "ret" && !isIn(sg, e.head)) {
+			clone(returns, e);
+			delete($G, e);
+		}
+}
+
+// Recover elided return edge for this target node
+N [op == "target" && indegree == 1] {
+	n = copy(returns, $);
+	e = fstin(n); // each target node can only have one return edge
+	e = edge(copy(sg, e.tail), $, "recovered"); // clone should work here, but doesn't
+	copyA(fstin(n), e);
+}
+
+// Copy relevant nodes
+N {
+	$tvroot = NULL;
+
+	g = find_owner($, $G);
+	if(g && g != sg)
+		subnode (copy(sg, g), $);
+}
+
+END_G {
+	induce(sg);
+	write(sg);
+}
diff --git a/gvpr/subg-rev b/gvpr/subg-rev
new file mode 100644
index 00000000..add3b820
--- /dev/null
+++ b/gvpr/subg-rev
@@ -0,0 +1,100 @@
+// Compute the reverse partition of the chosen function
+//
+// Run with graph ... | gvpr -f return-paths | gvpr -f subg-rev -a functionname
+
+
+BEGIN {
+	// Find the immediate parent subgraph of this object
+	graph_t find_owner(obj_t o, graph_t g)
+	{
+		graph_t g1;
+		for (g1 = fstsubg(g); g1; g1 = nxtsubg(g1))
+			if(isIn(g1,o)) return g1;
+		return NULL;
+	}
+}
+
+BEG_G {
+	graph_t calls[]; // Crude hash table for tracking who calls what
+	graph_t sg = subg ($, "reachable");
+	graph_t target, g, g2;
+	edge_t e;
+	int i;
+
+	$tvtype = TV_rev;
+
+	// find the ep corresponding to ARG[0]
+	for (g = fstsubg($G); g; g = nxtsubg(g)) {
+		if(g.fun == ARGV[0]) {
+			node_t n;
+			n = node($,g.ep);
+			$tvroot = n;
+			n.style = "filled";
+			target = g;
+			break;
+		}
+	}
+	if(!target) {
+		printf(2, "Function %s not found\n", ARGV[0]);
+		exit(1);
+	}
+
+	// Add the incoming call edges to the allowed call list
+	i = 0;
+	for(e = fstin(n); e; e = nxtin(e)) {
+		if (e.op = "call") {
+			g2 = find_owner(e.tail, $G);
+			calls[sprintf("%s%d", g2.name, ++i)] = g;
+		}
+	}
+}
+
+
+E [op == "ret"] {
+
+	// This is a return edge. Allow the corresponding call
+	g = find_owner(head, $G);
+	i = 0;
+	while(calls[sprintf("%s%d", g.name, ++i)]) {
+	}
+	calls[sprintf("%s%d", g.name, i)] = find_owner(tail, $G);
+	g2 = find_owner(tail, $G);
+}
+
+
+N [split == 1] {
+
+	// Ignore returns back to the target function
+	for (e = fstin($); e; e = nxtin(e))
+		if (e.op == "ret" && isIn(target,e.tail))
+			delete($G,e);
+}
+
+N {
+	$tvroot = NULL;
+
+	for (e = fstin($); e; e = nxtin(e)) {
+		if (e.op == "call") {
+			int found = 0;
+			g = find_owner(e.tail, $G);
+			i = 0;
+			while(calls[sprintf("%s%d", g.name, ++i)]) {
+				if (isIn(calls[sprintf("%s%d", g.name, i)],e.head))
+					found = 1;
+			}
+			g2 = find_owner(e.head, $G);
+			if (!found) delete($G, e);
+		}
+	}
+
+	for (g = fstsubg($G); g; g = nxtsubg(g)) {
+		if(isIn(g,$) && g != sg) {
+			subnode (copy(sg, g), $);
+		}
+	}
+}
+
+END_G {
+	induce(sg);
+	write(sg);
+}