tksimos.tcl

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

#!/powderkeg/pk1/bosch/blt2.1/bltwish -f
#
# Copyright (C) 1996-1998 by the Board of Trustees
#    of Leland Stanford Junior University.
# 
# This file is part of the SimOS distribution. 
# See LICENSE file for terms of the license. 
#


wm title . TkSimOS

set visualPort 5105
set hostname sim
set hostlist { }
set varUpdatePeriod 0
set chartsUpdatePeriod 0

foreach s { main stream local } { set sock($s) "" }
set varUpdateCB 0
set chartsUpdateCB 0

set charts_bg lightsteelblue
set charts_fg black
set chartEntries 60

set localHost [exec hostname]
set localSock 1066

set modelist { kernel sync ROOT idle total }
set formatlist { dec hex str "flt" "flt.1" }

set simos_vars {}
set derived_vars {}

set vcnt 0

proc dec {val} { format "%u" $val }
proc hex {val} { format "0x%x" $val }
proc str {val} { return $val }
proc pct {val} { format "%5.1f%%" $val }
proc flt {val} { format "%f" $val }
proc flt.1 {val} { format "%.1f" $val }

proc err msg {
#    puts $msg
    tk_dialog .dlog "TkSimOS Error" $msg "" 0 OK
}
proc connected {} {
    global sock
    return [expr {$sock(main) != ""}]
}

proc simosConnect {} {
    global sock hostname visualPort
    global localHost localSock
    global varUpdatePeriod
    
    # Set up main connection
    if [catch {set sock(main) [socket $hostname $visualPort]} msg] {
        err "Connect failed: $msg"
        return -1
    }
    catch {destroy .hostset}
    fconfigure $sock(main) -buffering none 
    catch {connectHook}
    mainWindow

    # Set up stream connection
    catch { close $sock(stream) }
    while {$sock(local) == ""} {
        if [catch {
            set sock(local) [socket -server streamConnect $localSock]
        }] {
            incr localSock
        }
    }
    if [catch {simosQuery [list "VISUALstream $localHost $localSock"]} msg] {
        err "Connect failed: $msg"
        return -1
    }
    if {$varUpdatePeriod > 0} varPeriodicUpdate
}

proc streamConnect {s h p} {
    global sock
    set sock(stream) $s
    fconfigure $sock(stream) -buffering line
    fconfigure $sock(stream) -blocking 0
    streamParse
}

proc simosDisconnect {} {
    global sock chartsUpdateCB varUpdateCB
    catch {close $sock(main)}
    catch {close $sock(stream)}
    catch {set sock(main) ""}
    catch {set sock(stream) ""}
    catch {destroy .vt}
    catch {destroy .vc}
    catch {destroy .charts}
    catch {destroy .debug}
    catch {destroy .modesp}
    catch {after cancel $chartsUpdateCB}
    catch {after cancel $varUpdateCB}
    chartsCleanup
    mainWindow
}

proc simosQuery {querylist} {
    global sock
    if ![connected] return {}
    foreach query $querylist {
        if [catch {puts $sock(main) $query} msg] {
            # Could not transmit request to SimOS -- it probably terminated
#            err "SimOS request failed:\n$msg"
            simosDisconnect
            return ""
        }
    }
    set replylist {}
    foreach query $querylist {
        if [catch {set len [read $sock(main) 8]} msg] {
#            err "SimOS request failed:\n$msg"
            simosDisconnect
            return ""
        }
        if [catch {set ret [read $sock(main) [expr $len]]} msg] {
#            err "SimOS request failed:\n$msg"
            simosDisconnect
            return ""
        }
        lappend replylist $ret
    }
    return $replylist
}


proc streamRead {} {
    global sock
    fconfigure $sock(stream) -blocking 0
    if [catch {set len [read $sock(stream) 8]} msg] {
        #        err "SimOS stream read failed:\n$msg"
        simosDisconnect
        return ""
    }
    if [fblocked $sock(stream)] {
        error "Stream empty"
    }
    # Once header is received, always use blocking to ensure the
    # entire data packet is received
    fconfigure $sock(stream) -blocking 1
    if [catch {set ret [read $sock(stream) [expr $len]]} msg] {
        #        err "SimOS stream read failed:\n$msg"
        simosDisconnect
        return ""
    }
    return $ret
}

