Beispiel #1
0
ngx_int_t
ngx_http_psgi_perl_init_worker(ngx_cycle_t *cycle)
{
    ngx_http_psgi_main_conf_t  *psgimcf =
        ngx_http_cycle_get_module_main_conf(cycle, ngx_http_psgi_module);

    ngx_log_debug1(NGX_LOG_DEBUG_HTTP, cycle->log, 0,
            "Init Perl interpreter in worker %d", ngx_pid);

    if (psgimcf) {

        dTHXa(psgimcf->perl);
        PERL_SET_CONTEXT(psgimcf->perl);

        /* FIXME: It looks very wrong.
         * Has new worker it's own Perl instance?
         * I think I should perl_clone() or something like that
         * Also $0 (script path) should be set somewhere.
         * I don't think it's right place for it. It should be done somewhere in local conf init stuff
         * Or, if many handlers share single Perl interpreter - before each handler call
         *
         * TODO
         * Test PID and related stuff
         * Test what happens if user try to change
         * Test what happens if user does 'fork' inside PSGI app
         */

        sv_setiv(GvSV(gv_fetchpv("$$", TRUE, SVt_PV)), (I32) ngx_pid);
    } else {
        ngx_log_error(NGX_LOG_ALERT, cycle->log, 0, "PSGI panic: no main configuration supplied for init worker %d", ngx_pid);
        return NGX_ERROR;
    }

    return NGX_OK;
}
Beispiel #2
0
GV *
Perl_gv_fetchfile(pTHX_ const char *name)
{
    char smallbuf[256];
    char *tmpbuf;
    STRLEN tmplen;
    GV *gv;

    if (!PL_defstash)
	return Nullgv;

    tmplen = strlen(name) + 2;
    if (tmplen < sizeof smallbuf)
	tmpbuf = smallbuf;
    else
	New(603, tmpbuf, tmplen + 1, char);
    tmpbuf[0] = '_';
    tmpbuf[1] = '<';
    strcpy(tmpbuf + 2, name);
    gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
    if (!isGV(gv)) {
	gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
	sv_setpv(GvSV(gv), name);
	if (PERLDB_LINE)
	    hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, 'L');
    }
    if (tmpbuf != smallbuf)
	Safefree(tmpbuf);
    return gv;
}
Beispiel #3
0
SV* THX_MopMcV_get_authority(pTHX_ SV* metaclass) {
    HV* stash = (HV*) SvRV(metaclass);

    SV** authority = hv_fetch(stash, "AUTHORITY", 9, 0);
    if (authority != NULL) {
        return GvSV((GV*) *authority);
    } else {
        return NULL;
    }
}
Beispiel #4
0
SV* THX_MopMcV_get_version(pTHX_ SV* metaclass) {
    HV* stash = (HV*) SvRV(metaclass);

    SV** version = hv_fetch(stash, "VERSION", 7, 0);
    if (version != NULL) {
        return GvSV((GV*) *version);
    } else {
        return NULL;
    }
}
Beispiel #5
0
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
    char autoload[] = "AUTOLOAD";
    STRLEN autolen = sizeof(autoload)-1;
    GV* gv;
    CV* cv;
    HV* varstash;
    GV* vargv;
    SV* varsv;

    if (len == autolen && strnEQ(name, autoload, autolen))
	return Nullgv;
    if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
	return Nullgv;
    cv = GvCV(gv);

    if (!CvROOT(cv))
	return Nullgv;

    /*
     * Inheriting AUTOLOAD for non-methods works ... for now.
     */
    if (ckWARN(WARN_DEPRECATED) && !method &&
	(GvCVGEN(gv) || GvSTASH(gv) != stash))
	Perl_warner(aTHX_ WARN_DEPRECATED,
	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
	     HvNAME(stash), (int)len, name);

    /*
     * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
     * The subroutine's original name may not be "AUTOLOAD", so we don't
     * use that, but for lack of anything better we will use the sub's
     * original package to look up $AUTOLOAD.
     */
    varstash = GvSTASH(CvGV(cv));
    vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
    ENTER;

