In the description of require, clarify the file handle return and why
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index a98314b..a8fd47f 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -148,6 +148,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
        ALLOC_THREAD_KEY;
        PERL_SET_THX(my_perl);
        OP_REFCNT_INIT;
+       HINTS_REFCNT_INIT;
        MUTEX_INIT(&PL_dollarzero_mutex);
 #  endif
 #ifdef PERL_IMPLICIT_CONTEXT
@@ -360,7 +361,7 @@ perl_construct(pTHXx)
        if ((long) PL_mmap_page_size < 0) {
          if (errno) {
            SV * const error = ERRSV;
-           (void) SvUPGRADE(error, SVt_PV);
+           SvUPGRADE(error, SVt_PV);
            Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
          }
          else
@@ -1034,11 +1035,13 @@ perl_destruct(pTHXx)
     PL_utf8_idcont     = NULL;
 
     if (!specialWARN(PL_compiling.cop_warnings))
-       SvREFCNT_dec(PL_compiling.cop_warnings);
+       PerlMemShared_free(PL_compiling.cop_warnings);
     PL_compiling.cop_warnings = NULL;
     if (!specialCopIO(PL_compiling.cop_io))
        SvREFCNT_dec(PL_compiling.cop_io);
     PL_compiling.cop_io = NULL;
+    Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
+    PL_compiling.cop_hints = NULL;
     CopFILE_free(&PL_compiling);
     CopSTASH_free(&PL_compiling);
 
@@ -1255,6 +1258,12 @@ perl_destruct(pTHXx)
 
     sv_free_arenas();
 
+    while (PL_regmatch_slab) {
+       regmatch_slab  *s = PL_regmatch_slab;
+       PL_regmatch_slab = PL_regmatch_slab->next;
+       Safefree(s);
+    }
+
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
@@ -1336,6 +1345,8 @@ perl_free(pTHXx)
 
 #if defined(__hpux) && !(defined(__ux_version) && __ux_version <= 1020) && !defined(__GNUC__)
 #pragma fini "perl_fini"
+#elif defined(__sun) && !defined(__GNUC__)
+#pragma fini (perl_fini)
 #endif
 
 static void
@@ -2026,7 +2037,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
 
     if (PL_taint_warn && PL_dowarn != G_WARN_ALL_OFF) {
-       PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+        PL_compiling.cop_warnings
+           = Perl_new_warnings_bitfield(aTHX_ NULL, WARN_TAINTstring, WARNsize);
     }
 
     if (!scriptname)
@@ -2604,27 +2616,11 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     else {
        myop.op_other = (OP*)&myop;
        PL_markstack_ptr--;
-       /* we're trying to emulate pp_entertry() here */
-       {
-           register PERL_CONTEXT *cx;
-           const I32 gimme = GIMME_V;
-       
-           ENTER;
-           SAVETMPS;
-       
-           PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
-           PUSHEVAL(cx, 0, 0);
-           PL_eval_root = PL_op;             /* Only needed so that goto works right. */
-       
-           PL_in_eval = EVAL_INEVAL;
-           if (flags & G_KEEPERR)
-               PL_in_eval |= EVAL_KEEPERR;
-           else
-               sv_setpvn(ERRSV,"",0);
-       }
+       create_eval_scope(flags|G_FAKINGEVAL);
        PL_markstack_ptr++;
 
        JMPENV_PUSH(ret);
+
        switch (ret) {
        case 0:
  redo_body:
@@ -2661,21 +2657,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            break;
        }
 
-       if (PL_scopestack_ix > oldscope) {
-           SV **newsp;
-           PMOP *newpm;
-           I32 gimme;
-           register PERL_CONTEXT *cx;
-           I32 optype;
-
-           POPBLOCK(cx,newpm);
-           POPEVAL(cx);
-           PL_curpm = newpm;
-           LEAVE;
-           PERL_UNUSED_VAR(newsp);
-           PERL_UNUSED_VAR(gimme);
-           PERL_UNUSED_VAR(optype);
-       }
+       if (PL_scopestack_ix > oldscope)
+           delete_eval_scope();
        JMPENV_POP;
     }
 
@@ -3108,7 +3091,7 @@ Perl_moreswitches(pTHX_ char *s)
        }
 #endif /* __CYGWIN__ */
        {
-           const char *start = ++s;
+           const char * const start = ++s;
            while (*s && !isSPACE(*s))
                ++s;
 
@@ -3387,14 +3370,14 @@ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
     case 'W':
        PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
         if (!specialWARN(PL_compiling.cop_warnings))
-            SvREFCNT_dec(PL_compiling.cop_warnings);
+            PerlMemShared_free(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_ALL ;
        s++;
        return s;
     case 'X':
        PL_dowarn = G_WARN_ALL_OFF;
         if (!specialWARN(PL_compiling.cop_warnings))
-            SvREFCNT_dec(PL_compiling.cop_warnings);
+            PerlMemShared_free(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_NONE ;
        s++;
        return s;
@@ -3492,6 +3475,11 @@ S_init_interp(pTHX)
 #  undef PERLVARIC
 #endif
 
+    /* As these are inside a structure, PERLVARI isn't capable of initialising
+       them  */
+    PL_regindent = 0;
+    PL_reg_oldcurpm = PL_reg_curpm = NULL;
+    PL_reg_poscache = PL_reg_starttry = NULL;
 }
 
 STATIC void
@@ -4810,7 +4798,8 @@ S_init_perllib(pTHX)
 #  endif
 #endif
 
-#ifdef SITELIB_STEM /* Search for version-specific dirs below here */
+#if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST)
+    /* Search for version-specific dirs below here */
     incpush(SITELIB_STEM, FALSE, TRUE, TRUE, TRUE);
 #endif