Add ${^GLOBAL_PHASE}

This exposes the current top-level interpreter phase to perl space.

1 files changed, 24 insertions, 7 deletions

diff --git a/perl.c b/perl.c
index ed99612b7b..8ed0960eac 100644
--- a/perl.c
+++ b/perl.c
@@ -557,8 +557,10 @@ perl_destruct(pTHXx)
 
         JMPENV_PUSH(x);
 	PERL_UNUSED_VAR(x);
-        if (PL_endav && !PL_minus_c)
+        if (PL_endav && !PL_minus_c) {
+	    PL_phase = PERL_PHASE_END;
             call_list(PL_scopestack_ix, PL_endav);
+	}
         JMPENV_POP;
     }
     LEAVE;
@@ -751,6 +753,7 @@ perl_destruct(pTHXx)
      * destruct_level > 0 */
     SvREFCNT_dec(PL_main_cv);
     PL_main_cv = NULL;
+    PL_phase = PERL_PHASE_DESTRUCT;
     PL_dirty = TRUE;
 
     /* Tell PerlIO we are about to tear things apart in case
@@ -1605,10 +1608,13 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     switch (ret) {
     case 0:
 	parse_body(env,xsinit);
-	if (PL_unitcheckav)
+	if (PL_unitcheckav) {
 	    call_list(oldscope, PL_unitcheckav);
-	if (PL_checkav)
+	}
+	if (PL_checkav) {
+	    PL_phase = PERL_PHASE_CHECK;
 	    call_list(oldscope, PL_checkav);
+	}
 	ret = 0;
 	break;
     case 1:
@@ -1620,10 +1626,13 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 	    LEAVE;
 	FREETMPS;
 	PL_curstash = PL_defstash;
-	if (PL_unitcheckav)
+	if (PL_unitcheckav) {
 	    call_list(oldscope, PL_unitcheckav);
-	if (PL_checkav)
+	}
+	if (PL_checkav) {
+	    PL_phase = PERL_PHASE_CHECK;
 	    call_list(oldscope, PL_checkav);
+	}
 	ret = STATUS_EXIT;
 	break;
     case 3:
@@ -1755,6 +1764,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     SV *linestr_sv = newSV_type(SVt_PVIV);
     bool add_read_e_script = FALSE;
 
+    PL_phase = PERL_PHASE_START;
+
     SvGROW(linestr_sv, 80);
     sv_setpvs(linestr_sv,"");
 
@@ -2245,8 +2256,10 @@ perl_run(pTHXx)
 	FREETMPS;
 	PL_curstash = PL_defstash;
 	if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
-	    PL_endav && !PL_minus_c)
+	    PL_endav && !PL_minus_c) {
+	    PL_phase = PERL_PHASE_END;
 	    call_list(oldscope, PL_endav);
+	}
 #ifdef MYMALLOC
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
@@ -2295,8 +2308,10 @@ S_run_body(pTHX_ I32 oldscope)
 	}
 	if (PERLDB_SINGLE && PL_DBsingle)
 	    sv_setiv(PL_DBsingle, 1);
-	if (PL_initav)
+	if (PL_initav) {
+	    PL_phase = PERL_PHASE_INIT;
 	    call_list(oldscope, PL_initav);
+	}
 #ifdef PERL_DEBUG_READONLY_OPS
 	Perl_pending_Slabs_to_ro(aTHX);
 #endif
@@ -2304,6 +2319,8 @@ S_run_body(pTHX_ I32 oldscope)
 
     /* do it */
 
+    PL_phase = PERL_PHASE_RUN;
+
     if (PL_restartop) {
 	PL_restartjmpenv = NULL;
 	PL_op = PL_restartop;