/*
 * 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"

/*
 * The Devel::Mwrap Perl API is probably no longer useful now that
 * the AF_UNIX HTTP interface exists.  It'll probably remain undocumented.
 */

/*
 * 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 = newSVpvs("");

	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;