[gitmo/Class-MOP.git] / MOP.xs

/* There's a lot of cases of doubled parens in here like this:

  while ( (he = ...) ) {

This shuts up warnings from gcc -Wall
*/

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define NEED_sv_2pv_flags
#define NEED_sv_2pv_nolen
#include "ppport.h"

SV *key_name;
U32 hash_name;

SV *key_package;
U32 hash_package;

SV *key_package_name;
U32 hash_package_name;

SV *key_body;
U32 hash_body;

SV* method_metaclass;
SV* associated_metaclass;
SV* wrap;


#define check_package_cache_flag(stash) mop_check_package_cache_flag(aTHX_ stash)
#ifdef HvMROMETA /* 5.10.0 */

#ifndef mro_meta_init
#define mro_meta_init(stash) Perl_mro_meta_init(aTHX_ stash) /* used in HvMROMETA macro */
#endif /* !mro_meta_init */

static UV
mop_check_package_cache_flag(pTHX_ HV* stash) {
    assert(SvTYPE(stash) == SVt_PVHV);

    return HvMROMETA(stash)->pkg_gen; /* mro::get_pkg_gen($pkg) */
}

#else /* pre 5.10.0 */

static UV
mop_check_package_cache_flag(pTHX_ HV* stash) {
    PERL_UNUSED_ARG(stash);
    assert(SvTYPE(stash) == SVt_PVHV);

    return PL_sub_generation;
}
#endif

#define call0(s, m)  mop_call0(aTHX_ s, m)
static SV*
mop_call0(pTHX_ SV* const self, SV* const method) {
    dSP;
    SV* ret;

    PUSHMARK(SP);
    XPUSHs(self);
    PUTBACK;

    call_sv(method, G_SCALAR | G_METHOD);

    SPAGAIN;
    ret = POPs;
    PUTBACK;

    return ret;
}

static void
mop_update_method_map(pTHX_ SV* const self, SV* const class_name, HV* const stash, HV* const map) {
    const char* const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
    SV*   method_metaclass_name;
    char* method_name;
    I32   method_name_len;
    GV* gv;
    dSP;

    /* this function massivly overlaps with the xs version of
     * get_all_package_symbols. a common c function to walk the symbol table
     * should be factored out and used by both.  --rafl */

    hv_iterinit(stash);
    while ( (gv = (GV*)hv_iternextsv(stash, &method_name, &method_name_len)) ) {
        CV* cv;
        switch (SvTYPE (gv)) {
#ifndef SVt_RV
            case SVt_RV:
#endif
            case SVt_IV:
            case SVt_PV:
                /* rafl says that this wastes memory savings that GvSVs have
                   in 5.8.9 and 5.10.x. But without it some tests fail. rafl
                   says the right thing to do is to handle GvSVs differently
                   here. */
                gv_init((GV*)gv, stash, method_name, method_name_len, GV_ADDMULTI);
                /* fall through */
            default:
                break;
        }

        if ( SvTYPE(gv) == SVt_PVGV && (cv = GvCVu(gv)) ) {
            GV* const cvgv = CvGV(cv);
            /* ($cvpkg_name, $cv_name) = get_code_info($cv) */
            const char* const cvpkg_name = HvNAME(GvSTASH(cvgv));
            const char* const cv_name    = GvNAME(cvgv);
            SV* method_slot;
            SV* method_object;

            /* this checks to see that the subroutine is actually from our package  */
            if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
                if ( strNE(cvpkg_name, class_name_pv) ) {
                    continue;
                }
            }

            method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
            if ( SvOK(method_slot) ) {
                SV* const body = call0(method_slot, key_body); /* $method_object->body() */
                if ( SvROK(body) && ((CV*) SvRV(body)) == cv ) {
                    continue;
                }
            }

            method_metaclass_name = call0(self, method_metaclass); /* $self->method_metaclass() */

            /*
                $method_object = $method_metaclass->wrap(
                    $cv,
                    associated_metaclass => $self,
                    package_name         => $class_name,
                    name                 => $method_name
                );
            */
            ENTER;
            SAVETMPS;

            PUSHMARK(SP);
            EXTEND(SP, 8);
            PUSHs(method_metaclass_name); /* invocant */
            mPUSHs(newRV_inc((SV*)cv));
            PUSHs(associated_metaclass);
            PUSHs(self);
            PUSHs(key_package_name);
            PUSHs(class_name);
            PUSHs(key_name);
            mPUSHs(newSVpv(method_name, method_name_len));
            PUTBACK;

            call_sv(wrap, G_SCALAR | G_METHOD);
            SPAGAIN;
            method_object = POPs;
            PUTBACK;
            /* $map->{$method_name} = $method_object */
            sv_setsv(method_slot, method_object);

            FREETMPS;
            LEAVE;
        }
    }
}


