view release on metacpan or  search on metacpan

c/typemap.c  view on Meta::CPAN

	croak("sv_2thing: not a reference?");
    sv = SvRV(sv);
    if (SvTYPE(sv) < SVt_PVMG)
	croak("sv_2thing: not a thing");
    if (!SvOBJECT(sv))
	croak("sv_2thing: not an object");
    mg = mg_find(sv, '~');
    if (mg) {
	if (mg->mg_private != mgcode) {
	    croak("Can't find event magic (SV=0x%x)", sv);
	}
	return (void*) mg->mg_ptr;
    }
    croak("sv_2thing: can't decode SV=0x%x", origsv);
    return 0;
}

#define MG_WATCHER_CODE ((((unsigned)'e')<<8) + (unsigned)'v')

static SV *wrap_watcher(void *ptr, HV *stash, SV *temple) {
    return wrap_thing(MG_WATCHER_CODE, ptr, stash, temple);
}

SV *watcher_2sv(pe_watcher *wa) { /**SLOW IS OKAY**/
    assert(!WaDESTROYED(wa));
    if (!wa->mysv) {
	wa->mysv = wrap_watcher(wa, wa->vtbl->stash, 0);
	if (WaDEBUGx(wa) >= 4) {
	    STRLEN n_a;
	    warn("Watcher=0x%x '%s' wrapped with SV=0x%x",
		 wa, SvPV(wa->desc, n_a), SvRV(wa->mysv));
	}
    }
    return SvREFCNT_inc(sv_2mortal(wa->mysv));
}

void* sv_2watcher(SV *sv) {
    return sv_2thing(MG_WATCHER_CODE, sv);
}

#define MG_GENERICSRC_CODE 2422 /* randomly chosen */

static SV *wrap_genericsrc(void *ptr, HV *stash, SV *temple) {
    return wrap_thing(MG_GENERICSRC_CODE, ptr, stash, temple);
}

static HV *pe_genericsrc_stash;

static SV *genericsrc_2sv(pe_genericsrc *src) { /**SLOW IS OKAY**/
    if (!src->mysv) {
	src->mysv = wrap_genericsrc(src, pe_genericsrc_stash, 0);
    }
    return SvREFCNT_inc(sv_2mortal(src->mysv));
}

static void* sv_2genericsrc(SV *sv) {
    return sv_2thing(MG_GENERICSRC_CODE, sv);
}

/*
  Events have a short lifetime.  mysv is kept alive until the event
  has been serviced.  Once perl finally releases mysv then the event
  is deallocated (or, more likely, recycled).
*/

SV *event_2sv(pe_event *ev) { /**MAKE FAST**/
    if (!ev->mysv) {
	SV *rv = newSV(0);
	SV *sv = newSVrv(rv,0);
	sv_bless(rv, ev->vtbl->stash);
	sv_setiv(sv, PTR2IV(ev));
	ev->mysv = rv;

	if (WaDEBUGx(ev->up) >= 4) {
	    STRLEN n_a;
	    warn("Event=0x%x '%s' wrapped with SV=0x%x",
		 ev, SvPV(ev->up->desc, n_a), SvRV(ev->mysv));
	}
    }
    return SvREFCNT_inc(sv_2mortal(ev->mysv));
}

void *sv_2event(SV *sv) {
    void *ptr;
    assert(sv);
    assert(SvROK(sv));
    sv = SvRV(sv);
    ptr = INT2PTR(void *, SvIV(sv));
    assert(ptr);
    return ptr;
}

/***************************************************************/

#define VERIFYINTERVAL(name, f) \
 STMT_START { NV ign; sv_2interval(name, f, &ign); } STMT_END

int sv_2interval(char *label, SV *in, NV *out) {
    SV *sv = in;
    if (!sv) return 0;
    if (SvGMAGICAL(sv))
	mg_get(sv);
    if (!SvOK(sv)) return 0;
    if (SvROK(sv))
	sv = SvRV(sv);
    if (!SvOK(sv)) {
	warn("Event: %s interval undef", label);
	*out = 0;
    } else if (SvNOK(sv)) {
	*out = SvNVX(sv);
    } else if (SvIOK(sv)) {
	*out = SvIVX(sv);
    } else if (looks_like_number(sv)) {
	*out = SvNV(sv);
    } else {
	sv_dump(in);
	croak("Event: %s interval must be a number or reference to a number",
	      label);
	return 0;
    }
    if (*out < 0) {