GV *
Perl_gv_AVadd(pTHX_ register GV *gv)
{
if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
Perl_croak(aTHX_ "Bad symbol for array");
if (!GvAV(gv))
GvAV(gv) = newAV();
return gv;
}
void THX_MopMcV_set_superclass(pTHX_ SV* metaclass, SV* superclass) {
AV* isa_av;
GV* isa_gv;
HV* stash = (HV*) SvRV(metaclass);
SV** isa_gv_p = hv_fetch(stash, "ISA", 3, 0);
if (isa_gv_p != NULL) {
isa_gv = (GV*) *isa_gv_p;
} else {
isa_gv = (GV*) newSV(0);
gv_init_pvn(isa_gv, stash, "ISA", 3, 0);
(void)hv_store(stash, "ISA", 3, (SV*) isa_gv, 0);
}
isa_av = GvAV(isa_gv);
if (isa_av == NULL) {
gv_AVadd(isa_gv);
isa_av = GvAV(isa_gv);
}
(void)av_store(isa_av, 0, MopMcV_get_name(superclass));
}
void
mop_get_package_symbols (HV *stash, type_filter_t filter, get_package_symbols_cb_t cb, void *ud)
{
HE *he;
(void)hv_iterinit(stash);
if (filter == TYPE_FILTER_NONE) {
while ( (he = hv_iternext(stash)) ) {
STRLEN keylen;
const char *key = HePV(he, keylen);
if (!cb(key, keylen, HeVAL(he), ud)) {
return;
}
}
return;
}
while ( (he = hv_iternext(stash)) ) {
GV * const gv = (GV*)HeVAL(he);
STRLEN keylen;
const char * const key = HePV(he, keylen);
SV *sv = NULL;
if(isGV(gv)){
switch (filter) {
case TYPE_FILTER_CODE: sv = (SV *)GvCVu(gv); break;
case TYPE_FILTER_ARRAY: sv = (SV *)GvAV(gv); break;
case TYPE_FILTER_IO: sv = (SV *)GvIO(gv); break;
case TYPE_FILTER_HASH: sv = (SV *)GvHV(gv); break;
case TYPE_FILTER_SCALAR: sv = (SV *)GvSV(gv); break;
default:
croak("Unknown type");
}
}
/* expand the gv into a real typeglob if it
* contains stub functions or constants and we
* were asked to return CODE references */
else if (filter == TYPE_FILTER_CODE) {
gv_init(gv, stash, key, keylen, GV_ADDMULTI);
sv = (SV *)GvCV(gv);
}
if (sv) {
if (!cb(key, keylen, sv, ud)) {
return;
}
}
}
}
SV* THX_MopMcV_get_superclass(pTHX_ SV* metaclass) {
HV* stash = (HV*) SvRV(metaclass);
SV** isa_gv = hv_fetch(stash, "ISA", 3, 0);
if (isa_gv != NULL) {
AV* isa_av = GvAV((GV*) *isa_gv);
if (isa_av != NULL) {
SV** super = av_fetch(isa_av, 0, 0);
if (super != NULL) {
return newMopMcV(*super);
}
}
}
return NULL;
}
int main(int argc, char **argv, char **env)
{
char *args[] = { NULL };
int exitstatus, i;
AV* plargv;
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, xs_init, argc, argv, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
/*** skipping perl_run() ***/
plargv = GvAV(PL_argvgv);
for (i = 0; i <= av_len(plargv); ++i) {
SV **item = av_fetch(plargv, i, 0);
call_argv(SvPV_nolen(*item), G_SCALAR | G_NOARGS, args);
{
dSP;
SV *res = POPs;
printf("RES=%s\n", SvOK(res) ? SvPV_nolen(res) : "undef");
}
}
exitstatus = perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
return exitstatus;
}
GV *
Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
{
AV* av;
GV* topgv;
GV* gv;
GV** gvp;
CV* cv;
if (!stash)
return 0;
if ((level > 100) || (level < -100))
Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
name, HvNAME(stash));
DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) );
gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
if (!gvp)
topgv = Nullgv;
else {
topgv = *gvp;
if (SvTYPE(topgv) != SVt_PVGV)
gv_init(topgv, stash, name, len, TRUE);
if ((cv = GvCV(topgv))) {
/* If genuine method or valid cache entry, use it */
if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation)
return topgv;
/* Stale cached entry: junk it */
SvREFCNT_dec(cv);
GvCV(topgv) = cv = Nullcv;
GvCVGEN(topgv) = 0;
}
else if (GvCVGEN(topgv) == PL_sub_generation)
return 0; /* cache indicates sub doesn't exist */
}
gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
/* create and re-create @.*::SUPER::ISA on demand */
if (!av || !SvMAGIC(av)) {
char* packname = HvNAME(stash);
STRLEN packlen = strlen(packname);
if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
HV* basestash;
packlen -= 7;
basestash = gv_stashpvn(packname, packlen, TRUE);
gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
if (!gvp || !(gv = *gvp))
Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
if (SvTYPE(gv) != SVt_PVGV)
gv_init(gv, stash, "ISA", 3, TRUE);
SvREFCNT_dec(GvAV(gv));
GvAV(gv) = (AV*)SvREFCNT_inc(av);
}
}
}
if (av) {
SV** svp = AvARRAY(av);
/* NOTE: No support for tied ISA */
I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ WARN_MISC, "Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
gv = gv_fetchmeth(basestash, name, len,
(level >= 0) ? level + 1 : level - 1);
if (gv)
goto gotcha;
}
}
/* if at top level, try UNIVERSAL */
if (level == 0 || level == -1) {
HV* lastchance;
if ((lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE))) {
if ((gv = gv_fetchmeth(lastchance, name, len,
(level >= 0) ? level + 1 : level - 1)))
{
gotcha:
/*
* Cache method in topgv if:
* 1. topgv has no synonyms (else inheritance crosses wires)
* 2. method isn't a stub (else AUTOLOAD fails spectacularly)
*/
if (topgv &&
GvREFCNT(topgv) == 1 &&
(cv = GvCV(gv)) &&
(CvROOT(cv) || CvXSUB(cv)))
{
if ((cv = GvCV(topgv)))
SvREFCNT_dec(cv);
GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
GvCVGEN(topgv) = PL_sub_generation;
}
return gv;
}
else if (topgv && GvREFCNT(topgv) == 1) {
/* cache the fact that the method is not defined */
GvCVGEN(topgv) = PL_sub_generation;
}
}
}
return 0;
}
/*
=for apidoc mro_get_linear_isa_dfs
Returns the Depth-First Search linearization of @ISA
the given stash. The return value is a read-only AV*.
C<level> should be 0 (it is used internally in this
function's recursion).
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
static AV*
S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
{
AV* retval;
GV** gvp;
GV* gv;
AV* av;
const HEK* stashhek;
struct mro_meta* meta;
SV *our_name;
HV *stored;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
assert(HvAUX(stash));
stashhek = HvNAME_HEK(stash);
if (!stashhek)
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
HEK_KEY(stashhek));
meta = HvMROMETA(stash);
/* return cache if valid */
if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
return retval;
}
/* not in cache, make a new one */
retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
/* We use this later in this function, but don't need a reference to it
beyond the end of this function, so reference count is fine. */
our_name = newSVhek(stashhek);
av_push(retval, our_name); /* add ourselves at the top */
/* fetch our @ISA */
gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
/* "stored" is used to keep track of all of the classnames we have added to
the MRO so far, so we can do a quick exists check and avoid adding
duplicate classnames to the MRO as we go.
It's then retained to be re-used as a fast lookup for ->isa(), by adding
our own name and "UNIVERSAL" to it. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
if(av && AvFILLp(av) >= 0) {
SV **svp = AvARRAY(av);
I32 items = AvFILLp(av) + 1;
/* foreach(@ISA) */
while (items--) {
SV* const sv = *svp++;
HV* const basestash = gv_stashsv(sv, 0);
SV *const *subrv_p;
I32 subrv_items;
if (!basestash) {
/* if no stash exists for this @ISA member,
simply add it to the MRO and move on */
subrv_p = &sv;
subrv_items = 1;
}
else {
/* otherwise, recurse into ourselves for the MRO
of this @ISA member, and append their MRO to ours.
The recursive call could throw an exception, which
has memory management implications here, hence the use of
the mortal. */
const AV *const subrv
= mro_get_linear_isa_dfs(basestash, level + 1);
subrv_p = AvARRAY(subrv);
subrv_items = AvFILLp(subrv) + 1;
}
while(subrv_items--) {
SV *const subsv = *subrv_p++;
/* LVALUE fetch will create a new undefined SV if necessary
*/
HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
assert(he);
if(HeVAL(he) != &PL_sv_undef) {
/* It was newly created. Steal it for our new SV, and
replace it in the hash with the "real" thing. */
SV *const val = HeVAL(he);
HEK *const key = HeKEY_hek(he);
HeVAL(he) = &PL_sv_undef;
/* Save copying by making a shared hash key scalar. We
inline this here rather than calling Perl_newSVpvn_share
because we already have the scalar, and we already have
the hash key. */
assert(SvTYPE(val) == SVt_NULL);
sv_upgrade(val, SVt_PV);
SvPV_set(val, HEK_KEY(share_hek_hek(key)));
SvCUR_set(val, HEK_LEN(key));
SvREADONLY_on(val);
SvFAKE_on(val);
SvPOK_on(val);
if (HEK_UTF8(key))
SvUTF8_on(val);
av_push(retval, val);
}
}
}
}
(void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
SvREFCNT_inc_simple_void_NN(stored);
SvTEMP_off(stored);
SvREADONLY_on(stored);
meta->isa = stored;
/* now that we're past the exception dangers, grab our own reference to
the AV we're about to use for the result. The reference owned by the
mortals' stack will be released soon, so everything will balance. */
SvREFCNT_inc_simple_void_NN(retval);
SvTEMP_off(retval);
/* we don't want anyone modifying the cache entry but us,
and we do so by replacing it completely */
SvREADONLY_on(retval);
return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
MUTABLE_SV(retval)));
}
static int perl_init_aaaa()
{
dTARG;
dSP;
listop_list[0].op_ppaddr = PL_ppaddr[OP_LEAVE];
op_list[0].op_ppaddr = PL_ppaddr[OP_ENTER];
cop_list[0].op_ppaddr = PL_ppaddr[OP_NEXTSTATE];
cop_list[0].cop_warnings = pWARN_STD;
CopFILE_set(&cop_list[0], "hello.p");
CopSTASHPV_set(&cop_list[0], "main");
listop_list[1].op_ppaddr = PL_ppaddr[OP_PRINT];
op_list[1].op_ppaddr = PL_ppaddr[OP_PUSHMARK];
svop_list[0].op_ppaddr = PL_ppaddr[OP_CONST];
gv_list[0] = gv_fetchpv("main::/", TRUE, SVt_PV);
SvFLAGS(gv_list[0]) = 0x600d;
GvFLAGS(gv_list[0]) = 0xa;
GvLINE(gv_list[0]) = 0;
SvPVX(gv_list[0]) = emptystring;
SvREFCNT(gv_list[0]) += 4;
GvREFCNT(gv_list[0]) += 1;
gv_list[1] = gv_fetchpv("main::stderr", TRUE, SVt_PV);
SvFLAGS(gv_list[1]) = 0x600d;
GvFLAGS(gv_list[1]) = 0x2;
GvLINE(gv_list[1]) = 0;
SvPVX(gv_list[1]) = emptystring;
SvREFCNT(gv_list[1]) += 2;
GvREFCNT(gv_list[1]) += 1;
GvSV(gv_list[1]) = &sv_list[0];
GvFILE(gv_list[1]) = "hello.p";
IoIFP((IO*)&sv_list[1])=PerlIO_stderr();
IoOFP((IO*)&sv_list[1])=PerlIO_stderr();
hv0 = gv_stashpv("FileHandle", TRUE);
SvSTASH((IO*)&sv_list[1]) = hv0;
GvIOp(gv_list[1]) = (IO*)&sv_list[1];
gv_list[2] = gv_fetchpv("main::SIG", TRUE, SVt_PV);
SvFLAGS(gv_list[2]) = 0x600d;
GvFLAGS(gv_list[2]) = 0xa;
GvLINE(gv_list[2]) = 62;
SvPVX(gv_list[2]) = emptystring;
SvREFCNT(gv_list[2]) += 12;
GvREFCNT(gv_list[2]) += 1;
gv_list[3] = gv_fetchpv("main::,", TRUE, SVt_PV);
SvFLAGS(gv_list[3]) = 0x600d;
GvFLAGS(gv_list[3]) = 0xa;
GvLINE(gv_list[3]) = 474;
SvPVX(gv_list[3]) = emptystring;
SvREFCNT(gv_list[3]) += 6;
GvREFCNT(gv_list[3]) += 1;
gv_list[4] = gv_fetchpv("utf8::unicode_to_native", TRUE, SVt_PV);
SvFLAGS(gv_list[4]) = 0x600d;
GvFLAGS(gv_list[4]) = 0xa;
GvLINE(gv_list[4]) = 0;
SvPVX(gv_list[4]) = emptystring;
SvREFCNT(gv_list[4]) += 3;
GvREFCNT(gv_list[4]) += 1;
GvSV(gv_list[4]) = &sv_list[2];
GvCV(gv_list[4]) = (CV*)((perl_get_cv("utf8::unicode_to_native",TRUE)));
GvFILE(gv_list[4]) = "hello.p";
gv_list[5] = gv_fetchpv("utf8::encode", TRUE, SVt_PV);
SvFLAGS(gv_list[5]) = 0x600d;
GvFLAGS(gv_list[5]) = 0x2;
GvLINE(gv_list[5]) = 0;
SvPVX(gv_list[5]) = emptystring;
SvREFCNT(gv_list[5]) += 2;
GvREFCNT(gv_list[5]) += 1;
GvSV(gv_list[5]) = &sv_list[3];
GvCV(gv_list[5]) = (CV*)((perl_get_cv("utf8::encode",TRUE)));
GvFILE(gv_list[5]) = "hello.p";
gv_list[6] = gv_fetchpv("utf8::valid", TRUE, SVt_PV);
SvFLAGS(gv_list[6]) = 0x600d;
GvFLAGS(gv_list[6]) = 0x2;
GvLINE(gv_list[6]) = 0;
SvPVX(gv_list[6]) = emptystring;
SvREFCNT(gv_list[6]) += 2;
GvREFCNT(gv_list[6]) += 1;
GvSV(gv_list[6]) = &sv_list[4];
GvCV(gv_list[6]) = (CV*)((perl_get_cv("utf8::valid",TRUE)));
GvFILE(gv_list[6]) = "hello.p";
gv_list[7] = gv_fetchpv("utf8::native_to_unicode", TRUE, SVt_PV);
SvFLAGS(gv_list[7]) = 0x600d;
GvFLAGS(gv_list[7]) = 0x2;
GvLINE(gv_list[7]) = 0;
SvPVX(gv_list[7]) = emptystring;
SvREFCNT(gv_list[7]) += 2;
GvREFCNT(gv_list[7]) += 1;
GvSV(gv_list[7]) = &sv_list[5];
GvCV(gv_list[7]) = (CV*)((perl_get_cv("utf8::native_to_unicode",TRUE)));
GvFILE(gv_list[7]) = "hello.p";
gv_list[8] = gv_fetchpv("utf8::decode", TRUE, SVt_PV);
SvFLAGS(gv_list[8]) = 0x600d;
GvFLAGS(gv_list[8]) = 0x2;
GvLINE(gv_list[8]) = 0;
SvPVX(gv_list[8]) = emptystring;
SvREFCNT(gv_list[8]) += 2;
GvREFCNT(gv_list[8]) += 1;
GvSV(gv_list[8]) = &sv_list[6];
GvCV(gv_list[8]) = (CV*)((perl_get_cv("utf8::decode",TRUE)));
GvFILE(gv_list[8]) = "hello.p";
gv_list[9] = gv_fetchpv("utf8::downgrade", TRUE, SVt_PV);
SvFLAGS(gv_list[9]) = 0x600d;
GvFLAGS(gv_list[9]) = 0x2;
GvLINE(gv_list[9]) = 0;
SvPVX(gv_list[9]) = emptystring;
SvREFCNT(gv_list[9]) += 2;
GvREFCNT(gv_list[9]) += 1;
GvSV(gv_list[9]) = &sv_list[7];
GvCV(gv_list[9]) = (CV*)((perl_get_cv("utf8::downgrade",TRUE)));
GvFILE(gv_list[9]) = "hello.p";
gv_list[10] = gv_fetchpv("utf8::upgrade", TRUE, SVt_PV);
SvFLAGS(gv_list[10]) = 0x600d;
GvFLAGS(gv_list[10]) = 0x2;
GvLINE(gv_list[10]) = 0;
SvPVX(gv_list[10]) = emptystring;
SvREFCNT(gv_list[10]) += 2;
GvREFCNT(gv_list[10]) += 1;
GvSV(gv_list[10]) = &sv_list[8];
GvCV(gv_list[10]) = (CV*)((perl_get_cv("utf8::upgrade",TRUE)));
GvFILE(gv_list[10]) = "hello.p";
gv_list[11] = gv_fetchpv("utf8::is_utf8", TRUE, SVt_PV);
SvFLAGS(gv_list[11]) = 0x600d;
GvFLAGS(gv_list[11]) = 0x2;
GvLINE(gv_list[11]) = 0;
SvPVX(gv_list[11]) = emptystring;
SvREFCNT(gv_list[11]) += 2;
GvREFCNT(gv_list[11]) += 1;
GvSV(gv_list[11]) = &sv_list[9];
GvCV(gv_list[11]) = (CV*)((perl_get_cv("utf8::is_utf8",TRUE)));
GvFILE(gv_list[11]) = "hello.p";
gv_list[12] = gv_fetchpv("main::\"", TRUE, SVt_PV);
SvFLAGS(gv_list[12]) = 0x600d;
GvFLAGS(gv_list[12]) = 0xa;
GvLINE(gv_list[12]) = 0;
SvPVX(gv_list[12]) = emptystring;
SvREFCNT(gv_list[12]) += 10;
GvREFCNT(gv_list[12]) += 1;
gv_list[13] = gv_fetchpv("main::stdout", TRUE, SVt_PV);
SvFLAGS(gv_list[13]) = 0x600d;
GvFLAGS(gv_list[13]) = 0x2;
GvLINE(gv_list[13]) = 0;
SvPVX(gv_list[13]) = emptystring;
SvREFCNT(gv_list[13]) += 2;
GvREFCNT(gv_list[13]) += 1;
GvSV(gv_list[13]) = &sv_list[10];
GvFILE(gv_list[13]) = "hello.p";
IoIFP((IO*)&sv_list[11])=PerlIO_stdout();
IoOFP((IO*)&sv_list[11])=PerlIO_stdout();
SvSTASH((IO*)&sv_list[11]) = hv0;
GvIOp(gv_list[13]) = (IO*)&sv_list[11];
gv_list[14] = gv_fetchpv("main::\022", TRUE, SVt_PV);
SvFLAGS(gv_list[14]) = 0x600d;
GvFLAGS(gv_list[14]) = 0x2;
GvLINE(gv_list[14]) = 0;
SvPVX(gv_list[14]) = emptystring;
SvREFCNT(gv_list[14]) += 2;
GvREFCNT(gv_list[14]) += 1;
gv_list[15] = gv_fetchpv("main::|", TRUE, SVt_PV);
SvFLAGS(gv_list[15]) = 0x600d;
GvFLAGS(gv_list[15]) = 0xa;
GvLINE(gv_list[15]) = 466;
SvPVX(gv_list[15]) = emptystring;
SvREFCNT(gv_list[15]) += 5;
GvREFCNT(gv_list[15]) += 1;
gv_list[16] = gv_fetchpv("Regexp::DESTROY", TRUE, SVt_PV);
SvFLAGS(gv_list[16]) = 0x600d;
GvFLAGS(gv_list[16]) = 0x2;
GvLINE(gv_list[16]) = 0;
SvPVX(gv_list[16]) = emptystring;
SvREFCNT(gv_list[16]) += 2;
GvREFCNT(gv_list[16]) += 1;
GvSV(gv_list[16]) = &sv_list[12];
GvCV(gv_list[16]) = (CV*)((perl_get_cv("Regexp::DESTROY",TRUE)));
GvFILE(gv_list[16]) = "hello.p";
gv_list[17] = gv_fetchpv("main::\f", TRUE, SVt_PV);
SvFLAGS(gv_list[17]) = 0x600d;
GvFLAGS(gv_list[17]) = 0xa;
GvLINE(gv_list[17]) = 554;
SvPVX(gv_list[17]) = emptystring;
SvREFCNT(gv_list[17]) += 4;
GvREFCNT(gv_list[17]) += 1;
gv_list[18] = gv_fetchpv("main::^", TRUE, SVt_PV);
SvFLAGS(gv_list[18]) = 0x600d;
GvFLAGS(gv_list[18]) = 0xa;
GvLINE(gv_list[18]) = 538;
SvPVX(gv_list[18]) = emptystring;
SvREFCNT(gv_list[18]) += 4;
GvREFCNT(gv_list[18]) += 1;
gv_list[19] = gv_fetchpv("main::\001", TRUE, SVt_PV);
SvFLAGS(gv_list[19]) = 0x600d;
GvFLAGS(gv_list[19]) = 0xa;
GvLINE(gv_list[19]) = 562;
SvPVX(gv_list[19]) = emptystring;
SvREFCNT(gv_list[19]) += 5;
GvREFCNT(gv_list[19]) += 1;
gv_list[20] = gv_fetchpv("main::$", TRUE, SVt_PV);
SvFLAGS(gv_list[20]) = 0x600d;
GvFLAGS(gv_list[20]) = 0x2;
GvLINE(gv_list[20]) = 0;
SvPVX(gv_list[20]) = emptystring;
SvREFCNT(gv_list[20]) += 2;
GvREFCNT(gv_list[20]) += 1;
gv_list[21] = gv_fetchpv("main::\\", TRUE, SVt_PV);
SvFLAGS(gv_list[21]) = 0x600d;
GvFLAGS(gv_list[21]) = 0xa;
GvLINE(gv_list[21]) = 441;
SvPVX(gv_list[21]) = emptystring;
SvREFCNT(gv_list[21]) += 9;
GvREFCNT(gv_list[21]) += 1;
gv_list[22] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[22]) = 0x600d;
GvFLAGS(gv_list[22]) = 0x2;
GvLINE(gv_list[22]) = 4294967295;
SvPVX(gv_list[22]) = emptystring;
SvREFCNT(gv_list[22]) += 2;
GvREFCNT(gv_list[22]) += 1;
xpv_list[0].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm", 56);
GvSV(gv_list[22]) = &sv_list[13];
GvFILE(gv_list[22]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[23] = gv_fetchpv("main::~", TRUE, SVt_PV);
SvFLAGS(gv_list[23]) = 0x600d;
GvFLAGS(gv_list[23]) = 0xa;
GvLINE(gv_list[23]) = 530;
SvPVX(gv_list[23]) = emptystring;
SvREFCNT(gv_list[23]) += 4;
GvREFCNT(gv_list[23]) += 1;
gv_list[24] = gv_fetchpv("main::-", TRUE, SVt_PV);
SvFLAGS(gv_list[24]) = 0x600d;
GvFLAGS(gv_list[24]) = 0xa;
GvLINE(gv_list[24]) = 0;
SvPVX(gv_list[24]) = emptystring;
SvREFCNT(gv_list[24]) += 4;
GvREFCNT(gv_list[24]) += 1;
gv_list[25] = gv_fetchpv("main::_<perlmain.c", TRUE, SVt_PV);
SvFLAGS(gv_list[25]) = 0x600d;
GvFLAGS(gv_list[25]) = 0x2;
GvLINE(gv_list[25]) = 0;
SvPVX(gv_list[25]) = emptystring;
SvREFCNT(gv_list[25]) += 2;
GvREFCNT(gv_list[25]) += 1;
xpv_list[1].xpv_pv = savepvn("perlmain.c", 10);
GvSV(gv_list[25]) = &sv_list[14];
GvFILE(gv_list[25]) = "hello.p";
gv_list[26] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/File/Spec/Unix.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[26]) = 0x600d;
GvFLAGS(gv_list[26]) = 0x2;
GvLINE(gv_list[26]) = 98;
SvPVX(gv_list[26]) = emptystring;
SvREFCNT(gv_list[26]) += 2;
GvREFCNT(gv_list[26]) += 1;
xpv_list[2].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/File/Spec/Unix.pm", 38);
GvSV(gv_list[26]) = &sv_list[15];
GvFILE(gv_list[26]) = "x/\031\b q\024\b\332T\305";
gv_list[27] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/C/C.so", TRUE, SVt_PV);
SvFLAGS(gv_list[27]) = 0x600d;
GvFLAGS(gv_list[27]) = 0x2;
GvLINE(gv_list[27]) = 87;
SvPVX(gv_list[27]) = emptystring;
SvREFCNT(gv_list[27]) += 2;
GvREFCNT(gv_list[27]) += 1;
xpv_list[3].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/C/C.so", 58);
GvSV(gv_list[27]) = &sv_list[16];
GvFILE(gv_list[27]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[28] = gv_fetchpv("main::_<universal.c", TRUE, SVt_PV);
SvFLAGS(gv_list[28]) = 0x600d;
GvFLAGS(gv_list[28]) = 0x2;
GvLINE(gv_list[28]) = 0;
SvPVX(gv_list[28]) = emptystring;
SvREFCNT(gv_list[28]) += 2;
GvREFCNT(gv_list[28]) += 1;
xpv_list[4].xpv_pv = savepvn("universal.c", 11);
GvSV(gv_list[28]) = &sv_list[17];
GvFILE(gv_list[28]) = "hello.p";
gv_list[29] = gv_fetchpv("main::BEGIN", TRUE, SVt_PV);
SvFLAGS(gv_list[29]) = 0x600d;
GvFLAGS(gv_list[29]) = 0x2;
GvLINE(gv_list[29]) = 0;
SvPVX(gv_list[29]) = emptystring;
SvREFCNT(gv_list[29]) += 2;
GvREFCNT(gv_list[29]) += 1;
GvSV(gv_list[29]) = &sv_list[18];
GvFILE(gv_list[29]) = "hello.p";
gv_list[30] = gv_fetchpv("main::_<xsutils.c", TRUE, SVt_PV);
SvFLAGS(gv_list[30]) = 0x600d;
GvFLAGS(gv_list[30]) = 0x2;
GvLINE(gv_list[30]) = 0;
SvPVX(gv_list[30]) = emptystring;
SvREFCNT(gv_list[30]) += 2;
GvREFCNT(gv_list[30]) += 1;
xpv_list[5].xpv_pv = savepvn("xsutils.c", 9);
GvSV(gv_list[30]) = &sv_list[19];
GvFILE(gv_list[30]) = "hello.p";
gv_list[31] = gv_fetchpv("main::!", TRUE, SVt_PV);
SvFLAGS(gv_list[31]) = 0x600d;
GvFLAGS(gv_list[31]) = 0xa;
GvLINE(gv_list[31]) = 2054;
SvPVX(gv_list[31]) = emptystring;
SvREFCNT(gv_list[31]) += 3;
GvREFCNT(gv_list[31]) += 1;
GvFILE(gv_list[31]) = "";
gv_list[32] = gv_fetchpv("main::\024AINT", TRUE, SVt_PV);
SvFLAGS(gv_list[32]) = 0x600d;
GvFLAGS(gv_list[32]) = 0xa;
GvLINE(gv_list[32]) = 1589;
SvPVX(gv_list[32]) = emptystring;
SvREFCNT(gv_list[32]) += 3;
GvREFCNT(gv_list[32]) += 1;
sv_magic((SV*)&sv_list[20], (SV*)gv_list[32], '\000', "\024AINT", 5);
GvSV(gv_list[32]) = &sv_list[20];
GvFILE(gv_list[32]) = "";
gv_list[33] = gv_fetchpv("main::\017", TRUE, SVt_PV);
SvFLAGS(gv_list[33]) = 0x600d;
GvFLAGS(gv_list[33]) = 0xa;
GvLINE(gv_list[33]) = 55;
SvPVX(gv_list[33]) = emptystring;
SvREFCNT(gv_list[33]) += 4;
GvREFCNT(gv_list[33]) += 1;
gv_list[34] = gv_fetchpv("main::%", TRUE, SVt_PV);
SvFLAGS(gv_list[34]) = 0x600d;
GvFLAGS(gv_list[34]) = 0xa;
GvLINE(gv_list[34]) = 506;
SvPVX(gv_list[34]) = emptystring;
SvREFCNT(gv_list[34]) += 4;
GvREFCNT(gv_list[34]) += 1;
gv_list[35] = gv_fetchpv("main::\030", TRUE, SVt_PV);
SvFLAGS(gv_list[35]) = 0x600d;
GvFLAGS(gv_list[35]) = 0x2;
GvLINE(gv_list[35]) = 0;
SvPVX(gv_list[35]) = emptystring;
SvREFCNT(gv_list[35]) += 2;
GvREFCNT(gv_list[35]) += 1;
gv_list[36] = gv_fetchpv("main::_", TRUE, SVt_PV);
SvFLAGS(gv_list[36]) = 0x630d;
GvFLAGS(gv_list[36]) = 0xa;
GvLINE(gv_list[36]) = 0;
SvPVX(gv_list[36]) = emptystring;
SvREFCNT(gv_list[36]) += 470;
GvREFCNT(gv_list[36]) += 1;
gv_list[37] = gv_fetchpv("main::+", TRUE, SVt_PV);
SvFLAGS(gv_list[37]) = 0x600d;
GvFLAGS(gv_list[37]) = 0x2;
GvLINE(gv_list[37]) = 0;
SvPVX(gv_list[37]) = emptystring;
SvREFCNT(gv_list[37]) += 2;
GvREFCNT(gv_list[37]) += 1;
gv_list[38] = gv_fetchpv("Internals::SvREFCNT", TRUE, SVt_PV);
SvFLAGS(gv_list[38]) = 0x600d;
GvFLAGS(gv_list[38]) = 0x2;
GvLINE(gv_list[38]) = 0;
SvPVX(gv_list[38]) = emptystring;
SvREFCNT(gv_list[38]) += 2;
GvREFCNT(gv_list[38]) += 1;
GvSV(gv_list[38]) = &sv_list[21];
GvCV(gv_list[38]) = (CV*)((perl_get_cv("Internals::SvREFCNT",TRUE)));
GvFILE(gv_list[38]) = "hello.p";
gv_list[39] = gv_fetchpv("Internals::hv_clear_placeholders", TRUE, SVt_PV);
SvFLAGS(gv_list[39]) = 0x600d;
GvFLAGS(gv_list[39]) = 0x2;
GvLINE(gv_list[39]) = 0;
SvPVX(gv_list[39]) = emptystring;
SvREFCNT(gv_list[39]) += 2;
GvREFCNT(gv_list[39]) += 1;
GvSV(gv_list[39]) = &sv_list[22];
GvCV(gv_list[39]) = (CV*)((perl_get_cv("Internals::hv_clear_placeholders",TRUE)));
GvFILE(gv_list[39]) = "hello.p";
gv_list[40] = gv_fetchpv("Internals::hash_seed", TRUE, SVt_PV);
SvFLAGS(gv_list[40]) = 0x600d;
GvFLAGS(gv_list[40]) = 0x2;
GvLINE(gv_list[40]) = 0;
SvPVX(gv_list[40]) = emptystring;
SvREFCNT(gv_list[40]) += 2;
GvREFCNT(gv_list[40]) += 1;
GvSV(gv_list[40]) = &sv_list[23];
GvCV(gv_list[40]) = (CV*)((perl_get_cv("Internals::hash_seed",TRUE)));
GvFILE(gv_list[40]) = "hello.p";
gv_list[41] = gv_fetchpv("Internals::SvREADONLY", TRUE, SVt_PV);
SvFLAGS(gv_list[41]) = 0x600d;
GvFLAGS(gv_list[41]) = 0x2;
GvLINE(gv_list[41]) = 0;
SvPVX(gv_list[41]) = emptystring;
SvREFCNT(gv_list[41]) += 2;
GvREFCNT(gv_list[41]) += 1;
GvSV(gv_list[41]) = &sv_list[24];
GvCV(gv_list[41]) = (CV*)((perl_get_cv("Internals::SvREADONLY",TRUE)));
GvFILE(gv_list[41]) = "hello.p";
gv_list[42] = gv_fetchpv("Internals::HvREHASH", TRUE, SVt_PV);
SvFLAGS(gv_list[42]) = 0x600d;
GvFLAGS(gv_list[42]) = 0x2;
GvLINE(gv_list[42]) = 0;
SvPVX(gv_list[42]) = emptystring;
SvREFCNT(gv_list[42]) += 2;
GvREFCNT(gv_list[42]) += 1;
GvSV(gv_list[42]) = &sv_list[25];
GvCV(gv_list[42]) = (CV*)((perl_get_cv("Internals::HvREHASH",TRUE)));
GvFILE(gv_list[42]) = "hello.p";
gv_list[43] = gv_fetchpv("Internals::rehash_seed", TRUE, SVt_PV);
SvFLAGS(gv_list[43]) = 0x600d;
GvFLAGS(gv_list[43]) = 0x2;
GvLINE(gv_list[43]) = 0;
SvPVX(gv_list[43]) = emptystring;
SvREFCNT(gv_list[43]) += 2;
GvREFCNT(gv_list[43]) += 1;
GvSV(gv_list[43]) = &sv_list[26];
GvCV(gv_list[43]) = (CV*)((perl_get_cv("Internals::rehash_seed",TRUE)));
GvFILE(gv_list[43]) = "hello.p";
gv_list[44] = gv_fetchpv("main::STDIN", TRUE, SVt_PV);
SvFLAGS(gv_list[44]) = 0x600d;
GvFLAGS(gv_list[44]) = 0xa;
GvLINE(gv_list[44]) = 0;
SvPVX(gv_list[44]) = emptystring;
SvREFCNT(gv_list[44]) += 2;
GvREFCNT(gv_list[44]) += 1;
gv_list[45] = gv_fetchpv("DB::args", TRUE, SVt_PV);
SvFLAGS(gv_list[45]) = 0x600d;
GvFLAGS(gv_list[45]) = 0xa;
GvLINE(gv_list[45]) = 431;
SvPVX(gv_list[45]) = emptystring;
SvREFCNT(gv_list[45]) += 4;
GvREFCNT(gv_list[45]) += 1;
GvSV(gv_list[45]) = &sv_list[27];
GvAV(gv_list[45]) = (AV*)&sv_list[28];
GvFILE(gv_list[45]) = "\260\r\016\b";
gv_list[46] = gv_fetchpv("main::\026", TRUE, SVt_PV);
SvFLAGS(gv_list[46]) = 0x600d;
GvFLAGS(gv_list[46]) = 0xa;
GvLINE(gv_list[46]) = 30;
SvPVX(gv_list[46]) = emptystring;
SvREFCNT(gv_list[46]) += 2;
GvREFCNT(gv_list[46]) += 1;
gv_list[47] = gv_fetchpv("main::=", TRUE, SVt_PV);
SvFLAGS(gv_list[47]) = 0x600d;
GvFLAGS(gv_list[47]) = 0xa;
GvLINE(gv_list[47]) = 514;
SvPVX(gv_list[47]) = emptystring;
SvREFCNT(gv_list[47]) += 4;
GvREFCNT(gv_list[47]) += 1;
gv_list[48] = gv_fetchpv("main::2", TRUE, SVt_PV);
SvFLAGS(gv_list[48]) = 0x600d;
GvFLAGS(gv_list[48]) = 0xa;
GvLINE(gv_list[48]) = 257;
SvPVX(gv_list[48]) = emptystring;
SvREFCNT(gv_list[48]) += 6;
GvREFCNT(gv_list[48]) += 1;
gv_list[49] = gv_fetchpv("main::_<Fcntl.c", TRUE, SVt_PV);
SvFLAGS(gv_list[49]) = 0x600d;
GvFLAGS(gv_list[49]) = 0x2;
GvLINE(gv_list[49]) = 92;
SvPVX(gv_list[49]) = emptystring;
SvREFCNT(gv_list[49]) += 2;
GvREFCNT(gv_list[49]) += 1;
xpv_list[6].xpv_pv = savepvn("Fcntl.c", 7);
GvSV(gv_list[49]) = &sv_list[29];
GvFILE(gv_list[49]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[50] = gv_fetchpv("main::1", TRUE, SVt_PV);
SvFLAGS(gv_list[50]) = 0x600d;
GvFLAGS(gv_list[50]) = 0xa;
GvLINE(gv_list[50]) = 74;
SvPVX(gv_list[50]) = emptystring;
SvREFCNT(gv_list[50]) += 28;
GvREFCNT(gv_list[50]) += 1;
gv_list[51] = gv_fetchpv("main::_<IO.c", TRUE, SVt_PV);
SvFLAGS(gv_list[51]) = 0x600d;
GvFLAGS(gv_list[51]) = 0x2;
GvLINE(gv_list[51]) = 92;
SvPVX(gv_list[51]) = emptystring;
SvREFCNT(gv_list[51]) += 2;
GvREFCNT(gv_list[51]) += 1;
xpv_list[7].xpv_pv = savepvn("IO.c", 4);
GvSV(gv_list[51]) = &sv_list[30];
GvFILE(gv_list[51]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[52] = gv_fetchpv("main::\027ARNING_BITS", TRUE, SVt_PV);
SvFLAGS(gv_list[52]) = 0x600d;
GvFLAGS(gv_list[52]) = 0xa;
GvLINE(gv_list[52]) = 341;
SvPVX(gv_list[52]) = emptystring;
SvREFCNT(gv_list[52]) += 6;
GvREFCNT(gv_list[52]) += 1;
sv_magic((SV*)&sv_list[31], (SV*)gv_list[52], '\000', "\027ARNING_BITS", 12);
GvSV(gv_list[52]) = &sv_list[31];
GvFILE(gv_list[52]) = "\260\r\016\b";
gv_list[53] = gv_fetchpv("main::_<B.c", TRUE, SVt_PV);
SvFLAGS(gv_list[53]) = 0x600d;
GvFLAGS(gv_list[53]) = 0x2;
GvLINE(gv_list[53]) = 92;
SvPVX(gv_list[53]) = emptystring;
SvREFCNT(gv_list[53]) += 2;
GvREFCNT(gv_list[53]) += 1;
xpv_list[8].xpv_pv = savepvn("B.c", 3);
GvSV(gv_list[53]) = &sv_list[32];
GvFILE(gv_list[53]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[54] = gv_fetchpv("main::_<DynaLoader.c", TRUE, SVt_PV);
SvFLAGS(gv_list[54]) = 0x600d;
GvFLAGS(gv_list[54]) = 0x2;
GvLINE(gv_list[54]) = 16;
SvPVX(gv_list[54]) = emptystring;
SvREFCNT(gv_list[54]) += 2;
GvREFCNT(gv_list[54]) += 1;
xpv_list[9].xpv_pv = savepvn("DynaLoader.c", 12);
GvSV(gv_list[54]) = &sv_list[33];
GvFILE(gv_list[54]) = "\335\367\302";
gv_list[55] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/IO/IO.so", TRUE, SVt_PV);
SvFLAGS(gv_list[55]) = 0x600d;
GvFLAGS(gv_list[55]) = 0x2;
GvLINE(gv_list[55]) = 87;
SvPVX(gv_list[55]) = emptystring;
SvREFCNT(gv_list[55]) += 2;
GvREFCNT(gv_list[55]) += 1;
xpv_list[10].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/IO/IO.so", 58);
GvSV(gv_list[55]) = &sv_list[34];
GvFILE(gv_list[55]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[56] = gv_fetchpv("attributes::bootstrap", TRUE, SVt_PV);
SvFLAGS(gv_list[56]) = 0x600d;
GvFLAGS(gv_list[56]) = 0x2;
GvLINE(gv_list[56]) = 0;
SvPVX(gv_list[56]) = emptystring;
SvREFCNT(gv_list[56]) += 2;
GvREFCNT(gv_list[56]) += 1;
GvSV(gv_list[56]) = &sv_list[35];
GvFILE(gv_list[56]) = "hello.p";
gv_list[57] = gv_fetchpv("main::stdin", TRUE, SVt_PV);
SvFLAGS(gv_list[57]) = 0x600d;
GvFLAGS(gv_list[57]) = 0x2;
GvLINE(gv_list[57]) = 0;
SvPVX(gv_list[57]) = emptystring;
SvREFCNT(gv_list[57]) += 2;
GvREFCNT(gv_list[57]) += 1;
GvSV(gv_list[57]) = &sv_list[36];
GvFILE(gv_list[57]) = "hello.p";
IoIFP((IO*)&sv_list[37])=PerlIO_stdin();
IoOFP((IO*)&sv_list[37])=PerlIO_stdin();
SvSTASH((IO*)&sv_list[37]) = hv0;
GvIOp(gv_list[57]) = (IO*)&sv_list[37];
gv_list[58] = gv_fetchpv("main::ARGV", TRUE, SVt_PV);
SvFLAGS(gv_list[58]) = 0x600d;
GvFLAGS(gv_list[58]) = 0x2;
GvLINE(gv_list[58]) = 0;
SvPVX(gv_list[58]) = emptystring;
SvREFCNT(gv_list[58]) += 2;
GvREFCNT(gv_list[58]) += 1;
gv_list[59] = gv_fetchpv("main::INC", TRUE, SVt_PV);
SvFLAGS(gv_list[59]) = 0x600d;
GvFLAGS(gv_list[59]) = 0xa;
GvLINE(gv_list[59]) = 0;
SvPVX(gv_list[59]) = emptystring;
SvREFCNT(gv_list[59]) += 7;
GvREFCNT(gv_list[59]) += 1;
GvSV(gv_list[59]) = &sv_list[38];
xpv_list[11].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi", 44);
xpv_list[12].xpv_pv = savepvn("/usr/lib/perl5/5.8.5", 20);
xpv_list[13].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi", 54);
xpv_list[14].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4/i386-linux-thread-multi", 54);
xpv_list[15].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi", 54);
xpv_list[16].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2/i386-linux-thread-multi", 54);
xpv_list[17].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi", 54);
xpv_list[18].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi", 54);
xpv_list[19].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5", 30);
xpv_list[20].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4", 30);
xpv_list[21].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3", 30);
xpv_list[22].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2", 30);
xpv_list[23].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1", 30);
xpv_list[24].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0", 30);
xpv_list[25].xpv_pv = savepvn("/usr/lib/perl5/site_perl", 24);
xpv_list[26].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi", 56);
xpv_list[27].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4/i386-linux-thread-multi", 56);
xpv_list[28].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3/i386-linux-thread-multi", 56);
xpv_list[29].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2/i386-linux-thread-multi", 56);
xpv_list[30].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi", 56);
xpv_list[31].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi", 56);
xpv_list[32].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5", 32);
xpv_list[33].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4", 32);
xpv_list[34].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3", 32);
xpv_list[35].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2", 32);
xpv_list[36].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1", 32);
xpv_list[37].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0", 32);
xpv_list[38].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl", 26);
xpv_list[39].xpv_pv = savepvn(".", 1);
xpv_list[40].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi", 44);
xpv_list[41].xpv_pv = savepvn("/usr/lib/perl5/5.8.5", 20);
xpv_list[42].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi", 54);
xpv_list[43].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4/i386-linux-thread-multi", 54);
xpv_list[44].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3/i386-linux-thread-multi", 54);
xpv_list[45].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2/i386-linux-thread-multi", 54);
xpv_list[46].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1/i386-linux-thread-multi", 54);
xpv_list[47].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi", 54);
xpv_list[48].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.5", 30);
xpv_list[49].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.4", 30);
xpv_list[50].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.3", 30);
xpv_list[51].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.2", 30);
xpv_list[52].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.1", 30);
xpv_list[53].xpv_pv = savepvn("/usr/lib/perl5/site_perl/5.8.0", 30);
xpv_list[54].xpv_pv = savepvn("/usr/lib/perl5/site_perl", 24);
xpv_list[55].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi", 56);
xpv_list[56].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4/i386-linux-thread-multi", 56);
xpv_list[57].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3/i386-linux-thread-multi", 56);
xpv_list[58].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2/i386-linux-thread-multi", 56);
xpv_list[59].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1/i386-linux-thread-multi", 56);
xpv_list[60].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi", 56);
xpv_list[61].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.5", 32);
xpv_list[62].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.4", 32);
xpv_list[63].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.3", 32);
xpv_list[64].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.2", 32);
xpv_list[65].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.1", 32);
xpv_list[66].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl/5.8.0", 32);
xpv_list[67].xpv_pv = savepvn("/usr/lib/perl5/vendor_perl", 26);
xpv_list[68].xpv_pv = savepvn(".", 1);
{
SV **svp;
AV *av = (AV*)&sv_list[39];
av_extend(av, 57);
svp = AvARRAY(av);
*svp++ = (SV*)&sv_list[40];
*svp++ = (SV*)&sv_list[41];
*svp++ = (SV*)&sv_list[42];
*svp++ = (SV*)&sv_list[43];
*svp++ = (SV*)&sv_list[44];
*svp++ = (SV*)&sv_list[45];
*svp++ = (SV*)&sv_list[46];
*svp++ = (SV*)&sv_list[47];
*svp++ = (SV*)&sv_list[48];
*svp++ = (SV*)&sv_list[49];
*svp++ = (SV*)&sv_list[50];
*svp++ = (SV*)&sv_list[51];
*svp++ = (SV*)&sv_list[52];
*svp++ = (SV*)&sv_list[53];
*svp++ = (SV*)&sv_list[54];
*svp++ = (SV*)&sv_list[55];
*svp++ = (SV*)&sv_list[56];
*svp++ = (SV*)&sv_list[57];
*svp++ = (SV*)&sv_list[58];
*svp++ = (SV*)&sv_list[59];
*svp++ = (SV*)&sv_list[60];
*svp++ = (SV*)&sv_list[61];
*svp++ = (SV*)&sv_list[62];
*svp++ = (SV*)&sv_list[63];
*svp++ = (SV*)&sv_list[64];
*svp++ = (SV*)&sv_list[65];
*svp++ = (SV*)&sv_list[66];
*svp++ = (SV*)&sv_list[67];
*svp++ = (SV*)&sv_list[68];
*svp++ = (SV*)&sv_list[69];
*svp++ = (SV*)&sv_list[70];
*svp++ = (SV*)&sv_list[71];
*svp++ = (SV*)&sv_list[72];
*svp++ = (SV*)&sv_list[73];
*svp++ = (SV*)&sv_list[74];
*svp++ = (SV*)&sv_list[75];
*svp++ = (SV*)&sv_list[76];
*svp++ = (SV*)&sv_list[77];
*svp++ = (SV*)&sv_list[78];
*svp++ = (SV*)&sv_list[79];
*svp++ = (SV*)&sv_list[80];
*svp++ = (SV*)&sv_list[81];
*svp++ = (SV*)&sv_list[82];
*svp++ = (SV*)&sv_list[83];
*svp++ = (SV*)&sv_list[84];
*svp++ = (SV*)&sv_list[85];
*svp++ = (SV*)&sv_list[86];
*svp++ = (SV*)&sv_list[87];
*svp++ = (SV*)&sv_list[88];
*svp++ = (SV*)&sv_list[89];
*svp++ = (SV*)&sv_list[90];
*svp++ = (SV*)&sv_list[91];
*svp++ = (SV*)&sv_list[92];
*svp++ = (SV*)&sv_list[93];
*svp++ = (SV*)&sv_list[94];
*svp++ = (SV*)&sv_list[95];
*svp++ = (SV*)&sv_list[96];
*svp++ = (SV*)&sv_list[97];
AvFILLp(av) = 57;
}
GvAV(gv_list[59]) = (AV*)&sv_list[39];
GvHV(gv_list[59]) = (HV*)&sv_list[98];
GvFILE(gv_list[59]) = "";
gv_list[60] = gv_fetchpv("main::ENV", TRUE, SVt_PV);
SvFLAGS(gv_list[60]) = 0x600d;
GvFLAGS(gv_list[60]) = 0xa;
GvLINE(gv_list[60]) = 0;
SvPVX(gv_list[60]) = emptystring;
SvREFCNT(gv_list[60]) += 5;
GvREFCNT(gv_list[60]) += 1;
gv_list[61] = gv_fetchpv("main::_<perlio.c", TRUE, SVt_PV);
SvFLAGS(gv_list[61]) = 0x600d;
GvFLAGS(gv_list[61]) = 0x2;
GvLINE(gv_list[61]) = 0;
SvPVX(gv_list[61]) = emptystring;
SvREFCNT(gv_list[61]) += 2;
GvREFCNT(gv_list[61]) += 1;
xpv_list[69].xpv_pv = savepvn("perlio.c", 8);
GvSV(gv_list[61]) = &sv_list[99];
GvFILE(gv_list[61]) = "hello.p";
gv_list[62] = gv_fetchpv("main:::", TRUE, SVt_PV);
SvFLAGS(gv_list[62]) = 0x600d;
GvFLAGS(gv_list[62]) = 0xa;
GvLINE(gv_list[62]) = 546;
SvPVX(gv_list[62]) = emptystring;
SvREFCNT(gv_list[62]) += 4;
GvREFCNT(gv_list[62]) += 1;
gv_list[63] = gv_fetchpv("PerlIO::get_layers", TRUE, SVt_PV);
SvFLAGS(gv_list[63]) = 0x600d;
GvFLAGS(gv_list[63]) = 0x2;
GvLINE(gv_list[63]) = 0;
SvPVX(gv_list[63]) = emptystring;
SvREFCNT(gv_list[63]) += 2;
GvREFCNT(gv_list[63]) += 1;
GvSV(gv_list[63]) = &sv_list[100];
GvCV(gv_list[63]) = (CV*)((perl_get_cv("PerlIO::get_layers",TRUE)));
GvFILE(gv_list[63]) = "hello.p";
gv_list[64] = gv_fetchpv("PerlIO::Layer::NoWarnings", TRUE, SVt_PV);
SvFLAGS(gv_list[64]) = 0x600d;
GvFLAGS(gv_list[64]) = 0x2;
GvLINE(gv_list[64]) = 0;
SvPVX(gv_list[64]) = emptystring;
SvREFCNT(gv_list[64]) += 2;
GvREFCNT(gv_list[64]) += 1;
GvSV(gv_list[64]) = &sv_list[101];
GvCV(gv_list[64]) = (CV*)((perl_get_cv("PerlIO::Layer::NoWarnings",TRUE)));
GvFILE(gv_list[64]) = "hello.p";
gv_list[65] = gv_fetchpv("PerlIO::Layer::find", TRUE, SVt_PV);
SvFLAGS(gv_list[65]) = 0x600d;
GvFLAGS(gv_list[65]) = 0x2;
GvLINE(gv_list[65]) = 0;
SvPVX(gv_list[65]) = emptystring;
SvREFCNT(gv_list[65]) += 2;
GvREFCNT(gv_list[65]) += 1;
GvSV(gv_list[65]) = &sv_list[102];
GvCV(gv_list[65]) = (CV*)((perl_get_cv("PerlIO::Layer::find",TRUE)));
GvFILE(gv_list[65]) = "hello.p";
gv_list[66] = gv_fetchpv("main::0", TRUE, SVt_PV);
SvFLAGS(gv_list[66]) = 0x600d;
GvFLAGS(gv_list[66]) = 0xa;
GvLINE(gv_list[66]) = 0;
SvPVX(gv_list[66]) = emptystring;
SvREFCNT(gv_list[66]) += 5;
GvREFCNT(gv_list[66]) += 1;
gv_list[67] = gv_fetchpv("main::.", TRUE, SVt_PV);
SvFLAGS(gv_list[67]) = 0x600d;
GvFLAGS(gv_list[67]) = 0xa;
GvLINE(gv_list[67]) = 496;
SvPVX(gv_list[67]) = emptystring;
SvREFCNT(gv_list[67]) += 5;
GvREFCNT(gv_list[67]) += 1;
gv_list[68] = gv_fetchpv("main::\b", TRUE, SVt_PV);
SvFLAGS(gv_list[68]) = 0x600d;
GvFLAGS(gv_list[68]) = 0xa;
GvLINE(gv_list[68]) = 0;
SvPVX(gv_list[68]) = emptystring;
SvREFCNT(gv_list[68]) += 5;
GvREFCNT(gv_list[68]) += 1;
gv_list[69] = gv_fetchpv("main::@", TRUE, SVt_PV);
SvFLAGS(gv_list[69]) = 0x600d;
GvFLAGS(gv_list[69]) = 0xa;
GvLINE(gv_list[69]) = 0;
SvPVX(gv_list[69]) = emptystring;
SvREFCNT(gv_list[69]) += 13;
GvREFCNT(gv_list[69]) += 1;
gv_list[70] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/base.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[70]) = 0x600d;
GvFLAGS(gv_list[70]) = 0x2;
GvLINE(gv_list[70]) = 8;
SvPVX(gv_list[70]) = emptystring;
SvREFCNT(gv_list[70]) += 2;
GvREFCNT(gv_list[70]) += 1;
xpv_list[70].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/base.pm", 28);
GvSV(gv_list[70]) = &sv_list[103];
GvFILE(gv_list[70]) = "\270/\r\b";
gv_list[71] = gv_fetchpv("main::STDOUT", TRUE, SVt_PV);
SvFLAGS(gv_list[71]) = 0x630d;
GvFLAGS(gv_list[71]) = 0xa;
GvLINE(gv_list[71]) = 0;
SvPVX(gv_list[71]) = emptystring;
SvREFCNT(gv_list[71]) += 13;
GvREFCNT(gv_list[71]) += 1;
gv_list[72] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/B/C.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[72]) = 0x600d;
GvFLAGS(gv_list[72]) = 0x2;
GvLINE(gv_list[72]) = 1096;
SvPVX(gv_list[72]) = emptystring;
SvREFCNT(gv_list[72]) += 2;
GvREFCNT(gv_list[72]) += 1;
xpv_list[71].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/B/C.pm", 51);
GvSV(gv_list[72]) = &sv_list[104];
GvFILE(gv_list[72]) = "";
gv_list[73] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/B.pm", TRUE, SVt_PV);
SvFLAGS(gv_list[73]) = 0x600d;
GvFLAGS(gv_list[73]) = 0x2;
GvLINE(gv_list[73]) = 87;
SvPVX(gv_list[73]) = emptystring;
SvREFCNT(gv_list[73]) += 2;
GvREFCNT(gv_list[73]) += 1;
xpv_list[72].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/B.pm", 49);
GvSV(gv_list[73]) = &sv_list[105];
GvFILE(gv_list[73]) = "\210\327\a\b\b";
gv_list[74] = gv_fetchpv("main::]", TRUE, SVt_PV);
SvFLAGS(gv_list[74]) = 0x600d;
GvFLAGS(gv_list[74]) = 0xa;
GvLINE(gv_list[74]) = 41;
SvPVX(gv_list[74]) = emptystring;
SvREFCNT(gv_list[74]) += 2;
GvREFCNT(gv_list[74]) += 1;
gv_list[75] = gv_fetchpv("main::\027", TRUE, SVt_PV);
SvFLAGS(gv_list[75]) = 0x600d;
GvFLAGS(gv_list[75]) = 0xa;
GvLINE(gv_list[75]) = 227;
SvPVX(gv_list[75]) = emptystring;
SvREFCNT(gv_list[75]) += 4;
GvREFCNT(gv_list[75]) += 1;
gv_list[76] = gv_fetchpv("main::STDERR", TRUE, SVt_PV);
SvFLAGS(gv_list[76]) = 0x630d;
GvFLAGS(gv_list[76]) = 0xa;
GvLINE(gv_list[76]) = 0;
SvPVX(gv_list[76]) = emptystring;
SvREFCNT(gv_list[76]) += 4;
GvREFCNT(gv_list[76]) += 1;
gv_list[77] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/B.so", TRUE, SVt_PV);
SvFLAGS(gv_list[77]) = 0x600d;
GvFLAGS(gv_list[77]) = 0x2;
GvLINE(gv_list[77]) = 87;
SvPVX(gv_list[77]) = emptystring;
SvREFCNT(gv_list[77]) += 2;
GvREFCNT(gv_list[77]) += 1;
xpv_list[73].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/B/B.so", 56);
GvSV(gv_list[77]) = &sv_list[106];
GvFILE(gv_list[77]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
gv_list[78] = gv_fetchpv("main::_</usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/Fcntl/Fcntl.so", TRUE, SVt_PV);
SvFLAGS(gv_list[78]) = 0x600d;
GvFLAGS(gv_list[78]) = 0x2;
GvLINE(gv_list[78]) = 87;
SvPVX(gv_list[78]) = emptystring;
SvREFCNT(gv_list[78]) += 2;
GvREFCNT(gv_list[78]) += 1;
xpv_list[74].xpv_pv = savepvn("/usr/lib/perl5/5.8.5/i386-linux-thread-multi/auto/Fcntl/Fcntl.so", 64);
GvSV(gv_list[78]) = &sv_list[107];
GvFILE(gv_list[78]) = "/usr/lib/perl5/5.8.5/i386-linux-thread-multi/XSLoader.pm";
PL_dowarn = ( 0 ) ? G_WARN_ON : G_WARN_OFF;
PL_main_root = (OP*)&listop_list[0];
PL_main_start = &op_list[0];
PL_initav = (AV *) Nullsv;
PL_endav = (AV*) Nullsv;
xpv_list[75].xpv_pv = savepvn("Hello World\n", 12);
{
SV **svp;
AV *av = (AV*)&sv_list[109];
av_extend(av, 2);
svp = AvARRAY(av);
*svp++ = (SV*)&PL_sv_undef;
*svp++ = (SV*)&sv_list[110];
*svp++ = (SV*)&sv_list[111];
AvFILLp(av) = 2;
}
PL_curpad = AvARRAY((AV*)&sv_list[109]);
GvHV(PL_incgv) = (HV*)&sv_list[98];
GvAV(PL_incgv) = (AV*)&sv_list[39];
av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc((AV*)&sv_list[108]));
av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc((AV*)&sv_list[109]));
PL_amagic_generation= 0;
return 0;
}
/*
=for apidoc mro_get_linear_isa_dfs
Returns the Depth-First Search linearization of C<@ISA>
the given stash. The return value is a read-only AV*.
C<level> should be 0 (it is used internally in this
function's recursion).
You are responsible for C<SvREFCNT_inc()> on the
return value if you plan to store it anywhere
semi-permanently (otherwise it might be deleted
out from under you the next time the cache is
invalidated).
=cut
*/
static AV*
S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
{
AV* retval;
GV** gvp;
GV* gv;
AV* av;
const HEK* stashhek;
struct mro_meta* meta;
SV *our_name;
HV *stored = NULL;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS;
assert(HvAUX(stash));
stashhek
= HvAUX(stash)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(stash)
? HvENAME_HEK_NN(stash)
: HvNAME_HEK(stash);
if (!stashhek)
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
Perl_croak(aTHX_
"Recursive inheritance detected in package '%"HEKf"'",
HEKfARG(stashhek));
meta = HvMROMETA(stash);
/* return cache if valid */
if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &dfs_alg)))) {
return retval;
}
/* not in cache, make a new one */
retval = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
/* We use this later in this function, but don't need a reference to it
beyond the end of this function, so reference count is fine. */
our_name = newSVhek(stashhek);
av_push(retval, our_name); /* add ourselves at the top */
/* fetch our @ISA */
gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
/* "stored" is used to keep track of all of the classnames we have added to
the MRO so far, so we can do a quick exists check and avoid adding
duplicate classnames to the MRO as we go.
It's then retained to be re-used as a fast lookup for ->isa(), by adding
our own name and "UNIVERSAL" to it. */
if(av && AvFILLp(av) >= 0) {
SV **svp = AvARRAY(av);
I32 items = AvFILLp(av) + 1;
/* foreach(@ISA) */
while (items--) {
SV* const sv = *svp ? *svp : &PL_sv_undef;
HV* const basestash = gv_stashsv(sv, 0);
SV *const *subrv_p;
I32 subrv_items;
svp++;
if (!basestash) {
/* if no stash exists for this @ISA member,
simply add it to the MRO and move on */
subrv_p = &sv;
subrv_items = 1;
}
else {
/* otherwise, recurse into ourselves for the MRO
of this @ISA member, and append their MRO to ours.
The recursive call could throw an exception, which
has memory management implications here, hence the use of
the mortal. */
const AV *const subrv
= mro_get_linear_isa_dfs(basestash, level + 1);
subrv_p = AvARRAY(subrv);
subrv_items = AvFILLp(subrv) + 1;
}
if (stored) {
while(subrv_items--) {
SV *const subsv = *subrv_p++;
/* LVALUE fetch will create a new undefined SV if necessary
*/
HE *const he = hv_fetch_ent(stored, subsv, 1, 0);
assert(he);
if(HeVAL(he) != &PL_sv_undef) {
/* It was newly created. Steal it for our new SV, and
replace it in the hash with the "real" thing. */
SV *const val = HeVAL(he);
HEK *const key = HeKEY_hek(he);
HeVAL(he) = &PL_sv_undef;
sv_sethek(val, key);
av_push(retval, val);
}
}
} else {
/* We are the first (or only) parent. We can short cut the
complexity above, because our @ISA is simply us prepended
to our parent's @ISA, and our ->isa cache is simply our
parent's, with our name added. */
/* newSVsv() is slow. This code is only faster if we can avoid
it by ensuring that SVs in the arrays are shared hash key
scalar SVs, because we can "copy" them very efficiently.
Although to be fair, we can't *ensure* this, as a reference
to the internal array is returned by mro::get_linear_isa(),
so we'll have to be defensive just in case someone faffed
with it. */
if (basestash) {
SV **svp;
stored = MUTABLE_HV(sv_2mortal((SV*)newHVhv(HvMROMETA(basestash)->isa)));
av_extend(retval, subrv_items);
AvFILLp(retval) = subrv_items;
svp = AvARRAY(retval);
while(subrv_items--) {
SV *const val = *subrv_p++;
*++svp = SvIsCOW_shared_hash(val)
? newSVhek(SvSHARED_HEK_FROM_PV(SvPVX(val)))
: newSVsv(val);
}
} else {
/* They have no stash. So create ourselves an ->isa cache
as if we'd copied it from what theirs should be. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
av_push(retval,
newSVhek(HeKEY_hek(hv_store_ent(stored, sv,
&PL_sv_undef, 0))));
}
}
}
} else {
/* We have no parents. */
stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
(void) hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0);
}
(void) hv_store_ent(stored, our_name, &PL_sv_undef, 0);
SvREFCNT_inc_simple_void_NN(stored);
SvTEMP_off(stored);
SvREADONLY_on(stored);
meta->isa = stored;
/* now that we're past the exception dangers, grab our own reference to
the AV we're about to use for the result. The reference owned by the
mortals' stack will be released soon, so everything will balance. */
SvREFCNT_inc_simple_void_NN(retval);
SvTEMP_off(retval);
/* we don't want anyone modifying the cache entry but us,
and we do so by replacing it completely */
SvREADONLY_on(retval);
return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg,
MUTABLE_SV(retval)));
}
static AV*
S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
{
AV* retval;
GV** gvp;
GV* gv;
AV* isa;
const HEK* stashhek;
struct mro_meta* meta;
PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_C3;
assert(HvAUX(stash));
stashhek = HvNAME_HEK(stash);
if (!stashhek)
Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
HEK_KEY(stashhek));
meta = HvMROMETA(stash);
/* return cache if valid */
if((retval = meta->mro_linear_c3)) {
return retval;
}
/* not in cache, make a new one */
gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
isa = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
if ( isa && ! SvAVOK(isa) ) {
Perl_croak(aTHX_ "@ISA is not an array but %s", Ddesc((SV*)isa));
}
/* For a better idea how the rest of this works, see the much clearer
pure perl version in Algorithm::C3 0.01:
http://search.cpan.org/src/STEVAN/Algorithm-C3-0.01/lib/Algorithm/C3.pm
(later versions go about it differently than this code for speed reasons)
*/
if(isa && AvFILLp(isa) >= 0) {
SV** seqs_ptr;
I32 seqs_items;
HV* const tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
I32* heads;
/* This builds @seqs, which is an array of arrays.
The members of @seqs are the MROs of
the members of @ISA, followed by @ISA itself.
*/
I32 items = AvFILLp(isa) + 1;
SV** isa_ptr = AvARRAY(isa);
while(items--) {
SV* const isa_item = *isa_ptr++;
if ( ! SvPVOK(isa_item) ) {
Perl_croak(aTHX_ "@ISA element which is not an plain value");
}
{
HV* const isa_item_stash = gv_stashsv(isa_item, 0);
if(!isa_item_stash) {
/* if no stash, make a temporary fake MRO
containing just itself */
AV* const isa_lin = newAV();
av_push(isa_lin, newSVsv(isa_item));
av_push(seqs, (SV*)isa_lin);
}
else {
/* recursion */
AV* const isa_lin = mro_get_linear_isa_c3(isa_item_stash, level + 1);
av_push(seqs, SvREFCNT_inc_NN((SV*)isa_lin));
}
}
}
av_push(seqs, SvREFCNT_inc_NN((SV*)isa));
/* This builds "heads", which as an array of integer array
indices, one per seq, which point at the virtual "head"
of the seq (initially zero) */
Newxz(heads, AvFILLp(seqs)+1, I32);
/* This builds %tails, which has one key for every class
mentioned in the tail of any sequence in @seqs (tail meaning
everything after the first class, the "head"). The value
is how many times this key appears in the tails of @seqs.
*/
seqs_ptr = AvARRAY(seqs);
seqs_items = AvFILLp(seqs) + 1;
while(seqs_items--) {
AV *const seq = MUTABLE_AV(*seqs_ptr++);
I32 seq_items = AvFILLp(seq);
if(seq_items > 0) {
SV** seq_ptr = AvARRAY(seq) + 1;
while(seq_items--) {
SV* const seqitem = *seq_ptr++;
/* LVALUE fetch will create a new undefined SV if necessary
*/
HE* const he = hv_fetch_ent(tails, seqitem, 1, 0);
if(he) {
SV* const val = HeVAL(he);
/* This will increment undef to 1, which is what we
want for a newly created entry. */
sv_inc(val);
}
}
}
}
/* Initialize retval to build the return value in */
retval = newAV();
av_push(retval, newSVhek(stashhek)); /* us first */
/* This loop won't terminate until we either finish building
the MRO, or get an exception. */
while(1) {
SV* cand = NULL;
SV* winner = NULL;
int s;
/* "foreach $seq (@seqs)" */
SV** const avptr = AvARRAY(seqs);
for(s = 0; s <= AvFILLp(seqs); s++) {
SV** svp;
AV * const seq = MUTABLE_AV(avptr[s]);
SV* seqhead;
if(!seq) continue; /* skip empty seqs */
svp = av_fetch(seq, heads[s], 0);
seqhead = *svp; /* seqhead = head of this seq */
if(!winner) {
HE* tail_entry;
SV* val;
/* if we haven't found a winner for this round yet,
and this seqhead is not in tails (or the count
for it in tails has dropped to zero), then this
seqhead is our new winner, and is added to the
final MRO immediately */
cand = seqhead;
if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
&& (val = HeVAL(tail_entry))
&& (SvIV(val) > 0))
continue;
winner = newSVsv(cand);
av_push(retval, winner);
/* note however that even when we find a winner,
we continue looping over @seqs to do housekeeping */
}
if(!sv_cmp(seqhead, winner)) {
/* Once we have a winner (including the iteration
where we first found him), inc the head ptr
for any seq which had the winner as a head,
NULL out any seq which is now empty,
and adjust tails for consistency */
const int new_head = ++heads[s];
if(new_head > AvFILLp(seq)) {
SvREFCNT_dec(avptr[s]);
avptr[s] = NULL;
}
else {
HE* tail_entry;
SV* val;
/* Because we know this new seqhead used to be
a tail, we can assume it is in tails and has
a positive value, which we need to dec */
svp = av_fetch(seq, new_head, 0);
seqhead = *svp;
tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
val = HeVAL(tail_entry);
sv_dec(val);
}
}
}
/* if we found no candidates, we are done building the MRO.
!cand means no seqs have any entries left to check */
if(!cand) {
Safefree(heads);
break;
}
/* If we had candidates, but nobody won, then the @ISA
hierarchy is not C3-incompatible */
if(!winner) {
SV *errmsg;
I32 i;
errmsg = newSVpvf(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s':\n\t"
"current merge results [\n", HEK_KEY(stashhek));
for (i = 0; i <= av_len(retval); i++) {
SV **elem = av_fetch(retval, i, 0);
sv_catpvf(aTHX_ errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
}
sv_catpvf(aTHX_ errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
/* we have to do some cleanup before we croak */
AvREFCNT_dec(retval);
Safefree(heads);
croak(aTHX_ "%"SVf, SVfARG(errmsg));
}
}
}
else { /* @ISA was undefined or empty */
/* build a retval containing only ourselves */
retval = newAV();
av_push(retval, newSVhek(stashhek));
}
/* we don't want anyone modifying the cache entry but us,
and we do so by replacing it completely */
SvREADONLY_on(retval);
meta->mro_linear_c3 = retval;
return retval;
}
STATIC SV *
S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level)
{
AV* av;
GV* gv;
GV** gvp;
HV* hv = Nullhv;
SV* subgen = Nullsv;
if (!stash)
return &PL_sv_undef;
if (strEQ(HvNAME(stash), name))
return &PL_sv_yes;
if (level > 100)
Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
HvNAME(stash));
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv))
&& (hv = GvHV(gv)))
{
if (SvIV(subgen) == PL_sub_generation) {
SV* sv;
SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
name, HvNAME(stash)) );
return sv;
}
}
else {
DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
HvNAME(stash)) );
hv_clear(hv);
sv_setiv(subgen, PL_sub_generation);
}
}
gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
if (!hv || !subgen) {
gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
gv = *gvp;
if (SvTYPE(gv) != SVt_PVGV)
gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE);
if (!hv)
hv = GvHVn(gv);
if (!subgen) {
subgen = newSViv(PL_sub_generation);
GvSV(gv) = subgen;
}
}
if (hv) {
SV** svp = AvARRAY(av);
/* NOTE: No support for tied ISA */
I32 items = AvFILLp(av) + 1;
while (items--) {
SV* sv = *svp++;
HV* basestash = gv_stashsv(sv, FALSE);
if (!basestash) {
if (ckWARN(WARN_MISC))
Perl_warner(aTHX_ WARN_SYNTAX,
"Can't locate package %s for @%s::ISA",
SvPVX(sv), HvNAME(stash));
continue;
}
if (&PL_sv_yes == isa_lookup(basestash, name, len, level + 1)) {
(void)hv_store(hv,name,len,&PL_sv_yes,0);
return &PL_sv_yes;
}
}
(void)hv_store(hv,name,len,&PL_sv_no,0);
}
}
return boolSV(strEQ(name, "UNIVERSAL"));
}
int init_psgi_app(struct wsgi_request *wsgi_req, char *app, uint16_t app_len, PerlInterpreter **interpreters) {
struct stat st;
int i;
SV **callables;
time_t now = uwsgi_now();
char *app_name = uwsgi_concat2n(app, app_len, "", 0);
// prepare for $0
uperl.embedding[1] = app_name;
int fd = open(app_name, O_RDONLY);
if (fd < 0) {
uwsgi_error_open(app_name);
goto clear2;
}
if (fstat(fd, &st)) {
uwsgi_error("fstat()");
close(fd);
goto clear2;
}
char *buf = uwsgi_calloc(st.st_size+1);
if (read(fd, buf, st.st_size) != st.st_size) {
uwsgi_error("read()");
close(fd);
free(buf);
goto clear2;
}
close(fd);
// the first (default) app, should always be loaded in the main interpreter
if (interpreters == NULL) {
if (uwsgi_apps_cnt) {
interpreters = uwsgi_calloc(sizeof(PerlInterpreter *) * uwsgi.threads);
interpreters[0] = uwsgi_perl_new_interpreter();
if (!interpreters[0]) {
uwsgi_log("unable to create new perl interpreter\n");
free(interpreters);
goto clear2;
}
}
else {
interpreters = uperl.main;
}
}
if (!interpreters) {
goto clear2;
}
callables = uwsgi_calloc(sizeof(SV *) * uwsgi.threads);
uperl.tmp_streaming_stash = uwsgi_calloc(sizeof(HV *) * uwsgi.threads);
uperl.tmp_input_stash = uwsgi_calloc(sizeof(HV *) * uwsgi.threads);
uperl.tmp_error_stash = uwsgi_calloc(sizeof(HV *) * uwsgi.threads);
uperl.tmp_stream_responder = uwsgi_calloc(sizeof(CV *) * uwsgi.threads);
uperl.tmp_psgix_logger = uwsgi_calloc(sizeof(CV *) * uwsgi.threads);
for(i=0;i<uwsgi.threads;i++) {
if (i > 0 && interpreters != uperl.main) {
interpreters[i] = uwsgi_perl_new_interpreter();
if (!interpreters[i]) {
uwsgi_log("unable to create new perl interpreter\n");
// what to do here ? i hope no-one will use threads with dynamic apps...but clear the whole stuff...
free(callables);
uwsgi_perl_free_stashes();
while(i>=0) {
perl_destruct(interpreters[i]);
perl_free(interpreters[i]);
goto clear2;
}
}
}
PERL_SET_CONTEXT(interpreters[i]);
uperl.tmp_current_i = i;
if (uperl.locallib) {
uwsgi_log("using %s as local::lib directory\n", uperl.locallib);
uperl.embedding[1] = uwsgi_concat2("-Mlocal::lib=", uperl.locallib);
uperl.embedding[2] = app_name;
if (perl_parse(interpreters[i], xs_init, 3, uperl.embedding, NULL)) {
// what to do here ? i hope no-one will use threads with dynamic apps... but clear the whole stuff...
free(uperl.embedding[1]);
uperl.embedding[1] = app_name;
free(callables);
uwsgi_perl_free_stashes();
goto clear;
}
free(uperl.embedding[1]);
uperl.embedding[1] = app_name;
}
else {
if (perl_parse(interpreters[i], xs_init, 2, uperl.embedding, NULL)) {
// what to do here ? i hope no-one will use threads with dynamic apps... but clear the whole stuff...
free(callables);
uwsgi_perl_free_stashes();
goto clear;
}
}
perl_eval_pv("use IO::Handle;", 0);
perl_eval_pv("use IO::File;", 0);
perl_eval_pv("use Scalar::Util;", 0);
if (!uperl.no_die_catch) {
perl_eval_pv("use Devel::StackTrace;", 0);
if (!SvTRUE(ERRSV)) {
uperl.stacktrace_available = 1;
perl_eval_pv("$SIG{__DIE__} = \\&uwsgi::stacktrace;", 0);
}
}
if (uperl.argv_items || uperl.argv_item) {
AV *uperl_argv = GvAV(PL_argvgv);
if (uperl.argv_items) {
char *argv_list = uwsgi_str(uperl.argv_items);
char *p = strtok(argv_list, " ");
while(p) {
av_push(uperl_argv, newSVpv(p, 0));
p = strtok(NULL, " ");
}
}
struct uwsgi_string_list *usl = uperl.argv_item;
while(usl) {
av_push(uperl_argv, newSVpv(usl->value, usl->len));
usl = usl->next;
}
}
SV *dollar_zero = get_sv("0", GV_ADD);
sv_setsv(dollar_zero, newSVpv(app, app_len));
callables[i] = perl_eval_pv(uwsgi_concat4("#line 1 ", app_name, "\n", buf), 0);
if (!callables[i]) {
uwsgi_log("unable to find PSGI function entry point.\n");
// what to do here ? i hope no-one will use threads with dynamic apps...
free(callables);
uwsgi_perl_free_stashes();
goto clear;
}
PERL_SET_CONTEXT(interpreters[0]);
}
free(buf);
if(SvTRUE(ERRSV)) {
uwsgi_log("%s\n", SvPV_nolen(ERRSV));
free(callables);
uwsgi_perl_free_stashes();
goto clear;
}
if (uwsgi_apps_cnt >= uwsgi.max_apps) {
uwsgi_log("ERROR: you cannot load more than %d apps in a worker\n", uwsgi.max_apps);
goto clear;
}
int id = uwsgi_apps_cnt;
struct uwsgi_app *wi = NULL;
if (wsgi_req) {
// we need a copy of app_id
wi = uwsgi_add_app(id, psgi_plugin.modifier1, uwsgi_concat2n(wsgi_req->appid, wsgi_req->appid_len, "", 0), wsgi_req->appid_len, interpreters, callables);
}
else {
wi = uwsgi_add_app(id, psgi_plugin.modifier1, "", 0, interpreters, callables);
}
wi->started_at = now;
wi->startup_time = uwsgi_now() - now;
uwsgi_log("PSGI app %d (%s) loaded in %d seconds at %p (interpreter %p)\n", id, app_name, (int) wi->startup_time, callables[0], interpreters[0]);
free(app_name);
// copy global data to app-specific areas
wi->stream = uperl.tmp_streaming_stash;
wi->input = uperl.tmp_input_stash;
wi->error = uperl.tmp_error_stash;
wi->responder0 = uperl.tmp_stream_responder;
wi->responder1 = uperl.tmp_psgix_logger;
uwsgi_emulate_cow_for_apps(id);
// restore context if required
if (interpreters != uperl.main) {
PERL_SET_CONTEXT(uperl.main[0]);
}
uperl.loaded = 1;
return id;
clear:
if (interpreters != uperl.main) {
for(i=0;i<uwsgi.threads;i++) {
perl_destruct(interpreters[i]);
perl_free(interpreters[i]);
}
free(interpreters);
}
PERL_SET_CONTEXT(uperl.main[0]);
clear2:
free(app_name);
return -1;
}
USER_OBJECT_
fromPerl(SV *val, unsigned int depth)
{
USER_OBJECT_ ans = NULL_USER_OBJECT;
USER_OBJECT_ classes;
svtype type = SvTYPE(val);
svtype elementType = SVt_NULL;
svtype refType;
SV *refVal = NULL;
dTHX;
if(type == SVt_PVGV) {
if(GvHV(val))
ans = fromPerlHV(GvHV(val), depth - 1);
else if(GvAV(val))
ans = fromPerlAV(GvAV(val), NULL, depth - 1);
else if(GvCV(val))
ans = fromPerl((SV *) GvCV(val), 0);
else if(GvSV(val))
ans = fromPerl(GvSV(val), depth - 1);
else if(GvIOp(val)) {
/* XXX */
} else {
PROBLEM "Don't understand particular type of PVGV at this point"
ERROR;
}
return(ans);
} else if (type == SVt_PVMG && !sv_isobject(val)) {
/* If it is magic and not an object, then treat it as a scalar and
get it back to R as a value, not a reference.
Would ideally like to respect the convert option. But
we can get ourselves into an infinite loop. Needs more investigation.
*/
return(GetRScalar(val));
}
if(val == NULL || val == &sv_undef || (!SvOK(val) && !SvROK(val) && type != SVt_PVCV) /* || type == SVt_NULL */) {
#ifdef R_PERL_DEBUG
fprintf(stderr, "Null result: %p (%d) (undef = %p) (type is %s) SvOK=%d, SvROK=%d\n",
val, type, &sv_undef, type == SVt_NULL ? "null" : "not null",
SvOK(val), SvROK(val)); fflush(stderr);
#endif
return(NULL_USER_OBJECT);
}
if(SvROK(val)) { /* && sv_isobject(val)) { */
if(sv_isa(val, "RReferences")) {
return(RPerl_getProxyValue(val));
} else {
ans = userLevelConversionFromPerl(val, depth);
if(ans != NULL)
return(ans);
#ifdef R_PERL_DEBUG
fprintf(stderr, "Didn't get a user-leve conversion. Continuining with regular conversion\n");
#endif
}
}
classes = computeRSPerlClassVector(val, &elementType, depth);
if(!depth || (classes && GET_LENGTH(classes))) {
/* We protect classes in the subroutines. */
PROTECT(classes);
ans = makeForeignPerlReference(val, classes, &exportReferenceTable);
UNPROTECT(1);
return(ans);
}
#ifdef R_PERL_DEBUG
fprintf(stderr, "[Converting] element type %d %d %d\n", (int) elementType, (int) SvTYPE(val), (int) (SvTYPE(val) == SVt_RV));
#endif
/*
If it is a reference, then check whether it is an array or hash.
*/
if(SvROK(val)) {
refVal = SvRV(val);
refType = SvTYPE(refVal);
} else {
refVal = val;
refType = type;
}
#ifdef R_PERL_DEBUG
fprintf(stderr, "[fromPerl] refType = %d\n", refType);
#endif
if(refType == SVt_PVAV || refType == SVt_PVHV) {
if(isHomogeneous(refVal, &elementType)) {
return( (refType == SVt_PVAV) ?
fromHomogeneousArray(refVal, elementType) :
fromHomogeneousTable(refVal, elementType));
} else {
return( (refType == SVt_PVAV) ? fromPerlAV((AV*)refVal, NULL, depth) : fromPerlHV((HV*)refVal, depth));
}
} else if(refType == SVt_PVCV) {
return(createPerlReference(refVal));
}
#ifdef R_PERL_DEBUG
fprintf(stderr, "[fromPerl] continuing again as refType (%d) was not an array or table.\n", refType);
#endif
ans = GetRScalar(val);
return(ans);
}
