projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
[PATCH 5.004_60] Fix to MM_VMS.PM
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 308cf4d..0c52557 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1,6 +1,6 @@
 /*    perl.c
  *
- *    Copyright (c) 1987-1997 Larry Wall
+ *    Copyright (c) 1987-1998 Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -83,19 +83,6 @@ static void validate_suid _((char *, char*));
 
 static int fdscript = -1;
 
-#if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
-#include <asm/sigcontext.h>
-static void
-catch_sigsegv(int signo, struct sigcontext_struct sc)
-{
-    PerlProc_signal(SIGSEGV, SIG_DFL);
-    fprintf(stderr, "Segmentation fault dereferencing 0x%lx\n"
-                   "return_address = 0x%lx, eip = 0x%lx\n",
-                   sc.cr2, __builtin_return_address(0), sc.eip);
-    fprintf(stderr, "thread = 0x%lx\n", (unsigned long)THR); 
-}
-#endif
-
 PerlInterpreter *
 perl_alloc(void)
 {
@@ -311,7 +298,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
 #ifdef DEBUGGING
     {
        char *s;
-       if (s = PerlENV_getenv("PERL_DESTRUCT_LEVEL")) {
+       if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) {
            int i = atoi(s);
            if (destruct_level < i)
                destruct_level = i;
@@ -821,7 +808,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     }
   switch_end:
 
-    if (!tainting && (s = PerlENV_getenv("PERL5OPT"))) {
+    if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
        while (s && *s) {
            while (isSPACE(*s))
                s++;
@@ -901,10 +888,6 @@ print \"  \\@INC:\\n    @INC\\n\";");
     init_os_extras();
 #endif
 
-#if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
-    DEBUG_L(PerlProc_signal(SIGSEGV, (void(*)(int))catch_sigsegv););
-#endif
-
     init_predump_symbols();
     if (!do_undump)
        init_postdump_symbols(argc,argv,env);
@@ -935,11 +918,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     /* now that script is parsed, we can modify record separator */
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
-#ifdef USE_THREADS
-    sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs); 
-#else
-    sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-#endif /* USE_THREADS */
+    sv_setsv(perl_get_sv("/", TRUE), rs);
     if (do_undump)
        my_unexec();
 
@@ -950,7 +929,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     FREETMPS;
 
 #ifdef MYMALLOC
-    if ((s=PerlENV_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+    if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
        dump_mstats("after compilation:");
 #endif
 
@@ -987,7 +966,7 @@ perl_run(PerlInterpreter *sv_interp)
        if (endav)
            call_list(oldscope, endav);
 #ifdef MYMALLOC
-       if (PerlENV_getenv("PERL_DEBUG_MSTATS"))
+       if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
            dump_mstats("after execution:  ");
 #endif
        JMPENV_POP;
@@ -1054,7 +1033,7 @@ perl_get_sv(char *name, I32 create)
        PADOFFSET tmp = find_threadsv(name);
        if (tmp != NOT_IN_PAD) {
            dTHR;
-           return *av_fetch(thr->threadsv, tmp, FALSE);
+           return THREADSV(tmp);
        }
     }
 #endif /* USE_THREADS */
@@ -1656,17 +1635,17 @@ moreswitches(char *s)
                LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
 #endif
 
-       printf("\n\nCopyright 1987-1997, Larry Wall\n");
+       printf("\n\nCopyright 1987-1998, Larry Wall\n");
 #ifdef MSDOS
        printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
 #endif
 #ifdef DJGPP
        printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
-       printf("djgpp v2 port (perl5004) by Laszlo Molnar, 1997\n");
+       printf("djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1998\n");
 #endif
 #ifdef OS2
        printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
-           "Version 5 port Copyright (c) 1994-1997, Andreas Kaiser, Ilya Zakharevich\n");
+           "Version 5 port Copyright (c) 1994-1998, Andreas Kaiser, Ilya Zakharevich\n");
 #endif
 #ifdef atarist
        printf("atariST series port, ++jrb  bammi@cadence.com\n");
@@ -1776,16 +1755,8 @@ init_main_stash(void)
     sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
 }
 
