#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#define declare_cbs perl6_callbacks *cbs = (perl6_callbacks*)SvIV(*hv_fetchs(PL_modglobal, "Inline::Perl5 callbacks", 0));

static void xs_init (pTHX);
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void boot_Socket (pTHX_ CV* cv);
int p5_is_live_wrapped_p6_object(PerlInterpreter *my_perl, SV *obj);

typedef struct {
    I32 key; /* to make sure it came from Inline */
    IV index;
    I32 is_wrapper;
} _perl6_magic;

typedef struct {
    I32 key; /* to make sure it came from Inline */
    IV index;
} _perl6_hash_magic;

typedef struct {
    SV *(*call_p6_method)(IV, char *, I32, SV *, SV **);
    SV *(*call_p6_callable)(IV, SV *, SV **);
    void (*free_p6_object)(IV);
    SV *(*hash_at_key)(IV, char *);
    SV *(*hash_assign_key)(IV, char *, SV *);
} perl6_callbacks;

XS(p5_call_p6_method);
XS(p5_call_p6_extension_method);
XS(p5_destroy_p5_object);
XS(p5_call_p6_callable);
XS(p5_hash_at_key);
XS(p5_hash_assign_key);
XS(p5_load_module);
XS(p5_set_subname);

EXTERN_C void xs_init(pTHX) {
    char *file = __FILE__;
    /* DynaLoader is a special case */
    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
    newXS("Perl6::Object::call_method", p5_call_p6_method, file);
    newXS("Perl6::Object::call_extension_method", p5_call_p6_extension_method, file);
    newXS("Perl6::Object::destroy", p5_destroy_p5_object, file);
    newXS("Perl6::Hash::FETCH", p5_hash_at_key, file);
    newXS("Perl6::Hash::STORE", p5_hash_assign_key, file);
    newXS("Perl6::Callable::call", p5_call_p6_callable, file);
    newXS("v6::load_module_impl", p5_load_module, file);
    newXS("v6::set_subname", p5_set_subname, file);
}

size_t p5_size_of_iv() {
    return IVSIZE;
}

#if NVSIZE > 8
#    define MYNVSIZE 8
#    define MYNV double
#else
#    define MYNVSIZE NVSIZE
#    define MYNV NV
#endif

size_t p5_size_of_nv() {
    return MYNVSIZE;
}

static int inited = 0;

void p5_inline_perl6_xs_init(PerlInterpreter *my_perl) {
    char *file = __FILE__;
    newXS("Perl6::Object::call_method", p5_call_p6_method, file);
    newXS("Perl6::Object::call_extension_method", p5_call_p6_extension_method, file);
    newXS("Perl6::Hash::FETCH", p5_hash_at_key, file);
    newXS("Perl6::Hash::STORE", p5_hash_assign_key, file);
    newXS("Perl6::Callable::call", p5_call_p6_callable, file);
    newXS("v6::load_module_impl", p5_load_module, file);
    newXS("v6::set_subname", p5_set_subname, file);
    inited = 1;
}

void p5_init_callbacks(
    SV  *(*call_p6_method)(IV, char * , I32, SV *, SV **),
    SV  *(*call_p6_callable)(IV, SV *, SV **),
    void (*free_p6_object)(IV),
    SV  *(*hash_at_key)(IV, char *),
    SV  *(*hash_assign_key)(IV, char *, SV *)
) {
    perl6_callbacks *cbs = malloc(sizeof(perl6_callbacks));
    cbs->call_p6_method   = call_p6_method;
    cbs->call_p6_callable = call_p6_callable;
    cbs->free_p6_object   = free_p6_object;
    cbs->hash_at_key      = hash_at_key;
    cbs->hash_assign_key  = hash_assign_key;
    hv_stores(PL_modglobal, "Inline::Perl5 callbacks", newSViv((IV)cbs));
}

static int interpreters = 0;
static int terminate = 0;

PerlInterpreter *p5_init_perl(
    int argc,
    char **argv,
    SV  *(*call_p6_method)(IV, char * , I32, SV *, SV **),
    SV  *(*call_p6_callable)(IV, SV *, SV **),
    void (*free_p6_object)(IV),
    SV  *(*hash_at_key)(IV, char *),
    SV  *(*hash_assign_key)(IV, char *, SV *)
) {
    if (inited) {
#ifndef MULTIPLICITY
        return NULL;
#endif
    }
    else {
        inited = 1;
        PERL_SYS_INIT(&argc, &argv);
    }

    interpreters++;

    PerlInterpreter *my_perl = perl_alloc();
    PERL_SET_CONTEXT(my_perl);
    PL_perl_destruct_level = 1;
    perl_construct( my_perl );
    perl_parse(my_perl, xs_init, argc, argv, NULL);
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
    perl_run(my_perl);

    p5_init_callbacks(
        call_p6_method,
        call_p6_callable,
        free_p6_object,
        hash_at_key,
        hash_assign_key
    );

    return my_perl;
}

void p5_destruct_perl(PerlInterpreter *my_perl) {
    PERL_SET_CONTEXT(my_perl);
    PL_perl_destruct_level = 1;

    POPSTACK_TO(PL_mainstack);
    dounwind(-1);
    LEAVE_SCOPE(0);

    perl_destruct(my_perl);
    perl_free(my_perl);

    if (--interpreters == 0 && terminate)
        PERL_SYS_TERM();
}

void p5_terminate() {
    terminate = 1;
}

U32 p5_SvIOK(PerlInterpreter *my_perl, SV* sv) {
    return SvIOK(sv);
}

U32 p5_SvNOK(PerlInterpreter *my_perl, SV* sv) {
    return SvNOK(sv);
}

U32 p5_SvPOK(PerlInterpreter *my_perl, SV* sv) {
    return SvPOK(sv);
}

U32 p5_sv_utf8(PerlInterpreter *my_perl, SV* sv) {
    PERL_SET_CONTEXT(my_perl);
    if (SvUTF8(sv)) { // UTF-8 flag set -> can use string as-is
        return 1;
    }
    else { // pure 7 bit ASCII is valid UTF-8 as well
        STRLEN len;
        char * const pv  = SvPV(sv, len);
        STRLEN i;
        for (i = 0; i < len; i++)
            if (pv[i] < 0) // signed char!
                return 0;
        return 1;
    }
}