/*
get_code_info:
  Pass in a coderef, returns:
  [ $pkg_name, $coderef_name ] ie:
  [ 'Foo::Bar', 'new' ]
*/

MODULE = Class::MOP   PACKAGE = Class::MOP

BOOT:
    key_name = newSVpvs("name");
    key_body = newSVpvs("body");
    key_package = newSVpvs("package");
    key_package_name = newSVpvs("package_name");

    PERL_HASH(hash_name, "name", 4);
    PERL_HASH(hash_body, "body", 4);
    PERL_HASH(hash_package, "package", 7);
    PERL_HASH(hash_package_name, "package_name", 12);

    method_metaclass     = newSVpvs("method_metaclass");
    wrap                 = newSVpvs("wrap");
    associated_metaclass = newSVpvs("associated_metaclass");


PROTOTYPES: ENABLE


void
get_code_info(coderef)
  SV* coderef
  PREINIT:
    char* name;
    char* pkg;
  PPCODE:
    if ( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV ) {
      coderef = SvRV(coderef);
      /* I think this only gets triggered with a mangled coderef, but if
         we hit it without the guard, we segfault. The slightly odd return
         value strikes me as an improvement (mst)
      */
#ifdef isGV_with_GP
      if ( isGV_with_GP(CvGV(coderef)) ) {
#endif
        pkg     = HvNAME( GvSTASH(CvGV(coderef)) );
        name    = GvNAME( CvGV(coderef) );
#ifdef isGV_with_GP
      } else {
        pkg     = "__UNKNOWN__";
        name    = "__ANON__";
      }
#endif

      EXTEND(SP, 2);
      PUSHs(newSVpvn(pkg, strlen(pkg)));
      PUSHs(newSVpvn(name, strlen(name)));
    }


MODULE = Class::MOP   PACKAGE = Class::MOP::Package

void
get_all_package_symbols(self, ...)
    SV *self
    PROTOTYPE: $;$
    PREINIT:
        HV *stash = NULL;
        SV *type_filter = NULL;
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call get_all_package_symbols as a class method");
        }

        switch (GIMME_V) {
            case G_VOID: return; break;
            case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
        }

        if ( items > 1 ) type_filter = ST(1);

        PUTBACK;

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
            stash = gv_stashsv(HeVAL(he),0);

        if (stash) {

            (void)hv_iterinit(stash);

            if ( type_filter && SvPOK(type_filter) ) {
                const char *const type = SvPV_nolen(type_filter);

                while ( (he = hv_iternext(stash)) ) {
                    SV *const gv = HeVAL(he);
                    SV *sv = NULL;
                    char *key;
                    STRLEN keylen;
                    char *package;
                    SV *fq;

                    switch( SvTYPE(gv) ) {
#ifndef SVt_RV
                        case SVt_RV:
#endif
                        case SVt_PV:
                        case SVt_IV:
                            /* expand the gv into a real typeglob if it
                             * contains stub functions and we were asked to
                             * return CODE symbols */
                            if (*type == 'C') {
                                if (SvROK(gv)) {
                                    /* we don't really care about the length,
                                       but that's the API */
                                    key = HePV(he, keylen);
                                    package = HvNAME(stash);
                                    fq = newSVpvf("%s::%s", package, key);
                                    sv = (SV*)get_cv(SvPV_nolen(fq), 0);
                                    break;
                                }

                                key = HePV(he, keylen);
                                gv_init((GV *)gv, stash, key, keylen, GV_ADDMULTI);
                            }
                            /* fall through */
                        case SVt_PVGV:
                            switch (*type) {
                                case 'C': sv = (SV *)GvCVu(gv); break; /* CODE */
                                case 'A': sv = (SV *)GvAV(gv); break; /* ARRAY */
                                case 'I': sv = (SV *)GvIO(gv); break; /* IO */
                                case 'H': sv = (SV *)GvHV(gv); break; /* HASH */
                                case 'S': sv = (SV *)GvSV(gv); break; /* SCALAR */
                                default:
                                          croak("Unknown type %s\n", type);
                            }
                            break;
                        default:
                            continue;
                    }

                    if (sv) {
                        SV *key = hv_iterkeysv(he);
                        SPAGAIN;
                        EXTEND(SP, 2);
                        PUSHs(key);
                        PUSHs(sv_2mortal(newRV_inc(sv)));
                        PUTBACK;
                    }
                }
            } else {
                EXTEND(SP, HvKEYS(stash) * 2);

                while ( (he = hv_iternext(stash)) ) {
                    SV *key = hv_iterkeysv(he);
                    SV *sv = HeVAL(he);
                    SPAGAIN;
                    PUSHs(key);
                    PUSHs(sv);
                    PUTBACK;
                }
            }

        }