#ifdef USE_THREADS
    sv_lock((SV *)varstash);
#endif
    if (!isGV(vargv))
	gv_init(vargv, varstash, autoload, autolen, FALSE);
    LEAVE;
    varsv = GvSV(vargv);
#ifdef USE_THREADS
    sv_lock(varsv);
#endif
    sv_setpv(varsv, HvNAME(stash));
    sv_catpvn(varsv, "::", 2);
    sv_catpvn(varsv, name, len);
    SvTAINTED_off(varsv);
    return gv;
}
Beispiel #6
0
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);
	}
    }
}
Beispiel #7
0
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;
            }
        }
    }
}
static ngx_int_t
ngx_http_perl_init_worker(ngx_cycle_t *cycle)
{
    ngx_http_perl_main_conf_t  *pmcf;
    pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module);
    if (pmcf)
    {
        dTHXa(pmcf->perl);
        PERL_SET_CONTEXT(pmcf->perl);
        /* set worker's $$ */
        sv_setiv(GvSV(gv_fetchpv("$", TRUE, SVt_PV)), (I32) ngx_pid);
    }
    return NGX_OK;
}
Beispiel #9
0
void
Perl_set_version(pTHX_ const char *name, STRLEN nlen, const char *strval, STRLEN plen, NV nvval)
{
    SV* ver = GvSV(gv_add_by_type(gv_fetchpvn(name, nlen, GV_ADD, SVt_PVNV),
                                  SVt_PVNV));
    PERL_ARGS_ASSERT_SET_VERSION;
    SvREADONLY_off(ver);
    SvUPGRADE(ver, SVt_PVNV);
    SvPVX(ver) = SvGROW(ver, plen+1);
    Move(strval, SvPVX(ver), plen, char);
    SvCUR_set(ver, plen);
    SvNVX(ver) = nvval;
    /* not the PROTECT bit */
    SvFLAGS(ver) |= (SVf_NOK|SVp_NOK|SVf_POK|SVp_POK|SVf_READONLY);
}
Beispiel #10
0
/*
  Returns the Perl reference to the Code object
  (sub-routine, method, etc.) identified by the S
  character vector `name'.
*/
SV *
getPerlCodeObject(USER_OBJECT_ name)
{
  SV *val;
  SV *tmp;
  Rboolean recurse = FALSE;
  dTHX;

  if(IS_CHARACTER(name)) {
     val = (SV *) get_cv(CHAR_DEREF(STRING_ELT(name, 0)), FALSE);
     return(val);
  } else
     tmp = getForeignPerlReference(name);

  if(tmp == NULL)
    return(NULL);

  do {
    recurse = FALSE;
     switch(SvTYPE(tmp)) {
      case SVt_PVGV:
	      /*XXX Is this correct? or should it be GvCV() */
    	tmp = GvSV(tmp);
    	recurse = TRUE;
    	break;
      case SVt_PVCV:
    	val = tmp;
    	break;
#if	0
		/* SVt_RV no longer exists in modern perl versions */
	  case SVt_RV:
	val = SvRV(tmp);
    	break;
#endif
	  default:
       val = NULL;
       getPerlType(tmp);
       break;
     }
  } while(recurse);

  return(val);
}
Beispiel #11
0
Datei: gv.c Projekt: gitpan/ponie
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
    char autoload[] = "AUTOLOAD";
    STRLEN autolen = sizeof(autoload)-1;
    GV* gv;
    CV* cv;
    HV* varstash;
    GV* vargv;
    SV* varsv;
    char *packname = "";

    if (len == autolen && strnEQ(name, autoload, autolen))
	return Nullgv;
    if (stash) {
	if (SvTYPE(stash) < SVt_PVHV) {
	    packname = SvPV_nolen((SV*)stash);
	    stash = Nullhv;
	}
	else {
	    packname = HvNAME(stash);
	}
    }
    if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
	return Nullgv;
    cv = GvCV(gv);

    if (!(CvROOT(cv) || CvXSUB(cv)))
	return Nullgv;

    /*
     * Inheriting AUTOLOAD for non-methods works ... for now.
     */
    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX) && !method &&
	(GvCVGEN(gv) || GvSTASH(gv) != stash))
	Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
	  "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
	     packname, (int)len, name);

    if (CvXSUB(cv)) {
        /* rather than lookup/init $AUTOLOAD here
         * only to have the XSUB do another lookup for $AUTOLOAD
         * and split that value on the last '::',
         * pass along the same data via some unused fields in the CV
         */
        CvSTASH(cv) = stash;
        SvPVX(cv) = (char *)name; /* cast to lose constness warning */
        SvCUR(cv) = len;
        return gv;
    }

    /*
     * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
     * The subroutine's original name may not be "AUTOLOAD", so we don't
     * use that, but for lack of anything better we will use the sub's
     * original package to look up $AUTOLOAD.
     */
    varstash = GvSTASH(CvGV(cv));
    vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
    ENTER;

    if (!isGV(vargv))
	gv_init(vargv, varstash, autoload, autolen, FALSE);
    LEAVE;
    varsv = GvSV(vargv);
    sv_setpv(varsv, packname);
    sv_catpvn(varsv, "::", 2);
    sv_catpvn(varsv, name, len);
    SvTAINTED_off(varsv);
    return gv;
}
Beispiel #12
0
OP *
Perl_do_readline(pTHX_ GV* gv)
{
    dVAR; dSP; dTARGETSTACKED;
    register SV *sv;
    STRLEN tmplen = 0;
    STRLEN offset;
    PerlIO *fp;
    register IO * const io = GvIO(gv);
    register const I32 type = PL_op->op_type;
    const I32 gimme = GIMME_V;
    PERL_ARGS_ASSERT_DO_READLINE;

    fp = NULL;
    if (io) {
	fp = IoIFP(io);
	if (!fp) {
	    if (IoFLAGS(io) & IOf_ARGV) {
		if (IoFLAGS(io) & IOf_START) {
		    IoLINES(io) = 0;
		    if (av_len(GvAVn(gv)) < 0) {
			IoFLAGS(io) &= ~IOf_START;
			do_openn(io,"-",1,FALSE,O_RDONLY,0,NULL,NULL,0);
			sv_setpvn(GvSVn(gv), "-", 1);
			SvSETMAGIC(GvSV(gv));
			fp = IoIFP(io);
			goto have_fp;
		    }
		}
		fp = nextargv(gv);
		if (!fp) { /* Note: fp != IoIFP(io) */
		    (void)do_close(gv, FALSE); /* now it does*/
		}
	    }
	}
	else if (ckWARN(WARN_IO) && IoTYPE(io) == IoTYPE_WRONLY) {
	    report_evil_fh(io, OP_phoney_OUTPUT_ONLY);
	}
    }
    if (!fp) {
	if ((!io || !(IoFLAGS(io) & IOf_START))
	    && ckWARN2(WARN_GLOB, WARN_CLOSED))
	{
	    if (type == OP_GLOB)
		Perl_warner(aTHX_ packWARN(WARN_GLOB),
			    "glob failed (can't start child: %s)",
			    Strerror(errno));
	    else
		report_evil_fh(io, PL_op->op_type);
	}
	if (gimme == G_SCALAR) {
	    /* undef TARG, and push that undefined value */
	    if (type != OP_RCATLINE) {
		SV_CHECK_THINKFIRST_COW_DROP(TARG);
		if ( ! SvPVOK(TARG) )
		    sv_upgrade(TARG, SVt_PV);
		SvOK_off(TARG);
	    }
	    PUSHTARG;
	}
	RETURN;
    }
  have_fp:
    if (gimme == G_SCALAR) {
	sv = TARG;
	if (type == OP_RCATLINE) {
	    NOOP;
	}
	else {
	    if ( SvOK(sv) && ! SvPVOK(sv) )
		sv_clear_body(sv);
	}
	if (SvROK(sv)) {
	    if (type == OP_RCATLINE)
		SvPV_force_nolen(sv);
	    else
		sv_unref(sv);
	}
	else if (isGV_with_GP(sv)) {
	    SvPV_force_nolen(sv);
	}
	SvUPGRADE(sv, SVt_PV);
	tmplen = SvLEN(sv);	/* remember if already alloced */
	if (!tmplen && !SvREADONLY(sv))
	    Sv_Grow(sv, 80);	/* try short-buffering it */
	offset = 0;
	if (type == OP_RCATLINE && SvOK(sv)) {
	    if (!SvPOK(sv)) {
		SvPV_force_nolen(sv);
	    }
	    offset = SvCUR(sv);
	}
    }
    else {
	sv = sv_2mortal(newSV(80));
	offset = 0;
    }

/* delay EOF state for a snarfed empty file */
#define SNARF_EOF(gimme,rs,io,sv) \
    (gimme != G_SCALAR || SvCUR(sv)					\
     || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))

    for (;;) {
	PUTBACK;
	if (!sv_gets(sv, fp, offset)
	    && (type == OP_GLOB
		|| SNARF_EOF(gimme, PL_rs, io, sv)
		|| PerlIO_error(fp)))
	{
	    PerlIO_clearerr(fp);
	    if (IoFLAGS(io) & IOf_ARGV) {
		fp = nextargv(gv);
		if (fp)
		    continue;
		(void)do_close(gv, FALSE);
	    }
	    else if (type == OP_GLOB) {
		if (!do_close(gv, FALSE) && ckWARN(WARN_GLOB)) {
		    Perl_warner(aTHX_ packWARN(WARN_GLOB),
			   "glob failed (child exited with status %d%s)",
			   (int)(STATUS_CURRENT >> 8),
			   (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
		}
	    }
	    if (gimme == G_SCALAR) {
		if (type != OP_RCATLINE) {
		    SV_CHECK_THINKFIRST_COW_DROP(TARG);
		    SvOK_off(TARG);
		}
		SPAGAIN;
		PUSHTARG;
	    }
	    RETURN;
	}
Beispiel #13
0
int
main(int argc, char **argv, char **env)
{
    int exitstatus;
    int i;
    char **fakeargv;
    GV* tmpgv;
    SV* tmpsv;
    int options_count;

    PERL_SYS_INIT3(&argc,&argv,&env);

    if (!PL_do_undump) {
	my_perl = perl_alloc();
	if (!my_perl)
	    exit(1);
	perl_construct( my_perl );
	PL_perl_destruct_level = 0;
    }
#ifdef USE_ITHREADS
    for( i = 0; i < 117; ++i ) {
        av_push( PL_regex_padav, newSViv(0) );
    }
    PL_regex_pad = AvARRAY( PL_regex_padav );
#endif
#ifdef CSH
    if (!PL_cshlen) 
      PL_cshlen = strlen(PL_cshname);
#endif

#ifdef ALLOW_PERL_OPTIONS
#define EXTRA_OPTIONS 3
#else
#define EXTRA_OPTIONS 4
#endif /* ALLOW_PERL_OPTIONS */
    New(666, fakeargv, argc + EXTRA_OPTIONS + 1, char *);

    fakeargv[0] = argv[0];
    fakeargv[1] = "-e";
    fakeargv[2] = "";
    options_count = 3;
    if( 0 ) {
        fakeargv[options_count] = "-T";
        ++options_count;
    }
#ifndef ALLOW_PERL_OPTIONS
    fakeargv[options_count] = "--";
    ++options_count;
#endif /* ALLOW_PERL_OPTIONS */
    for (i = 1; i < argc; i++)
	fakeargv[i + options_count - 1] = argv[i];
    fakeargv[argc + options_count - 1] = 0;

    exitstatus = perl_parse(my_perl, xs_init, argc + options_count - 1,
			    fakeargv, NULL);

    if (exitstatus)
	exit( exitstatus );

    TAINT;
    if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {/* hello.p */
        tmpsv = GvSV(tmpgv);
        sv_setpv(tmpsv, argv[0]);
        SvSETMAGIC(tmpsv);
    }
    if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
        tmpsv = GvSV(tmpgv);
#ifdef WIN32
        sv_setpv(tmpsv,"perl.exe");
#else
        sv_setpv(tmpsv,"perl");
#endif
        SvSETMAGIC(tmpsv);
    }

    TAINT_NOT;

    /* PL_main_cv = PL_compcv; */
    PL_compcv = 0;

    exitstatus = perl_init();
    if (exitstatus)
	exit( exitstatus );
    dl_init(aTHX);

    exitstatus = perl_run( my_perl );

    perl_destruct( my_perl );
    perl_free( my_perl );

    PERL_SYS_TERM();

    exit( exitstatus );
}
Beispiel #14
0
void
my_xsinit(pTHX)
{
    dVAR;
    static const char file[] = __FILE__;

#ifdef USE_CTRLX
    GV *ctrlXgv;
    SV *ctrlX;
#endif

#ifdef USE_SUBFILE
    if (PL_preprocess)
        croak("Can't use -P with pl2exe");
#endif

#ifdef NEED_INIT_WIN32CORE
    init_Win32CORE(aTHX);
#endif

#ifdef USE_ZIP
    pl2exe_boot_zip(aTHX);
#endif

#ifdef NEED_PREAMBLE
    newXS("ExtUtils::PerlToExe::preamble",
        XS_ExtUtils_PerlToExe_preamble,
        file);

    if (!PL_preambleav)
        PL_preambleav = newAV();
    av_push(PL_preambleav, 
        newSVpvs("BEGIN { ExtUtils::PerlToExe::preamble() }"));
#endif

#ifdef NEED_TAINT
    TAINT;
    TAINT_PROPER("appended " TAINT_TYPE);
    TAINT_NOT;
#endif

#ifdef USE_CTRLX
    ctrlXgv = gv_fetchpvs("\030", GV_NOTQUAL, SVt_PV);
    ctrlX   = GvSV(ctrlXgv);

    /*
     * We can't reopen PL_rsfp yet as it hasn't been set (the file is
     * open, it's just in an auto variable in S_parse_body). However,
     * it's easier to fixup the name here, before gv_fetch_file gets
     * called on it.
     */

    PL_origfilename = savepv(SvPV_nolen(ctrlX));
    CopFILE_free(PL_curcop);
    CopFILE_set(PL_curcop, PL_origfilename);

    sv_setpv(ctrlX, CTRL_X);
    SvTAINTED_on(ctrlX);
#endif

#ifdef USE_ZIP
    pl2exe_load_zip(aTHX_ PL_origfilename);
#endif

    real_xsinit(aTHX);
}
Beispiel #15
0
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"));
}
Beispiel #16
0
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;
}
Beispiel #17
0
void
Perl_set_caret_X(pTHX) {
    GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
    SV *const caret_x = GvSV(tmpgv);
#if defined(OS2)
    sv_setpv(caret_x, os2_execname(aTHX));
#elif defined(USE_KERN_PROC_PATHNAME)
    size_t size = 0;
    int mib[4];
    mib[0] = CTL_KERN;
    mib[1] = KERN_PROC;
    mib[2] = KERN_PROC_PATHNAME;
    mib[3] = -1;

    if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0
        && size > 0 && size < MAXPATHLEN * MAXPATHLEN) {
        sv_grow(caret_x, size);

        if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0
            && size > 2) {
            SvPOK_only(caret_x);
            SvCUR_set(caret_x, size - 1);
            SvTAINT(caret_x);
            return;
        }
    }