IV p5_sv_iv(PerlInterpreter *my_perl, SV* sv) {
    return SvIV(sv);
}

MYNV p5_sv_nv(PerlInterpreter *my_perl, SV* sv) {
    return (MYNV) SvNV(sv);
}

SV *p5_sv_rv(PerlInterpreter *my_perl, SV* sv) {
    return SvRV(sv);
}

int p5_is_object(PerlInterpreter *my_perl, SV* sv) {
    PERL_SET_CONTEXT(my_perl);
    return sv_isobject(sv);
}

int p5_is_sub_ref(PerlInterpreter *my_perl, SV* sv) {
    return (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV);
}

int p5_is_array(PerlInterpreter *my_perl, SV* sv) {
    return (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV);
}

int p5_is_hash(PerlInterpreter *my_perl, SV* sv) {
    MAGIC *mg;
    PERL_SET_CONTEXT(my_perl);
    return (
        (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV)
        ? ((mg = mg_find(SvRV(sv), PERL_MAGIC_tied)) && sv_isa(mg->mg_obj, "Perl6::Hash"))
            ? 2
            : 1
        : 0
    );
}

IV p5_unwrap_p6_hash(PerlInterpreter *my_perl, SV *obj) {
    PERL_SET_CONTEXT(my_perl);
    {
        MAGIC * const tie_mg = mg_find(SvRV(obj), PERL_MAGIC_tied);
        SV * const hash = tie_mg->mg_obj;
        SV * const p6hashobj = *(av_fetch((AV *) SvRV(hash), 0, 0));
        MAGIC * const mg = mg_find(SvRV(p6hashobj), '~');
        return ((_perl6_hash_magic*)(mg->mg_ptr))->index;
    }
}

int p5_is_scalar_ref(PerlInterpreter *my_perl, SV* sv) {
    return (SvROK(sv) && SvTYPE(SvRV(sv)) < SVt_PVAV);
}

int p5_is_undef(PerlInterpreter *my_perl, SV* sv) {
    return !SvOK(sv);
}

AV *p5_sv_to_av(PerlInterpreter *my_perl, SV* sv) {
    return (AV *) SvRV(sv);
}

AV *p5_sv_to_av_inc(PerlInterpreter *my_perl, SV* sv) {
    AV * const retval = (AV *) SvRV(sv);
    SvREFCNT_inc((SV *)retval);
    return retval;
}

HV *p5_sv_to_hv(PerlInterpreter *my_perl, SV* sv) {
    return (HV *) SvRV(sv);
}

char *p5_sv_to_char_star(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    {
        STRLEN len;
        char * const pv  = SvPV(sv, len);
        return pv;
    }
}

STRLEN p5_sv_to_buf(PerlInterpreter *my_perl, SV *sv, char **buf) {
    PERL_SET_CONTEXT(my_perl);
    {
        STRLEN len;
        *buf  = SvPV(sv, len);
        return len;
    }
}

SV *p5_sv_to_ref(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    return newRV_noinc(sv);
}

int p5_sv_refcnt(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    return SvREFCNT(sv);
}

void p5_sv_refcnt_dec(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    SvREFCNT_dec(sv);
}

void p5_sv_refcnt_inc(PerlInterpreter *my_perl, SV *sv) {
    SvREFCNT_inc(sv);
}

void p5_sv_destroy(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    if (!PL_in_clean_objs && !PL_in_clean_all)
        SvREFCNT_dec(sv); // don't bother during global deconstruction
}

void p5_sv_2mortal(PerlInterpreter *my_perl, SV *sv) {
    sv_2mortal(sv);
}

SV *p5_new_mortal_reference(PerlInterpreter *my_perl, SV *sv) {
    return newRV_inc(SvRV(sv));
}

SV *p5_int_to_sv(PerlInterpreter *my_perl, IV value) {
    PERL_SET_CONTEXT(my_perl);
    return newSViv(value);
}

SV *p5_float_to_sv(PerlInterpreter *my_perl, MYNV value) {
    PERL_SET_CONTEXT(my_perl);
    return newSVnv((NV)value);
}

SV *p5_str_to_sv(PerlInterpreter *my_perl, STRLEN len, char* value) {
    PERL_SET_CONTEXT(my_perl);
    return newSVpvn_flags(value, len, SVf_UTF8);
}

SV *p5_buf_to_sv(PerlInterpreter *my_perl, STRLEN len, char* value) {
    PERL_SET_CONTEXT(my_perl);
    return newSVpvn_flags(value, len, 0);
}

I32 p5_av_top_index(PerlInterpreter *my_perl, AV *av) {
    PERL_SET_CONTEXT(my_perl);
    return av_top_index(av);
}

SV *p5_av_fetch(PerlInterpreter *my_perl, AV *av, I32 key) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV ** const item = av_fetch(av, key, 0);
        if (item)
            return *item;
        return NULL;
    }
}

void p5_av_store(PerlInterpreter *my_perl, AV *av, I32 key, SV *val) {
    PERL_SET_CONTEXT(my_perl);
    SvREFCNT_inc(val);
    if (av_store(av, key, val) == NULL)
        SvREFCNT_dec(val);
    return;
}

SV *p5_av_pop(PerlInterpreter *my_perl, AV *av) {
    PERL_SET_CONTEXT(my_perl);
    return av_pop(av);
}

void p5_av_push(PerlInterpreter *my_perl, AV *av, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    av_push(av, sv);
}

SV *p5_av_shift(PerlInterpreter *my_perl, AV *av) {
    PERL_SET_CONTEXT(my_perl);
    return av_shift(av);
}

void p5_av_unshift(PerlInterpreter *my_perl, AV *av, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    av_unshift(av, 1);
    SvREFCNT_inc(sv);
    if (av_store(av, 0, sv) == NULL)
        SvREFCNT_dec(sv);
}

void p5_av_delete(PerlInterpreter *my_perl, AV *av, I32 key) {
    PERL_SET_CONTEXT(my_perl);
    av_delete(av, key, G_DISCARD);
}