void
name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call name as a class method");
        }

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

MODULE = Class::MOP   PACKAGE = Class::MOP::Attribute

void
name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call name as a class method");
        }

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

MODULE = Class::MOP   PACKAGE = Class::MOP::Method

void
name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call name as a class method");
        }

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

void
package_name(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call package_name as a class method");
        }

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name)) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;

void
body(self)
    SV *self
    PREINIT:
        register HE *he;
    PPCODE:
        if ( ! SvROK(self) ) {
            die("Cannot call body as a class method");
        }

        if ( (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)) )
            XPUSHs(HeVAL(he));
        else
            ST(0) = &PL_sv_undef;


MODULE = Class::MOP    PACKAGE = Class::MOP::Class

void
get_method_map(self)
    SV* self
    PREINIT:
        SV* const class_name = HeVAL( hv_fetch_ent((HV*)SvRV(self), key_package, TRUE, hash_package) );
        HV* const stash      = gv_stashsv(class_name, TRUE);
        UV  const current    = check_package_cache_flag(stash);
        SV* const cache_flag = *hv_fetchs((HV*)SvRV(self), "_package_cache_flag", TRUE);
        SV* const map_ref    = *hv_fetchs((HV*)SvRV(self), "methods", TRUE);
    PPCODE:
        if ( ! SvRV(self) ) {
            die("Cannot call get_method_map as a class method");
        }

        /* in  $self->{methods} does not yet exist (or got deleted) */
        if ( ! (SvROK(map_ref) && SvTYPE(SvRV(map_ref)) == SVt_PVHV) ) {
            SV* new_map_ref = newRV_noinc((SV*)newHV());
            sv_2mortal(new_map_ref);
            sv_setsv(map_ref, new_map_ref);
        }

        if ( ! (SvOK(cache_flag) && SvUV(cache_flag) == current) ) {
            ENTER;
            SAVETMPS;

            mop_update_method_map(aTHX_ self, class_name, stash, (HV*)SvRV(map_ref));
            sv_setuv(cache_flag, check_package_cache_flag(stash)); /* update_cache_flag() */

            FREETMPS;
            LEAVE;
        }

        XPUSHs(map_ref);
Commit	Line	Data
e7b69038	1	/* There's a lot of cases of doubled parens in here like this:
	2
	3	while ( (he = ...) ) {
	4
	5	This shuts up warnings from gcc -Wall
	6	*/
	7
e0e4674a	8	#include "EXTERN.h"
	9	#include "perl.h"
	10	#include "XSUB.h"
15273f3c	11
599791aa	12	#define NEED_sv_2pv_flags
15273f3c	13	#define NEED_sv_2pv_nolen
b0e94057	14	#include "ppport.h"
e0e4674a	15
cc856b56	16	SV *key_name;
	17	U32 hash_name;
	18
	19	SV *key_package;
	20	U32 hash_package;
	21
da88f307	22	SV *key_package_name;
	23	U32 hash_package_name;
	24
