The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#include "try-catch-constants.h"
#include "try-catch-stack.h"

#include <perl.h>

#define get_sub_context_ix(start_ix)    my_get_sub_context_ix(aTHX_ start_ix)
STATIC I32 my_get_sub_context_ix(pTHX_ I32 start_ix) {
    I32 i;

    for (i = start_ix; i >= 0; i--) {
        register const PERL_CONTEXT * const cx = &cxstack[i];
        switch (CxTYPE(cx)) {
            case CXt_EVAL:
            case CXt_SUB:
            case CXt_FORMAT:
                return i;
        }
    }
    return -1;
}

#define is_called_internally(cx) \
        CopSTASH_eq((cx)->blk_oldcop, internal_stash)

static PERL_CONTEXT* my_get_sub_context(pTHX_ int skip_internals) {
    I32 i;
    i = get_sub_context_ix(cxstack_ix);
    if (i < 0) {
        return NULL;
    }

    if (skip_internals && (i >= 0)) {
        // skip internally called
        while ((i >= 0) && is_called_internally(&cxstack[i])) i--;

        // skip last internal block and find upper sub
        i = get_sub_context_ix(i-1);
    }
    return (i >= 0) ? &cxstack[i] : NULL;
}