This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[ID 20010801.039] perlre.pod message typo
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index b9a9111..91efa0f 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -149,7 +149,6 @@ void
 perl_construct(pTHXx)
 {
 #ifdef USE_THREADS
-    int i;
 #ifndef FAKE_THREADS
     struct perl_thread *thr = NULL;
 #endif /* FAKE_THREADS */
@@ -227,8 +226,8 @@ perl_construct(pTHXx)
         * space.  The other alternative would be to provide STDAUX and STDPRN
         * filehandles.
         */
-       (void)fclose(stdaux);
-       (void)fclose(stdprn);
+       (void)PerlIO_close(PerlIO_importFILE(stdaux, 0));
+       (void)PerlIO_close(PerlIO_importFILE(stdprn, 0));
 #endif
     }
 
@@ -284,7 +283,13 @@ perl_construct(pTHXx)
     PL_fdpid = newAV();                        /* for remembering popen pids by fd */
     PL_modglobal = newHV();            /* pointers to per-interpreter module globals */
     PL_errors = newSVpvn("",0);
-
+#ifdef USE_ITHREADS
+        PL_regex_padav = newAV();
+#endif
+#ifdef USE_REENTRANT_API
+    New(31337, PL_reentrant_buffer,1, REBUF);
+    New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+#endif
     ENTER;
 }
 
@@ -777,6 +782,11 @@ perl_destruct(pTHXx)
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
 
+#ifdef USE_REENTRANT_API
+    Safefree(PL_reentrant_buffer->tmbuff);
+    Safefree(PL_reentrant_buffer);
+#endif
+
     sv_free_arenas();
 
     /* As the absolutely last thing, free the non-arena SV for mess() */
@@ -817,14 +827,24 @@ perl_free(pTHXx)
 #if defined(PERL_OBJECT)
     PerlMem_free(this);
 #else
-#  if defined(WIN32)
+#  if defined(WIN32) || defined(NETWARE)
 #  if defined(PERL_IMPLICIT_SYS)
-    void *host = w32_internal_host;
-    if (PerlProc_lasthost()) {
+    #ifdef NETWARE
+               void *host = nw_internal_host;
+       #else
+               void *host = w32_internal_host;
+       #endif
+       #ifndef NETWARE
+       if (PerlProc_lasthost()) {
        PerlIO_cleanup();
-    }
+       }
+       #endif
     PerlMem_free(aTHXx);
-    win32_delete_internal_host(host);
+       #ifdef NETWARE
+               nw5_delete_internal_host(host);
+       #else
+               win32_delete_internal_host(host);
+       #endif
 #else
     PerlIO_cleanup();
     PerlMem_free(aTHXx);
@@ -1143,7 +1163,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
                sv_catpv(PL_Sv, "; \
 $\"=\"\\n    \"; \
-@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \
+@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; ");
+#ifdef __CYGWIN__
+               sv_catpv(PL_Sv,"\
+push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
+#endif
+               sv_catpv(PL_Sv, "\
 print \"  \\%ENV:\\n    @env\\n\" if @env; \
 print \"  \\@INC:\\n    @INC\\n\";");
            }
@@ -1297,6 +1322,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     av_store(comppadlist, 1, (SV*)PL_comppad);
     CvPADLIST(PL_compcv) = comppadlist;
 
+    boot_core_PerlIO();
     boot_core_UNIVERSAL();
 #ifndef PERL_MICRO
     boot_core_xsutils();
@@ -2022,7 +2048,7 @@ STATIC void
 S_usage(pTHX_ char *name)              /* XXX move this out into a module ? */
 {
     /* This message really ought to be max 23 lines.
-     * Removed -h because the user already knows that opton. Others? */
+     * Removed -h because the user already knows that option. Others? */
 
     static char *usage_msg[] = {
 "-0[octal]       specify record separator (\\0, if no argument)",
@@ -2344,7 +2370,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 #ifdef MPE
        PerlIO_printf(PerlIO_stdout(),
-                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-1999\n");
+                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2001\n");
 #endif
 #ifdef OEMVS
        PerlIO_printf(PerlIO_stdout(),
@@ -3126,7 +3152,8 @@ S_find_beginning(pTHX)
        if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
            Perl_croak(aTHX_ "No Perl script found in input\n");
 #endif
-       if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
+       s2 = s;
+       if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
            PerlIO_ungetc(PL_rsfp, '\n');               /* to keep line count right */
            PL_doextract = FALSE;
            while (*s && !(isSPACE (*s) || *s == '#')) s++;
@@ -3139,6 +3166,9 @@ S_find_beginning(pTHX)
                    while ((s = moreswitches(s)))
                        ;
            }
+#ifdef MACOS_TRADITIONAL
+           break;
+#endif
        }
     }
 }
@@ -3410,7 +3440,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            } /* else what? */
        }
 #endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
-       for (; *env; env++) {
+       if (env)
+         for (; *env; env++) {
            if (!(s = strchr(*env,'=')))
                continue;
            *s++ = '\0';
@@ -3420,7 +3451,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
            sv = newSVpv(s--,0);
            (void)hv_store(hv, *env, s - *env, sv, 0);
            *s = '=';
-       }
+         }
 #ifdef NEED_ENVIRON_DUP_FOR_MODIFY
        if (dup_env_base) {
            char **dup_env;
@@ -3430,9 +3461,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        }
 #endif /* NEED_ENVIRON_DUP_FOR_MODIFY */
 #endif /* USE_ENVIRON_ARRAY */
-#ifdef DYNAMIC_ENV_FETCH
-       HvNAME(hv) = savepv(ENV_HV_NAME);
-#endif
     }
     TAINT_NOT;
     if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))