This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a few helpers to B for INVLIST
[perl5.git] / ext / B / B.xs
CommitLineData
a8a597b2
MB
1/* B.xs
2 *
3 * Copyright (c) 1996 Malcolm Beattie
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 */
9
c5be433b 10#define PERL_NO_GET_CONTEXT
fedf30e1 11#define PERL_EXT
a8a597b2
MB
12#include "EXTERN.h"
13#include "perl.h"
14#include "XSUB.h"
a8a597b2 15
47e6c6d9
N
16/* #include "invlist_inline.h" */
17#define FROM_INTERNAL_SIZE(x) ((x)/ sizeof(UV))
18
51aa15f3
GS
19#ifdef PerlIO
20typedef PerlIO * InputStream;
21#else
22typedef FILE * InputStream;
23#endif
24
25
27da23d5 26static const char* const svclassnames[] = {
a8a597b2 27 "B::NULL",
1cb9cd50 28 "B::IV",
b53eecb4 29 "B::NV",
a8a597b2 30 "B::PV",
e94d9b54 31 "B::INVLIST",
a8a597b2
MB
32 "B::PVIV",
33 "B::PVNV",
34 "B::PVMG",
5c35adbb 35 "B::REGEXP",
4ce457a6 36 "B::GV",
a8a597b2
MB
37 "B::PVLV",
38 "B::AV",
39 "B::HV",
40 "B::CV",
a8a597b2
MB
41 "B::FM",
42 "B::IO",
43};
44
a8a597b2 45
27da23d5 46static const char* const opclassnames[] = {
a8a597b2
MB
47 "B::NULL",
48 "B::OP",
49 "B::UNOP",
50 "B::BINOP",
51 "B::LOGOP",
a8a597b2
MB
52 "B::LISTOP",
53 "B::PMOP",
54 "B::SVOP",
7934575e 55 "B::PADOP",
a8a597b2 56 "B::PVOP",
a8a597b2 57 "B::LOOP",
b46e009d 58 "B::COP",
2f7c6295
DM
59 "B::METHOP",
60 "B::UNOP_AUX"
a8a597b2
MB
61};
62
27da23d5 63static const size_t opsizes[] = {
651aa52e
AE
64 0,
65 sizeof(OP),
66 sizeof(UNOP),
67 sizeof(BINOP),
68 sizeof(LOGOP),
69 sizeof(LISTOP),
70 sizeof(PMOP),
71 sizeof(SVOP),
72 sizeof(PADOP),
73 sizeof(PVOP),
74 sizeof(LOOP),
b46e009d 75 sizeof(COP),
2f7c6295
DM
76 sizeof(METHOP),
77 sizeof(UNOP_AUX),
651aa52e
AE
78};
79
df3728a2 80#define MY_CXT_KEY "B::_guts" XS_VERSION
a8a597b2 81
89ca4ac7 82typedef struct {
b043c4bf 83 SV * x_specialsv_list[8];
a462fa00 84 int x_walkoptree_debug; /* Flag for walkoptree debug hook */
89ca4ac7
JH
85} my_cxt_t;
86
87START_MY_CXT
88
89#define walkoptree_debug (MY_CXT.x_walkoptree_debug)
90#define specialsv_list (MY_CXT.x_specialsv_list)
e8edd1e6 91
a462fa00
DD
92
93static void B_init_my_cxt(pTHX_ my_cxt_t * cxt) {
94 cxt->x_specialsv_list[0] = Nullsv;
95 cxt->x_specialsv_list[1] = &PL_sv_undef;
96 cxt->x_specialsv_list[2] = &PL_sv_yes;
97 cxt->x_specialsv_list[3] = &PL_sv_no;
98 cxt->x_specialsv_list[4] = (SV *) pWARN_ALL;
99 cxt->x_specialsv_list[5] = (SV *) pWARN_NONE;
100 cxt->x_specialsv_list[6] = (SV *) pWARN_STD;
b043c4bf 101 cxt->x_specialsv_list[7] = &PL_sv_zero;
a462fa00
DD
102}
103
a8a597b2 104
6079961f
NC
105static SV *
106make_op_object(pTHX_ const OP *o)
a8a597b2 107{
6079961f 108 SV *opsv = sv_newmortal();
1e85b658 109 sv_setiv(newSVrv(opsv, opclassnames[op_class(o)]), PTR2IV(o));
6079961f 110 return opsv;
a8a597b2
MB
111}
112
71324a3b
DM
113
114static SV *
115get_overlay_object(pTHX_ const OP *o, const char * const name, U32 namelen)
116{
117 HE *he;
118 SV **svp;
119 SV *key;
120 SV *sv =get_sv("B::overlay", 0);
121 if (!sv || !SvROK(sv))
122 return NULL;
123 sv = SvRV(sv);
124 if (SvTYPE(sv) != SVt_PVHV)
125 return NULL;
126 key = newSViv(PTR2IV(o));
127 he = hv_fetch_ent((HV*)sv, key, 0, 0);
128 SvREFCNT_dec(key);
129 if (!he)
130 return NULL;
131 sv = HeVAL(he);
132 if (!sv || !SvROK(sv))
133 return NULL;
134 sv = SvRV(sv);
135 if (SvTYPE(sv) != SVt_PVHV)
136 return NULL;
137 svp = hv_fetch((HV*)sv, name, namelen, 0);
138 if (!svp)
139 return NULL;
140 sv = *svp;
141 return sv;
142}
143
144
a8a597b2 145static SV *
0c74f67f 146make_sv_object(pTHX_ SV *sv)
a8a597b2 147{
0c74f67f 148 SV *const arg = sv_newmortal();
27da23d5 149 const char *type = 0;
a8a597b2 150 IV iv;
89ca4ac7 151 dMY_CXT;
9496d2e5 152
c33e8be1 153 for (iv = 0; iv < (IV)(sizeof(specialsv_list)/sizeof(SV*)); iv++) {
e8edd1e6 154 if (sv == specialsv_list[iv]) {
a8a597b2
MB
155 type = "B::SPECIAL";
156 break;
157 }
158 }
159 if (!type) {
160 type = svclassnames[SvTYPE(sv)];
56431972 161 iv = PTR2IV(sv);
a8a597b2
MB
162 }
163 sv_setiv(newSVrv(arg, type), iv);
164 return arg;
165}
166
167static SV *
9496d2e5 168make_temp_object(pTHX_ SV *temp)
8e01d9a6
NC
169{
170 SV *target;
9496d2e5 171 SV *arg = sv_newmortal();
8e01d9a6
NC
172 const char *const type = svclassnames[SvTYPE(temp)];
173 const IV iv = PTR2IV(temp);
174
175 target = newSVrv(arg, type);
176 sv_setiv(target, iv);
177
178 /* Need to keep our "temp" around as long as the target exists.
179 Simplest way seems to be to hang it from magic, and let that clear
180 it up. No vtable, so won't actually get in the way of anything. */
181 sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
182 /* magic object has had its reference count increased, so we must drop
183 our reference. */
184 SvREFCNT_dec(temp);
185 return arg;
186}
187
188static SV *
d2b4c688 189make_warnings_object(pTHX_ const COP *const cop)
5c3c3f81 190{
d2b4c688 191 const STRLEN *const warnings = cop->cop_warnings;
5c3c3f81
NC
192 const char *type = 0;
193 dMY_CXT;
194 IV iv = sizeof(specialsv_list)/sizeof(SV*);
195
196 /* Counting down is deliberate. Before the split between make_sv_object
197 and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
198 were both 0, so you could never get a B::SPECIAL for pWARN_STD */
199
200 while (iv--) {
201 if ((SV*)warnings == specialsv_list[iv]) {
202 type = "B::SPECIAL";
203 break;
204 }
205 }
206 if (type) {
9496d2e5 207 SV *arg = sv_newmortal();
5c3c3f81 208 sv_setiv(newSVrv(arg, type), iv);
8e01d9a6 209 return arg;
5c3c3f81
NC
210 } else {
211 /* B assumes that warnings are a regular SV. Seems easier to keep it
212 happy by making them into a regular SV. */
9496d2e5 213 return make_temp_object(aTHX_ newSVpvn((char *)(warnings + 1), *warnings));
8e01d9a6
NC
214 }
215}
216
217static SV *
9496d2e5 218make_cop_io_object(pTHX_ COP *cop)
8e01d9a6 219{
8b850bd5
NC
220 SV *const value = newSV(0);
221
33972ad6 222 Perl_emulate_cop_io(aTHX_ cop, value);
8b850bd5
NC
223
224 if(SvOK(value)) {
0c74f67f 225 return make_sv_object(aTHX_ value);
8e01d9a6 226 } else {
8b850bd5 227 SvREFCNT_dec(value);
0c74f67f 228 return make_sv_object(aTHX_ NULL);
5c3c3f81 229 }
5c3c3f81
NC
230}
231
232static SV *
9496d2e5 233make_mg_object(pTHX_ MAGIC *mg)
a8a597b2 234{
9496d2e5 235 SV *arg = sv_newmortal();
56431972 236 sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
a8a597b2
MB
237 return arg;
238}
239
240static SV *
52ad86de 241cstring(pTHX_ SV *sv, bool perlstyle)
a8a597b2 242{
09e97b95 243 SV *sstr;
a8a597b2
MB
244
245 if (!SvOK(sv))
09e97b95
NC
246 return newSVpvs_flags("0", SVs_TEMP);
247
248 sstr = newSVpvs_flags("\"", SVs_TEMP);
249
250 if (perlstyle && SvUTF8(sv)) {
d79a7a3d 251 SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
5d7488b2
AL
252 const STRLEN len = SvCUR(sv);
253 const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
d79a7a3d
RGS
254 while (*s)
255 {
256 if (*s == '"')
6beb30a6 257 sv_catpvs(sstr, "\\\"");
d79a7a3d 258 else if (*s == '$')
6beb30a6 259 sv_catpvs(sstr, "\\$");
d79a7a3d 260 else if (*s == '@')
6beb30a6 261 sv_catpvs(sstr, "\\@");
d79a7a3d
RGS
262 else if (*s == '\\')
263 {
948c7369 264 if (memCHRs("nrftaebx\\",*(s+1)))
d79a7a3d
RGS
265 sv_catpvn(sstr, s++, 2);
266 else
6beb30a6 267 sv_catpvs(sstr, "\\\\");
d79a7a3d
RGS
268 }
269 else /* should always be printable */
270 sv_catpvn(sstr, s, 1);
271 ++s;
272 }
d79a7a3d 273 }
a8a597b2
MB
274 else
275 {
276 /* XXX Optimise? */
5d7488b2
AL
277 STRLEN len;
278 const char *s = SvPV(sv, len);
a8a597b2
MB
279 for (; len; len--, s++)
280 {
281 /* At least try a little for readability */
282 if (*s == '"')
6beb30a6 283 sv_catpvs(sstr, "\\\"");
a8a597b2 284 else if (*s == '\\')
6beb30a6 285 sv_catpvs(sstr, "\\\\");
b326da91 286 /* trigraphs - bleagh */
5d7488b2 287 else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
47bf35fa 288 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", '?');
b326da91 289 }
52ad86de 290 else if (perlstyle && *s == '$')
6beb30a6 291 sv_catpvs(sstr, "\\$");
52ad86de 292 else if (perlstyle && *s == '@')
6beb30a6 293 sv_catpvs(sstr, "\\@");
ce561ef2 294 else if (isPRINT(*s))
a8a597b2
MB
295 sv_catpvn(sstr, s, 1);
296 else if (*s == '\n')
6beb30a6 297 sv_catpvs(sstr, "\\n");
a8a597b2 298 else if (*s == '\r')
6beb30a6 299 sv_catpvs(sstr, "\\r");
a8a597b2 300 else if (*s == '\t')
6beb30a6 301 sv_catpvs(sstr, "\\t");
a8a597b2 302 else if (*s == '\a')
6beb30a6 303 sv_catpvs(sstr, "\\a");
a8a597b2 304 else if (*s == '\b')
6beb30a6 305 sv_catpvs(sstr, "\\b");
a8a597b2 306 else if (*s == '\f')
6beb30a6 307 sv_catpvs(sstr, "\\f");
52ad86de 308 else if (!perlstyle && *s == '\v')
6beb30a6 309 sv_catpvs(sstr, "\\v");
a8a597b2
MB
310 else
311 {
a8a597b2 312 /* Don't want promotion of a signed -1 char in sprintf args */
5d7488b2 313 const unsigned char c = (unsigned char) *s;
47bf35fa 314 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
a8a597b2
MB
315 }
316 /* XXX Add line breaks if string is long */
317 }
a8a597b2 318 }
09e97b95 319 sv_catpvs(sstr, "\"");
a8a597b2
MB
320 return sstr;
321}
322
323static SV *
cea2e8a9 324cchar(pTHX_ SV *sv)
a8a597b2 325{
422d053b 326 SV *sstr = newSVpvs_flags("'", SVs_TEMP);
5d7488b2 327 const char *s = SvPV_nolen(sv);
422d053b
NC
328 /* Don't want promotion of a signed -1 char in sprintf args */
329 const unsigned char c = (unsigned char) *s;
a8a597b2 330
422d053b 331 if (c == '\'')
6beb30a6 332 sv_catpvs(sstr, "\\'");
422d053b 333 else if (c == '\\')
6beb30a6 334 sv_catpvs(sstr, "\\\\");
422d053b 335 else if (isPRINT(c))
a8a597b2 336 sv_catpvn(sstr, s, 1);
422d053b 337 else if (c == '\n')
6beb30a6 338 sv_catpvs(sstr, "\\n");
422d053b 339 else if (c == '\r')
6beb30a6 340 sv_catpvs(sstr, "\\r");
422d053b 341 else if (c == '\t')
6beb30a6 342 sv_catpvs(sstr, "\\t");
422d053b 343 else if (c == '\a')
6beb30a6 344 sv_catpvs(sstr, "\\a");
422d053b 345 else if (c == '\b')
6beb30a6 346 sv_catpvs(sstr, "\\b");
422d053b 347 else if (c == '\f')
6beb30a6 348 sv_catpvs(sstr, "\\f");
422d053b 349 else if (c == '\v')
6beb30a6 350 sv_catpvs(sstr, "\\v");
a8a597b2 351 else
422d053b 352 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
6beb30a6 353 sv_catpvs(sstr, "'");
a8a597b2
MB
354 return sstr;
355}
356
35633035
DM
357#define PMOP_pmreplstart(o) o->op_pmstashstartu.op_pmreplstart
358#define PMOP_pmreplroot(o) o->op_pmreplrootu.op_pmreplroot
8f3d514b 359
20f7624e
NC
360static SV *
361walkoptree(pTHX_ OP *o, const char *method, SV *ref)
a8a597b2
MB
362{
363 dSP;
20f7624e
NC
364 OP *kid;
365 SV *object;
1e85b658 366 const char *const classname = opclassnames[op_class(o)];
89ca4ac7
JH
367 dMY_CXT;
368
20f7624e
NC
369 /* Check that no-one has changed our reference, or is holding a reference
370 to it. */
371 if (SvREFCNT(ref) == 1 && SvROK(ref) && SvTYPE(ref) == SVt_RV
372 && (object = SvRV(ref)) && SvREFCNT(object) == 1
373 && SvTYPE(object) == SVt_PVMG && SvIOK_only(object)
374 && !SvMAGICAL(object) && !SvMAGIC(object) && SvSTASH(object)) {
375 /* Looks good, so rebless it for the class we need: */
376 sv_bless(ref, gv_stashpv(classname, GV_ADD));
377 } else {
378 /* Need to make a new one. */
379 ref = sv_newmortal();
380 object = newSVrv(ref, classname);
381 }
382 sv_setiv(object, PTR2IV(o));
383
a8a597b2
MB
384 if (walkoptree_debug) {
385 PUSHMARK(sp);
20f7624e 386 XPUSHs(ref);
a8a597b2
MB
387 PUTBACK;
388 perl_call_method("walkoptree_debug", G_DISCARD);
389 }
390 PUSHMARK(sp);
20f7624e 391 XPUSHs(ref);
a8a597b2
MB
392 PUTBACK;
393 perl_call_method(method, G_DISCARD);
394 if (o && (o->op_flags & OPf_KIDS)) {
e6dae479 395 for (kid = ((UNOP*)o)->op_first; kid; kid = OpSIBLING(kid)) {
20f7624e 396 ref = walkoptree(aTHX_ kid, method, ref);
a8a597b2
MB
397 }
398 }
1e85b658 399 if (o && (op_class(o) == OPclass_PMOP) && o->op_type != OP_SPLIT
8f3d514b 400 && (kid = PMOP_pmreplroot(cPMOPo)))
f3be9b72 401 {
20f7624e 402 ref = walkoptree(aTHX_ kid, method, ref);
f3be9b72 403 }
20f7624e 404 return ref;
a8a597b2
MB
405}
406
5d7488b2 407static SV **
1df34986
AE
408oplist(pTHX_ OP *o, SV **SP)
409{
410 for(; o; o = o->op_next) {
7252851f 411 if (o->op_opt == 0)
1df34986 412 break;
2814eb74 413 o->op_opt = 0;
6079961f 414 XPUSHs(make_op_object(aTHX_ o));
1df34986
AE
415 switch (o->op_type) {
416 case OP_SUBST:
8f3d514b 417 SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
1df34986
AE
418 continue;
419 case OP_SORT:
f66c782a 420 if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
e6dae479 421 OP *kid = OpSIBLING(cLISTOPo->op_first); /* pass pushmark */
1df34986
AE
422 kid = kUNOP->op_first; /* pass rv2gv */
423 kid = kUNOP->op_first; /* pass leave */
f66c782a 424 SP = oplist(aTHX_ kid->op_next, SP);
1df34986
AE
425 }
426 continue;
427 }
428 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
429 case OA_LOGOP:
430 SP = oplist(aTHX_ cLOGOPo->op_other, SP);
431 break;
432 case OA_LOOP:
433 SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
434 SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
435 SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
436 break;
437 }
438 }
439 return SP;
440}
441
a8a597b2
MB
442typedef OP *B__OP;
443typedef UNOP *B__UNOP;
444typedef BINOP *B__BINOP;
445typedef LOGOP *B__LOGOP;
a8a597b2
MB
446typedef LISTOP *B__LISTOP;
447typedef PMOP *B__PMOP;
448typedef SVOP *B__SVOP;
7934575e 449typedef PADOP *B__PADOP;
a8a597b2
MB
450typedef PVOP *B__PVOP;
451typedef LOOP *B__LOOP;
452typedef COP *B__COP;
b46e009d 453typedef METHOP *B__METHOP;
a8a597b2
MB
454
455typedef SV *B__SV;
456typedef SV *B__IV;
457typedef SV *B__PV;
458typedef SV *B__NV;
459typedef SV *B__PVMG;
5c35adbb 460typedef SV *B__REGEXP;
a8a597b2
MB
461typedef SV *B__PVLV;
462typedef SV *B__BM;
463typedef SV *B__RV;
1df34986 464typedef SV *B__FM;
a8a597b2
MB
465typedef AV *B__AV;
466typedef HV *B__HV;
467typedef CV *B__CV;
468typedef GV *B__GV;
469typedef IO *B__IO;
470
471typedef MAGIC *B__MAGIC;
fd9f6265
JJ
472typedef HE *B__HE;
473typedef struct refcounted_he *B__RHE;
7261499d 474typedef PADLIST *B__PADLIST;
9b7476d7 475typedef PADNAMELIST *B__PADNAMELIST;
0f94cb1f 476typedef PADNAME *B__PADNAME;
9b7476d7 477
47e6c6d9 478typedef INVLIST *B__INVLIST;
a8a597b2 479
3486ec84 480#ifdef MULTIPLICITY
115ff745 481# define ASSIGN_COMMON_ALIAS(prefix, var) \
3800c318 482 STMT_START { XSANY.any_i32 = STRUCT_OFFSET(struct interpreter, prefix##var); } STMT_END
32855229 483#else
115ff745 484# define ASSIGN_COMMON_ALIAS(prefix, var) \
32855229
NC
485 STMT_START { XSANY.any_ptr = (void *)&PL_##var; } STMT_END
486#endif
487
488/* This needs to be ALIASed in a custom way, hence can't easily be defined as
489 a regular XSUB. */
490static XSPROTO(intrpvar_sv_common); /* prototype to pass -Wmissing-prototypes */
491static XSPROTO(intrpvar_sv_common)
492{
32855229
NC
493 dXSARGS;
494 SV *ret;
495 if (items != 0)
496 croak_xs_usage(cv, "");
3486ec84 497#ifdef MULTIPLICITY
32855229
NC
498 ret = *(SV **)(XSANY.any_i32 + (char *)my_perl);
499#else
500 ret = *(SV **)(XSANY.any_ptr);
501#endif
0c74f67f 502 ST(0) = make_sv_object(aTHX_ ret);
32855229
NC
503 XSRETURN(1);
504}
505
bec746fe
DM
506
507
0508288e
NC
508#define SVp 0x0
509#define U32p 0x1
510#define line_tp 0x2
511#define OPp 0x3
512#define PADOFFSETp 0x4
513#define U8p 0x5
514#define IVp 0x6
515#define char_pp 0x7
516/* Keep this last: */
517#define op_offset_special 0x8
bec746fe
DM
518
519/* table that drives most of the B::*OP methods */
520
0b057af7 521static const struct OP_methods {
bec746fe 522 const char *name;
7d6d3fb7 523 U8 namelen;
0508288e
NC
524 U8 type; /* if op_offset_special, access is handled on a case-by-case basis */
525 U16 offset;
bec746fe 526} op_methods[] = {
3800c318 527 { STR_WITH_LEN("next"), OPp, STRUCT_OFFSET(struct op, op_next), },/* 0*/
1ed44841 528 { STR_WITH_LEN("sibling"), op_offset_special, 0, },/* 1*/
3800c318
JH
529 { STR_WITH_LEN("targ"), PADOFFSETp, STRUCT_OFFSET(struct op, op_targ), },/* 2*/
530 { STR_WITH_LEN("flags"), U8p, STRUCT_OFFSET(struct op, op_flags), },/* 3*/
531 { STR_WITH_LEN("private"), U8p, STRUCT_OFFSET(struct op, op_private), },/* 4*/
532 { STR_WITH_LEN("first"), OPp, STRUCT_OFFSET(struct unop, op_first), },/* 5*/
533 { STR_WITH_LEN("last"), OPp, STRUCT_OFFSET(struct binop, op_last), },/* 6*/
534 { STR_WITH_LEN("other"), OPp, STRUCT_OFFSET(struct logop, op_other), },/* 7*/
99639b5b 535 { STR_WITH_LEN("pmreplstart"), op_offset_special, 0, },/* 8*/
3800c318
JH
536 { STR_WITH_LEN("redoop"), OPp, STRUCT_OFFSET(struct loop, op_redoop), },/* 9*/
537 { STR_WITH_LEN("nextop"), OPp, STRUCT_OFFSET(struct loop, op_nextop), },/*10*/
538 { STR_WITH_LEN("lastop"), OPp, STRUCT_OFFSET(struct loop, op_lastop), },/*11*/
539 { STR_WITH_LEN("pmflags"), U32p, STRUCT_OFFSET(struct pmop, op_pmflags),},/*12*/
3800c318 540 { STR_WITH_LEN("code_list"),OPp, STRUCT_OFFSET(struct pmop, op_code_list),},/*13*/
3800c318
JH
541 { STR_WITH_LEN("sv"), SVp, STRUCT_OFFSET(struct svop, op_sv), },/*14*/
542 { STR_WITH_LEN("gv"), SVp, STRUCT_OFFSET(struct svop, op_sv), },/*15*/
543 { STR_WITH_LEN("padix"), PADOFFSETp,STRUCT_OFFSET(struct padop, op_padix),},/*16*/
544 { STR_WITH_LEN("cop_seq"), U32p, STRUCT_OFFSET(struct cop, cop_seq), },/*17*/
545 { STR_WITH_LEN("line"), line_tp, STRUCT_OFFSET(struct cop, cop_line), },/*18*/
546 { STR_WITH_LEN("hints"), U32p, STRUCT_OFFSET(struct cop, cop_hints), },/*19*/
bec746fe 547#ifdef USE_ITHREADS
3800c318 548 { STR_WITH_LEN("pmoffset"),IVp, STRUCT_OFFSET(struct pmop, op_pmoffset),},/*20*/
99639b5b 549 { STR_WITH_LEN("filegv"), op_offset_special, 0, },/*21*/
3800c318 550 { STR_WITH_LEN("file"), char_pp, STRUCT_OFFSET(struct cop, cop_file), },/*22*/
99639b5b 551 { STR_WITH_LEN("stash"), op_offset_special, 0, },/*23*/
99639b5b 552 { STR_WITH_LEN("stashpv"), op_offset_special, 0, },/*24*/
3800c318 553 { STR_WITH_LEN("stashoff"),PADOFFSETp,STRUCT_OFFSET(struct cop,cop_stashoff),},/*25*/
bec746fe 554#else
99639b5b 555 { STR_WITH_LEN("pmoffset"),op_offset_special, 0, },/*20*/
3800c318 556 { STR_WITH_LEN("filegv"), SVp, STRUCT_OFFSET(struct cop, cop_filegv),},/*21*/
99639b5b 557 { STR_WITH_LEN("file"), op_offset_special, 0, },/*22*/
3800c318 558 { STR_WITH_LEN("stash"), SVp, STRUCT_OFFSET(struct cop, cop_stash), },/*23*/
99639b5b
DM
559 { STR_WITH_LEN("stashpv"), op_offset_special, 0, },/*24*/
560 { STR_WITH_LEN("stashoff"),op_offset_special, 0, },/*25*/
bec746fe 561#endif
99639b5b
DM
562 { STR_WITH_LEN("size"), op_offset_special, 0, },/*26*/
563 { STR_WITH_LEN("name"), op_offset_special, 0, },/*27*/
564 { STR_WITH_LEN("desc"), op_offset_special, 0, },/*28*/
565 { STR_WITH_LEN("ppaddr"), op_offset_special, 0, },/*29*/
566 { STR_WITH_LEN("type"), op_offset_special, 0, },/*30*/
567 { STR_WITH_LEN("opt"), op_offset_special, 0, },/*31*/
568 { STR_WITH_LEN("spare"), op_offset_special, 0, },/*32*/
569 { STR_WITH_LEN("children"),op_offset_special, 0, },/*33*/
570 { STR_WITH_LEN("pmreplroot"), op_offset_special, 0, },/*34*/
571 { STR_WITH_LEN("pmstashpv"), op_offset_special, 0, },/*35*/
572 { STR_WITH_LEN("pmstash"), op_offset_special, 0, },/*36*/
573 { STR_WITH_LEN("precomp"), op_offset_special, 0, },/*37*/
574 { STR_WITH_LEN("reflags"), op_offset_special, 0, },/*38*/
575 { STR_WITH_LEN("sv"), op_offset_special, 0, },/*39*/
576 { STR_WITH_LEN("gv"), op_offset_special, 0, },/*40*/
577 { STR_WITH_LEN("pv"), op_offset_special, 0, },/*41*/
578 { STR_WITH_LEN("label"), op_offset_special, 0, },/*42*/
579 { STR_WITH_LEN("arybase"), op_offset_special, 0, },/*43*/
580 { STR_WITH_LEN("warnings"),op_offset_special, 0, },/*44*/
581 { STR_WITH_LEN("io"), op_offset_special, 0, },/*45*/
582 { STR_WITH_LEN("hints_hash"),op_offset_special, 0, },/*46*/
99639b5b
DM
583 { STR_WITH_LEN("slabbed"), op_offset_special, 0, },/*47*/
584 { STR_WITH_LEN("savefree"),op_offset_special, 0, },/*48*/
585 { STR_WITH_LEN("static"), op_offset_special, 0, },/*49*/
99639b5b 586 { STR_WITH_LEN("folded"), op_offset_special, 0, },/*50*/
87b5a8b9 587 { STR_WITH_LEN("moresib"), op_offset_special, 0, },/*51*/
29e61fd9 588 { STR_WITH_LEN("parent"), op_offset_special, 0, },/*52*/
b46e009d 589 { STR_WITH_LEN("first"), op_offset_special, 0, },/*53*/
590 { STR_WITH_LEN("meth_sv"), op_offset_special, 0, },/*54*/
429ba3b2 591 { STR_WITH_LEN("pmregexp"),op_offset_special, 0, },/*55*/
810bd8b7 592# ifdef USE_ITHREADS
593 { STR_WITH_LEN("rclass"), op_offset_special, 0, },/*56*/
594# else
595 { STR_WITH_LEN("rclass"), op_offset_special, 0, },/*56*/
596# endif
bec746fe
DM
597};
598
b1826b71
NC
599#include "const-c.inc"
600
7a2c16aa 601MODULE = B PACKAGE = B
a8a597b2 602
b1826b71
NC
603INCLUDE: const-xs.inc
604
a8a597b2
MB
605PROTOTYPES: DISABLE
606
607BOOT:
4c1f658f 608{
7a2c16aa
NC
609 CV *cv;
610 const char *file = __FILE__;
c3890f9c 611 SV *sv;
89ca4ac7 612 MY_CXT_INIT;
a462fa00 613 B_init_my_cxt(aTHX_ &(MY_CXT));
32855229 614 cv = newXS("B::init_av", intrpvar_sv_common, file);
115ff745 615 ASSIGN_COMMON_ALIAS(I, initav);
32855229 616 cv = newXS("B::check_av", intrpvar_sv_common, file);
115ff745 617 ASSIGN_COMMON_ALIAS(I, checkav_save);
32855229 618 cv = newXS("B::unitcheck_av", intrpvar_sv_common, file);
115ff745 619 ASSIGN_COMMON_ALIAS(I, unitcheckav_save);
32855229 620 cv = newXS("B::begin_av", intrpvar_sv_common, file);
115ff745 621 ASSIGN_COMMON_ALIAS(I, beginav_save);
32855229 622 cv = newXS("B::end_av", intrpvar_sv_common, file);
115ff745 623 ASSIGN_COMMON_ALIAS(I, endav);
32855229 624 cv = newXS("B::main_cv", intrpvar_sv_common, file);
115ff745 625 ASSIGN_COMMON_ALIAS(I, main_cv);
32855229 626 cv = newXS("B::inc_gv", intrpvar_sv_common, file);
115ff745 627 ASSIGN_COMMON_ALIAS(I, incgv);
32855229 628 cv = newXS("B::defstash", intrpvar_sv_common, file);
115ff745 629 ASSIGN_COMMON_ALIAS(I, defstash);
32855229 630 cv = newXS("B::curstash", intrpvar_sv_common, file);
115ff745 631 ASSIGN_COMMON_ALIAS(I, curstash);
32855229
NC
632#ifdef USE_ITHREADS
633 cv = newXS("B::regex_padav", intrpvar_sv_common, file);
115ff745 634 ASSIGN_COMMON_ALIAS(I, regex_padav);
32855229
NC
635#endif
636 cv = newXS("B::warnhook", intrpvar_sv_common, file);
115ff745 637 ASSIGN_COMMON_ALIAS(I, warnhook);
32855229 638 cv = newXS("B::diehook", intrpvar_sv_common, file);
115ff745 639 ASSIGN_COMMON_ALIAS(I, diehook);
c3890f9c 640 sv = get_sv("B::OP::does_parent", GV_ADDMULTI);
e1812838 641 sv_setsv(sv, &PL_sv_yes);
32855229
NC
642}
643
5f7e30c4
NC
644void
645formfeed()
646 PPCODE:
647 PUSHs(make_sv_object(aTHX_ GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV))));
648
7a2c16aa
NC
649long
650amagic_generation()
651 CODE:
652 RETVAL = PL_amagic_generation;
653 OUTPUT:
654 RETVAL
655
8ae5a962 656void
7a2c16aa 657comppadlist()
7261499d
FC
658 PREINIT:
659 PADLIST *padlist = CvPADLIST(PL_main_cv ? PL_main_cv : PL_compcv);
8ae5a962 660 PPCODE:
7261499d
FC
661 {
662 SV * const rv = sv_newmortal();
663 sv_setiv(newSVrv(rv, padlist ? "B::PADLIST" : "B::NULL"),
664 PTR2IV(padlist));
665 PUSHs(rv);
666 }
7a2c16aa 667
8ae5a962 668void
a4aabc83
NC
669sv_undef()
670 ALIAS:
671 sv_no = 1
672 sv_yes = 2
8ae5a962 673 PPCODE:
0c74f67f
NC
674 PUSHs(make_sv_object(aTHX_ ix > 1 ? &PL_sv_yes
675 : ix < 1 ? &PL_sv_undef
676 : &PL_sv_no));
a4aabc83 677
6079961f 678void
e97701b4
NC
679main_root()
680 ALIAS:
681 main_start = 1
6079961f
NC
682 PPCODE:
683 PUSHs(make_op_object(aTHX_ ix ? PL_main_start : PL_main_root));
e97701b4 684
2edf0c1d
NC
685UV
686sub_generation()
687 ALIAS:
688 dowarn = 1
689 CODE:
690 RETVAL = ix ? PL_dowarn : PL_sub_generation;
691 OUTPUT:
692 RETVAL
693
a8a597b2 694void
20f7624e
NC
695walkoptree(op, method)
696 B::OP op
5d7488b2 697 const char * method
cea2e8a9 698 CODE:
20f7624e 699 (void) walkoptree(aTHX_ op, method, &PL_sv_undef);
a8a597b2
MB
700
701int
702walkoptree_debug(...)
703 CODE:
89ca4ac7 704 dMY_CXT;
a8a597b2
MB
705 RETVAL = walkoptree_debug;
706 if (items > 0 && SvTRUE(ST(1)))
707 walkoptree_debug = 1;
708 OUTPUT:
709 RETVAL
710
56431972 711#define address(sv) PTR2IV(sv)
a8a597b2
MB
712
713IV
714address(sv)
715 SV * sv
716
8ae5a962 717void
a8a597b2
MB
718svref_2object(sv)
719 SV * sv
8ae5a962 720 PPCODE:
a8a597b2
MB
721 if (!SvROK(sv))
722 croak("argument is not a reference");
0c74f67f 723 PUSHs(make_sv_object(aTHX_ SvRV(sv)));
0cc1d052
NIS
724
725void
726opnumber(name)
5d7488b2 727const char * name
0cc1d052
NIS
728CODE:
729{
730 int i;
731 IV result = -1;
732 ST(0) = sv_newmortal();
c8b388b0 733 if (strBEGINs(name,"pp_"))
0cc1d052
NIS
734 name += 3;
735 for (i = 0; i < PL_maxo; i++)
736 {
752602b1 737 if (strEQ(name, PL_op_name[i]))
0cc1d052
NIS
738 {
739 result = i;
740 break;
741 }
742 }
743 sv_setiv(ST(0),result);
744}
a8a597b2
MB
745
746void
747ppname(opnum)
748 int opnum
749 CODE:
750 ST(0) = sv_newmortal();
cc5b6bab
NC
751 if (opnum >= 0 && opnum < PL_maxo)
752 Perl_sv_setpvf(aTHX_ ST(0), "pp_%s", PL_op_name[opnum]);
a8a597b2
MB
753
754void
755hash(sv)
756 SV * sv
757 CODE:
a8a597b2
MB
758 STRLEN len;
759 U32 hash = 0;
8c5b7c71 760 const char *s = SvPVbyte(sv, len);
c32d3395 761 PERL_HASH(hash, s, len);
147e3846 762 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "0x%" UVxf, (UV)hash));
a8a597b2
MB
763
764#define cast_I32(foo) (I32)foo
765IV
766cast_I32(i)
767 IV i
768
769void
770minus_c()
651233d2
NC
771 ALIAS:
772 save_BEGINs = 1
a8a597b2 773 CODE:
651233d2
NC
774 if (ix)
775 PL_savebegin = TRUE;
776 else
777 PL_minus_c = TRUE;
059a8bb7 778
847ded71 779void
a8a597b2
MB
780cstring(sv)
781 SV * sv
84556172
NC
782 ALIAS:
783 perlstring = 1
9e380ad4 784 cchar = 2
09e97b95 785 PPCODE:
847ded71 786 PUSHs(ix == 2 ? cchar(aTHX_ sv) : cstring(aTHX_ sv, (bool)ix));
a8a597b2
MB
787
788void
789threadsv_names()
790 PPCODE:
f5ba1307 791
a8a597b2 792
a462fa00
DD
793#ifdef USE_ITHREADS
794void
795CLONE(...)
796PPCODE:
797 PUTBACK; /* some vars go out of scope now in machine code */
798 {
799 MY_CXT_CLONE;
800 B_init_my_cxt(aTHX_ &(MY_CXT));
801 }
802 return; /* dont execute another implied XSPP PUTBACK */
9488fb36 803
a462fa00 804#endif
a9ed1a44 805
fdbacc68 806MODULE = B PACKAGE = B::OP
a8a597b2 807
651aa52e 808
9b1961be
NC
809# The type checking code in B has always been identical for all OP types,
810# irrespective of whether the action is actually defined on that OP.
811# We should fix this
086f9b42 812void
9b1961be 813next(o)
a8a597b2 814 B::OP o
9b1961be 815 ALIAS:
bec746fe
DM
816 B::OP::next = 0
817 B::OP::sibling = 1
818 B::OP::targ = 2
819 B::OP::flags = 3
820 B::OP::private = 4
821 B::UNOP::first = 5
822 B::BINOP::last = 6
823 B::LOGOP::other = 7
824 B::PMOP::pmreplstart = 8
825 B::LOOP::redoop = 9
826 B::LOOP::nextop = 10
827 B::LOOP::lastop = 11
828 B::PMOP::pmflags = 12
829 B::PMOP::code_list = 13
830 B::SVOP::sv = 14
831 B::SVOP::gv = 15
832 B::PADOP::padix = 16
833 B::COP::cop_seq = 17
834 B::COP::line = 18
835 B::COP::hints = 19
836 B::PMOP::pmoffset = 20
837 B::COP::filegv = 21
838 B::COP::file = 22
839 B::COP::stash = 23
840 B::COP::stashpv = 24
841 B::COP::stashoff = 25
287ce0d8
DM
842 B::OP::size = 26
843 B::OP::name = 27
844 B::OP::desc = 28
845 B::OP::ppaddr = 29
846 B::OP::type = 30
847 B::OP::opt = 31
848 B::OP::spare = 32
849 B::LISTOP::children = 33
850 B::PMOP::pmreplroot = 34
851 B::PMOP::pmstashpv = 35
852 B::PMOP::pmstash = 36
853 B::PMOP::precomp = 37
854 B::PMOP::reflags = 38
855 B::PADOP::sv = 39
856 B::PADOP::gv = 40
857 B::PVOP::pv = 41
858 B::COP::label = 42
859 B::COP::arybase = 43
860 B::COP::warnings = 44
861 B::COP::io = 45
862 B::COP::hints_hash = 46
3164fde4
RU
863 B::OP::slabbed = 47
864 B::OP::savefree = 48
865 B::OP::static = 49
866 B::OP::folded = 50
87b5a8b9 867 B::OP::moresib = 51
29e61fd9 868 B::OP::parent = 52
b46e009d 869 B::METHOP::first = 53
870 B::METHOP::meth_sv = 54
429ba3b2 871 B::PMOP::pmregexp = 55
810bd8b7 872 B::METHOP::rclass = 56
9b1961be 873 PREINIT:
086f9b42
NC
874 SV *ret;
875 PPCODE:
99639b5b 876 if (ix < 0 || (U32)ix >= C_ARRAY_LENGTH(op_methods))
287ce0d8 877 croak("Illegal alias %d for B::*OP::next", (int)ix);
71324a3b
DM
878 ret = get_overlay_object(aTHX_ o,
879 op_methods[ix].name, op_methods[ix].namelen);
880 if (ret) {
881 ST(0) = ret;
882 XSRETURN(1);
883 }
bec746fe
DM
884
885 /* handle non-direct field access */
886
0508288e 887 if (op_methods[ix].type == op_offset_special)
bec746fe 888 switch (ix) {
9d28cd7b 889 case 1: /* B::OP::op_sibling */
e6dae479 890 ret = make_op_object(aTHX_ OpSIBLING(o));
1ed44841
DM
891 break;
892
9d28cd7b 893 case 8: /* B::PMOP::pmreplstart */
2721a2ca
DM
894 ret = make_op_object(aTHX_
895 cPMOPo->op_type == OP_SUBST
896 ? cPMOPo->op_pmstashstartu.op_pmreplstart
897 : NULL
898 );
899 break;
bec746fe 900#ifdef USE_ITHREADS
9d28cd7b 901 case 21: /* B::COP::filegv */
bec746fe
DM
902 ret = make_sv_object(aTHX_ (SV *)CopFILEGV((COP*)o));
903 break;
904#endif
1dc74fdb 905#ifndef USE_ITHREADS
9d28cd7b 906 case 22: /* B::COP::file */
bec746fe
DM
907 ret = sv_2mortal(newSVpv(CopFILE((COP*)o), 0));
908 break;
909#endif
910#ifdef USE_ITHREADS
9d28cd7b 911 case 23: /* B::COP::stash */
bec746fe
DM
912 ret = make_sv_object(aTHX_ (SV *)CopSTASH((COP*)o));
913 break;
914#endif
9d28cd7b 915 case 24: /* B::COP::stashpv */
bec746fe
DM
916 ret = sv_2mortal(CopSTASH((COP*)o)
917 && SvTYPE(CopSTASH((COP*)o)) == SVt_PVHV
918 ? newSVhek(HvNAME_HEK(CopSTASH((COP*)o)))
919 : &PL_sv_undef);
bec746fe 920 break;
9d28cd7b 921 case 26: /* B::OP::size */
1e85b658 922 ret = sv_2mortal(newSVuv((UV)(opsizes[op_class(o)])));
287ce0d8 923 break;
9d28cd7b
DM
924 case 27: /* B::OP::name */
925 case 28: /* B::OP::desc */
287ce0d8
DM
926 ret = sv_2mortal(newSVpv(
927 (char *)(ix == 28 ? OP_DESC(o) : OP_NAME(o)), 0));
928 break;
9d28cd7b 929 case 29: /* B::OP::ppaddr */
287ce0d8
DM
930 {
931 int i;
932 ret = sv_2mortal(Perl_newSVpvf(aTHX_ "PL_ppaddr[OP_%s]",
933 PL_op_name[o->op_type]));
934 for (i=13; (STRLEN)i < SvCUR(ret); ++i)
935 SvPVX(ret)[i] = toUPPER(SvPVX(ret)[i]);
936 }
937 break;
9d28cd7b
DM
938 case 30: /* B::OP::type */
939 case 31: /* B::OP::opt */
940 case 32: /* B::OP::spare */
9d28cd7b
DM
941 case 47: /* B::OP::slabbed */
942 case 48: /* B::OP::savefree */
943 case 49: /* B::OP::static */
9d28cd7b 944 case 50: /* B::OP::folded */
87b5a8b9 945 case 51: /* B::OP::moresib */
3164fde4 946 /* These are all bitfields, so we can't take their addresses */
287ce0d8
DM
947 ret = sv_2mortal(newSVuv((UV)(
948 ix == 30 ? o->op_type
949 : ix == 31 ? o->op_opt
3164fde4
RU
950 : ix == 47 ? o->op_slabbed
951 : ix == 48 ? o->op_savefree
952 : ix == 49 ? o->op_static
953 : ix == 50 ? o->op_folded
87b5a8b9 954 : ix == 51 ? o->op_moresib
287ce0d8
DM
955 : o->op_spare)));
956 break;
9d28cd7b 957 case 33: /* B::LISTOP::children */
287ce0d8
DM
958 {
959 OP *kid;
960 UV i = 0;
e6dae479 961 for (kid = ((LISTOP*)o)->op_first; kid; kid = OpSIBLING(kid))
287ce0d8
DM
962 i++;
963 ret = sv_2mortal(newSVuv(i));
964 }
965 break;
9d28cd7b 966 case 34: /* B::PMOP::pmreplroot */
5012eebe 967 if (cPMOPo->op_type == OP_SPLIT) {
287ce0d8 968 ret = sv_newmortal();
5012eebe
DM
969#ifndef USE_ITHREADS
970 if (o->op_private & OPpSPLIT_LEX)
971#endif
972 sv_setiv(ret, cPMOPo->op_pmreplrootu.op_pmtargetoff);
973#ifndef USE_ITHREADS
974 else {
975 GV *const target = cPMOPo->op_pmreplrootu.op_pmtargetgv;
976 sv_setiv(newSVrv(ret, target ?
977 svclassnames[SvTYPE((SV*)target)] : "B::SV"),
978 PTR2IV(target));
979 }
287ce0d8
DM
980#endif
981 }
982 else {
983 OP *const root = cPMOPo->op_pmreplrootu.op_pmreplroot;
984 ret = make_op_object(aTHX_ root);
985 }
986 break;
987#ifdef USE_ITHREADS
9d28cd7b 988 case 35: /* B::PMOP::pmstashpv */
287ce0d8
DM
989 ret = sv_2mortal(newSVpv(PmopSTASHPV(cPMOPo),0));
990 break;
991#else
9d28cd7b 992 case 36: /* B::PMOP::pmstash */
287ce0d8
DM
993 ret = make_sv_object(aTHX_ (SV *) PmopSTASH(cPMOPo));
994 break;
995#endif
9d28cd7b
DM
996 case 37: /* B::PMOP::precomp */
997 case 38: /* B::PMOP::reflags */
287ce0d8
DM
998 {
999 REGEXP *rx = PM_GETRE(cPMOPo);
1000 ret = sv_newmortal();
1001 if (rx) {
1002 if (ix==38) {
1003 sv_setuv(ret, RX_EXTFLAGS(rx));
1004 }
1005 else {
1006 sv_setpvn(ret, RX_PRECOMP(rx), RX_PRELEN(rx));
fea7fb25
DM
1007 if (RX_UTF8(rx))
1008 SvUTF8_on(ret);
287ce0d8
DM
1009 }
1010 }
1011 }
1012 break;
3a23d767
DM
1013 case 39: /* B::PADOP::sv */
1014 case 40: /* B::PADOP::gv */
1015 /* PADOPs should only be created on threaded builds.
1016 * They don't have an sv or gv field, just an op_padix
1017 * field. Leave it to the caller to retrieve padix
1018 * and look up th value in the pad. Don't do it here,
1019 * becuase PL_curpad is the pad of the caller, not the
1020 * pad of the sub the op is part of */
1021 ret = make_sv_object(aTHX_ NULL);
287ce0d8 1022 break;
9d28cd7b 1023 case 41: /* B::PVOP::pv */
0b9a13c3
DM
1024 /* OP_TRANS uses op_pv to point to a OPtrans_map struct,
1025 * whereas other PVOPs point to a null terminated string.
1026 * For trans, for now just return the whole struct as a
1027 * string and let the caller unpack() it */
c923a699
DM
1028 if ( cPVOPo->op_type == OP_TRANS
1029 || cPVOPo->op_type == OP_TRANSR)
1030 {
0b9a13c3 1031 const OPtrans_map *const tbl = (OPtrans_map*)cPVOPo->op_pv;
c923a699 1032 ret = newSVpvn_flags(cPVOPo->op_pv,
0b9a13c3
DM
1033 (char*)(&tbl->map[tbl->size + 1])
1034 - (char*)tbl,
c923a699 1035 SVs_TEMP);
287ce0d8
DM
1036 }
1037 else
1038 ret = newSVpvn_flags(cPVOPo->op_pv, strlen(cPVOPo->op_pv), SVs_TEMP);
1039 break;
9d28cd7b 1040 case 42: /* B::COP::label */
287ce0d8
DM
1041 ret = sv_2mortal(newSVpv(CopLABEL(cCOPo),0));
1042 break;
9d28cd7b 1043 case 43: /* B::COP::arybase */
287ce0d8
DM
1044 ret = sv_2mortal(newSVuv(0));
1045 break;
9d28cd7b 1046 case 44: /* B::COP::warnings */
287ce0d8
DM
1047 ret = make_warnings_object(aTHX_ cCOPo);
1048 break;
9d28cd7b 1049 case 45: /* B::COP::io */
287ce0d8
DM
1050 ret = make_cop_io_object(aTHX_ cCOPo);
1051 break;
9d28cd7b 1052 case 46: /* B::COP::hints_hash */
287ce0d8
DM
1053 ret = sv_newmortal();
1054 sv_setiv(newSVrv(ret, "B::RHE"),
1055 PTR2IV(CopHINTHASH_get(cCOPo)));
1056 break;
9d28cd7b 1057 case 52: /* B::OP::parent */
1fafe688 1058#ifdef PERL_OP_PARENT
29e61fd9 1059 ret = make_op_object(aTHX_ op_parent(o));
1fafe688
DM
1060#else
1061 ret = make_op_object(aTHX_ NULL);
1062#endif
29e61fd9 1063 break;
b46e009d 1064 case 53: /* B::METHOP::first */
1065 /* METHOP struct has an op_first/op_meth_sv union
1066 * as its first extra field. How to interpret the
1067 * union depends on the op type. For the purposes of
1068 * B, we treat it as a struct with both fields present,
1069 * where one of the fields always happens to be null
1070 * (i.e. we return NULL in preference to croaking with
1071 * 'method not implemented').
1072 */
1073 ret = make_op_object(aTHX_
1074 o->op_type == OP_METHOD
1075 ? cMETHOPx(o)->op_u.op_first : NULL);
1076 break;
1077 case 54: /* B::METHOP::meth_sv */
1078 /* see comment above about METHOP */
1079 ret = make_sv_object(aTHX_
1080 o->op_type == OP_METHOD
1081 ? NULL : cMETHOPx(o)->op_u.op_meth_sv);
1082 break;
429ba3b2
FC
1083 case 55: /* B::PMOP::pmregexp */
1084 ret = make_sv_object(aTHX_ (SV *)PM_GETRE(cPMOPo));
1085 break;
810bd8b7 1086 case 56: /* B::METHOP::rclass */
1087#ifdef USE_ITHREADS
1088 ret = sv_2mortal(newSVuv(
1089 (o->op_type == OP_METHOD_REDIR ||
1090 o->op_type == OP_METHOD_REDIR_SUPER) ?
1091 cMETHOPx(o)->op_rclass_targ : 0
1092 ));
1093#else
1094 ret = make_sv_object(aTHX_
1095 (o->op_type == OP_METHOD_REDIR ||
1096 o->op_type == OP_METHOD_REDIR_SUPER) ?
1097 cMETHOPx(o)->op_rclass_sv : NULL
1098 );
1099#endif
1100 break;
bec746fe
DM
1101 default:
1102 croak("method %s not implemented", op_methods[ix].name);
0508288e
NC
1103 } else {
1104 /* do a direct structure offset lookup */
1105 const char *const ptr = (char *)o + op_methods[ix].offset;
f68c0b4a
NC
1106 switch (op_methods[ix].type) {
1107 case OPp:
1108 ret = make_op_object(aTHX_ *((OP **)ptr));
1109 break;
1110 case PADOFFSETp:
1111 ret = sv_2mortal(newSVuv(*((PADOFFSET*)ptr)));
1112 break;
1113 case U8p:
1114 ret = sv_2mortal(newSVuv(*((U8*)ptr)));
1115 break;
1116 case U32p:
1117 ret = sv_2mortal(newSVuv(*((U32*)ptr)));
1118 break;
1119 case SVp:
1120 ret = make_sv_object(aTHX_ *((SV **)ptr));
1121 break;
1122 case line_tp:
1123 ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
1124 break;
1125 case IVp:
1126 ret = sv_2mortal(newSViv(*((IV*)ptr)));
1127 break;
1128 case char_pp:
1129 ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
1130 break;
1131 default:
0508288e 1132 croak("Illegal type 0x%x for B::*OP::%s",
f68c0b4a 1133 (unsigned)op_methods[ix].type, op_methods[ix].name);
0508288e 1134 }
086f9b42
NC
1135 }
1136 ST(0) = ret;
1137 XSRETURN(1);
a8a597b2 1138
7252851f 1139
1df34986 1140void
fdbacc68 1141oplist(o)
1df34986
AE
1142 B::OP o
1143 PPCODE:
1144 SP = oplist(aTHX_ o, SP);
1145
e412117e 1146
2f7c6295
DM
1147
1148MODULE = B PACKAGE = B::UNOP_AUX
1149
1150# UNOP_AUX class ops are like UNOPs except that they have an extra
1151# op_aux pointer that points to an array of UNOP_AUX_item unions.
1152# Element -1 of the array contains the length
1153
1154
1155# return a string representation of op_aux where possible The op's CV is
1156# needed as an extra arg to allow GVs and SVs moved into the pad to be
1157# accessed okay.
1158
1159void
1160string(o, cv)
1161 B::OP o
1162 B::CV cv
1163 PREINIT:
1164 SV *ret;
4fa06845 1165 UNOP_AUX_item *aux;
2f7c6295 1166 PPCODE:
4fa06845 1167 aux = cUNOP_AUXo->op_aux;
2f7c6295 1168 switch (o->op_type) {
e839e6ed
DM
1169 case OP_MULTICONCAT:
1170 ret = multiconcat_stringify(o);
1171 break;
1172
fedf30e1 1173 case OP_MULTIDEREF:
48ee9c0e 1174 ret = multideref_stringify(o, cv);
fedf30e1 1175 break;
4fa06845
DM
1176
1177 case OP_ARGELEM:
147e3846 1178 ret = sv_2mortal(Perl_newSVpvf(aTHX_ "%" IVdf,
6daeaaa3 1179 PTR2IV(aux)));
4fa06845
DM
1180 break;
1181
1182 case OP_ARGCHECK:
f417cfa9
DM
1183 {
1184 struct op_argcheck_aux *p = (struct op_argcheck_aux*)aux;
1185 ret = Perl_newSVpvf(aTHX_ "%" IVdf ",%" IVdf,
1186 p->params, p->opt_params);
1187 if (p->slurpy)
1188 Perl_sv_catpvf(aTHX_ ret, ",%c", p->slurpy);
1189 ret = sv_2mortal(ret);
1190 break;
1191 }
4fa06845 1192
2f7c6295
DM
1193 default:
1194 ret = sv_2mortal(newSVpvn("", 0));
1195 }
4fa06845 1196
2f7c6295
DM
1197 ST(0) = ret;
1198 XSRETURN(1);
1199
1200
1201# Return the contents of the op_aux array as a list of IV/GV/etc objects.
1202# How to interpret each array element is op-dependent. The op's CV is
1203# needed as an extra arg to allow GVs and SVs which have been moved into
1204# the pad to be accessed okay.
1205
1206void
1207aux_list(o, cv)
1208 B::OP o
1209 B::CV cv
4fa06845
DM
1210 PREINIT:
1211 UNOP_AUX_item *aux;
2f7c6295 1212 PPCODE:
fedf30e1 1213 PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
4fa06845 1214 aux = cUNOP_AUXo->op_aux;
2f7c6295
DM
1215 switch (o->op_type) {
1216 default:
1217 XSRETURN(0); /* by default, an empty list */
fedf30e1 1218
4fa06845 1219 case OP_ARGELEM:
6daeaaa3 1220 XPUSHs(sv_2mortal(newSViv(PTR2IV(aux))));
4fa06845
DM
1221 XSRETURN(1);
1222 break;
1223
1224 case OP_ARGCHECK:
f417cfa9
DM
1225 {
1226 struct op_argcheck_aux *p = (struct op_argcheck_aux*)aux;
1227 EXTEND(SP, 3);
1228 PUSHs(sv_2mortal(newSViv(p->params)));
1229 PUSHs(sv_2mortal(newSViv(p->opt_params)));
1230 PUSHs(sv_2mortal(p->slurpy
1231 ? Perl_newSVpvf(aTHX_ "%c", p->slurpy)
1232 : &PL_sv_no));
1233 break;
1234 }
4fa06845 1235
e839e6ed
DM
1236 case OP_MULTICONCAT:
1237 {
ca84e88e 1238 SSize_t nargs;
e839e6ed
DM
1239 char *p;
1240 STRLEN len;
1241 U32 utf8 = 0;
1242 SV *sv;
1243 UNOP_AUX_item *lens;
1244
1245 /* return (nargs, const string, segment len 0, 1, 2, ...) */
1246
1247 /* if this changes, this block of code probably needs fixing */
1248 assert(PERL_MULTICONCAT_HEADER_SIZE == 5);
ca84e88e 1249 nargs = aux[PERL_MULTICONCAT_IX_NARGS].ssize;
e839e6ed 1250 EXTEND(SP, ((SSize_t)(2 + (nargs+1))));
ca84e88e 1251 PUSHs(sv_2mortal(newSViv((IV)nargs)));
e839e6ed
DM
1252
1253 p = aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv;
b5bf9f73 1254 len = aux[PERL_MULTICONCAT_IX_PLAIN_LEN].ssize;
e839e6ed
DM
1255 if (!p) {
1256 p = aux[PERL_MULTICONCAT_IX_UTF8_PV].pv;
b5bf9f73 1257 len = aux[PERL_MULTICONCAT_IX_UTF8_LEN].ssize;
e839e6ed
DM
1258 utf8 = SVf_UTF8;
1259 }
1260 sv = newSVpvn(p, len);
1261 SvFLAGS(sv) |= utf8;
1262 PUSHs(sv_2mortal(sv));
1263
1264 lens = aux + PERL_MULTICONCAT_IX_LENGTHS;
1265 nargs++; /* loop (nargs+1) times */
1266 if (utf8) {
1267 U8 *p = (U8*)SvPVX(sv);
1268 while (nargs--) {
b5bf9f73 1269 SSize_t bytes = lens->ssize;
e839e6ed
DM
1270 SSize_t chars;
1271 if (bytes <= 0)
1272 chars = bytes;
1273 else {
1274 /* return char lengths rather than byte lengths */
1275 chars = utf8_length(p, p + bytes);
1276 p += bytes;
1277 }
1278 lens++;
1279 PUSHs(sv_2mortal(newSViv(chars)));
1280 }
1281 }
1282 else {
1283 while (nargs--) {
b5bf9f73 1284 PUSHs(sv_2mortal(newSViv(lens->ssize)));
e839e6ed
DM
1285 lens++;
1286 }
1287 }
1288 break;
1289 }
1290
fedf30e1
DM
1291 case OP_MULTIDEREF:
1292#ifdef USE_ITHREADS
1293# define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
1294#else
1295# define ITEM_SV(item) UNOP_AUX_item_sv(item)
1296#endif
1297 {
1298 UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
1299 UV actions = items->uv;
1300 UV len = items[-1].uv;
1301 SV *sv;
1302 bool last = 0;
1303 bool is_hash = FALSE;
1304#ifdef USE_ITHREADS
1305 PADLIST * const padlist = CvPADLIST(cv);
9cdf4efd 1306 PAD *comppad = PadlistARRAY(padlist)[1];
fedf30e1
DM
1307#endif
1308
052a7c76
DM
1309 /* len should never be big enough to truncate or wrap */
1310 assert(len <= SSize_t_MAX);
1311 EXTEND(SP, (SSize_t)len);
fedf30e1
DM
1312 PUSHs(sv_2mortal(newSViv(actions)));
1313
1314 while (!last) {
1315 switch (actions & MDEREF_ACTION_MASK) {
1316
1317 case MDEREF_reload:
1318 actions = (++items)->uv;
1319 PUSHs(sv_2mortal(newSVuv(actions)));
1320 continue;
2b5060ae 1321 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM
1322
1323 case MDEREF_HV_padhv_helem:
1324 is_hash = TRUE;
2b5060ae 1325 /* FALLTHROUGH */
fedf30e1
DM
1326 case MDEREF_AV_padav_aelem:
1327 PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
1328 goto do_elem;
2b5060ae 1329 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM
1330
1331 case MDEREF_HV_gvhv_helem:
1332 is_hash = TRUE;
2b5060ae 1333 /* FALLTHROUGH */
fedf30e1
DM
1334 case MDEREF_AV_gvav_aelem:
1335 sv = ITEM_SV(++items);
1336 PUSHs(make_sv_object(aTHX_ sv));
1337 goto do_elem;
2b5060ae 1338 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM
1339
1340 case MDEREF_HV_gvsv_vivify_rv2hv_helem:
1341 is_hash = TRUE;
2b5060ae 1342 /* FALLTHROUGH */
fedf30e1
DM
1343 case MDEREF_AV_gvsv_vivify_rv2av_aelem:
1344 sv = ITEM_SV(++items);
1345 PUSHs(make_sv_object(aTHX_ sv));
1346 goto do_vivify_rv2xv_elem;
2b5060ae 1347 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM
1348
1349 case MDEREF_HV_padsv_vivify_rv2hv_helem:
1350 is_hash = TRUE;
2b5060ae 1351 /* FALLTHROUGH */
fedf30e1
DM
1352 case MDEREF_AV_padsv_vivify_rv2av_aelem:
1353 PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
1354 goto do_vivify_rv2xv_elem;
2b5060ae 1355 NOT_REACHED; /* NOTREACHED */
fedf30e1
DM
1356
1357 case MDEREF_HV_pop_rv2hv_helem:
1358 case MDEREF_HV_vivify_rv2hv_helem:
1359 is_hash = TRUE;
2b5060ae 1360 /* FALLTHROUGH */
fedf30e1
DM
1361 do_vivify_rv2xv_elem:
1362 case MDEREF_AV_pop_rv2av_aelem:
1363 case MDEREF_AV_vivify_rv2av_aelem:
1364 do_elem:
1365 switch (actions & MDEREF_INDEX_MASK) {
1366 case MDEREF_INDEX_none:
1367 last = 1;
1368 break;
1369 case MDEREF_INDEX_const:
1370 if (is_hash) {
1371 sv = ITEM_SV(++items);
1372 PUSHs(make_sv_object(aTHX_ sv));
1373 }
1374 else
1375 PUSHs(sv_2mortal(newSViv((++items)->iv)));
1376 break;
1377 case MDEREF_INDEX_padsv:
1378 PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
1379 break;
1380 case MDEREF_INDEX_gvsv:
1381 sv = ITEM_SV(++items);
1382 PUSHs(make_sv_object(aTHX_ sv));
1383 break;
1384 }
1385 if (actions & MDEREF_FLAG_last)
1386 last = 1;
1387 is_hash = FALSE;
1388
1389 break;
1390 } /* switch */
1391
1392 actions >>= MDEREF_SHIFT;
1393 } /* while */
1394 XSRETURN(len);
1395
1396 } /* OP_MULTIDEREF */
2f7c6295
DM
1397 } /* switch */
1398
1399
1400
651aa52e
AE
1401MODULE = B PACKAGE = B::SV
1402
de64752d
NC
1403#define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
1404
651aa52e 1405U32
de64752d 1406REFCNT(sv)
651aa52e 1407 B::SV sv
de64752d
NC
1408 ALIAS:
1409 FLAGS = 0xFFFFFFFF
1410 SvTYPE = SVTYPEMASK
1411 POK = SVf_POK
1412 ROK = SVf_ROK
1413 MAGICAL = MAGICAL_FLAG_BITS
1414 CODE:
1415 RETVAL = ix ? (SvFLAGS(sv) & (U32)ix) : SvREFCNT(sv);
1416 OUTPUT:
1417 RETVAL
651aa52e 1418
9efba5c8 1419void
429a5ce7
SM
1420object_2svref(sv)
1421 B::SV sv
9efba5c8
NC
1422 PPCODE:
1423 ST(0) = sv_2mortal(newRV(sv));
1424 XSRETURN(1);
1425
a8a597b2
MB
1426MODULE = B PACKAGE = B::IV PREFIX = Sv
1427
1428IV
1429SvIV(sv)
1430 B::IV sv
1431
e4da9d6a 1432MODULE = B PACKAGE = B::IV
a8a597b2 1433
e4da9d6a
NC
1434#define sv_SVp 0x00000
1435#define sv_IVp 0x10000
1436#define sv_UVp 0x20000
1437#define sv_STRLENp 0x30000
1438#define sv_U32p 0x40000
1439#define sv_U8p 0x50000
1440#define sv_char_pp 0x60000
1441#define sv_NVp 0x70000
6782c6e0 1442#define sv_char_p 0x80000
3da43c35 1443#define sv_SSize_tp 0x90000
ffc5d9fc
NC
1444#define sv_I32p 0xA0000
1445#define sv_U16p 0xB0000
e4da9d6a 1446
3800c318
JH
1447#define IV_ivx_ix sv_IVp | STRUCT_OFFSET(struct xpviv, xiv_iv)
1448#define IV_uvx_ix sv_UVp | STRUCT_OFFSET(struct xpvuv, xuv_uv)
1449#define NV_nvx_ix sv_NVp | STRUCT_OFFSET(struct xpvnv, xnv_u.xnv_nv)
e4da9d6a 1450
3800c318
JH
1451#define PV_cur_ix sv_STRLENp | STRUCT_OFFSET(struct xpv, xpv_cur)
1452#define PV_len_ix sv_STRLENp | STRUCT_OFFSET(struct xpv, xpv_len)
6782c6e0 1453
3800c318 1454#define PVMG_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvmg, xmg_stash)
6782c6e0 1455
9ca4b7ea 1456#define PVBM_useful_ix sv_IVp | STRUCT_OFFSET(struct xpviv, xiv_u.xivu_iv)
91a71e08 1457
3800c318
JH
1458#define PVLV_targoff_ix sv_U32p | STRUCT_OFFSET(struct xpvlv, xlv_targoff)
1459#define PVLV_targlen_ix sv_U32p | STRUCT_OFFSET(struct xpvlv, xlv_targlen)
1460#define PVLV_targ_ix sv_SVp | STRUCT_OFFSET(struct xpvlv, xlv_targ)
1461#define PVLV_type_ix sv_char_p | STRUCT_OFFSET(struct xpvlv, xlv_type)
1462
1463#define PVGV_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvgv, xnv_u.xgv_stash)
1464#define PVGV_flags_ix sv_STRLENp | STRUCT_OFFSET(struct xpvgv, xpv_cur)
1465#define PVIO_lines_ix sv_IVp | STRUCT_OFFSET(struct xpvio, xiv_iv)
1466
1467#define PVIO_page_ix sv_IVp | STRUCT_OFFSET(struct xpvio, xio_page)
1468#define PVIO_page_len_ix sv_IVp | STRUCT_OFFSET(struct xpvio, xio_page_len)
1469#define PVIO_lines_left_ix sv_IVp | STRUCT_OFFSET(struct xpvio, xio_lines_left)
1470#define PVIO_top_name_ix sv_char_pp | STRUCT_OFFSET(struct xpvio, xio_top_name)
1471#define PVIO_top_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvio, xio_top_gv)
1472#define PVIO_fmt_name_ix sv_char_pp | STRUCT_OFFSET(struct xpvio, xio_fmt_name)
1473#define PVIO_fmt_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvio, xio_fmt_gv)
1474#define PVIO_bottom_name_ix sv_char_pp | STRUCT_OFFSET(struct xpvio, xio_bottom_name)
1475#define PVIO_bottom_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvio, xio_bottom_gv)
1476#define PVIO_type_ix sv_char_p | STRUCT_OFFSET(struct xpvio, xio_type)
1477#define PVIO_flags_ix sv_U8p | STRUCT_OFFSET(struct xpvio, xio_flags)
1478
1479#define PVAV_max_ix sv_SSize_tp | STRUCT_OFFSET(struct xpvav, xav_max)
1480
1481#define PVCV_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_stash)
9ca4b7ea 1482#define PVCV_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_gv_u.xcv_gv)
3800c318
JH
1483#define PVCV_file_ix sv_char_pp | STRUCT_OFFSET(struct xpvcv, xcv_file)
1484#define PVCV_outside_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_outside)
1485#define PVCV_outside_seq_ix sv_U32p | STRUCT_OFFSET(struct xpvcv, xcv_outside_seq)
1486#define PVCV_flags_ix sv_U32p | STRUCT_OFFSET(struct xpvcv, xcv_flags)
ffc5d9fc 1487
3800c318 1488#define PVHV_max_ix sv_STRLENp | STRUCT_OFFSET(struct xpvhv, xhv_max)
3800c318 1489#define PVHV_keys_ix sv_STRLENp | STRUCT_OFFSET(struct xpvhv, xhv_keys)
d65a2b0a 1490
e4da9d6a
NC
1491# The type checking code in B has always been identical for all SV types,
1492# irrespective of whether the action is actually defined on that SV.
1493# We should fix this
1494void
1495IVX(sv)
1496 B::SV sv
1497 ALIAS:
1498 B::IV::IVX = IV_ivx_ix
1499 B::IV::UVX = IV_uvx_ix
1500 B::NV::NVX = NV_nvx_ix
6782c6e0
NC
1501 B::PV::CUR = PV_cur_ix
1502 B::PV::LEN = PV_len_ix
1503 B::PVMG::SvSTASH = PVMG_stash_ix
1504 B::PVLV::TARGOFF = PVLV_targoff_ix
1505 B::PVLV::TARGLEN = PVLV_targlen_ix
1506 B::PVLV::TARG = PVLV_targ_ix
1507 B::PVLV::TYPE = PVLV_type_ix
f1f19364
NC
1508 B::GV::STASH = PVGV_stash_ix
1509 B::GV::GvFLAGS = PVGV_flags_ix
91a71e08 1510 B::BM::USEFUL = PVBM_useful_ix
55440d31
NC
1511 B::IO::LINES = PVIO_lines_ix
1512 B::IO::PAGE = PVIO_page_ix
1513 B::IO::PAGE_LEN = PVIO_page_len_ix
1514 B::IO::LINES_LEFT = PVIO_lines_left_ix
1515 B::IO::TOP_NAME = PVIO_top_name_ix
1516 B::IO::TOP_GV = PVIO_top_gv_ix
1517 B::IO::FMT_NAME = PVIO_fmt_name_ix
1518 B::IO::FMT_GV = PVIO_fmt_gv_ix
1519 B::IO::BOTTOM_NAME = PVIO_bottom_name_ix
1520 B::IO::BOTTOM_GV = PVIO_bottom_gv_ix
1521 B::IO::IoTYPE = PVIO_type_ix
1522 B::IO::IoFLAGS = PVIO_flags_ix
3da43c35 1523 B::AV::MAX = PVAV_max_ix
ffc5d9fc 1524 B::CV::STASH = PVCV_stash_ix
ffc5d9fc 1525 B::CV::FILE = PVCV_file_ix
ffc5d9fc
NC
1526 B::CV::OUTSIDE = PVCV_outside_ix
1527 B::CV::OUTSIDE_SEQ = PVCV_outside_seq_ix
1528 B::CV::CvFLAGS = PVCV_flags_ix
d65a2b0a
NC
1529 B::HV::MAX = PVHV_max_ix
1530 B::HV::KEYS = PVHV_keys_ix
e4da9d6a
NC
1531 PREINIT:
1532 char *ptr;
1533 SV *ret;
1534 PPCODE:
1535 ptr = (ix & 0xFFFF) + (char *)SvANY(sv);
1536 switch ((U8)(ix >> 16)) {
1537 case (U8)(sv_SVp >> 16):
428744c7 1538 ret = make_sv_object(aTHX_ *((SV **)ptr));
e4da9d6a
NC
1539 break;
1540 case (U8)(sv_IVp >> 16):
1541 ret = sv_2mortal(newSViv(*((IV *)ptr)));
1542 break;
1543 case (U8)(sv_UVp >> 16):
1544 ret = sv_2mortal(newSVuv(*((UV *)ptr)));
1545 break;
6782c6e0
NC
1546 case (U8)(sv_STRLENp >> 16):
1547 ret = sv_2mortal(newSVuv(*((STRLEN *)ptr)));
1548 break;
e4da9d6a
NC
1549 case (U8)(sv_U32p >> 16):
1550 ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
1551 break;
1552 case (U8)(sv_U8p >> 16):
1553 ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
1554 break;
1555 case (U8)(sv_char_pp >> 16):
1556 ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
1557 break;
1558 case (U8)(sv_NVp >> 16):
1559 ret = sv_2mortal(newSVnv(*((NV *)ptr)));
1560 break;
6782c6e0
NC
1561 case (U8)(sv_char_p >> 16):
1562 ret = newSVpvn_flags((char *)ptr, 1, SVs_TEMP);
1563 break;
3da43c35
NC
1564 case (U8)(sv_SSize_tp >> 16):
1565 ret = sv_2mortal(newSViv(*((SSize_t *)ptr)));
1566 break;
ffc5d9fc
NC
1567 case (U8)(sv_I32p >> 16):
1568 ret = sv_2mortal(newSVuv(*((I32 *)ptr)));
1569 break;
1570 case (U8)(sv_U16p >> 16):
1571 ret = sv_2mortal(newSVuv(*((U16 *)ptr)));
1572 break;
c33e8be1
Z
1573 default:
1574 croak("Illegal alias 0x%08x for B::*IVX", (unsigned)ix);
e4da9d6a
NC
1575 }
1576 ST(0) = ret;
1577 XSRETURN(1);
a8a597b2 1578
a8a597b2
MB
1579void
1580packiv(sv)
1581 B::IV sv
6829f5e2
NC
1582 ALIAS:
1583 needs64bits = 1
a8a597b2 1584 CODE:
6829f5e2
NC
1585 if (ix) {
1586 ST(0) = boolSV((I32)SvIVX(sv) != SvIVX(sv));
1587 } else if (sizeof(IV) == 8) {
a8a597b2 1588 U32 wp[2];
5d7488b2 1589 const IV iv = SvIVX(sv);
a8a597b2
MB
1590 /*
1591 * The following way of spelling 32 is to stop compilers on
1592 * 32-bit architectures from moaning about the shift count
1593 * being >= the width of the type. Such architectures don't
1594 * reach this code anyway (unless sizeof(IV) > 8 but then
1595 * everything else breaks too so I'm not fussed at the moment).
1596 */
42718184
RB
1597#ifdef UV_IS_QUAD
1598 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1599#else
1600 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1601#endif
a8a597b2 1602 wp[1] = htonl(iv & 0xffffffff);
d3d34884 1603 ST(0) = newSVpvn_flags((char *)wp, 8, SVs_TEMP);
a8a597b2
MB
1604 } else {
1605 U32 w = htonl((U32)SvIVX(sv));
d3d34884 1606 ST(0) = newSVpvn_flags((char *)&w, 4, SVs_TEMP);
a8a597b2
MB
1607 }
1608
1609MODULE = B PACKAGE = B::NV PREFIX = Sv
1610
76ef7183 1611NV
a8a597b2
MB
1612SvNV(sv)
1613 B::NV sv
1614
89c6bc13
NC
1615MODULE = B PACKAGE = B::REGEXP
1616
154b8842 1617void
81e413dd 1618REGEX(sv)
89c6bc13 1619 B::REGEXP sv
81e413dd
NC
1620 ALIAS:
1621 precomp = 1
6190dd99 1622 qr_anoncv = 2
1f306347 1623 compflags = 3
154b8842 1624 PPCODE:
6190dd99 1625 if (ix == 1) {
81e413dd 1626 PUSHs(newSVpvn_flags(RX_PRECOMP(sv), RX_PRELEN(sv), SVs_TEMP));
1f306347 1627 } else if (ix == 2) {
6190dd99 1628 PUSHs(make_sv_object(aTHX_ (SV *)ReANY(sv)->qr_anoncv));
81e413dd
NC
1629 } else {
1630 dXSTARG;
17d6506d
DD
1631 if (ix)
1632 PUSHu(RX_COMPFLAGS(sv));
1633 else
81e413dd 1634 /* FIXME - can we code this method more efficiently? */
17d6506d 1635 PUSHi(PTR2IV(sv));
81e413dd 1636 }
89c6bc13 1637
47e6c6d9
N
1638MODULE = B PACKAGE = B::INVLIST PREFIX = Invlist
1639
1640int
1641prev_index(invlist)
1642 B::INVLIST invlist
1643 CODE:
1644 RETVAL = ((XINVLIST*) SvANY(invlist))->prev_index;
1645 OUTPUT:
1646 RETVAL
1647
1648int
1649is_offset(invlist)
1650 B::INVLIST invlist
1651 CODE:
1652 RETVAL = ((XINVLIST*) SvANY(invlist))->is_offset == TRUE ? 1 : 0;
1653 OUTPUT:
1654 RETVAL
1655
1656unsigned int
1657array_len(invlist)
1658 B::INVLIST invlist
1659 CODE:
1660 {
1661 if (SvCUR(invlist) > 0)
1662 RETVAL = FROM_INTERNAL_SIZE(SvCUR(invlist)); /* - ((XINVLIST*) SvANY(invlist))->is_offset; */ /* <- for iteration */
1663 else
1664 RETVAL = 0;
1665 }
1666 OUTPUT:
1667 RETVAL
1668
1669void
1670get_invlist_array(invlist)
1671 B::INVLIST invlist
1672PPCODE:
1673 {
1674 /* should use invlist_is_iterating but not public for now */
1675 bool is_iterating = ( (XINVLIST*) SvANY(invlist) )->iterator < (STRLEN) UV_MAX;
1676
1677 if (is_iterating) {
1678 croak( "Can't access inversion list: in middle of iterating" );
1679 }
1680
1681 {
1682 UV pos;
1683 UV len;
1684
1685 len = 0;
1686 /* should use _invlist_len (or not) */
1687 if (SvCUR(invlist) > 0)
1688 len = FROM_INTERNAL_SIZE(SvCUR(invlist)); /* - ((XINVLIST*) SvANY(invlist))->is_offset; */ /* <- for iteration */
1689
1690 if ( len > 0 ) {
1691 UV *array = (UV*) SvPVX( invlist ); /* invlist_array */
1692
1693 EXTEND(SP, (int) len);
1694
1695 for ( pos = 0; pos < len; ++pos ) {
1696 PUSHs( sv_2mortal( newSVuv(array[pos]) ) );
1697 }
1698 }
1699 }
1700
1701 }
1702
fdbacc68 1703MODULE = B PACKAGE = B::PV
a8a597b2 1704
8ae5a962 1705void
fdbacc68 1706RV(sv)
b326da91 1707 B::PV sv
8ae5a962
NC
1708 PPCODE:
1709 if (!SvROK(sv))
b326da91 1710 croak( "argument is not SvROK" );
0c74f67f 1711 PUSHs(make_sv_object(aTHX_ SvRV(sv)));
b326da91 1712
a8a597b2 1713void
fdbacc68 1714PV(sv)
a8a597b2 1715 B::PV sv
3d665704
NC
1716 ALIAS:
1717 PVX = 1
f4c36584 1718 PVBM = 2
84fea184 1719 B::BM::TABLE = 3
a804b0fe
NC
1720 PREINIT:
1721 const char *p;
1722 STRLEN len = 0;
1723 U32 utf8 = 0;
a8a597b2 1724 CODE:
84fea184 1725 if (ix == 3) {
2bda37ba
NC
1726 const MAGIC *const mg = mg_find(sv, PERL_MAGIC_bm);
1727
1728 if (!mg)
1729 croak("argument to B::BM::TABLE is not a PVBM");
1730 p = mg->mg_ptr;
1731 len = mg->mg_len;
84fea184 1732 } else if (ix == 2) {
f4c36584 1733 /* This used to read 257. I think that that was buggy - should have
26ec7981
NC
1734 been 258. (The "\0", the flags byte, and 256 for the table.)
1735 The only user of this method is B::Bytecode in B::PV::bsave.
1736 I'm guessing that nothing tested the runtime correctness of
1737 output of bytecompiled string constant arguments to index (etc).
1738
1739 Note the start pointer is and has always been SvPVX(sv), not
1740 SvPVX(sv) + SvCUR(sv) PVBM was added in 651aa52ea1faa806, and
1741 first used by the compiler in 651aa52ea1faa806. It's used to
1742 get a "complete" dump of the buffer at SvPVX(), not just the
1743 PVBM table. This permits the generated bytecode to "load"
2bda37ba
NC
1744 SvPVX in "one" hit.
1745
1746 5.15 and later store the BM table via MAGIC, so the compiler
1747 should handle this just fine without changes if PVBM now
1748 always returns the SvPVX() buffer. */
8d919b0a
FC
1749 p = isREGEXP(sv)
1750 ? RX_WRAPPED_const((REGEXP*)sv)
1751 : SvPVX_const(sv);
2bda37ba 1752 len = SvCUR(sv);
f4c36584 1753 } else if (ix) {
8d919b0a 1754 p = isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX(sv);
3d665704
NC
1755 len = strlen(p);
1756 } else if (SvPOK(sv)) {
a804b0fe
NC
1757 len = SvCUR(sv);
1758 p = SvPVX_const(sv);
1759 utf8 = SvUTF8(sv);
eb32218e 1760 } else if (isREGEXP(sv)) {
8d919b0a
FC
1761 len = SvCUR(sv);
1762 p = RX_WRAPPED_const((REGEXP*)sv);
1763 utf8 = SvUTF8(sv);
eb32218e 1764 } else {
b326da91
MB
1765 /* XXX for backward compatibility, but should fail */
1766 /* croak( "argument is not SvPOK" ); */
a804b0fe 1767 p = NULL;
b326da91 1768 }
a804b0fe 1769 ST(0) = newSVpvn_flags(p, len, SVs_TEMP | utf8);
a8a597b2 1770
fdbacc68 1771MODULE = B PACKAGE = B::PVMG
a8a597b2
MB
1772
1773void
fdbacc68 1774MAGIC(sv)
a8a597b2
MB
1775 B::PVMG sv
1776 MAGIC * mg = NO_INIT
1777 PPCODE:
1778 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
9496d2e5 1779 XPUSHs(make_mg_object(aTHX_ mg));
a8a597b2 1780
b2adfa9b 1781MODULE = B PACKAGE = B::MAGIC
a8a597b2
MB
1782
1783void
b2adfa9b 1784MOREMAGIC(mg)
a8a597b2 1785 B::MAGIC mg
b2adfa9b
NC
1786 ALIAS:
1787 PRIVATE = 1
1788 TYPE = 2
1789 FLAGS = 3
fb6620c6 1790 LENGTH = 4
b2adfa9b
NC
1791 OBJ = 5
1792 PTR = 6
1793 REGEX = 7
1794 precomp = 8
1795 PPCODE:
1796 switch (ix) {
1797 case 0:
1798 XPUSHs(mg->mg_moremagic ? make_mg_object(aTHX_ mg->mg_moremagic)
1799 : &PL_sv_undef);
1800 break;
1801 case 1:
1802 mPUSHu(mg->mg_private);
1803 break;
1804 case 2:
1805 PUSHs(newSVpvn_flags(&(mg->mg_type), 1, SVs_TEMP));
1806 break;
1807 case 3:
1808 mPUSHu(mg->mg_flags);
1809 break;
1810 case 4:
1811 mPUSHi(mg->mg_len);
1812 break;
1813 case 5:
0c74f67f 1814 PUSHs(make_sv_object(aTHX_ mg->mg_obj));
b2adfa9b
NC
1815 break;
1816 case 6:
1817 if (mg->mg_ptr) {
1818 if (mg->mg_len >= 0) {
1819 PUSHs(newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP));
651aa52e 1820 } else if (mg->mg_len == HEf_SVKEY) {
0c74f67f 1821 PUSHs(make_sv_object(aTHX_ (SV*)mg->mg_ptr));
fdbd1d64 1822 } else
b2adfa9b
NC
1823 PUSHs(sv_newmortal());
1824 } else
1825 PUSHs(sv_newmortal());
1826 break;
1827 case 7:
1828 if(mg->mg_type == PERL_MAGIC_qr) {
1829 mPUSHi(PTR2IV(mg->mg_obj));
1830 } else {
1831 croak("REGEX is only meaningful on r-magic");
1832 }
1833 break;
1834 case 8:
1835 if (mg->mg_type == PERL_MAGIC_qr) {
1836 REGEXP *rx = (REGEXP *)mg->mg_obj;
227aaa42
NC
1837 PUSHs(newSVpvn_flags(rx ? RX_PRECOMP(rx) : NULL,
1838 rx ? RX_PRELEN(rx) : 0, SVs_TEMP));
b2adfa9b
NC
1839 } else {
1840 croak( "precomp is only meaningful on r-magic" );
1841 }
1842 break;
1843 }
a8a597b2 1844
8922e438
FC
1845MODULE = B PACKAGE = B::BM PREFIX = Bm
1846
1847U32
1848BmPREVIOUS(sv)
1849 B::BM sv
99639b5b 1850 CODE:
99639b5b 1851 PERL_UNUSED_VAR(sv);
99639b5b
DM
1852 RETVAL = BmPREVIOUS(sv);
1853 OUTPUT:
1854 RETVAL
1855
8922e438
FC
1856
1857U8
1858BmRARE(sv)
1859 B::BM sv
99639b5b 1860 CODE:
99639b5b 1861 PERL_UNUSED_VAR(sv);
99639b5b
DM
1862 RETVAL = BmRARE(sv);
1863 OUTPUT:
1864 RETVAL
1865
8922e438 1866
a8a597b2
MB
1867MODULE = B PACKAGE = B::GV PREFIX = Gv
1868
1869void
1870GvNAME(gv)
1871 B::GV gv
cbf9c13f
NC
1872 ALIAS:
1873 FILE = 1
435e8dd0 1874 B::HV::NAME = 2
a8a597b2 1875 CODE:
435e8dd0
NC
1876 ST(0) = sv_2mortal(newSVhek(!ix ? GvNAME_HEK(gv)
1877 : (ix == 1 ? GvFILE_HEK(gv)
1878 : HvNAME_HEK((HV *)gv))));
a8a597b2 1879
87d7fd28
GS
1880bool
1881is_empty(gv)
1882 B::GV gv
711fbbf0
NC
1883 ALIAS:
1884 isGV_with_GP = 1
87d7fd28 1885 CODE:
711fbbf0 1886 if (ix) {
8298454c 1887 RETVAL = cBOOL(isGV_with_GP(gv));
711fbbf0
NC
1888 } else {
1889 RETVAL = GvGP(gv) == Null(GP*);
1890 }
50786ba8 1891 OUTPUT:
711fbbf0 1892 RETVAL
50786ba8 1893
651aa52e
AE
1894void*
1895GvGP(gv)
1896 B::GV gv
1897
3800c318
JH
1898#define GP_sv_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_sv)
1899#define GP_io_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_io)
1900#define GP_cv_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_cv)
1901#define GP_cvgen_ix (U32p << 16) | STRUCT_OFFSET(struct gp, gp_cvgen)
1902#define GP_refcnt_ix (U32p << 16) | STRUCT_OFFSET(struct gp, gp_refcnt)
1903#define GP_hv_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_hv)
1904#define GP_av_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_av)
1905#define GP_form_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_form)
1906#define GP_egv_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_egv)
a8a597b2 1907
257e0650
NC
1908void
1909SV(gv)
a8a597b2 1910 B::GV gv
257e0650
NC
1911 ALIAS:
1912 SV = GP_sv_ix
1913 IO = GP_io_ix
1914 CV = GP_cv_ix
1915 CVGEN = GP_cvgen_ix
1916 GvREFCNT = GP_refcnt_ix
1917 HV = GP_hv_ix
1918 AV = GP_av_ix
1919 FORM = GP_form_ix
1920 EGV = GP_egv_ix
257e0650
NC
1921 PREINIT:
1922 GP *gp;
1923 char *ptr;
1924 SV *ret;
1925 PPCODE:
1926 gp = GvGP(gv);
1927 if (!gp) {
1928 const GV *const gv = CvGV(cv);
46c3f339 1929 Perl_croak(aTHX_ "NULL gp in B::GV::%s", gv ? GvNAME(gv) : "???");
257e0650
NC
1930 }
1931 ptr = (ix & 0xFFFF) + (char *)gp;
1932 switch ((U8)(ix >> 16)) {
7d6d3fb7 1933 case SVp:
0c74f67f 1934 ret = make_sv_object(aTHX_ *((SV **)ptr));
257e0650 1935 break;
7d6d3fb7 1936 case U32p:
257e0650
NC
1937 ret = sv_2mortal(newSVuv(*((U32*)ptr)));
1938 break;
c33e8be1
Z
1939 default:
1940 croak("Illegal alias 0x%08x for B::*SV", (unsigned)ix);
257e0650
NC
1941 }
1942 ST(0) = ret;
1943 XSRETURN(1);
a8a597b2 1944
39ff6c37
FC
1945U32
1946GvLINE(gv)
1947 B::GV gv
1948
bb1efdce
FC
1949U32
1950GvGPFLAGS(gv)
1951 B::GV gv
1952
8ae5a962
NC
1953void
1954FILEGV(gv)
a8a597b2 1955 B::GV gv
8ae5a962 1956 PPCODE:
0c74f67f 1957 PUSHs(make_sv_object(aTHX_ (SV *)GvFILEGV(gv)));
a8a597b2 1958
a8a597b2
MB
1959MODULE = B PACKAGE = B::IO PREFIX = Io
1960
04071355 1961
b326da91
MB
1962bool
1963IsSTD(io,name)
1964 B::IO io
5d7488b2 1965 const char* name
b326da91
MB
1966 PREINIT:
1967 PerlIO* handle = 0;
1968 CODE:
1969 if( strEQ( name, "stdin" ) ) {
1970 handle = PerlIO_stdin();
1971 }
1972 else if( strEQ( name, "stdout" ) ) {
1973 handle = PerlIO_stdout();
1974 }
1975 else if( strEQ( name, "stderr" ) ) {
1976 handle = PerlIO_stderr();
1977 }
1978 else {
1979 croak( "Invalid value '%s'", name );
1980 }
1981 RETVAL = handle == IoIFP(io);
1982 OUTPUT:
1983 RETVAL
1984
a8a597b2
MB
1985MODULE = B PACKAGE = B::AV PREFIX = Av
1986
1987SSize_t
1988AvFILL(av)
1989 B::AV av
1990
a8a597b2
MB
1991void
1992AvARRAY(av)
1993 B::AV av
1994 PPCODE:
1995 if (AvFILL(av) >= 0) {
1996 SV **svp = AvARRAY(av);
1997 I32 i;
1998 for (i = 0; i <= AvFILL(av); i++)
0c74f67f 1999 XPUSHs(make_sv_object(aTHX_ svp[i]));
a8a597b2
MB
2000 }
2001
429a5ce7
SM
2002void
2003AvARRAYelt(av, idx)
2004 B::AV av
2005 int idx
2006 PPCODE:
2007 if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
0c74f67f 2008 XPUSHs(make_sv_object(aTHX_ (AvARRAY(av)[idx])));
429a5ce7 2009 else
0c74f67f 2010 XPUSHs(make_sv_object(aTHX_ NULL));
429a5ce7 2011
edcc7c74 2012
f2da823f
FC
2013MODULE = B PACKAGE = B::FM PREFIX = Fm
2014
f2da823f 2015IV
99639b5b
DM
2016FmLINES(format)
2017 B::FM format
2018 CODE:
2019 PERL_UNUSED_VAR(format);
2020 RETVAL = 0;
2021 OUTPUT:
2022 RETVAL
2023
f2da823f 2024
a8a597b2
MB
2025MODULE = B PACKAGE = B::CV PREFIX = Cv
2026
651aa52e
AE
2027U32
2028CvCONST(cv)
2029 B::CV cv
2030
6079961f 2031void
a8a597b2
MB
2032CvSTART(cv)
2033 B::CV cv
a0da4400
NC
2034 ALIAS:
2035 ROOT = 1
6079961f
NC
2036 PPCODE:
2037 PUSHs(make_op_object(aTHX_ CvISXSUB(cv) ? NULL
2038 : ix ? CvROOT(cv) : CvSTART(cv)));
a8a597b2 2039
bb02a38f
FC
2040I32
2041CvDEPTH(cv)
2042 B::CV cv
2043
7261499d
FC
2044B::PADLIST
2045CvPADLIST(cv)
2046 B::CV cv
eacbb379
DD
2047 CODE:
2048 RETVAL = CvISXSUB(cv) ? NULL : CvPADLIST(cv);
2049 OUTPUT:
2050 RETVAL
7261499d 2051
eacbb379 2052SV *
db6e00bd 2053CvHSCXT(cv)
eacbb379
DD
2054 B::CV cv
2055 CODE:
db6e00bd 2056 RETVAL = newSVuv(CvISXSUB(cv) ? PTR2UV(CvHSCXT(cv)) : 0);
eacbb379
DD
2057 OUTPUT:
2058 RETVAL
2059
a8a597b2
MB
2060void
2061CvXSUB(cv)
2062 B::CV cv
96819e59
NC
2063 ALIAS:
2064 XSUBANY = 1
a8a597b2 2065 CODE:
96819e59 2066 ST(0) = ix && CvCONST(cv)
0c74f67f 2067 ? make_sv_object(aTHX_ (SV *)CvXSUBANY(cv).any_ptr)
96819e59
NC
2068 : sv_2mortal(newSViv(CvISXSUB(cv)
2069 ? (ix ? CvXSUBANY(cv).any_iv
2070 : PTR2IV(CvXSUB(cv)))
2071 : 0));
a8a597b2 2072
8ae5a962
NC
2073void
2074const_sv(cv)
de3f1649 2075 B::CV cv
8ae5a962 2076 PPCODE:
0c74f67f 2077 PUSHs(make_sv_object(aTHX_ (SV *)cv_const_sv(cv)));
de3f1649 2078
486b1e7f
TC
2079void
2080GV(cv)
2081 B::CV cv
486b1e7f 2082 CODE:
f244b085 2083 ST(0) = make_sv_object(aTHX_ (SV*)CvGV(cv));
486b1e7f 2084
486b1e7f
TC
2085SV *
2086NAME_HEK(cv)
2087 B::CV cv
2088 CODE:
2089 RETVAL = CvNAMED(cv) ? newSVhek(CvNAME_HEK(cv)) : &PL_sv_undef;
2090 OUTPUT:
2091 RETVAL
2092
a8a597b2
MB
2093MODULE = B PACKAGE = B::HV PREFIX = Hv
2094
2095STRLEN
2096HvFILL(hv)
2097 B::HV hv
2098
a8a597b2
MB
2099I32
2100HvRITER(hv)
2101 B::HV hv
2102
a8a597b2
MB
2103void
2104HvARRAY(hv)
2105 B::HV hv
2106 PPCODE:
1b95d04f 2107 if (HvUSEDKEYS(hv) > 0) {
fa0789a7 2108 HE *he;
052a7c76 2109 SSize_t extend_size;
a8a597b2 2110 (void)hv_iterinit(hv);
052a7c76
DM
2111 /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */
2112 assert(HvUSEDKEYS(hv) <= (SSize_t_MAX >> 1));
2113 extend_size = (SSize_t)HvUSEDKEYS(hv) * 2;
2114 EXTEND(sp, extend_size);
fa0789a7
RU
2115 while ((he = hv_iternext(hv))) {
2116 if (HeSVKEY(he)) {
2117 mPUSHs(HeSVKEY(he));
2118 } else if (HeKUTF8(he)) {
2119 PUSHs(newSVpvn_flags(HeKEY(he), HeKLEN(he), SVf_UTF8|SVs_TEMP));
2120 } else {
2121 mPUSHp(HeKEY(he), HeKLEN(he));
2122 }
2123 PUSHs(make_sv_object(aTHX_ HeVAL(he)));
a8a597b2
MB
2124 }
2125 }
fd9f6265
JJ
2126
2127MODULE = B PACKAGE = B::HE PREFIX = He
2128
8ae5a962 2129void
fd9f6265
JJ
2130HeVAL(he)
2131 B::HE he
b2619626
NC
2132 ALIAS:
2133 SVKEY_force = 1
8ae5a962 2134 PPCODE:
0c74f67f 2135 PUSHs(make_sv_object(aTHX_ ix ? HeSVKEY_force(he) : HeVAL(he)));
fd9f6265
JJ
2136
2137U32
2138HeHASH(he)
2139 B::HE he
2140
fdbacc68 2141MODULE = B PACKAGE = B::RHE
fd9f6265
JJ
2142
2143SV*
fdbacc68 2144HASH(h)
fd9f6265
JJ
2145 B::RHE h
2146 CODE:
4b6e9aa6 2147 RETVAL = newRV_noinc( (SV*)cophh_2hv(h, 0) );
fd9f6265
JJ
2148 OUTPUT:
2149 RETVAL
e412117e 2150
7261499d 2151
86d2498c 2152MODULE = B PACKAGE = B::PADLIST PREFIX = Padlist
7261499d
FC
2153
2154SSize_t
86d2498c 2155PadlistMAX(padlist)
7261499d 2156 B::PADLIST padlist
9b7476d7
FC
2157 ALIAS: B::PADNAMELIST::MAX = 0
2158 CODE:
2159 PERL_UNUSED_VAR(ix);
2160 RETVAL = PadlistMAX(padlist);
2161 OUTPUT:
2162 RETVAL
2163
2164B::PADNAMELIST
2165PadlistNAMES(padlist)
2166 B::PADLIST padlist
7261499d
FC
2167
2168void
86d2498c 2169PadlistARRAY(padlist)
7261499d
FC
2170 B::PADLIST padlist
2171 PPCODE:
86d2498c 2172 if (PadlistMAX(padlist) >= 0) {
9b7476d7 2173 dXSTARG;
86d2498c 2174 PAD **padp = PadlistARRAY(padlist);
99639b5b 2175 SSize_t i;
9b7476d7
FC
2176 sv_setiv(newSVrv(TARG, PadlistNAMES(padlist)
2177 ? "B::PADNAMELIST"
2178 : "B::NULL"),
2179 PTR2IV(PadlistNAMES(padlist)));
2180 XPUSHTARG;
2181 for (i = 1; i <= PadlistMAX(padlist); i++)
7261499d
FC
2182 XPUSHs(make_sv_object(aTHX_ (SV *)padp[i]));
2183 }
2184
2185void
86d2498c 2186PadlistARRAYelt(padlist, idx)
7261499d 2187 B::PADLIST padlist
99639b5b 2188 SSize_t idx
7261499d 2189 PPCODE:
9b7476d7
FC
2190 if (idx < 0 || idx > PadlistMAX(padlist))
2191 XPUSHs(make_sv_object(aTHX_ NULL));
2192 else if (!idx) {
2193 PL_stack_sp--;
2194 PUSHMARK(PL_stack_sp-1);
2195 XS_B__PADLIST_NAMES(aTHX_ cv);
2196 return;
2197 }
2198 else
7261499d 2199 XPUSHs(make_sv_object(aTHX_
86d2498c 2200 (SV *)PadlistARRAY(padlist)[idx]));
7261499d
FC
2201
2202U32
86d2498c 2203PadlistREFCNT(padlist)
7261499d
FC
2204 B::PADLIST padlist
2205 CODE:
99639b5b 2206 PERL_UNUSED_VAR(padlist);
86d2498c 2207 RETVAL = PadlistREFCNT(padlist);
7261499d
FC
2208 OUTPUT:
2209 RETVAL
2210
9b7476d7
FC
2211MODULE = B PACKAGE = B::PADNAMELIST PREFIX = Padnamelist
2212
2213void
2214PadnamelistARRAY(pnl)
2215 B::PADNAMELIST pnl
2216 PPCODE:
2217 if (PadnamelistMAX(pnl) >= 0) {
2218 PADNAME **padp = PadnamelistARRAY(pnl);
2219 SSize_t i = 0;
2220 for (; i <= PadnamelistMAX(pnl); i++)
0f94cb1f
FC
2221 {
2222 SV *rv = sv_newmortal();
2223 sv_setiv(newSVrv(rv,padp[i] ? "B::PADNAME" : "B::SPECIAL"),
2224 PTR2IV(padp[i]));
2225 XPUSHs(rv);
2226 }
9b7476d7
FC
2227 }
2228
0f94cb1f 2229B::PADNAME
9b7476d7
FC
2230PadnamelistARRAYelt(pnl, idx)
2231 B::PADNAMELIST pnl
2232 SSize_t idx
0f94cb1f 2233 CODE:
9b7476d7 2234 if (idx < 0 || idx > PadnamelistMAX(pnl))
0f94cb1f 2235 RETVAL = NULL;
9b7476d7 2236 else
0f94cb1f
FC
2237 RETVAL = PadnamelistARRAY(pnl)[idx];
2238 OUTPUT:
2239 RETVAL
9b7476d7 2240
0f94cb1f
FC
2241MODULE = B PACKAGE = B::PADNAME PREFIX = Padname
2242
2243#define PN_type_ix \
2244 sv_SVp | STRUCT_OFFSET(struct padname,xpadn_type_u.xpadn_typestash)
2245#define PN_ourstash_ix \
2246 sv_SVp | STRUCT_OFFSET(struct padname,xpadn_ourstash)
2247#define PN_len_ix \
2248 sv_U8p | STRUCT_OFFSET(struct padname,xpadn_len)
2249#define PN_refcnt_ix \
2250 sv_U32p | STRUCT_OFFSET(struct padname, xpadn_refcnt)
2251#define PN_cop_seq_range_low_ix \
2252 sv_U32p | STRUCT_OFFSET(struct padname, xpadn_low)
2253#define PN_cop_seq_range_high_ix \
2254 sv_U32p | STRUCT_OFFSET(struct padname, xpadn_high)
d8fed09d
FC
2255#define PNL_refcnt_ix \
2256 sv_U32p | STRUCT_OFFSET(struct padnamelist, xpadnl_refcnt)
58480c3b
FC
2257#define PL_id_ix \
2258 sv_U32p | STRUCT_OFFSET(struct padlist, xpadl_id)
2259#define PL_outid_ix \
2260 sv_U32p | STRUCT_OFFSET(struct padlist, xpadl_outid)
2261
0f94cb1f
FC
2262
2263void
2264PadnameTYPE(pn)
2265 B::PADNAME pn
2266 ALIAS:
2267 B::PADNAME::TYPE = PN_type_ix
2268 B::PADNAME::OURSTASH = PN_ourstash_ix
2269 B::PADNAME::LEN = PN_len_ix
2270 B::PADNAME::REFCNT = PN_refcnt_ix
2271 B::PADNAME::COP_SEQ_RANGE_LOW = PN_cop_seq_range_low_ix
2272 B::PADNAME::COP_SEQ_RANGE_HIGH = PN_cop_seq_range_high_ix
d8fed09d 2273 B::PADNAMELIST::REFCNT = PNL_refcnt_ix
58480c3b
FC
2274 B::PADLIST::id = PL_id_ix
2275 B::PADLIST::outid = PL_outid_ix
0f94cb1f
FC
2276 PREINIT:
2277 char *ptr;
47e6c6d9 2278 SV *ret = NULL;
0f94cb1f
FC
2279 PPCODE:
2280 ptr = (ix & 0xFFFF) + (char *)pn;
2281 switch ((U8)(ix >> 16)) {
2282 case (U8)(sv_SVp >> 16):
2283 ret = make_sv_object(aTHX_ *((SV **)ptr));
2284 break;
2285 case (U8)(sv_U32p >> 16):
2286 ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
2287 break;
2288 case (U8)(sv_U8p >> 16):
2289 ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
2290 break;
2291 default:
2292 NOT_REACHED;
2293 }
2294 ST(0) = ret;
2295 XSRETURN(1);
2296
2297SV *
2298PadnamePV(pn)
2299 B::PADNAME pn
2300 PREINIT:
2301 dXSTARG;
2302 PPCODE:
2303 PERL_UNUSED_ARG(RETVAL);
2304 sv_setpvn(TARG, PadnamePV(pn), PadnameLEN(pn));
2305 SvUTF8_on(TARG);
2306 XPUSHTARG;
2307
2308BOOT:
2309{
2310 /* Uses less memory than an ALIAS. */
2311 GV *gv = gv_fetchpvs("B::PADNAME::TYPE", 1, SVt_PVGV);
2312 sv_setsv((SV *)gv_fetchpvs("B::PADNAME::SvSTASH",1,SVt_PVGV),(SV *)gv);
2313 sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PROTOCV",1,SVt_PVGV),(SV *)gv);
2314 sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PVX",1,SVt_PVGV),
2315 (SV *)gv_fetchpvs("B::PADNAME::PV" ,1,SVt_PVGV));
43a4fb14
FC
2316 sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PARENT_PAD_INDEX" ,1,SVt_PVGV),
2317 (SV *)gv_fetchpvs("B::PADNAME::COP_SEQ_RANGE_LOW",1,
2318 SVt_PVGV));
2319 sv_setsv((SV *)gv_fetchpvs("B::PADNAME::PARENT_FAKELEX_FLAGS",1,
2320 SVt_PVGV),
2321 (SV *)gv_fetchpvs("B::PADNAME::COP_SEQ_RANGE_HIGH" ,1,
2322 SVt_PVGV));
0f94cb1f
FC
2323}
2324
2325U32
2326PadnameFLAGS(pn)
2327 B::PADNAME pn
2328 CODE:
2329 RETVAL = PadnameFLAGS(pn);
2330 /* backward-compatibility hack, which should be removed if the
2331 flags field becomes large enough to hold SVf_FAKE (and
2332 PADNAMEt_OUTER should be renumbered to match SVf_FAKE) */
d28cce60 2333 STATIC_ASSERT_STMT(SVf_FAKE >= 1<<(sizeof(PadnameFLAGS((B__PADNAME)NULL)) * 8));
0f94cb1f
FC
2334 if (PadnameOUTER(pn))
2335 RETVAL |= SVf_FAKE;
2336 OUTPUT:
2337 RETVAL