This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Changes.
[perl5.git] / pp_ctl.c
index 90c6a3c..a7ac731 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
-static I32 sortcv(pTHXo_ SV *a, SV *b);
-static I32 sortcv_stacked(pTHXo_ SV *a, SV *b);
-static I32 sortcv_xsub(pTHXo_ SV *a, SV *b);
-static I32 sv_ncmp(pTHXo_ SV *a, SV *b);
-static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_ncmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_i_ncmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_cmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_cmp_locale(pTHXo_ SV *a, SV *b);
-static I32 run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen);
-
-#ifdef PERL_OBJECT
-static I32 sv_cmp_static(pTHXo_ SV *a, SV *b);
-static I32 sv_cmp_locale_static(pTHXo_ SV *a, SV *b);
-#else
+static I32 sortcv(pTHX_ SV *a, SV *b);
+static I32 sortcv_stacked(pTHX_ SV *a, SV *b);
+static I32 sortcv_xsub(pTHX_ SV *a, SV *b);
+static I32 sv_ncmp(pTHX_ SV *a, SV *b);
+static I32 sv_i_ncmp(pTHX_ SV *a, SV *b);
+static I32 amagic_ncmp(pTHX_ SV *a, SV *b);
+static I32 amagic_i_ncmp(pTHX_ SV *a, SV *b);
+static I32 amagic_cmp(pTHX_ SV *a, SV *b);
+static I32 amagic_cmp_locale(pTHX_ SV *a, SV *b);
+static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen);
+
 #define sv_cmp_static Perl_sv_cmp
 #define sv_cmp_locale_static Perl_sv_cmp_locale
