# endif /* EMULATE_ATOMIC_REFCOUNTS */
MUTEX_INIT(&PL_cred_mutex);
+ MUTEX_INIT(&PL_sv_lock_mutex);
+ MUTEX_INIT(&PL_fdpid_mutex);
thr = init_main_thread();
#endif /* USE_THREADS */
DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: armageddon has arrived\n"));
MUTEX_DESTROY(&PL_threads_mutex);
COND_DESTROY(&PL_nthreads_cond);
+ PL_nthreads--;
#endif /* !defined(FAKE_THREADS) */
#endif /* USE_THREADS */
if (!specialWARN(PL_compiling.cop_warnings))
SvREFCNT_dec(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = Nullsv;
-#ifndef USE_ITHREADS
+#ifdef USE_ITHREADS
+ Safefree(CopFILE(&PL_compiling));
+ CopFILE(&PL_compiling) = Nullch;
+ Safefree(CopSTASHPV(&PL_compiling));
+#else
SvREFCNT_dec(CopFILEGV(&PL_compiling));
- CopFILEGV_set(&PL_compiling, Nullgv);
+ CopFILEGV(&PL_compiling) = Nullgv;
+ /* cop_stash is not refcounted */
#endif
/* Prepare to destruct main symbol table. */
SvREFCNT_dec(PL_fdpid); /* needed in io_close() */
PL_fdpid = Nullav;
+#ifdef HAVE_INTERP_INTERN
+ sys_intern_clear();
+#endif
+
/* Destruct the global string table. */
{
/* Yell and reset the HeVAL() slots that are still holding refcounts,
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
- sv_free_arenas();
-
- /* No SVs have survived, need to clean out */
Safefree(PL_origfilename);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
Safefree(PL_reg_poscache);
Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
Safefree(PL_op_mask);
+ Safefree(PL_psig_ptr);
+ Safefree(PL_psig_name);
nuke_stacks();
PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
MUTEX_DESTROY(&PL_sv_mutex);
MUTEX_DESTROY(&PL_eval_mutex);
MUTEX_DESTROY(&PL_cred_mutex);
+ MUTEX_DESTROY(&PL_fdpid_mutex);
COND_DESTROY(&PL_eval_cond);
#ifdef EMULATE_ATOMIC_REFCOUNTS
MUTEX_DESTROY(&PL_svref_mutex);
PL_thrsv = Nullsv;
#endif /* USE_THREADS */
+ sv_free_arenas();
+
/* As the absolutely last thing, free the non-arena SV for mess() */
if (PL_mess_sv) {
PL_origargv = argv;
PL_origargc = argc;
-#ifndef VMS /* VMS doesn't have environ array */
+#if !defined( VMS) && !defined(EPOC) /* VMS doesn't have environ array */
PL_origenviron = environ;
#endif
validate_suid(validarg, scriptname,fdscript);
+#ifndef PERL_MICRO
#if defined(SIGCHLD) || defined(SIGCLD)
{
#ifndef SIGCHLD
}
}
#endif
+#endif
#ifdef MACOS_TRADITIONAL
if (PL_doextract || gMacPerl_AlwaysExtract) {
if (xsinit)
(*xsinit)(aTHXo); /* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__)
+#ifndef PERL_MICRO
+#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC)
init_os_extras();
#endif
+#endif
#ifdef USE_SOCKS
+# ifdef HAS_SOCKS5_INIT
+ socks5_init(argv[0]);
+# else
SOCKSinit(argv[0]);
+# endif
#endif
init_predump_symbols();
I32
Perl_call_sv(pTHX_ SV *sv, I32 flags)
-
/* See G_* flags in cop.h */
{
dSP;
method_op.op_next = PL_op;
method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
- PL_op = &method_op;
+ PL_op = (OP*)&method_op;
}
if (!(flags & G_EVAL)) {
CATCH_SET(oldcatch);
}
else {
- cLOGOP->op_other = PL_op;
+ myop.op_other = (OP*)&myop;
PL_markstack_ptr--;
/* we're trying to emulate pp_entertry() here */
{
if (PL_op == myop) {
if (is_eval)
- PL_op = Perl_pp_entereval(aTHX);
+ PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */
else
- PL_op = Perl_pp_entersub(aTHX);
+ PL_op = Perl_pp_entersub(aTHX); /* this does */
}
if (PL_op)
CALLRUNOPS(aTHX);
dSP;
SV* sv = newSVpv(p, 0);
- PUSHMARK(SP);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
case 'd':
forbid_setid("-d");
s++;
- if (*s == ':' || *s == '=') {
- my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
+ /* The following permits -d:Mod to accepts arguments following an =
+ in the fashion that -MSome::Mod does. */
+ if (*s == ':' || *s == '=') {
+ char *start;
+ SV *sv;
+ sv = newSVpv("use Devel::", 0);
+ start = ++s;
+ /* We now allow -d:Module=Foo,Bar */
+ while(isALNUM(*s) || *s==':') ++s;
+ if (*s != '=')
+ sv_catpv(sv, start);
+ else {
+ sv_catpvn(sv, start, s-start);
+ sv_catpv(sv, " split(/,/,q{");
+ sv_catpv(sv, ++s);
+ sv_catpv(sv, "})");
+ }
s += strlen(s);
+ my_setenv("PERL5DB", SvPV(sv, PL_na));
}
if (!PL_perldb) {
PL_perldb = PERLDB_ALL;
return s;
case 'v':
PerlIO_printf(PerlIO_stdout(),
- Perl_form(aTHX_ "\nThis is perl, v%vd built for %s",
+ Perl_form(aTHX_ "\nThis is perl, v%"VDf" built for %s",
PL_patchlevel, ARCHNAME));
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
PerlIO_printf(PerlIO_stdout(),
"\n\nCopyright 1987-2000, Larry Wall\n");
+#ifdef MACOS_TRADITIONAL
+ PerlIO_printf(PerlIO_stdout(),
+ "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n");
+#endif
#ifdef MSDOS
PerlIO_printf(PerlIO_stdout(),
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
PerlIO_printf(PerlIO_stdout(),
"\n\
Perl may be copied only under the terms of either the Artistic License or the\n\
-GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n\
+GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
Complete documentation for Perl, including FAQ lists, should be found on\n\
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");
}
}
+#ifdef USE_ITHREADS
+ Safefree(CopFILE(PL_curcop));
+#else
+ SvREFCNT_dec(CopFILEGV(PL_curcop));
+#endif
CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
(void)PerlIO_close(PL_rsfp);
- if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */
- PerlIO_printf(PL_rsfp,
-"User %"Uid_t_f" tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
-(Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n",
- PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
- (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
- CopFILE(PL_curcop),
- PL_statbuf.st_uid, PL_statbuf.st_gid);
- (void)PerlProc_pclose(PL_rsfp);
- }
Perl_croak(aTHX_ "Permission denied\n");
}
if (
}
if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)))
#ifdef OS2
- sv_setpv(GvSV(tmpgv), os2_execname());
+ sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
#else
sv_setpv(GvSV(tmpgv),PL_origargv[0]);
#endif
#endif /* MACOS_TRADITIONAL */
}
-#if defined(DOSISH)
+#if defined(DOSISH) || defined(EPOC)
# define PERLLIB_SEP ';'
#else
# if defined(VMS)
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
- SAVEFREESV(cv);
+ if ((PL_minus_c & 0x10) && (paramList == PL_beginav)) {
+ /* save PL_beginav for compiler */
+ if (! PL_beginav_save)
+ PL_beginav_save = newAV();
+ av_push(PL_beginav_save, (SV*)cv);
+ } else {
+ SAVEFREESV(cv);
+ }
#ifdef PERL_FLEXIBLE_EXCEPTIONS
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
#else
projects / p5sagit/p5-mst-13.2.git / blobdiff