projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
phase 1 of somewhat major rearrangement of PERL_OBJECT stuff
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 26653a3..388dd8b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -92,7 +92,7 @@ perl_alloc(void)
 
 void
 #ifdef PERL_OBJECT
-CPerlObj::perl_construct(void)
+perl_construct(void)
 #else
 perl_construct(register PerlInterpreter *sv_interp)
 #endif
@@ -138,9 +138,13 @@ perl_construct(register PerlInterpreter *sv_interp)
        MUTEX_INIT(&PL_svref_mutex);
 #endif /* EMULATE_ATOMIC_REFCOUNTS */
        
+       MUTEX_INIT(&PL_cred_mutex);
+
        thr = init_main_thread();
 #endif /* USE_THREADS */
 
+       PL_curcop = &PL_compiling;      /* needed by ckWARN, right away */
+
        PL_linestr = NEWSV(65,79);
        sv_upgrade(PL_linestr,SVt_PVIV);
 
@@ -231,7 +235,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 
 void
 #ifdef PERL_OBJECT
-CPerlObj::perl_destruct(void)
+perl_destruct(void)
 #else
 perl_destruct(register PerlInterpreter *sv_interp)
 #endif
@@ -403,7 +407,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
     PL_minus_a      = FALSE;
     PL_minus_F      = FALSE;
     PL_doswitches   = FALSE;
-    PL_dowarn       = FALSE;
+    PL_dowarn       = G_WARN_OFF;
     PL_doextract    = FALSE;
     PL_sawampersand = FALSE;   /* must save all match strings */
     PL_sawstudy     = FALSE;   /* do fbm_instr on all strings */
@@ -551,8 +555,10 @@ perl_destruct(register PerlInterpreter *sv_interp)
     
     DEBUG_P(debprofdump());
 #ifdef USE_THREADS
+    MUTEX_DESTROY(&PL_strtab_mutex);
     MUTEX_DESTROY(&PL_sv_mutex);
     MUTEX_DESTROY(&PL_eval_mutex);
+    MUTEX_DESTROY(&PL_cred_mutex);
     COND_DESTROY(&PL_eval_cond);
 
     /* As the penultimate thing, free the non-arena SV for thrsv */
@@ -587,7 +593,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
 
 void
 #ifdef PERL_OBJECT
-CPerlObj::perl_free(void)
+perl_free(void)
 #else
 perl_free(PerlInterpreter *sv_interp)
 #endif
@@ -603,7 +609,7 @@ perl_free(PerlInterpreter *sv_interp)
 
 void
 #ifdef PERL_OBJECT
-CPerlObj::perl_atexit(void (*fn) (CPerlObj*,void *), void *ptr)
+perl_atexit(void (*fn) (CPerlObj*,void *), void *ptr)
 #else
 perl_atexit(void (*fn) (void *), void *ptr)
 #endif
@@ -616,7 +622,7 @@ perl_atexit(void (*fn) (void *), void *ptr)
 
 int
 #ifdef PERL_OBJECT
-CPerlObj::perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env)
+perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env)
 #else
 perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
 #endif
@@ -680,6 +686,7 @@ setuid perl scripts securely.\n");
 
     time(&PL_basetime);
     oldscope = PL_scopestack_ix;