-#endif
 
 PP(pp_wantarray)
 {
@@ -86,29 +81,36 @@ PP(pp_regcomp)
     SV *tmpstr;
     STRLEN len;
     MAGIC *mg = Null(MAGIC*);
-
+    
     tmpstr = POPs;
+
+    /* prevent recompiling under /o and ithreads. */
+#if defined(USE_ITHREADS) || defined(USE_5005THREADS)
+    if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm))
+        RETURN;
+#endif
+
     if (SvROK(tmpstr)) {
        SV *sv = SvRV(tmpstr);
        if(SvMAGICAL(sv))
-           mg = mg_find(sv, 'r');
+           mg = mg_find(sv, PERL_MAGIC_qr);
     }
     if (mg) {
        regexp *re = (regexp *)mg->mg_obj;
-       ReREFCNT_dec(pm->op_pmregexp);
-       pm->op_pmregexp = ReREFCNT_inc(re);
+       ReREFCNT_dec(PM_GETRE(pm));
+       PM_SETRE(pm, ReREFCNT_inc(re));
     }
     else {
        t = SvPV(tmpstr, len);
 
        /* Check against the last compiled regexp. */
-       if (!pm->op_pmregexp || !pm->op_pmregexp->precomp ||
-           pm->op_pmregexp->prelen != len ||
-           memNE(pm->op_pmregexp->precomp, t, len))
+       if (!PM_GETRE(pm) || !PM_GETRE(pm)->precomp ||
+           PM_GETRE(pm)->prelen != len ||
+           memNE(PM_GETRE(pm)->precomp, t, len))
        {
-           if (pm->op_pmregexp) {
-               ReREFCNT_dec(pm->op_pmregexp);
-               pm->op_pmregexp = Null(REGEXP*);        /* crucial if regcomp aborts */
+           if (PM_GETRE(pm)) {
+               ReREFCNT_dec(PM_GETRE(pm));
+               PM_SETRE(pm, Null(REGEXP*));    /* crucial if regcomp aborts */
            }
            if (PL_op->op_flags & OPf_SPECIAL)
                PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
@@ -121,7 +123,7 @@ PP(pp_regcomp)
                if (pm->op_pmdynflags & PMdf_UTF8)
                    t = (char*)bytes_to_utf8((U8*)t, &len);
            }
-           pm->op_pmregexp = CALLREGCOMP(aTHX_ t, t + len, pm);
+           PM_SETRE(pm, CALLREGCOMP(aTHX_ t, t + len, pm));
            if (!DO_UTF8(tmpstr) && (pm->op_pmdynflags & PMdf_UTF8))
                Safefree(t);
            PL_reginterp_cnt = 0;       /* XXXX Be extra paranoid - needed
@@ -138,15 +140,17 @@ PP(pp_regcomp)
     }
 #endif
 
-    if (!pm->op_pmregexp->prelen && PL_curpm)
+    if (!PM_GETRE(pm)->prelen && PL_curpm)
        pm = PL_curpm;
-    else if (strEQ("\\s+", pm->op_pmregexp->precomp))
+    else if (strEQ("\\s+", PM_GETRE(pm)->precomp))
        pm->op_pmflags |= PMf_WHITE;
+    else
+       pm->op_pmflags &= ~PMf_WHITE;
 
     /* XXX runtime compiled output needs to move to the pad */
     if (pm->op_pmflags & PMf_KEEP) {
        pm->op_private &= ~OPpRUNTIME;  /* no point compiling again */
-#if !defined(USE_ITHREADS) && !defined(USE_THREADS)
+#if !defined(USE_ITHREADS) && !defined(USE_5005THREADS)
        /* XXX can't change the optree at runtime either */
        cLOGOP->op_first->op_next = PL_op->op_next;
 #endif
@@ -227,9 +231,9 @@ PP(pp_substcont)
        I32 i;
        if (SvTYPE(sv) < SVt_PVMG)
            (void)SvUPGRADE(sv, SVt_PVMG);
-       if (!(mg = mg_find(sv, 'g'))) {
-           sv_magic(sv, Nullsv, 'g', Nullch, 0);
-           mg = mg_find(sv, 'g');
+       if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
+           sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
+           mg = mg_find(sv, PERL_MAGIC_regex_global);
        }
        i = m - orig;
        if (DO_UTF8(sv))
@@ -312,18 +316,18 @@ PP(pp_formline)
     register char *s;
     register char *send;
     register I32 arg;
-    register SV *sv;
-    char *item;
-    I32 itemsize;
-    I32 fieldsize;
+    register SV *sv = Nullsv;
+    char *item = Nullch;
+    I32 itemsize  = 0;
+    I32 fieldsize = 0;
     I32 lines = 0;
     bool chopspace = (strchr(PL_chopset, ' ') != Nullch);
-    char *chophere;
-    char *linemark;
+    char *chophere = Nullch;
+    char *linemark = Nullch;
     NV value;
-    bool gotsome;
+    bool gotsome = FALSE;
     STRLEN len;
-    STRLEN fudge = SvCUR(tmpForm) * (IN_BYTE ? 1 : 3) + 1;
+    STRLEN fudge = SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1;
     bool item_is_utf = FALSE;
 
     if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
@@ -373,7 +377,7 @@ PP(pp_formline)
                PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg);
            else
                PerlIO_printf(Perl_debug_log, "%-16s\n", name);
-       } )
+       } );
        switch (*fpc++) {
        case FF_LINEMARK:
            linemark = t;
@@ -771,7 +775,7 @@ PP(pp_grepstart)
     ENTER;                                     /* enter outer scope */
 
     SAVETMPS;
-    /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
+    /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
     SAVESPTR(DEFSV);
     ENTER;                                     /* enter inner scope */
     SAVEVPTR(PL_curpm);
@@ -887,7 +891,7 @@ PP(pp_sort)
     register I32 max;
     HV *stash;
     GV *gv;
-    CV *cv;
+    CV *cv = 0;
     I32 gimme = GIMME;
     OP* nextop = PL_op->op_next;
     I32 overloading = 0;
@@ -985,7 +989,7 @@ PP(pp_sort)
                    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
                    PL_sortstash = stash;
                }
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
                sv_lock((SV *)PL_firstgv);
                sv_lock((SV *)PL_secondgv);
 #endif
@@ -1007,10 +1011,10 @@ PP(pp_sort)
                /* This is mostly copied from pp_entersub */
                AV *av = (AV*)PL_curpad[0];
 
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
                cx->blk_sub.savearray = GvAV(PL_defgv);
                GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
                cx->blk_sub.oldcurpad = PL_curpad;
                cx->blk_sub.argarray = av;
            }
@@ -1031,7 +1035,7 @@ PP(pp_sort)
                        ? ( (PL_op->op_private & OPpSORT_INTEGER)
                            ? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
                            : ( overloading ? amagic_ncmp : sv_ncmp))