#elif defined(USE_NSGETEXECUTABLEPATH)
    char buf[1];
    uint32_t size = sizeof(buf);

    _NSGetExecutablePath(buf, &size);
    if (size < MAXPATHLEN * MAXPATHLEN) {
        sv_grow(caret_x, size);
        if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) {
            char *const tidied = realpath(SvPVX(caret_x), NULL);
            if (tidied) {
                sv_setpv(caret_x, tidied);
                free(tidied);
            } else {
                SvPOK_only(caret_x);
                SvCUR_set(caret_x, size);
            }
            return;
        }
    }
#elif defined(HAS_PROCSELFEXE)
    char buf[MAXPATHLEN];
    SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
    /* NOTE: if the length returned by readlink() is sizeof(buf) - 1,
     * it is impossible to know whether the result was truncated. */

    if (len != -1) {
        buf[len] = '\0';
    }

    /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
       includes a spurious NUL which will cause $^X to fail in system
       or backticks (this will prevent extensions from being built and
       many tests from working). readlink is not meant to add a NUL.
       Normal readlink works fine.
    */
    if (len > 0 && buf[len-1] == '\0') {
        len--;
    }

    /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
       returning the text "unknown" from the readlink rather than the path
       to the executable (or returning an error from the readlink). Any
       valid path has a '/' in it somewhere, so use that to validate the
       result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
    */
    if (len > 0 && memchr(buf, '/', len)) {
        sv_setpvn(caret_x, buf, len);
        return;
    }
