tksimos.tcl

一个用在mips体系结构中的操作系统

        frame .comm
        button .comm.vt -text "Variable table" -command { 
            varTableCreate
        }
        button .comm.charts -text "Stripcharts" \
            -command { chartsCreate }
        button .comm.debug -text "FlashLite debug" \
            -command { debugWindow }
        button .comm.cpt -text "Checkpoint" \
            -command doCheckpoint
        button .comm.kill -text "Exit SimOS" \
            -command simosExit
        button .comm.disconnect -text "Disconnect from SimOS" \
            -command simosDisconnect
        button .comm.exit -text "Exit TkSimOS" \
            -command exit
        pack .comm -fill x
        pack .comm.vt .comm.charts .comm.debug .comm.cpt .comm.kill \
            .comm.disconnect .comm.exit -fill x
    } else {
        catch {destroy .pause}
        catch {destroy .comm}
        frame .comm
        button .comm.connect -text "Connect to SimOS" -command simosConnect
        button .comm.exit -text "Exit TkSimOS" -command exit
        pack .comm -fill x
        pack .comm.connect .comm.exit -fill x
        hostMenu .host
    }
}

proc bucket {mf} {
    global bucket_diff
    return $bucket_diff($mf)
}

proc chartsSetup {} {
    global charts_bg charts_fg
    if {[simosQuery [list {log [timing fields]}]] != "OK"} {
        err "Error in reading data stream"
        error "Can't read data stream"
    }
    catch {destroy .charts}
    toplevel .charts -background $charts_bg
    wm title .charts "TkSimOS Stripcharts" 

    frame .charts.control -relief groove -bd 4 -bg $charts_bg
    pack .charts.control -fill x

    frame .charts.control.update -bg $charts_bg
    label .charts.control.update.label1 -text "Update every" \
        -fg $charts_fg -bg $charts_bg
    entry .charts.control.update.period -width 5 -relief sunken \
        -textvariable chartsUpdatePeriod -fg $charts_fg -bg $charts_bg
    bind .charts.control.update.period <Return> {
        catch {after cancel $chartsUpdateCB}
        set chartsUpdateCB [after [expr [%W get] * 1000] chartsUpdate]
    }
    label .charts.control.update.label2 -text "seconds" \
        -fg $charts_fg -bg $charts_bg
    pack .charts.control.update
    pack .charts.control.update.label1 .charts.control.update.period \
        .charts.control.update.label2 -side left

    button .charts.control.close -text "Close All" -command "chartsCleanup" \
        -fg $charts_fg -bg $charts_bg
    pack .charts.control.close
}

proc chartsCleanup {} {
    global chartsUpdateCB bucket_field bucket_prev bucket_total
    global chart_stats chart_normed
    catch {after cancel chartsUpdateCB}
    catch {destroy .charts}

    catch {unset bucket_field}
    catch {unset bucket_prev}
    catch {unset bucket_diff}
    catch {unset bucket_total}

    catch {unset chart_stats}
    catch {unset chart_normed}
}

proc streamParse {} {
    global sock
    if {$sock(stream) == ""} return
    while 1 {
        if [catch {set buf [streamRead]} msg] {
            if {$msg != "Stream empty"} { 
                err $msg
            } else {
                after 1000 streamParse
            }
            return 
        } else {
#            puts "STREAM: $buf"
            if {[lindex $buf 0] == "TIMING:"} {
                modesParse $buf
            } else {
                catch {streamParseHook $buf}
            }
        }
    }
}

proc modesParse {buf} {
    global bucket_field bucket_prev bucket_total bucket_diff modelist
    foreach line [split $buf "\n"] {
        if {[lindex $line 1] == "SR_FIELDS"} {
            set bucket_field $line
            foreach f [lrange $bucket_field 4 end] {
                foreach m $modelist {
                    set bucket_diff($m,$f) 0
                    set bucket_total($m,$f) 0
                    set bucket_prev($m,$f) 0
                }
            }
        } elseif [regexp [concat {^TIMING: tree (.*) depth ([0-9]*) } \
                              {name (.*) parent (.*) n ([0-9]*)$}] \
                      $line match tree depth name parent n] {
        } elseif {[lindex $line 1] == "SR_BUCKET"} {
            if ![info exists bucket_field] return
            set m [lindex $line 2]
            if {[lsearch $modelist $m] == -1} continue
            for {set i 4} {$i < [llength $line]} {incr i} {
                set f [lindex $bucket_field $i]
                incr bucket_total($m,$f) [lindex $line $i]
            }
        } elseif {$line == "TIMING: tree modes END"} {
            foreach mf [array names bucket_total] {
                set bucket_diff($mf) [expr $bucket_total($mf) - $bucket_prev($mf)]
                set bucket_prev($mf) $bucket_total($mf)
                set bucket_total($mf) 0
            }
        }
    }
}

