X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7614df0c0f0d0458f8f9c442cd557e6387b4e40d..6c72d195a44add86e50e54c2c80795702dc3fc9f:/perl.c diff --git a/perl.c b/perl.c index 7b76edf..14357b7 100644 --- a/perl.c +++ b/perl.c @@ -45,36 +45,13 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; #endif #endif -#define I_REINIT \ - STMT_START { \ - chopset = " \n-"; \ - copline = NOLINE; \ - curcop = &compiling; \ - curcopdb = NULL; \ - cxstack_ix = -1; \ - cxstack_max = 128; \ - dbargs = 0; \ - dlmax = 128; \ - laststatval = -1; \ - laststype = OP_STAT; \ - maxscream = -1; \ - maxsysfd = MAXSYSFD; \ - statname = Nullsv; \ - tmps_floor = -1; \ - tmps_ix = -1; \ - op_mask = NULL; \ - dlmax = 128; \ - laststatval = -1; \ - laststype = OP_STAT; \ - mess_sv = Nullsv; \ - } STMT_END - #ifdef PERL_OBJECT static I32 read_e_script _((CPerlObj* pPerl, int idx, SV *buf_sv, int maxlen)); #else static void find_beginning _((void)); static void forbid_setid _((char *)); static void incpush _((char *, int)); +static void init_interp _((void)); static void init_ids _((void)); static void init_debugger _((void)); static void init_lexer _((void)); @@ -135,6 +112,7 @@ perl_construct(register PerlInterpreter *sv_interp) #endif #ifdef MULTIPLICITY + ++ninterps; Zero(sv_interp, 1, PerlInterpreter); #endif @@ -165,7 +143,7 @@ perl_construct(register PerlInterpreter *sv_interp) thr = init_main_thread(); #endif /* USE_THREADS */ - linestr = NEWSV(65,80); + linestr = NEWSV(65,79); sv_upgrade(linestr,SVt_PVIV); if (!SvREADONLY(&sv_undef)) { @@ -204,11 +182,11 @@ perl_construct(register PerlInterpreter *sv_interp) init_stacks(ARGS); #ifdef MULTIPLICITY - I_REINIT; + init_interp(); perl_destruct_level = 1; #else - if(perl_destruct_level > 0) - I_REINIT; + if (perl_destruct_level > 0) + init_interp(); #endif init_ids(); @@ -352,6 +330,10 @@ perl_destruct(register PerlInterpreter *sv_interp) LEAVE; FREETMPS; +#ifdef MULTIPLICITY + --ninterps; +#endif + /* We must account for everything. */ /* Destroy the main CV and syntax tree */ @@ -471,6 +453,7 @@ perl_destruct(register PerlInterpreter *sv_interp) envgv = Nullgv; siggv = Nullgv; incgv = Nullgv; + hintgv = Nullgv; errgv = Nullgv; argvgv = Nullgv; argvoutgv = Nullgv; @@ -551,8 +534,11 @@ perl_destruct(register PerlInterpreter *sv_interp) /* No SVs have survived, need to clean out */ linestr = NULL; pidstatus = Nullhv; - if (origfilename) - Safefree(origfilename); + Safefree(origfilename); + Safefree(archpat_auto); + Safefree(reg_start_tmp); + Safefree(HeKEY_hek(&hv_fetch_ent_mh)); + Safefree(op_mask); nuke_stacks(); hints = 0; /* Reset hints. Should hints be per-interpreter ? */ @@ -1449,11 +1435,17 @@ perl_eval_pv(char *p, I32 croak_on_error) void perl_require_pv(char *pv) { - SV* sv = sv_newmortal(); + SV* sv; + dSP; + PUSHSTACKi(SI_REQUIRE); + PUTBACK; + sv = sv_newmortal(); sv_setpv(sv, "require '"); sv_catpv(sv, pv); sv_catpv(sv, "'"); perl_eval_sv(sv, G_DISCARD); + SPAGAIN; + POPSTACK; } void @@ -1790,6 +1782,72 @@ my_unexec(void) #endif } +/* initialize curinterp */ +STATIC void +init_interp(void) +{ + +#ifdef PERL_OBJECT /* XXX kludge */ +#define I_REINIT \ + STMT_START { \ + chopset = " \n-"; \ + copline = NOLINE; \ + curcop = &compiling; \ + curcopdb = NULL; \ + dbargs = 0; \ + dlmax = 128; \ + laststatval = -1; \ + laststype = OP_STAT; \ + maxscream = -1; \ + maxsysfd = MAXSYSFD; \ + statname = Nullsv; \ + tmps_floor = -1; \ + tmps_ix = -1; \ + op_mask = NULL; \ + dlmax = 128; \ + laststatval = -1; \ + laststype = OP_STAT; \ + mess_sv = Nullsv; \ + splitstr = " "; \ + generation = 100; \ + exitlist = NULL; \ + exitlistlen = 0; \ + regindent = 0; \ + in_clean_objs = FALSE; \ + in_clean_all= FALSE; \ + profiledata = NULL; \ + rsfp = Nullfp; \ + rsfp_filters= Nullav; \ + } STMT_END + I_REINIT; +#else +# ifdef MULTIPLICITY +# define PERLVAR(var,type) +# define PERLVARI(var,type,init) curinterp->var = init; +# define PERLVARIC(var,type,init) curinterp->var = init; +# include "intrpvar.h" +# ifndef USE_THREADS +# include "thrdvar.h" +# endif +# undef PERLVAR +# undef PERLVARI +# undef PERLVARIC +# else +# define PERLVAR(var,type) +# define PERLVARI(var,type,init) var = init; +# define PERLVARIC(var,type,init) var = init; +# include "intrpvar.h" +# ifndef USE_THREADS +# include "thrdvar.h" +# endif +# undef PERLVAR +# undef PERLVARI +# undef PERLVARIC +# endif +#endif + +} + STATIC void init_main_stash(void) { @@ -1813,10 +1871,12 @@ init_main_stash(void) HvNAME(defstash) = savepv("main"); incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV))); GvMULTI_on(incgv); + hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */ + GvMULTI_on(hintgv); defgv = gv_fetchpv("_",TRUE, SVt_PVAV); errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV)); GvMULTI_on(errgv); - replgv = gv_HVadd(gv_fetchpv("\022", TRUE, SVt_PV)); /* ^R */ + replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */ GvMULTI_on(replgv); (void)form("%240s",""); /* Preallocate temp - for immediate signals. */ sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */ @@ -1835,7 +1895,8 @@ open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript) dTHR; register char *s; - scriptname = find_script(scriptname, dosearch, NULL, 0); + /* scriptname will be non-NULL if find_script() returns */ + scriptname = find_script(scriptname, dosearch, NULL, 1); if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) { char *s = scriptname + 8; @@ -1847,7 +1908,7 @@ open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript) } else *fdscript = -1; - origfilename = savepv(e_script ? "-e" : scriptname); + origfilename = (e_script ? savepv("-e") : scriptname); curcop->cop_filegv = gv_fetchfile(origfilename); if (strEQ(origfilename,"-")) scriptname = ""; @@ -1860,7 +1921,7 @@ open_script(char *scriptname, bool dosearch, SV *sv, int *fdscript) } else if (preprocess) { char *cpp_cfg = CPPSTDIN; - SV *cpp = NEWSV(0,0); + SV *cpp = newSVpv("",0); SV *cmd = NEWSV(0,0); if (strEQ(cpp_cfg, "cppstdin")) @@ -2295,44 +2356,23 @@ init_stacks(ARGSproto) tmps_ix = -1; tmps_max = REASONABLE(128); - /* - * The following stacks almost certainly should be per-interpreter, - * but for now they're not. XXX - */ - - if (markstack) { - markstack_ptr = markstack; - } else { - New(54,markstack,REASONABLE(32),I32); - markstack_ptr = markstack; - markstack_max = markstack + REASONABLE(32); - } + New(54,markstack,REASONABLE(32),I32); + markstack_ptr = markstack; + markstack_max = markstack + REASONABLE(32); SET_MARKBASE; - if (scopestack) { - scopestack_ix = 0; - } else { - New(54,scopestack,REASONABLE(32),I32); - scopestack_ix = 0; - scopestack_max = REASONABLE(32); - } + New(54,scopestack,REASONABLE(32),I32); + scopestack_ix = 0; + scopestack_max = REASONABLE(32); - if (savestack) { - savestack_ix = 0; - } else { - New(54,savestack,REASONABLE(128),ANY); - savestack_ix = 0; - savestack_max = REASONABLE(128); - } + New(54,savestack,REASONABLE(128),ANY); + savestack_ix = 0; + savestack_max = REASONABLE(128); - if (retstack) { - retstack_ix = 0; - } else { - New(54,retstack,REASONABLE(16),OP*); - retstack_ix = 0; - retstack_max = REASONABLE(16); - } + New(54,retstack,REASONABLE(16),OP*); + retstack_ix = 0; + retstack_max = REASONABLE(16); } #undef REASONABLE @@ -2351,6 +2391,10 @@ nuke_stacks(void) curstackinfo = p; } Safefree(tmps_stack); + Safefree(markstack); + Safefree(scopestack); + Safefree(savestack); + Safefree(retstack); DEBUG( { Safefree(debname); Safefree(debdelim); @@ -2578,7 +2622,7 @@ incpush(char *p, int addsubdirs) return; if (addsubdirs) { - subdir = NEWSV(55,0); + subdir = sv_newmortal(); if (!archpat_auto) { STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel) + sizeof("//auto")); @@ -2654,8 +2698,6 @@ incpush(char *p, int addsubdirs) /* finally push this lib directory on the end of @INC */ av_push(GvAVn(incgv), libdir); } - - SvREFCNT_dec(subdir); } #ifdef USE_THREADS