-#ifdef CAN_PROTOTYPE
 static void
 open_script(char *scriptname, bool dosearch, SV *sv)
-#else
-static void
-open_script(scriptname,dosearch,sv)
-char *scriptname;
-bool dosearch;
-SV *sv;
-#endif
 {
     dTHR;
     char *xfound = Nullch;
@@ -1903,7 +1874,7 @@ SV *sv;
 #ifdef DOSISH
                 && !strchr(scriptname, '\\')
 #endif
-                && (s = PerlENV_getenv("PATH"))) {
+                && (s = PerlEnv_getenv("PATH"))) {
        bool seen_dot = 0;
        
        bufend = s + strlen(s);
@@ -2509,12 +2480,7 @@ init_predump_symbols(void)
     GV *tmpgv;
     GV *othergv;
 
-#ifdef USE_THREADS
-    sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1);
-#else
-    sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
-#endif /* USE_THREADS */
-
+    sv_setpvn(perl_get_sv("\"", TRUE), " ", 1);
     stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(stdingv);
     IoIFP(GvIOp(stdingv)) = PerlIO_stdin();
@@ -2618,7 +2584,7 @@ init_postdump_symbols(register int argc, register char **argv, register char **e
            *s = '=';
 #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
            /* Sins of the RTL. See note in my_setenv(). */
-           (void)PerlENV_putenv(savepv(*env));
+           (void)PerlEnv_putenv(savepv(*env));
 #endif
        }
 #endif
@@ -2637,11 +2603,11 @@ init_perllib(void)
     char *s;
     if (!tainting) {
 #ifndef VMS
-       s = PerlENV_getenv("PERL5LIB");
+       s = PerlEnv_getenv("PERL5LIB");
        if (s)
            incpush(s, TRUE);
        else
-           incpush(PerlENV_getenv("PERLLIB"), FALSE);
+           incpush(PerlEnv_getenv("PERLLIB"), FALSE);
 #else /* VMS */
        /* Treat PERL5?LIB as a possible search list logical name -- the
         * "natural" VMS idiom for a Unix path string.  We allow each
@@ -2657,7 +2623,7 @@ init_perllib(void)
     }
 
 /* Use the ~-expanded versions of APPLLIB (undocumented),
-    ARCHLIB PRIVLIB SITEARCH SITELIB and OLDARCHLIB
+    ARCHLIB PRIVLIB SITEARCH and SITELIB 
 */
 #ifdef APPLLIB_EXP
     incpush(APPLLIB_EXP, FALSE);
@@ -2677,10 +2643,6 @@ init_perllib(void)
 #ifdef SITELIB_EXP
     incpush(SITELIB_EXP, FALSE);
 #endif
-#ifdef OLDARCHLIB_EXP  /* 5.00[01] compatibility */
-    incpush(OLDARCHLIB_EXP, FALSE);
-#endif
-    
     if (!tainting)
        incpush(".", FALSE);
 }
@@ -2708,7 +2670,7 @@ incpush(char *p, int addsubdirs)
        return;
 
     if (addsubdirs) {
-       subdir = newSV(0);
+       subdir = NEWSV(55,0);
        if (!archpat_auto) {
            STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel)
                          + sizeof("//auto"));
@@ -2724,7 +2686,7 @@ incpush(char *p, int addsubdirs)
 
     /* Break at all separators */
     while (p && *p) {
-       SV *libdir = newSV(0);
+       SV *libdir = NEWSV(55,0);
        char *s;
 
        /* skip any consecutive separators */
@@ -2799,6 +2761,7 @@ init_main_thread()
     curcop = &compiling;
     thr->cvcache = newHV();
     thr->threadsv = newAV();
+    /* thr->threadsvp is set when find_threadsv is called */
     thr->specific = newAV();
     thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
@@ -2847,6 +2810,7 @@ init_main_thread()
     sv_setpvn(bodytarget, "", 0);
     formtarget = bodytarget;
     thr->errsv = newSVpv("", 0);
+    (void) find_threadsv("@"); /* Ensure $@ is initialised early */
     return thr;
 }
 #endif /* USE_THREADS */
Unnamed repository; edit this file to name it for gitweb.