diff options
Diffstat (limited to 'Mwrap.xs')
| -rw-r--r-- | Mwrap.xs | 309 |
1 files changed, 0 insertions, 309 deletions
diff --git a/Mwrap.xs b/Mwrap.xs deleted file mode 100644 index 4d4c996..0000000 --- a/Mwrap.xs +++ /dev/null @@ -1,309 +0,0 @@ -/* - * Copyright (C) mwrap hackers <mwrap-perl@80x24.org> - * License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt> - * Disclaimer: I don't really know my way around XS or Perl internals well - */ -#define MWRAP_PERL 1 -#include "mwrap_core.h" - -/* - * I hate typedefs, especially when they're hiding the fact that there's - * a pointer, but XS needs this, apparently, and it does s/__/::/g - */ -typedef struct src_loc * Devel__Mwrap__SrcLoc; - -/* keep this consistent with httpd.h write_loc_name */ -static SV *location_string(struct src_loc *l) -{ - SV *ret = newSV(0); - - if (l->f) { - sv_catpv(ret, l->f->fn); - if (l->lineno == U24_MAX) - sv_catpvs(ret, ":-"); - else - sv_catpvf(ret, ":%u", l->lineno); - } - if (l->bt_len) { - AUTO_FREE char **s = bt_syms(l->bt, l->bt_len); - if (s) { - if (l->f) - sv_catpvs(ret, "\n"); - sv_catpv(ret, s[0]); - for (uint32_t i = 1; i < l->bt_len; ++i) - sv_catpvf(ret, "\n%s", s[i]); - } - } - return ret; -} - -MODULE = Devel::Mwrap PACKAGE = Devel::Mwrap PREFIX = mwrap_ - -BOOT: -#ifndef PERL_IMPLICIT_CONTEXT - root_locating = &locating; -#endif - -PROTOTYPES: ENABLE - -size_t -mwrap_quiet(int on_off) -CODE: - RETVAL = on_off ? locating++ : locating--; -OUTPUT: - RETVAL - -size_t -mwrap_current_age() -CODE: - RETVAL = uatomic_read(&total_bytes_inc); -OUTPUT: - RETVAL - -size_t -mwrap_total_bytes_allocated() -CODE: - RETVAL = uatomic_read(&total_bytes_inc); -OUTPUT: - RETVAL - -size_t -mwrap_total_bytes_freed() -CODE: - RETVAL = uatomic_read(&total_bytes_dec); -OUTPUT: - RETVAL - -void -mwrap_each(min, cb, arg = &PL_sv_undef) - size_t min; - SV *cb; - SV *arg; -PREINIT: - struct cds_lfht *t; - struct cds_lfht_iter iter; - struct src_loc *l; -CODE: - ++locating; - rcu_read_lock(); - t = CMM_LOAD_SHARED(totals); - if (t) { - bool err = false; - - cds_lfht_for_each_entry(t, &iter, l, hnode) { - size_t total = uatomic_read(&l->total); - - if (total > min) { - SV *loc; - dSP; - ENTER; - SAVETMPS; - - PUSHMARK(SP); - loc = sv_newmortal(); - sv_setref_pv(loc, "Devel::Mwrap::SrcLoc", l); - XPUSHs(arg); - XPUSHs(loc); - PUTBACK; - - call_sv(cb, G_DISCARD|G_EVAL); - - SPAGAIN; - if (SvTRUE(ERRSV)) - err = true; - - FREETMPS; - LEAVE; - } - if (err) - break; - mwrap_assert(rcu_read_ongoing()); - } - } - if (SvTRUE(ERRSV)) - croak(NULL); -CLEANUP: - rcu_read_unlock(); - --locating; - - -void -mwrap_reset() -CODE: - mwrap_reset(); - -unsigned -mwrap_bt_depth(arg = &PL_sv_undef) - SV *arg; -CODE: - if (SvOK(arg)) { - UV n = SvUVx(arg); - if (n > MWRAP_BT_MAX) - n = MWRAP_BT_MAX; - CMM_STORE_SHARED(bt_req_depth, (uint32_t)n); - RETVAL = n; - } else { - RETVAL = CMM_LOAD_SHARED(bt_req_depth); - } -OUTPUT: - RETVAL - -Devel::Mwrap::SrcLoc -mwrap_get(loc) - SV *loc; -PREINIT: - STRLEN len; - const char *str; - struct src_loc *l; -CODE: - ++locating; - if (!SvPOK(loc)) - XSRETURN_UNDEF; - str = SvPV(loc, len); - l = mwrap_get(str, len); - if (!l) - XSRETURN_UNDEF; - RETVAL = l; -OUTPUT: - RETVAL -CLEANUP: - --locating; - -MODULE = Devel::Mwrap PACKAGE = Devel::Mwrap::SrcLoc PREFIX = src_loc_ - -PROTOTYPES: ENABLE - -size_t -src_loc_frees(self) - Devel::Mwrap::SrcLoc self -PREINIT: -CODE: - ++locating; - RETVAL = uatomic_read(&self->frees); -OUTPUT: - RETVAL -CLEANUP: - --locating; - -size_t -src_loc_freed_bytes(self) - Devel::Mwrap::SrcLoc self -PREINIT: -CODE: - ++locating; - RETVAL = uatomic_read(&self->freed_bytes); -OUTPUT: - RETVAL -CLEANUP: - --locating; - -size_t -src_loc_allocations(self) - Devel::Mwrap::SrcLoc self -PREINIT: -CODE: - ++locating; - RETVAL = uatomic_read(&self->allocations); -OUTPUT: - RETVAL -CLEANUP: - --locating; - -size_t -src_loc_total(self) - Devel::Mwrap::SrcLoc self -PREINIT: -CODE: - ++locating; - RETVAL = uatomic_read(&self->total); -OUTPUT: - RETVAL -CLEANUP: - --locating; - -double -src_loc_mean_lifespan(self) - Devel::Mwrap::SrcLoc self -PREINIT: - size_t tot, frees; -CODE: - ++locating; - frees = uatomic_read(&self->frees); - tot = uatomic_read(&self->age_total); - RETVAL = frees ? ((double)tot/(double)frees) : HUGE_VAL; -OUTPUT: - RETVAL -CLEANUP: - --locating; - -double -src_loc_max_lifespan(self) - Devel::Mwrap::SrcLoc self -CODE: - ++locating; - RETVAL = uatomic_read(&self->max_lifespan); -OUTPUT: - RETVAL -CLEANUP: - --locating; - -SV * -src_loc_name(self) - Devel::Mwrap::SrcLoc self -CODE: - ++locating; - RETVAL = location_string(self); -OUTPUT: - RETVAL -CLEANUP: - --locating; - -void -src_loc_each(self, min, cb, arg = &PL_sv_undef) - Devel::Mwrap::SrcLoc self; - size_t min; - SV *cb; - SV *arg; -PREINIT: - struct alloc_hdr *h; - bool err = false; -CODE: - ++locating; - rcu_read_lock(); - cds_list_for_each_entry_rcu(h, &self->allocs, anode) { - size_t size = uatomic_read(&h->size); - if (size > min) { - dSP; - ENTER; - SAVETMPS; - - PUSHMARK(SP); - - /* - * note: we MUST NOT expose alloc_hdr to Perl code - * since that opens us up to use-after-free - */ - XPUSHs(arg); - XPUSHs(sv_2mortal(newSVuv(size))); - XPUSHs(sv_2mortal(newSVuv(h->as.live.gen))); - XPUSHs(sv_2mortal(newSVuv((uintptr_t)h->real))); - PUTBACK; - - call_sv(cb, G_DISCARD|G_EVAL); - - SPAGAIN; - if (SvTRUE(ERRSV)) - err = true; - - FREETMPS; - LEAVE; - if (err) - break; - mwrap_assert(rcu_read_ongoing()); - } - } - if (SvTRUE(ERRSV)) - croak(NULL); -CLEANUP: - rcu_read_unlock(); - --locating; |