void p5_av_clear(PerlInterpreter *my_perl, AV *av) {
    PERL_SET_CONTEXT(my_perl);
    av_clear(av);
}

I32 p5_hv_iterinit(PerlInterpreter *my_perl, HV *hv) {
    PERL_SET_CONTEXT(my_perl);
    return hv_iterinit(hv);
}

HE *p5_hv_iternext(PerlInterpreter *my_perl, HV *hv) {
    PERL_SET_CONTEXT(my_perl);
    return hv_iternext(hv);
}

SV *p5_hv_iterkeysv(PerlInterpreter *my_perl, HE *entry) {
    PERL_SET_CONTEXT(my_perl);
    return hv_iterkeysv(entry);
}

SV *p5_hv_iterval(PerlInterpreter *my_perl, HV *hv, HE *entry) {
    PERL_SET_CONTEXT(my_perl);
    return hv_iterval(hv, entry);
}

SV *p5_hv_fetch(PerlInterpreter *my_perl, HV *hv, STRLEN len, const char *key) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV ** const item = hv_fetch(hv, key, len, 0);
        if (item)
            return *item;
        return NULL;
    }
}

void p5_hv_store(PerlInterpreter *my_perl, HV *hv, const char *key, SV *val) {
    PERL_SET_CONTEXT(my_perl);
    hv_store(hv, key, strlen(key), val, 0);
}

int p5_hv_exists(PerlInterpreter *my_perl, HV *hv, STRLEN len, const char *key) {
    PERL_SET_CONTEXT(my_perl);
    return hv_exists(hv, key, len);
}

SV *p5_undef(PerlInterpreter *my_perl) {
    PERL_SET_CONTEXT(my_perl);
    return &PL_sv_undef;
}

HV *p5_newHV(PerlInterpreter *my_perl) {
    PERL_SET_CONTEXT(my_perl);
    return newHV();
}

AV *p5_newAV(PerlInterpreter *my_perl) {
    PERL_SET_CONTEXT(my_perl);
    return newAV();
}

SV *p5_newRV_noinc(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    return newRV_noinc(sv);
}

SV *p5_newRV_inc(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    return newRV_inc(sv);
}

const char *p5_sv_reftype(PerlInterpreter *my_perl, SV *sv) {
    PERL_SET_CONTEXT(my_perl);
    return sv_reftype(SvRV(sv), 1);
}

I32 p5_get_type(PerlInterpreter *my_perl, SV *sv) {
    int is_hash;
    PERL_SET_CONTEXT(my_perl);
    if (p5_is_object(my_perl, sv)) {
        return 1;
    }
    else if (p5_is_sub_ref(my_perl, sv)) {
        return 2;
    }
    else if (p5_SvNOK(my_perl, sv)) {
        return 3;
    }
    else if (p5_SvIOK(my_perl, sv)) {
        return 4;
    }
    else if (p5_SvPOK(my_perl, sv)) {
        return 5;
    }
    else if (p5_is_array(my_perl, sv)) {
        return 6;
    }
    else if ((is_hash = p5_is_hash(my_perl, sv)) > 0) {
        return 6 + is_hash;
    }
    else if (p5_is_undef(my_perl, sv)) {
        return 9;
    }
    else if (p5_is_scalar_ref(my_perl, sv)) {
        return 10;
    }
    else if (SvTYPE(sv) == SVt_PVGV) {
        return 11;
    }
    else {
        return 0;
    }
}

SV *p5_get_global(PerlInterpreter *my_perl, const char* name) {
    PERL_SET_CONTEXT(my_perl);
    if (strlen(name) < 2)
        return NULL;

    if (name[0] == '$')
        return get_sv(&name[1], 0);

    if (name[0] == '@')
        return sv_2mortal(newRV_inc((SV *)get_av(&name[1], 0)));

    if (name[0] == '%')
        return sv_2mortal(newRV_inc((SV *)get_hv(&name[1], 0)));

    return NULL;
}

void p5_set_global(PerlInterpreter *my_perl, const char* name, SV *value) {
    PERL_SET_CONTEXT(my_perl);
    if (strlen(name) < 2)
        return;

    if (name[0] == '$')
        SvSetSV(get_sv(&name[1], 0), value);

    else if (name[0] == '@')
        croak("Setting global array variable NYI");

    else if (name[0] == '%')
        croak("Setting global hash variable NYI");
}

SV *p5_eval_pv(PerlInterpreter *my_perl, const char* p, I32 croak_on_error) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval;
        ENTER;
        SAVETMPS;
        PUSHMARK(SP);

        retval = eval_pv(p, croak_on_error);
        SvREFCNT_inc(retval);

        SPAGAIN;
        PUTBACK;
        FREETMPS;
        LEAVE;
        return retval;
    }
}

SV *p5_err_sv(PerlInterpreter *my_perl) {
    PERL_SET_CONTEXT(my_perl);
    return sv_mortalcopy(ERRSV);
}

void handle_p5_error(I32 *err) {
    SV *err_tmp = ERRSV;
    *err = SvTRUE(err_tmp);
}

void push_arguments(SV **sp, int len, SV *args[]) {
    int i;
    for (i = 0; i < len; i++) {
        if (args[i] != NULL) /* skip Nil which gets turned into NULL */
            XPUSHs(sv_2mortal(args[i]));
    }
    PUTBACK;
}

SV *pop_return_values(PerlInterpreter *my_perl, SV **sp, I32 count, I32 *type) {
    SV * retval = NULL;
    I32 i;

    if (count == 1) {
        retval = POPs;
        SvREFCNT_inc(retval);
        *type = p5_get_type(my_perl, retval);
    }
    else {
        if (count > 1) {
            retval = (SV *)newAV();
            av_extend((AV *)retval, count - 1);
        }

        for (i = count - 1; i >= 0; i--) {
            SV * const next = POPs;
            SvREFCNT_inc(next);

            if (av_store((AV *)retval, i, next) == NULL)
                SvREFCNT_dec(next); /* see perlguts Working with AVs */
        }
    }
    PUTBACK;

    return retval;
}

