#define PERL_IN_PERL_C
#include "perl.h"
#include "patchlevel.h" /* for local_patches */
+#include "XSUB.h"
#ifdef NETWARE
#include "nwutil.h"
/* clear utf8 character classes */
SvREFCNT_dec(PL_utf8_alnum);
- SvREFCNT_dec(PL_utf8_alnumc);
SvREFCNT_dec(PL_utf8_ascii);
SvREFCNT_dec(PL_utf8_alpha);
SvREFCNT_dec(PL_utf8_space);
SvREFCNT_dec(PL_utf8_idstart);
SvREFCNT_dec(PL_utf8_idcont);
PL_utf8_alnum = NULL;
- PL_utf8_alnumc = NULL;
PL_utf8_ascii = NULL;
PL_utf8_alpha = NULL;
PL_utf8_space = 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;
return ret;
}
+/* This needs to stay in perl.c, as perl.c is compiled with different flags for
+ miniperl, and we need to see those flags reflected in the values here. */
+
+/* What this returns is subject to change. Use the public interface in Config.
+ */
+static void
+S_Internals_V(pTHX_ CV *cv)
+{
+ dXSARGS;
+#ifdef LOCAL_PATCH_COUNT
+ const int local_patch_count = LOCAL_PATCH_COUNT;
+#else
+ const int local_patch_count = 0;
+#endif
+ const int entries = 4 + local_patch_count;
+ int i;
+ static char non_bincompat_options[] =
+# ifdef DEBUGGING
+ " DEBUGGING"
+# endif
+# 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_IS_MINIPERL
+ " PERL_IS_MINIPERL"
+# endif
+# ifdef PERL_MALLOC_WRAP
+ " PERL_MALLOC_WRAP"
+# endif
+# ifdef PERL_MEM_LOG
+ " PERL_MEM_LOG"
+# endif
+# ifdef PERL_MEM_LOG_NOIMPL
+ " PERL_MEM_LOG_NOIMPL"
+# endif
+# ifdef PERL_USE_DEVEL
+ " PERL_USE_DEVEL"
+# endif
+# ifdef PERL_USE_SAFE_PUTENV
+ " PERL_USE_SAFE_PUTENV"
+# endif
+# ifdef USE_SITECUSTOMIZE
+ " USE_SITECUSTOMIZE"
+# endif
+# ifdef USE_FAST_STDIO
+ " USE_FAST_STDIO"
+# endif
+ ;
+ PERL_UNUSED_ARG(cv);
+ PERL_UNUSED_ARG(items);
+
+ EXTEND(SP, entries);
+
+ PUSHs(sv_2mortal(newSVpv(PL_bincompat_options, 0)));
+ PUSHs(Perl_newSVpvn_flags(aTHX_ non_bincompat_options,
+ sizeof(non_bincompat_options) - 1, SVs_TEMP));
+
+#ifdef __DATE__
+# ifdef __TIME__
+ PUSHs(Perl_newSVpvn_flags(aTHX_
+ STR_WITH_LEN("Compiled at " __DATE__ " " __TIME__),
+ SVs_TEMP));
+# else
+ PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN("Compiled on " __DATE__),
+ SVs_TEMP));
+# endif
+#else
+ PUSHs(&PL_sv_undef);
+#endif
+
+ PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(OSNAME), SVs_TEMP));
+
+ for (i = 1; i <= local_patch_count; i++) {
+ /* This will be an undef, if PL_localpatches[i] is NULL. */
+ PUSHs(sv_2mortal(newSVpv(PL_localpatches[i], 0)));
+ }
+
+ XSRETURN(entries);
+}
+
#define INCPUSH_UNSHIFT 0x01
#define INCPUSH_ADD_OLD_VERS 0x02
#define INCPUSH_ADD_VERSIONED_SUB_DIRS 0x04
{
SV *opts_prog;
- Perl_av_create_and_push(aTHX_ &PL_preambleav, newSVpvs("use Config;"));
if (*++s != ':') {
- /* Can't do newSVpvs() as that would involve pre-processor
- condititionals inside a macro expansion. */
- opts_prog = Perl_newSVpv(aTHX_ "$_ = join ' ', sort qw("
-# ifdef DEBUGGING
- " DEBUGGING"
-# endif
-# ifdef NO_MATHOMS
- " NO_MATHOMS"
-# endif
-# ifdef PERL_DONT_CREATE_GVSV
- " PERL_DONT_CREATE_GVSV"
-# endif
-# ifdef PERL_MALLOC_WRAP
- " PERL_MALLOC_WRAP"
-# 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"
-# endif
-# ifdef PERL_USE_DEVEL
- " PERL_USE_DEVEL"
-# endif
-# ifdef PERL_USE_SAFE_PUTENV
- " PERL_USE_SAFE_PUTENV"
-# endif
-# ifdef USE_SITECUSTOMIZE
- " USE_SITECUSTOMIZE"
-# endif
-# ifdef USE_FAST_STDIO
- " USE_FAST_STDIO"
-# endif
- , 0);
-
- sv_catpv(opts_prog, PL_bincompat_options);
- /* Terminate the qw(, and then wrap at 76 columns. */
- sv_catpvs(opts_prog, "); s/(?=.{53})(.{1,53}) /$1\\n /mg;print Config::myconfig(),");
-#ifdef VMS
- sv_catpvs(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n");
-#else
- sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n");
-#endif
- sv_catpvs(opts_prog," Compile-time options: $_\\n\",");
-
-#if defined(LOCAL_PATCH_COUNT)
- if (LOCAL_PATCH_COUNT > 0) {
- int i;
- sv_catpvs(opts_prog,
- "\" Locally applied patches:\\n\",");
- for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
- if (PL_localpatches[i])
- Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
- 0, PL_localpatches[i], 0);
- }
- }
-#endif
- Perl_sv_catpvf(aTHX_ opts_prog,
- "\" Built under %s\\n",OSNAME);
-#ifdef __DATE__
-# ifdef __TIME__
- sv_catpvs(opts_prog,
- " Compiled at " __DATE__ " " __TIME__ "\\n\"");
-# else
- sv_catpvs(opts_prog, " Compiled on " __DATE__ "\\n\"");
-# endif
-#endif
- sv_catpvs(opts_prog, "; $\"=\"\\n \"; "
- "@env = map { \"$_=\\\"$ENV{$_}\\\"\" } "
- "sort grep {/^PERL/} keys %ENV; ");
-#ifdef __CYGWIN__
- sv_catpvs(opts_prog,
- "push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
-#endif
- sv_catpvs(opts_prog,
- "print \" \\%ENV:\\n @env\\n\" if @env;"
- "print \" \\@INC:\\n @INC\\n\";");
+ opts_prog = newSVpvs("use Config; Config::_V()");
}
else {
++s;
opts_prog = Perl_newSVpvf(aTHX_
- "Config::config_vars(qw%c%s%c)",
+ "use Config; Config::config_vars(qw%c%s%c)",
0, s, 0);
s += strlen(s);
}
- av_push(PL_preambleav, opts_prog);
+ Perl_av_create_and_push(aTHX_ &PL_preambleav, opts_prog);
/* don't look for script or read stdin */
scriptname = BIT_BUCKET;
goto reswitch;
}
}
-#ifdef USE_SITECUSTOMIZE
+#if defined(USE_SITECUSTOMIZE) && !defined(PERL_IS_MINIPERL)
if (!minus_f) {
+ /* SITELIB_EXP is a function call on Win32.
+ The games with local $! are to avoid setting errno if there is no
+ sitecustomize script. */
+ const char *const sitelib = SITELIB_EXP;
(void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
- Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP));
+ Perl_newSVpvf(aTHX_
+ "BEGIN { do {local $!; -f '%s/sitecustomize.pl'} && do '%s/sitecustomize.pl' }", sitelib, sitelib));
}
#endif
boot_core_PerlIO();
boot_core_UNIVERSAL();
boot_core_mro();
+ newXS("Internals::V", S_Internals_V, __FILE__);
if (xsinit)
(*xsinit)(aTHX); /* in case linked C routines want magical variables */
#if defined(__SYMBIAN32__)
PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
#endif
+# ifndef PERL_IS_MINIPERL
if (PL_unicode) {
/* Requires init_predump_symbols(). */
if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
}
}
}
+#endif
{
const char *s;
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
/* 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);
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");
#endif /* VMS */
}
+#ifndef PERL_IS_MINIPERL
+ /* miniperl gets just -I..., the split of $ENV{PERL5LIB}, and "." in @INC
+ (and not the architecture specific directories from $ENV{PERL5LIB}) */
+
/* Use the ~-expanded versions of APPLLIB (undocumented),
ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB
*/
INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS
|INCPUSH_CAN_RELOCATE);
#endif
+#endif /* !PERL_IS_MINIPERL */
if (!PL_tainting)
S_incpush(aTHX_ STR_WITH_LEN("."), 0);