[win32] protect sortcop from C<sort { sort { ... } ... } ...>

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 0536829..52ad7ca 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -176,6 +176,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 #endif
     }
 
+    init_stacks(ARGS);
 #ifdef MULTIPLICITY
     I_REINIT;
     perl_destruct_level = 1; 
@@ -207,11 +208,11 @@ perl_construct(register PerlInterpreter *sv_interp)
     localpatches = local_patches;      /* For possible -v */
 #endif
 
-    PerlIO_init();      /* Hook to IO system */
+    PerlIO_init();                     /* Hook to IO system */
 
-    fdpid = newAV();   /* for remembering popen pids by fd */
+    fdpid = newAV();                   /* for remembering popen pids by fd */
+    modglobal = newHV();               /* pointers to per-interpreter module globals */
 
-    init_stacks(ARGS);
     DEBUG( {
        New(51,debname,128,char);
        New(52,debdelim,128,char);
@@ -327,6 +328,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
        op_free(main_root);
        main_root = Nullop;
     }
+    curcop = &compiling;
     main_start = Nullop;
     SvREFCNT_dec(main_cv);
     main_cv = Nullcv;
@@ -350,6 +352,12 @@ perl_destruct(register PerlInterpreter *sv_interp)
     SvREFCNT_dec(parsehook);
     parsehook = Nullsv;
 
+    /* call exit list functions */
+    while (exitlistlen-- > 0)
+       exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr);
+
+    Safefree(exitlist);
+
     if (destruct_level == 0){
 
        DEBUG_P(debprofdump());
@@ -430,10 +438,6 @@ perl_destruct(register PerlInterpreter *sv_interp)
     endav = Nullav;
     initav = Nullav;
 
-    /* temp stack during pp_sort() */
-    SvREFCNT_dec(sortstack);
-    sortstack = Nullav;
-
     /* shortcuts just get cleared */
     envgv = Nullgv;
     siggv = Nullgv;
@@ -555,6 +559,15 @@ perl_free(PerlInterpreter *sv_interp)
     Safefree(sv_interp);
 }
 
+void
+perl_atexit(void (*fn) (void *), void *ptr)
+{
+    Renew(exitlist, exitlistlen+1, PerlExitListEntry);
+    exitlist[exitlistlen].fn = fn;
+    exitlist[exitlistlen].ptr = ptr;
+    ++exitlistlen;
+}
+
 int
 perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
 {
@@ -977,7 +990,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 int
 perl_run(PerlInterpreter *sv_interp)
 {
-    dTHR;
+    dSP;
     I32 oldscope;
     dJMPENV;
     int ret;
@@ -1013,10 +1026,7 @@ perl_run(PerlInterpreter *sv_interp)
            JMPENV_POP;
            return 1;
        }
-       if (curstack != mainstack) {
-           dSP;
-           SWITCHSTACK(curstack, mainstack);
-       }
+       POPSTACK_TO(mainstack);
        break;
     }
 
@@ -2432,19 +2442,16 @@ init_debugger(void)
 void
 init_stacks(ARGSproto)
 {
-    curstack = newAV();
+    /* start with 128-item stack and 8K cxstack */
+    curstackinfo = new_stackinfo(REASONABLE(128),
+                                REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
+    curstackinfo->si_type = SI_MAIN;
+    curstack = curstackinfo->si_stack;
     mainstack = curstack;              /* remember in case we switch stacks */
-    AvREAL_off(curstack);              /* not a real array */
-    av_extend(curstack,REASONABLE(127));
 
     stack_base = AvARRAY(curstack);
     stack_sp = stack_base;
-    stack_max = stack_base + REASONABLE(127);
-
-    /* Use most of 8K. */
-    cxstack_max = REASONABLE(8192 / sizeof(PERL_CONTEXT) - 2);
-    New(50,cxstack,cxstack_max + 1,PERL_CONTEXT);
-    cxstack_ix = -1;
+    stack_max = stack_base + AvMAX(curstack);
 
     New(50,tmps_stack,REASONABLE(128),SV*);
     tmps_floor = -1;
@@ -2464,6 +2471,8 @@ init_stacks(ARGSproto)
        markstack_max = markstack + REASONABLE(32);
     }
 
+    SET_MARKBASE;
+
     if (scopestack) {
        scopestack_ix = 0;
     } else {
@@ -2495,7 +2504,15 @@ static void
 nuke_stacks(void)
 {
     dTHR;
-    Safefree(cxstack);
+    while (curstackinfo->si_next)
+       curstackinfo = curstackinfo->si_next;
+    while (curstackinfo) {
+       PERL_SI *p = curstackinfo->si_prev;
+       /* curstackinfo->si_stack got nuked by sv_free_arenas() */
+       Safefree(curstackinfo->si_cxstack);
+       Safefree(curstackinfo);
+       curstackinfo = p;
+    }
     Safefree(tmps_stack);
     DEBUG( {
        Safefree(debname);
@@ -2978,7 +2995,7 @@ my_failure_exit(void)
 static void
 my_exit_jump(void)
 {
-    dTHR;
+    dSP;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -2993,6 +3010,7 @@ my_exit_jump(void)
        e_tmpname = Nullch;
     }
 
+    POPSTACK_TO(mainstack);
     if (cxstack_ix >= 0) {
        if (cxstack_ix > 0)
            dounwind(0);