Introduce CALLER()

[perl/modules/Scope-Upper.git] / Upper.xs

diff --git a/Upper.xs b/Upper.xs
index 60e8a0c80ecab6b44391c8d60bfe0703a7b58964..f55b18cd04f8580ce68e7fa201b7c876dccf9404 100644 (file)
--- a/Upper.xs
+++ b/Upper.xs
@@ -700,6 +700,35 @@ PROTOTYPE: ;$
 PPCODE:
  SU_DOPOPTOCX(CXt_EVAL);
 
+void
+CALLER(...)
+PROTOTYPE: ;$
+PREINIT:
+ I32 cxix = cxstack_ix, caller = 0, level = 0;
+PPCODE:
+ if (items) {
+  SV *csv = ST(0);
+  if (SvOK(csv))
+   caller = SvIV(csv);
+ }
+ cxix = cxstack_ix;
+ while (cxix > 0) {
+  PERL_CONTEXT *cx = cxstack + cxix--;
+  switch (CxTYPE(cx)) {
+   case CXt_SUB:
+   case CXt_EVAL:
+   case CXt_FORMAT:
+    --caller;
+    if (caller < 0)
+     goto done;
+    break;
+  }
+  ++level;
+ }
+done:
+ ST(0) = sv_2mortal(newSViv(level));
+ XSRETURN(1);
+
 void
 reap(SV *hook, ...)
 PROTOTYPE: &;$