cc856b56	25	SV *key_body;
	26	U32 hash_body;
	27
c94afdc4	28	SV* method_metaclass;
	29	SV* associated_metaclass;
	30	SV* wrap;
	31
	32
	33	#define check_package_cache_flag(stash) mop_check_package_cache_flag(aTHX_ stash)
	34	#ifdef HvMROMETA /* 5.10.0 */
	35
	36	#ifndef mro_meta_init
	37	#define mro_meta_init(stash) Perl_mro_meta_init(aTHX_ stash) /* used in HvMROMETA macro */
	38	#endif /* !mro_meta_init */
	39
	40	static UV
	41	mop_check_package_cache_flag(pTHX_ HV* stash) {
	42	assert(SvTYPE(stash) == SVt_PVHV);
	43
	44	return HvMROMETA(stash)->pkg_gen; /* mro::get_pkg_gen($pkg) */
	45	}
	46
	47	#else /* pre 5.10.0 */
	48
	49	static UV
	50	mop_check_package_cache_flag(pTHX_ HV* stash) {
	51	PERL_UNUSED_ARG(stash);
	52	assert(SvTYPE(stash) == SVt_PVHV);
	53
	54	return PL_sub_generation;
	55	}
	56	#endif
	57
	58	#define call0(s, m) mop_call0(aTHX_ s, m)
	59	static SV*
	60	mop_call0(pTHX_ SV* const self, SV* const method) {
	61	dSP;
	62	SV* ret;
	63
	64	PUSHMARK(SP);
	65	XPUSHs(self);
	66	PUTBACK;
	67
	68	call_sv(method, G_SCALAR \| G_METHOD);
	69
	70	SPAGAIN;
	71	ret = POPs;
	72	PUTBACK;
	73
	74	return ret;
	75	}
	76
	77	static void
	78	mop_update_method_map(pTHX_ SV* const self, SV* const class_name, HV* const stash, HV* const map) {
	79	const char* const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
	80	SV* method_metaclass_name;
	81	char* method_name;
	82	I32 method_name_len;
	83	GV* gv;
	84	dSP;
49bbf9e5	85
6bd19edb	86	/* this function massivly overlaps with the xs version of
	87	* get_all_package_symbols. a common c function to walk the symbol table
	88	* should be factored out and used by both. --rafl */
	89
c94afdc4	90	hv_iterinit(stash);
e7b69038	91	while ( (gv = (GV*)hv_iternextsv(stash, &method_name, &method_name_len)) ) {
c94afdc4	92	CV* cv;
6bd19edb	93	switch (SvTYPE (gv)) {
cb0ec494	94	#ifndef SVt_RV
6bd19edb	95	case SVt_RV:
cb0ec494	96	#endif
6bd19edb	97	case SVt_IV:
	98	case SVt_PV:
	99	/* rafl says that this wastes memory savings that GvSVs have
	100	in 5.8.9 and 5.10.x. But without it some tests fail. rafl
	101	says the right thing to do is to handle GvSVs differently
	102	here. */
	103	gv_init((GV*)gv, stash, method_name, method_name_len, GV_ADDMULTI);
	104	/* fall through */
733e8831	105	default:
733e8831	106	break;
c94afdc4	107	}
	108
	109	if ( SvTYPE(gv) == SVt_PVGV && (cv = GvCVu(gv)) ) {
	110	GV* const cvgv = CvGV(cv);
	111	/* ($cvpkg_name, $cv_name) = get_code_info($cv) */
	112	const char* const cvpkg_name = HvNAME(GvSTASH(cvgv));
	113	const char* const cv_name = GvNAME(cvgv);
	114	SV* method_slot;
	115	SV* method_object;
	116
	117	/* this checks to see that the subroutine is actually from our package */
	118	if ( !(strEQ(cvpkg_name, "constant") && strEQ(cv_name, "__ANON__")) ) {
	119	if ( strNE(cvpkg_name, class_name_pv) ) {
	120	continue;
	121	}
	122	}
	123
	124	method_slot = *hv_fetch(map, method_name, method_name_len, TRUE);
	125	if ( SvOK(method_slot) ) {
	126	SV* const body = call0(method_slot, key_body); /* $method_object->body() */
	127	if ( SvROK(body) && ((CV*) SvRV(body)) == cv ) {
	128	continue;
	129	}
	130	}
	131
	132	method_metaclass_name = call0(self, method_metaclass); /* $self->method_metaclass() */
	133
	134	/*
	135	$method_object = $method_metaclass->wrap(
	136	$cv,
	137	associated_metaclass => $self,
	138	package_name => $class_name,
	139	name => $method_name
	140	);
	141	*/
	142	ENTER;
	143	SAVETMPS;
	144
	145	PUSHMARK(SP);
	146	EXTEND(SP, 8);
	147	PUSHs(method_metaclass_name); /* invocant */
	148	mPUSHs(newRV_inc((SV*)cv));
	149	PUSHs(associated_metaclass);
	150	PUSHs(self);
	151	PUSHs(key_package_name);
	152	PUSHs(class_name);
	153	PUSHs(key_name);
	154	mPUSHs(newSVpv(method_name, method_name_len));
	155	PUTBACK;
	156
	157	call_sv(wrap, G_SCALAR \| G_METHOD);
	158	SPAGAIN;
	159	method_object = POPs;
	160	PUTBACK;
	161	/* $map->{$method_name} = $method_object */
	162	sv_setsv(method_slot, method_object);
	163
	164	FREETMPS;
	165	LEAVE;
	166	}
	167	}
	168	}
	169
	170