SV *p5_call_package_method(PerlInterpreter *my_perl, char *package, char *name, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval = NULL;
        int flags = G_ARRAY | G_EVAL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(sv_2mortal(newSVpv(package, 0)));
        push_arguments(sp, len, args);

        *count = call_method(name, flags);
        SPAGAIN;

        handle_p5_error(err);

        retval = pop_return_values(my_perl, sp, *count, type);

        FREETMPS;
        LEAVE;

        return retval;
    }
}

GV *p5_look_up_package_method(PerlInterpreter *my_perl, char *module, char *name) {
    PERL_SET_CONTEXT(my_perl);
    {
        HV * const pkg = gv_stashpvn(module, strlen(module), 0);
        GV * const gv = gv_fetchmeth_pvn(pkg, name, strlen(name), -1, SVf_UTF8);
        if (gv && isGV(gv))
            return gv;
        return NULL;
    }
}

SV *p5_call_inherited_package_method(PerlInterpreter *my_perl, char *package, char *base_package, char *name, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval = NULL;
        HV * stash = gv_stashpvn(package, strlen(package), SVf_UTF8);
        int flags = G_ARRAY | G_EVAL;

        if (stash == NULL) {
            *type = -1; /* signal that a wrapper package needs to be created */
            return NULL;
        }

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        XPUSHs(newSVpv(package, 0));
        push_arguments(sp, len, args);

        {
            GV * const gv = p5_look_up_package_method(my_perl, base_package, name);
            SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv)));
            *count = call_sv(rv, flags);
        }

        SPAGAIN;

        handle_p5_error(err);

        retval = pop_return_values(my_perl, sp, *count, type);

        FREETMPS;
        LEAVE;

        return retval;
    }
}

GV *p5_look_up_method(PerlInterpreter *my_perl, SV *obj, char *name) {
    PERL_SET_CONTEXT(my_perl);
    {
        HV * const pkg = SvSTASH((SV*)SvRV(obj));
        GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, name, TRUE);
        if (gv && isGV(gv))
            return gv;
        return NULL;
    }
}

char *p5_stash_name(PerlInterpreter *my_perl, SV *obj) {
    HV * const pkg = SvSTASH((SV*)SvRV(obj));
    return HvNAME(pkg);
}

SV *p5_call_gv(PerlInterpreter *my_perl, GV *gv, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        int i;
        SV * retval = NULL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        if (len > 1) {
            XPUSHs(args[0]);
            for (i = 1; i < len; i++) {
                if (args[i] != NULL) /* skip Nil which gets turned into NULL */
                    XPUSHs(sv_2mortal(args[i]));
            }
        }
        else if (len > 0)
            if (args != NULL) /* skip Nil which gets turned into NULL */
                XPUSHs((SV*)args);

        PUTBACK;

        SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv))); /* FIXME: can be done once */

        *count = call_sv(rv, G_ARRAY | G_EVAL);
        SPAGAIN;

        handle_p5_error(err);
        retval = pop_return_values(my_perl, sp, *count, type);
        SPAGAIN;

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

void reset_wrapped_object(PerlInterpreter *my_perl, SV *obj) {
    if (SvREFCNT(obj) == 1 && SvREFCNT(SvRV(obj)) == 1) {
        MAGIC * mg = mg_find(SvRV(obj), '~');
        _perl6_magic* const p6mg = (_perl6_magic*) mg->mg_ptr;
        SV **cbs_entry = hv_fetchs(PL_modglobal, "Inline::Perl5 callbacks", 0);
        if (cbs_entry) {
            perl6_callbacks *cbs = (perl6_callbacks*)SvIV(*cbs_entry);
            cbs->free_p6_object(p6mg->index);
        }
        p6mg->index = -1;
        SvREFCNT_inc(SvRV(obj)); // keep it from dying
    }
}

