This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl_free() should use PerlMem_free()
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 3a3505d..a5816a9 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -61,7 +61,8 @@ perl_alloc(void)
 {
     PerlInterpreter *my_perl;
 
-    New(53, my_perl, 1, PerlInterpreter);
+    /* New() needs interpreter, so call malloc() instead */
+    my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
     PERL_SET_INTERP(my_perl);
     return my_perl;
 }
@@ -81,6 +82,14 @@ perl_construct(pTHXx)
     Zero(my_perl, 1, PerlInterpreter);
 #endif
 
+#ifdef MULTIPLICITY
+    init_interp();
+    PL_perl_destruct_level = 1; 
+#else
+   if (PL_perl_destruct_level > 0)
+       init_interp();
+#endif
+
    /* Init the real globals (and main thread)? */
     if (!PL_linestr) {
 #ifdef USE_THREADS
@@ -158,13 +167,6 @@ perl_construct(pTHXx)
     PL_rs = SvREFCNT_inc(PL_nrs);
 
     init_stacks();
-#ifdef MULTIPLICITY
-    init_interp();
-    PL_perl_destruct_level = 1; 
-#else
-   if (PL_perl_destruct_level > 0)
-       init_interp();
-#endif
 
     init_ids();
     PL_lex_state = LEX_NOTPARSING;
@@ -507,6 +509,7 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
        Safefree(PL_reg_curpm);
+    Safefree(PL_reg_poscache);
     Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
     Safefree(PL_op_mask);
     nuke_stacks();
@@ -557,9 +560,9 @@ void
 perl_free(pTHXx)
 {
 #if defined(PERL_OBJECT)
-    Safefree(this);
+    PerlMem_free(this);
 #else
-    Safefree(aTHXx);
+    PerlMem_free(aTHXx);
 #endif
 }
 
@@ -1224,10 +1227,16 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        PL_op->op_private |= OPpENTERSUB_DB;
 
     if (!(flags & G_EVAL)) {
-       CATCH_SET(TRUE);
+        /* G_NOCATCH is a hack for perl_vdie using this path to call
+          a __DIE__ handler */
+        if (!(flags & G_NOCATCH)) {
+           CATCH_SET(TRUE);
+       }
        call_xbody((OP*)&myop, FALSE);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
-       CATCH_SET(FALSE);
+        if (!(flags & G_NOCATCH)) {
+           CATCH_SET(FALSE);
+       }
     }
     else {
        cLOGOP->op_other = PL_op;
@@ -1878,8 +1887,13 @@ S_init_interp(pTHX)
 #    define PERLVAR(var,type)
 #    define PERLVARA(var,n,type)
 #    if defined(PERL_IMPLICIT_CONTEXT)
-#      define PERLVARI(var,type,init)  my_perl->var = init;
-#      define PERLVARIC(var,type,init) my_perl->var = init;
+#      if defined(USE_THREADS)
+#        define PERLVARI(var,type,init)                PERL_GET_INTERP->var = init;
+#        define PERLVARIC(var,type,init)       PERL_GET_INTERP->var = init;
+#      else /* !USE_THREADS */
+#        define PERLVARI(var,type,init)                aTHX->var = init;
+#        define PERLVARIC(var,type,init)       aTHX->var = init;
+#      endif /* USE_THREADS */
 #    else
 #      define PERLVARI(var,type,init)  PERL_GET_INTERP->var = init;
 #      define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
@@ -2458,10 +2472,10 @@ S_find_beginning(pTHX)
 STATIC void
 S_init_ids(pTHX)
 {
-    PL_uid = (int)PerlProc_getuid();
-    PL_euid = (int)PerlProc_geteuid();
-    PL_gid = (int)PerlProc_getgid();
-    PL_egid = (int)PerlProc_getegid();
+    PL_uid = PerlProc_getuid();
+    PL_euid = PerlProc_geteuid();
+    PL_gid = PerlProc_getgid();
+    PL_egid = PerlProc_getegid();
 #ifdef VMS
     PL_uid |= PL_gid << 16;
     PL_euid |= PL_egid << 16;