+    PL_dowarn = G_WARN_OFF;
 
     JMPENV_PUSH(ret);
     switch (ret) {
@@ -737,6 +744,8 @@ setuid perl scripts securely.\n");
        case 'u':
        case 'U':
        case 'v':
+       case 'W':
+       case 'X':
        case 'w':
            if (s = moreswitches(s))
                goto reswitch;
@@ -804,14 +813,11 @@ setuid perl scripts securely.\n");
 #else
                sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
 #endif
-#if defined(DEBUGGING) || defined(NO_EMBED) || defined(MULTIPLICITY)
+#if defined(DEBUGGING) || defined(MULTIPLICITY)
                sv_catpv(PL_Sv,"\"  Compile-time options:");
 #  ifdef DEBUGGING
                sv_catpv(PL_Sv," DEBUGGING");
 #  endif
-#  ifdef NO_EMBED
-               sv_catpv(PL_Sv," NO_EMBED");
-#  endif
 #  ifdef MULTIPLICITY
                sv_catpv(PL_Sv," MULTIPLICITY");
 #  endif
@@ -990,7 +996,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     if (PL_do_undump)
        my_unexec();
 
-    if (PL_dowarn)
+    if (ckWARN(WARN_ONCE))
        gv_check(PL_defstash);
 
     LEAVE;
@@ -1009,7 +1015,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
 int
 #ifdef PERL_OBJECT
-CPerlObj::perl_run(void)
+perl_run(void)
 #else
 perl_run(PerlInterpreter *sv_interp)
 #endif
@@ -1737,6 +1743,15 @@ moreswitches(char *s)
 #ifdef OEMVS
        printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n");
 #endif
+#ifdef __VOS__
+       printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1998\n");
+#endif
+#ifdef __OPEN_VM
+       printf("VM/ESA port by Neale Ferguson, 1998\n");
+#endif
+#ifdef POSIX_BC
+       printf("BS2000 (POSIX) port by Start Amadeus GmbH, 1998\n");
+#endif
 #ifdef BINARY_BUILD_NOTICE
        BINARY_BUILD_NOTICE;
 #endif
@@ -1748,7 +1763,18 @@ this system using `man perl' or `perldoc perl'.  If you have access to the\n\
 Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
        PerlProc_exit(0);
     case 'w':
-       PL_dowarn = TRUE;
+       if (! (PL_dowarn & G_WARN_ALL_MASK))
+           PL_dowarn |= G_WARN_ON; 
+       s++;
+       return s;
+    case 'W':
+       PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; 
+       PL_compiling.cop_warnings = WARN_ALL ;
+       s++;
+       return s;
+    case 'X':
+       PL_dowarn = G_WARN_ALL_OFF; 
+       PL_compiling.cop_warnings = WARN_NONE ;
        s++;
        return s;
     case '*':
@@ -1758,7 +1784,7 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
        break;
     case '-':
     case 0:
-#ifdef WIN32
+#if defined(WIN32) || !defined(PERL_STRICT_CR)
     case '\r':
 #endif
     case '\n':
@@ -1886,6 +1912,9 @@ init_main_stash(void)
        about not iterating on it, and not adding tie magic to it.
        It is properly deallocated in perl_destruct() */
     PL_strtab = newHV();
+#ifdef USE_THREADS
+    MUTEX_INIT(&PL_strtab_mutex);
+#endif
     HvSHAREKEYS_off(PL_strtab);                        /* mandatory */
     hv_ksplit(PL_strtab, 512);
     
@@ -1913,7 +1942,7 @@ init_main_stash(void)
     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(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
+    sv_setpvn(perl_get_sv("/", TRUE), "\n", 1);
 }
 
 STATIC void
@@ -1982,6 +2011,21 @@ sed %s -e \"/^[^#]/b\" \
  %s | %_ -C %_ %s",
          (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
 #else
+#  ifdef __OPEN_VM
+       sv_setpvf(cmd, "\
+%s %s -e '/^[^#]/b' \
+ -e '/^#[      ]*include[      ]/b' \
+ -e '/^#[      ]*define[       ]/b' \
+ -e '/^#[      ]*if[   ]/b' \
+ -e '/^#[      ]*ifdef[        ]/b' \
+ -e '/^#[      ]*ifndef[       ]/b' \
+ -e '/^#[      ]*else/b' \
+ -e '/^#[      ]*elif[         ]/b' \
+ -e '/^#[      ]*undef[        ]/b' \
+ -e '/^#[      ]*endif/b' \
+ -e 's/^[      ]*#.*//' \
+ %s | %_ %_ %s",
+#  else
        sv_setpvf(cmd, "\
 %s %s -e '/^[^#]/b' \
  -e '/^#[      ]*include[      ]/b' \
@@ -1995,6 +2039,7 @@ sed %s -e \"/^[^#]/b\" \
  -e '/^#[      ]*endif/b' \
  -e 's/^[      ]*#.*//' \
  %s | %_ -C %_ %s",
+#  endif
 #ifdef LOC_SED
          LOC_SED,
 #else
@@ -2971,8 +3016,10 @@ read_e_script(int idx, SV *buf_sv, int maxlen)
     p  = SvPVX(PL_e_script);
     nl = strchr(p, '\n');
     nl = (nl) ? nl+1 : SvEND(PL_e_script);
-    if (nl-p == 0)
+    if (nl-p == 0) {
+       filter_del(read_e_script);
        return 0;
+    }
     sv_catpvn(buf_sv, p, nl-p);
     sv_chop(PL_e_script, nl);
     return 1;
Unnamed repository; edit this file to name it for gitweb.