SV *p5_call_parent_gv(PerlInterpreter *my_perl, GV *gv, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        int i;
        SV * obj;
        SV * retval = NULL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        obj = len > 1 ? args[0] : (SV*) args;

        if (len > 1) {
            XPUSHs(obj);
            for (i = 1; i < len; i++) {
                if (args[i] != NULL) /* skip Nil which gets turned into NULL */
                    XPUSHs(sv_2mortal(args[i]));
            }
        }
        else if (len > 0)
            if (args != NULL) /* skip Nil which gets turned into NULL */
                XPUSHs(obj);

        PUTBACK;

        SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv))); /* FIXME: can be done once */

        *count = call_sv(rv, G_ARRAY | G_EVAL);
        SPAGAIN;

        handle_p5_error(err);
        retval = pop_return_values(my_perl, sp, *count, type);
        SPAGAIN;

        reset_wrapped_object(my_perl, obj);
        SvREFCNT_dec(obj);

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_scalar_call_gv(PerlInterpreter *my_perl, GV *gv, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        int i;
        SV * retval = NULL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        if (len > 1) {
            XPUSHs(args[0]);
            for (i = 1; i < len; i++) {
                if (args[i] != NULL) /* skip Nil which gets turned into NULL */
                    XPUSHs(sv_2mortal(args[i]));
            }
        }
        else if (len > 0)
            if (args != NULL) /* skip Nil which gets turned into NULL */
                XPUSHs((SV*)args);

        PUTBACK;

        SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv))); /* FIXME: can be done once */

        *count = call_sv(rv, G_SCALAR | G_EVAL);
        SPAGAIN;

        handle_p5_error(err);
        retval = pop_return_values(my_perl, sp, *count, type);
        SPAGAIN;

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_scalar_call_parent_gv(PerlInterpreter *my_perl, GV *gv, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        int i;
        SV * retval = NULL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        if (len > 1) {
            XPUSHs(args[0]);
            for (i = 1; i < len; i++) {
                if (args[i] != NULL) /* skip Nil which gets turned into NULL */
                    XPUSHs(sv_2mortal(args[i]));
            }
        }
        else if (len > 0)
            if (args != NULL) /* skip Nil which gets turned into NULL */
                XPUSHs((SV*)args);

        PUTBACK;

        SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv))); /* FIXME: can be done once */

        *count = call_sv(rv, G_SCALAR | G_EVAL);
        SPAGAIN;

        handle_p5_error(err);
        retval = pop_return_values(my_perl, sp, *count, type);
        SPAGAIN;

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_call_gv_two_args(PerlInterpreter *my_perl, GV *gv, SV *arg, SV *arg2, I32 *count, I32 *type, I32 *err) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval = NULL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        XPUSHs(sv_2mortal((SV*)arg));
        XPUSHs(sv_2mortal((SV*)arg2));

        PUTBACK;

        SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv)));

        *count = call_sv(rv, G_ARRAY | G_EVAL);
        SPAGAIN;

        handle_p5_error(err);
        if (*err)
            fprintf(stderr, "err: %d\n", *err);
        retval = pop_return_values(my_perl, sp, *count, type);
        SPAGAIN;

        reset_wrapped_object(my_perl, arg);

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_scalar_call_gv_two_args(PerlInterpreter *my_perl, GV *gv, SV *arg, SV *arg2, I32 *count, I32 *type, I32 *err) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval = NULL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        XPUSHs(sv_2mortal((SV*)arg));
        XPUSHs(sv_2mortal((SV*)arg2));

        PUTBACK;

        SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv)));

        *count = call_sv(rv, G_SCALAR | G_EVAL);
        SPAGAIN;

        handle_p5_error(err);
        if (*err)
            fprintf(stderr, "err: %d\n", *err);
        retval = pop_return_values(my_perl, sp, *count, type);
        SPAGAIN;

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_call_method(PerlInterpreter *my_perl, SV *obj, I32 context, char *name, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        int i;
        SV * retval = NULL;
        int flags = (context ? G_SCALAR : G_ARRAY) | G_EVAL;

        ENTER;
        SAVETMPS;

        HV * const pkg = SvSTASH((SV*)SvRV(obj));
        GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, name, TRUE);
        if (gv && isGV(gv)) {
            PUSHMARK(SP);

            if (len > 1) {
                XPUSHs(args[0]);
                for (i = 1; i < len; i++) {
                    if (args[i] != NULL) /* skip Nil which gets turned into NULL */
                        XPUSHs(sv_2mortal(args[i]));
                }
            }
            else if (len > 0)
                if (args != NULL) /* skip Nil which gets turned into NULL */
                    XPUSHs((SV*)args);

            PUTBACK;

            SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv)));

            *count = call_sv(rv, flags);
            SPAGAIN;

            handle_p5_error(err);
            retval = pop_return_values(my_perl, sp, *count, type);
            SPAGAIN;
        }
        else {
            ERRSV = newSVpvf("Could not find method \"%s\" of \"%s\" object", name, HvNAME(pkg));
        }

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_call_parent_method(PerlInterpreter *my_perl, char *package, SV *parent_obj, I32 context, char *name, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        int i;
        SV * retval = NULL;
        int flags = (context ? G_SCALAR : G_ARRAY) | G_EVAL;

        ENTER;
        SAVETMPS;

        HV * const pkg = package != NULL ? gv_stashpv(package, 0) : SvSTASH((SV*)SvRV(parent_obj));
        GV * const gv = Perl_gv_fetchmethod_autoload(aTHX_ pkg, name, TRUE);
        if (gv && isGV(gv)) {
            SV * obj;

            PUSHMARK(SP);

            obj = len > 1 ? args[0] : (SV*) args;

            if (len > 1) {
                XPUSHs(obj);
                for (i = 1; i < len; i++) {
                    if (args[i] != NULL) /* skip Nil which gets turned into NULL */
                        XPUSHs(sv_2mortal(args[i]));
                }
            }
            else if (len > 0)
                if (args != NULL) /* skip Nil which gets turned into NULL */
                    XPUSHs(obj);

            PUTBACK;

            SV * const rv = sv_2mortal(newRV((SV*)GvCV(gv)));

            *count = call_sv(rv, flags);
            SPAGAIN;

            handle_p5_error(err);
            retval = pop_return_values(my_perl, sp, *count, type);
            SPAGAIN;

            if (p5_is_live_wrapped_p6_object(my_perl, SvRV(obj))) {
                reset_wrapped_object(my_perl, obj);
                SvREFCNT_dec(obj);
            }
        }

        PUTBACK;
        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_call_function(PerlInterpreter *my_perl, char *name, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval = NULL;
        int flags = G_ARRAY | G_EVAL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        push_arguments(sp, len, args);

        *count = call_pv(name, flags);
        SPAGAIN;

        handle_p5_error(err);
        retval = pop_return_values(my_perl, sp, *count, type);

        FREETMPS;
        LEAVE;

        return retval;
    }
}

SV *p5_call_code_ref(PerlInterpreter *my_perl, SV *code_ref, int len, SV *args[], I32 *count, I32 *err, I32 *type) {
    PERL_SET_CONTEXT(my_perl);
    {
        dSP;
        SV * retval = NULL;
        int flags = G_ARRAY | G_EVAL;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        push_arguments(sp, len, args);

        *count = call_sv(code_ref, flags);
        SPAGAIN;

        handle_p5_error(err);
        retval = pop_return_values(my_perl, sp, *count, type);

        FREETMPS;
        LEAVE;

        return retval;
    }
}

#define PERL6_MAGIC_KEY 0x0DD515FE
#define PERL6_HASH_MAGIC_KEY 0x0DD515FF
#define PERL6_EXTENSION_MAGIC_KEY 0x0DD51600

int p5_free_perl6_obj(pTHX_ SV* obj, MAGIC *mg)
{
    if (mg && ((_perl6_magic*) mg->mg_ptr)->index != -1) {
        _perl6_magic* const p6mg = (_perl6_magic*) mg->mg_ptr;
        /* need to be extra careful here as PL_modglobal could have been cleaned already */
        SV **cbs_entry = hv_fetchs(PL_modglobal, "Inline::Perl5 callbacks", 0);
        if (cbs_entry) {
            perl6_callbacks *cbs = (perl6_callbacks*)SvIV(*cbs_entry);
            cbs->free_p6_object(p6mg->index);
        }
    }
    return 0;
}

