[ID 19991104.005] modified hints file for UnixWare7 ( svr5)

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

diff --git a/perl.c b/perl.c
index 5eb8338..800e83b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -47,40 +47,42 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
 #endif
 
 #ifdef PERL_OBJECT
-CPerlObj*
-perl_alloc(struct IPerlMem* ipM, struct IPerlEnv* ipE,
-                struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
-                struct IPerlDir* ipD, struct IPerlSock* ipS,
-                struct IPerlProc* ipP)
-{
-    CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
-    if (pPerl != NULL)
-       pPerl->Init();
-
-    return pPerl;
-}
-#else
+#define perl_construct Perl_construct
+#define perl_parse     Perl_parse
+#define perl_run       Perl_run
+#define perl_destruct  Perl_destruct
+#define perl_free      Perl_free
+#endif
 
 #ifdef PERL_IMPLICIT_SYS
 PerlInterpreter *
-perl_alloc_using(struct IPerlMem* ipM, struct IPerlEnv* ipE,
+perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
+                struct IPerlMem* ipMP, struct IPerlEnv* ipE,
                 struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
                 struct IPerlDir* ipD, struct IPerlSock* ipS,
                 struct IPerlProc* ipP)
 {
     PerlInterpreter *my_perl;
-
+#ifdef PERL_OBJECT
+    my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
+                                                 ipLIO, ipD, ipS, ipP);
+    PERL_SET_INTERP(my_perl);
+#else
     /* New() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     PERL_SET_INTERP(my_perl);
     Zero(my_perl, 1, PerlInterpreter);
     PL_Mem = ipM;
+    PL_MemShared = ipMS;
+    PL_MemParse = ipMP;
     PL_Env = ipE;
     PL_StdIO = ipStd;
     PL_LIO = ipLIO;
     PL_Dir = ipD;
     PL_Sock = ipS;
     PL_Proc = ipP;
+#endif
+
     return my_perl;
 }
 #else
@@ -95,7 +97,6 @@ perl_alloc(void)
     return my_perl;
 }
 #endif /* PERL_IMPLICIT_SYS */
-#endif /* PERL_OBJECT */
 
 void
 perl_construct(pTHXx)
@@ -235,6 +236,9 @@ perl_destruct(pTHXx)
     dTHX;
 #endif /* USE_THREADS */
 
+    /* wait for all pseudo-forked children to finish */
+    PERL_WAIT_FOR_CHILDREN;
+
 #ifdef USE_THREADS
 #ifndef FAKE_THREADS
     /* Pass 1 on any remaining threads: detach joinables, join zombies */
@@ -1402,7 +1406,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            /* my_exit() was called */
            PL_curstash = PL_defstash;
            FREETMPS;
-           if (PL_statusvalue)
+           if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
                Perl_croak(aTHX_ "Callback called exit");
            my_exit_jump();
            /* NOTREACHED */
@@ -1526,7 +1530,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        /* my_exit() was called */
        PL_curstash = PL_defstash;
        FREETMPS;
-       if (PL_statusvalue)
+       if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
            Perl_croak(aTHX_ "Callback called exit");
        my_exit_jump();
        /* NOTREACHED */
@@ -1689,10 +1693,10 @@ Perl_moreswitches(pTHX_ char *s)
            my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
            s += strlen(s);
        }
-       if (!PL_perldb)
+       if (!PL_perldb) {
            PL_perldb = PERLDB_ALL;
-       if (!PL_debstash)
            init_debugger();
+       }
        return s;
     case 'D':
     {  
@@ -2086,6 +2090,7 @@ S_init_main_stash(pTHX)
     sv_setpvn(ERRSV, "", 0);
     PL_curstash = PL_defstash;
     CopSTASH_set(&PL_compiling, PL_defstash);
+    PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
     PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
     /* We must init $/ before switches are processed. */
     sv_setpvn(get_sv("/", TRUE), "\n", 1);
@@ -2644,7 +2649,6 @@ Perl_init_debugger(pTHX)
     dTHR;
     HV *ostash = PL_curstash;
 
-    PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
     PL_curstash = PL_debstash;
     PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(PL_dbargs);
@@ -2690,7 +2694,7 @@ Perl_init_stacks(pTHX)
     PL_markstack_ptr = PL_markstack;
     PL_markstack_max = PL_markstack + REASONABLE(32);
 
-    SET_MARKBASE;
+    SET_MARK_OFFSET;
 
     New(54,PL_scopestack,REASONABLE(32),I32);
     PL_scopestack_ix = 0;
@@ -2873,7 +2877,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     }
     TAINT_NOT;
     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
-       sv_setiv(GvSV(tmpgv), (IV)getpid());
+       sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
 }
 
 STATIC void
@@ -3165,7 +3169,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
            PL_curstash = PL_defstash;
            PL_curcop = &PL_compiling;
            CopLINE_set(PL_curcop, oldline);
-           if (PL_statusvalue) {
+           if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
                if (paramList == PL_beginav)
                    Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
                else