#ifndef EASYXS_DEBUG_H
#define EASYXS_DEBUG_H 1
#include "init.h"
/* The following is courtesy of Paul Evans: */
#define exs_debug_sv_summary(sv) S_debug_sv_summary(aTHX_ sv)
/* ------------------------------------------------------------ */
static inline void S_debug_sv_summary(pTHX_ const SV *sv)
{
const char *type;
if(!sv) {
PerlIO_printf(Perl_debug_log, "NULL");
return;
}
if(sv == &PL_sv_undef) {
PerlIO_printf(Perl_debug_log, "SV=undef");
return;
}
if(sv == &PL_sv_no) {
PerlIO_printf(Perl_debug_log, "SV=false");
return;
}
if(sv == &PL_sv_yes) {
PerlIO_printf(Perl_debug_log, "SV=true");
return;
}
switch(SvTYPE(sv)) {
case SVt_NULL: type = "NULL"; break;
case SVt_IV: type = "IV"; break;
case SVt_NV: type = "NV"; break;
case SVt_PV: type = "PV"; break;
case SVt_PVIV: type = "PVIV"; break;
case SVt_PVNV: type = "PVNV"; break;
case SVt_PVGV: type = "PVGV"; break;
case SVt_PVAV: type = "PVAV"; break;
case SVt_PVHV: type = "PVHV"; break;
case SVt_PVCV: type = "PVCV"; break;
default: {
char buf[16];
sprintf(buf, "(%d)", SvTYPE(sv));
type = buf;
break;
}
}
if(SvROK(sv))
type = "RV";
PerlIO_printf(Perl_debug_log, "SV{type=%s,refcnt=%" IVdf, type, (IV) SvREFCNT(sv));
if(SvTEMP(sv))
PerlIO_printf(Perl_debug_log, ",TEMP");
if(SvOBJECT(sv))
PerlIO_printf(Perl_debug_log, ",blessed=%s", HvNAME(SvSTASH(sv)));
switch(SvTYPE(sv)) {
case SVt_PVAV:
PerlIO_printf(Perl_debug_log, ",FILL=%d", (int) AvFILL((AV *)sv));
break;
default:
/* regular scalars */
if(SvROK(sv))
PerlIO_printf(Perl_debug_log, ",ROK");
else {
if(SvIOK(sv))
PerlIO_printf(Perl_debug_log, ",IV=%" IVdf, SvIVX(sv));
if(SvUOK(sv))
PerlIO_printf(Perl_debug_log, ",UV=%" UVuf, SvUVX(sv));
if(SvPOK(sv)) {
PerlIO_printf(Perl_debug_log, ",PVX=\"%.10s\"", SvPVX((SV *)sv));
if(SvCUR(sv) > 10)
PerlIO_printf(Perl_debug_log, "...");
}
}
break;
}
PerlIO_printf(Perl_debug_log, "}");
}
#ifdef CX_CUR
#define exs_debug_showstack(pattern, ...) S_debug_showstack(aTHX_ pattern, ##__VA_ARGS__)
static inline void S_debug_showstack(pTHX_ const char *pattern, ...)
{
SV **sp;
va_list ap;
va_start(ap, pattern);
if (!pattern) pattern = "Stack";
PerlIO_vprintf(Perl_debug_log, pattern, ap);
PerlIO_printf(Perl_debug_log, "\n");
va_end(ap);
PERL_CONTEXT *cx = CX_CUR();
I32 floor = cx->blk_oldsp;
I32 *mark = PL_markstack + cx->blk_oldmarksp + 1;
PerlIO_printf(Perl_debug_log, " TOPMARK=%d, floor = %d\n", (int) TOPMARK, (int) floor);
PerlIO_printf(Perl_debug_log, " marks (TOPMARK=@%" IVdf "):\n", (IV) (TOPMARK - floor));
for(; mark <= PL_markstack_ptr; mark++)
PerlIO_printf(Perl_debug_log, " @%" IVdf "\n", (IV) (*mark - floor));
mark = PL_markstack + cx->blk_oldmarksp + 1;
for(sp = PL_stack_base + floor + 1; sp <= PL_stack_sp; sp++) {
PerlIO_printf(Perl_debug_log, sp == PL_stack_sp ? "-> " : " ");
PerlIO_printf(Perl_debug_log, "%p = ", *sp);
S_debug_sv_summary(aTHX_ *sp);
while(mark <= PL_markstack_ptr && PL_stack_base + *mark == sp)
PerlIO_printf(Perl_debug_log, " [*M]"), mark++;
PerlIO_printf(Perl_debug_log, "\n");
}
}
#endif
/*
void static inline exs_debug_showmark_stack(pTHX) {
PerlIO_printf(Perl_debug_log, "MARK STACK (start=%p; cur=%p, offset=%d):\n", PL_markstack, PL_markstack_ptr, (int) (PL_markstack_ptr - PL_markstack));
I32 *mp = PL_markstack;
while (mp != PL_markstack_max) {
const char* pattern = (mp == PL_markstack_ptr ? "[%d]" : "%d");
PerlIO_printf(Perl_debug_log, pattern, *mp++);
PerlIO_printf(Perl_debug_log, (mp == PL_markstack_max) ? "\n" : ",");
}
}
*/
#endif