[Jifty-commit] r5371 - Runops-Hook/trunk

[Jifty commits]

Author: nothingmuch
Date: Wed May  7 04:14:46 2008
New Revision: 5371

Modified:
   Runops-Hook/trunk/Hook.xs

Log:
perl space hook with no args yet

Modified: Runops-Hook/trunk/Hook.xs
==============================================================================
--- Runops-Hook/trunk/Hook.xs	(original)
+++ Runops-Hook/trunk/Hook.xs	Wed May  7 04:14:46 2008
@@ -10,17 +10,27 @@
 static bool Runops_Hook_enabled = 0;
 static UV Runops_Hook_threshold = 0;
 
+static SV *Runops_Hook_perl_hook;
+
+/* this is the modified runloop */
 int runops_hooked(pTHX)
 {
 	if ( !Runops_Hook_op_counters )
 		Runops_Hook_op_counters = newHV();
 
 	for (;PL_op;) {
+		/* global flag controls all hooking behavior */
 		if (Runops_Hook_enabled) {
 			if (Runops_Hook_threshold == 0) {
+				/* no threshold set means simple hooking */
 				if (Runops_Hook_hook(aTHX))
 					continue;
 			} else {
+				/* having a threshold means that only ops that are hit enough
+				 * times get hooked, the idea is that this can be used for
+				 * trace caching */
+
+				/* unfortunately we need to keep the counters in a hash */
 				SV **count = hv_fetch(Runops_Hook_op_counters, (char *)PL_op, sizeof(PL_op), 1);
 				UV c       = SvTRUE(*count) ? SvUV(*count) + 1 : 1;
 				sv_setuv(*count, c);
@@ -41,12 +51,55 @@
 	return 0;
 }
 
+void
+Runops_Hook_enable () {
+	Runops_Hook_enabled = 1;
+}
+
+void
+Runops_Hook_disable () {
+	Runops_Hook_enabled = 0;
+}
+
+/* this is the default hook that does nothing */
 bool
 Runops_Hook_noop (pTHX) {
 	/* resume normally */
 	return 0;
 }
 
+/* this is a hook that calls to a perl code ref */
+bool
+Runops_Hook_perl (pTHX) {
+	dSP;
+
+	int ret_count;
+	SV *sv_ret;
+	bool ret;
+
+	Runops_Hook_disable();
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	PUTBACK;
+	ret_count = call_sv(Runops_Hook_perl_hook, G_SCALAR|G_NOARGS);
+
+	SPAGAIN;
+
+	sv_ret = POPs;
+	ret = SvTRUE(sv_ret);
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	Runops_Hook_enable();
+
+	return 0;
+}
+
 void
 Runops_Hook_clear_hook () {
 	Runops_Hook_hook = Runops_Hook_noop;
@@ -58,13 +111,21 @@
 }
 
 void
-Runops_Hook_enable () {
-	Runops_Hook_enabled = 1;
+Runops_Hook_clear_perl_hook(pTHX) {
+	if (Runops_Hook_perl_hook) {
+		SvREFCNT_dec(Runops_Hook_perl_hook);
+		Runops_Hook_perl_hook = NULL;
+	}
 }
 
 void
-Runops_Hook_disable () {
-	Runops_Hook_enabled = 0;
+Runops_Hook_set_perl_hook (pTHX_ SV *hook) {
+	Runops_Hook_clear_perl_hook(aTHX);
+
+	Runops_Hook_perl_hook = hook;
+	SvREFCNT_inc(Runops_Hook_perl_hook);
+
+	Runops_Hook_set_hook(Runops_Hook_perl);
 }
 
 UV
@@ -130,3 +191,18 @@
 {
 	   Runops_Hook_set_threshold(SvUV(a));
 }
+
+void
+set_hook(SV *hook)
+	CODE:
+{
+	Runops_Hook_set_perl_hook(aTHX_ hook);
+}
+
+void
+clear_hook()
+	CODE:
+{
+	Runops_Hook_clear_perl_hook(aTHX);
+	Runops_Hook_clear_hook();
+}