int p5_free_wrapped_perl6_obj(pTHX_ SV* obj, MAGIC *mg)
{
    if (mg) {
        _perl6_magic* const p6mg = (_perl6_magic*) mg->mg_ptr;
        /* need to be extra careful here as PL_modglobal could have been cleaned already */
        if (p6mg->index != 0) {
            SV **cbs_entry = hv_fetchs(PL_modglobal, "Inline::Perl5 callbacks", 0);
            if (cbs_entry) {
                perl6_callbacks *cbs = (perl6_callbacks*)SvIV(*cbs_entry);
                cbs->free_p6_object(p6mg->index);
            }
            p6mg->index = 0;
        }
    }
    return 0;
}

int p5_free_perl6_hash(pTHX_ SV* obj, MAGIC *mg)
{
    if (mg) {
        _perl6_hash_magic* const p6mg = (_perl6_hash_magic*) mg->mg_ptr;
        /* need to be extra careful here as PL_modglobal could have been cleaned already */
        SV **cbs_entry = hv_fetchs(PL_modglobal, "Inline::Perl5 callbacks", 0);
        if (cbs_entry) {
            perl6_callbacks *cbs = (perl6_callbacks*)SvIV(*cbs_entry);
            cbs->free_p6_object(p6mg->index);
        }
    }
    return 0;
}

MGVTBL p5_inline_mg_vtbl = {
    0x0,
    0x0,
    0x0,
    0x0,
    &p5_free_perl6_obj,
    0x0,
    0x0,
    0x0
};

MGVTBL p5_inline_wrapped_mg_vtbl = {
    0x0,
    0x0,
    0x0,
    0x0,
    &p5_free_wrapped_perl6_obj,
    0x0,
    0x0,
    0x0
};

MGVTBL p5_inline_hash_mg_vtbl = {
    0x0,
    0x0,
    0x0,
    0x0,
    &p5_free_perl6_hash,
    0x0,
    0x0,
    0x0
};

void p5_rebless_object(PerlInterpreter *my_perl, SV *obj, char *package, IV i) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV * const inst = SvRV(obj);
        HV *stash = gv_stashpv(package, GV_ADD);
        if (stash == NULL)
            croak("Perl6::Object not found!? Forgot to call init_callbacks?");
        (void)sv_bless(obj, stash);

        _perl6_magic priv;

        /* set up magic */
        priv.key = PERL6_MAGIC_KEY;
        priv.index = i;
        priv.is_wrapper = 0;
        sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_mg_vtbl, (char *) &priv, sizeof(priv));
    }
}

SV *p5_add_magic(PerlInterpreter *my_perl, SV *inst, IV i) {
    PERL_SET_CONTEXT(my_perl);
    {
        MAGIC * const mg = mg_find(inst, '~');
        if (mg && mg->mg_ptr && ((_perl6_magic*)(mg->mg_ptr))->key == PERL6_MAGIC_KEY) {
            ((_perl6_magic*)(mg->mg_ptr))->index = i;
        }
        else {
            _perl6_magic priv;

            /* set up magic */
            priv.key = PERL6_MAGIC_KEY;
            priv.index = i;
            priv.is_wrapper = 1;
            sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_mg_vtbl, (char *) &priv, sizeof(priv));
        }
        return newRV_noinc(inst);
    }
}

SV *p5_wrap_p6_object(PerlInterpreter *my_perl, IV i, SV *p5obj) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV * inst;
        SV * inst_ptr;
        if (p5obj == NULL) {
            inst_ptr = newSViv(0); // will be upgraded to an RV
            inst = newSVrv(inst_ptr, "Perl6::Object");
        }
        else {
            inst_ptr = p5obj;
            inst = SvRV(inst_ptr);
        }
        _perl6_magic priv;

        /* set up magic */
        priv.key = p5obj == NULL ? PERL6_MAGIC_KEY : PERL6_EXTENSION_MAGIC_KEY;
        priv.index = i;
        priv.is_wrapper = 0;
        sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_mg_vtbl, (char *) &priv, sizeof(priv));

        return inst_ptr;
    }
}

SV *p5_wrap_p6_callable(PerlInterpreter *my_perl, IV i, SV *p5obj) {
    SV * inst;
    SV * inst_ptr;

    PERL_SET_CONTEXT(my_perl);

    if (p5obj == NULL) {
        dSP;
        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        call_pv("Perl6::Callable::new", G_SCALAR);
        SPAGAIN;

        inst_ptr = POPs;
        inst = SvRV(inst_ptr);
        SvREFCNT_inc(inst_ptr);

        PUTBACK;
        FREETMPS;
        LEAVE;
    }
    else {
        inst_ptr = p5obj;
        inst = SvRV(inst_ptr);
        SvREFCNT_inc(inst_ptr);
    }
    _perl6_magic priv;

    /* set up magic */
    priv.key = PERL6_MAGIC_KEY;
    priv.index = i;
    priv.is_wrapper = 0;
    sv_magic(inst, inst, PERL_MAGIC_ext, (char *) &priv, sizeof(priv));
    MAGIC * const mg = mg_find(inst, PERL_MAGIC_ext);
    mg->mg_virtual = &p5_inline_mg_vtbl;

    return inst_ptr;
}

SV *p5_wrap_p6_hash(
    PerlInterpreter *my_perl,
    IV i
) {
    PERL_SET_CONTEXT(my_perl);
    {
        int flags = G_SCALAR;
        dSP;

        SV * inst;
        SV * inst_ptr;
        inst_ptr = newSViv(0); // will be upgraded to an RV
        inst = newSVrv(inst_ptr, "Perl6::Object");
        _perl6_hash_magic priv;

        /* set up magic */
        priv.key = PERL6_HASH_MAGIC_KEY;
        priv.index = i;
        sv_magicext(inst, inst, PERL_MAGIC_ext, &p5_inline_hash_mg_vtbl, (char *) &priv, sizeof(priv));

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        XPUSHs(newSVpv("Perl6::Hash", 0));
        XPUSHs(inst_ptr);

        PUTBACK;

        call_method("new", flags);
        SPAGAIN;

        SV *tied_handle = POPs;
        SvREFCNT_inc(tied_handle);

        PUTBACK;
        FREETMPS;
        LEAVE;

        return tied_handle;
    }
}

