root/hiersort/animation/preprocess.tcl

#!/usr/bin/tclsh
#
# preprocess.tcl
#
# A script to preprocess log files for use with animation tool.
# Slightly out-of-date.
#
# Copytight (C) 2007, 2008 Serguey Zefirov
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
# See file COPYING or visit http://www.gnu.org/licenses for details.


# -----------------------------------------------------------------------------
# Failure.

proc fail {msg} {
        puts stderr $msg
        exit 1
}

# -----------------------------------------------------------------------------
# Arguments.

foreach {infn outfn} $argv break
if {![string length $outfn]} { fail "usage: preprocess input output" }

set inh [open $infn]

proc linein {} { global inh; return [gets $inh]}

proc checkre {___line ___re args} {
        foreach ___a $args {
                upvar $___a $___a
        }
        if {![eval regexp [list $___re] [list $___line] _ $args]} {
                error "Failed [list $___re] on [list $___line]"
        }
}
proc checkrein {___re args} {
        set ___line [linein]
        foreach ___a $args {
                upvar $___a $___a
        }
        eval checkre [list $___line] [list $___re] $args
}

checkrein {Command line options: [[](.*)[]]} options

set options [string map {{"} { } {,} { }} $options]
puts [list $options]

proc intarg {prefix} {
        checkrein "$prefix: (\[0-9]+)" r
        return $r
}

proc boolarg {prefix} {
        checkrein "$prefix: (True|False)" r
        return [string equal True $r]
}

set hierDepth 0
foreach opt $options {
        regexp -- {hierDepth=([0-9]+)} $opt _ hierDepth
        regexp -- {taskOption=taskSize=([0-9]+)} $opt _ taskSize
}

# -----------------------------------------------------------------------------
# Splitting.

set currTick 0
set maxQL 0

proc checkTick {} {
        global tickInfo currTick totalTicks
        set l [linein]
        if {[regexp {Total ([0-9]+) ticks.} $l _ totalTicks]} {
                return 0
        }
        if {[regexp {Tick [0-9]+} $l]} {
                set tickInfo($currTick,indices) {}
                foreach {_ i j} [regexp -all -inline {OrderIndexes GroupReceivers .([0-9]+),([0-9]+).,OrderNode HostNodeC} $l] {
                        lappend tickInfo($currTick,indices) $i $j
                }
                return 1
        }
        fail "Invalid line [list $l] for tick header."
}

proc processTick {} {
        processFifo
        global hierDepth
        processNode $hierDepth
        # Skip empty line.
        linein
}

proc processFifo {} {
        checkrein "FIFO ---"
        global tickInfo currTick maxQL
        linein
        checkrein {cts: (True|False)} flag
        set tickInfo($currTick,fifocts) [string equal True $flag]
        linein
        checkrein {que length: ([0-9]+)} quelen
        set tickInfo($currTick,quelen) $quelen
        checkrein {maxql: ([0-9]+)} maxQL
}

proc processPresorter {node} {
        checkrein "presorter ---"
        set maxbuflen [intarg maxlen]
        set currbuflen [intarg tokensBufLen]
        global tickInfo currTick
        set tickInfo($currTick,$node,presortmaxbuflen) $maxbuflen
        set tickInfo($currTick,$node,presortcurrbuflen) $currbuflen
        linein
        linein
        linein
        set tickInfo($currTick,$node,presortenabled) [boolarg "presorter rtr"]
}

proc processUpBuf {node} {
        checkrein "upstream buffer ---"
        global tickInfo currTick
        set tickInfo($currTick,$node,upenabled) [boolarg "upstream rtr"]
        set tickInfo($currTick,$node,upmaxbuflen) [intarg "buffer maxlen"]
        set tickInfo($currTick,$node,upcurrbuflen) [intarg "buffer length"]
        linein
        linein
}

proc processSorter {leftright node} {
        checkrein "$leftright sorter"
        checkrein "sorter machine .* ---"
        global tickInfo currTick
        set tickInfo($currTick,$node,$leftright,sorter,maxlen) [intarg maxLen]
        set tickInfo($currTick,$node,$leftright,sorter,curlen) [intarg currlen]
        linein;linein;linein;linein;
        set tickInfo($currTick,$node,$leftright,sorter,available) [boolarg rtr]
}


proc processNodeBody {nodeLevel} {
        incr nodeLevel -1
        checkrein {Node ([0-9]+..[0-9]+)} nodeindex
        processPresorter $nodeindex
        processUpBuf     $nodeindex
        processSorter    left $nodeindex
        processSorter    right $nodeindex
        processNode $nodeLevel
        processNode $nodeLevel
}

proc processMatcher {proc} {
        checkrein "matcher ---"
        global tickInfo currTick
        set tickInfo($currTick,$proc,matchmaxlen) [intarg maxlen]
        set tickInfo($currTick,$proc,matchcurrlen) [intarg tokensCount]
        linein
        set tickInfo($currTick,$proc,matchavailable) [boolarg rtr]
}

proc _tokdone {tok} {
        if {![regexp {GroupWork [[][0-9]+,([0-9]+),([0-9]+),([0-9]+).*NodeS.*SInputX} $tok _ i j k]} {
                return {}
        }
        global taskSize
        return [list $i $j [expr double($k)/$taskSize]]
}
proc processEU {proc} {
        global tickInfo currTick
        checkrein {proc info ---}
        checkrein {processor (is|isn.t) blocked} blockflag
        checkrein {processor (is|isn.t) idle} idleflag
        linein
        linein
        set l1 [linein]
        set l2 [linein]
        foreach {i j v} [concat [_tokdone $l1] [_tokdone $l2]] {
                lappend tickInfo($currTick,sumtokens) $i $j $v
        }
        set worksetlen [intarg workSetLen]
        set execwindow [intarg execWindow]
        linein
        linein
        set bufavail [boolarg procRTR]
        set tickInfo($currTick,$proc,blocked) [string equal is $blockflag]
        set tickInfo($currTick,$proc,idle) [string equal is $idleflag]
        set tickInfo($currTick,$proc,available) $bufavail
        set tickInfo($currTick,$proc,runthreads) $worksetlen
        set tickInfo($currTick,$proc,maxthreads) $execwindow
}

proc processProc {} {
        checkrein {Processor ([0-9]+)} procindex
        processMatcher $procindex
        processUpBuf   $procindex
        processEU      $procindex
        
}

proc processNode {nodeLevel} {
        if {$nodeLevel > 0} {
                processNodeBody $nodeLevel
        } else {
                processProc
        }
}

proc genNodes {l h} {
        if {$l == $h} {
                return [list P $l]
        }
        set m [expr ($l+$h)/2]
        set a [genNodes $l $m]
        set b [genNodes [expr $m+1] $h]
        return [list N $l..$h $a $b]
}

set tickInfo(nodes) [genNodes 0 [expr (1<<$hierDepth)-1]]

while {[checkTick]} {
# puts "tick $currTick"
        set tickInfo($currTick,sumtokens) {}
        processTick
# puts "tickInfo($currTick,sumtokens) [list $tickInfo($currTick,sumtokens)]"
        incr currTick
}

# -----------------------------------------------------------------------------
# Getting maximum values.

foreach v {
        sorterMaxFillLen presorterMaxFillLen upBufMaxFillLen matcherMaxFillLen
        sorterMaxLen presorterMaxLen upBufMaxLen matcherMaxLen
} {
        set $v 0
}

for {set currTick 0} {$currTick < $totalTicks} {incr currTick} {
        set tickInfo($currTick,hiermemused) 0
        set tickInfo($currTick,sortmemused) 0
}

foreach {t v} [array get tickInfo] {
        set add 0
        set sortadd 0
        switch -glob -- $t {
                *presortcurrbuflen {
                        set vn presorterMaxFillLen
                        set add 1
                }
                *matchcurrlen {
                        set vn matcherMaxFillLen
                        set add 1
                        set sortadd 1
                }
                *sorter,curlen {
                        set vn sorterMaxFillLen
                        set add 1
                        set sortadd 1
                }
                *upcurrbuflen {
                        set vn upBufMaxFillLen
                }
                *presortmaxbuflen {
                        set vn presorterMaxLen
                }
                *matchmaxlen {
                        set vn matcherMaxLen
                }
                *sorter,maxlen {
                        set vn sorterMaxLen
                }
                *upmaxbuflen {
                        set vn upBufMaxLen
                }
                default {
                        set vn {}
                }
        }
        if {[string length $vn]} {
                set $vn [expr [set $vn]<$v?$v:[set $vn]]
        }
        set currTick [scan $t %d]
        if {$add} {
                incr tickInfo($currTick,hiermemused) $v
        }
        if {$sortadd} {
                incr tickInfo($currTick,sortmemused) $v
        }
}

foreach v {
        sorterMaxFillLen presorterMaxFillLen upBufMaxFillLen matcherMaxFillLen
        sorterMaxLen presorterMaxLen upBufMaxLen matcherMaxLen
} {
        puts "$v [set $v]"
}

set maxHierMem 0
for {set currTick 0} {$currTick < $totalTicks} {incr currTick} {
        set x $tickInfo($currTick,hiermemused)
        set maxHierMem [expr $x<$maxHierMem?$maxHierMem:$x]
}

set hierMemAvailable 0
set sortMemAvailable 0
if 0 {
array set tt [array get tickInfo 0,*]
set tt(nodes) $tickInfo(nodes)
puts "parray tt:"
parray tt
}
foreach {t v} [array get tickInfo 0,*] {
        switch -glob -- $t {
                *presortmaxbuflen -
                *matchmaxlen -
                *sorter,maxlen -
                *upmaxbuflen {
                        incr hierMemAvailable $v
                }
        }
        switch -glob -- $t {
                *matchmaxlen -
                *sorter,maxlen {
                        incr sortMemAvailable $v
                }
        }
}

# -----------------------------------------------------------------------------
# Sorting information out.

proc noderatio {n curr max} {
        global currTick tickInfo
        return [expr double($tickInfo($currTick,$n,$curr))/$tickInfo($currTick,$n,$max)]
}

proc collectnodes {tree} {
        global currTick tickInfo
        foreach {n i suba subb} $tree break
        if {![string equal $n N]} { return {} }
        set la [collectnodes $suba]
        set lb [collectnodes $subb]
        set thisl [list                                                 \
                $i                                                      \
                [noderatio $i presortcurrbuflen presortmaxbuflen]       \
                [noderatio $i upcurrbuflen upmaxbuflen]                 \
                [noderatio $i left,sorter,curlen left,sorter,maxlen]    \
                [noderatio $i right,sorter,curlen right,sorter,maxlen]  \
        ]
        return [concat $thisl $la $lb]
}

proc procratio {i curr max} {
        global tickInfo currTick
        return [expr double($tickInfo($currTick,$i,$curr))/$tickInfo($currTick,$i,$max)]
}

proc collectprocessors {} {
        global hierDepth
        set res {}
        for {set i 0} {$i < (1<<$hierDepth)} {incr i} {
                lappend res $i [procratio $i matchcurrlen matchmaxlen] [procratio $i upcurrbuflen upmaxbuflen] [procratio $i runthreads maxthreads]
        }
        return $res
}

array set collectedindices {}
for {set i 1} {$i <= $taskSize} {incr i} {
        for {set j 1} {$j <= $taskSize} {incr j} {
                set collectedindices($i,$j) 0.0
        }
}
proc collectindices {} {
        global tickInfo currTick collectedindices taskSize
        set ts {}
        if {[info exists tickInfo($currTick,sumtokens)]} {
                set ts $tickInfo($currTick,sumtokens)
        }
        foreach {i j v} $ts {
                set collectedindices($i,$j) $v
        }
        foreach {i j} $tickInfo($currTick,indices) {
                set collectedindices($i,$j) 1.0
        }
        set r {}
        for {set i 1} {$i <= $taskSize} {incr i} {
                for {set j 1} {$j <= $taskSize} {incr j} {
                        lappend r $i $j $collectedindices($i,$j)
                }
        }
        return $r
}

proc optarg {opt} {
        if {[regexp {.*=([0-9]+)} $opt _ v]} {
                return $v
        }
        return 0
}
proc determinevolumes {} {
        global options
        set presorterVolume 0
        set upbufVolume 0
        set sorterVolume 0
        set matcherVolume 0
        set threadsVolume 0
        foreach o $options {
                set ov [optarg $o]
                switch -glob -- $o {
                        --procParThreads=* {
                                set threadsVolume $ov
                        }
                        --procMatcherForceUp=* {
                                set matcherVolume $ov
                        }
                        --hierBaseSortSize=* {
                                set sorterVolume $ov
                        }
                        --procMatcherSize=* {
                                set matcherVolume $ov
                        }
                        --presorterMaxLen=* {
                                set presorterVolume $ov
                        }
                        --upBufMaxLen=* {
                                set upbufVolume $ov
                        }
                }
        }
        set r [list $presorterVolume $upbufVolume $sorterVolume $matcherVolume $threadsVolume]
        return $r
}

set tcl_precision 5
set outh [open $outfn w]
puts $outh [list resetAll]
puts $outh [list taskSize $taskSize]
puts $outh [list totalTicks $totalTicks]
puts $outh [list fifoMax $maxQL]
puts $outh [list hierDepth $hierDepth]
puts $outh [list hierMemMax $maxHierMem]
puts $outh [list hierMemAvailable $hierMemAvailable]
puts $outh [list sortMemAvailable $sortMemAvailable]
puts $outh [list hierNodes $tickInfo(nodes)]
puts $outh "circuitVolumes [determinevolumes]"
set results {}
for {set currTick 0} {$currTick < $totalTicks} {incr currTick} {
        puts $outh "# ---------------------------------------------"
        puts $outh [list currTick $currTick]
        puts $outh [list fifoUse [expr double($tickInfo($currTick,quelen))/$maxQL]]
        set results [collectindices]
        puts $outh [list tickResults $results]
        puts $outh [list memUse $tickInfo($currTick,hiermemused)]
        puts $outh [list sortMemUse [expr double($tickInfo($currTick,sortmemused))/$sortMemAvailable]]
        puts $outh [list nodesUse [collectnodes $tickInfo(nodes)]]
        puts $outh [list procsUse [collectprocessors]]
}
close $outh