# $Id: cpumon.tcl 512 2013-04-28 07:44:02Z mueller $
|
# $Id: cpumon.tcl 512 2013-04-28 07:44:02Z mueller $
|
#
|
#
|
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
#
|
#
|
# This program is free software; you may redistribute and/or modify it under
|
# This program is free software; you may redistribute and/or modify it under
|
# the terms of the GNU General Public License as published by the Free
|
# the terms of the GNU General Public License as published by the Free
|
# Software Foundation, either version 2, or at your option any later version.
|
# Software Foundation, either version 2, or at your option any later version.
|
#
|
#
|
# This program is distributed in the hope that it will be useful, but
|
# This program is distributed in the hope that it will be useful, but
|
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
|
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# for complete details.
|
# for complete details.
|
#
|
#
|
# Revision History:
|
# Revision History:
|
# Date Rev Version Comment
|
# Date Rev Version Comment
|
# 2013-04-26 510 1.0 Initial version
|
# 2013-04-26 510 1.0 Initial version
|
#
|
#
|
|
|
package provide rw11 1.0
|
package provide rw11 1.0
|
|
|
package require rlink
|
package require rlink
|
package require rwxxtpp
|
package require rwxxtpp
|
|
|
namespace eval rw11 {
|
namespace eval rw11 {
|
|
|
#
|
#
|
# cpumon: special command environment while cpu is running
|
# cpumon: special command environment while cpu is running
|
#
|
#
|
|
|
variable cpumon_active 0
|
variable cpumon_active 0
|
variable cpumon_prompt ">"
|
variable cpumon_prompt ">"
|
variable cpumon_attnhdl_added 0
|
variable cpumon_attnhdl_added 0
|
variable cpumon_eofchar_save {puts {}}
|
variable cpumon_eofchar_save {puts {}}
|
|
|
proc cpumon {{prompt "cpumon> "} } {
|
proc cpumon {{prompt "cpumon> "} } {
|
variable cpumon_active
|
variable cpumon_active
|
variable cpumon_prompt
|
variable cpumon_prompt
|
variable cpumon_attnhdl_added
|
variable cpumon_attnhdl_added
|
variable cpumon_eofchar_save
|
variable cpumon_eofchar_save
|
global tirri_interactive
|
global tirri_interactive
|
|
|
# quit if cpumon already active
|
# quit if cpumon already active
|
if {$cpumon_active} {
|
if {$cpumon_active} {
|
error "cpumon already active"
|
error "cpumon already active"
|
}
|
}
|
|
|
# check that attn handler is installed
|
# check that attn handler is installed
|
if {!$cpumon_attnhdl_added} {
|
if {!$cpumon_attnhdl_added} {
|
rls attn -add 0x0001 { rw11::cpumon_attncpu }
|
rls attn -add 0x0001 { rw11::cpumon_attncpu }
|
set cpumon_attnhdl_added 1
|
set cpumon_attnhdl_added 1
|
}
|
}
|
|
|
# redefine ti_rri prompt and eof handling
|
# redefine ti_rri prompt and eof handling
|
if { $tirri_interactive } {
|
if { $tirri_interactive } {
|
# setup new prompt (save old one...)
|
# setup new prompt (save old one...)
|
set cpumon_prompt $prompt
|
set cpumon_prompt $prompt
|
rename ::tclreadline::prompt1 ::rw11::cpumon_prompt1_save
|
rename ::tclreadline::prompt1 ::rw11::cpumon_prompt1_save
|
namespace eval ::tclreadline {
|
namespace eval ::tclreadline {
|
proc prompt1 {} {
|
proc prompt1 {} {
|
return $rw11::cpumon_prompt
|
return $rw11::cpumon_prompt
|
}
|
}
|
}
|
}
|
# disable ^D (and save old setting)
|
# disable ^D (and save old setting)
|
set cpumon_eofchar_save [::tclreadline::readline eofchar]
|
set cpumon_eofchar_save [::tclreadline::readline eofchar]
|
::tclreadline::readline eofchar \
|
::tclreadline::readline eofchar \
|
{puts {^D disabled, use tirri_exit if you really want to bail-out}}
|
{puts {^D disabled, use tirri_exit if you really want to bail-out}}
|
}
|
}
|
|
|
set cpumon_active 1
|
set cpumon_active 1
|
return ""
|
return ""
|
}
|
}
|
|
|
#
|
#
|
# cpumon_attncpu: cpu attn handler
|
# cpumon_attncpu: cpu attn handler
|
#
|
#
|
proc cpumon_attncpu {} {
|
proc cpumon_attncpu {} {
|
variable cpumon_active
|
variable cpumon_active
|
variable cpumon_eofchar_save
|
variable cpumon_eofchar_save
|
global tirri_interactive
|
global tirri_interactive
|
|
|
if {$cpumon_active} {
|
if {$cpumon_active} {
|
puts "CPU down attention"
|
puts "CPU down attention"
|
puts [cpu0 show -r0ps]
|
puts [cpu0 show -r0ps]
|
# restore ti_rri prompt and eof handling
|
# restore ti_rri prompt and eof handling
|
if { $tirri_interactive } {
|
if { $tirri_interactive } {
|
rename ::tclreadline::prompt1 {}
|
rename ::tclreadline::prompt1 {}
|
rename ::rw11::cpumon_prompt1_save ::tclreadline::prompt1
|
rename ::rw11::cpumon_prompt1_save ::tclreadline::prompt1
|
::tclreadline::readline eofchar $cpumon_eofchar_save
|
::tclreadline::readline eofchar $cpumon_eofchar_save
|
}
|
}
|
set cpumon_active 0
|
set cpumon_active 0
|
}
|
}
|
return ""
|
return ""
|
}
|
}
|
|
|
}
|
}
|
|
|