proc chartsUpdate {} {
    global sock bucket_field chart_fields chartsUpdatePeriod chartsUpdateCB
    global getModes pauseSimulation

    if ![connected] return
    if !$pauseSimulation {
        if {$getModes && [info exists bucket_field]} {
            simosQuery [list {log [timing dump modes]}]
        }
        foreach chart [array names chart_fields] {
            chartUpdate $chart
            chartRedraw $chart
        }
    }
    set chartsUpdateCB [after [expr $chartsUpdatePeriod * 1000] chartsUpdate]
}

proc chartUpdate {chart} {
    global chart_fields chart_eval chart_stats chart_normed
    set total 0
    foreach field $chart_fields($chart) {
        if ![catch {set val [eval $chart_eval($chart,$field)]}] {
            lappend chart_stats($chart,$field) $val
            set total [expr $total + $val]
        }
    }
    foreach field $chart_fields($chart) {
        if {$total > 0} {
            lappend chart_normed($chart,$field) \
                [expr 1.0 * [lindex $chart_stats($chart,$field) end] / $total]
        } else {
            lappend chart_normed($chart,$field) 0.0
        }
    }
}

proc chartRedraw {chart} {
    global modeLast modeTotal
    global chart_fields chart_norm chart_stats chart_normed

    set w .charts.chart_$chart
    if ![winfo exists $w] return;
    foreach field $chart_fields($chart) {
        if $chart_norm($chart) {
            set modeTotal($chart,$field) ""
            set modeLast($chart,$field) \
                [pct [expr [lindex $chart_normed($chart,$field) end]*100]]
        } else {
            set modeTotal($chart,$field) ""
            set modeLast($chart,$field) \
                [lindex $chart_stats($chart,$field) end]
        }
        if $chart_norm($chart) {
            stackedChartUpdate $w.chart $field $chart_normed($chart,$field)
        } else {
            stackedChartUpdate $w.chart $field $chart_stats($chart,$field)
        }
    }
}

proc chartsClose {chart} {
    global chart_fields chart_eval chart_norm 
    global chart_stats chart_normed chart_colors
    destroy .charts.chart_$chart
    foreach field $chart_fields($chart) {
        unset chart_eval($chart,$field)
        unset chart_stats($chart,$field)
        unset chart_normed($chart,$field)
    }
    unset chart_fields($chart)
    unset chart_colors($chart)
    unset chart_norm($chart)
    # Cleanup charts data if all charts windows are closed
    if {[array size chart_fields] == 0} chartsCleanup
}
    
proc chartDefine {name fields} {
    global chart_fields chart_eval chart_colors chart_stats
    set chart_fields($name) ""
    set chart_norm($name) 0
    foreach fdef $fields {
        set field [lindex $fdef 0]
        lappend chart_fields($name) $field
        set chart_stats($name,$field) {}
        set chart_eval($name,$field) [lindex $fdef 1]
        if {[llength $fdef] > 2} {
            lappend chart_colors($name) [lindex $fdef 2]
        } else {
            lappend chart_colors($name) "black"
        }
    }
}

proc chartConfigure {name config} {
    global chart_config
    set w .charts.chart_$name.chart

    if [winfo exists $w] {
        $w $config 
    } else {
        lappend chart_config($w) $config
    }
}