SV *p5_wrap_p6_handle(PerlInterpreter *my_perl, IV i, SV *p5obj) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV *handle = p5_wrap_p6_object(my_perl, i, p5obj);
        int flags = G_SCALAR;
        dSP;

        ENTER;
        SAVETMPS;

        PUSHMARK(SP);

        XPUSHs(newSVpv("Perl6::Handle", 0));
        XPUSHs(handle);

        PUTBACK;

        call_method("new", flags);
        SPAGAIN;

        SV *tied_handle = POPs;
        SvREFCNT_inc(tied_handle);

        PUTBACK;
        FREETMPS;
        LEAVE;

        return tied_handle;
    }
}

int p5_is_wrapped_p6_object(PerlInterpreter *my_perl, SV *obj) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV * const obj_deref = SvRV(obj);
        /* check for magic! */
        MAGIC * const mg = mg_find(obj_deref, '~');
        return (mg && mg->mg_ptr && ((_perl6_magic*)(mg->mg_ptr))->key == PERL6_MAGIC_KEY);
    }
}

int p5_is_live_wrapped_p6_object(PerlInterpreter *my_perl, SV *obj) {
    PERL_SET_CONTEXT(my_perl);
    {
        /* check for magic! */
        MAGIC * const mg = mg_find(obj, '~');
        return (
            mg
            && mg->mg_ptr
            && ((_perl6_magic*)(mg->mg_ptr))->key == PERL6_MAGIC_KEY
            && ((_perl6_magic*)(mg->mg_ptr))->index != -1
            && ((_perl6_magic*)(mg->mg_ptr))->is_wrapper == 1
        );
    }
}

IV p5_unwrap_p6_object(PerlInterpreter *my_perl, SV *obj) {
    PERL_SET_CONTEXT(my_perl);
    {
        SV * const obj_deref = SvRV(obj);
        MAGIC * const mg = mg_find(obj_deref, '~');
        return ((_perl6_magic*)(mg->mg_ptr))->index;
    }
}

AV *create_args_array(const I32 ax, I32 items, I32 num_fixed_args) {
    AV * args = newAV();
    av_extend(args, items - num_fixed_args);
    int i;
    for (i = 0; i < items - num_fixed_args; i++) {
        SV * const next = SvREFCNT_inc(ST(i + num_fixed_args));
        if (av_store(args, i, next) == NULL)
            SvREFCNT_dec(next); /* see perlguts Working with AVs */
    }
    return args;
}

void return_retval(const I32 ax, SV **sp, SV *retval) {
    if (GIMME_V == G_VOID) {
        XSRETURN_EMPTY;
    }
    if (GIMME_V == G_ARRAY) {
        AV* const av = (AV*)SvRV(retval);
        I32 const len = av_len(av) + 1;
        I32 i;
        for (i = 0; i < len; i++) {
            XPUSHs(sv_2mortal(av_shift(av)));
        }
        XSRETURN(len);
    }
    else {
        AV* const av = (AV*)SvRV(retval);
        XPUSHs(sv_2mortal(av_shift(av)));
        XSRETURN(1);
    }
}

void handle_p6_error(SV *err) {
    if (err) {
        sv_2mortal(err);
        croak_sv(err);
    }
}

void post_callback(const I32 ax, SV **sp, I32 items, SV * const args_rv, SV *err, SV *retval) {
    /* refresh local stack pointer, could have been modified by Perl 5 code called from Perl 6 */
    SPAGAIN;
    SvREFCNT_dec(args_rv);
    handle_p6_error(err);
    sv_2mortal(retval);
    sp -= items;
    return return_retval(ax, sp, retval);
}

XS(p5_call_p6_method) {
    dXSARGS;
    SV * name = ST(0);
    SV * obj = ST(1);

    AV *args = create_args_array(ax, items, 2);

    STRLEN len;
    char * const name_pv  = SvPV(name, len);

    if (!SvROK(obj)) {
        croak("Got a non-reference for obj in p5_call_p6_method calling %s?!", name_pv);
    }
    SV * const obj_deref = SvRV(obj);
    MAGIC * const mg = mg_find(obj_deref, '~');
    if (!mg) {
        XSRETURN_EMPTY;
        return;
    }
    _perl6_magic* const p6mg = (_perl6_magic*)(mg->mg_ptr);
    SV *err = NULL;
    SV * const args_rv = newRV_noinc((SV *) args);

    declare_cbs;
    SV * retval = cbs->call_p6_method(p6mg->index, name_pv, GIMME_V == G_SCALAR, args_rv, &err);
    return post_callback(ax, sp, items, args_rv, err, retval);
}

XS(p5_destroy_p5_object) {
    dXSARGS;
    SV * obj = ST(0);
    SV * const inst = SvRV(obj);
    MAGIC * mg = mg_find(inst, '~');
    int destroyed = 1;
    if (mg) {
        _perl6_magic* const p6mg = (_perl6_magic*) mg->mg_ptr;
        /* need to be extra careful here as PL_modglobal could have been cleaned already */
        if (p6mg->index != -1 && !PL_in_clean_objs) {
            SV **cbs_entry = hv_fetchs(PL_modglobal, "Inline::Perl5 callbacks", 0);
            if (cbs_entry) {
                perl6_callbacks *cbs = (perl6_callbacks*)SvIV(*cbs_entry);
                cbs->free_p6_object(p6mg->index);
            }
            p6mg->index = -1;
            SvREFCNT_inc(inst); // resurrect it!
            destroyed = 0;
        }
    }
    sp -= items;
    XPUSHs(newSViv(destroyed && !PL_in_clean_objs));
    XSRETURN(1);
}

