Safefree(PL_reg_poscache);
free_tied_hv_pool();
Safefree(PL_op_mask);
- Safefree(PL_psig_ptr);
- PL_psig_ptr = (SV**)NULL;
Safefree(PL_psig_name);
PL_psig_name = (SV**)NULL;
- Safefree(PL_bitcount);
- PL_bitcount = NULL;
+ PL_psig_ptr = (SV**)NULL;
Safefree(PL_psig_pend);
PL_psig_pend = (int*)NULL;
+ {
+ /* We need to NULL PL_psig_pend first, so that
+ signal handlers know not to use it */
+ int *psig_save = PL_psig_pend;
+ PL_psig_pend = (int*)NULL;
+ Safefree(psig_save);
+ }
PL_formfeed = NULL;
nuke_stacks();
PL_tainting = FALSE;
char **argv = PL_origargv;
const char *scriptname = NULL;
VOL bool dosearch = FALSE;
- register SV *sv;
register char c;
const char *cddir = NULL;
#ifdef USE_SITECUSTOMIZE
SvGROW(linestr_sv, 80);
sv_setpvs(linestr_sv,"");
- sv = newSVpvs(""); /* first used for -I flags */
- SAVEFREESV(sv);
init_main_stash();
{
PL_minus_E = TRUE;
/* FALL THROUGH */
case 'e':
-#ifdef MACOS_TRADITIONAL
- /* ignore -e for Dev:Pseudo argument */
- if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
- break;
-#endif
forbid_setid('e', FALSE);
if (!PL_e_script) {
PL_e_script = newSVpvs("");
if (s && *s) {
STRLEN len = strlen(s);
incpush(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
- sv_catpvs(sv, "-I");
- sv_catpvn(sv, s, len);
- sv_catpvs(sv, " ");
}
else
Perl_croak(aTHX_ "No directory specified for -I");
# ifdef NO_MATHOMS
" NO_MATHOMS"
# endif
+# ifdef PERL_DISABLE_PMC
+ " PERL_DISABLE_PMC"
+# endif
# ifdef PERL_DONT_CREATE_GVSV
" PERL_DONT_CREATE_GVSV"
# endif
# ifdef PERL_MEM_LOG
" PERL_MEM_LOG"
# endif
-# ifdef PERL_MEM_LOG_ENV
- " PERL_MEM_LOG_ENV"
-# endif
-# ifdef PERL_MEM_LOG_ENV_FD
- " PERL_MEM_LOG_ENV_FD"
-# endif
-# ifdef PERL_MEM_LOG_STDERR
- " PERL_MEM_LOG_STDERR"
-# endif
-# ifdef PERL_MEM_LOG_TIMESTAMP
- " PERL_MEM_LOG_TIMESTAMP"
+# ifdef PERL_MEM_LOG_NOIMPL
+ " PERL_MEM_LOG_NOIMPL"
# endif
# ifdef PERL_USE_DEVEL
" PERL_USE_DEVEL"
d = s;
if (!*s)
break;
- if (!strchr("CDIMUdmtw", *s))
+ if (!strchr("CDIMUdmtwW", *s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
while (++s && *s) {
if (isSPACE(*s)) {
# endif
#endif
- if (PL_doextract
-#ifdef MACOS_TRADITIONAL
- || gMacPerl_AlwaysExtract
-#endif
- ) {
+ if (PL_doextract) {
/* This will croak if suidscript is true, as -x cannot be used with
setuid scripts. */
boot_core_PerlIO();
boot_core_UNIVERSAL();
- boot_core_xsutils();
boot_core_mro();
if (xsinit)
/* now parse the script */
SETERRNO(0,SS_NORMAL);
-#ifdef MACOS_TRADITIONAL
- if (gMacPerl_SyntaxError = (yyparse() || PL_parser->error_count)) {
- if (PL_minus_c)
- Perl_croak(aTHX_ "%s had compilation errors.\n", MacPerl_MPWFileName(PL_origfilename));
- else {
- Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
- MacPerl_MPWFileName(PL_origfilename));
- }
- }
-#else
if (yyparse() || PL_parser->error_count) {
if (PL_minus_c)
Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
PL_origfilename);
}
}
-#endif
CopLINE_set(PL_curcop, 0);
PL_curstash = PL_defstash;
if (PL_e_script) {
exit(0); /* less likely to core dump than my_exit(0) */
}
#endif
- DEBUG_x(dump_all());
#ifdef DEBUGGING
+ if (DEBUG_x_TEST || DEBUG_B_TEST)
+ dump_all_perl(!DEBUG_B_TEST);
if (!DEBUG_q_TEST)
PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
#endif
if (PL_minus_c) {
-#ifdef MACOS_TRADITIONAL
- PerlIO_printf(Perl_error_log, "%s%s syntax OK\n",
- (gMacPerl_ErrorFormat ? "# " : ""),
- MacPerl_MPWFileName(PL_origfilename));
-#else
PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
-#endif
my_exit(0);
}
if (PERLDB_SINGLE && PL_DBsingle)
/* name of the subroutine */
/* See G_* flags in cop.h */
{
+ STRLEN len;
PERL_ARGS_ASSERT_CALL_METHOD;
- return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
+ len = strlen(methname);
+
+ /* XXX: sv_2mortal(newSVpvn_share(methname, len)) can be faster */
+ return call_sv(newSVpvn_flags(methname, len, SVs_TEMP), flags | G_METHOD);
}
/* May be called with any of a CV, a GV, or an SV containing the name. */
" C Copy On Write",
" A Consistency checks on internal structures",
" q quiet - currently only suppresses the 'EXECUTING' message",
+ " M trace smart match resolution",
+ " B dump suBroutine definitions, including special Blocks like BEGIN",
NULL
};
int i = 0;
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
for (; isALNUM(**s); (*s)++) {
const char * const d = strchr(debopts,**s);
s++;
return s;
case 'u':
-#ifdef MACOS_TRADITIONAL
- Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh");
-#endif
PL_do_undump = TRUE;
s++;
return s;
PerlIO_printf(PerlIO_stdout(),
"\n\nCopyright 1987-2009, Larry Wall\n");
-#ifdef MACOS_TRADITIONAL
- PerlIO_printf(PerlIO_stdout(),
- "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
- "maintained by Chris Nandor\n");
-#endif
#ifdef MSDOS
PerlIO_printf(PerlIO_stdout(),
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
PerlIO_printf(PerlIO_stdout(),
"BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
#endif
-#ifdef __MINT__
- PerlIO_printf(PerlIO_stdout(),
- "MiNT port by Guido Flohr, 1997-1999\n");
-#endif
#ifdef EPOC
PerlIO_printf(PerlIO_stdout(),
"EPOC port by Olaf Flebbe, 1999-2002\n");
dVAR;
const char *s;
register const char *s2;
-#ifdef MACOS_TRADITIONAL
- int maclines = 0;
-#endif
PERL_ARGS_ASSERT_FIND_BEGINNING;
/* skip forward in input to the real script? */
-#ifdef MACOS_TRADITIONAL
- /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
-
- while (PL_doextract || gMacPerl_AlwaysExtract) {
- if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) {
- if (!gMacPerl_AlwaysExtract)
- Perl_croak(aTHX_ "No Perl script found in input\n");
-
- if (PL_doextract) /* require explicit override ? */
- if (!OverrideExtract(PL_origfilename))
- Perl_croak(aTHX_ "User aborted script\n");
- else
- PL_doextract = FALSE;
-
- /* Pater peccavi, file does not have #! */
- PerlIO_rewind(rsfp);
-
- break;
- }
-#else
while (PL_doextract) {
if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL)
Perl_croak(aTHX_ "No Perl script found in input\n");
-#endif
s2 = s;
if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
PerlIO_ungetc(rsfp, '\n'); /* to keep line count right */
while ((s = moreswitches(s)))
;
}
-#ifdef MACOS_TRADITIONAL
- /* We are always searching for the #!perl line in MacPerl,
- * so if we find it, still keep the line count correct
- * by counting lines we already skipped over
- */
- for (; maclines > 0 ; maclines--)
- PerlIO_ungetc(rsfp, '\n');
-
- break;
-
- /* gMacPerl_AlwaysExtract is false in MPW tool */
- } else if (gMacPerl_AlwaysExtract) {
- ++maclines;
-#endif
}
}
}
init_argv_symbols(argc,argv);
if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) {
-#ifdef MACOS_TRADITIONAL
- /* $0 is not majick on a Mac */
- sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename));
-#else
sv_setpv(GvSV(tmpgv),PL_origfilename);
- {
- GV * const gv = gv_fetchpv("0", GV_ADD, SVt_PV);
- if (gv)
- sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, "0", 1);
- }
-#endif
}
if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
HV *hv;
do {
incpush_use_sep(buf, 0, INCPUSH_ADD_SUB_DIRS);
} while (my_trnlnm("PERL5LIB",buf,++idx));
- else if
+ else {
while (my_trnlnm("PERLLIB",buf,idx++))
incpush_use_sep(buf, 0, 0);
+ }
#endif /* VMS */
}
INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
#endif
-#ifdef MACOS_TRADITIONAL
- {
- Stat_t tmpstatbuf;
- SV * privdir = newSV(0);
- char * macperl = PerlEnv_getenv("MACPERL");
-
- if (!macperl)
- macperl = "";
-
-# ifdef ARCHLIB_EXP
- S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE);
-# endif
-
- Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush_use_sep(SvPVX(privdir), SvCUR(privdir),
- INCPUSH_ADD_SUB_DIRS);
- Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), SvCUR(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush_use_sep(SvPVX(privdir), SvCUR(privdir),
- INCPUSH_ADD_SUB_DIRS);
-
- SvREFCNT_dec(privdir);
- if (!PL_tainting)
- S_incpush(aTHX_ STR_WITH_LEN(":"), 0);
- }
-#else
#ifdef SITEARCH_EXP
/* sitearch is always relative to sitelib on Windows for
* DLL-based path intuition to work correctly */
INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR
|INCPUSH_CAN_RELOCATE);
#endif
-#endif /* MACOS_TRADITIONAL */
if (!PL_tainting) {
#ifndef VMS
|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE);
#endif
-#ifndef MACOS_TRADITIONAL
#if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST)
/* Search for version-specific dirs below here */
S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM),
if (!PL_tainting)
S_incpush(aTHX_ STR_WITH_LEN("."), 0);
-#endif /* MACOS_TRADITIONAL */
}
#if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__)
# if defined(VMS)
# define PERLLIB_SEP '|'
# else
-# if defined(MACOS_TRADITIONAL)
-# define PERLLIB_SEP ','
-# else
-# define PERLLIB_SEP ':'
-# endif
+# define PERLLIB_SEP ':'
# endif
#endif
#ifndef PERLLIB_MANGLE
= (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
const U8 add_archonly_sub_dirs
= (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS;
+#ifdef PERL_INC_VERSION_LIST
const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS;
+#endif
const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE;
const U8 unshift = (U8)flags & INCPUSH_UNSHIFT;
const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
libdir = newSVpv(PERLLIB_MANGLE(dir, 0), 0);
}
-#ifdef MACOS_TRADITIONAL
- if (!strchr(SvPVX(libdir), ':')) {
- char buf[256];
-
- sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0));
- }
- if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
- sv_catpvs(libdir, ":");
-#endif
-
/* Do the if() outside the #ifdef to avoid warnings about an unused
parameter. */
if (canrelocate) {
subdir = newSVsv(libdir);
if (add_versioned_sub_dirs) {
-#ifdef MACOS_TRADITIONAL
-#define PERL_ARCH_FMT_PREFIX ""
-#define PERL_ARCH_FMT_SUFFIX ":"
-#define PERL_ARCH_FMT_PATH PERL_FS_VERSION ""
-#else
-#define PERL_ARCH_FMT_PREFIX "/"
-#define PERL_ARCH_FMT_SUFFIX ""
-#define PERL_ARCH_FMT_PATH "/" PERL_FS_VERSION
-#endif
/* .../version/archname if -d .../version/archname */
- sv_catpvs(subdir, PERL_ARCH_FMT_PATH \
- PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
+ sv_catpvs(subdir, "/" PERL_FS_VERSION "/" ARCHNAME);
subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
/* .../version if -d .../version */
- sv_catpvs(subdir, PERL_ARCH_FMT_PATH);
+ sv_catpvs(subdir, "/" PERL_FS_VERSION);
subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
}
if (addoldvers) {
for (incver = incverlist; *incver; incver++) {
/* .../xxx if -d .../xxx */
- Perl_sv_catpvf(aTHX_ subdir, PERL_ARCH_FMT_PREFIX \
- "%s" PERL_ARCH_FMT_SUFFIX, *incver);
+ Perl_sv_catpvf(aTHX_ subdir, "/%s", *incver);
subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
}
}
if (add_archonly_sub_dirs) {
/* .../archname if -d .../archname */
- sv_catpvs(subdir,
- PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
+ sv_catpvs(subdir, "/" ARCHNAME);
subdir = S_incpush_if_exists(aTHX_ av, subdir, libdir);
}