1 #define PERL_NO_GET_CONTEXT
2 #include <EXTERN.h>
3 #include <perl.h>
4 #include <XSUB.h>
5 #include <regcomp.h>
6
7 #include "ppport.h"
8
9 #include "b_sizeof.h"
10
11 #ifndef PM_GETRE
12 #define PM_GETRE(o) ((o)->op_pmregexp)
13 #endif
14
15 typedef SV * B__PV;
16 typedef OP * B__OP;
17 typedef PMOP * B__PMOP;
18 typedef MAGIC * B__MAGIC;
19
B__Size_SV_size(pTHX_ SV * sv)20 static int B__Size_SV_size(pTHX_ SV *sv)
21 {
22 dSP;
23 int count, retval;
24
25 ENTER;SAVETMPS;PUSHMARK(SP);
26 XPUSHs(sv_2mortal(newRV_inc(sv)));
27 PUTBACK;
28
29 count = call_pv("B::Size::SV_size", G_SCALAR);
30
31 SPAGAIN;
32
33 retval = POPi;
34
35 PUTBACK;FREETMPS;LEAVE;
36
37 return retval;
38 }
39
40 #define sizeof_if(p) (p ? sizeof(*p) : 0);
41
REGEXP_size(PMOP * o)42 static int REGEXP_size(PMOP *o)
43 {
44 dTHX;
45 REGEXP *rx = PM_GETRE(o);
46 int retval = 0;
47
48 if (!rx) {
49 return retval;
50 }
51 #if PERL_BCDVERSION >= 0x5010000 /* 5.10 */
52 /* TODO */
53 #else /* pre-5.10 */
54 retval = rx->prelen;
55
56 retval += sizeof_if(rx->regstclass);
57 retval += sizeof_if(rx->subbeg);
58 retval += sizeof_if(rx->startp);
59 retval += sizeof_if(rx->endp);
60
61 if (rx->data) {
62 int n = rx->data->count;
63 retval += sizeof(*rx->data);
64 retval += sizeof(void *) * n;
65
66 while (--n >= 0) {
67 switch (rx->data->what[n]) {
68 case 's':
69 case 'p':
70 retval += B__Size_SV_size(aTHX_ (SV*)rx->data->data[n]);
71 break;
72 case 'o':
73 /*XXX: OP*/
74 break;
75 case 'n':
76 break;
77 }
78 }
79 }
80
81 if (rx->substrs) {
82 /* check_substr just points to anchor or float */
83 if (rx->anchored_substr) {
84 retval += B__Size_SV_size(aTHX_ rx->anchored_substr);
85 }
86 if (rx->float_substr) {
87 retval += B__Size_SV_size(aTHX_ rx->float_substr);
88 }
89
90 retval += sizeof(*rx->substrs);
91 }
92 #endif
93 return retval;
94 }
95
XS(XS_B__PV_LEN)96 static XS(XS_B__PV_LEN)
97 {
98 dXSARGS;
99 if (items != 1)
100 croak("Usage: B::PV::LEN(sv)");
101
102 {
103 B__PV sv;
104 STRLEN RETVAL;
105
106 if (SvROK(ST(0))) {
107 IV tmp = SvIV((SV*)SvRV(ST(0)));
108 sv = INT2PTR(B__PV, tmp);
109 }
110 else
111 croak("sv is not a reference");
112
113 RETVAL = SvLEN(sv);
114 ST(0) = sv_newmortal();
115 sv_setiv(ST(0), (IV)RETVAL);
116 }
117
118 XSRETURN(1);
119 }
120
XS(XS_B__PV_CUR)121 static XS(XS_B__PV_CUR)
122 {
123 dXSARGS;
124 if (items != 1)
125 croak("Usage: B::PV::CUR(sv)");
126 {
127 B__PV sv;
128 STRLEN RETVAL;
129
130 if (SvROK(ST(0))) {
131 IV tmp = SvIV((SV*)SvRV(ST(0)));
132 sv = INT2PTR(B__PV, tmp);
133 }
134 else
135 croak("sv is not a reference");
136
137 RETVAL = SvCUR(sv);
138 ST(0) = sv_newmortal();
139 sv_setiv(ST(0), (IV)RETVAL);
140 }
141
142 XSRETURN(1);
143 }
144
145 #define MgLENGTH(mg) mg->mg_len
146
XS(XS_B__MAGIC_LENGTH)147 static XS(XS_B__MAGIC_LENGTH)
148 {
149 dXSARGS;
150 if (items != 1)
151 croak("Usage: B::MAGIC::LENGTH(mg)");
152 {
153 B__MAGIC mg;
154 I32 RETVAL;
155
156 if (SvROK(ST(0))) {
157 IV tmp = SvIV((SV*)SvRV(ST(0)));
158 mg = INT2PTR(B__MAGIC, tmp);
159 }
160 else
161 croak("mg is not a reference");
162
163 RETVAL = MgLENGTH(mg);
164 ST(0) = sv_newmortal();
165 sv_setiv(ST(0), (IV)RETVAL);
166 }
167
168 XSRETURN(1);
169 }
170
XS(XS_B__OP_name)171 static XS(XS_B__OP_name)
172 {
173 dXSARGS;
174 if (items != 1)
175 croak("Usage: B::OP::name(o)");
176 {
177 B__OP o;
178 const char * RETVAL;
179
180 if (SvROK(ST(0))) {
181 IV tmp = SvIV((SV*)SvRV(ST(0)));
182 o = INT2PTR(B__OP, tmp);
183 }
184 else
185 croak("o is not a reference");
186
187 ST(0) = sv_newmortal();
188 sv_setpv(ST(0), PL_op_name[o->op_type]);
189 }
190
191 XSRETURN(1);
192 }
193
boot_B_compat(pTHX)194 static void boot_B_compat(pTHX)
195 {
196 HV *b_stash = gv_stashpvn("B", 1, TRUE);
197
198 /* these were not present until 5.005_58ish */
199 if (!get_cv("B::PV::LEN", FALSE)) {
200 (void)newXS("B::PV::LEN", XS_B__PV_LEN, __FILE__);
201 }
202 if (!get_cv("B::PV::CUR", FALSE)) {
203 (void)newXS("B::PV::CUR", XS_B__PV_CUR, __FILE__);
204 }
205 if (!get_cv("B::MAGIC::LENGTH", FALSE)) {
206 (void)newXS("B::MAGIC::LENGTH", XS_B__MAGIC_LENGTH, __FILE__);
207 }
208 if (!get_cv("B::OP::name", FALSE)) {
209 (void)newXS("B::OP::name", XS_B__OP_name, __FILE__);
210 }
211 if (!get_cv("B::SVf_POK", FALSE)) {
212 (void)newCONSTSUB(b_stash, "SVf_POK", newSViv(SVf_POK));
213 }
214 if (!get_cv("B::SVf_FAKE", FALSE)) {
215 (void)newCONSTSUB(b_stash, "SVf_FAKE", newSViv(SVf_FAKE));
216 }
217 }
218
219 #define OP_op_name(i) PL_op_name[i]
220 #define OP_op_desc(i) PL_op_desc[i]
221
222 MODULE = B::Size2 PACKAGE = B::Sizeof
223
224 PROTOTYPES: disable
225
226 BOOT:
227 boot_B_Sizeof(aTHX);
228 boot_B_compat(aTHX);
229
230 MODULE = B::Size2 PACKAGE = B::PMOP
231
232 int
233 REGEXP_size(o)
234 B::PMOP o
235
236 MODULE = B::Size2 PACKAGE = B::OP PREFIX = OP_
237
238 const char *
239 OP_op_name(i)
240 U16 i
241
242 const char *
243 OP_op_desc(i)
244 U16 i
245
246