3 * Copyright (c) 1996 Malcolm Beattie
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.
10 #define PERL_NO_GET_CONTEXT
16 typedef PerlIO * InputStream;
18 typedef FILE * InputStream;
22 static const char* const svclassnames[] = {
29 #if PERL_VERSION <= 10
39 #if PERL_VERSION >= 11
71 static const char* const opclassnames[] = {
86 static const size_t opsizes[] = {
101 #define MY_CXT_KEY "B::_guts" XS_VERSION
104 int x_walkoptree_debug; /* Flag for walkoptree debug hook */
105 SV * x_specialsv_list[7];
110 #define walkoptree_debug (MY_CXT.x_walkoptree_debug)
111 #define specialsv_list (MY_CXT.x_specialsv_list)
114 cc_opclass(pTHX_ const OP *o)
122 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
124 if (o->op_type == OP_SASSIGN)
125 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
127 if (o->op_type == OP_AELEMFAST) {
128 if (o->op_flags & OPf_SPECIAL)
139 if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
140 o->op_type == OP_RCATLINE)
144 if (o->op_type == OP_CUSTOM)
147 switch (OP_CLASS(o)) {
172 case OA_PVOP_OR_SVOP:
174 * Character translations (tr///) are usually a PVOP, keeping a
175 * pointer to a table of shorts used to look up translations.
176 * Under utf8, however, a simple table isn't practical; instead,
177 * the OP is an SVOP (or, under threads, a PADOP),
178 * and the SV is a reference to a swash
179 * (i.e., an RV pointing to an HV).
182 (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
184 #if defined(USE_ITHREADS) \
185 && (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION >= 9))
186 ? OPc_PADOP : OPc_PVOP;
188 ? OPc_SVOP : OPc_PVOP;
197 case OA_BASEOP_OR_UNOP:
199 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
200 * whether parens were seen. perly.y uses OPf_SPECIAL to
201 * signal whether a BASEOP had empty parens or none.
202 * Some other UNOPs are created later, though, so the best
203 * test is OPf_KIDS, which is set in newUNOP.
205 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
209 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
210 * the OPf_REF flag to distinguish between OP types instead of the
211 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
212 * return OPc_UNOP so that walkoptree can find our children. If
213 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
214 * (no argument to the operator) it's an OP; with OPf_REF set it's
215 * an SVOP (and op_sv is the GV for the filehandle argument).
217 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
219 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
221 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
225 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
226 * label was omitted (in which case it's a BASEOP) or else a term was
227 * seen. In this last case, all except goto are definitely PVOP but
228 * goto is either a PVOP (with an ordinary constant label), an UNOP
229 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
230 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
233 if (o->op_flags & OPf_STACKED)
235 else if (o->op_flags & OPf_SPECIAL)
240 warn("can't determine class of operator %s, assuming BASEOP\n",
246 make_op_object(pTHX_ const OP *o)
248 SV *opsv = sv_newmortal();
249 sv_setiv(newSVrv(opsv, opclassnames[cc_opclass(aTHX_ o)]), PTR2IV(o));
254 make_sv_object(pTHX_ SV *sv)
256 SV *const arg = sv_newmortal();
257 const char *type = 0;
261 for (iv = 0; iv < (IV)(sizeof(specialsv_list)/sizeof(SV*)); iv++) {
262 if (sv == specialsv_list[iv]) {
268 type = svclassnames[SvTYPE(sv)];
271 sv_setiv(newSVrv(arg, type), iv);
275 #if PERL_VERSION >= 9
277 make_temp_object(pTHX_ SV *temp)
280 SV *arg = sv_newmortal();
281 const char *const type = svclassnames[SvTYPE(temp)];
282 const IV iv = PTR2IV(temp);
284 target = newSVrv(arg, type);
285 sv_setiv(target, iv);
287 /* Need to keep our "temp" around as long as the target exists.
288 Simplest way seems to be to hang it from magic, and let that clear
289 it up. No vtable, so won't actually get in the way of anything. */
290 sv_magicext(target, temp, PERL_MAGIC_sv, NULL, NULL, 0);
291 /* magic object has had its reference count increased, so we must drop
298 make_warnings_object(pTHX_ const COP *const cop)
300 const STRLEN *const warnings = cop->cop_warnings;
301 const char *type = 0;
303 IV iv = sizeof(specialsv_list)/sizeof(SV*);
305 /* Counting down is deliberate. Before the split between make_sv_object
306 and make_warnings_obj there appeared to be a bug - Nullsv and pWARN_STD
307 were both 0, so you could never get a B::SPECIAL for pWARN_STD */
310 if ((SV*)warnings == specialsv_list[iv]) {
316 SV *arg = sv_newmortal();
317 sv_setiv(newSVrv(arg, type), iv);
320 /* B assumes that warnings are a regular SV. Seems easier to keep it
321 happy by making them into a regular SV. */
322 return make_temp_object(aTHX_ newSVpvn((char *)(warnings + 1), *warnings));
327 make_cop_io_object(pTHX_ COP *cop)
329 SV *const value = newSV(0);
331 Perl_emulate_cop_io(aTHX_ cop, value);
334 return make_sv_object(aTHX_ value);
337 return make_sv_object(aTHX_ NULL);
343 make_mg_object(pTHX_ MAGIC *mg)
345 SV *arg = sv_newmortal();
346 sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
351 cstring(pTHX_ SV *sv, bool perlstyle)
356 return newSVpvs_flags("0", SVs_TEMP);
358 sstr = newSVpvs_flags("\"", SVs_TEMP);
360 if (perlstyle && SvUTF8(sv)) {
361 SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
362 const STRLEN len = SvCUR(sv);
363 const char *s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
367 sv_catpvs(sstr, "\\\"");
369 sv_catpvs(sstr, "\\$");
371 sv_catpvs(sstr, "\\@");
374 if (strchr("nrftax\\",*(s+1)))
375 sv_catpvn(sstr, s++, 2);
377 sv_catpvs(sstr, "\\\\");
379 else /* should always be printable */
380 sv_catpvn(sstr, s, 1);
388 const char *s = SvPV(sv, len);
389 for (; len; len--, s++)
391 /* At least try a little for readability */
393 sv_catpvs(sstr, "\\\"");
395 sv_catpvs(sstr, "\\\\");
396 /* trigraphs - bleagh */
397 else if (!perlstyle && *s == '?' && len>=3 && s[1] == '?') {
398 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", '?');
400 else if (perlstyle && *s == '$')
401 sv_catpvs(sstr, "\\$");
402 else if (perlstyle && *s == '@')
403 sv_catpvs(sstr, "\\@");
405 else if (isPRINT(*s))
407 else if (*s >= ' ' && *s < 127)
409 sv_catpvn(sstr, s, 1);
411 sv_catpvs(sstr, "\\n");
413 sv_catpvs(sstr, "\\r");
415 sv_catpvs(sstr, "\\t");
417 sv_catpvs(sstr, "\\a");
419 sv_catpvs(sstr, "\\b");
421 sv_catpvs(sstr, "\\f");
422 else if (!perlstyle && *s == '\v')
423 sv_catpvs(sstr, "\\v");
426 /* Don't want promotion of a signed -1 char in sprintf args */
427 const unsigned char c = (unsigned char) *s;
428 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
430 /* XXX Add line breaks if string is long */
433 sv_catpvs(sstr, "\"");
440 SV *sstr = newSVpvs_flags("'", SVs_TEMP);
441 const char *s = SvPV_nolen(sv);
442 /* Don't want promotion of a signed -1 char in sprintf args */
443 const unsigned char c = (unsigned char) *s;
446 sv_catpvs(sstr, "\\'");
448 sv_catpvs(sstr, "\\\\");
452 else if (c >= ' ' && c < 127)
454 sv_catpvn(sstr, s, 1);
456 sv_catpvs(sstr, "\\n");
458 sv_catpvs(sstr, "\\r");
460 sv_catpvs(sstr, "\\t");
462 sv_catpvs(sstr, "\\a");
464 sv_catpvs(sstr, "\\b");
466 sv_catpvs(sstr, "\\f");
468 sv_catpvs(sstr, "\\v");
470 Perl_sv_catpvf(aTHX_ sstr, "\\%03o", c);
471 sv_catpvs(sstr, "'");
475 #if PERL_VERSION >= 9
476 # define PMOP_pmreplstart(o) o->op_pmstashstartu.op_pmreplstart
477 # define PMOP_pmreplroot(o) o->op_pmreplrootu.op_pmreplroot
479 # define PMOP_pmreplstart(o) o->op_pmreplstart
480 # define PMOP_pmreplroot(o) o->op_pmreplroot
481 # define PMOP_pmpermflags(o) o->op_pmpermflags
482 # define PMOP_pmdynflags(o) o->op_pmdynflags
486 walkoptree(pTHX_ OP *o, const char *method, SV *ref)
491 const char *const classname = opclassnames[cc_opclass(aTHX_ o)];
494 /* Check that no-one has changed our reference, or is holding a reference
496 if (SvREFCNT(ref) == 1 && SvROK(ref) && SvTYPE(ref) == SVt_RV
497 && (object = SvRV(ref)) && SvREFCNT(object) == 1
498 && SvTYPE(object) == SVt_PVMG && SvIOK_only(object)
499 && !SvMAGICAL(object) && !SvMAGIC(object) && SvSTASH(object)) {
500 /* Looks good, so rebless it for the class we need: */
501 sv_bless(ref, gv_stashpv(classname, GV_ADD));
503 /* Need to make a new one. */
504 ref = sv_newmortal();
505 object = newSVrv(ref, classname);
507 sv_setiv(object, PTR2IV(o));
509 if (walkoptree_debug) {
513 perl_call_method("walkoptree_debug", G_DISCARD);
518 perl_call_method(method, G_DISCARD);
519 if (o && (o->op_flags & OPf_KIDS)) {
520 for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
521 ref = walkoptree(aTHX_ kid, method, ref);
524 if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
525 && (kid = PMOP_pmreplroot(cPMOPo)))
527 ref = walkoptree(aTHX_ kid, method, ref);
533 oplist(pTHX_ OP *o, SV **SP)
535 for(; o; o = o->op_next) {
536 #if PERL_VERSION >= 9
545 XPUSHs(make_op_object(aTHX_ o));
546 switch (o->op_type) {
548 SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
551 if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
552 OP *kid = cLISTOPo->op_first->op_sibling; /* pass pushmark */
553 kid = kUNOP->op_first; /* pass rv2gv */
554 kid = kUNOP->op_first; /* pass leave */
555 SP = oplist(aTHX_ kid->op_next, SP);
559 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
561 SP = oplist(aTHX_ cLOGOPo->op_other, SP);
564 SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
565 SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
566 SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
574 typedef UNOP *B__UNOP;
575 typedef BINOP *B__BINOP;
576 typedef LOGOP *B__LOGOP;
577 typedef LISTOP *B__LISTOP;
578 typedef PMOP *B__PMOP;
579 typedef SVOP *B__SVOP;
580 typedef PADOP *B__PADOP;
581 typedef PVOP *B__PVOP;
582 typedef LOOP *B__LOOP;
590 #if PERL_VERSION >= 11
591 typedef SV *B__REGEXP;
603 typedef MAGIC *B__MAGIC;
605 #if PERL_VERSION >= 9
606 typedef struct refcounted_he *B__RHE;
610 # define ASSIGN_COMMON_ALIAS(var) \
611 STMT_START { XSANY.any_i32 = offsetof(struct interpreter, var); } STMT_END
613 # define ASSIGN_COMMON_ALIAS(var) \
614 STMT_START { XSANY.any_ptr = (void *)&PL_##var; } STMT_END
617 /* This needs to be ALIASed in a custom way, hence can't easily be defined as
619 static XSPROTO(intrpvar_sv_common); /* prototype to pass -Wmissing-prototypes */
620 static XSPROTO(intrpvar_sv_common)
626 croak_xs_usage(cv, "");
628 ret = *(SV **)(XSANY.any_i32 + (char *)my_perl);
630 ret = *(SV **)(XSANY.any_ptr);
632 ST(0) = make_sv_object(aTHX_ ret);
636 #include "const-c.inc"
638 MODULE = B PACKAGE = B
640 INCLUDE: const-xs.inc
647 const char *file = __FILE__;
649 specialsv_list[0] = Nullsv;
650 specialsv_list[1] = &PL_sv_undef;
651 specialsv_list[2] = &PL_sv_yes;
652 specialsv_list[3] = &PL_sv_no;
653 specialsv_list[4] = (SV *) pWARN_ALL;
654 specialsv_list[5] = (SV *) pWARN_NONE;
655 specialsv_list[6] = (SV *) pWARN_STD;
657 cv = newXS("B::init_av", intrpvar_sv_common, file);
658 ASSIGN_COMMON_ALIAS(Iinitav);
659 cv = newXS("B::check_av", intrpvar_sv_common, file);
660 ASSIGN_COMMON_ALIAS(Icheckav_save);
661 #if PERL_VERSION >= 9
662 cv = newXS("B::unitcheck_av", intrpvar_sv_common, file);
663 ASSIGN_COMMON_ALIAS(Iunitcheckav_save);
665 cv = newXS("B::begin_av", intrpvar_sv_common, file);
666 ASSIGN_COMMON_ALIAS(Ibeginav_save);
667 cv = newXS("B::end_av", intrpvar_sv_common, file);
668 ASSIGN_COMMON_ALIAS(Iendav);
669 cv = newXS("B::main_cv", intrpvar_sv_common, file);
670 ASSIGN_COMMON_ALIAS(Imain_cv);
671 cv = newXS("B::inc_gv", intrpvar_sv_common, file);
672 ASSIGN_COMMON_ALIAS(Iincgv);
673 cv = newXS("B::defstash", intrpvar_sv_common, file);
674 ASSIGN_COMMON_ALIAS(Idefstash);
675 cv = newXS("B::curstash", intrpvar_sv_common, file);
676 ASSIGN_COMMON_ALIAS(Icurstash);
677 cv = newXS("B::formfeed", intrpvar_sv_common, file);
678 ASSIGN_COMMON_ALIAS(Iformfeed);
680 cv = newXS("B::regex_padav", intrpvar_sv_common, file);
681 ASSIGN_COMMON_ALIAS(Iregex_padav);
683 cv = newXS("B::warnhook", intrpvar_sv_common, file);
684 ASSIGN_COMMON_ALIAS(Iwarnhook);
685 cv = newXS("B::diehook", intrpvar_sv_common, file);
686 ASSIGN_COMMON_ALIAS(Idiehook);
692 RETVAL = PL_amagic_generation;
699 PUSHs(make_sv_object(aTHX_ (SV *)(PL_main_cv ? CvPADLIST(PL_main_cv)
700 : CvPADLIST(PL_compcv))));
708 PUSHs(make_sv_object(aTHX_ ix > 1 ? &PL_sv_yes
709 : ix < 1 ? &PL_sv_undef
717 PUSHs(make_op_object(aTHX_ ix ? PL_main_start : PL_main_root));
724 RETVAL = ix ? PL_dowarn : PL_sub_generation;
729 walkoptree(op, method)
733 (void) walkoptree(aTHX_ op, method, &PL_sv_undef);
736 walkoptree_debug(...)
739 RETVAL = walkoptree_debug;
740 if (items > 0 && SvTRUE(ST(1)))
741 walkoptree_debug = 1;
745 #define address(sv) PTR2IV(sv)
756 croak("argument is not a reference");
757 PUSHs(make_sv_object(aTHX_ SvRV(sv)));
766 ST(0) = sv_newmortal();
767 if (strncmp(name,"pp_",3) == 0)
769 for (i = 0; i < PL_maxo; i++)
771 if (strcmp(name, PL_op_name[i]) == 0)
777 sv_setiv(ST(0),result);
784 ST(0) = sv_newmortal();
785 if (opnum >= 0 && opnum < PL_maxo) {
786 sv_setpvs(ST(0), "pp_");
787 sv_catpv(ST(0), PL_op_name[opnum]);
796 const char *s = SvPVbyte(sv, len);
797 PERL_HASH(hash, s, len);
798 ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "0x%"UVxf, (UV)hash));
800 #define cast_I32(foo) (I32)foo
822 PUSHs(ix == 2 ? cchar(aTHX_ sv) : cstring(aTHX_ sv, (bool)ix));
827 #if PERL_VERSION <= 8
828 # ifdef USE_5005THREADS
830 const STRLEN len = strlen(PL_threadsv_names);
833 for (i = 0; i < len; i++)
834 PUSHs(newSVpvn_flags(&PL_threadsv_names[i], 1, SVs_TEMP));
840 #define line_tp 0x20000
842 #define PADOFFSETp 0x40000
845 #define char_pp 0x70000
847 #define OP_next_ix OPp | offsetof(struct op, op_next)
848 #define OP_sibling_ix OPp | offsetof(struct op, op_sibling)
849 #define UNOP_first_ix OPp | offsetof(struct unop, op_first)
850 #define BINOP_last_ix OPp | offsetof(struct binop, op_last)
851 #define LOGOP_other_ix OPp | offsetof(struct logop, op_other)
852 #if PERL_VERSION >= 9
853 # define PMOP_pmreplstart_ix \
854 OPp | offsetof(struct pmop, op_pmstashstartu.op_pmreplstart)
856 # define PMOP_pmreplstart_ix OPp | offsetof(struct pmop, op_pmreplstart)
858 #define LOOP_redoop_ix OPp | offsetof(struct loop, op_redoop)
859 #define LOOP_nextop_ix OPp | offsetof(struct loop, op_nextop)
860 #define LOOP_lastop_ix OPp | offsetof(struct loop, op_lastop)
862 #define OP_targ_ix PADOFFSETp | offsetof(struct op, op_targ)
863 #define OP_flags_ix U8p | offsetof(struct op, op_flags)
864 #define OP_private_ix U8p | offsetof(struct op, op_private)
866 #define PMOP_pmflags_ix U32p | offsetof(struct pmop, op_pmflags)
869 #define PMOP_pmoffset_ix IVp | offsetof(struct pmop, op_pmoffset)
872 # Yes, B::SV::sv and B::SV::gv really do end up generating identical code.
873 #define SVOP_sv_ix SVp | offsetof(struct svop, op_sv)
874 #define SVOP_gv_ix SVp | offsetof(struct svop, op_sv)
876 #define PADOP_padix_ix PADOFFSETp | offsetof(struct padop, op_padix)
878 #define COP_seq_ix U32p | offsetof(struct cop, cop_seq)
879 #define COP_line_ix line_tp | offsetof(struct cop, cop_line)
880 #if PERL_VERSION >= 9
881 #define COP_hints_ix U32p | offsetof(struct cop, cop_hints)
883 #define COP_hints_ix U8p | offsetof(struct cop, op_private)
887 #define COP_stashpv_ix char_pp | offsetof(struct cop, cop_stashpv)
888 #define COP_file_ix char_pp | offsetof(struct cop, cop_file)
890 #define COP_stash_ix SVp | offsetof(struct cop, cop_stash)
891 #define COP_filegv_ix SVp | offsetof(struct cop, cop_filegv)
894 MODULE = B PACKAGE = B::OP
900 RETVAL = opsizes[cc_opclass(aTHX_ o)];
904 # The type checking code in B has always been identical for all OP types,
905 # irrespective of whether the action is actually defined on that OP.
911 B::OP::next = OP_next_ix
912 B::OP::sibling = OP_sibling_ix
913 B::OP::targ = OP_targ_ix
914 B::OP::flags = OP_flags_ix
915 B::OP::private = OP_private_ix
916 B::UNOP::first = UNOP_first_ix
917 B::BINOP::last = BINOP_last_ix
918 B::LOGOP::other = LOGOP_other_ix
919 B::PMOP::pmreplstart = PMOP_pmreplstart_ix
920 B::LOOP::redoop = LOOP_redoop_ix
921 B::LOOP::nextop = LOOP_nextop_ix
922 B::LOOP::lastop = LOOP_lastop_ix
923 B::PMOP::pmflags = PMOP_pmflags_ix
924 B::SVOP::sv = SVOP_sv_ix
925 B::SVOP::gv = SVOP_gv_ix
926 B::PADOP::padix = PADOP_padix_ix
927 B::COP::cop_seq = COP_seq_ix
928 B::COP::line = COP_line_ix
929 B::COP::hints = COP_hints_ix
934 ptr = (ix & 0xFFFF) + (char *)o;
935 switch ((U8)(ix >> 16)) {
936 case (U8)(OPp >> 16):
937 ret = make_op_object(aTHX_ *((OP **)ptr));
939 case (U8)(PADOFFSETp >> 16):
940 ret = sv_2mortal(newSVuv(*((PADOFFSET*)ptr)));
942 case (U8)(U8p >> 16):
943 ret = sv_2mortal(newSVuv(*((U8*)ptr)));
945 case (U8)(U32p >> 16):
946 ret = sv_2mortal(newSVuv(*((U32*)ptr)));
948 case (U8)(SVp >> 16):
949 ret = make_sv_object(aTHX_ *((SV **)ptr));
951 case (U8)(line_tp >> 16):
952 ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
955 case (U8)(IVp >> 16):
956 ret = sv_2mortal(newSViv(*((IV*)ptr)));
958 case (U8)(char_pp >> 16):
959 ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
963 croak("Illegal alias 0x%08x for B::*next", (unsigned)ix);
975 RETVAL = (char *)(ix ? OP_DESC(o) : OP_NAME(o));
984 SV *sv = newSVpvs_flags("PL_ppaddr[OP_", SVs_TEMP);
986 sv_catpv(sv, PL_op_name[o->op_type]);
987 for (i=13; (STRLEN)i < SvCUR(sv); ++i)
988 SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
992 #if PERL_VERSION >= 9
993 # These 3 are all bitfields, so we can't take their addresses.
1006 RETVAL = o->op_spare;
1009 RETVAL = o->op_type;
1027 RETVAL = o->op_type;
1038 SP = oplist(aTHX_ o, SP);
1040 MODULE = B PACKAGE = B::LISTOP
1049 for (kid = o->op_first; kid; kid = kid->op_sibling)
1055 MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
1057 #if PERL_VERSION <= 8
1064 root = o->op_pmreplroot;
1065 /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
1066 if (o->op_type == OP_PUSHRE) {
1067 ST(0) = sv_newmortal();
1068 # ifdef USE_ITHREADS
1069 sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
1071 sv_setiv(newSVrv(ST(0), root ?
1072 svclassnames[SvTYPE((SV*)root)] : "B::SV"),
1077 ST(0) = make_op_object(aTHX_ root);
1086 if (o->op_type == OP_PUSHRE) {
1087 # ifdef USE_ITHREADS
1088 ST(0) = sv_newmortal();
1089 sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
1091 GV *const target = o->op_pmreplrootu.op_pmtargetgv;
1092 ST(0) = sv_newmortal();
1093 sv_setiv(newSVrv(ST(0), target ?
1094 svclassnames[SvTYPE((SV*)target)] : "B::SV"),
1099 OP *const root = o->op_pmreplrootu.op_pmreplroot;
1100 ST(0) = make_op_object(aTHX_ root);
1106 #define PMOP_pmstashpv(o) PmopSTASHPV(o);
1118 PUSHs(make_sv_object(aTHX_ (SV *) PmopSTASH(o)));
1122 #if PERL_VERSION < 9
1128 PUSHs(make_op_object(aTHX_ o->op_pmnext));
1148 ST(0) = sv_newmortal();
1150 #if PERL_VERSION >= 9
1152 sv_setuv(ST(0), RX_EXTFLAGS(rx));
1156 sv_setpvn(ST(0), RX_PRECOMP(rx), RX_PRELEN(rx));
1164 cv = newXS("B::PMOP::pmoffset", XS_B__OP_next, __FILE__);
1165 XSANY.any_i32 = PMOP_pmoffset_ix;
1166 cv = newXS("B::COP::stashpv", XS_B__OP_next, __FILE__);
1167 XSANY.any_i32 = COP_stashpv_ix;
1168 cv = newXS("B::COP::file", XS_B__OP_next, __FILE__);
1169 XSANY.any_i32 = COP_file_ix;
1171 cv = newXS("B::COP::stash", XS_B__OP_next, __FILE__);
1172 XSANY.any_i32 = COP_stash_ix;
1173 cv = newXS("B::COP::filegv", XS_B__OP_next, __FILE__);
1174 XSANY.any_i32 = COP_filegv_ix;
1176 #if PERL_VERSION >= 9
1177 cv = newXS("B::PMOP::reflags", XS_B__PMOP_precomp, __FILE__);
1182 MODULE = B PACKAGE = B::PADOP
1192 /* It happens that the output typemaps for B::SV and B::GV are
1193 identical. The "smarts" are in make_sv_object(), which determines
1194 which class to use based on SvTYPE(), rather than anything baked in
1197 ret = PAD_SVl(o->op_padix);
1198 if (ix && SvTYPE(ret) != SVt_PVGV)
1203 PUSHs(make_sv_object(aTHX_ ret));
1205 MODULE = B PACKAGE = B::PVOP
1212 * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
1213 * whereas other PVOPs point to a null terminated string.
1215 if ((o->op_type == OP_TRANS || o->op_type == OP_TRANSR) &&
1216 (o->op_private & OPpTRANS_COMPLEMENT) &&
1217 !(o->op_private & OPpTRANS_DELETE))
1219 const short* const tbl = (short*)o->op_pv;
1220 const short entries = 257 + tbl[256];
1221 ST(0) = newSVpvn_flags(o->op_pv, entries * sizeof(short), SVs_TEMP);
1223 else if (o->op_type == OP_TRANS || o->op_type == OP_TRANSR) {
1224 ST(0) = newSVpvn_flags(o->op_pv, 256 * sizeof(short), SVs_TEMP);
1227 ST(0) = newSVpvn_flags(o->op_pv, strlen(o->op_pv), SVs_TEMP);
1229 #define COP_label(o) CopLABEL(o)
1230 #define COP_arybase(o) CopARYBASE_get(o)
1232 MODULE = B PACKAGE = B::COP PREFIX = COP_
1238 # Both pairs of accessors are provided for both ithreads and not, but for each,
1239 # one pair is direct structure access, and 1 pair "faked up" with a more complex
1240 # macro. We implement the direct structure access pair using the common code
1241 # above (B::OP::next)
1251 PUSHs(make_sv_object(aTHX_
1252 ix ? (SV *)CopFILEGV(o) : (SV *)CopSTASH(o)));
1262 RETVAL = ix ? CopFILE(o) : CopSTASHPV(o);
1278 #if PERL_VERSION >= 9
1279 ST(0) = ix ? make_cop_io_object(aTHX_ o) : make_warnings_object(aTHX_ o);
1281 ST(0) = make_sv_object(aTHX_ ix ? o->cop_io : o->cop_warnings);
1285 #if PERL_VERSION >= 9
1291 RETVAL = CopHINTHASH_get(o);
1297 MODULE = B PACKAGE = B::SV
1299 #define MAGICAL_FLAG_BITS (SVs_GMG|SVs_SMG|SVs_RMG)
1309 MAGICAL = MAGICAL_FLAG_BITS
1311 RETVAL = ix ? (SvFLAGS(sv) & (U32)ix) : SvREFCNT(sv);
1319 ST(0) = sv_2mortal(newRV(sv));
1322 MODULE = B PACKAGE = B::IV PREFIX = Sv
1328 MODULE = B PACKAGE = B::IV
1330 #define sv_SVp 0x00000
1331 #define sv_IVp 0x10000
1332 #define sv_UVp 0x20000
1333 #define sv_STRLENp 0x30000
1334 #define sv_U32p 0x40000
1335 #define sv_U8p 0x50000
1336 #define sv_char_pp 0x60000
1337 #define sv_NVp 0x70000
1338 #define sv_char_p 0x80000
1339 #define sv_SSize_tp 0x90000
1340 #define sv_I32p 0xA0000
1341 #define sv_U16p 0xB0000
1343 #define IV_ivx_ix sv_IVp | offsetof(struct xpviv, xiv_iv)
1344 #define IV_uvx_ix sv_UVp | offsetof(struct xpvuv, xuv_uv)
1345 #define NV_nvx_ix sv_NVp | offsetof(struct xpvnv, xnv_u.xnv_nv)
1347 #if PERL_VERSION >= 10
1348 #define NV_cop_seq_range_low_ix \
1349 sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
1350 #define NV_cop_seq_range_high_ix \
1351 sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
1352 #define NV_parent_pad_index_ix \
1353 sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xlow)
1354 #define NV_parent_fakelex_flags_ix \
1355 sv_U32p | offsetof(struct xpvnv, xnv_u.xpad_cop_seq.xhigh)
1357 #define NV_cop_seq_range_low_ix \
1358 sv_NVp | offsetof(struct xpvnv, xnv_nv)
1359 #define NV_cop_seq_range_high_ix \
1360 sv_UVp | offsetof(struct xpvnv, xuv_uv)
1361 #define NV_parent_pad_index_ix \
1362 sv_NVp | offsetof(struct xpvnv, xnv_nv)
1363 #define NV_parent_fakelex_flags_ix \
1364 sv_UVp | offsetof(struct xpvnv, xuv_uv)
1367 #define PV_cur_ix sv_STRLENp | offsetof(struct xpv, xpv_cur)
1368 #define PV_len_ix sv_STRLENp | offsetof(struct xpv, xpv_len)
1370 #define PVMG_stash_ix sv_SVp | offsetof(struct xpvmg, xmg_stash)
1372 #if PERL_VERSION >= 10
1373 #define PVBM_useful_ix sv_I32p | offsetof(struct xpvgv, xiv_u.xivu_i32)
1374 #define PVBM_previous_ix sv_U32p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_previous)
1375 #define PVBM_rare_ix sv_U8p | offsetof(struct xpvgv, xnv_u.xbm_s.xbm_rare)
1377 #define PVBM_useful_ix sv_I32p | offsetof(struct xpvbm, xbm_useful)
1378 #define PVBM_previous_ix sv_U16p | offsetof(struct xpvbm, xbm_previous)
1379 #define PVBM_rare_ix sv_U8p | offsetof(struct xpvbm, xbm_rare)
1382 #define PVLV_targoff_ix sv_U32p | offsetof(struct xpvlv, xlv_targoff)
1383 #define PVLV_targlen_ix sv_U32p | offsetof(struct xpvlv, xlv_targlen)
1384 #define PVLV_targ_ix sv_SVp | offsetof(struct xpvlv, xlv_targ)
1385 #define PVLV_type_ix sv_char_p | offsetof(struct xpvlv, xlv_type)
1387 #if PERL_VERSION >= 10
1388 #define PVGV_stash_ix sv_SVp | offsetof(struct xpvgv, xnv_u.xgv_stash)
1389 #define PVGV_flags_ix sv_STRLENp | offsetof(struct xpvgv, xpv_cur)
1390 #define PVIO_lines_ix sv_IVp | offsetof(struct xpvio, xiv_iv)
1392 #define PVGV_stash_ix sv_SVp | offsetof(struct xpvgv, xgv_stash)
1393 #define PVGV_flags_ix sv_U8p | offsetof(struct xpvgv, xgv_flags)
1394 #define PVIO_lines_ix sv_IVp | offsetof(struct xpvio, xio_lines)
1397 #define PVIO_page_ix sv_IVp | offsetof(struct xpvio, xio_page)
1398 #define PVIO_page_len_ix sv_IVp | offsetof(struct xpvio, xio_page_len)
1399 #define PVIO_lines_left_ix sv_IVp | offsetof(struct xpvio, xio_lines_left)
1400 #define PVIO_top_name_ix sv_char_pp | offsetof(struct xpvio, xio_top_name)
1401 #define PVIO_top_gv_ix sv_SVp | offsetof(struct xpvio, xio_top_gv)
1402 #define PVIO_fmt_name_ix sv_char_pp | offsetof(struct xpvio, xio_fmt_name)
1403 #define PVIO_fmt_gv_ix sv_SVp | offsetof(struct xpvio, xio_fmt_gv)
1404 #define PVIO_bottom_name_ix sv_char_pp | offsetof(struct xpvio, xio_bottom_name)
1405 #define PVIO_bottom_gv_ix sv_SVp | offsetof(struct xpvio, xio_bottom_gv)
1406 #define PVIO_type_ix sv_char_p | offsetof(struct xpvio, xio_type)
1407 #define PVIO_flags_ix sv_U8p | offsetof(struct xpvio, xio_flags)
1409 #define PVAV_max_ix sv_SSize_tp | offsetof(struct xpvav, xav_max)
1411 #define PVFM_lines_ix sv_IVp | offsetof(struct xpvfm, xfm_lines)
1413 #define PVCV_stash_ix sv_SVp | offsetof(struct xpvcv, xcv_stash)
1414 #define PVCV_gv_ix sv_SVp | offsetof(struct xpvcv, xcv_gv)
1415 #define PVCV_file_ix sv_char_pp | offsetof(struct xpvcv, xcv_file)
1416 #define PVCV_depth_ix sv_I32p | offsetof(struct xpvcv, xcv_depth)
1417 #define PVCV_padlist_ix sv_SVp | offsetof(struct xpvcv, xcv_padlist)
1418 #define PVCV_outside_ix sv_SVp | offsetof(struct xpvcv, xcv_outside)
1419 #define PVCV_outside_seq_ix sv_U32p | offsetof(struct xpvcv, xcv_outside_seq)
1420 #define PVCV_flags_ix sv_U16p | offsetof(struct xpvcv, xcv_flags)
1422 #define PVHV_max_ix sv_STRLENp | offsetof(struct xpvhv, xhv_max)
1424 #if PERL_VERSION > 12
1425 #define PVHV_keys_ix sv_STRLENp | offsetof(struct xpvhv, xhv_keys)
1427 #define PVHV_keys_ix sv_IVp | offsetof(struct xpvhv, xhv_keys)
1430 # The type checking code in B has always been identical for all SV types,
1431 # irrespective of whether the action is actually defined on that SV.
1432 # We should fix this
1437 B::IV::IVX = IV_ivx_ix
1438 B::IV::UVX = IV_uvx_ix
1439 B::NV::NVX = NV_nvx_ix
1440 B::NV::COP_SEQ_RANGE_LOW = NV_cop_seq_range_low_ix
1441 B::NV::COP_SEQ_RANGE_HIGH = NV_cop_seq_range_high_ix
1442 B::NV::PARENT_PAD_INDEX = NV_parent_pad_index_ix
1443 B::NV::PARENT_FAKELEX_FLAGS = NV_parent_fakelex_flags_ix
1444 B::PV::CUR = PV_cur_ix
1445 B::PV::LEN = PV_len_ix
1446 B::PVMG::SvSTASH = PVMG_stash_ix
1447 B::PVLV::TARGOFF = PVLV_targoff_ix
1448 B::PVLV::TARGLEN = PVLV_targlen_ix
1449 B::PVLV::TARG = PVLV_targ_ix
1450 B::PVLV::TYPE = PVLV_type_ix
1451 B::GV::STASH = PVGV_stash_ix
1452 B::GV::GvFLAGS = PVGV_flags_ix
1453 B::BM::USEFUL = PVBM_useful_ix
1454 B::BM::PREVIOUS = PVBM_previous_ix
1455 B::BM::RARE = PVBM_rare_ix
1456 B::IO::LINES = PVIO_lines_ix
1457 B::IO::PAGE = PVIO_page_ix
1458 B::IO::PAGE_LEN = PVIO_page_len_ix
1459 B::IO::LINES_LEFT = PVIO_lines_left_ix
1460 B::IO::TOP_NAME = PVIO_top_name_ix
1461 B::IO::TOP_GV = PVIO_top_gv_ix
1462 B::IO::FMT_NAME = PVIO_fmt_name_ix
1463 B::IO::FMT_GV = PVIO_fmt_gv_ix
1464 B::IO::BOTTOM_NAME = PVIO_bottom_name_ix
1465 B::IO::BOTTOM_GV = PVIO_bottom_gv_ix
1466 B::IO::IoTYPE = PVIO_type_ix
1467 B::IO::IoFLAGS = PVIO_flags_ix
1468 B::AV::MAX = PVAV_max_ix
1469 B::FM::LINES = PVFM_lines_ix
1470 B::CV::STASH = PVCV_stash_ix
1471 B::CV::GV = PVCV_gv_ix
1472 B::CV::FILE = PVCV_file_ix
1473 B::CV::DEPTH = PVCV_depth_ix
1474 B::CV::PADLIST = PVCV_padlist_ix
1475 B::CV::OUTSIDE = PVCV_outside_ix
1476 B::CV::OUTSIDE_SEQ = PVCV_outside_seq_ix
1477 B::CV::CvFLAGS = PVCV_flags_ix
1478 B::HV::MAX = PVHV_max_ix
1479 B::HV::KEYS = PVHV_keys_ix
1484 ptr = (ix & 0xFFFF) + (char *)SvANY(sv);
1485 switch ((U8)(ix >> 16)) {
1486 case (U8)(sv_SVp >> 16):
1487 ret = make_sv_object(aTHX_ *((SV **)ptr));
1489 case (U8)(sv_IVp >> 16):
1490 ret = sv_2mortal(newSViv(*((IV *)ptr)));
1492 case (U8)(sv_UVp >> 16):
1493 ret = sv_2mortal(newSVuv(*((UV *)ptr)));
1495 case (U8)(sv_STRLENp >> 16):
1496 ret = sv_2mortal(newSVuv(*((STRLEN *)ptr)));
1498 case (U8)(sv_U32p >> 16):
1499 ret = sv_2mortal(newSVuv(*((U32 *)ptr)));
1501 case (U8)(sv_U8p >> 16):
1502 ret = sv_2mortal(newSVuv(*((U8 *)ptr)));
1504 case (U8)(sv_char_pp >> 16):
1505 ret = sv_2mortal(newSVpv(*((char **)ptr), 0));
1507 case (U8)(sv_NVp >> 16):
1508 ret = sv_2mortal(newSVnv(*((NV *)ptr)));
1510 case (U8)(sv_char_p >> 16):
1511 ret = newSVpvn_flags((char *)ptr, 1, SVs_TEMP);
1513 case (U8)(sv_SSize_tp >> 16):
1514 ret = sv_2mortal(newSViv(*((SSize_t *)ptr)));
1516 case (U8)(sv_I32p >> 16):
1517 ret = sv_2mortal(newSVuv(*((I32 *)ptr)));
1519 case (U8)(sv_U16p >> 16):
1520 ret = sv_2mortal(newSVuv(*((U16 *)ptr)));
1523 croak("Illegal alias 0x%08x for B::*IVX", (unsigned)ix);
1535 ST(0) = boolSV((I32)SvIVX(sv) != SvIVX(sv));
1536 } else if (sizeof(IV) == 8) {
1538 const IV iv = SvIVX(sv);
1540 * The following way of spelling 32 is to stop compilers on
1541 * 32-bit architectures from moaning about the shift count
1542 * being >= the width of the type. Such architectures don't
1543 * reach this code anyway (unless sizeof(IV) > 8 but then
1544 * everything else breaks too so I'm not fussed at the moment).
1547 wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
1549 wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
1551 wp[1] = htonl(iv & 0xffffffff);
1552 ST(0) = newSVpvn_flags((char *)wp, 8, SVs_TEMP);
1554 U32 w = htonl((U32)SvIVX(sv));
1555 ST(0) = newSVpvn_flags((char *)&w, 4, SVs_TEMP);
1558 MODULE = B PACKAGE = B::NV PREFIX = Sv
1564 #if PERL_VERSION < 11
1566 MODULE = B PACKAGE = B::RV PREFIX = Sv
1572 PUSHs(make_sv_object(aTHX_ SvRV(sv)));
1576 MODULE = B PACKAGE = B::REGEXP
1585 PUSHs(newSVpvn_flags(RX_PRECOMP(sv), RX_PRELEN(sv), SVs_TEMP));
1588 /* FIXME - can we code this method more efficiently? */
1594 MODULE = B PACKAGE = B::PV
1601 croak( "argument is not SvROK" );
1602 PUSHs(make_sv_object(aTHX_ SvRV(sv)));
1618 /* Boyer-Moore table is just after string and its safety-margin \0 */
1619 p += len + PERL_FBM_TABLE_OFFSET;
1621 } else if (ix == 2) {
1622 /* This used to read 257. I think that that was buggy - should have
1623 been 258. (The "\0", the flags byte, and 256 for the table. Not
1624 that anything anywhere calls this method. NWC. */
1625 /* Also, the start pointer has always been SvPVX(sv). Surely it
1626 should be SvPVX(sv) + SvCUR(sv)? The code has faithfully been
1627 refactored with this behaviour, since PVBM was added in
1628 651aa52ea1faa806. */
1629 p = SvPVX_const(sv);
1630 len = SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0);
1634 } else if (SvPOK(sv)) {
1636 p = SvPVX_const(sv);
1638 #if PERL_VERSION < 10
1639 /* Before 5.10 (well 931b58fb28fa5ca7), PAD_COMPNAME_GEN was stored
1640 in SvCUR(), which meant we had to attempt this special casing
1641 to avoid tripping up over variable names in the pads. */
1642 if((SvLEN(sv) && len >= SvLEN(sv))) {
1643 /* It claims to be longer than the space allocated for it -
1644 presumably it's a variable name in the pad */
1650 /* XXX for backward compatibility, but should fail */
1651 /* croak( "argument is not SvPOK" ); */
1654 ST(0) = newSVpvn_flags(p, len, SVs_TEMP | utf8);
1656 MODULE = B PACKAGE = B::PVMG
1661 MAGIC * mg = NO_INIT
1663 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
1664 XPUSHs(make_mg_object(aTHX_ mg));
1666 MODULE = B PACKAGE = B::MAGIC
1683 XPUSHs(mg->mg_moremagic ? make_mg_object(aTHX_ mg->mg_moremagic)
1687 mPUSHu(mg->mg_private);
1690 PUSHs(newSVpvn_flags(&(mg->mg_type), 1, SVs_TEMP));
1693 mPUSHu(mg->mg_flags);
1699 PUSHs(make_sv_object(aTHX_ mg->mg_obj));
1703 if (mg->mg_len >= 0) {
1704 PUSHs(newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP));
1705 } else if (mg->mg_len == HEf_SVKEY) {
1706 PUSHs(make_sv_object(aTHX_ (SV*)mg->mg_ptr));
1708 PUSHs(sv_newmortal());
1710 PUSHs(sv_newmortal());
1713 if(mg->mg_type == PERL_MAGIC_qr) {
1714 mPUSHi(PTR2IV(mg->mg_obj));
1716 croak("REGEX is only meaningful on r-magic");
1720 if (mg->mg_type == PERL_MAGIC_qr) {
1721 REGEXP *rx = (REGEXP *)mg->mg_obj;
1722 PUSHs(newSVpvn_flags(rx ? RX_PRECOMP(rx) : NULL,
1723 rx ? RX_PRELEN(rx) : 0, SVs_TEMP));
1725 croak( "precomp is only meaningful on r-magic" );
1730 MODULE = B PACKAGE = B::GV PREFIX = Gv
1739 #if PERL_VERSION >= 10
1740 ST(0) = sv_2mortal(newSVhek(!ix ? GvNAME_HEK(gv)
1741 : (ix == 1 ? GvFILE_HEK(gv)
1742 : HvNAME_HEK((HV *)gv))));
1744 ST(0) = !ix ? newSVpvn_flags(GvNAME(gv), GvNAMELEN(gv), SVs_TEMP)
1745 : sv_2mortal(newSVpv(ix == 1 ? GvFILE(gv) : HvNAME((HV *)gv), 0))
1755 #if PERL_VERSION >= 9
1756 RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
1758 RETVAL = TRUE; /* In 5.8 and earlier they all are. */
1761 RETVAL = GvGP(gv) == Null(GP*);
1770 #define GP_sv_ix SVp | offsetof(struct gp, gp_sv)
1771 #define GP_io_ix SVp | offsetof(struct gp, gp_io)
1772 #define GP_cv_ix SVp | offsetof(struct gp, gp_cv)
1773 #define GP_cvgen_ix U32p | offsetof(struct gp, gp_cvgen)
1774 #define GP_refcnt_ix U32p | offsetof(struct gp, gp_refcnt)
1775 #define GP_hv_ix SVp | offsetof(struct gp, gp_hv)
1776 #define GP_av_ix SVp | offsetof(struct gp, gp_av)
1777 #define GP_form_ix SVp | offsetof(struct gp, gp_form)
1778 #define GP_egv_ix SVp | offsetof(struct gp, gp_egv)
1779 #define GP_line_ix line_tp | offsetof(struct gp, gp_line)
1789 GvREFCNT = GP_refcnt_ix
1802 const GV *const gv = CvGV(cv);
1803 Perl_croak(aTHX_ "NULL gp in B::GV::%s", gv ? GvNAME(gv) : "???");
1805 ptr = (ix & 0xFFFF) + (char *)gp;
1806 switch ((U8)(ix >> 16)) {
1807 case (U8)(SVp >> 16):
1808 ret = make_sv_object(aTHX_ *((SV **)ptr));
1810 case (U8)(U32p >> 16):
1811 ret = sv_2mortal(newSVuv(*((U32*)ptr)));
1813 case (U8)(line_tp >> 16):
1814 ret = sv_2mortal(newSVuv(*((line_t *)ptr)));
1817 croak("Illegal alias 0x%08x for B::*SV", (unsigned)ix);
1826 PUSHs(make_sv_object(aTHX_ (SV *)GvFILEGV(gv)));
1828 MODULE = B PACKAGE = B::IO PREFIX = Io
1830 #if PERL_VERSION <= 8
1845 if( strEQ( name, "stdin" ) ) {
1846 handle = PerlIO_stdin();
1848 else if( strEQ( name, "stdout" ) ) {
1849 handle = PerlIO_stdout();
1851 else if( strEQ( name, "stderr" ) ) {
1852 handle = PerlIO_stderr();
1855 croak( "Invalid value '%s'", name );
1857 RETVAL = handle == IoIFP(io);
1861 MODULE = B PACKAGE = B::AV PREFIX = Av
1871 if (AvFILL(av) >= 0) {
1872 SV **svp = AvARRAY(av);
1874 for (i = 0; i <= AvFILL(av); i++)
1875 XPUSHs(make_sv_object(aTHX_ svp[i]));
1883 if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
1884 XPUSHs(make_sv_object(aTHX_ (AvARRAY(av)[idx])));
1886 XPUSHs(make_sv_object(aTHX_ NULL));
1888 #if PERL_VERSION < 9
1890 #define AvOFF(av) ((XPVAV*)SvANY(av))->xof_off
1896 MODULE = B PACKAGE = B::AV
1904 MODULE = B PACKAGE = B::CV PREFIX = Cv
1916 PUSHs(make_op_object(aTHX_ CvISXSUB(cv) ? NULL
1917 : ix ? CvROOT(cv) : CvSTART(cv)));
1925 ST(0) = ix && CvCONST(cv)
1926 ? make_sv_object(aTHX_ (SV *)CvXSUBANY(cv).any_ptr)
1927 : sv_2mortal(newSViv(CvISXSUB(cv)
1928 ? (ix ? CvXSUBANY(cv).any_iv
1929 : PTR2IV(CvXSUB(cv)))
1936 PUSHs(make_sv_object(aTHX_ (SV *)cv_const_sv(cv)));
1938 MODULE = B PACKAGE = B::HV PREFIX = Hv
1948 #if PERL_VERSION < 9
1954 PUSHs(make_op_object(aTHX_ HvPMROOT(hv)));
1962 if (HvKEYS(hv) > 0) {
1966 (void)hv_iterinit(hv);
1967 EXTEND(sp, HvKEYS(hv) * 2);
1968 while ((sv = hv_iternextsv(hv, &key, &len))) {
1970 PUSHs(make_sv_object(aTHX_ sv));
1974 MODULE = B PACKAGE = B::HE PREFIX = He
1982 PUSHs(make_sv_object(aTHX_ ix ? HeSVKEY_force(he) : HeVAL(he)));
1988 MODULE = B PACKAGE = B::RHE
1990 #if PERL_VERSION >= 9
1996 RETVAL = newRV( (SV*)cophh_2hv(h, 0) );