e0e4674a	171	/*
e0e4674a	172	get_code_info:
	173	Pass in a coderef, returns:
	174	[ $pkg_name, $coderef_name ] ie:
	175	[ 'Foo::Bar', 'new' ]
	176	*/
	177
	178	MODULE = Class::MOP PACKAGE = Class::MOP
	179
cc856b56	180	BOOT:
	181	key_name = newSVpvs("name");
	182	key_body = newSVpvs("body");
	183	key_package = newSVpvs("package");
da88f307	184	key_package_name = newSVpvs("package_name");
cc856b56	185
	186	PERL_HASH(hash_name, "name", 4);
	187	PERL_HASH(hash_body, "body", 4);
	188	PERL_HASH(hash_package, "package", 7);
da88f307	189	PERL_HASH(hash_package_name, "package_name", 12);
cc856b56	190
c94afdc4	191	method_metaclass = newSVpvs("method_metaclass");
	192	wrap = newSVpvs("wrap");
	193	associated_metaclass = newSVpvs("associated_metaclass");
	194
cc856b56	195
d7bf3478	196	PROTOTYPES: ENABLE
d7bf3478	197
cc856b56	198
e0e4674a	199	void
	200	get_code_info(coderef)
	201	SV* coderef
	202	PREINIT:
	203	char* name;
	204	char* pkg;
	205	PPCODE:
a7f711e5	206	if ( SvOK(coderef) && SvROK(coderef) && SvTYPE(SvRV(coderef)) == SVt_PVCV ) {
e0e4674a	207	coderef = SvRV(coderef);
7b62d87f	208	/* I think this only gets triggered with a mangled coderef, but if
	209	we hit it without the guard, we segfault. The slightly odd return
	210	value strikes me as an improvement (mst)
	211	*/
a4f4221a	212	#ifdef isGV_with_GP
a7f711e5	213	if ( isGV_with_GP(CvGV(coderef)) ) {
a4f4221a	214	#endif
7b62d87f	215	pkg = HvNAME( GvSTASH(CvGV(coderef)) );
7b62d87f	216	name = GvNAME( CvGV(coderef) );
a4f4221a	217	#ifdef isGV_with_GP
	218	} else {
	219	pkg = "__UNKNOWN__";
	220	name = "__ANON__";
	221	}
	222	#endif
e0e4674a	223
	224	EXTEND(SP, 2);
	225	PUSHs(newSVpvn(pkg, strlen(pkg)));
	226	PUSHs(newSVpvn(name, strlen(name)));
	227	}
	228
15273f3c	229
	230	MODULE = Class::MOP PACKAGE = Class::MOP::Package
	231
	232	void
