1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
/*
----------------------------------------------------------------------------
mro_compat.h - Provides mro functions for XS
Automatically created by Devel::MRO/0.01, running under perl 5.10.0
Copyright (c) 2008, Goro Fuji <gfuji(at)cpan.org>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
----------------------------------------------------------------------------
Usage:
#include "mro_compat.h"
Functions:
AV* mro_get_linear_isa(HV* stash)
UV mro_get_pkg_gen(HV* stash)
void mro_method_changed_in(HV* stash)
See "perldoc mro" for details.
*/
#ifndef mro_get_linear_isa
#define mro_get_linear_isa(stash) my_mro_get_linear_isa(aTHX_ stash)
#define mro_method_changed_in(stash) ((void)stash, (void)PL_sub_generation++)
#define mro_get_pkg_gen(stash) ((void)stash, PL_sub_generation)
#if defined(NEED_mro_get_linear_isa) && !defined(NEED_mro_get_linear_isa_GLOBAL)
static AV* my_mro_get_linear_isa(pTHX_ HV* const stash);
static
#else
extern AV* my_mro_get_linear_isa(pTHX_ HV* const stash);
#endif /* !NEED_mro_get_linear_isa */
#if defined(NEED_mro_get_linear_isa) || defined(NEED_mro_get_linear_isa_GLOBAL)
#define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
AV*
my_mro_get_linear_isa(pTHX_ HV* const stash){
GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
AV* isa;
SV* gen;
CV* get_linear_isa;
if(!isGV(cachegv))
gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE);
isa = GvAVn(cachegv);
#ifdef GvSVn
gen = GvSVn(cachegv);
#else
gen = GvSV(cachegv);
#endif
if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
return isa; /* returns the cache if available */
}
else{
SvREADONLY_off(isa);
av_clear(isa);
}
get_linear_isa = get_cv("mro::get_linear_isa", FALSE);
if(!get_linear_isa){
ENTER;
SAVETMPS;
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvs("MRO::Compat"), NULL, NULL);
get_linear_isa = get_cv("mro::get_linear_isa", TRUE);
FREETMPS;
LEAVE;
}
{
SV* avref;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
mXPUSHp(HvNAME(stash), strlen(HvNAME(stash)));
PUTBACK;
call_sv((SV*)get_linear_isa, G_SCALAR);
SPAGAIN;
avref = POPs;
PUTBACK;
if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
AV* const av = (AV*)SvRV(avref);
I32 const len = AvFILLp(av) + 1;
I32 i;
for(i = 0; i < len; i++){
HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE);
if(stash)
av_push(isa, newSVpv(HvNAME(stash), 0));
}
SvREADONLY_on(isa);
}
else{
Perl_croak(aTHX_ "mro::get_linear_isa() didn't return an ARRAY reference");
}
FREETMPS;
LEAVE;
}
sv_setiv(gen, (IV)mro_get_pkg_gen(stash));
return GvAV(cachegv);
}
#undef ISA_CACHE
#endif /* !(defined(NEED_mro_get_linear_isa) || defined(NEED_mro_get_linear_isa_GLOBAL)) */
#else /* !mro_get_linear_isa */
/* NOTE:
Because ActivePerl 5.10.0 does not provide Perl_mro_meta_init(),
which is used in HvMROMETA() macro, this mro_get_pkg_gen() refers
to xhv_mro_meta directly.
*/
#ifndef mro_get_pkg_gen
#define mro_get_pkg_gen(stash) (HvAUX(stash)->xhv_mro_meta ? HvAUX(stash)->xhv_mro_meta->pkg_gen : (U32)0)
#endif
#endif /* mro_get_linear_isa */
|
