mwrap (Perl version) user+dev discussion/patches/pulls/bugs/help
 help / color / mirror / code / Atom feed
From: Eric Wong <e@80x24.org>
To: mwrap-perl@80x24.org
Subject: [PATCH 5/7] psgi: add total bytes + reset
Date: Tue,  5 Oct 2021 12:48:01 +0000	[thread overview]
Message-ID: <20211005124803.7215-6-e@80x24.org> (raw)
In-Reply-To: <20211005124803.7215-1-e@80x24.org>

These will probably be more useful, we'll drop total bytes
allocated, for now.
---
 Mwrap.xs                | 15 ++++++++++++
 lib/Devel/Mwrap/PSGI.pm | 54 ++++++++++++++++++++++++-----------------
 2 files changed, 47 insertions(+), 22 deletions(-)

diff --git a/Mwrap.xs b/Mwrap.xs
index b93efd6..43d1ed6 100644
--- a/Mwrap.xs
+++ b/Mwrap.xs
@@ -202,6 +202,7 @@ static char *int2str(unsigned num, char *dst, size_t * size)
 struct src_loc {
 	pthread_mutex_t *mtx;
 	size_t total;
+	size_t freed_bytes;
 	size_t allocations;
 	size_t frees;
 	size_t age_total; /* (age_total / frees) => mean age at free */
@@ -402,6 +403,7 @@ void free(void *p)
 			size_t current_bytes = uatomic_read(&total_bytes_inc);
 			size_t age = current_bytes - h->as.live.gen;
 			uatomic_add(&total_bytes_dec, h->size);
+			uatomic_add(&l->freed_bytes, h->size);
 			uatomic_set(&h->size, 0);
 			uatomic_add(&l->frees, 1);
 			uatomic_add(&l->age_total, age);
@@ -889,6 +891,7 @@ CODE:
 		uatomic_set(&l->total, 0);
 		uatomic_set(&l->allocations, 0);
 		uatomic_set(&l->frees, 0);
+		uatomic_set(&l->freed_bytes, 0);
 		uatomic_set(&l->age_total, 0);
 		uatomic_set(&l->max_lifespan, 0);
 	}
@@ -960,6 +963,18 @@ OUTPUT:
 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
diff --git a/lib/Devel/Mwrap/PSGI.pm b/lib/Devel/Mwrap/PSGI.pm
index f47c9b0..5bb7c36 100644
--- a/lib/Devel/Mwrap/PSGI.pm
+++ b/lib/Devel/Mwrap/PSGI.pm
@@ -39,14 +39,16 @@ sub uri_unescape {
 	$str;
 }
 