-                       : ( (PL_op->op_private & OPpLOCALE)
+                       : ( IN_LOCALE_RUNTIME
                            ? ( overloading
                                ? amagic_cmp_locale
                                : sv_cmp_locale_static)
@@ -1079,7 +1083,7 @@ PP(pp_flip)
        if (PL_op->op_private & OPpFLIP_LINENUM) {
            struct io *gp_io;
            flip = PL_last_in_gv
-               && (gp_io = GvIOp(PL_last_in_gv))
+               && (gp_io = GvIO(PL_last_in_gv))
                && SvIV(sv) == (IV)IoLINES(gp_io);
        } else {
            flip = SvTRUE(sv);
@@ -1160,7 +1164,8 @@ PP(pp_flop)
        SV *targ = PAD_SV(cUNOP->op_first->op_targ);
        sv_inc(targ);
        if ((PL_op->op_private & OPpFLIP_LINENUM)
-         ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
+         ? (GvIO(PL_last_in_gv)
+            && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
          : SvTRUE(sv) ) {
            sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
            sv_catpv(targ, "E0");
@@ -1185,27 +1190,27 @@ S_dopoptolabel(pTHX_ char *label)
        case CXt_SUBST:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_SUB:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_FORMAT:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_EVAL:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_NULL:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            return -1;
        case CXt_LOOP:
            if (!cx->blk_loop.label ||
@@ -1320,27 +1325,27 @@ S_dopoptoloop(pTHX_ I32 startingblock)
        case CXt_SUBST:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_SUB:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_FORMAT:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_EVAL:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            break;
        case CXt_NULL:
            if (ckWARN(WARN_EXITING))
                Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s",
-                       PL_op_name[PL_op->op_type]);
+                       OP_NAME(PL_op));
            return -1;
        case CXt_LOOP:
            DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
@@ -1433,10 +1438,6 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen)
            }
            else {
                sv_setpvn(ERRSV, message, msglen);
-               if (PL_hints & HINT_UTF8)
-                   SvUTF8_on(ERRSV);
-               else
-                   SvUTF8_off(ERRSV);
            }
        }
        else
@@ -1545,7 +1546,7 @@ PP(pp_caller)
 
     if (MAXARG)
        count = POPi;
-    EXTEND(SP, 10);
+
     for (;;) {
        /* we may be in a higher stacklevel, so dig down deeper */
        while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
@@ -1554,8 +1555,10 @@ PP(pp_caller)
            cxix = dopoptosub_at(ccstack, top_si->si_cxix);
        }
        if (cxix < 0) {
-           if (GIMME != G_ARRAY)
+           if (GIMME != G_ARRAY) {
+               EXTEND(SP, 1);
                RETPUSHUNDEF;
+            }
            RETURN;
        }
        if (PL_DBsub && cxix >= 0 &&
@@ -1577,6 +1580,7 @@ PP(pp_caller)
 
     stashname = CopSTASHPV(cx->blk_oldcop);
     if (GIMME != G_ARRAY) {
+        EXTEND(SP, 1);
        if (!stashname)
            PUSHs(&PL_sv_undef);
        else {
@@ -1587,6 +1591,8 @@ PP(pp_caller)
        RETURN;
     }
 
+    EXTEND(SP, 10);
+
     if (!stashname)
        PUSHs(&PL_sv_undef);
     else
@@ -1759,14 +1765,14 @@ PP(pp_enteriter)
     ENTER;
     SAVETMPS;
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     if (PL_op->op_flags & OPf_SPECIAL) {
        svp = &THREADSV(PL_op->op_targ);        /* per-thread variable */
        SAVEGENERICSV(*svp);
        *svp = NEWSV(0,0);
     }
     else
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     if (PL_op->op_targ) {
 #ifndef USE_ITHREADS
        svp = &PL_curpad[PL_op->op_targ];               /* "my" variable */
@@ -2241,10 +2247,10 @@ PP(pp_goto)
                EXTEND(PL_stack_sp, items); /* @_ could have been extended. */
                Copy(AvARRAY(av), PL_stack_sp, items, SV*);
                PL_stack_sp += items;
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
                SvREFCNT_dec(GvAV(PL_defgv));
                GvAV(PL_defgv) = cx->blk_sub.savearray;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
                /* abandon @_ if it got reified */
                if (AvREAL(av)) {
                    (void)sv_2mortal((SV*)av);  /* delay until return */
@@ -2256,7 +2262,7 @@ PP(pp_goto)
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
                AV* av;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
                av = (AV*)PL_curpad[0];
 #else
                av = GvAV(PL_defgv);
@@ -2298,7 +2304,7 @@ PP(pp_goto)
                    PL_stack_sp--;              /* There is no cv arg. */
                    /* Push a mark for the start of arglist */
                    PUSHMARK(mark);
-                   (void)(*CvXSUB(cv))(aTHXo_ cv);
+                   (void)(*CvXSUB(cv))(aTHX_ cv);
                    /* Pop the current context like a decent sub should */
                    POPBLOCK(cx, PL_curpm);
                    /* Do _not_ use PUTBACK, keep the XSUB's return stack! */
@@ -2368,7 +2374,7 @@ PP(pp_goto)
                        svp = AvARRAY(padlist);
                    }
                }
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
                if (!cx->blk_sub.hasargs) {
                    AV* av = (AV*)PL_curpad[0];
                
@@ -2381,20 +2387,20 @@ PP(pp_goto)
                        PUTBACK ;               
                    }
                }
-#endif /* USE_THREADS */               
+#endif /* USE_5005THREADS */           
                SAVEVPTR(PL_curpad);
                PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
                if (cx->blk_sub.hasargs)
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
                {
                    AV* av = (AV*)PL_curpad[0];
                    SV** ary;
 
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
                    cx->blk_sub.savearray = GvAV(PL_defgv);
                    GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
                    cx->blk_sub.oldcurpad = PL_curpad;
                    cx->blk_sub.argarray = av;
                    ++mark;
@@ -2794,7 +2800,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp)
     return rop;
 }
 
-/* With USE_THREADS, eval_owner must be held on entry to doeval */
+/* With USE_5005THREADS, eval_owner must be held on entry to doeval */
 STATIC OP *
 S_doeval(pTHX_ int gimme, OP** startop)
 {
@@ -2835,11 +2841,14 @@ S_doeval(pTHX_ int gimme, OP** startop)
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
     CvEVAL_on(PL_compcv);
-#ifdef USE_THREADS
+    assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+    cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
+
+#ifdef USE_5005THREADS
     CvOWNER(PL_compcv) = 0;
     New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(PL_compcv));
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     PL_comppad = newAV();
     av_push(PL_comppad, Nullsv);
@@ -2848,11 +2857,11 @@ S_doeval(pTHX_ int gimme, OP** startop)
     PL_comppad_name_fill = 0;
     PL_min_intro_pending = 0;
     PL_padix = 0;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
     PL_curpad[0] = (SV*)newAV();
     SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -2866,7 +2875,7 @@ S_doeval(pTHX_ int gimme, OP** startop)
        CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(caller);
     }
 
