X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=225d3dcabb401a406c93d7872145ea38c84b47a8;hb=3b0e0cb610a437b422e9557a50cdb439557976dd;hp=1467df1c15cc7db0c703bb6591265c5294830d36;hpb=ce3e5b80724e7725765c5559e5f4b0058876fc19;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 1467df1..225d3dc 100644 --- a/perl.c +++ b/perl.c @@ -298,7 +298,6 @@ Shuts down a Perl interpreter. See L. void perl_destruct(pTHXx) { - dTHR; int destruct_level; /* 0=none, 1=full, 2=full with checks */ I32 last_sv_count; HV *hv; @@ -474,11 +473,11 @@ perl_destruct(pTHXx) /* magical thingies */ - Safefree(PL_ofs); /* $, */ - PL_ofs = Nullch; + SvREFCNT_dec(PL_ofs_sv); /* $, */ + PL_ofs_sv = Nullsv; - Safefree(PL_ors); /* $\ */ - PL_ors = Nullch; + SvREFCNT_dec(PL_ors_sv); /* $\ */ + PL_ors_sv = Nullsv; SvREFCNT_dec(PL_rs); /* $/ */ PL_rs = Nullsv; @@ -824,7 +823,6 @@ Tells a Perl interpreter to parse a Perl script. See L. int perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) { - dTHR; I32 oldscope; int ret; dJMPENV; @@ -926,7 +924,6 @@ S_vparse_body(pTHX_ va_list args) STATIC void * S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { - dTHR; int argc = PL_origargc; char **argv = PL_origargv; char *scriptname = NULL; @@ -1357,7 +1354,6 @@ Tells a Perl interpreter to run. See L. int perl_run(pTHXx) { - dTHR; I32 oldscope; int ret = 0; dJMPENV; @@ -1425,8 +1421,6 @@ S_vrun_body(pTHX_ va_list args) STATIC void * S_run_body(pTHX_ I32 oldscope) { - dTHR; - DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n", PL_sawampersand ? "Enabling" : "Omitting")); @@ -1485,10 +1479,8 @@ Perl_get_sv(pTHX_ const char *name, I32 create) #ifdef USE_THREADS if (name[1] == '\0' && !isALPHA(name[0])) { PADOFFSET tmp = find_threadsv(name); - if (tmp != NOT_IN_PAD) { - dTHR; + if (tmp != NOT_IN_PAD) return THREADSV(tmp); - } } #endif /* USE_THREADS */ gv = gv_fetchpv(name, create, SVt_PV); @@ -1808,8 +1800,6 @@ S_vcall_body(pTHX_ va_list args) STATIC void S_call_body(pTHX_ OP *myop, int is_eval) { - dTHR; - if (PL_op == myop) { if (is_eval) PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */ @@ -2042,7 +2032,6 @@ Perl_moreswitches(pTHX_ char *s) switch (*s) { case '0': { - dTHR; numlen = 0; /* disallow underscores */ rschar = (U32)scan_oct(s, 4, &numlen); SvREFCNT_dec(PL_nrs); @@ -2118,7 +2107,6 @@ Perl_moreswitches(pTHX_ char *s) } PL_debug |= 0x80000000; #else - dTHR; if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ WARN_DEBUGGING, "Recompile perl with -DDEBUGGING to use -D switch\n"); @@ -2170,24 +2158,23 @@ Perl_moreswitches(pTHX_ char *s) case 'l': PL_minus_l = TRUE; s++; - if (PL_ors) - Safefree(PL_ors); + if (PL_ors_sv) { + SvREFCNT_dec(PL_ors_sv); + PL_ors_sv = Nullsv; + } if (isDIGIT(*s)) { - PL_ors = savepv("\n"); - PL_orslen = 1; + PL_ors_sv = newSVpvn("\n",1); numlen = 0; /* disallow underscores */ - *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen); + *SvPVX(PL_ors_sv) = (char)scan_oct(s, 3 + (*s == '0'), &numlen); s += numlen; } else { - dTHR; if (RsPARA(PL_nrs)) { - PL_ors = "\n\n"; - PL_orslen = 2; + PL_ors_sv = newSVpvn("\n\n",2); + } + else { + PL_ors_sv = newSVsv(PL_nrs); } - else - PL_ors = SvPV(PL_nrs, PL_orslen); - PL_ors = savepvn(PL_ors, PL_orslen); } return s; case 'M': @@ -2495,7 +2482,6 @@ S_init_interp(pTHX) STATIC void S_init_main_stash(pTHX) { - dTHR; GV *gv; /* Note that strtab is a rather special HV. Assumptions are made @@ -2539,8 +2525,6 @@ S_init_main_stash(pTHX) STATIC void S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) { - dTHR; - *fdscript = -1; if (PL_e_script) { @@ -2834,7 +2818,6 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) */ #ifdef DOSUID - dTHR; char *s, *s2; if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */ @@ -3032,7 +3015,6 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #else /* !DOSUID */ if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */ #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW - dTHR; PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf); /* may be either wrapped or real suid */ if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) || @@ -3123,7 +3105,6 @@ S_forbid_setid(pTHX_ char *s) void Perl_init_debugger(pTHX) { - dTHR; HV *ostash = PL_curstash; PL_curstash = PL_debstash; @@ -3191,7 +3172,6 @@ Perl_init_stacks(pTHX) STATIC void S_nuke_stacks(pTHX) { - dTHR; while (PL_curstackinfo->si_next) PL_curstackinfo = PL_curstackinfo->si_next; while (PL_curstackinfo) { @@ -3228,7 +3208,6 @@ S_init_lexer(pTHX) STATIC void S_init_predump_symbols(pTHX) { - dTHR; GV *tmpgv; IO *io; @@ -3268,7 +3247,6 @@ S_init_predump_symbols(pTHX) STATIC void S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env) { - dTHR; char *s; SV *sv; GV* tmpgv; @@ -3663,8 +3641,9 @@ S_init_main_thread(pTHX) PERL_SET_THX(thr); /* - * These must come after the SET_THR because sv_setpvn does - * SvTAINT and the taint fields require dTHR. + * These must come after the thread self setting + * because sv_setpvn does SvTAINT and the taint + * fields thread selfness being set. */ PL_toptarget = NEWSV(0,0); sv_upgrade(PL_toptarget, SVt_PVFM); @@ -3692,7 +3671,6 @@ S_init_main_thread(pTHX) void Perl_call_list(pTHX_ I32 oldscope, AV *paramList) { - dTHR; SV *atsv; line_t oldline = CopLINE(PL_curcop); CV *cv; @@ -3797,8 +3775,6 @@ S_call_list_body(pTHX_ CV *cv) void Perl_my_exit(pTHX_ U32 status) { - dTHR; - DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n", thr, (unsigned long) status)); switch (status) { @@ -3847,7 +3823,6 @@ Perl_my_failure_exit(pTHX) STATIC void S_my_exit_jump(pTHX) { - dTHR; register PERL_CONTEXT *cx; I32 gimme; SV **newsp;