MAGIC *find_shadow_magic(SV *p6cb, SV *static_class, SV *obj) {
    SV * const obj_deref = SvRV(obj);
    MAGIC * mg = mg_find(obj_deref, '~');
    if (mg == NULL || ((_perl6_magic*)(mg->mg_ptr))->key != PERL6_EXTENSION_MAGIC_KEY) {
        /* need to create the shadow object here */

        AV * method_args = newAV();
        SV * method_args_rv = newRV_noinc((SV *) method_args);
        av_extend(method_args, 1);
        SvREFCNT_inc(obj);
        av_store(method_args, 0, obj);

        AV * args = newAV();
        av_extend(args, 3);
        SvREFCNT_inc(static_class);
        av_store(args, 0, static_class);
        av_store(args, 1, newSVpvs("new_shadow_of_p5_object"));
        av_store(args, 2, method_args_rv);

        MAGIC * const p6cb_mg = mg_find(SvRV(p6cb), '~');
        _perl6_magic* const p6cb_p6mg = (_perl6_magic*)(p6cb_mg->mg_ptr);
        SV *err = NULL;
        SV * const args_rv = newRV_noinc((SV *) args);

        declare_cbs;
        cbs->call_p6_method(p6cb_p6mg->index, "invoke", 1, args_rv, &err);
        SvREFCNT_dec(args_rv);
        handle_p6_error(err);

        mg = mg_find(obj_deref, '~');
    }
    return mg;
}

XS(p5_call_p6_extension_method) {
    dXSARGS;
    SV * p6cb = ST(0);
    SV * static_class = ST(1);
    SV * name = ST(2);
    SV * obj = ST(3);

    if (!SvROK(obj)) {
        croak("Got a non-reference for obj in p5_call_p6_extension_method?!");
    }
    MAGIC * mg = find_shadow_magic(p6cb, static_class, obj);
    STRLEN len;
    char * const name_pv  = SvPV(name, len);
    _perl6_magic* const p6mg = (_perl6_magic*)(mg->mg_ptr);
    SV *err = NULL;

    AV *args = create_args_array(ax, items, 4);
    SV * const args_rv = newRV_noinc((SV *) args);

    declare_cbs;
    SV * retval = cbs->call_p6_method(p6mg->index, name_pv, GIMME_V == G_SCALAR, args_rv, &err);
    return post_callback(ax, sp, items, args_rv, err, retval);
}

XS(p5_hash_at_key) {
    dXSARGS;
    SV * self = ST(0);
    SV * key  = ST(1);

    SV * const p6hashobj = *(av_fetch((AV *) SvRV(self), 0, 0));
    MAGIC * const mg = mg_find(SvRV(p6hashobj), '~');
    _perl6_hash_magic* const p6mg = (_perl6_hash_magic*)(mg->mg_ptr);

    STRLEN len;
    char * const key_pv  = SvPV(key, len);

    declare_cbs;
    SV * retval = cbs->hash_at_key(p6mg->index, key_pv);

    sv_2mortal(retval);
    sp -= items;

    XPUSHs(retval);
    XSRETURN(1);
}

XS(p5_hash_assign_key) {
    dXSARGS;
    SV * self = ST(0);
    SV * key  = ST(1);
    SV * val  = ST(2);

    SV * const p6hashobj = *(av_fetch((AV *) SvRV(self), 0, 0));
    MAGIC * const mg = mg_find(SvRV(p6hashobj), '~');
    _perl6_hash_magic* const p6mg = (_perl6_hash_magic*)(mg->mg_ptr);

    STRLEN len;
    char * const key_pv  = SvPV(key, len);

    declare_cbs;
    cbs->hash_assign_key(p6mg->index, key_pv, val);

    sp -= items;

    XSRETURN_EMPTY;
}

XS(p5_call_p6_callable) {
    dXSARGS;
    SV * obj = ST(0);

    AV *args = create_args_array(ax, items, 1);

    if (!SvROK(obj))
        croak("Tried to call a Perl 6 method on a non-object!?");
    SV * const obj_deref = SvRV(obj);
    MAGIC * const mg = mg_find(obj_deref, '~');
    _perl6_magic* const p6mg = (_perl6_magic*)(mg->mg_ptr);
    SV *err = NULL;
    SV * const args_rv = newRV_noinc((SV *) args);

    declare_cbs;
    SV * retval = cbs->call_p6_callable(p6mg->index, args_rv, &err);
    return post_callback(ax, sp, items, args_rv, err, retval);
}

XS(p5_load_module) {
    dXSARGS;
    SV * module  = ST(0);
    SV * version = NULL;
    SvREFCNT_inc(module);  /* decremented by load_module */
    if (items == 2) {
        version = ST(1);
        SvREFCNT_inc(version); /* decremented by load_module */
    }
    load_module(PERL_LOADMOD_NOIMPORT, module, version);
    SPAGAIN;
    sp -= items;
    XSRETURN_EMPTY;
}

static MGVTBL subname_vtbl;

XS(p5_set_subname) {
    dXSARGS;
    SV *package = ST(0);
    SV *name    = ST(1);
    SV *sub     = ST(2);
    CV *code    = (CV *) SvRV(sub);
    HV *stash   = GvHV(gv_fetchsv(package, TRUE, SVt_PVHV));
    GV *gv = (GV *) newSV(0);
    MAGIC *mg;

    gv_init_sv(gv, stash, name, GV_ADDMULTI);

    /*
     * p5_set_subname needs to create a GV to store the name. The CvGV field of
     * a CV is not refcounted, so perl wouldn't know to SvREFCNT_dec() this GV
     * if it destroys the containing CV. We use a MAGIC with an empty vtable
     * simply for the side-effect of using MGf_REFCOUNTED to store the
     * actually-counted reference to the GV.
     */
    Newxz(mg, 1, MAGIC);
    mg->mg_moremagic = SvMAGIC(code);
    mg->mg_type = PERL_MAGIC_ext;
    mg->mg_virtual = &subname_vtbl;
    SvMAGIC_set(code, mg);
    mg->mg_flags |= MGf_REFCOUNTED;
    mg->mg_obj = (SV *) gv;
    SvRMAGICAL_on(code);
    CvANON_off(code);
#ifndef CvGV_set
    CvGV(code) = gv;
#else
    CvGV_set(code, gv);
#endif
    sp -= items;
    PUSHs(sub);
    XSRETURN(1);
}