Exemplo n.º 1
0
STATIC void
S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
	I32 mark_min, I32 mark_max)
{
#ifdef DEBUGGING
    dVAR;
    I32 i = stack_max - 30;
    const I32 *markscan = PL_markstack + mark_min;

    PERL_ARGS_ASSERT_DEB_STACK_N;

    if (i < stack_min)
	i = stack_min;
    
    while (++markscan <= PL_markstack + mark_max)
	if (*markscan >= i)
	    break;

    if (i > stack_min)
	PerlIO_printf(Perl_debug_log, "... ");

    if (stack_base[0] != &PL_sv_undef || stack_max < 0)
	PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n");
    do {
	++i;
	if (markscan <= PL_markstack + mark_max && *markscan < i) {
	    do {
		++markscan;
		PerlIO_putc(Perl_debug_log, '*');
	    }
	    while (markscan <= PL_markstack + mark_max && *markscan < i);
	    PerlIO_printf(Perl_debug_log, "  ");
	}
	if (i > stack_max)
	    break;
	PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(stack_base[i]));
    }
    while (1);
    PerlIO_printf(Perl_debug_log, "\n");
#else
    PERL_UNUSED_CONTEXT;
    PERL_UNUSED_ARG(stack_base);
    PERL_UNUSED_ARG(stack_min);
    PERL_UNUSED_ARG(stack_max);
    PERL_UNUSED_ARG(mark_min);
    PERL_UNUSED_ARG(mark_max);
#endif /* DEBUGGING */
}
Exemplo n.º 2
0
I32
Perl_debop(pTHX_ OP *o)
{
#ifdef DEBUGGING
    SV *sv;
    SV **svp;
    STRLEN n_a;
    Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
    switch (o->op_type) {
    case OP_CONST:
	PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
	break;
    case OP_GVSV:
    case OP_GV:
	if (cGVOPo_gv) {
	    sv = NEWSV(0,0);
	    gv_fullname3(sv, cGVOPo_gv, Nullch);
	    PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
	    SvREFCNT_dec(sv);
	}
	else
	    PerlIO_printf(Perl_debug_log, "(NULL)");
	break;
    case OP_PADSV:
    case OP_PADAV:
    case OP_PADHV:
	/* print the lexical's name */
	svp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
	if (svp)
	    PerlIO_printf(Perl_debug_log, "(%s)", SvPV(*svp,n_a));
	else
           PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
	break;
    default:
	break;
    }
    PerlIO_printf(Perl_debug_log, "\n");
#endif	/* DEBUGGING */
    return 0;
}