-my @FIELDS = qw(total allocations frees live mean_life max_life location);
+my @FIELDS = qw(bytes allocations frees live
+		mean_life max_life location);
 my $HDR = '<tr><th>' . join('</th><th>', @FIELDS) . '</th></tr>';
 
 sub accumulate_i { # callback for Devel::Mwrap::each
 	my ($all, $src_loc) = @_;
 	my $alloc = $src_loc->allocations;
 	my $frees = $src_loc->frees;
-	push @$all, [ $src_loc->total, $alloc, $frees, $alloc - $frees,
+	push @$all, [ $src_loc->total - $src_loc->freed_bytes,
+			$alloc, $frees, $alloc - $frees,
 			$src_loc->mean_lifespan, $src_loc->max_lifespan,
 			$src_loc->name ];
 }
@@ -65,9 +67,10 @@ sub fh_response {
 }
 
 sub each_gt {
-	my ($env, $min, $sort) = @_;
+	my ($env, $min) = @_;
+	my ($sort) = ($env->{QUERY_STRING} =~ /\bsort=(\w+)\b/a);
 	open my $fh, '+>', undef or die "open: $!";
-	$sort //= 'total';
+	$sort //= 'bytes';
 	my $sn = $env->{SCRIPT_NAME};
 	my $t = "Devel::Mwrap::each($min)";
 	my $all = [];
@@ -93,12 +96,12 @@ sub each_gt {
 	my $age = Devel::Mwrap::current_age();
 	my $live = $age - Devel::Mwrap::total_bytes_freed();
 	print $fh <<EOM;
-<html><head><title>$t</title></head><body><h1>$t</h1>
-<h2>Current age: $age (live: $live)</h2>
+<html><head><title>$t</title></head><body><p>$t
+<p>Current age: $age (live: $live)
 <table><tr><th>@f</th></tr>
 EOM
 	while (my $cols = shift @all) {
-		# cols: [ total, allocations, frees, mean_lifespan,
+		# cols: [ bytes , allocations, frees, mean_lifespan,
 		#   max_lifespan, name ]
 		my $loc_name = pop @$cols;
 		$cols->[4] = sprintf('%0.3f', $cols->[4]); # mean_life
@@ -125,8 +128,8 @@ sub each_at {
 	my $age = Devel::Mwrap::current_age();
 	my $live = $age - Devel::Mwrap::total_bytes_freed();
 	print $fh <<EOM;
-<html><head><title>$t</title></head><body><h1>live allocations at $t</h1>
-<h2>Current age: $age (live: $live)</h2>\n<table>
+<html><head><title>$t</title></head><body><p>live allocations at $t
+<p>Current age: $age (live: $live)\n<table>
 <tr><th>size</th><th>generation</th></tr>
 EOM
 	$src_loc->each(0, \&each_at_i, $fh);
@@ -151,21 +154,28 @@ EOM
 sub call { # PSGI entry point
 	Devel::Mwrap::quiet(1);
 	my (undef, $env) = @_;
-	my $path_info = $env->{PATH_INFO};
 	my $ret;
-	if ($path_info =~ m!\A/each/([0-9]+)\z!) {
-		my $min = $1 + 0;
-		my ($sort) = ($env->{QUERY_STRING} =~ /\bsort=(\w+)\b/a);
-		$ret = each_gt($env, $min, $sort);
-	} elsif ($path_info =~ m!\A/at/(.*)\z!) {
-		my $src_loc = Devel::Mwrap::get(uri_unescape($1));
-		$ret = $src_loc ? each_at($env, $src_loc) : r404();
-	} elsif ($path_info eq '/') {
-		$ret = [ 200, [ qw(Content-Type text/html
-				Content-Length), length($root) ], [ $root ] ]
-	} else {
-		$ret = r404();
+	my $path_info = $env->{PATH_INFO};
+	if ($env->{REQUEST_METHOD} eq 'GET') {
+		if ($path_info =~ m!\A/each/([0-9]+)\z!) {
+			$ret = each_gt($env, $1 + 0);
+		} elsif ($path_info =~ m!\A/at/(.*)\z!) {
+			my $src_loc = Devel::Mwrap::get(uri_unescape($1));
+			$ret = $src_loc ? each_at($env, $src_loc) : r404();
+		} elsif ($path_info eq '/') {
+			$ret = [ 200, [ qw(Content-Type text/html
+					Content-Length), length($root) ],
+				[ $root ] ]
+		}
+	} elsif ($env->{REQUEST_METHOD} eq 'POST') {
+		if ($path_info eq '/reset') {
+			Devel::Mwrap::reset();
+			$ret = [ 200, [ qw(Content-Type text/html
+					Content-Length 5) ],
+				[ "done\n" ] ];
+		}
 	}
+	$ret //= r404();
 	Devel::Mwrap::quiet(0);
 	$ret;
 }

  parent reply	other threads:[~2021-10-05 12:48 UTC|newest]

Thread overview: 8+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-10-05 12:47 [PATCH 0/7] PSGI-related updates Eric Wong
2021-10-05 12:47 ` [PATCH 1/7] don't set root_locating until BOOT Eric Wong
2021-10-05 12:47 ` [PATCH 2/7] examples/mwrap.psgi: explain why we delete LD_PRELOAD Eric Wong
2021-10-05 12:47 ` [PATCH 3/7] psgi: fix 404 return Eric Wong
2021-10-05 12:48 ` [PATCH 4/7] examples/mwrap.psgi: disable deflater Eric Wong
2021-10-05 12:48 ` Eric Wong [this message]
2021-10-05 12:48 ` [PATCH 6/7] psgi: sort "location" column lexically Eric Wong
2021-10-05 12:48 ` [PATCH 7/7] psgi: show address column Eric Wong

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20211005124803.7215-6-e@80x24.org \
    --to=e@80x24.org \
    --cc=mwrap-perl@80x24.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://80x24.org/mwrap-perl.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).