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