proc chartsCreate {} {
    global modeLast modeTotal
    global charts_fg charts_bg
    global chart_fields chart_eval chart_colors chart_norm

    if [winfo exists .charts] return
    if [catch chartsSetup] return

    foreach chart [array names chart_fields] {
        set w .charts.chart_$chart
        frame $w -relief groove -bd 2 -bg $charts_bg
        pack $w -before .charts.control

        frame $w.ctl -bg $charts_bg
        label $w.ctl.name -text $chart -width 25 -fg $charts_fg -bg $charts_bg
        checkbutton $w.ctl.norm -text "Normalize" \
            -variable chart_norm($chart) -command "chartRedraw $chart" \
            -fg $charts_fg -bg $charts_bg
        button $w.ctl.close -text "Close" -command "chartsClose $chart" \
            -fg $charts_fg -bg $charts_bg
        pack $w.ctl
        pack $w.ctl.norm $w.ctl.name $w.ctl.close -side left

        frame $w.table -bg $charts_bg
        frame $w.table.title -bg $charts_bg
        label $w.table.title.label -width 20 -text "Mode" \
            -fg $charts_fg -bg $charts_bg
        label $w.table.title.recent -width 12 -text "Last Period" \
            -fg $charts_fg -bg $charts_bg
        pack $w.table.title
        pack $w.table.title.label $w.table.title.recent -side left
        foreach f $chart_fields($chart) c $chart_colors($chart) {
            frame $w.table.f_$f -bg $charts_bg
            label $w.table.f_$f.label -width 20 -text $f -fg $c -bg $charts_bg
            label $w.table.f_$f.recent -width 12 -fg $c -bg $charts_bg \
                -textvariable modeLast($chart,$f)
            pack $w.table.f_$f -after $w.table.title
            pack $w.table.f_$f.label $w.table.f_$f.recent -side left 
        }

        stackedChartCreate $w.chart $chart_fields($chart) $chart_colors($chart)
        pack $w.table $w.chart -side left
    }
    chartsUpdate
}

proc stackedChartCreate {w elts colors} {
    global chartEntries charts_bg
    global chart_config
    barchart $w -title "" -bg $charts_bg
    $w legend configure -mapped 0
    $w configure -height 180 -width 320 -barwidth 1 -barmode stacked
    $w yaxis configure -min 0 -mapped 0
    $w xaxis configure -min -0.5 -max [expr $chartEntries - 0.5] -mapped 0
    foreach elt $elts color $colors {
        $w element create $elt -xdata {} -ydata {} \
            -fg $color -relief flat -borderwidth 0
    }
    if [info exists chart_config($w)] {
        foreach config $chart_config($w) {
            eval $w $config
        }
    }
}
proc stackedChartUpdate {w elt ylist} {
    global xlist chartEntries
    set count [llength $ylist]
    if {$count < $chartEntries} {
        $w element configure $elt \
            -xdata [lrange $xlist 0 [expr $count - 2]] \
            -ydata [lrange $ylist 1 end]
    } else {
        $w element configure $elt \
            -xdata $xlist \
            -ydata [lrange $ylist [expr $count - $chartEntries] end]
    }
}

proc tickFormat {w value} {
    return [format "%10s" $value]
}
proc stripChartCreate {chart title} {
    global xlist chartEntries
    uplevel barchart $chart -title $title
    $chart configure -height 100 -width 460 -barwidth 1.25
    $chart legend configure -mapped 0
    $chart yaxis configure -min 0 -title "" -showticks 1 -command tickFormat
    $chart xaxis configure -min -0.5 -max [expr $chartEntries - 0.5] -mapped 0
    $chart element create strip -xdata {} -ydata {} \
        -relief flat -borderwidth 0
    pack $chart
}
proc stripChartUpdate {chart ylist} {
    global xlist chartEntries
    set count [llength $ylist]
    if {$count < $chartEntries} {
        $chart element configure strip \
            -xdata [lrange $xlist 0 [expr $count - 2]] \
            -ydata [lrange $ylist 1 end]
    } else {
        $chart element configure strip \
            -xdata $xlist \
            -ydata [lrange $ylist [expr $count - $chartEntries] end]
    }
}

set debugOptions "TiXhe"

proc debugUpdate {node flag} {
    global DEBUG
    simosQuery [list "set DEBUG($node,$flag) [set DEBUG($node,$flag)]"]
}

proc debugUpdateAll {flag value} {
    global DEBUG
    set query {}
    set numCpus [simosQuery [list {set PARAM(CPU.Count)}]]
    for {set i 0} {$i <= $numCpus} {incr i} {
        set DEBUG($i,$flag) $value
        lappend query "set DEBUG($i,$flag) $value"
    }
    set ret [simosQuery $query]
}

set debugHelp ""

