pools.tcl

Does not contain a contract.

Location:

/packages/acs-subsite/www/admin/system/pools.tcl

Related Files

• packages/acs-subsite/www/admin/system/pools.tcl

[ hide source ] | [ make this the default ]

File Contents

set _ "<table border=1>"

set talloc 0
set trequest 0
set tused 0
set tlocks 0
set twaits 0
set tfree 0
set tops 0


foreach item [lsort [ns_info threads]] {
    set id [lindex $item 2]
    set name($id) [lindex $item 0]
    set parent($id) [lindex $item 1]
}
                                                                                                          

foreach p [lsort [ns_info pools]] {
    set title [lindex $p 0]
    if {[regexp {^thread(.+)$} $title match id]} {
       if {![info exists name($id)]} {
          set title "No Name for <$id> [array names name]"
       } else {
          set title "Thread $id ($name($id) $parent($id))"
       }
    }
        append _ "<tr><tr><td colspan=9 align=center>$title</td></tr><tr>"
        foreach e {blocksize nfree nget nput bytesreq bytesused overhead locks lockwaits} {
                append _ <th>$e</th>
        }
        foreach b [lrange $p 1 end] {
                set bs [lindex $b 0]
                set nf [lindex $b 1]
                set ng [lindex $b 2]
                set np [lindex $b 3]
                set nr [lindex $b 4]
                incr tops [expr {$ng + $np}]
                incr tlocks [lindex $b 5]
                incr twaits [lindex $b 6]
                incr tfree [expr {$bs * $nf}]
                set nu [expr {$ng - $np}]
                set na [expr {$nu * $bs}]
                incr talloc $na
                incr trequest $nr
                incr tused $nu
                if {$nr != 0} {
                        set ov [expr {$na - $nr}]
                        set op [format %4.2f%% [expr {$ov.0 * 100 / $nr.0}]]
                } else {
                        set ov "NA"
                        set op "NA"
                }
                append _ </tr><tr>
                foreach e [linsert [lreplace $b 4 4] 4 $nr $na $op] {
                        append _ <td>$e</td>
                }
                append _ </tr>\n
        }
}
set ov [expr {$talloc - $trequest}]
set op [format %4.2f [expr {$ov.0 * 100 / $trequest.0}]]
if {$tlocks > 0} {
        set wr [format %4.2f [expr {$twaits.0 / $tlocks.0}]]
} else {
        set wr NA
}
set av [format %4.2f [expr {100.0 - ($tlocks.0 * 100) / $tops.0}]]

append _ [subst {</table>
<table>
<tr><td>Total bytes requested:</td><td>$trequest</td></tr>
<tr><td>Total bytes free:</td><td>$tfree</td></tr>
<tr><td>Total bytes allocated:</td><td>$talloc</td></tr>
<tr><td>Total bytes wasted:</td><td>$ov</td></tr>
<tr><td>Total byte overhead:</td><td>$op</td></tr>
<tr><td>Total mutex locks:</td><td>$tlocks</td></tr>
<tr><td>Total mutex lock waits:</td><td>$twaits</td></tr>
<tr><td>Lock wait ratio:</td><td>$wr%</td></tr>
<tr><td>Total get/puts:</td><td>$tops</td></tr>
<tr><td>Lock avoidance:</td><td>$av%</td></tr>
</table>}]

ns_return 200 text/html $_