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 { double ign; sv_2interval(name, f, &ign); } STMT_END int sv_2interval(char *label, SV *in, double *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); 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 */ } }