The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#ifndef PM_GETRE
#define PM_GETRE(o) ((o)->op_pmregexp)
#endif

typedef SV    * B__PV;
typedef OP    * B__OP;
typedef PMOP  * B__PMOP;
typedef MAGIC * B__MAGIC;

#include "regcomp.h"

#include "b_sizeof.c"

static int B__Size_SV_size(SV *sv)
{
    dSP;
    int count, retval;

    ENTER;SAVETMPS;PUSHMARK(SP);
    XPUSHs(sv_2mortal(newRV_inc(sv)));
    PUTBACK;

    count = perl_call_pv("B::Size::SV_size", G_SCALAR);

    SPAGAIN;

    retval = POPi;

    PUTBACK;FREETMPS;LEAVE;

    return retval;
}

#define sizeof_if(p) (p ? sizeof(*p) : 0);

static int REGEXP_size(PMOP *o)
{
    REGEXP *rx = PM_GETRE(o);
    int retval = 0;

    if (!rx) {
	return retval;
    }

    retval = rx->prelen;

    retval += sizeof_if(rx->regstclass);
    retval += sizeof_if(rx->subbeg);
    retval += sizeof_if(rx->startp);
    retval += sizeof_if(rx->endp);

    if (rx->data) {
	int n = rx->data->count;
	retval += sizeof(*rx->data);
	retval += sizeof(void *) * n;

	while (--n >= 0) {
	    switch (rx->data->what[n]) {
	    case 's':
	    case 'p':
	        retval += B__Size_SV_size((SV*)rx->data->data[n]);
	        break;
	    case 'o':
	        /*XXX: OP*/
		break;
	    case 'n':
	        break;
	    }
	}
    }

    if (rx->substrs) {
#if 0
	int i;
	for (i=0; i<3; i++) {
	    if (rx->substrs->data[i].substr) {
		retval += B__Size_SV_size(rx->substrs->data[i].substr);
	    }
	}
#else
	/* check_substr just points to anchor or float */
	if (rx->anchored_substr) {
	    retval += B__Size_SV_size(rx->anchored_substr);
	}
	if (rx->float_substr) {
	    retval += B__Size_SV_size(rx->float_substr);
	}
#endif

	retval += sizeof(*rx->substrs);
    }

    return retval;
}

static XS(XS_B__PV_LEN)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: B::PV::LEN(sv)");
    {
	B__PV	sv;
	STRLEN	RETVAL;

	if (SvROK(ST(0))) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    sv = (B__PV) tmp;
	}
	else
	    croak("sv is not a reference");

	RETVAL = SvLEN(sv);
	ST(0) = sv_newmortal();
	sv_setiv(ST(0), (IV)RETVAL);
    }
    XSRETURN(1);
}

static XS(XS_B__PV_CUR)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: B::PV::CUR(sv)");
    {
	B__PV	sv;
	STRLEN	RETVAL;

	if (SvROK(ST(0))) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    sv = (B__PV) tmp;
	}
	else
	    croak("sv is not a reference");

	RETVAL = SvCUR(sv);
	ST(0) = sv_newmortal();
	sv_setiv(ST(0), (IV)RETVAL);
    }
    XSRETURN(1);
}

#define MgLENGTH(mg) mg->mg_len

static XS(XS_B__MAGIC_LENGTH)
{
    dXSARGS;
    if (items != 1)
	croak("Usage: B::MAGIC::LENGTH(mg)");
    {
	B__MAGIC	mg;
	I32	RETVAL;

	if (SvROK(ST(0))) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    mg = (B__MAGIC) tmp;
	}
	else
	    croak("mg is not a reference");

	RETVAL = MgLENGTH(mg);
	ST(0) = sv_newmortal();
	sv_setiv(ST(0), (IV)RETVAL);
    }
    XSRETURN(1);
}

static XS(XS_B__OP_name)
{
    dXSARGS;
    if (items != 1)
        croak("Usage: B::OP::name(o)");
    {
	B__OP	o;
	char *	RETVAL;

	if (SvROK(ST(0))) {
	    IV tmp = SvIV((SV*)SvRV(ST(0)));
	    o = (B__OP) tmp;
	}
	else
	    croak("o is not a reference");

	ST(0) = sv_newmortal();
	sv_setpv(ST(0), PL_op_name[o->op_type]);
    }
    XSRETURN(1);
}

static void boot_B_compat(void)
{
    HV *b_stash = gv_stashpvn("B", 1, TRUE);
    /* these were not present until 5.005_58ish */
    if (!perl_get_cv("B::PV::LEN", FALSE)) {
        (void)newXS("B::PV::LEN", XS_B__PV_LEN, __FILE__);
    }
    if (!perl_get_cv("B::PV::CUR", FALSE)) {
        (void)newXS("B::PV::CUR", XS_B__PV_CUR, __FILE__);
    }
    if (!perl_get_cv("B::MAGIC::LENGTH", FALSE)) {
        (void)newXS("B::MAGIC::LENGTH", XS_B__MAGIC_LENGTH, __FILE__);
    }
    if (!perl_get_cv("B::OP::name", FALSE)) {
        (void)newXS("B::OP::name", XS_B__OP_name, __FILE__);
    }
    if (!perl_get_cv("B::SVf_POK", FALSE)) {
	(void)newCONSTSUB(b_stash, "SVf_POK", newSViv(SVf_POK));
    }
    if (!perl_get_cv("B::SVf_FAKE", FALSE)) {
	(void)newCONSTSUB(b_stash, "SVf_FAKE", newSViv(SVf_FAKE));
    }
}

#define OP_op_name(i) PL_op_name[i]
#define OP_op_desc(i) PL_op_desc[i]

MODULE = B::Size   PACKAGE = B::Sizeof

PROTOTYPES: disable

BOOT:
    boot_B_Sizeof();
    boot_B_compat();

MODULE = B::Size	PACKAGE = B::PMOP

int
REGEXP_size(o)
    B::PMOP o

MODULE = B::Size	PACKAGE = B::OP		PREFIX = OP_

char *
OP_op_name(i)
    U16 i

char *
OP_op_desc(i)
    U16 i