File Coverage

c/typemap.c

Criterion	Covered	Total	%
statement	92	116	79.3
branch	47	82	57.3
condition			n/a
subroutine			n/a
pod			n/a
total	139	198	70.2

static SV *wrap_thing(U16 mgcode, void *ptr, HV *stash, SV *temple) {
    SV *ref;
    MAGIC **mgp;
    MAGIC *mg;

    assert(ptr);
    assert(stash);

    if (!temple)
	temple = (SV*)newHV();
    else
	SvREFCNT_inc(temple);
    if (SvOBJECT(temple))
	croak("Can't attach to blessed reference");
    assert(!SvROK(temple));
    assert(mg_find(temple, '~') == 0); /* multiplicity disallowed! */

    ref = newRV_noinc(temple);
    sv_bless(ref, stash);

    mgp = &SvMAGIC(temple);
    while ((mg = *mgp))
	mgp = &mg->mg_moremagic;

    New(0, mg, 1, MAGIC);
    Zero(mg, 1, MAGIC);
    mg->mg_type = '~';
    mg->mg_ptr = (char*) ptr;  /* NOT refcnt'd */
    mg->mg_private = mgcode;
    *mgp = mg;

    return ref;
}

static void* sv_2thing(U16 mgcode, SV *sv) {
    MAGIC *mg;
    SV *origsv = sv;
    if (!sv || !SvROK(sv))
	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) {
	warn("Event: %s has negative timeout %.2f (clipped to zero)",
	     label, *out);
	*out = 0;
    }
    return 1;
}

SV* events_mask_2sv(int mask) {
    SV *ret = newSV(0);
    (void)SvUPGRADE(ret, SVt_PVIV);
    sv_setpvn(ret, "", 0);
    if (mask & PE_R) sv_catpv(ret, "r");
    if (mask & PE_W) sv_catpv(ret, "w");
    if (mask & PE_E) sv_catpv(ret, "e");
    if (mask & PE_T) sv_catpv(ret, "t");
    SvIVX(ret) = mask;
    SvIOK_on(ret);
    return ret;
}

int sv_2events_mask(SV *sv, int bits) {
    if (SvPOK(sv)) {
	UV got=0;
	int xx;
	STRLEN el;
	char *ep = SvPV(sv,el);
	for (xx=0; xx < el; xx++) {
	    switch (ep[xx]) {
	      case 'r': if (bits & PE_R) { got |= PE_R; continue; }
	      case 'w': if (bits & PE_W) { got |= PE_W; continue; }
	      case 'e': if (bits & PE_E) { got |= PE_E; continue; }
	      case 't': if (bits & PE_T) { got |= PE_T; continue; }
	    }
	    warn("Ignored '%c' in poll mask", ep[xx]);
	}
	return got;
    }
    else if (SvIOK(sv)) {
	UV extra = SvIVX(sv) & ~bits;
	if (extra) warn("Ignored extra bits (0x%x) in poll mask", extra);
	return SvIVX(sv) & bits;
    }
    else {
	sv_dump(sv);
	croak("Must be a string /[rwet]/ or bit mask");
	return 0; /* NOTREACHED */
    }
}