-    SAVEFREESV(PL_compcv);
+    SAVEMORTALIZESV(PL_compcv);        /* must remain until end of current statement */
 
     /* make sure we compile in the right package */
 
@@ -2926,12 +2935,12 @@ S_doeval(pTHX_ int gimme, OP** startop)
        }
        SvREFCNT_dec(PL_rs);
        PL_rs = SvREFCNT_inc(PL_nrs);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
        MUTEX_LOCK(&PL_eval_mutex);
        PL_eval_owner = 0;
        COND_SIGNAL(&PL_eval_cond);
        MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
        RETPUSHUNDEF;
     }
     SvREFCNT_dec(PL_rs);
@@ -2970,12 +2979,12 @@ S_doeval(pTHX_ int gimme, OP** startop)
     SP = PL_stack_base + POPMARK;              /* pop original mark */
     PL_op = saveop;                    /* The caller may need it. */
     PL_lex_state = LEX_NOTPARSING;     /* $^S needs this. */
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     MUTEX_LOCK(&PL_eval_mutex);
     PL_eval_owner = 0;
     COND_SIGNAL(&PL_eval_cond);
     MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
 
     RETURNOP(PL_eval_start);
 }
@@ -3019,10 +3028,10 @@ PP(pp_require)
     SV *sv;
     char *name;
     STRLEN len;
-    char *tryname;
+    char *tryname = Nullch;
     SV *namesv = Nullsv;
     SV** svp;
-    I32 gimme = G_SCALAR;
+    I32 gimme = GIMME_V;
     PerlIO *tryrsfp = 0;
     STRLEN n_a;
     int filter_has_file = 0;