set debugInfo(a) { "DPsim annotations" }
set debugInfo(b) { "Buffer tracing" }
set debugInfo(c) { "Context tracing" }
set debugInfo(d) { "Directory thread tracing" }
set debugInfo(e) { "Emulator tracing" }
set debugInfo(f) { "Fault tracing" }
set debugInfo(h) { "Handler tracing" }
set debugInfo(i) { "Initialization sequence" }
set debugInfo(l) { "Latency output" }
set debugInfo(m) { "Memory system tracing" }
set debugInfo(n) { "Network thread tracing" }
set debugInfo(p) { "Processor thread tracing" }
set debugInfo(s) { "Scache thread tracing" }
set debugInfo(u) { "printf1 output from emulated handlers" }
set debugInfo(v) { "Virtual address translation tracing" }
set debugInfo(w) { "Watchdog thread tracing" }
set debugInfo(x) { "Enable protocol FLDEBUGTIME() output, DPsim call/return" }
set debugInfo(z) { "Misc or temporary" }
set debugInfo(A) { "Data handling debug statements" }
set debugInfo(B) { "SysADBus arbitration debugging" }
set debugInfo(C) { "Message passing cache coherence interaction" }
set debugInfo(D) { "Directory data cache tracing" }
set debugInfo(E) { "Show details of every handler-generated sEnd" }
set debugInfo(F) { "FlashPoint debugging" }
set debugInfo(G) { "Accelerated write gather debugging" }
set debugInfo(H) { "Handler timing dump" }
set debugInfo(I) { "InBox internal tracing" }
set debugInfo(J) { "IO thread tracing" }
set debugInfo(K) { "Vector pacKet tracing" }
set debugInfo(M) { "Message passing protocol debugging" }
set debugInfo(O) { "OutBox internal tracing" }
set debugInfo(P) { "Internal protocol tracing" }
set debugInfo(Q) { "Queue histogram debugging" }
set debugInfo(S) { "Software queue debugging" }
set debugInfo(T) { "Prints simulation time every DebugInterval ticks" }
set debugInfo(V) { "Verilog-FlashLite debugging output" }
set debugInfo(W) { "Wait-for-PI-reply debugging" }
set debugInfo(X) { "Enable statistics output" }
set debugInfo(Y) { "Report MD$ and MI$ misses (not hits)" }
set debugInfo(Z) { "Message passing timing debug output" }
set debugInfo(1) { "Message passing timing debugs required for calcperf.pl" }
set debugInfo(\() { "Jumptable activity trace" }

proc debugWindow {} {
    global DEBUG debugOptions debugInfo debugHelp
    toplevel .debug
    wm title .debug "TkSimOS: FlashLite Debug Settings"

    set numCpus [simosQuery [list {set PARAM(CPU.Count)}]]

    # Get starting values of debug flags from SimOS
    set debugQuery {}
    set debugVars {}
    for {set i 0} {$i <= $numCpus} {incr i} {
        foreach j [split $debugOptions {}] {
            set var "DEBUG($i,$j)" 
            lappend debugVars $var
            lappend debugQuery "set $var"
        }
    }
    set debugFlags [simosQuery $debugQuery]
    foreach v $debugVars f $debugFlags {
        set $v $f
    }            

    for {set i 0} {$i <= $numCpus} {incr i} {
        frame .debug.node_$i -relief groove -bd 2
        if {$i == $numCpus} {
            label .debug.node_$i.label -text "System" -width 20
        } else {
            label .debug.node_$i.label -text "Node $i" -width 20
        }
        pack .debug.node_$i.label -side left

        foreach j [split $debugOptions {}] {
            checkbutton .debug.node_$i.flag_$j -text $j \
                -variable DEBUG($i,$j) -command "debugUpdate $i $j"
            bind .debug.node_$i.flag_$j <Enter> "set debugHelp $debugInfo($j)"
            bind .debug.node_$i.flag_$j <Leave> "set debugHelp {}"
            bind .debug.node_$i.flag_$j <2> "debugUpdateAll $j 1"
            bind .debug.node_$i.flag_$j <3> "debugUpdateAll $j 0"
            pack .debug.node_$i.flag_$j -side left
        }
        pack .debug.node_$i
    }
    label .debug.help -textvariable debugHelp
    pack .debug.help
}

if [file exists $env(HOME)/.tksimosrc] {
    source $env(HOME)/.tksimosrc
}
if [file exists ./init.tksimos] {
    source ./init.tksimos
}
if {$argc > 0} {
    foreach f $argv {
        source $f
    }
}

set xlist {}
for {set i 0} {$i < $chartEntries} {incr i} {
    lappend xlist $i
}

mainWindow