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