proc varDisplay v {
    global var_value var_format var_chart formatlist 
    global var_widget vcnt
    if ![info exists var_value($v)] {
        if [catch {varAdd $v} msg] { err $msg; return }
    }
    if ![winfo exists .vt] return
    if ![info exists var_widget($v)] {
        set var_widget($v) var_$vcnt; incr vcnt
    }
    if [winfo exists .vt.$var_widget($v)] return;
    frame .vt.$var_widget($v) -relief groove -bd 2
    label .vt.$var_widget($v).name -text $v -width 45
    label .vt.$var_widget($v).value -width 15 -textvariable var_value($v)
    
    menubutton .vt.$var_widget($v).format -textvariable var_format($v) \
        -fg blue -menu .vt.$var_widget($v).format.menu -width 4
    menu .vt.$var_widget($v).format.menu
    foreach f $formatlist {
        .vt.$var_widget($v).format.menu add command -label $f \
            -command "varFormat $v $f"
    }
    button .vt.$var_widget($v).hide -text "Hide" -command "varHide $v"
    button .vt.$var_widget($v).chart -text "Chart" -command "varChartToggle $v"
    pack .vt.$var_widget($v) -before .vt.control
    pack .vt.$var_widget($v).name .vt.$var_widget($v).value \
        .vt.$var_widget($v).format .vt.$var_widget($v).hide \
        .vt.$var_widget($v).chart -side left -fill x
}

proc varTableCreate {} {
    global var_widget
    toplevel .vt
    wm title .vt "TkSimOS Variable Table"

    frame .vt.control -relief groove -bd 4
    pack .vt.control -fill x

    frame .vt.control.newVar
    label .vt.control.newVar.label -text "Display Variable:"
    entry .vt.control.newVar.entry -width 45 -relief sunken
    bind .vt.control.newVar.entry <Return> { 
        if [catch {varAdd [%W get]} msg] {
            err $msg
        } else {
            varDisplay [%W get]
#            varUpdate
        }
        %W delete 0 end
    }
    pack .vt.control.newVar
    pack .vt.control.newVar.label .vt.control.newVar.entry -side left -fill x

    frame .vt.control.update
    label .vt.control.update.label1 -text "Update every"
    entry .vt.control.update.period -width 5 -relief sunken \
        -textvariable varUpdatePeriod
    bind .vt.control.update.period <Return> {
        catch {after cancel $varUpdateCB}
        after [expr [%W get] * 1000] varPeriodicUpdate
    }
    label .vt.control.update.label2 -text "seconds"
    pack .vt.control.update
    pack .vt.control.update.label1 .vt.control.update.period \
        .vt.control.update.label2 -side left

    frame .vt.control.buttons
    button .vt.control.buttons.updateNow -text "Update All" \
        -command varUpdate
    button .vt.control.buttons.deleteAll -text "Hide All" \
        -command varTableHide
    button .vt.control.buttons.close -text "Close" -command varTableClose
    pack .vt.control.buttons
    pack .vt.control.buttons.updateNow .vt.control.buttons.deleteAll \
        .vt.control.buttons.close -side left -fill x

    foreach v [array names var_widget] {
        varDisplay $v
    }
    varChartCreate
    catch {varTableHook}
    varUpdate
}

proc var {v {type total}} {
    global var_value var_last
    if ![info exists var_value($v)] {
        varAdd $v
    }
    if {$type == "periodic"} {
        if [catch {set val [expr $var_value($v) - $var_last($v)]}] {
            set val ""
        }
        return $val
    } else {
        return $var_value($v)
    }
}
proc varFormat {v {f ""}} {
    global var_format var_value
    if {$f != ""} {
        set var_format($v) $f
    }
    if [info exists var_value($v)] {
        set val $var_value($v) 
        if [catch {set var_value($v) [$var_format($v) $val]}] {
            set var_format($v) "str"
            set var_value($v) $val
        }
    }
}
proc varAdd {v {format "str"}} {
    global var_format var_value var_last var_eval
    global simos_vars derived_vars
    set var_format($v) $format
    set var_value($v) ""
    set var_last($v) 0
    if [info exists var_eval($v)] {
        lappend derived_vars $v
    } else {
        lappend simos_vars $v
    }
}
proc varHide {v} {
    global var_widget var_value var_eval var_chart
    catch {destroy .vt.$var_widget($v)}
    catch {unset var_widget($v)}
    catch {destroy .vc.$var_widget($v)}
    catch {unset var_chart($v)}
}    
proc varDelete {v} {
    global var_widget var_format var_value var_eval var_chart
    global simos_vars derived_vars
    varHide $v
    catch {unset var_value($v)}
    catch {unset var_format($v)}
    catch {unset var_eval($v)}
    set i [lsearch $simos_vars $v]
    if {$i >= 0} {
        set simos_vars [lreplace $simos_vars $i $i]
    }
    set i [lsearch $derived_vars $v]
    if {$i >= 0} {
        set simos_vars [lreplace $derived_vars $i $i]
    }
}
proc varDefine {v calc} {
    global var_eval
    set var_eval($v) $calc
    if [catch {varAdd $v} msg] { err $msg }
}

