This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix a couple of minor typos in comments
[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
a8a597b2
MB
11#include "EXTERN.h"
12#include "perl.h"
13#include "XSUB.h"
a8a597b2 14
51aa15f3
GS
15#ifdef PerlIO
16typedef PerlIO * InputStream;
17#else
18typedef FILE * InputStream;
19#endif
20
21
27da23d5 22static const char* const svclassnames[] = {
a8a597b2 23 "B::NULL",
cecf5685
NC
24#if PERL_VERSION >= 9
25 "B::BIND",
26#endif
1cb9cd50
NC
27 "B::IV",
28 "B::NV",
29 "B::RV",
a8a597b2
MB
30 "B::PV",
31 "B::PVIV",
32 "B::PVNV",
33 "B::PVMG",
cecf5685 34#if PERL_VERSION <= 8
a8a597b2 35 "B::BM",
cecf5685 36#endif
7252851f 37#if PERL_VERSION >= 9
4ce457a6 38 "B::GV",
7252851f 39#endif
a8a597b2
MB
40 "B::PVLV",
41 "B::AV",
42 "B::HV",
43 "B::CV",
7252851f
NC
44#if PERL_VERSION <= 8
45 "B::GV",
46#endif
a8a597b2
MB
47 "B::FM",
48 "B::IO",
49};
50
51typedef enum {
52 OPc_NULL, /* 0 */
53 OPc_BASEOP, /* 1 */
54 OPc_UNOP, /* 2 */
55 OPc_BINOP, /* 3 */
56 OPc_LOGOP, /* 4 */
1a67a97c
SM
57 OPc_LISTOP, /* 5 */
58 OPc_PMOP, /* 6 */
59 OPc_SVOP, /* 7 */
7934575e 60 OPc_PADOP, /* 8 */
1a67a97c 61 OPc_PVOP, /* 9 */
651aa52e
AE
62 OPc_LOOP, /* 10 */
63 OPc_COP /* 11 */
a8a597b2
MB
64} opclass;
65
27da23d5 66static const char* const opclassnames[] = {
a8a597b2
MB
67 "B::NULL",
68 "B::OP",
69 "B::UNOP",
70 "B::BINOP",
71 "B::LOGOP",
a8a597b2
MB
72 "B::LISTOP",
73 "B::PMOP",
74 "B::SVOP",
7934575e 75 "B::PADOP",
a8a597b2 76 "B::PVOP",
a8a597b2
MB
77 "B::LOOP",
78 "B::COP"
79};
80
27da23d5 81static const size_t opsizes[] = {
651aa52e
AE
82 0,
83 sizeof(OP),
84 sizeof(UNOP),
85 sizeof(BINOP),
86 sizeof(LOGOP),
87 sizeof(LISTOP),
88 sizeof(PMOP),
89 sizeof(SVOP),
90 sizeof(PADOP),
91 sizeof(PVOP),
92 sizeof(LOOP),
93 sizeof(COP)
94};
95
df3728a2 96#define MY_CXT_KEY "B::_guts" XS_VERSION
a8a597b2 97
89ca4ac7
JH
98typedef struct {
99 int x_walkoptree_debug; /* Flag for walkoptree debug hook */
b326da91 100 SV * x_specialsv_list[7];
89ca4ac7
JH
101} my_cxt_t;
102
103START_MY_CXT
104
105#define walkoptree_debug (MY_CXT.x_walkoptree_debug)
106#define specialsv_list (MY_CXT.x_specialsv_list)
e8edd1e6 107
a8a597b2 108static opclass
5d7488b2 109cc_opclass(pTHX_ const OP *o)
a8a597b2
MB
110{
111 if (!o)
112 return OPc_NULL;
113
114 if (o->op_type == 0)
115 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
116
117 if (o->op_type == OP_SASSIGN)
118 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
119
c60fdceb
SM
120 if (o->op_type == OP_AELEMFAST) {
121 if (o->op_flags & OPf_SPECIAL)
122 return OPc_BASEOP;
123 else
124#ifdef USE_ITHREADS
125 return OPc_PADOP;
126#else
127 return OPc_SVOP;
128#endif
129 }
130
18228111 131#ifdef USE_ITHREADS
31b49ad4 132 if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
c60fdceb 133 o->op_type == OP_RCATLINE)
18228111
GS
134 return OPc_PADOP;
135#endif
136
22c35a8c 137 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
a8a597b2
MB
138 case OA_BASEOP:
139 return OPc_BASEOP;
140
141 case OA_UNOP:
142 return OPc_UNOP;
143
144 case OA_BINOP:
145 return OPc_BINOP;
146
147 case OA_LOGOP:
148 return OPc_LOGOP;
149
a8a597b2
MB
150 case OA_LISTOP:
151 return OPc_LISTOP;
152
153 case OA_PMOP:
154 return OPc_PMOP;
155
156 case OA_SVOP:
157 return OPc_SVOP;
158
7934575e
GS
159 case OA_PADOP:
160 return OPc_PADOP;
a8a597b2 161
293d3ffa
SM
162 case OA_PVOP_OR_SVOP:
163 /*
164 * Character translations (tr///) are usually a PVOP, keeping a
165 * pointer to a table of shorts used to look up translations.
166 * Under utf8, however, a simple table isn't practical; instead,
167 * the OP is an SVOP, and the SV is a reference to a swash
168 * (i.e., an RV pointing to an HV).
169 */
170 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
171 ? OPc_SVOP : OPc_PVOP;
a8a597b2
MB
172
173 case OA_LOOP:
174 return OPc_LOOP;
175
176 case OA_COP:
177 return OPc_COP;
178
179 case OA_BASEOP_OR_UNOP:
180 /*
181 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
45f6cd40
SM
182 * whether parens were seen. perly.y uses OPf_SPECIAL to
183 * signal whether a BASEOP had empty parens or none.
184 * Some other UNOPs are created later, though, so the best
185 * test is OPf_KIDS, which is set in newUNOP.
a8a597b2 186 */
45f6cd40 187 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
a8a597b2
MB
188
189 case OA_FILESTATOP:
190 /*
191 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
192 * the OPf_REF flag to distinguish between OP types instead of the
193 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
194 * return OPc_UNOP so that walkoptree can find our children. If
195 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
196 * (no argument to the operator) it's an OP; with OPf_REF set it's
7934575e 197 * an SVOP (and op_sv is the GV for the filehandle argument).
a8a597b2
MB
198 */
199 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
93865851
GS
200#ifdef USE_ITHREADS
201 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
202#else
7934575e 203 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
93865851 204#endif
a8a597b2
MB
205 case OA_LOOPEXOP:
206 /*
207 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
208 * label was omitted (in which case it's a BASEOP) or else a term was
209 * seen. In this last case, all except goto are definitely PVOP but
210 * goto is either a PVOP (with an ordinary constant label), an UNOP
211 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
212 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
213 * get set.
214 */
215 if (o->op_flags & OPf_STACKED)
216 return OPc_UNOP;
217 else if (o->op_flags & OPf_SPECIAL)
218 return OPc_BASEOP;
219 else
220 return OPc_PVOP;
221 }
222 warn("can't determine class of operator %s, assuming BASEOP\n",
22c35a8c 223 PL_op_name[o->op_type]);
a8a597b2
MB
224 return OPc_BASEOP;
225}
226
227static char *
5d7488b2 228cc_opclassname(pTHX_ const OP *o)
a8a597b2 229{
27da23d5 230 return (char *)opclassnames[cc_opclass(aTHX_ o)];
a8a597b2
MB
231}
232
233static SV *
cea2e8a9 234make_sv_object(pTHX_ SV *arg, SV *sv)
a8a597b2 235{
27da23d5 236 const char *type = 0;
a8a597b2 237 IV iv;
89ca4ac7 238 dMY_CXT;
a8a597b2 239
e8edd1e6
TH
240 for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
241 if (sv == specialsv_list[iv]) {
a8a597b2
MB
242 type = "B::SPECIAL";
243 break;
244 }
245 }
246 if (!type) {
247 type = svclassnames[SvTYPE(sv)];
56431972 248 iv = PTR2IV(sv);
a8a597b2
MB
249 }
250 sv_setiv(newSVrv(arg, type), iv);
251 return arg;
252}
253
254static SV *
8e01d9a6
NC
255make_temp_object(pTHX_ SV *arg, SV *temp)
256{
257 SV *target;
258 const char *const type = svclassnames[SvTYPE(temp)];
259 const IV iv = PTR2IV(temp);
260
261 target = newSVrv(arg, type);
262 sv_setiv(target, iv);
263
264 /* Need to keep our "temp" around as long as the target exists.
265 Simplest way seems to be to hang it from magic, and let that clear
266 it up. No vtable, so won't actually get in the way of anything. */
267 sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
268 /* magic object has had its reference count increased, so we must drop
269 our reference. */
270 SvREFCNT_dec(temp);
271 return arg;
272}
273
274static SV *
5c3c3f81
NC
275make_warnings_object(pTHX_ SV *arg, STRLEN *warnings)
276{
277 const char *type = 0;
278 dMY_CXT;
279 IV iv = sizeof(specialsv_list)/sizeof(SV*);
280
281 /* Counting down is deliberate. Before the split between make_sv_object
282 and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
283 were both 0, so you could never get a B::SPECIAL for pWARN_STD */
284
285 while (iv--) {
286 if ((SV*)warnings == specialsv_list[iv]) {
287 type = "B::SPECIAL";
288 break;
289 }
290 }
291 if (type) {
292 sv_setiv(newSVrv(arg, type), iv);
8e01d9a6 293 return arg;
5c3c3f81
NC
294 } else {
295 /* B assumes that warnings are a regular SV. Seems easier to keep it
296 happy by making them into a regular SV. */
8e01d9a6
NC
297 return make_temp_object(aTHX_ arg,
298 newSVpvn((char *)(warnings + 1), *warnings));
299 }
300}
301
302static SV *
303make_cop_io_object(pTHX_ SV *arg, COP *cop)
304{
8b850bd5
NC
305 SV *const value = newSV(0);
306
33972ad6 307 Perl_emulate_cop_io(aTHX_ cop, value);
8b850bd5
NC
308
309 if(SvOK(value)) {
8e01d9a6
NC
310 return make_temp_object(aTHX_ arg, newSVsv(value));
311 } else {
8b850bd5 312 SvREFCNT_dec(value);
8e01d9a6 313 return make_sv_object(aTHX_ arg, NULL);
5c3c3f81 314 }
5c3c3f81
NC
315}
316
317static SV *
cea2e8a9 318make_mg_object(pTHX_ SV *arg, MAGIC *mg)
a8a597b2 319{
56431972 320 sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
a8a597b2
MB
321 return arg;
322}
323
324static SV *
52ad86de 325cstring(pTHX_ SV *sv, bool perlstyle)
a8a597b2 326{
79cb57f6 327 SV *sstr = newSVpvn("", 0);
a8a597b2
MB
328
329 if (!SvOK(sv))
330 sv_setpvn(sstr, "0", 1);
5d7488b2 331 else if (perlstyle && SvUTF8(sv)) {
d79a7a3d 332 SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
5d7488b2
AL
333 const STRLEN len = SvCUR(sv);
334 const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
c69006e4 335 sv_setpvn(sstr,"\"",1);
d79a7a3d
RGS
336 while (*s)
337 {
338 if (*s == '"')
5d7488b2 339 sv_catpvn(sstr, "\\\"", 2);
d79a7a3d 340 else if (*s == '$')
5d7488b2 341 sv_catpvn(sstr, "\\$", 2);
d79a7a3d 342 else if (*s == '@')
5d7488b2 343 sv_catpvn(sstr, "\\@", 2);
d79a7a3d
RGS
344 else if (*s == '\\')
345 {
346 if (strchr("nrftax\\",*(s+1)))
347 sv_catpvn(sstr, s++, 2);
348 else
5d7488b2 349 sv_catpvn(sstr, "\\\\", 2);
d79a7a3d
RGS
350 }
351 else /* should always be printable */
352 sv_catpvn(sstr, s, 1);
353 ++s;
354 }
355 sv_catpv(sstr, "\"");
356 return sstr;
357 }
a8a597b2
MB
358 else
359 {
360 /* XXX Optimise? */
5d7488b2
AL
361 STRLEN len;
362 const char *s = SvPV(sv, len);
a8a597b2
MB
363 sv_catpv(sstr, "\"");
364 for (; len; len--, s++)
365 {
366 /* At least try a little for readability */
367 if (*s == '"')
368 sv_catpv(sstr, "\\\"");
369 else if (*s == '\\')
370 sv_catpv(sstr, "\\\\");
b326da91 371 /* trigraphs - bleagh */
5d7488b2
AL
372 else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
373 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
b326da91
MB
374 sprintf(escbuff, "\\%03o", '?');
375 sv_catpv(sstr, escbuff);
376 }
52ad86de
JH
377 else if (perlstyle && *s == '$')
378 sv_catpv(sstr, "\\$");
379 else if (perlstyle && *s == '@')
380 sv_catpv(sstr, "\\@");
ce561ef2
JH
381#ifdef EBCDIC
382 else if (isPRINT(*s))
383#else
384 else if (*s >= ' ' && *s < 127)
385#endif /* EBCDIC */
a8a597b2
MB
386 sv_catpvn(sstr, s, 1);
387 else if (*s == '\n')
388 sv_catpv(sstr, "\\n");
389 else if (*s == '\r')
390 sv_catpv(sstr, "\\r");
391 else if (*s == '\t')
392 sv_catpv(sstr, "\\t");
393 else if (*s == '\a')
394 sv_catpv(sstr, "\\a");
395 else if (*s == '\b')
396 sv_catpv(sstr, "\\b");
397 else if (*s == '\f')
398 sv_catpv(sstr, "\\f");
52ad86de 399 else if (!perlstyle && *s == '\v')
a8a597b2
MB
400 sv_catpv(sstr, "\\v");
401 else
402 {
a8a597b2 403 /* Don't want promotion of a signed -1 char in sprintf args */
5d7488b2
AL
404 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
405 const unsigned char c = (unsigned char) *s;
a8a597b2
MB
406 sprintf(escbuff, "\\%03o", c);
407 sv_catpv(sstr, escbuff);
408 }
409 /* XXX Add line breaks if string is long */
410 }
411 sv_catpv(sstr, "\"");
412 }
413 return sstr;
414}
415
416static SV *
cea2e8a9 417cchar(pTHX_ SV *sv)
a8a597b2 418{
79cb57f6 419 SV *sstr = newSVpvn("'", 1);
5d7488b2 420 const char *s = SvPV_nolen(sv);
a8a597b2
MB
421
422 if (*s == '\'')
5d7488b2 423 sv_catpvn(sstr, "\\'", 2);
a8a597b2 424 else if (*s == '\\')
5d7488b2 425 sv_catpvn(sstr, "\\\\", 2);
ce561ef2 426#ifdef EBCDIC
133b4094 427 else if (isPRINT(*s))
ce561ef2
JH
428#else
429 else if (*s >= ' ' && *s < 127)
430#endif /* EBCDIC */
a8a597b2
MB
431 sv_catpvn(sstr, s, 1);
432 else if (*s == '\n')
5d7488b2 433 sv_catpvn(sstr, "\\n", 2);
a8a597b2 434 else if (*s == '\r')
5d7488b2 435 sv_catpvn(sstr, "\\r", 2);
a8a597b2 436 else if (*s == '\t')
5d7488b2 437 sv_catpvn(sstr, "\\t", 2);
a8a597b2 438 else if (*s == '\a')
5d7488b2 439 sv_catpvn(sstr, "\\a", 2);
a8a597b2 440 else if (*s == '\b')
5d7488b2 441 sv_catpvn(sstr, "\\b", 2);
a8a597b2 442 else if (*s == '\f')
5d7488b2 443 sv_catpvn(sstr, "\\f", 2);
a8a597b2 444 else if (*s == '\v')
5d7488b2 445 sv_catpvn(sstr, "\\v", 2);
a8a597b2
MB
446 else
447 {
448 /* no trigraph support */
449 char escbuff[5]; /* to fit backslash, 3 octals + trailing \0 */
450 /* Don't want promotion of a signed -1 char in sprintf args */
451 unsigned char c = (unsigned char) *s;
452 sprintf(escbuff, "\\%03o", c);
453 sv_catpv(sstr, escbuff);
454 }
5d7488b2 455 sv_catpvn(sstr, "'", 1);
a8a597b2
MB
456 return sstr;
457}
458
5d7488b2
AL
459static void
460walkoptree(pTHX_ SV *opsv, const char *method)
a8a597b2
MB
461{
462 dSP;
f3be9b72 463 OP *o, *kid;
89ca4ac7
JH
464 dMY_CXT;
465
a8a597b2
MB
466 if (!SvROK(opsv))
467 croak("opsv is not a reference");
468 opsv = sv_mortalcopy(opsv);
56431972 469 o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
a8a597b2
MB
470 if (walkoptree_debug) {
471 PUSHMARK(sp);
472 XPUSHs(opsv);
473 PUTBACK;
474 perl_call_method("walkoptree_debug", G_DISCARD);
475 }
476 PUSHMARK(sp);
477 XPUSHs(opsv);
478 PUTBACK;
479 perl_call_method(method, G_DISCARD);
480 if (o && (o->op_flags & OPf_KIDS)) {
a8a597b2
MB
481 for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
482 /* Use the same opsv. Rely on methods not to mess it up. */
56431972 483 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
cea2e8a9 484 walkoptree(aTHX_ opsv, method);
a8a597b2
MB
485 }
486 }
5464c149 487 if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
f3be9b72
RGS
488 && (kid = cPMOPo->op_pmreplroot))
489 {
5464c149 490 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
f3be9b72
RGS
491 walkoptree(aTHX_ opsv, method);
492 }
a8a597b2
MB
493}
494
5d7488b2 495static SV **
1df34986
AE
496oplist(pTHX_ OP *o, SV **SP)
497{
498 for(; o; o = o->op_next) {
499 SV *opsv;
7252851f
NC
500#if PERL_VERSION >= 9
501 if (o->op_opt == 0)
1df34986 502 break;
2814eb74 503 o->op_opt = 0;
7252851f
NC
504#else
505 if (o->op_seq == 0)
506 break;
507 o->op_seq = 0;
508#endif
1df34986
AE
509 opsv = sv_newmortal();
510 sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
511 XPUSHs(opsv);
512 switch (o->op_type) {
513 case OP_SUBST:
514 SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
515 continue;
516 case OP_SORT:
f66c782a 517 if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
1df34986
AE
518 OP *kid = cLISTOPo->op_first->op_sibling; /* pass pushmark */
519 kid = kUNOP->op_first; /* pass rv2gv */
520 kid = kUNOP->op_first; /* pass leave */
f66c782a 521 SP = oplist(aTHX_ kid->op_next, SP);
1df34986
AE
522 }
523 continue;
524 }
525 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
526 case OA_LOGOP:
527 SP = oplist(aTHX_ cLOGOPo->op_other, SP);
528 break;
529 case OA_LOOP:
530 SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
531 SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
532 SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
533 break;
534 }
535 }
536 return SP;
537}
538
a8a597b2
MB
539typedef OP *B__OP;
540typedef UNOP *B__UNOP;
541typedef BINOP *B__BINOP;
542typedef LOGOP *B__LOGOP;
a8a597b2
MB
543typedef LISTOP *B__LISTOP;
544typedef PMOP *B__PMOP;
545typedef SVOP *B__SVOP;
7934575e 546typedef PADOP *B__PADOP;
a8a597b2
MB
547typedef PVOP *B__PVOP;
548typedef LOOP *B__LOOP;
549typedef COP *B__COP;
550
551typedef SV *B__SV;
552typedef SV *B__IV;
553typedef SV *B__PV;
554typedef SV *B__NV;
555typedef SV *B__PVMG;
556typedef SV *B__PVLV;
557typedef SV *B__BM;
558typedef SV *B__RV;
1df34986 559typedef SV *B__FM;
a8a597b2
MB
560typedef AV *B__AV;
561typedef HV *B__HV;
562typedef CV *B__CV;
563typedef GV *B__GV;
564typedef IO *B__IO;
565
566typedef MAGIC *B__MAGIC;
fd9f6265
JJ
567typedef HE *B__HE;
568typedef struct refcounted_he *B__RHE;
a8a597b2
MB
569
570MODULE = B PACKAGE = B PREFIX = B_
571
572PROTOTYPES: DISABLE
573
574BOOT:
4c1f658f 575{
da51bb9b 576 HV *stash = gv_stashpvn("B", 1, GV_ADD);
4c1f658f 577 AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
89ca4ac7 578 MY_CXT_INIT;
e8edd1e6
TH
579 specialsv_list[0] = Nullsv;
580 specialsv_list[1] = &PL_sv_undef;
581 specialsv_list[2] = &PL_sv_yes;
582 specialsv_list[3] = &PL_sv_no;
5c3c3f81
NC
583 specialsv_list[4] = (SV *) pWARN_ALL;
584 specialsv_list[5] = (SV *) pWARN_NONE;
585 specialsv_list[6] = (SV *) pWARN_STD;
f5ba1307 586#if PERL_VERSION <= 8
7252851f 587# define CVf_ASSERTION 0
e6663653 588# define OPpPAD_STATE 0
7252851f 589#endif
4c1f658f
NIS
590#include "defsubs.h"
591}
a8a597b2 592
3280af22 593#define B_main_cv() PL_main_cv
31d7d75a 594#define B_init_av() PL_initav
651aa52e 595#define B_inc_gv() PL_incgv
ece599bd 596#define B_check_av() PL_checkav_save
e6663653
NC
597#if PERL_VERSION > 8
598# define B_unitcheck_av() PL_unitcheckav_save
599#else
600# define B_unitcheck_av() NULL
601#endif
059a8bb7
JH
602#define B_begin_av() PL_beginav_save
603#define B_end_av() PL_endav
3280af22
NIS
604#define B_main_root() PL_main_root
605#define B_main_start() PL_main_start
56eca212 606#define B_amagic_generation() PL_amagic_generation
5ce57cc0 607#define B_sub_generation() PL_sub_generation
651aa52e
AE
608#define B_defstash() PL_defstash
609#define B_curstash() PL_curstash
610#define B_dowarn() PL_dowarn
3280af22
NIS
611#define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
612#define B_sv_undef() &PL_sv_undef
613#define B_sv_yes() &PL_sv_yes
614#define B_sv_no() &PL_sv_no
1df34986 615#define B_formfeed() PL_formfeed
9d2bbe64
MB
616#ifdef USE_ITHREADS
617#define B_regex_padav() PL_regex_padav
618#endif
a8a597b2 619
31d7d75a
NIS
620B::AV
621B_init_av()
622
059a8bb7 623B::AV
ece599bd
RGS
624B_check_av()
625
626B::AV
676456c2
AG
627B_unitcheck_av()
628
629B::AV
059a8bb7
JH
630B_begin_av()
631
632B::AV
633B_end_av()
634
651aa52e
AE
635B::GV
636B_inc_gv()
637
9d2bbe64
MB
638#ifdef USE_ITHREADS
639
640B::AV
641B_regex_padav()
642
643#endif
644
a8a597b2
MB
645B::CV
646B_main_cv()
647
648B::OP
649B_main_root()
650
651B::OP
652B_main_start()
653
56eca212
GS
654long
655B_amagic_generation()
656
5ce57cc0
JJ
657long
658B_sub_generation()
659
a8a597b2
MB
660B::AV
661B_comppadlist()
662
663B::SV
664B_sv_undef()
665
666B::SV
667B_sv_yes()
668
669B::SV
670B_sv_no()
671
651aa52e
AE
672B::HV
673B_curstash()
674
675B::HV
676B_defstash()
a8a597b2 677
651aa52e
AE
678U8
679B_dowarn()
680
1df34986
AE
681B::SV
682B_formfeed()
683
651aa52e
AE
684void
685B_warnhook()
686 CODE:
687 ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_warnhook);
688
689void
690B_diehook()
691 CODE:
692 ST(0) = make_sv_object(aTHX_ sv_newmortal(), PL_diehook);
693
694MODULE = B PACKAGE = B
a8a597b2
MB
695
696void
697walkoptree(opsv, method)
698 SV * opsv
5d7488b2 699 const char * method
cea2e8a9
GS
700 CODE:
701 walkoptree(aTHX_ opsv, method);
a8a597b2
MB
702
703int
704walkoptree_debug(...)
705 CODE:
89ca4ac7 706 dMY_CXT;
a8a597b2
MB
707 RETVAL = walkoptree_debug;
708 if (items > 0 && SvTRUE(ST(1)))
709 walkoptree_debug = 1;
710 OUTPUT:
711 RETVAL
712
56431972 713#define address(sv) PTR2IV(sv)
a8a597b2
MB
714
715IV
716address(sv)
717 SV * sv
718
719B::SV
720svref_2object(sv)
721 SV * sv
722 CODE:
723 if (!SvROK(sv))
724 croak("argument is not a reference");
725 RETVAL = (SV*)SvRV(sv);
726 OUTPUT:
0cc1d052
NIS
727 RETVAL
728
729void
730opnumber(name)
5d7488b2 731const char * name
0cc1d052
NIS
732CODE:
733{
734 int i;
735 IV result = -1;
736 ST(0) = sv_newmortal();
737 if (strncmp(name,"pp_",3) == 0)
738 name += 3;
739 for (i = 0; i < PL_maxo; i++)
740 {
741 if (strcmp(name, PL_op_name[i]) == 0)
742 {
743 result = i;
744 break;
745 }
746 }
747 sv_setiv(ST(0),result);
748}
a8a597b2
MB
749
750void
751ppname(opnum)
752 int opnum
753 CODE:
754 ST(0) = sv_newmortal();
3280af22 755 if (opnum >= 0 && opnum < PL_maxo) {
a8a597b2 756 sv_setpvn(ST(0), "pp_", 3);
22c35a8c 757 sv_catpv(ST(0), PL_op_name[opnum]);
a8a597b2
MB
758 }
759
760void
761hash(sv)
762 SV * sv
763 CODE:
a8a597b2
MB
764 STRLEN len;
765 U32 hash = 0;
faccc32b 766 char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
5d7488b2 767 const char *s = SvPV(sv, len);
c32d3395 768 PERL_HASH(hash, s, len);
faccc32b 769 sprintf(hexhash, "0x%"UVxf, (UV)hash);
a8a597b2
MB
770 ST(0) = sv_2mortal(newSVpv(hexhash, 0));
771
772#define cast_I32(foo) (I32)foo
773IV
774cast_I32(i)
775 IV i
776
777void
778minus_c()
779 CODE:
3280af22 780 PL_minus_c = TRUE;
a8a597b2 781
059a8bb7
JH
782void
783save_BEGINs()
784 CODE:
aefff11f 785 PL_savebegin = TRUE;
059a8bb7 786
a8a597b2
MB
787SV *
788cstring(sv)
789 SV * sv
cea2e8a9 790 CODE:
52ad86de
JH
791 RETVAL = cstring(aTHX_ sv, 0);
792 OUTPUT:
793 RETVAL
794
795SV *
796perlstring(sv)
797 SV * sv
798 CODE:
799 RETVAL = cstring(aTHX_ sv, 1);
cea2e8a9
GS
800 OUTPUT:
801 RETVAL
a8a597b2
MB
802
803SV *
804cchar(sv)
805 SV * sv
cea2e8a9
GS
806 CODE:
807 RETVAL = cchar(aTHX_ sv);
808 OUTPUT:
809 RETVAL
a8a597b2
MB
810
811void
812threadsv_names()
813 PPCODE:
f5ba1307
NC
814#if PERL_VERSION <= 8
815# ifdef USE_5005THREADS
816 int i;
5d7488b2 817 const STRLEN len = strlen(PL_threadsv_names);
f5ba1307
NC
818
819 EXTEND(sp, len);
820 for (i = 0; i < len; i++)
821 PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
822# endif
823#endif
a8a597b2
MB
824
825#define OP_next(o) o->op_next
826#define OP_sibling(o) o->op_sibling
27da23d5 827#define OP_desc(o) (char *)PL_op_desc[o->op_type]
a8a597b2
MB
828#define OP_targ(o) o->op_targ
829#define OP_type(o) o->op_type
7252851f
NC
830#if PERL_VERSION >= 9
831# define OP_opt(o) o->op_opt
832# define OP_static(o) o->op_static
833#else
834# define OP_seq(o) o->op_seq
835#endif
a8a597b2
MB
836#define OP_flags(o) o->op_flags
837#define OP_private(o) o->op_private
a60ba18b 838#define OP_spare(o) o->op_spare
a8a597b2
MB
839
840MODULE = B PACKAGE = B::OP PREFIX = OP_
841
651aa52e
AE
842size_t
843OP_size(o)
844 B::OP o
845 CODE:
846 RETVAL = opsizes[cc_opclass(aTHX_ o)];
847 OUTPUT:
848 RETVAL
849
a8a597b2
MB
850B::OP
851OP_next(o)
852 B::OP o
853
854B::OP
855OP_sibling(o)
856 B::OP o
857
858char *
3f872cb9
GS
859OP_name(o)
860 B::OP o
861 CODE:
27da23d5 862 RETVAL = (char *)PL_op_name[o->op_type];
8063af02
DM
863 OUTPUT:
864 RETVAL
3f872cb9
GS
865
866
8063af02 867void
a8a597b2
MB
868OP_ppaddr(o)
869 B::OP o
dc333d64
GS
870 PREINIT:
871 int i;
872 SV *sv = sv_newmortal();
a8a597b2 873 CODE:
dc333d64
GS
874 sv_setpvn(sv, "PL_ppaddr[OP_", 13);
875 sv_catpv(sv, PL_op_name[o->op_type]);
7c436af3 876 for (i=13; (STRLEN)i < SvCUR(sv); ++i)
dc333d64
GS
877 SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
878 sv_catpv(sv, "]");
879 ST(0) = sv;
a8a597b2
MB
880
881char *
882OP_desc(o)
883 B::OP o
884
7934575e 885PADOFFSET
a8a597b2
MB
886OP_targ(o)
887 B::OP o
888
889U16
890OP_type(o)
891 B::OP o
892
7252851f
NC
893#if PERL_VERSION >= 9
894
2814eb74
PJ
895U8
896OP_opt(o)
897 B::OP o
898
899U8
900OP_static(o)
a8a597b2
MB
901 B::OP o
902
7252851f
NC
903#else
904
905U16
906OP_seq(o)
907 B::OP o
908
909#endif
910
a8a597b2
MB
911U8
912OP_flags(o)
913 B::OP o
914
915U8
916OP_private(o)
917 B::OP o
918
7252851f
NC
919#if PERL_VERSION >= 9
920
a60ba18b
JC
921U8
922OP_spare(o)
923 B::OP o
924
7252851f
NC
925#endif
926
1df34986
AE
927void
928OP_oplist(o)
929 B::OP o
930 PPCODE:
931 SP = oplist(aTHX_ o, SP);
932
a8a597b2
MB
933#define UNOP_first(o) o->op_first
934
935MODULE = B PACKAGE = B::UNOP PREFIX = UNOP_
936
937B::OP
938UNOP_first(o)
939 B::UNOP o
940
941#define BINOP_last(o) o->op_last
942
943MODULE = B PACKAGE = B::BINOP PREFIX = BINOP_
944
945B::OP
946BINOP_last(o)
947 B::BINOP o
948
949#define LOGOP_other(o) o->op_other
950
951MODULE = B PACKAGE = B::LOGOP PREFIX = LOGOP_
952
953B::OP
954LOGOP_other(o)
955 B::LOGOP o
956
a8a597b2
MB
957MODULE = B PACKAGE = B::LISTOP PREFIX = LISTOP_
958
c03c2844
SM
959U32
960LISTOP_children(o)
961 B::LISTOP o
962 OP * kid = NO_INIT
963 int i = NO_INIT
964 CODE:
c03c2844
SM
965 i = 0;
966 for (kid = o->op_first; kid; kid = kid->op_sibling)
967 i++;
8063af02
DM
968 RETVAL = i;
969 OUTPUT:
970 RETVAL
c03c2844 971
a8a597b2
MB
972#define PMOP_pmreplroot(o) o->op_pmreplroot
973#define PMOP_pmreplstart(o) o->op_pmreplstart
974#define PMOP_pmnext(o) o->op_pmnext
aaa362c4 975#define PMOP_pmregexp(o) PM_GETRE(o)
9d2bbe64
MB
976#ifdef USE_ITHREADS
977#define PMOP_pmoffset(o) o->op_pmoffset
651aa52e
AE
978#define PMOP_pmstashpv(o) o->op_pmstashpv
979#else
980#define PMOP_pmstash(o) o->op_pmstash
9d2bbe64 981#endif
a8a597b2
MB
982#define PMOP_pmflags(o) o->op_pmflags
983#define PMOP_pmpermflags(o) o->op_pmpermflags
9d2bbe64 984#define PMOP_pmdynflags(o) o->op_pmdynflags
a8a597b2
MB
985
986MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
987
988void
989PMOP_pmreplroot(o)
990 B::PMOP o
991 OP * root = NO_INIT
992 CODE:
993 ST(0) = sv_newmortal();
994 root = o->op_pmreplroot;
995 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
996 if (o->op_type == OP_PUSHRE) {
9d2bbe64
MB
997#ifdef USE_ITHREADS
998 sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
999#else
a8a597b2
MB
1000 sv_setiv(newSVrv(ST(0), root ?
1001 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
56431972 1002 PTR2IV(root));
9d2bbe64 1003#endif
a8a597b2
MB
1004 }
1005 else {
56431972 1006 sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
a8a597b2
MB
1007 }
1008
1009B::OP
1010PMOP_pmreplstart(o)
1011 B::PMOP o
1012
1013B::PMOP
1014PMOP_pmnext(o)
1015 B::PMOP o
1016
9d2bbe64
MB
1017#ifdef USE_ITHREADS
1018
1019IV
1020PMOP_pmoffset(o)
1021 B::PMOP o
1022
651aa52e
AE
1023char*
1024PMOP_pmstashpv(o)
1025 B::PMOP o
1026
1027#else
1028
1029B::HV
1030PMOP_pmstash(o)
1031 B::PMOP o
1032
9d2bbe64
MB
1033#endif
1034
6e21dc91 1035U32
a8a597b2
MB
1036PMOP_pmflags(o)
1037 B::PMOP o
1038
6e21dc91 1039U32
a8a597b2
MB
1040PMOP_pmpermflags(o)
1041 B::PMOP o
1042
9d2bbe64
MB
1043U8
1044PMOP_pmdynflags(o)
1045 B::PMOP o
1046
a8a597b2
MB
1047void
1048PMOP_precomp(o)
1049 B::PMOP o
1050 REGEXP * rx = NO_INIT
1051 CODE:
1052 ST(0) = sv_newmortal();
aaa362c4 1053 rx = PM_GETRE(o);
a8a597b2
MB
1054 if (rx)
1055 sv_setpvn(ST(0), rx->precomp, rx->prelen);
1056
ac33dcd1
JH
1057#define SVOP_sv(o) cSVOPo->op_sv
1058#define SVOP_gv(o) ((GV*)cSVOPo->op_sv)
a8a597b2
MB
1059
1060MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
1061
a8a597b2
MB
1062B::SV
1063SVOP_sv(o)
1064 B::SVOP o
1065
f22444f5 1066B::GV
065a1863
GS
1067SVOP_gv(o)
1068 B::SVOP o
1069
7934575e 1070#define PADOP_padix(o) o->op_padix
dd2155a4 1071#define PADOP_sv(o) (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
7934575e 1072#define PADOP_gv(o) ((o->op_padix \
dd2155a4
DM
1073 && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
1074 ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
a8a597b2 1075
7934575e
GS
1076MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_
1077
1078PADOFFSET
1079PADOP_padix(o)
1080 B::PADOP o
1081
1082B::SV
1083PADOP_sv(o)
1084 B::PADOP o
a8a597b2
MB
1085
1086B::GV
7934575e
GS
1087PADOP_gv(o)
1088 B::PADOP o
a8a597b2
MB
1089
1090MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_
1091
1092void
1093PVOP_pv(o)
1094 B::PVOP o
1095 CODE:
1096 /*
bec89253 1097 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
a8a597b2
MB
1098 * whereas other PVOPs point to a null terminated string.
1099 */
bec89253
RH
1100 if (o->op_type == OP_TRANS &&
1101 (o->op_private & OPpTRANS_COMPLEMENT) &&
1102 !(o->op_private & OPpTRANS_DELETE))
1103 {
5d7488b2
AL
1104 const short* const tbl = (short*)o->op_pv;
1105 const short entries = 257 + tbl[256];
bec89253
RH
1106 ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
1107 }
1108 else if (o->op_type == OP_TRANS) {
1109 ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
1110 }
1111 else
1112 ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
a8a597b2
MB
1113
1114#define LOOP_redoop(o) o->op_redoop
1115#define LOOP_nextop(o) o->op_nextop
1116#define LOOP_lastop(o) o->op_lastop
1117
1118MODULE = B PACKAGE = B::LOOP PREFIX = LOOP_
1119
1120
1121B::OP
1122LOOP_redoop(o)
1123 B::LOOP o
1124
1125B::OP
1126LOOP_nextop(o)
1127 B::LOOP o
1128
1129B::OP
1130LOOP_lastop(o)
1131 B::LOOP o
1132
1133#define COP_label(o) o->cop_label
11faa288
GS
1134#define COP_stashpv(o) CopSTASHPV(o)
1135#define COP_stash(o) CopSTASH(o)
57843af0 1136#define COP_file(o) CopFILE(o)
1df34986 1137#define COP_filegv(o) CopFILEGV(o)
a8a597b2 1138#define COP_cop_seq(o) o->cop_seq
fc15ae8f 1139#define COP_arybase(o) CopARYBASE_get(o)
57843af0 1140#define COP_line(o) CopLINE(o)
d5ec2987 1141#define COP_hints(o) CopHINTS_get(o)
a8a597b2
MB
1142
1143MODULE = B PACKAGE = B::COP PREFIX = COP_
1144
1145char *
1146COP_label(o)
1147 B::COP o
1148
11faa288
GS
1149char *
1150COP_stashpv(o)
1151 B::COP o
1152
a8a597b2
MB
1153B::HV
1154COP_stash(o)
1155 B::COP o
1156
57843af0
GS
1157char *
1158COP_file(o)
a8a597b2
MB
1159 B::COP o
1160
1df34986
AE
1161B::GV
1162COP_filegv(o)
1163 B::COP o
1164
1165
a8a597b2
MB
1166U32
1167COP_cop_seq(o)
1168 B::COP o
1169
1170I32
1171COP_arybase(o)
1172 B::COP o
1173
8bafa735 1174U32
a8a597b2
MB
1175COP_line(o)
1176 B::COP o
1177
5c3c3f81 1178void
b295d113
TH
1179COP_warnings(o)
1180 B::COP o
5c3c3f81
NC
1181 PPCODE:
1182 ST(0) = make_warnings_object(aTHX_ sv_newmortal(), o->cop_warnings);
1183 XSRETURN(1);
b295d113 1184
670f1322 1185void
6e6a1aef
RGS
1186COP_io(o)
1187 B::COP o
11bcd5da 1188 PPCODE:
8e01d9a6 1189 ST(0) = make_cop_io_object(aTHX_ sv_newmortal(), o);
11bcd5da 1190 XSRETURN(1);
6e6a1aef 1191
d5ec2987
NC
1192U32
1193COP_hints(o)
1194 B::COP o
1195
fd9f6265
JJ
1196B::RHE
1197COP_hints_hash(o)
1198 B::COP o
1199 CODE:
1200 RETVAL = o->cop_hints_hash;
1201 OUTPUT:
1202 RETVAL
1203
651aa52e
AE
1204MODULE = B PACKAGE = B::SV
1205
1206U32
1207SvTYPE(sv)
1208 B::SV sv
1209
429a5ce7
SM
1210#define object_2svref(sv) sv
1211#define SVREF SV *
1212
1213SVREF
1214object_2svref(sv)
1215 B::SV sv
1216
a8a597b2
MB
1217MODULE = B PACKAGE = B::SV PREFIX = Sv
1218
1219U32
1220SvREFCNT(sv)
1221 B::SV sv
1222
1223U32
1224SvFLAGS(sv)
1225 B::SV sv
1226
651aa52e
AE
1227U32
1228SvPOK(sv)
1229 B::SV sv
1230
1231U32
1232SvROK(sv)
1233 B::SV sv
1234
1235U32
1236SvMAGICAL(sv)
1237 B::SV sv
1238
a8a597b2
MB
1239MODULE = B PACKAGE = B::IV PREFIX = Sv
1240
1241IV
1242SvIV(sv)
1243 B::IV sv
1244
1245IV
1246SvIVX(sv)
1247 B::IV sv
1248
0ca04487
VB
1249UV
1250SvUVX(sv)
1251 B::IV sv
1252
1253
a8a597b2
MB
1254MODULE = B PACKAGE = B::IV
1255
1256#define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))
1257
1258int
1259needs64bits(sv)
1260 B::IV sv
1261
1262void
1263packiv(sv)
1264 B::IV sv
1265 CODE:
1266 if (sizeof(IV) == 8) {
1267 U32 wp[2];
5d7488b2 1268 const IV iv = SvIVX(sv);
a8a597b2
MB
1269 /*
1270 * The following way of spelling 32 is to stop compilers on
1271 * 32-bit architectures from moaning about the shift count
1272 * being >= the width of the type. Such architectures don't
1273 * reach this code anyway (unless sizeof(IV) > 8 but then
1274 * everything else breaks too so I'm not fussed at the moment).
1275 */
42718184
RB
1276#ifdef UV_IS_QUAD
1277 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1278#else
1279 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1280#endif
a8a597b2 1281 wp[1] = htonl(iv & 0xffffffff);
79cb57f6 1282 ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
a8a597b2
MB
1283 } else {
1284 U32 w = htonl((U32)SvIVX(sv));
79cb57f6 1285 ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
a8a597b2
MB
1286 }
1287
1288MODULE = B PACKAGE = B::NV PREFIX = Sv
1289
76ef7183 1290NV
a8a597b2
MB
1291SvNV(sv)
1292 B::NV sv
1293
76ef7183 1294NV
a8a597b2
MB
1295SvNVX(sv)
1296 B::NV sv
1297
809abb02
NC
1298U32
1299COP_SEQ_RANGE_LOW(sv)
1300 B::NV sv
1301
1302U32
1303COP_SEQ_RANGE_HIGH(sv)
1304 B::NV sv
1305
1306U32
1307PARENT_PAD_INDEX(sv)
1308 B::NV sv
1309
1310U32
1311PARENT_FAKELEX_FLAGS(sv)
1312 B::NV sv
1313
a8a597b2
MB
1314MODULE = B PACKAGE = B::RV PREFIX = Sv
1315
1316B::SV
1317SvRV(sv)
1318 B::RV sv
1319
1320MODULE = B PACKAGE = B::PV PREFIX = Sv
1321
0b40bd6d
RH
1322char*
1323SvPVX(sv)
1324 B::PV sv
1325
b326da91
MB
1326B::SV
1327SvRV(sv)
1328 B::PV sv
1329 CODE:
1330 if( SvROK(sv) ) {
1331 RETVAL = SvRV(sv);
1332 }
1333 else {
1334 croak( "argument is not SvROK" );
1335 }
1336 OUTPUT:
1337 RETVAL
1338
a8a597b2
MB
1339void
1340SvPV(sv)
1341 B::PV sv
1342 CODE:
b326da91 1343 ST(0) = sv_newmortal();
c0b20461 1344 if( SvPOK(sv) ) {
b55685ae
NC
1345 /* FIXME - we need a better way for B to identify PVs that are
1346 in the pads as variable names. */
1347 if((SvLEN(sv) && SvCUR(sv) >= SvLEN(sv))) {
1348 /* It claims to be longer than the space allocated for it -
1349 presuambly it's a variable name in the pad */
1350 sv_setpv(ST(0), SvPV_nolen_const(sv));
1351 } else {
1352 sv_setpvn(ST(0), SvPVX_const(sv), SvCUR(sv));
1353 }
b326da91
MB
1354 SvFLAGS(ST(0)) |= SvUTF8(sv);
1355 }
1356 else {
1357 /* XXX for backward compatibility, but should fail */
1358 /* croak( "argument is not SvPOK" ); */
1359 sv_setpvn(ST(0), NULL, 0);
1360 }
a8a597b2 1361
5a44e503
NC
1362# This used to read 257. I think that that was buggy - should have been 258.
1363# (The "\0", the flags byte, and 256 for the table. Not that anything
1364# anywhere calls this method. NWC.
651aa52e
AE
1365void
1366SvPVBM(sv)
1367 B::PV sv
1368 CODE:
1369 ST(0) = sv_newmortal();
aa07b2f6 1370 sv_setpvn(ST(0), SvPVX_const(sv),
5a44e503 1371 SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0));
651aa52e
AE
1372
1373
445a12f6
DM
1374STRLEN
1375SvLEN(sv)
1376 B::PV sv
1377
1378STRLEN
1379SvCUR(sv)
1380 B::PV sv
1381
a8a597b2
MB
1382MODULE = B PACKAGE = B::PVMG PREFIX = Sv
1383
1384void
1385SvMAGIC(sv)
1386 B::PVMG sv
1387 MAGIC * mg = NO_INIT
1388 PPCODE:
1389 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
cea2e8a9 1390 XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg));
a8a597b2
MB
1391
1392MODULE = B PACKAGE = B::PVMG
1393
1394B::HV
1395SvSTASH(sv)
1396 B::PVMG sv
1397
1398#define MgMOREMAGIC(mg) mg->mg_moremagic
1399#define MgPRIVATE(mg) mg->mg_private
1400#define MgTYPE(mg) mg->mg_type
1401#define MgFLAGS(mg) mg->mg_flags
1402#define MgOBJ(mg) mg->mg_obj
88b39979 1403#define MgLENGTH(mg) mg->mg_len
bde7177d 1404#define MgREGEX(mg) PTR2IV(mg->mg_obj)
a8a597b2
MB
1405
1406MODULE = B PACKAGE = B::MAGIC PREFIX = Mg
1407
1408B::MAGIC
1409MgMOREMAGIC(mg)
1410 B::MAGIC mg
c5f0f3aa
RGS
1411 CODE:
1412 if( MgMOREMAGIC(mg) ) {
1413 RETVAL = MgMOREMAGIC(mg);
1414 }
1415 else {
1416 XSRETURN_UNDEF;
1417 }
1418 OUTPUT:
1419 RETVAL
a8a597b2
MB
1420
1421U16
1422MgPRIVATE(mg)
1423 B::MAGIC mg
1424
1425char
1426MgTYPE(mg)
1427 B::MAGIC mg
1428
1429U8
1430MgFLAGS(mg)
1431 B::MAGIC mg
1432
1433B::SV
1434MgOBJ(mg)
1435 B::MAGIC mg
b326da91 1436
9d2bbe64
MB
1437IV
1438MgREGEX(mg)
1439 B::MAGIC mg
1440 CODE:
a8248b05 1441 if(mg->mg_type == PERL_MAGIC_qr) {
9d2bbe64
MB
1442 RETVAL = MgREGEX(mg);
1443 }
1444 else {
1445 croak( "REGEX is only meaningful on r-magic" );
1446 }
1447 OUTPUT:
1448 RETVAL
1449
b326da91
MB
1450SV*
1451precomp(mg)
1452 B::MAGIC mg
1453 CODE:
a8248b05 1454 if (mg->mg_type == PERL_MAGIC_qr) {
b326da91 1455 REGEXP* rx = (REGEXP*)mg->mg_obj;
ef35129c 1456 RETVAL = Nullsv;
b326da91
MB
1457 if( rx )
1458 RETVAL = newSVpvn( rx->precomp, rx->prelen );
1459 }
1460 else {
1461 croak( "precomp is only meaningful on r-magic" );
1462 }
1463 OUTPUT:
1464 RETVAL
a8a597b2 1465
88b39979
VB
1466I32
1467MgLENGTH(mg)
1468 B::MAGIC mg
1469
a8a597b2
MB
1470void
1471MgPTR(mg)
1472 B::MAGIC mg
1473 CODE:
1474 ST(0) = sv_newmortal();
88b39979
VB
1475 if (mg->mg_ptr){
1476 if (mg->mg_len >= 0){
1477 sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len);
651aa52e
AE
1478 } else if (mg->mg_len == HEf_SVKEY) {
1479 ST(0) = make_sv_object(aTHX_
1480 sv_newmortal(), (SV*)mg->mg_ptr);
88b39979
VB
1481 }
1482 }
a8a597b2
MB
1483
1484MODULE = B PACKAGE = B::PVLV PREFIX = Lv
1485
1486U32
1487LvTARGOFF(sv)
1488 B::PVLV sv
1489
1490U32
1491LvTARGLEN(sv)
1492 B::PVLV sv
1493
1494char
1495LvTYPE(sv)
1496 B::PVLV sv
1497
1498B::SV
1499LvTARG(sv)
1500 B::PVLV sv
1501
1502MODULE = B PACKAGE = B::BM PREFIX = Bm
1503
1504I32
1505BmUSEFUL(sv)
1506 B::BM sv
1507
85c508c3 1508U32
a8a597b2
MB
1509BmPREVIOUS(sv)
1510 B::BM sv
1511
1512U8
1513BmRARE(sv)
1514 B::BM sv
1515
1516void
1517BmTABLE(sv)
1518 B::BM sv
1519 STRLEN len = NO_INIT
1520 char * str = NO_INIT
1521 CODE:
1522 str = SvPV(sv, len);
1523 /* Boyer-Moore table is just after string and its safety-margin \0 */
5a44e503 1524 ST(0) = sv_2mortal(newSVpvn(str + len + PERL_FBM_TABLE_OFFSET, 256));
a8a597b2
MB
1525
1526MODULE = B PACKAGE = B::GV PREFIX = Gv
1527
1528void
1529GvNAME(gv)
1530 B::GV gv
1531 CODE:
79cb57f6 1532 ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
a8a597b2 1533
87d7fd28
GS
1534bool
1535is_empty(gv)
1536 B::GV gv
1537 CODE:
1538 RETVAL = GvGP(gv) == Null(GP*);
1539 OUTPUT:
1540 RETVAL
1541
651aa52e
AE
1542void*
1543GvGP(gv)
1544 B::GV gv
1545
a8a597b2
MB
1546B::HV
1547GvSTASH(gv)
1548 B::GV gv
1549
1550B::SV
1551GvSV(gv)
1552 B::GV gv
1553
1554B::IO
1555GvIO(gv)
1556 B::GV gv
1557
1df34986 1558B::FM
a8a597b2
MB
1559GvFORM(gv)
1560 B::GV gv
1df34986
AE
1561 CODE:
1562 RETVAL = (SV*)GvFORM(gv);
1563 OUTPUT:
1564 RETVAL
a8a597b2
MB
1565
1566B::AV
1567GvAV(gv)
1568 B::GV gv
1569
1570B::HV
1571GvHV(gv)
1572 B::GV gv
1573
1574B::GV
1575GvEGV(gv)
1576 B::GV gv
1577
1578B::CV
1579GvCV(gv)
1580 B::GV gv
1581
1582U32
1583GvCVGEN(gv)
1584 B::GV gv
1585
8bafa735 1586U32
a8a597b2
MB
1587GvLINE(gv)
1588 B::GV gv
1589
b195d487
GS
1590char *
1591GvFILE(gv)
1592 B::GV gv
1593
a8a597b2
MB
1594B::GV
1595GvFILEGV(gv)
1596 B::GV gv
1597
1598MODULE = B PACKAGE = B::GV
1599
1600U32
1601GvREFCNT(gv)
1602 B::GV gv
1603
1604U8
1605GvFLAGS(gv)
1606 B::GV gv
1607
1608MODULE = B PACKAGE = B::IO PREFIX = Io
1609
1610long
1611IoLINES(io)
1612 B::IO io
1613
1614long
1615IoPAGE(io)
1616 B::IO io
1617
1618long
1619IoPAGE_LEN(io)
1620 B::IO io
1621
1622long
1623IoLINES_LEFT(io)
1624 B::IO io
1625
1626char *
1627IoTOP_NAME(io)
1628 B::IO io
1629
1630B::GV
1631IoTOP_GV(io)
1632 B::IO io
1633
1634char *
1635IoFMT_NAME(io)
1636 B::IO io
1637
1638B::GV
1639IoFMT_GV(io)
1640 B::IO io
1641
1642char *
1643IoBOTTOM_NAME(io)
1644 B::IO io
1645
1646B::GV
1647IoBOTTOM_GV(io)
1648 B::IO io
1649
1650short
1651IoSUBPROCESS(io)
1652 B::IO io
1653
b326da91
MB
1654bool
1655IsSTD(io,name)
1656 B::IO io
5d7488b2 1657 const char* name
b326da91
MB
1658 PREINIT:
1659 PerlIO* handle = 0;
1660 CODE:
1661 if( strEQ( name, "stdin" ) ) {
1662 handle = PerlIO_stdin();
1663 }
1664 else if( strEQ( name, "stdout" ) ) {
1665 handle = PerlIO_stdout();
1666 }
1667 else if( strEQ( name, "stderr" ) ) {
1668 handle = PerlIO_stderr();
1669 }
1670 else {
1671 croak( "Invalid value '%s'", name );
1672 }
1673 RETVAL = handle == IoIFP(io);
1674 OUTPUT:
1675 RETVAL
1676
a8a597b2
MB
1677MODULE = B PACKAGE = B::IO
1678
1679char
1680IoTYPE(io)
1681 B::IO io
1682
1683U8
1684IoFLAGS(io)
1685 B::IO io
1686
1687MODULE = B PACKAGE = B::AV PREFIX = Av
1688
1689SSize_t
1690AvFILL(av)
1691 B::AV av
1692
1693SSize_t
1694AvMAX(av)
1695 B::AV av
1696
edcc7c74
NC
1697#if PERL_VERSION < 9
1698
1699
1700#define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1701
1702IV
1703AvOFF(av)
1704 B::AV av
1705
1706#endif
1707
a8a597b2
MB
1708void
1709AvARRAY(av)
1710 B::AV av
1711 PPCODE:
1712 if (AvFILL(av) >= 0) {
1713 SV **svp = AvARRAY(av);
1714 I32 i;
1715 for (i = 0; i <= AvFILL(av); i++)
cea2e8a9 1716 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
a8a597b2
MB
1717 }
1718
429a5ce7
SM
1719void
1720AvARRAYelt(av, idx)
1721 B::AV av
1722 int idx
1723 PPCODE:
1724 if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1725 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
1726 else
1727 XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
1728
edcc7c74
NC
1729#if PERL_VERSION < 9
1730
1731MODULE = B PACKAGE = B::AV
1732
1733U8
1734AvFLAGS(av)
1735 B::AV av
1736
1737#endif
1738
1df34986
AE
1739MODULE = B PACKAGE = B::FM PREFIX = Fm
1740
1741IV
1742FmLINES(form)
1743 B::FM form
1744
a8a597b2
MB
1745MODULE = B PACKAGE = B::CV PREFIX = Cv
1746
651aa52e
AE
1747U32
1748CvCONST(cv)
1749 B::CV cv
1750
a8a597b2
MB
1751B::HV
1752CvSTASH(cv)
1753 B::CV cv
1754
1755B::OP
1756CvSTART(cv)
1757 B::CV cv
bf53b3a5
NC
1758 CODE:
1759 RETVAL = CvISXSUB(cv) ? NULL : CvSTART(cv);
1760 OUTPUT:
1761 RETVAL
a8a597b2
MB
1762
1763B::OP
1764CvROOT(cv)
1765 B::CV cv
d04ba589
NC
1766 CODE:
1767 RETVAL = CvISXSUB(cv) ? NULL : CvROOT(cv);
1768 OUTPUT:
1769 RETVAL
a8a597b2
MB
1770
1771B::GV
1772CvGV(cv)
1773 B::CV cv
1774
57843af0
GS
1775char *
1776CvFILE(cv)
1777 B::CV cv
1778
a8a597b2
MB
1779long
1780CvDEPTH(cv)
1781 B::CV cv
1782
1783B::AV
1784CvPADLIST(cv)
1785 B::CV cv
1786
1787B::CV
1788CvOUTSIDE(cv)
1789 B::CV cv
1790
a3985cdc
DM
1791U32
1792CvOUTSIDE_SEQ(cv)
1793 B::CV cv
1794
a8a597b2
MB
1795void
1796CvXSUB(cv)
1797 B::CV cv
1798 CODE:
d04ba589 1799 ST(0) = sv_2mortal(newSViv(CvISXSUB(cv) ? PTR2IV(CvXSUB(cv)) : 0));
a8a597b2
MB
1800
1801
1802void
1803CvXSUBANY(cv)
1804 B::CV cv
1805 CODE:
b326da91 1806 ST(0) = CvCONST(cv) ?
07409e01 1807 make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) :
bf53b3a5 1808 sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0));
a8a597b2 1809
5cfd8ad4
VB
1810MODULE = B PACKAGE = B::CV
1811
6aaf4108 1812U16
5cfd8ad4
VB
1813CvFLAGS(cv)
1814 B::CV cv
1815
de3f1649
JT
1816MODULE = B PACKAGE = B::CV PREFIX = cv_
1817
1818B::SV
1819cv_const_sv(cv)
1820 B::CV cv
1821
5cfd8ad4 1822
a8a597b2
MB
1823MODULE = B PACKAGE = B::HV PREFIX = Hv
1824
1825STRLEN
1826HvFILL(hv)
1827 B::HV hv
1828
1829STRLEN
1830HvMAX(hv)
1831 B::HV hv
1832
1833I32
1834HvKEYS(hv)
1835 B::HV hv
1836
1837I32
1838HvRITER(hv)
1839 B::HV hv
1840
1841char *
1842HvNAME(hv)
1843 B::HV hv
1844
edcc7c74
NC
1845#if PERL_VERSION < 9
1846
1847B::PMOP
1848HvPMROOT(hv)
1849 B::HV hv
1850
1851#endif
1852
a8a597b2
MB
1853void
1854HvARRAY(hv)
1855 B::HV hv
1856 PPCODE:
1857 if (HvKEYS(hv) > 0) {
1858 SV *sv;
1859 char *key;
1860 I32 len;
1861 (void)hv_iterinit(hv);
1862 EXTEND(sp, HvKEYS(hv) * 2);
8063af02 1863 while ((sv = hv_iternextsv(hv, &key, &len))) {
79cb57f6 1864 PUSHs(newSVpvn(key, len));
cea2e8a9 1865 PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
a8a597b2
MB
1866 }
1867 }
fd9f6265
JJ
1868
1869MODULE = B PACKAGE = B::HE PREFIX = He
1870
1871B::SV
1872HeVAL(he)
1873 B::HE he
1874
1875U32
1876HeHASH(he)
1877 B::HE he
1878
1879B::SV
1880HeSVKEY_force(he)
1881 B::HE he
1882
1883MODULE = B PACKAGE = B::RHE PREFIX = RHE_
1884
1885SV*
1886RHE_HASH(h)
1887 B::RHE h
1888 CODE:
38d45822 1889 RETVAL = newRV( (SV*)Perl_refcounted_he_chain_2hv(aTHX_ h) );
fd9f6265
JJ
1890 OUTPUT:
1891 RETVAL