static SV *parser_fn(OP *(fn)(pTHX_ U32), bool named) {
I32 floor;
CV *code;
U8 errors;
ENTER;
PL_curcop = &PL_compiling;
SAVEVPTR(PL_op);
SAVEI8(PL_parser->error_count);
PL_parser->error_count = 0;
floor = start_subparse(0, named ? 0 : CVf_ANON);
code = newATTRSUB(floor, NULL, NULL, NULL, fn(aTHX_ 0));
errors = PL_parser->error_count;
LEAVE;
if (errors) {
++PL_parser->error_count;
return newSV(0);
}
else {
if (CvCLONE(code)) {
code = cv_clone(code);
}
return newRV_inc((SV*)code);
}
}
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
{
register GP *gp;
bool doproto = SvTYPE(gv) > SVt_NULL;
char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
sv_upgrade((SV*)gv, SVt_PVGV);
if (SvLEN(gv)) {
if (proto) {
SvPVX(gv) = NULL;
SvLEN(gv) = 0;
SvPOK_off(gv);
} else
Safefree(SvPVX(gv));
}
Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
GvSV(gv) = NEWSV(72,0);
GvLINE(gv) = CopLINE(PL_curcop);
GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : "";
GvCVGEN(gv) = 0;
GvEGV(gv) = gv;
sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0);
GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
if (multi || doproto) /* doproto means it _was_ mentioned */
GvMULTI_on(gv);
if (doproto) { /* Replicate part of newSUB here. */
SvIOK_off(gv);
ENTER;
/* XXX unsafe for threads if eval_owner isn't held */
start_subparse(0,0); /* Create CV in compcv. */
GvCV(gv) = PL_compcv;
LEAVE;
PL_sub_generation++;
CvGV(GvCV(gv)) = gv;
CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(GvCV(gv)) = 0;
if (!CvMUTEXP(GvCV(gv))) {
New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
MUTEX_INIT(CvMUTEXP(GvCV(gv)));
}
#endif /* USE_THREADS */
if (proto) {
sv_setpv((SV*)GvCV(gv), proto);
Safefree(proto);
}
}
}