@@ -3032,7 +3041,7 @@ PP(pp_require)
 
     sv = POPs;
     if (SvNIOKp(sv)) {
-       if (SvPOK(sv) && SvNOK(sv)) {           /* require v5.6.1 */
+       if (SvPOK(sv) && SvNOK(sv) && SvNV(sv)) {               /* require v5.6.1 */
            UV rev = 0, ver = 0, sver = 0;
            STRLEN len;
            U8 *s = (U8*)SvPVX(sv);
@@ -3139,12 +3148,14 @@ trylocal: {
                    int count;
                    SV *loader = dirsv;
 
-                   if (SvTYPE(SvRV(loader)) == SVt_PVAV) {
+                   if (SvTYPE(SvRV(loader)) == SVt_PVAV
+                       && !sv_isobject(loader))
+                   {
                        loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
                    }
 
                    Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
-                                  PTR2UV(SvANY(loader)), name);
+                                  PTR2UV(SvRV(dirsv)), name);
                    tryname = SvPVX(namesv);
                    tryrsfp = 0;
 
@@ -3352,15 +3363,15 @@ trylocal: {
     CopLINE_set(&PL_compiling, 0);
 
     PUTBACK;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     MUTEX_LOCK(&PL_eval_mutex);
     if (PL_eval_owner && PL_eval_owner != thr)
        while (PL_eval_owner)
            COND_WAIT(&PL_eval_cond, &PL_eval_mutex);
     PL_eval_owner = thr;
     MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_THREADS */
-    return DOCATCH(doeval(G_SCALAR, NULL));
+#endif /* USE_5005THREADS */
+    return DOCATCH(doeval(gimme, NULL));
 }
 
 PP(pp_dofile)
@@ -3436,14 +3447,14 @@ PP(pp_entereval)
     if (PERLDB_LINE && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_linestr);
     PUTBACK;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     MUTEX_LOCK(&PL_eval_mutex);
     if (PL_eval_owner && PL_eval_owner != thr)
        while (PL_eval_owner)
            COND_WAIT(&PL_eval_cond, &PL_eval_mutex);
     PL_eval_owner = thr;
     MUTEX_UNLOCK(&PL_eval_mutex);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
     ret = doeval(gimme, NULL);
     if (PERLDB_INTER && was != PL_sub_generation /* Some subs defined here. */
        && ret != PL_op->op_next) {     /* Successive compilation. */
@@ -3592,14 +3603,14 @@ S_doparseform(pTHX_ SV *sv)
     STRLEN len;
     register char *s = SvPV_force(sv, len);
     register char *send = s + len;
-    register char *base;
+    register char *base = Nullch;
     register I32 skipspaces = 0;
-    bool noblank;
-    bool repeat;
+    bool noblank   = FALSE;
+    bool repeat    = FALSE;
     bool postspace = FALSE;
     U16 *fops;
     register U16 *fpc;
-    U16 *linepc;
+    U16 *linepc = 0;
     register I32 arg;
     bool ischop;
 
@@ -3778,7 +3789,7 @@ S_doparseform(pTHX_ SV *sv)
     }
     Copy(fops, s, arg, U16);
     Safefree(fops);
-    sv_magic(sv, Nullsv, 'f', Nullch, 0);
+    sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0);
     SvCOMPILED_on(sv);
 }
 
@@ -3799,12 +3810,11 @@ S_doparseform(pTHX_ SV *sv)
 #ifdef TESTHARNESS
 #include <sys/types.h>
 typedef        void SV;
-#define pTHXo_
 #define pTHX_
 #define STATIC
 #define New(ID,VAR,N,TYPE) VAR=(TYPE *)malloc((N)*sizeof(TYPE))
 #define        Safefree(VAR) free(VAR)
-typedef int  (*SVCOMPARE_t) (pTHXo_ SV*, SV*);
+typedef int  (*SVCOMPARE_t) (pTHX_ SV*, SV*);
 #endif /* TESTHARNESS */
 
 typedef char * aptr;           /* pointer for arithmetic on sizes */
@@ -4148,16 +4158,8 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
     return;
 }
 
-
-#ifdef PERL_OBJECT
-#undef this
-#define this pPerl
-#include "XSUB.h"
-#endif
-
-
 static I32
-sortcv(pTHXo_ SV *a, SV *b)
+sortcv(pTHX_ SV *a, SV *b)
 {
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
@@ -4180,14 +4182,14 @@ sortcv(pTHXo_ SV *a, SV *b)
 }
 
 static I32
