This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fdim NaN guard.
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index b61e2ff..a5f1592 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -325,7 +325,6 @@ perl_construct(pTHXx)
     PL_stashcache = newHV();
 
     PL_patchlevel = newSVpvs("v" PERL_VERSION_STRING);
-    PL_apiversion = newSVpvs("v" PERL_API_VERSION_STRING);
 
 #ifdef HAS_MMAP
     if (!PL_mmap_page_size) {
@@ -906,7 +905,6 @@ perl_destruct(pTHXx)
     Safefree(PL_inplace);
     PL_inplace = NULL;
     SvREFCNT_dec(PL_patchlevel);
-    SvREFCNT_dec(PL_apiversion);
 
     if (PL_e_script) {
        SvREFCNT_dec(PL_e_script);
@@ -968,6 +966,9 @@ perl_destruct(pTHXx)
     PL_DBsingle = NULL;
     PL_DBtrace = NULL;
     PL_DBsignal = NULL;
+    PL_DBsingle_iv = 0;
+    PL_DBtrace_iv = 0;
+    PL_DBsignal_iv = 0;
     PL_DBcv = NULL;
     PL_dbargs = NULL;
     PL_debstash = NULL;
@@ -1034,6 +1035,7 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_foldable);
     SvREFCNT_dec(PL_utf8_foldclosures);
     SvREFCNT_dec(PL_AboveLatin1);
+    SvREFCNT_dec(PL_InBitmap);
     SvREFCNT_dec(PL_UpperLatin1);
     SvREFCNT_dec(PL_Latin1);
     SvREFCNT_dec(PL_NonL1NonFinalFold);
@@ -1047,6 +1049,7 @@ perl_destruct(pTHXx)
     PL_utf8_idcont     = NULL;
     PL_utf8_foldclosures = NULL;
     PL_AboveLatin1       = NULL;
+    PL_InBitmap          = NULL;
     PL_HasMultiCharFold  = NULL;
     PL_Latin1            = NULL;
     PL_NonL1NonFinalFold = NULL;
@@ -2070,10 +2073,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                it should be reported immediately as a build failure.  */
            (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
                                                 Perl_newSVpvf(aTHX_
-               "BEGIN { my $f = q%c./%"SVf"/buildcustomize.pl%c; "
+               "BEGIN { my $f = q%c%s%"SVf"/buildcustomize.pl%c; "
                        "do {local $!; -f $f }"
                        " and do $f || die $@ || qq '$f: $!' }",
-                                                              0, SVfARG(*inc0), 0));
+                                0, (TAINTING_get ? "./" : ""), SVfARG(*inc0), 0));
        }
 #  else
        /* SITELIB_EXP is a function call on Win32.  */
@@ -2157,7 +2160,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
     CvUNIQUE_on(PL_compcv);
 
-    CvPADLIST(PL_compcv) = pad_new(0);
+    CvPADLIST_set(PL_compcv, pad_new(0));
 
     PL_isarev = newHV();
 
@@ -2387,7 +2390,7 @@ S_run_body(pTHX_ I32 oldscope)
            my_exit(0);
        }
        if (PERLDB_SINGLE && PL_DBsingle)
-           sv_setiv(PL_DBsingle, 1);
+            PL_DBsingle_iv = 1;
        if (PL_initav) {
            PERL_SET_PHASE(PERL_PHASE_INIT);
            call_list(oldscope, PL_initav);
@@ -2644,8 +2647,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
 {
     dVAR; dSP;
     LOGOP myop;                /* fake syntax tree node */
-    UNOP method_unop;
-    SVOP method_svop;
+    METHOP method_op;
     I32 oldmark;
     VOL I32 retval = 0;
     I32 oldscope;
@@ -2689,23 +2691,19 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        myop.op_private |= OPpENTERSUB_DB;
 
     if (flags & (G_METHOD|G_METHOD_NAMED)) {
+        Zero(&method_op, 1, METHOP);
+        method_op.op_next = (OP*)&myop;
+        PL_op = (OP*)&method_op;
         if ( flags & G_METHOD_NAMED ) {
-            Zero(&method_svop, 1, SVOP);
-            method_svop.op_next = (OP*)&myop;
-            method_svop.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED];
-            method_svop.op_type = OP_METHOD_NAMED;
-            method_svop.op_sv = sv;
-            PL_op = (OP*)&method_svop;
+            method_op.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED];
+            method_op.op_type = OP_METHOD_NAMED;
+            method_op.op_u.op_meth_sv = sv;
         } else {
-            Zero(&method_unop, 1, UNOP);
-            method_unop.op_next = (OP*)&myop;
-            method_unop.op_ppaddr = PL_ppaddr[OP_METHOD];
-            method_unop.op_type = OP_METHOD;
-            PL_op = (OP*)&method_unop;
+            method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
+            method_op.op_type = OP_METHOD;
         }
         myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
         myop.op_type = OP_ENTERSUB;
-
     }
 
     if (!(flags & G_EVAL)) {
@@ -3960,6 +3958,7 @@ void
 Perl_init_debugger(pTHX)
 {
     HV * const ostash = PL_curstash;
+    MAGIC *mg;
 
     PL_curstash = (HV *)SvREFCNT_inc_simple(PL_debstash);
 
@@ -3976,12 +3975,24 @@ Perl_init_debugger(pTHX)
     PL_DBsingle = GvSV((gv_fetchpvs("DB::single", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBsingle))
        sv_setiv(PL_DBsingle, 0);
+    mg = sv_magicext(PL_DBsingle, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_SINGLE;
+    SvSETMAGIC(PL_DBsingle);
+
     PL_DBtrace = GvSV((gv_fetchpvs("DB::trace", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBtrace))
        sv_setiv(PL_DBtrace, 0);
+    mg = sv_magicext(PL_DBtrace, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_TRACE;
+    SvSETMAGIC(PL_DBtrace);
+
     PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBsignal))
        sv_setiv(PL_DBsignal, 0);
+    mg = sv_magicext(PL_DBsignal, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_SIGNAL;
+    SvSETMAGIC(PL_DBsignal);
+
     SvREFCNT_dec(PL_curstash);
     PL_curstash = ostash;
 }
@@ -5024,6 +5035,15 @@ read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
     return 1;
 }
 
+/* removes boilerplate code at the end of each boot_Module xsub */
+void
+Perl_xs_boot_epilog(pTHX_ const U32 ax)
+{
+  if (PL_unitcheckav)
+       call_list(PL_scopestack_ix, PL_unitcheckav);
+    XSRETURN_YES;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd