* and destroy a perl interpreter, plus the functions used by XS code to
* call back into perl. Note that it does not contain the actual main()
* function of the interpreter; that can be found in perlmain.c
+ *
+ * Note that at build time this file is also linked to as perlmini.c,
+ * and perlmini.o is then built with PERL_IS_MINIPERL defined, which is
+ * then used to create the miniperl executable, rather than perl.o.
*/
#if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE)
=cut
*/
+static void
+S_fixup_platform_bugs(void)
+{
+#if defined(__GLIBC__) && IVSIZE == 8 \
+ && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
+ {
+ IV l = 3;
+ IV r = -10;
+ /* Cannot do this check with inlined IV constants since
+ * that seems to work correctly even with the buggy glibc. */
+ if (l % r == -3) {
+ dTHX;
+ /* Yikes, we have the bug.
+ * Patch in the workaround version. */
+ PL_ppaddr[OP_I_MODULO] = &Perl_pp_i_modulo_glibc_bugfix;
+ }
+ }
+#endif
+}
+
void
perl_construct(pTHXx)
{
init_ids();
+ S_fixup_platform_bugs();
+
JMPENV_BOOTSTRAP;
STATUS_ALL_SUCCESS;
PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
+#ifdef USE_THREAD_SAFE_LOCALE
+ PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
+#endif
ENTER;
}
my_fflush_all();
#ifdef PERL_TRACE_OPS
- /* If we traced all Perl OP usage, report and clean up */
+ /* dump OP-counts if $ENV{PERL_TRACE_OPS} > 0 */
+ {
+ const char * const ptoenv = PerlEnv_getenv("PERL_TRACE_OPS");
+ UV uv;
+
+ if (!ptoenv || !Perl_grok_atoUV(ptoenv, &uv, NULL)
+ || !(uv > 0))
+ goto no_trace_out;
+ }
PerlIO_printf(Perl_debug_log, "Trace of all OPs executed:\n");
for (i = 0; i <= OP_max; ++i) {
- PerlIO_printf(Perl_debug_log, " %s: %"UVuf"\n", PL_op_name[i], PL_op_exec_cnt[i]);
- PL_op_exec_cnt[i] = 0;
+ if (PL_op_exec_cnt[i])
+ PerlIO_printf(Perl_debug_log, " %s: %"UVuf"\n", PL_op_name[i], PL_op_exec_cnt[i]);
}
/* Utility slot for easily doing little tracing experiments in the runloop: */
if (PL_op_exec_cnt[OP_max+1] != 0)
PerlIO_printf(Perl_debug_log, " SPECIAL: %"UVuf"\n", PL_op_exec_cnt[OP_max+1]);
PerlIO_printf(Perl_debug_log, "\n");
+ no_trace_out:
#endif
PL_SB_invlist = NULL;
PL_WB_invlist = NULL;
+#ifdef USE_THREAD_SAFE_LOCALE
+ if (PL_C_locale_obj) {
+ /* Make sure we aren't using the locale space we are about to free */
+ uselocale(LC_GLOBAL_LOCALE);
+
+ freelocale(PL_C_locale_obj);
+ PL_C_locale_obj = (locale_t) NULL;
+ }
+#endif
+
if (!specialWARN(PL_compiling.cop_warnings))
PerlMemShared_free(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = NULL;
# ifdef PERL_MEM_LOG_NOIMPL
" PERL_MEM_LOG_NOIMPL"
# endif
+# ifdef PERL_OP_PARENT
+ " PERL_OP_PARENT"
+# endif
# ifdef PERL_PERTURB_KEYS_DETERMINISTIC
" PERL_PERTURB_KEYS_DETERMINISTIC"
# endif
(void)POPMARK;
old_cxix = cxstack_ix;
create_eval_scope(NULL, flags|G_FAKINGEVAL);
- (void)INCMARK;
+ INCMARK;
JMPENV_PUSH(ret);
" M trace smart match resolution\n"
" B dump suBroutine definitions, including special Blocks like BEGIN\n",
" L trace some locale setting information--for Perl core development\n",
+ " i trace PerlIO layer processing\n",
NULL
};
UV uv = 0;
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBL";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBLi";
for (; isWORDCHAR(**s); (*s)++) {
const char * const d = strchr(debopts,**s);