-sortcv_stacked(pTHXo_ SV *a, SV *b)
+sortcv_stacked(pTHX_ SV *a, SV *b)
 {
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
     I32 result;
     AV *av;
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     av = (AV*)PL_curpad[0];
 #else
     av = GvAV(PL_defgv);
@@ -4225,7 +4227,7 @@ sortcv_stacked(pTHXo_ SV *a, SV *b)
 }
 
 static I32
-sortcv_xsub(pTHXo_ SV *a, SV *b)
+sortcv_xsub(pTHX_ SV *a, SV *b)
 {
     dSP;
     I32 oldsaveix = PL_savestack_ix;
@@ -4239,7 +4241,7 @@ sortcv_xsub(pTHXo_ SV *a, SV *b)
     *++SP = a;
     *++SP = b;
     PUTBACK;
-    (void)(*CvXSUB(cv))(aTHXo_ cv);
+    (void)(*CvXSUB(cv))(aTHX_ cv);
     if (PL_stack_sp != PL_stack_base + 1)
        Perl_croak(aTHX_ "Sort subroutine didn't return single value");
     if (!SvNIOKp(*PL_stack_sp))
@@ -4254,7 +4256,7 @@ sortcv_xsub(pTHXo_ SV *a, SV *b)
 
 
 static I32
-sv_ncmp(pTHXo_ SV *a, SV *b)
+sv_ncmp(pTHX_ SV *a, SV *b)
 {
     NV nv1 = SvNV(a);
     NV nv2 = SvNV(b);
@@ -4262,7 +4264,7 @@ sv_ncmp(pTHXo_ SV *a, SV *b)
 }
 
 static I32
-sv_i_ncmp(pTHXo_ SV *a, SV *b)
+sv_i_ncmp(pTHX_ SV *a, SV *b)
 {
     IV iv1 = SvIV(a);
     IV iv2 = SvIV(b);
@@ -4280,7 +4282,7 @@ sv_i_ncmp(pTHXo_ SV *a, SV *b)
        } STMT_END
 
 static I32
-amagic_ncmp(pTHXo_ register SV *a, register SV *b)
+amagic_ncmp(pTHX_ register SV *a, register SV *b)
 {
     SV *tmpsv;
     tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
@@ -4298,11 +4300,11 @@ amagic_ncmp(pTHXo_ register SV *a, register SV *b)
            return 1;
         return d? -1 : 0;
      }
-     return sv_ncmp(aTHXo_ a, b);
+     return sv_ncmp(aTHX_ a, b);
 }
 
 static I32
-amagic_i_ncmp(pTHXo_ register SV *a, register SV *b)
+amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
 {
     SV *tmpsv;
     tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
@@ -4320,11 +4322,11 @@ amagic_i_ncmp(pTHXo_ register SV *a, register SV *b)
            return 1;
         return d? -1 : 0;
     }
-    return sv_i_ncmp(aTHXo_ a, b);
+    return sv_i_ncmp(aTHX_ a, b);
 }
 
 static I32
-amagic_cmp(pTHXo_ register SV *str1, register SV *str2)
+amagic_cmp(pTHX_ register SV *str1, register SV *str2)
 {
     SV *tmpsv;
     tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
@@ -4346,7 +4348,7 @@ amagic_cmp(pTHXo_ register SV *str1, register SV *str2)
 }
 
 static I32
-amagic_cmp_locale(pTHXo_ register SV *str1, register SV *str2)
+amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
 {
     SV *tmpsv;
     tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
@@ -4368,7 +4370,7 @@ amagic_cmp_locale(pTHXo_ register SV *str1, register SV *str2)
 }
 
 static I32
-run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
+run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
     SV *datasv = FILTER_DATA(idx);
     int filter_has_file = IoLINES(datasv);
@@ -4436,19 +4438,3 @@ run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
 
     return len;
 }
-
-#ifdef PERL_OBJECT
-
-static I32
-sv_cmp_locale_static(pTHXo_ register SV *str1, register SV *str2)
-{
-    return sv_cmp_locale(str1, str2);
-}
-
-static I32
-sv_cmp_static(pTHXo_ register SV *str1, register SV *str2)
-{
-    return sv_cmp(str1, str2);
-}
-
-#endif /* PERL_OBJECT */