#elif defined(WIN32)
    char *ansi;
    WCHAR widename[MAX_PATH];
    GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR));
    ansi = win32_ansipath(widename);
    sv_setpv(caret_x, ansi);
    win32_free(ansi);
    return;
#else
    /* Fallback to this:  */
    sv_setpv(caret_x, PL_origargv[0]);
#endif
}
Beispiel #18
0
static void perlfilter()
{
char *embedding[] = { "", WRAPPERPL };
char *args[] = { "", "0", NULL, NULL, NULL};
int exitstatus = 0;
int	sock;
PerlInterpreter *my_perl;
 
	if((my_perl = perl_alloc()) == NULL)
	{
		fprintf(stderr, "no memory!");
		exit(1);
	}
	perl_construct(my_perl);
 
	exitstatus = perl_parse(my_perl, xs_init, 2, embedding, NULL);
 
	if (exitstatus || (exitstatus=perl_run(my_perl)) != 0)
	{
		fprintf(stderr, "Cannot parse " WRAPPERPL "\n");
		exit(exitstatus);
	}

	while ((sock=lf_accept(listen_sock)) >= 0)
	{
	char	sockbuf[100];

		args[0]=filter;
		sprintf(sockbuf, "%d", sock);
		args[2]=sockbuf;

		{
		dSP ;
		ENTER ;
		SAVETMPS ;

		perl_call_argv("Embed::Persistent::eval_file",
			G_VOID | G_DISCARD | G_EVAL, args);

#ifdef	ERRSV
		if(SvTRUE(ERRSV))
#else
		if(SvTRUE(GvSV(errgv)))
#endif
		{
			clog_open_syslog("perlfilter");
			clog_msg_start_err();
			clog_msg_str("eval error: ");

#ifdef	ERRSV
			clog_msg_str(SvPV(ERRSV,PL_na));
#else
			clog_msg_str(SvPV(GvSV(errgv),na));
#endif
			clog_msg_send();
		}
		FREETMPS ;
		LEAVE ;
		}

		close(sock);	/* Just in case */
	}
#ifdef	perl_destruct_level
	perl_destruct_level=0;
#else
	PL_perl_destruct_level=0;
#endif
	perl_destruct(my_perl);
	perl_free(my_perl);
	exit(0);
}
Beispiel #19
0
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);
}