cc856b56	233	get_all_package_symbols(self, ...)
cc856b56	234	SV *self
15273f3c	235	PROTOTYPE: $;$
15273f3c	236	PREINIT:
cc856b56	237	HV *stash = NULL;
15273f3c	238	SV *type_filter = NULL;
75705e60	239	register HE *he;
15273f3c	240	PPCODE:
a7f711e5	241	if ( ! SvROK(self) ) {
988fb42e	242	die("Cannot call get_all_package_symbols as a class method");
988fb42e	243	}
15273f3c	244
a7f711e5	245	switch (GIMME_V) {
15273f3c	246	case G_VOID: return; break;
	247	case G_SCALAR: ST(0) = &PL_sv_undef; return; break;
	248	}
	249
	250	if ( items > 1 ) type_filter = ST(1);
	251
	252	PUTBACK;
	253
a7f711e5	254	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
75705e60	255	stash = gv_stashsv(HeVAL(he),0);
15273f3c	256
a7f711e5	257	if (stash) {
15273f3c	258
	259	(void)hv_iterinit(stash);
	260
	261	if ( type_filter && SvPOK(type_filter) ) {
	262	const char *const type = SvPV_nolen(type_filter);
	263
a7f711e5	264	while ( (he = hv_iternext(stash)) ) {
75705e60	265	SV *const gv = HeVAL(he);
a88898eb	266	SV *sv = NULL;
75705e60	267	char *key;
75705e60	268	STRLEN keylen;
9457b596	269	char *package;
fd27f6e9	270	SV *fq;
15273f3c	271
15273f3c	272	switch( SvTYPE(gv) ) {
cb0ec494	273	#ifndef SVt_RV
	274	case SVt_RV:
	275	#endif
15b55537	276	case SVt_PV:
	277	case SVt_IV:
	278	/* expand the gv into a real typeglob if it
	279	* contains stub functions and we were asked to
	280	* return CODE symbols */
	281	if (*type == 'C') {
cb0ec494	282	if (SvROK(gv)) {
	283	/* we don't really care about the length,
	284	but that's the API */
	285	key = HePV(he, keylen);
	286	package = HvNAME(stash);
	287	fq = newSVpvf("%s::%s", package, key);
	288	sv = (SV*)get_cv(SvPV_nolen(fq), 0);
	289	break;
	290	}
	291
15b55537	292	key = HePV(he, keylen);
	293	gv_init((GV *)gv, stash, key, keylen, GV_ADDMULTI);
	294	}
	295	/* fall through */
15273f3c	296	case SVt_PVGV:
	297	switch (*type) {
	298	case 'C': sv = (SV )GvCVu(gv); break; / CODE */
	299	case 'A': sv = (SV )GvAV(gv); break; / ARRAY */
	300	case 'I': sv = (SV )GvIO(gv); break; / IO */
	301	case 'H': sv = (SV )GvHV(gv); break; / HASH */
	302	case 'S': sv = (SV )GvSV(gv); break; / SCALAR */
	303	default:
	304	croak("Unknown type %s\n", type);
	305	}
	306	break;
15273f3c	307	default:
	308	continue;
	309	}
	310
a7f711e5	311	if (sv) {
75705e60	312	SV *key = hv_iterkeysv(he);
15273f3c	313	SPAGAIN;
	314	EXTEND(SP, 2);
	315	PUSHs(key);
66af67fe	316	PUSHs(sv_2mortal(newRV_inc(sv)));
15273f3c	317	PUTBACK;
	318	}
	319	}
	320	} else {
	321	EXTEND(SP, HvKEYS(stash) * 2);
	322
e7b69038	323	while ( (he = hv_iternext(stash)) ) {
75705e60	324	SV *key = hv_iterkeysv(he);
599791aa	325	SV *sv = HeVAL(he);
15273f3c	326	SPAGAIN;
0eb2957d	327	PUSHs(key);
15273f3c	328	PUSHs(sv);
	329	PUTBACK;
	330	}
	331	}
	332
	333	}
	334
e2c189ae	335	void
cc856b56	336	name(self)
	337	SV *self
	338	PREINIT:
	339	register HE *he;
	340	PPCODE:
