} STMT_END
#else
# if defined(USE_ITHREADS)
+
+/* this is called in parent before the fork() */
+void
+Perl_atfork_lock(void)
+{
+ /* locks must be held in locking order (if any) */
+#ifdef MYMALLOC
+ MUTEX_LOCK(&PL_malloc_mutex);
+#endif
+ OP_REFCNT_LOCK;
+}
+
+/* this is called in both parent and child after the fork() */
+void
+Perl_atfork_unlock(void)
+{
+ /* locks must be released in same order as in S_atfork_lock() */
+#ifdef MYMALLOC
+ MUTEX_UNLOCK(&PL_malloc_mutex);
+#endif
+ OP_REFCNT_UNLOCK;
+}
+
# define INIT_TLS_AND_INTERP \
STMT_START { \
if (!PL_curinterp) { \
perl_construct(pTHXx)
{
#ifdef USE_THREADS
- int i;
#ifndef FAKE_THREADS
struct perl_thread *thr = NULL;
#endif /* FAKE_THREADS */
* 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
}
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;
}
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() */
#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);
#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\";");
}
av_store(comppadlist, 1, (SV*)PL_comppad);
CvPADLIST(PL_compcv) = comppadlist;
+ boot_core_PerlIO();
boot_core_UNIVERSAL();
#ifndef PERL_MICRO
boot_core_xsutils();
{
dSP;
UNOP myop; /* fake syntax tree node */
- I32 oldmark = SP - PL_stack_base;
+ volatile I32 oldmark = SP - PL_stack_base;
volatile I32 retval = 0;
I32 oldscope;
int ret;
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)",
#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(),
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++;
while ((s = moreswitches(s)))
;
}
+#ifdef MACOS_TRADITIONAL
+ break;
+#endif
}
}
}
}
#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)))