1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#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];
snprintf(buf, sizeof(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
|