a7f711e5	341	if ( ! SvROK(self) ) {
988fb42e	342	die("Cannot call name as a class method");
	343	}
	344
e7b69038	345	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) )
cc856b56	346	XPUSHs(HeVAL(he));
	347	else
	348	ST(0) = &PL_sv_undef;
	349
dcbfe027	350	MODULE = Class::MOP PACKAGE = Class::MOP::Attribute
cc856b56	351
e2c189ae	352	void
cc856b56	353	name(self)
	354	SV *self
	355	PREINIT:
	356	register HE *he;
	357	PPCODE:
a7f711e5	358	if ( ! SvROK(self) ) {
988fb42e	359	die("Cannot call name as a class method");
	360	}
	361
e7b69038	362	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) )
cc856b56	363	XPUSHs(HeVAL(he));
	364	else
	365	ST(0) = &PL_sv_undef;
	366
dcbfe027	367	MODULE = Class::MOP PACKAGE = Class::MOP::Method
cc856b56	368
e2c189ae	369	void
da88f307	370	name(self)
	371	SV *self
	372	PREINIT:
	373	register HE *he;
	374	PPCODE:
a7f711e5	375	if ( ! SvROK(self) ) {
da88f307	376	die("Cannot call name as a class method");
	377	}
	378
e7b69038	379	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) )
da88f307	380	XPUSHs(HeVAL(he));
	381	else
	382	ST(0) = &PL_sv_undef;
	383
e2c189ae	384	void
da88f307	385	package_name(self)
	386	SV *self
	387	PREINIT:
	388	register HE *he;
	389	PPCODE:
a7f711e5	390	if ( ! SvROK(self) ) {
da88f307	391	die("Cannot call package_name as a class method");
	392	}
	393
e7b69038	394	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name)) )
da88f307	395	XPUSHs(HeVAL(he));
	396	else
	397	ST(0) = &PL_sv_undef;
	398
e2c189ae	399	void
cc856b56	400	body(self)
	401	SV *self
	402	PREINIT:
	403	register HE *he;
	404	PPCODE:
a7f711e5	405	if ( ! SvROK(self) ) {
da88f307	406	die("Cannot call body as a class method");
	407	}
	408
e7b69038	409	if ( (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)) )
cc856b56	410	XPUSHs(HeVAL(he));
	411	else
	412	ST(0) = &PL_sv_undef;
c94afdc4	413
	414
	415	MODULE = Class::MOP PACKAGE = Class::MOP::Class
	416
	417	void
	418	get_method_map(self)
	419	SV* self
c200a770	420	PREINIT:
b69838b1	421	SV* const class_name = HeVAL( hv_fetch_ent((HV*)SvRV(self), key_package, TRUE, hash_package) );
c200a770	422	HV* const stash = gv_stashsv(class_name, TRUE);
	423	UV const current = check_package_cache_flag(stash);
	424	SV* const cache_flag = hv_fetchs((HV)SvRV(self), "_package_cache_flag", TRUE);
	425	SV* const map_ref = hv_fetchs((HV)SvRV(self), "methods", TRUE);
	426	PPCODE:
	427	if ( ! SvRV(self) ) {
	428	die("Cannot call get_method_map as a class method");
	429	}
c94afdc4	430
c200a770	431	/* in $self->{methods} does not yet exist (or got deleted) */
	432	if ( ! (SvROK(map_ref) && SvTYPE(SvRV(map_ref)) == SVt_PVHV) ) {
	433	SV* new_map_ref = newRV_noinc((SV*)newHV());
	434	sv_2mortal(new_map_ref);
	435	sv_setsv(map_ref, new_map_ref);
	436	}
c94afdc4	437
c200a770	438	if ( ! (SvOK(cache_flag) && SvUV(cache_flag) == current) ) {
	439	ENTER;
	440	SAVETMPS;
	441
	442	mop_update_method_map(aTHX_ self, class_name, stash, (HV*)SvRV(map_ref));
	443	sv_setuv(cache_flag, check_package_cache_flag(stash)); /* update_cache_flag() */
	444
	445	FREETMPS;
	446	LEAVE;
	447	}
	448
	449	XPUSHs(map_ref);
c94afdc4	450