{
PerlInterpreter *my_perl;
-#if !defined(PERL_IMPLICIT_CONTEXT)
- PL_curinterp = 0;
-#endif
New(53, my_perl, 1, PerlInterpreter);
+ PERL_SET_INTERP(my_perl);
return my_perl;
}
#endif /* PERL_OBJECT */
#endif /* FAKE_THREADS */
#endif /* USE_THREADS */
-#ifndef PERL_OBJECT
- if (!(PL_curinterp = my_perl))
- return;
-#endif
-
#ifdef MULTIPLICITY
Zero(my_perl, 1, PerlInterpreter);
#endif
thr = init_main_thread();
#endif /* USE_THREADS */
- PL_protect = FUNC_NAME_TO_PTR(Perl_default_protect); /* for exceptions */
+ PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
PL_curcop = &PL_compiling; /* needed by ckWARN, right away */
dTHX;
#endif /* USE_THREADS */
-#if !defined(PERL_OBJECT) && !defined(PERL_IMPLICIT_CONTEXT)
- if (!(PL_curinterp = my_perl))
- return;
-#endif
-
#ifdef USE_THREADS
#ifndef FAKE_THREADS
/* Pass 1 on any remaining threads: detach joinables, join zombies */
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
+ Safefree(PL_reg_poscache);
Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
Safefree(PL_op_mask);
nuke_stacks();
void
perl_free(pTHXx)
{
-#ifdef PERL_OBJECT
- Safefree(this);
+#if defined(PERL_OBJECT)
+ Safefree(this);
#else
-# if !defined(PERL_IMPLICIT_CONTEXT)
- if (!(PL_curinterp = my_perl))
- return;
-# endif
- Safefree(my_perl);
+ Safefree(aTHXx);
#endif
}
#endif
#endif
-#if !defined(PERL_OBJECT) && !defined(PERL_IMPLICIT_CONTEXT)
- if (!(PL_curinterp = my_perl))
- return 255;
-#endif
-
#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
_dyld_lookup_and_bind
("__environ", (unsigned long *) &environ_pointer, NULL);
oldscope = PL_scopestack_ix;
PL_dowarn = G_WARN_OFF;
- CALLPROTECT(aTHX_ &ret, FUNC_NAME_TO_PTR(S_parse_body), env, xsinit);
+ CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_parse_body), env, xsinit);
switch (ret) {
case 0:
return 0;
if (xsinit)
(*xsinit)(aTHXo); /* in case linked C routines want magical variables */
#if defined(VMS) || defined(WIN32) || defined(DJGPP)
- init_os_extras(aTHX);
+ init_os_extras();
#endif
#ifdef USE_SOCKS
dTHX;
#endif
-#if !defined(PERL_OBJECT) && !defined(PERL_IMPLICIT_CONTEXT)
- if (!(PL_curinterp = my_perl))
- return 255;
-#endif
-
oldscope = PL_scopestack_ix;
redo_body:
- CALLPROTECT(aTHX_ &ret, FUNC_NAME_TO_PTR(S_run_body), oldscope);
+ CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
switch (ret) {
case 1:
cxstack_ix = -1; /* start context stack again */
PL_markstack_ptr++;
redo_body:
- CALLPROTECT(aTHX_ &ret, FUNC_NAME_TO_PTR(S_call_body), (OP*)&myop, FALSE);
+ CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, FALSE);
switch (ret) {
case 0:
retval = PL_stack_sp - (PL_stack_base + oldmark);
myop.op_flags |= OPf_SPECIAL;
redo_body:
- CALLPROTECT(aTHX_ &ret, FUNC_NAME_TO_PTR(S_call_body), (OP*)&myop, TRUE);
+ CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, TRUE);
switch (ret) {
case 0:
retval = PL_stack_sp - (PL_stack_base + oldmark);
#else
# ifdef MULTIPLICITY
# define PERLVAR(var,type)
+# define PERLVARA(var,n,type)
# if defined(PERL_IMPLICIT_CONTEXT)
# define PERLVARI(var,type,init) my_perl->var = init;
# define PERLVARIC(var,type,init) my_perl->var = init;
# else
-# define PERLVARI(var,type,init) PL_curinterp->var = init;
-# define PERLVARIC(var,type,init) PL_curinterp->var = init;
+# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
+# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
# endif
# include "intrpvar.h"
# ifndef USE_THREADS
# include "thrdvar.h"
# endif
# undef PERLVAR
+# undef PERLVARA
# undef PERLVARI
# undef PERLVARIC
# else
# define PERLVAR(var,type)
+# define PERLVARA(var,n,type)
# define PERLVARI(var,type,init) PL_##var = init;
# define PERLVARIC(var,type,init) PL_##var = init;
# include "intrpvar.h"
# include "thrdvar.h"
# endif
# undef PERLVAR
+# undef PERLVARA
# undef PERLVARI
# undef PERLVARIC
# endif
Perl_croak(aTHX_ "No %s allowed while running setgid", s);
}
-STATIC void
-S_init_debugger(pTHX)
+void
+Perl_init_debugger(pTHX)
{
dTHR;
+ HV *ostash = PL_curstash;
+
PL_curstash = PL_debstash;
PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
AvREAL_off(PL_dbargs);
PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+ sv_upgrade(GvSV(PL_DBsub), SVt_IV); /* IVX accessed if PERLDB_SUB_NN */
PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsingle, 0);
PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBtrace, 0);
PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsignal, 0);
- PL_curstash = PL_defstash;
+ PL_curstash = ostash;
}
#ifndef STRESS_REALLOC
incpush(SITELIB_EXP, FALSE);
#endif
#endif
+#if defined(PERL_VENDORLIB_EXP)
+#if defined(WIN32)
+ incpush(PERL_VENDORLIB_EXP, TRUE);
+#else
+ incpush(PERL_VENDORLIB_EXP, FALSE);
+#endif
+#endif
if (!PL_tainting)
incpush(".", FALSE);
}
STATIC struct perl_thread *
S_init_main_thread(pTHX)
{
-#ifndef PERL_IMPLICIT_CONTEXT
+#if !defined(PERL_IMPLICIT_CONTEXT)
struct perl_thread *thr;
#endif
XPV *xpv;
Newz(53, thr, 1, struct perl_thread);
PL_curcop = &PL_compiling;
+ thr->interp = PERL_GET_INTERP;
thr->cvcache = newHV();
thr->threadsv = newAV();
/* thr->threadsvp is set when find_threadsv is called */
(void) find_threadsv("@"); /* Ensure $@ is initialised early */
PL_maxscream = -1;
- PL_regcompp = FUNC_NAME_TO_PTR(Perl_pregcomp);
- PL_regexecp = FUNC_NAME_TO_PTR(Perl_regexec_flags);
- PL_regint_start = FUNC_NAME_TO_PTR(Perl_re_intuit_start);
- PL_regint_string = FUNC_NAME_TO_PTR(Perl_re_intuit_string);
- PL_regfree = FUNC_NAME_TO_PTR(Perl_pregfree);
+ PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
+ PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
+ PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);
+ PL_regint_string = MEMBER_TO_FPTR(Perl_re_intuit_string);
+ PL_regfree = MEMBER_TO_FPTR(Perl_pregfree);
PL_regindent = 0;
PL_reginterp_cnt = 0;
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
SAVEFREESV(cv);
- CALLPROTECT(aTHX_ &ret, FUNC_NAME_TO_PTR(S_call_list_body), cv);
+ CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
switch (ret) {
case 0:
(void)SvPV(atsv, len);
#ifdef PERL_OBJECT
#define NO_XSLOCKS
-#endif /* PERL_OBJECT */
-
#include "XSUB.h"
+#endif
static I32
read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)