[svn:mod_parrot] r258 - mod_parrot/trunk/eg

[email protected] Sat, 22 Sep 2007 14:26:21 -0700 (PDT)
Newsgroups	perl.cvs.mod_parrot
Message-ID	<[email protected]>
Author: jhorwitz
Date: Sat Sep 22 14:26:20 2007
New Revision: 258

Added:
   mod_parrot/trunk/eg/interpinfo.pir

Log:
new example handler to dump interpreter statistics


Added: mod_parrot/trunk/eg/interpinfo.pir
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/eg/interpinfo.pir	Sat Sep 22 14:26:20 2007
@@ -0,0 +1,128 @@
+# $Id$
+
+# This is a response handler to dump interpreter info, including interpinfo
+# statistics and search paths.  It might be useful to somebody.
+#
+# Usage:
+#
+# ParrotLoad /path/to/this/file
+# <Location /parrot-status>
+#     SetHandler parrot-code
+#     ParrotHandler Interpinfo
+# </Location>
+
+.namespace [ 'Interpinfo' ]
+
+.include 'interpinfo.pasm'
+.include 'iglobals.pasm'
+
+.sub print_row
+    .param pmc r
+    .param string key
+    .param string value
+
+    $S0 = "<tr><td>"
+    concat $S0, key
+    concat $S0, "</td><td>"
+    concat $S0, value
+    concat $S0, "</td></tr>\n"
+    r.'puts'($S0)
+.end
+
+.sub _handler
+    # request_rec object is the first argument
+    .param pmc r
+
+    r.'puts'("<html><title>Parrot interpreter statistics</title>\n<body>\n")
+    r.'puts'("<h1>Parrot interpreter statistics</h1>\n")
+    r.'puts'("<table>\n")
+
+    $I0 = interpinfo .INTERPINFO_TOTAL_MEM_ALLOC
+    $S0 = $I0
+    print_row(r, "TOTAL_MEM_ALLOC", $S0)
+
+    $I0 = interpinfo .INTERPINFO_DOD_RUNS
+    $S0 = $I0
+    print_row(r, "DOD_RUNS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_COLLECT_RUNS
+    $S0 = $I0
+    print_row(r, "COLLECT_RUNS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_ACTIVE_PMCS
+    $S0 = $I0
+    print_row(r, "ACTIVE_PMCS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_ACTIVE_BUFFERS
+    $S0 = $I0
+    print_row(r, "ACTIVE_BUFFERS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_TOTAL_PMCS
+    $S0 = $I0
+    print_row(r, "TOTAL_PMCS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_TOTAL_BUFFERS
+    $S0 = $I0
+    print_row(r, "TOTAL_BUFFERS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_HEADER_ALLOCS_SINCE_COLLECT
+    $S0 = $I0
+    print_row(r, "HEADER_ALLOCS_SINCE_COLLECT", $S0)
+
+    $I0 = interpinfo .INTERPINFO_MEM_ALLOCS_SINCE_COLLECT
+    $S0 = $I0
+    print_row(r, "MEM_ALLOCS_SINCE_COLLECT", $S0)
+
+    $I0 = interpinfo .INTERPINFO_TOTAL_COPIED
+    $S0 = $I0
+    print_row(r, "TOTAL_COPIED", $S0)
+
+    $I0 = interpinfo .INTERPINFO_IMPATIENT_PMCS
+    $S0 = $I0
+    print_row(r, "IMPATIENT_PMCS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_LAZY_DOD_RUNS
+    $S0 = $I0
+    print_row(r, "LAZY_DOD_RUNS", $S0)
+
+    $I0 = interpinfo .INTERPINFO_EXTENDED_PMCS
+    $S0 = $I0
+    print_row(r, "EXTENDED_PMCS", $S0)
+
+    $S0 = interpinfo .INTERPINFO_RUNTIME_PREFIX
+    print_row(r, "RUNTIME_PREFIX", $S0)
+
+    .local pmc interp, lib_paths
+    .local string include_paths, library_paths, dynext_paths
+    interp = getinterp
+    lib_paths = interp[.IGLOBALS_LIB_PATHS]
+    $P0 = lib_paths[0]
+    include_paths = join '<br>', $P0
+    $P0 = lib_paths[1]
+    library_paths = join '<br>', $P0
+    $P0 = lib_paths[2]
+    dynext_paths = join '<br>', $P0
+
+    $S0 = "<tr valign=\"top\"><td>INCLUDE PATH</td><td>"
+    concat $S0, include_paths
+    concat $S0, "</td></tr>\n"
+    r.'puts'($S0)
+
+    $S0 = "<tr valign=\"top\"><td>LIBRARY PATH</td><td>"
+    concat $S0, library_paths
+    concat $S0, "</td></tr>\n"
+    r.'puts'($S0)
+
+    $S0 = "<tr valign=\"top\"><td>DYNEXT PATH</td><td>"
+    concat $S0, dynext_paths
+    concat $S0, "</td></tr>\n"
+    r.'puts'($S0)
+
+    r.'puts'("</table>\n</body></html>\n")
+
+    # tell apache we're finished
+    .local pmc ap_const
+    ap_const = get_root_global [ 'Apache'; 'Constants' ], 'ap_constants'
+    $I0 = ap_const['OK']
+    .return($I0)
+.end