proc varUpdate {} {
    global var_value var_eval var_format var_chart var_widget var_last
    global simos_vars derived_vars
    set query {}
    set dlist {}
    foreach v $simos_vars {
        lappend query "set $v"
    }
    if {[llength $query] > 0} {
        set rlist [simosQuery $query]
        # First set the values of all SimOS-defined variables
        foreach v $simos_vars val $rlist {  
            set var_last($v) $var_value($v)
            if {$val == "can't read \"$v\": no such variable"} {
                lappend dlist $v
            } else {
                set var_value($v) $val
                varFormat $v
            }
        }
        if {[llength $dlist] == 1} {
            varDelete $dlist
            err "Undefined variable $dlist"
        } elseif {[llength $dlist] > 1} {
            foreach d $dlist {
                varDelete $d
            }
            err "Undefined variables:\n $dlist"
        }
    }
    # Next compute the values of the derived variables
    foreach v $derived_vars {
        set var_last($v) $var_value($v)
        if [catch {set val [uplevel \#0 $var_eval($v)]} msg] {
            set val "<undefined>"
        }
        set var_value($v) $val
        varFormat $v
    }
    # Finally, update chart information for charted variables
    if [winfo exists .vc] {
        foreach v [array names var_chart] {
            lappend var_chart($v) $var_value($v)
            stripChartUpdate .vc.$var_widget($v) $var_chart($v)
        }
    }
}    

proc varPeriodicUpdate {} {
    global varUpdatePeriod varUpdateCB pauseSimulation
    if ![connected] return
    if {$varUpdatePeriod > 0} {
        if !$pauseSimulation varUpdate
        set varUpdateCB \
            [after [expr $varUpdatePeriod * 1000] varPeriodicUpdate]
    }
}

proc varTableHide {} {
    global var_widget
    foreach v [array names var_widget] { 
        varHide $v
    }
}

proc varChartToggle {v} {
    global var_chart var_value var_widget
    if [winfo exists .vc.$var_widget($v)] {
        destroy .vc.$var_widget($v)
        unset var_chart($v)
    } else {
        set var_chart($v) {}
        stripChartCreate .vc.$var_widget($v) $v
    }
}
proc varChartCreate {} {
    toplevel .vc
    wm title .vc "TkSimOS Variable Chart"
    label .vc.label -text "Variable Charts"
    pack .vc.label
}
    
proc varTableClose {} {
    global var_chart
    destroy .vt
    catch {destroy .vc}
    foreach v [array names var_chart] {
        unset var_chart($v)
    }
}

proc doCheckpoint {} {
    if {[simosQuery "doCheckpoint"] != OK} {
        err "SimOS reported checkpoint failure"
    }
}
proc simosExit {} {
    global sock
    if [catch {puts $sock(main) "simosExit"} msg] {
        err "Checkpoint failed: $msg"
    }
    simosDisconnect
}

proc hostSet host {
    global sock hostname visualPort
    if [connected] {
        err "Can't change host: already connected to $hostname:$visualPort"
        return
    }
    if {$host == ""} {
        set name ""
        toplevel .hostset
        wm title .hostset "TkSimOS: New host"
        label .hostset.label -text Hostname:
        entry .hostset.name -width 25 -relief sunken -textvariable name
        pack .hostset.label .hostset.name -side left
        focus .hostset.name
        bind .hostset.name <Return> { 
            lappend hostlist $name
            hostSet $name
            destroy .hostset 
            hostMenu .host
        }
    } else {
        set hostname $host
    }
}

proc hostMenu {w} {
    global hostname hostlist
    catch {destroy $w}
    frame $w
    menubutton $w.name -textvariable hostname -menu $w.name.menu -fg blue
    menu $w.name.menu
    foreach h $hostlist {
        $w.name.menu add command -label $h -command "hostSet $h"
    }
    $w.name.menu add command -label "new host..." -command {hostSet ""}
    label $w.label -text "Connect to: "
    entry $w.port -width 5 -relief sunken -textvariable visualPort
    pack $w
    pack $w.label $w.name $w.port -side left -fill x
                 
}

proc mainWindow {} {
    global hostlist hostname visualPort
    global pauseSimulation getModes
    if [connected] {
        catch {destroy .host}
        label .host -text "Connected to $hostname:$visualPort" -fg red
        pack .host -fill x -ipady 5

        catch {destroy .pause}
        set pauseSimulation \
            [simosQuery [list "set PauseSimulation"]]
        checkbutton .pause -text "Pause Simulation" -variable pauseSimulation \
            -command {simosQuery [list "set PauseSimulation $pauseSimulation"]}
        pack .pause

        set getModes 0
        checkbutton .modesp -text "Retrieve Modes Data" -variable getModes
        pack .modesp

        catch {destroy .comm}