#!/usr/bin/wish -f
###############################################################################
## CONFIGURING this script:
##
##  As of tkisem version 4.5.8 on Linux systems, this file SHOULD NOT REQUIRE
##  ANY CUSTOMIZATION (unless you've got wish elsewhere than above).
##
## 1. If you're on a Unix system, replace the first line with the full
##    pathname of your wish interpreter (be certain to leave the "-f" after
##    the pathname).  This wish interpreter must be at least 7.5 (for file 
##    split/join commands, 8.0 or higher preferred).
##    
## 2. Set the library directory to the full pathname of where you installed
##    the library and help file.
##
## 3. Set the library extension: for Unix systems, this is 'so'.
##
###############################################################################

set libdir /usr/lib/tkisem
set lib_ext so

# $Format: "set release $ProjectVersion$"$
set release 4.5.12


###############################################################################
# Other configurable options -- 
###############################################################################

set library "$libdir/tkisem.$lib_ext"
set rom "$libdir/isem_rom"
set tkhfile "$libdir/isemhelp.txt"

if {[info exists env(TKISEM_ROM)]} {
    set rom $env(TKISEM_ROM)
}

load $library

# how to display registers
# the default is  regular  which uses the names %r0 through %r31
# the alternative is  window  which uses the names %g0-%g7, %o0-%o7, etc
set reg_view regular


#--------------------------fonts-----------------------------------------------
# configuration related to the help window
set help_fore black		;# basic help text
set help_back white
set help_font variable

set help_xref_fore black	;# cross reference text
set help_xref_back yellow
set help_xref_font variable

set help_label_fore black	;# label text
set help_label_back white
set help_label_font variable

set help_example_fore black	;# example text
set help_example_back white
set help_example_font fixed

set gpreg_font fixed
set text_font fixed		;# font used in the text (code) display windows
set data_font fixed		;# font used in the date display windows
set sym_font fixed
set console_font fixed

#--------------------------isem devices----------------------------------------
#
# the address is the memory address for the device
# the mode specifies which address spaces the device appears in -- it always
#   mapped into supervisor space, if mode is set to user, it is also mapped
#   into user space

set gx_address 0x100000
set gx_mode user

set console_address 0x110000
set console_mode user

set halt_address 0x120000
set halt_mode user

set timer_int_level 1
set timer_address 0x130000
set timer_mode user

set uart_int_level 1
set uart_address 0x140000
set uart_status_address 0x140000
set uart_creg_address 0x140004
set uart_txreg_address 0x140008
set uart_rxreg_address 0x14000c
set uart_mode user

###############################################################################
# end of configuration
###############################################################################

###############################################################################
# The debug panel
###############################################################################
toplevel .isem_debug
wm title .isem_debug "Debugging Messages for the tkISEM Script"
wm withdraw .isem_debug

label .isem_debug.lab -text "tkISEM DEBUG" -relief groove
frame .isem_debug.text
pack .isem_debug.lab .isem_debug.text -side top -fill x -expand 1

text .isem_debug.text.text -height 20 -width 80 \
    -relief sunken -bd 2 -font fixed \
    -yscrollcommand ".isem_debug.text.scroll set"
scrollbar .isem_debug.text.scroll -command ".isem_debug.text.text yview"
pack .isem_debug.text.scroll -side right -fill y
pack .isem_debug.text.text -side left

button .isem_debug.dismiss -text "Dismiss" -command "wm withdraw .isem_debug" -bg yellow
pack .isem_debug.dismiss

proc isem_debug {mes} {
    .isem_debug.text.text insert end [format "%s\n" $mes]
    .isem_debug.text.text yview -pickplace end
}

#------------------------------------------------------------------------------
# globals
set super_breaks {}
set user_breaks {}
set last_shown_pc_user 0
set last_shown_pc_super 0

set instr_annul ""

wm title . "tkisem Release: $release"

set file_super $rom
set file_user "a.out"
set proc_state "execute"

#####################
# AckleyHacks(tm) ON
# 
# a routine to keep the wm from killing our windows

proc make_delete_withdraw {win} {
    wm protocol $win WM_DELETE_WINDOW "wm withdraw $win"
}

#
# AckleyHacks(tm) OFF
#####################

proc set_status_message {msg} {
    global status_message
    set status_message $msg
}

proc updateprocmodecolor {vname velt op} {
    upvar $vname x
    if {$x=="super"} {
	catch {.pstate.mode.mode config -bg yellow}
    } elseif {$x=="user"} {
	catch {.pstate.mode.mode config -bg lightblue}
    }
}

proc updateprocstatecolor {vname velt op} {
    upvar $vname x
    if {$x=="execute"} {
	catch {.pstate.state.state config -bg lightgreen}
    } else {
	catch {.pstate.state.state config -bg red}
    }
}

###############################################################################
# a widget for the GX device
###############################################################################
toplevel .gx
wm withdraw .gx
wm title .gx "ISEM GX device"
make_delete_withdraw {.gx}

frame .gx.buttons
button .gx.buttons.dismiss -text "Dismiss" -command "wm withdraw .gx" \
    -bg yellow
button .gx.buttons.help -text "Help" -bg red \
    -command "goto_help_label {The GX device} 1"
pack .gx.buttons.dismiss -side left
pack .gx.buttons.help -side right


isem_gx .gx.display
pack .gx.display .gx.buttons -side top -fill x -expand on

###############################################################################
# a widget for the timer device
###############################################################################
toplevel .timer
wm withdraw .timer
wm title .timer "ISEM timer device"
make_delete_withdraw {.timer}

set timer_edit 0x00000000

frame .timer.bdy
frame .timer.buttons

pack .timer.bdy .timer.buttons -side top -expand 1 -fill x

label .timer.bdy.periodlab -text "Period" -bg grey75 -relief groove
label .timer.bdy.periodval -textvariable timer_period -relief sunken -bd 2
grid .timer.bdy.periodlab .timer.bdy.periodval -row 0 -sticky ew

label .timer.bdy.countlab -text "Count" -bg grey75 -relief groove
label .timer.bdy.countval -textvariable timer_count -relief sunken -bd 2
grid .timer.bdy.countlab .timer.bdy.countval -row 1 -sticky ew

label .timer.bdy.interrlab -text "Interrupt" -bg grey75 -relief groove
label .timer.bdy.interrval -textvariable timer_interrupt -relief sunken -bd 2
grid .timer.bdy.interrlab .timer.bdy.interrval -row 2 -sticky ew

button .timer.bdy.edlab -text "Set period" -command timer_edit_button \
    -bg grey75
entry .timer.bdy.edval -width 11 -textvariable timer_edit -relief sunken -bd 2
grid .timer.bdy.edlab .timer.bdy.edval -row 3 -sticky ew
bind .timer.bdy.edval <Return> {timer_edit_button}

proc timer_edit_button {} {
    global timer_edit timer_period

    set_timer_period $timer_edit
    set timer_edit $timer_period
}


button .timer.buttons.dismiss -text "Dismiss" -command "wm withdraw .timer" \
    -bg yellow
button .timer.buttons.help -text "Help" -bg red \
    -command "goto_help_label {The interval timer} 1"
pack .timer.buttons.dismiss -side left
pack .timer.buttons.help -side right

#############################################################################
##  UART device for tkisem
##############################################################################

toplevel .uart
wm withdraw .uart
wm title .uart "ISEM UART device"
make_delete_withdraw {.uart}
wm minsize .uart 30 20

# variable initialization
set UART_interrupt 0

set UART_RXscale 4			;# scale for UART clock ticks
set UART_TXscale 4			;# scale for UART clock ticks

set UART_sending "****"			;# current value being sent
set UART_TXReg "****"			;# vaule in the transmit register

set UART_receiving "****"		;# current value being sent
set UART_RXReg "****"			;# vaule in the transmit register

set UART_Tx_count 0			;# ticks until value transmitted
set UART_Rx_count 0			;# ticks until next value received
set UART_running 0			;# only set when interesting things
					;# are happening

set UART_stat 0x21
set UART_ctrl 0xfc

set UART_src none
set UART_src_file uart_src
set UART_srate 256
set UART_src_count 0
set UART_inchar 0

set UartTxInput program
set UartRxInput program
set UartTxOutput program
set UartRxOutput program
set UartTxInFile {}
set UartRxInFile {}
set UartTxOutFile {}
set UartRxOutFile {}
set UartTXReg 0x0
set UartRxIndex 1.0
set UartRxIndexCount -1
set UartTxIndex 1.0
set UartTxIndexCount -1

# register displays
frame .uart.reg 
pack .uart.reg -side top -fill x -expand true

# create status register
frame .uart.reg.stat -borderwidth 5 -relief ridge
grid .uart.reg.stat -row 0 -column 0 -rowspan 3 -sticky ns

# status register label
label .uart.reg.stat.reg -text "Status Reg" -bg grey75
grid .uart.reg.stat.reg -row 0 -columnspan 2 -sticky ew

# status register bit labels
label .uart.reg.stat.id0 -text  "tx reg emty"
label .uart.reg.stat.id1 -text  "rx reg full"
label .uart.reg.stat.id2 -text  "overrun err"
label .uart.reg.stat.id3 -text  "framing err"
label .uart.reg.stat.id4 -text  "parity err"
label .uart.reg.stat.id5 -text  "dsr"
label .uart.reg.stat.id6 -text  "unused"
label .uart.reg.stat.id7 -text  "unused"
foreach uarti {0 1 2 3 4 5 6 7}  {
    grid .uart.reg.stat.id$uarti -column 1 -row [expr $uarti + 1] -sticky w
}

# status register bit values
set temp $UART_stat
foreach uarti {0 1 2 3 4 5 6 7}  {
    set bit [expr $temp & 1]
    message .uart.reg.stat.bit$uarti -justify center -text $bit -relief sunken
    grid .uart.reg.stat.bit$uarti -column 0 -row [expr $uarti + 1]
    set temp [expr $temp >> 1]
}

# create control register
frame .uart.reg.creg -borderwidth 5 -relief ridge
grid .uart.reg.creg -row 0 -column 1 -rowspan 3 -sticky ns

# control register label
label .uart.reg.creg.reg -text "Control Reg" -bg grey75
grid .uart.reg.creg.reg -row 0 -columnspan 2 -sticky ew

# control register bit labels
frame .uart.reg.creg.id -borderwidth 5
label .uart.reg.creg.id0 -text  "tx intrrpt enbl"
label .uart.reg.creg.id1 -text  "rx intrrpt enbl"
label .uart.reg.creg.id2 -text  "tx/rx rate x1"
label .uart.reg.creg.id3 -text  "\"            \" x2"
label .uart.reg.creg.id4 -text  "\"            \" x4"
label .uart.reg.creg.id5 -text  "\"            \" x8"
label .uart.reg.creg.id6 -text  "\"            \" x16"
label .uart.reg.creg.id7 -text  "\"            \" x32"
foreach uarti {0 1 2 3 4 5 6 7}  {
    grid .uart.reg.creg.id$uarti -column 1 -row [expr $uarti + 1] -sticky w
}

# control register bit values
set temp $UART_ctrl
foreach uarti {0 1 2 3 4 5 6 7} {
    set bit [expr $temp & 1]
    message .uart.reg.creg.bit$uarti -justify center -relief sunken -text $bit
    grid .uart.reg.creg.bit$uarti -column 0 -row [expr $uarti + 1]
    set temp [expr $temp >> 1]
}

proc uart_disp_reg {reg reg_val} {
    set temp $reg_val
    foreach uarti {0 1 2 3 4 5 6 7} {
	set bit [expr $temp & 1]
	.uart.reg.$reg.bit$uarti configure -text $bit
	set temp [expr $temp >> 1]
    }
}

# the uart data registers
frame .uart.reg.data -borderwidth 5 -relief ridge
grid .uart.reg.data -row 0 -column 2 -sticky ns -rowspan 3

label .uart.reg.data.lab -bg grey75 -text "Data Regs"
grid .uart.reg.data.lab -row 0 -columnspan 2 -sticky ew

label .uart.reg.data.send_lab -text Sending
label .uart.reg.data.send_val -relief sunken -textvariable UART_sending \
    -width 8
grid .uart.reg.data.send_lab .uart.reg.data.send_val -row 1 -sticky e

label .uart.reg.data.tx_lab -text "TX reg"
label .uart.reg.data.tx_val -relief sunken -textvariable UART_TXReg -width 8
grid .uart.reg.data.tx_lab .uart.reg.data.tx_val -row 2 -sticky e

label .uart.reg.data.recv_lab -text Receiving
label .uart.reg.data.recv_val -relief sunken -textvariable UART_receiving \
    -width 8
grid .uart.reg.data.recv_lab .uart.reg.data.recv_val -row 3 -sticky e

label .uart.reg.data.rx_lab -text "RX reg"
label .uart.reg.data.rx_val -relief sunken -textvariable UART_RXReg -width 8
grid .uart.reg.data.rx_lab .uart.reg.data.rx_val -row 4 -sticky e

label .uart.reg.data.interr_lab -text Interrupt
label .uart.reg.data.interr_val -relief sunken -textvariable UART_interrupt \
    -width 8
grid .uart.reg.data.interr_lab .uart.reg.data.interr_val -row 5 -sticky e

label .uart.reg.data.txcnt_lab -text "TX count"
label .uart.reg.data.txcnt_val -relief sunken -textvariable UART_Tx_count \
    -width 8
grid .uart.reg.data.txcnt_lab .uart.reg.data.txcnt_val -row 6 -sticky e

label .uart.reg.data.rxcnt_lab -text "RX count"
label .uart.reg.data.rxcnt_val -relief sunken -textvariable UART_Rx_count \
    -width 8
grid .uart.reg.data.rxcnt_lab .uart.reg.data.rxcnt_val -row 7 -sticky e

entry .uart.reg.data.scale_entr -textvariable UART_RXscale -width 7
label .uart.reg.data.scale_lab -text "RX Scale" -bg grey75
grid .uart.reg.data.scale_lab .uart.reg.data.scale_entr -row 8 -sticky e

entry .uart.reg.data.txscale_entr -textvariable UART_TXscale -width 7
label .uart.reg.data.txscale_lab -text "TX Scale" -bg grey75
grid .uart.reg.data.txscale_lab .uart.reg.data.txscale_entr -row 9 -sticky e

# uart source
frame .uart.reg.source -borderwidth 5 -relief ridge
grid .uart.reg.source -row 1 -column 3

label .uart.reg.source.lab -text "UART Source" -bg grey75
pack .uart.reg.source.lab -side top -fill x -expand on

frame .uart.reg.source.radio
pack .uart.reg.source.radio -side top
radiobutton .uart.reg.source.radio.none -text none -value none \
    -variable UART_src -command uart_source_disabled
radiobutton .uart.reg.source.radio.key -text keybd -value key \
    -variable UART_src -command uart_source_key
radiobutton .uart.reg.source.radio.file -text file -value file \
    -variable UART_src -command uart_source_file
radiobutton .uart.reg.source.radio.rfile -text "rand file" -value rand_file \
    -variable UART_src -command uart_source_file
grid .uart.reg.source.radio.none .uart.reg.source.radio.key -row 0
grid .uart.reg.source.radio.file .uart.reg.source.radio.rfile -row 1

entry .uart.reg.source.entr -textvariable UART_src_file -width 18
pack .uart.reg.source.entr -side top

frame .uart.reg.srate -borderwidth 5 -relief ridge
grid .uart.reg.srate -row 2 -column 3 -sticky ew

label .uart.reg.srate.label -text "Source Rate" -bg grey75
grid .uart.reg.srate.label -columnspan 2 -row 0 -sticky ew
entry .uart.reg.srate.entr -textvariable UART_srate -width 10
label .uart.reg.srate.lab -text "rate"
grid .uart.reg.srate.lab .uart.reg.srate.entr -row 1

label .uart.reg.srate.scnt -textvariable UART_src_count -width 10
label .uart.reg.srate.scntlab -text "count"
grid .uart.reg.srate.scntlab .uart.reg.srate.scnt -row 2

proc uart_source_file {} {
    global UART_src_file UART_src UART_file
    global UART_running

    if {[file readable $UART_src_file]==0} {
	set_status_message "UART_file: Cannot read $UART_src_file"
	set UART_src none
	return
    }

    set UART_file [open $UART_src_file RDONLY]

    uart_getch
    if { $UART_running == 0 } {
	set UART_running 1
	add_run uart_timer
    }
}

proc uart_source_key {} {
    global UART_running
    uart_getch
    if { $UART_running == 0 } {
	set UART_running 1
	add_run uart_timer
    }
}

proc uart_source_disabled {} {
    set UART_src_count 0
}

# the buttons
frame .uart.buttons
pack .uart.buttons -side bottom -fill x -expand on

button .uart.buttons.help -text "Help" -bg red \
    -command "goto_help_label {The UART} 1"
button .uart.buttons.dismiss -text "Dismiss" -command "wm withdraw .uart" \
     -bg yellow
pack .uart.buttons.help -side right
pack .uart.buttons.dismiss -side left

##########################################################################
#  uart input/output selection - PLV
##########################################################################

set uart_test {}
set uart_filename {}

proc UartGetFileName {}  {
    global uart_test uart_filename
    toplevel .uart_get -borderwidth 10
    message .uart_get.msg -text "Please enter filename."  
    entry .uart_get.entry -textvariable uart_filename -bg white \
	-relief ridge
    frame .uart_get.buttons -borderwidth 10
    pack .uart_get.msg .uart_get.entry .uart_get.buttons -side top -fill x
    button .uart_get.buttons.ok -text "OK" -command {set uart_test 1}
    button .uart_get.buttons.can -text "Cancel" -command {set uart_test 0}
    pack .uart_get.buttons.ok -side left
    pack .uart_get.buttons.can -side right
    
    bind .uart_get.buttons.ok <Alt-o> "focus .uart_get.buttons.ok ; break"
    bind .uart_get.buttons.can <Alt-c>\
	"focus .uart_get.buttons.cancel ; break"
    bind .uart_get.entry <Return> {set uart_test 1}
    bind .uart_get <Alt-Key> break
    bind .uart_get <Control-c> {set uart_test 0}
    focus .uart_get.entry
    grab .uart_get
    tkwait variable uart_test
    #grab release .uart_get
    destroy .uart_get
    if {$uart_test}  {
	return $uart_filename
    } else {
	return {}
    }
}

# tx output window
frame .uart.keybd
pack .uart.keybd -side bottom -anchor sw 

frame .uart.keybd.txout
pack .uart.keybd.txout -side top
label .uart.keybd.txout.id -text "Transmitted Values" -bg grey75 -relief groove
pack .uart.keybd.txout.id -side top -fill x -expand true
text .uart.keybd.txout.text -setgrid true -wrap word -width 80 -height 5 \
    -yscrollcommand ".uart.keybd.txout.yscroll set" \
    -relief sunken -state disabled -font fixed
scrollbar .uart.keybd.txout.yscroll -command ".uart.keybd.txout.text yview"
pack .uart.keybd.txout.yscroll -side right -fill y
pack .uart.keybd.txout.text -side left -fill x -expand true

frame .uart.keybd.rxin
pack .uart.keybd.rxin -side top
label .uart.keybd.rxin.id -text "Source Values" -bg grey75  -relief groove
pack .uart.keybd.rxin.id -side top -fill x -expand true
text .uart.keybd.rxin.text -setgrid true -wrap word -width 80 -height 5 \
    -yscrollcommand {.uart.keybd.rxin.yscroll set} -font fixed
scrollbar .uart.keybd.rxin.yscroll -command {.uart.keybd.rxin.text yview}
pack .uart.keybd.rxin.yscroll -side right -fill y
pack .uart.keybd.rxin.text -side left -fill x -expand true

###############################################################################
# The state registers, pc, npc, z, psr, and tbr, are displayed in the
#   register display window along with the general purpose registers
###############################################################################
proc set_state_regs {} {
    global reg_view
    global pc npc y wim
    global psr_cwp psr_et psr_ps psr_s psr_pil psr_ef psr_ec
    global psr_c psr_v psr_z psr_n
    global tbr_tba tbr_tt
    global instr_annul instr_op instr_lab instr_opnds proc_mode

    set pc [isem_reg get pc]
    set npc [isem_reg get npc]
    set instr [isem_mem_rd $proc_mode text $pc]
    set ninstr [isem_mem_rd $proc_mode text $npc]
    set instr [isem_disasm $pc $proc_mode $reg_view]
    set instr_lab [lindex $instr 0]
    set instr_op [lindex $instr 1]
    set instr_opnds [lindex $instr 2]

    # get annul
    set instr_annul [isem_annul]
    
    set y [isem_reg get y]
    set wim [isem_reg get wim]

    set psr [isem_reg get psr]
    set psr_cwp [expr $psr & 1]
    set psr_cwp [expr $psr>>1 & 1]$psr_cwp
    set psr_cwp [expr $psr>>2 & 1]$psr_cwp
    set psr_cwp [expr $psr>>3 & 1]$psr_cwp
    set psr_cwp [expr $psr>>4 & 1]$psr_cwp

    set psr_et [expr $psr>>5 & 1]
    set psr_ps [expr $psr>>6 & 1]
    set psr_s [expr $psr>>7 & 1]

    set psr_pil [expr $psr>>8 & 1]
    set psr_pil [expr $psr>>9 & 1]$psr_pil
    set psr_pil [expr $psr>>10 & 1]$psr_pil
    set psr_pil [expr $psr>>11 & 1]$psr_pil

    set psr_ef [expr $psr>>12 &1]
    set psr_ec [expr $psr>>13 &1]

    set psr_c [expr $psr>>20 &1]
    set psr_v [expr $psr>>21 &1]
    set psr_z [expr $psr>>22 &1]
    set psr_n [expr $psr>>23 &1]

    set tbr [isem_reg get tbr]
    set tbr_tt [format {%.2x} [expr $tbr>>4 & 0xff] ]
    set tbr_tba [format {%.5x} [expr $tbr>>12] ]
}

proc set_gp_regs {} {
    for {set i 0} {$i < 32} {incr i} {
	global r$i
	set r$i [isem_reg get r$i]
    }
}

proc set_memrange {range mode}  {
    upvar \#0 $range range_var
    set temp [convert_val $range_var $mode "unknown"]
    if { $temp != "unknown" } {
	set range_var $temp
    }
}

proc scroll_data_super {args} {
    eval .super_data.mem.lab yview $args
    eval .super_data.mem.mem yview $args
    eval .super_data.mem.char yview $args
}

proc scroll_data_user {args} {
    eval .user_data.mem.lab yview $args
    eval .user_data.mem.mem yview $args
    eval .user_data.mem.char yview $args
}

proc scroll_super {args} {
    eval .super_syms.syms.syms.syms yview $args
    eval .super_syms.syms.value.vals yview $args
}

proc scroll_user {args} {
    eval .user_syms.syms.syms.syms yview $args
    eval .user_syms.syms.value.vals yview $args
}

proc show_syms {mode} {
    # clear out the symbol and value displays
    set syms_list [format {.%s_syms.syms.syms.syms} $mode]
    set vals_list [format {.%s_syms.syms.value.vals} $mode]
    $syms_list delete 0 end
    $vals_list delete 0 end

    upvar \#0 [format {%s_sort} $mode] sort
    if {$sort == "name"} {
	upvar \#0 [format {%s_syms} $mode] syms
	foreach s [lsort [array names syms]] {
	    $syms_list insert end $s
	    $vals_list insert end $syms($s)
	}
    } else {
	foreach sect {abs bss data text} {
	    upvar \#0 [format {%s_%s} $mode $sect] vals
	    foreach s [lsort [array names vals]] {
		$vals_list insert end "$s $sect"
		$syms_list insert end $vals($s)
	    }
	}
    }
}

proc toggle_breakpoint_addr {window addr} {
    regexp {(user|super)} $window mode
    set bv ${mode}_break_var
    global $bv
    set $bv $addr
    if {[is_breakp $mode $addr]} {
	rmv_break $bv $mode
    } else {
	set_bpoint $bv $mode
    }                
}

proc clear_breaks {mode} {
    set base [format {.%s_break.bp} $mode]
    $base.vals delete 0 end
    $base.labs delete 0 end

    set brks [format {.%s_text.mem.breakp} $mode]
    upvar \#0 [format {text_start_%s} $mode] start

    upvar \#0 [format "last_shown_pc_%s" $mode] last_pc
    upvar \#0 [format {%s_breaks} $mode] break_list
    foreach bkpt $break_list {
	set index [expr ($bkpt-$start) / 4]
	$brks delete $index
	if {$bkpt == $last_pc} {
	    $brks insert $index " >"
	} else {
	    $brks insert $index "  "
	}
    }
    set break_list {}

    # clear the last shown pc
    set index [expr ($last_pc-$start) / 4]
    $brks delete $index
    $brks insert $index "  "

    # show the pc
    set last_pc [isem_reg get pc]
    set index [expr ($last_pc-$start) / 4]
    $brks delete $index
    $brks insert $index " >"
}

proc set_bpoint {val_var mode} {
    upvar \#0 $val_var break
    set temp [convert_val $break $mode "unknown"]
    if {$temp != "unknown"} {

	# see if we have a label
	upvar \#0 [format {%s_syms} $mode] syms
	if { [info exists syms($break)] } {
	    set label $break
	} else {
	    set label ""
	}

	# add to the break list
	upvar \#0 [format {%s_breaks} $mode] breaks
	if { [lsearch -exact $breaks $temp] == -1 } {
	    lappend breaks $temp
	    set base [format {.%s_break.bp} $mode]
	    $base.labs insert end $label
	    $base.vals insert end $temp
	} 

	# show the breakpoint
	upvar \#0 [format "last_shown_pc_%s" $mode] last_pc
	set brks [format {.%s_text.mem.breakp} $mode]
	upvar \#0 [format {text_start_%s} $mode] start
	set index [expr ($temp-$start) / 4]
	$brks delete $index
	if {$temp == $last_pc} {
	    $brks insert $index "B>"
	} else {
	    $brks insert $index "B "
	}
    }
}

proc rmv_break {val_var mode} {
    upvar \#0 $val_var break
    set temp [convert_val $break $mode "unknown"]
    if {$temp != "unknown"} {
	upvar \#0  [format {%s_breaks} $mode] breaks
	set index [lsearch -exact $breaks $temp]
	if { $index != -1 } {
	    set breaks [lreplace $breaks $index $index]
	    set base [format {.%s_break.bp} $mode]
	    $base.labs delete $index
	    $base.vals delete $index
	} 

	# clear the breakpoint
	upvar \#0 [format "last_shown_pc_%s" $mode] last_pc
	set brks [format {.%s_text.mem.breakp} $mode]
	upvar \#0 [format {text_start_%s} $mode] start
	set index [expr ($temp-$start) / 4]
	$brks delete $index
	if {$temp == $last_pc} {
	    $brks insert $index " >"
	} else {
	    $brks insert $index "  "
	}
    }
}

###############################################################################
# support functions
###############################################################################
#..............................................................................
# show_data -- 
#------------------------------------------------------------------------------
proc show_data {mode} {
    upvar \#0 [format {data_start_%s} $mode] start
    upvar \#0 [format {data_end_%s} $mode] end

    set start [format {0x%.8x} [expr ($start>>2)<<2]]
    set end [format {0x%.8x} [expr ($end>>2)<<2]]

    set labs [format {.%s_data.mem.lab} $mode]
    $labs delete 0 end
    set mem [format {.%s_data.mem.mem} $mode]
    $mem delete 0 end
    set char [format {.%s_data.mem.char} $mode]
    $char delete 0 end

    upvar \#0 [format {%s_data} $mode] val

    set update [format {.%s_text.range.update} $mode]
    $update configure -text ""
    update

    set values [isem_mem_rd $mode data $start $end]
    set addr $start
    foreach v $values {
	set addr [format {0x%.8x} $addr]
	if {[info exists val($addr)]} {
	    $labs insert end "$val($addr):"
	} else {
	    $labs insert end $addr
	}
	$mem insert end $v
	$char insert end [format {%c%c%c%c} [expr ($v>>24)&0xff] \
			      [expr ($v>>16)&0xff] [expr ($v>>8)&0xff] \
			      [expr $v&0xff] ]
	incr addr 4
    }
    $update configure -text "Update" -bg lightgreen
    update
}

proc show_text {mode} {
    global reg_view
    set scrollw [format {.%s_text.mem.scroll} $mode]
    set wasy [lindex [$scrollw get] 0]
    
    set pc [format {0x%.8x} [isem_reg get pc]]
    
    upvar \#0 [format {text_start_%s} $mode] start
    upvar \#0 [format {text_end_%s} $mode] end
    
    set start [format {0x%.8x} [expr ($start>>2)<<2]]
    set end [format {0x%.8x} [expr ($end>>2)<<2]]
    
    set update [format {.%s_text.range.update} $mode]
    $update configure -text ""
    update
    
    set addrs [format {.%s_text.mem.addr} $mode]
    $addrs delete 0 end
    set labs [format {.%s_text.mem.lab} $mode]
    $labs delete 0 end
    set opr [format {.%s_text.mem.opr} $mode]
    $opr delete 0 end
    set opnds [format {.%s_text.mem.opnds} $mode]
    $opnds delete 0 end
    set brks [format {.%s_text.mem.breakp} $mode]
    $brks delete 0 end
    
    for {set adr $start} {$adr <= $end} {incr adr 4} {
	set addr [format {0x%.8x} $adr]
	
        set pcflag " "
        if {$addr==$pc} {
	    set pcflag ">"
	    upvar \#0 [format "last_shown_pc_%s" $mode] last_pc
	    set last_pc $pc
        }
        set brkflag " "
	if {[is_breakp $mode $addr] } {
	    set brkflag "B"
	}
	$brks insert end "$brkflag$pcflag" 
	$addrs insert end $addr
	
	set instr [isem_disasm $addr $mode $reg_view]
	$labs insert end [lindex $instr 0]
	$opr insert end [lindex $instr 1]
	$opnds insert end [lindex $instr 2]
    }
    
    set pc_indx [expr ($pc-$start)/4]
    $addrs see $pc_indx
    $labs see $pc_indx
    $opr see $pc_indx
    $opnds see $pc_indx
    $brks see $pc_indx

    $update configure -text "Update" -bg lightgreen
    update
}

#------------------------------------------------------------------------------
# loading files
#------------------------------------------------------------------------------
proc load_super name {
    global load_mode

    set load_mode super
    load_file $name
}

proc load_user name {
    global load_mode

    set load_mode user
    load_file $name
}

proc load_file name {

    # make sure we can read the file we're trying to read
    if {[file readable $name]==0} {
	set_status_message "load_file: Cannot read $name"
	isem_debug "load_file: Cannot read $name"
	return "error"
    }

    global load_mode
    if {[catch {isem_load $name $load_mode} symbols] != 0} {
	set_status_message $symbols
	isem_debug "load_file: $symbols"
	return "error"
    }

    global proc_mode proc_state
    global file_$load_mode

    #set file_$load_mode [file tail $name]

    set proc_mode $load_mode
    set file_name [format {%s_file} $load_mode]
    global $file_name
    set $file_name $name

    upvar \#0 [format {%s_syms} $load_mode] syms
    set syms(x) y
    foreach i [array names syms] {
	unset syms($i)
    }

    foreach sect {abs bss data text} {
	upvar \#0 [format {%s_%s} $load_mode $sect] arr
	set arr(x) y
	foreach i [array names arr] {
	    unset arr($i)
	}
    }

    global text_start_$load_mode text_end_$load_mode
    global data_start_$load_mode data_end_$load_mode

    set text_start_$load_mode [lindex $symbols 0]
    upvar \#0 [format {%s_text} $load_mode] val
    set text_end_$load_mode [lindex $symbols 1]
    set data_start_$load_mode [lindex $symbols 2]
    set data_end_$load_mode [lindex $symbols 3]

    set symbols [lrange $symbols 4 end]

    foreach s $symbols {
	set nam [lindex $s 0]
	if { ![regexp {.*\.o$} $nam] } {
	    set syms($nam) [list [lindex $s 1] [lindex $s 2]]
	    upvar \#0 [format {%s_%s} $load_mode [lindex $s 2]] val
	    set val([lindex $s 1]) $nam
	}
    }

    set xxx $syms(_etext)
    set text_end_$load_mode [lindex $xxx 0]

    set xxx $syms(_edata)
    set data_end_$load_mode [lindex $xxx 0]
    
    show_syms $load_mode
    clear_breaks $load_mode

    set_state_regs
    set_gp_regs

    .run_stop configure -text Run -command run_button
    set proc_state "execute"

    set_status_message "$name loaded into $load_mode memory"

    return "ok"
}

proc is_breakp {mode addr} {
   global user_breaks super_breaks
   if { [lsearch -exact [set ${mode}_breaks] $addr] != -1} {
	return 1
    } else {
   	return 0
    }
}

#------------------------------------------------------------------------------
# running programs
#------------------------------------------------------------------------------

#..............................................................................
# driver -- run until stop_run is set
proc driver {} {
    global total_cycles stop_run proc_state
    global user_breaks super_breaks proc_mode step_super step_user
    
    set_status_message ""
    set stop_run 0
    while {!$stop_run} {
	set proc_mode [isem_step]
	run_devices
	incr total_cycles

	if {$proc_mode=="error"} {
	    set stop_run 1
	} else {
	    if { [set step_${proc_mode}] } {
		set stop_run 1
	    } elseif { $total_cycles%[.uprate get] == 0 } {
		update_display 0
	    }
	    
	    if {[llength ${proc_mode}_breaks]} { ;# see if worth checking..
		set pc [isem_reg get pc]
		if { [lsearch -exact [set ${proc_mode}_breaks] $pc] != -1 } {
		    set_status_message [format {Breakpoint at %s} $pc]
		    set stop_run 1
		}
	    }
	}
    }
    
    update_display 1
    .run_stop configure -text Run -command run_button
    .loadfile.user.load configure -state normal
    .loadfile.super.load configure -state normal
}

#..............................................................................
# run and stop buttons
proc do_nothing {} {
}

proc run_button {} {
    .loadfile.user.load configure -state disabled
    .loadfile.super.load configure -state disabled
    .run_stop configure -text Stop -command stop_button
    driver
}

proc stop_button {} {
    global stop_run
    .run_stop configure -text Run -command run_button
    set stop_run 1
}

#..............................................................................
# update_display -- updates the main window and register displays.  Called
# whenever execution is halted or when enough instructions have been executed
proc update_display { force } {
    global proc_mode proc_state update_user update_super
    global user_cycles user_mems super_cycles super_mems
    global super_breaks user_breaks

    if {$proc_mode=="error"} {
	set proc_state "error"
	set psr [isem_reg get psr]
	if { [expr $psr>>7 & 1] == 1 } {
	    set proc_mode super
	} else {
	    set proc_mode user
	}
    }

    set mode_is_updated [set update_${proc_mode}]
    if {$mode_is_updated || $force} {
	if {[wm state .gpregs] == "normal"} {
	    set_state_regs
	    set_gp_regs
	}
	if {[wm state .${proc_mode}_text] == "normal" } {
	    # clear the last shown pc
	    set brks [format {.%s_text.mem.breakp} $proc_mode]
	    upvar \#0 [format {text_start_%s} $proc_mode] start
	    upvar \#0 [format "last_shown_pc_%s" $proc_mode] last_pc
	    set index [expr ($last_pc-$start) / 4]
	    $brks delete $index
	    if { [lsearch -exact [set ${proc_mode}_breaks] $last_pc] != -1 } {
		$brks insert $index "B "
	    } else {
		$brks insert $index "  "
	    }
	    
	    # show the pc
	    set last_pc [isem_reg get pc]
	    set index [expr ($last_pc-$start) / 4]
	    $brks delete $index
	    if { [lsearch -exact [set ${proc_mode}_breaks] $last_pc] != -1 } {
		$brks insert $index "B>"
	    } else {
		$brks insert $index " >"
	    }

	    set addrs [format {.%s_text.mem.addr} $proc_mode]
	    set labs [format {.%s_text.mem.lab} $proc_mode]
	    set opr [format {.%s_text.mem.opr} $proc_mode]
	    set opnds [format {.%s_text.mem.opnds} $proc_mode]

	    $addrs see $index
	    $labs see $index
	    $opr see $index
	    $opnds see $index
	    $brks see $index
	}
    }

    # get processor state
    scan [isem_counts] %d%d%d%d user_cycles user_mems super_cycles super_mems
    update
}

###############################################################################
# The control panel
###############################################################################

#------------------------------------------------------------------------------
# the menu bar entries
#------------------------------------------------------------------------------
frame .mbar -relief raised -bd 2
menubutton .mbar.file -text File -underline 0 -menu .mbar.file.menu
menubutton .mbar.regs -text Registers -underline 0 -menu .mbar.regs.menu
menubutton .mbar.symb -text Symbols -underline 0 -menu .mbar.symb.menu
menubutton .mbar.break -text Breakpoints -underline 0 -menu .mbar.break.menu
menubutton .mbar.mem -text Memory -underline 0 -menu .mbar.mem.menu
menubutton .mbar.opt -text Options -underline 0 -menu .mbar.opt.menu
menubutton .mbar.dev -text Devices -underline 0 -menu .mbar.dev.menu
menubutton .mbar.help -text "Help" -underline 0 -menu .mbar.help.menu -bg red

menu .mbar.file.menu
.mbar.file.menu add command -label Quit -command exit
.mbar.file.menu add command -label "Debug" -command "wm deiconify .isem_debug"

menu .mbar.regs.menu
.mbar.regs.menu add command -label "Display" -command "wm deiconify .gpregs;raise .gpregs"

menu .mbar.break.menu
.mbar.break.menu add command -label "User Breakpoints" \
    -command "wm deiconify .user_break;raise .user_break"
.mbar.break.menu add command -label "Supervisor Breakpoints"  \
    -command "wm deiconify .super_break;raise .super_break"

menu .mbar.mem.menu
.mbar.mem.menu add command -label "User Data" \
    -command "wm deiconify .user_data;raise .user_data"
.mbar.mem.menu add command -label "User Text" \
    -command "wm deiconify .user_text;raise .user_text"
.mbar.mem.menu add command -label "Supervisor Data" \
    -command "wm deiconify .super_data;raise .super_data"
.mbar.mem.menu add command -label "Supervisor Text" \
    -command "wm deiconify .super_text;raise .super_text"

menu .mbar.symb.menu
.mbar.symb.menu add command -label "User Symbols" \
    -command "wm deiconify .user_syms;raise .user_syms"
.mbar.symb.menu add command -label "Supervisor Symbols" \
    -command "wm deiconify .super_syms;raise .super_syms"

menu .mbar.dev.menu
.mbar.dev.menu add command -label "Timer" -command "wm deiconify .timer;raise .timer"
.mbar.dev.menu add command -label "UART" -command "wm deiconify .uart;raise .uart"
.mbar.dev.menu add command -label "GX" -command "wm deiconify .gx;raise .gx"

menu .mbar.opt.menu

.mbar.opt.menu add command -label "Regular Regs" -command set_reg_view_regular
.mbar.opt.menu add command -label "Window Regs" -command set_reg_view_window

menu .mbar.help.menu
.mbar.help.menu add command -label "Table of contents" \
    -command "goto_help_label {Table of contents} 1"
.mbar.help.menu add command -label "Overview" \
    -command "goto_help_label {Overview} 1"
.mbar.help.menu add command -label "Using Help" \
    -command "goto_help_label {Using help} 1"
.mbar.help.menu add command -label "About Tcl Errors" \
    -command "goto_help_label {About Tcl errors} 1"
.mbar.help.menu add command -label "The Main Window" \
    -command "goto_help_label {Main window} 1"
.mbar.help.menu add command -label "The Register Window" \
    -command "goto_help_label {Register window} 1"
.mbar.help.menu add command -label "The Symbol Window" \
    -command "goto_help_label {Symbol window} 1"
.mbar.help.menu add command -label "The Breakpoint Window" \
    -command "goto_help_label {Breakpoint window} 1"
.mbar.help.menu add command -label "The Text Display Window" \
    -command "goto_help_label {Text display window} 1"
.mbar.help.menu add command -label "The Data Display Window" \
    -command "goto_help_label {Data display window} 1"
.mbar.help.menu add command -label "Breakpoints" \
    -command "goto_help_label {Breakpoints} 1"
.mbar.help.menu add command -label "The Devices" \
    -command "goto_help_label {The devices} 1"
.mbar.help.menu add command -label "The ROM Code" \
    -command "goto_help_label {The rom code} 1"

#------------------------------------------------------------------------------
# the help window
#------------------------------------------------------------------------------
toplevel .tkhelp
wm withdraw .tkhelp
wm title .tkhelp "ISEM: Help"
make_delete_withdraw .tkhelp

frame .tkhelp.statusline

label .tkhelp.statusline.stat -text "Message: " -bg grey75
label .tkhelp.statusline.msg -anchor w -textvariable status_message -width 50 \
    -relief sunken -bg white
pack .tkhelp.statusline.stat -side left -ipadx 2m -fill x
pack .tkhelp.statusline.msg -side left -expand 1 -fill x 
pack .tkhelp.statusline -side bottom

frame .tkhelp.buttons
pack .tkhelp.buttons -side bottom -fill x
text .tkhelp.text -yscrollcommand ".tkhelp.scroll set" -wrap word
scrollbar .tkhelp.scroll -command ".tkhelp.text yview"
pack .tkhelp.scroll -side right -fill y
pack .tkhelp.text -side left
button .tkhelp.buttons.dismiss -text "Dismiss" -command "wm withdraw .tkhelp" \
     -bg yellow
set help_previous_topics {}
set help_current_topic {}

button .tkhelp.buttons.back -text "Back" -command "help_go_back" \
    -state disabled
button .tkhelp.buttons.last -text Previous -command "help_go_prev" \
    -state disabled
pack .tkhelp.buttons.dismiss -side left
pack .tkhelp.buttons.back -side right

.tkhelp.text configure -foreground $help_fore
.tkhelp.text configure -bg $help_back
.tkhelp.text configure -font $help_font

.tkhelp.text tag configure xref -foreground $help_xref_fore
.tkhelp.text tag configure xref -background $help_xref_back
.tkhelp.text tag configure xref -font $help_xref_font

.tkhelp.text tag configure label -background $help_label_back
.tkhelp.text tag configure label -foreground $help_label_fore
.tkhelp.text tag configure label -font $help_label_font

.tkhelp.text tag configure example -foreground $help_example_fore
.tkhelp.text tag configure example -background $help_example_back
.tkhelp.text tag configure example -font $help_example_font

.tkhelp.text tag bind xref <Any-Button> {
    infojumpfocus [.tkhelp.text index @%x,%y] 1
}

##########################################
# Sun Jan 22 12:26:13 1995 dha Barfing out something, anything, to add a
# little help functionality to tkisem21 before the students have actually
# to *use* the damn thing

# Basic scheme: A single help file for everything, that will get
# inhaled in its entirety the first time any help is requested, and a
# single help window to display the file.  We're going to parse the help
# text just slightly on the way in, to find two things: 
# (1) Beginning-of-section labels, indicating that the immediately
# following text should be scrolled to the top of the help window if
# help on the given label is requested, and 
# (2) Inline xrefs to other sections, mentioning them by labels.
#
# For disgustimento nroff-oid ease of parsing, we'll require that all
# such commands appear alone on a line, and use blank lines to separate
# paragraphs, and flow everything else together.
#
# The implementation strategy is to tag all xrefs as XREF or something,
# and tag all labels as, say, LABEL, and then go from there.
#
# Sun Jan 22 12:35:46 1995 Here we go.
#
# Sun Jan 22 13:45:09 1995 OK, well, regrouping...  Frigging text
# widgets can't be trusted to wrap text as far as I can barf them, so
# we're tossing the nroff-oid mode and going with arbitrary position
# trip characters instead.  This isn't so awful to do since we're using
# regexp already.  So now we're going to believe the line breaks in the
# help file.  Going again.
#
# Sun Jan 22 15:20:49 1995 OK, it works.  God I hate Tcl.  Now to drop by
# the escape pod to see if I can use these fonts or not, on the way outta here
#
# Thu Jan 26 10:30:10 1995 Well, since it's office hours and nobody's here,
# I'm going to hack help a little more.  Going back to tcl-wrap/paragraph
# mode, but keeping the trip-character style

set tkhloadedp 0

proc help_go_back {} {
    global help_previous_topics
    set l [expr [llength $help_previous_topics]-1]
    if { $l >= 0 } {
	set b [lindex $help_previous_topics $l]
	set help_previous_topics [lreplace $help_previous_topics $l $l]
	goto_help_label $b 0
    }
    if {$help_previous_topics=={}} {
	.tkhelp.buttons.back config -state disabled -text "Back"
    } else {
	set b [lindex $help_previous_topics \
		   [expr [llength $help_previous_topics]-1]]
	.tkhelp.buttons.back config -state normal -text "Back to '$b'"
    }
}

proc find_prev_label {indx} {
    set w .tkhelp.text
    $w mark set finger 1.0
    set nr ""
    while {1} {
	set last $nr
	set nr [$w tag nextrange label [$w index finger] "$indx+1 char"]
	if {$nr==""} {
	    if {$last==""} return
	    set ats [lindex $last 0]
	    set ate [lindex $last 1]
	    set lab [$w get $ats $ate]
	    return $lab
	} else { 
	    $w mark set finger [lindex $nr 1] 
	}
    }
}

proc infojumpfocus {jndex additp} {
    set w .tkhelp.text
    $w mark set finger 1.0
    set nr ""
    while {1} {
	set last $nr
	set nr [$w tag nextrange xref [$w index finger] "$jndex+1 char"]
	if {$nr==""} {
	    if {$last==""} return
	    set ats [lindex $last 0]
	    set ate [lindex $last 1]
	    set lab [$w get $ats $ate]
	    global help_current_topic
	    set cur_label [find_prev_label $jndex]
	    if {$cur_label != $help_current_topic} {
		global help_previous_topics
		lappend help_previous_topics $help_current_topic
		set help_current_topic $cur_label
	    }
	    goto_help_label $lab $additp
	    return
	} else { 
	    $w mark set finger [lindex $nr 1] 
	}
    }
}

proc goto_help_label {label additp} {
    tkhcheckload
    wm deiconify .tkhelp
    raise .tkhelp
    set_status_message ""
    if {[catch {set kndex [lindex [.tkhelp.text tag ranges $label] 0]} \
	                          errorstring]==0} {
	if {$kndex!=""} {
	    .tkhelp.text yview $kndex
	    global help_current_topic
	    if { $additp && $help_current_topic != {} } {
		global help_previous_topics
		lappend help_previous_topics $help_current_topic
		.tkhelp.buttons.back config -state normal \
		    -text "Back to '$help_current_topic'"
	    }
	    set help_current_topic $label
	    return
	}
    }
    set_status_message "Can't find help label '$label'"
}

proc tkhcheckload {} {
    global tkhloadedp tkhfile
    if {$tkhloadedp==0} {
	tkhloadparse $tkhfile .tkhelp
	set tkhloadedp 1
    }
}

set lvl1_cnt 0
set lvl2_cnt 0
set lvl3_cnt 0

proc tkhloadparse {name w} {

    set evalstr ""
    $w.text delete 1.0 end
    if {[file readable $name]==0} {
	$w.text insert end "Can't read help file $name"
	return
    }

    set f [open $name r]
    while {[gets $f line] >= 0} {	;# til eof

	# look for blank lines
	set first 1
	set notlast 1
	while {$notlast && [regexp {^[ 	]*$} $line]} {
	    if {$first} {
		$w.text insert end "\n\n"
		set first 0
	    }
	    if {[gets $f line] < 0} {
		set notlast 0
	    }
	}

	global lvl1_cnt lvl2_cnt lvl3_cnt
	while {[regexp -nocase \
		    {^([^~]*)~(br|lb|lb1|lb2|lb3|xr|eg|var)\[([^~]*)\](.*)$} \
		    $line all pre cmd arg post]!=0} {

	    # ship off the leading non-cmd stuff
	    $w.text insert end $pre 

	    if {$cmd == "lb1"} {
		incr lvl1_cnt
		set lvl2_cnt 0
		set lvl3_cnt 0
		$w.text insert end "$lvl1_cnt.  "
		set cmd "lb"
	    } elseif {$cmd=="lb2"} {
		incr lvl2_cnt
		set lvl3_cnt 0
		$w.text insert end "$lvl1_cnt.$lvl2_cnt.  "
		set cmd "lb"
	    } elseif {$cmd=="lb3"} {
		incr lvl3_cnt
		$w.text insert end "$lvl1_cnt.$lvl2_cnt.$lvl3_cnt  "
		set cmd "lb"
	    }

	    # replace the variable for a ~var command
	    if {$cmd=="var"} {
		upvar \#0 $arg xxx
		set arg $xxx
		set cmd "eg"
	    }

	    # record the start and end of the text for this command
	    set start [$w.text index "end - 1 chars"]
	    $w.text insert end $arg
	    set end [$w.text index "end - 1 chars"]

	    #puts "tkhlp cmd $cmd start $start end $end arg $arg"

	    # process the command
	    if {$cmd=="lb"} {
		append evalstr "$w.text mark set {$arg} $start\n"
		append evalstr "$w.text tag add label $start $end\n"
		append evalstr "$w.text tag add {$arg} $start $end\n"
	    } elseif {$cmd=="xr"} {
		append evalstr "$w.text tag add xref $start $end\n"
	    } elseif {$cmd=="eg"} {
		append evalstr "$w.text tag add example $start $end\n"
	    } elseif {$cmd=="br"} {
		$w.text insert end "\n"
	    }
	    
	    # process the rest of the line
	    set line $post
	}

	# add the rest (non command part) of the line
	$w.text insert end "$line "
    }

    #puts "$evalstr"
    eval $evalstr
    close $f
    $w.text configure -state disabled
}

# End of tkisem_help.tcl
##########################################

pack .mbar.file .mbar.regs .mbar.symb .mbar.break .mbar.mem .mbar.dev \
    .mbar.opt -side left
pack .mbar.help -side right

#------------------------------------------------------------------------------
# the status line
#------------------------------------------------------------------------------
frame .statusline

label .statusline.stat -text "Message: " -background grey75
label .statusline.msg -anchor w -textvariable status_message -width 50 \
    -relief sunken -bg white
pack .statusline.stat -side left -ipadx 2m -fill x
pack .statusline.msg -side left -expand 1 -fill x 

#------------------------------------------------------------------------------
# the processor state line
#------------------------------------------------------------------------------
frame .pstate -relief raised -bd 2
frame .pstate.state
label .pstate.state.lab -text "Proc State" -anchor w
label .pstate.state.state -width 8 -textvariable proc_state \
    -relief groove -bd 4 -anchor w
pack .pstate.state.lab .pstate.state.state -side top -expand 1 -fill x

frame .pstate.mode
label .pstate.mode.lab -text "Proc Mode" -anchor w
label .pstate.mode.mode -width 7 -textvariable proc_mode -relief groove \
    -bd 4 -anchor w

#####################
# AckleyHacks(tm) ON
# 
# make it a bit more obvious what the processor mode is

trace variable proc_mode w updateprocmodecolor
trace variable proc_state w updateprocstatecolor

#
# AckleyHacks(tm) OFF
#####################

pack .pstate.mode.lab .pstate.mode.mode -side top -expand 1 -fill x
pack .pstate.state .pstate.mode -side left -padx 2m

frame .pstate.step
frame .pstate.step.super
label .pstate.step.super.lab -text "Super" -width 6
checkbutton .pstate.step.super.step -text "Step" -variable step_super \
    -command set_super_step -anchor w
checkbutton .pstate.step.super.update -text "Display" -variable update_super \
    -command set_super_update -anchor w
label .pstate.step.super.cyclecount -textvariable super_cycles -width 8 \
    -anchor e
label .pstate.step.super.memcount -textvariable super_mems -width 8 -anchor e
pack .pstate.step.super.lab .pstate.step.super.step .pstate.step.super.update \
    .pstate.step.super.cyclecount .pstate.step.super.memcount -side left

frame .pstate.step.user
label .pstate.step.user.lab -text "User" -width 6
checkbutton .pstate.step.user.step -text "Step" -variable step_user \
    -command set_user_step -anchor w
checkbutton .pstate.step.user.update -text "Display" -variable update_user \
    -command set_user_update -anchor w
label .pstate.step.user.cyclecount -textvariable user_cycles -width 8 \
    -anchor e
label .pstate.step.user.memcount -textvariable user_mems -width 8 -anchor e
pack .pstate.step.user.lab .pstate.step.user.step .pstate.step.user.update \
    .pstate.step.user.cyclecount .pstate.step.user.memcount -side left

pack .pstate.step.super .pstate.step.user -side top -expand 1 -fill x -padx 2m

pack .pstate.step -side left -expand 1 -fill x -padx 2m

proc set_super_step {} {
    global step_super update_super

    if { $step_super } {
	set update_super 1
    }
}

proc set_super_update {} {
    global step_super update_super

    if { $update_super==0 } {
	set step_super 0
    }
}

proc set_user_step {} {
    global step_user update_user

    if { $step_user } {
	set update_user 1
    }
}

proc set_user_update {} {
    global step_user update_user

    if { $update_user==0 } {
	set step_user 0
    }
}

#------------------------------------------------------------------------------
# the load line  -- now including update rate and also run?
#------------------------------------------------------------------------------
set ld_fname a.out
frame .loadfile

frame .loadfile.user
button .loadfile.user.load -text "Load User" -command {load_user $file_user} \
    -state disabled
entry .loadfile.user.name -relief sunken -textvariable file_user
bind .loadfile.user.name <Return> {load_user $file_user}
pack .loadfile.user.load .loadfile.user.name -side top -fill x -expand 1

frame .loadfile.super
button .loadfile.super.load -text "Load Super" \
    -command {load_super $file_super} -state disabled
entry .loadfile.super.name -relief sunken -textvariable file_super
bind .loadfile.super.name <Return> {load_super $file_super}
pack .loadfile.super.load .loadfile.super.name -side top -fill x -expand 1

pack .loadfile.user .loadfile.super -side left

scale .uprate -label "Display Frequency" -from 1 -to 1024 \
    -orient horizontal 
.uprate set 256
pack .uprate -in .loadfile -side right -fill x -expand 1 -padx 1m
button .run_stop -width 5
pack .run_stop -in .loadfile -side right -padx 1m -fill y

#------------------------------------------------------------------------------
# the console output
#------------------------------------------------------------------------------
set conout_height 6
set conout_width 80
frame .conout
label .conout.lab -text "Console Output" -relief groove -background grey75
frame .conout.text
pack .conout.lab -side top -fill x -expand 0
pack .conout.text -side top -fill both -expand 1

text .conout.text.text \
        -height $conout_height -width $conout_width \
        -relief sunken -bd 2 -state disabled -font $console_font \
        -yscrollcommand ".conout.text.scroll set"
scrollbar .conout.text.scroll -command ".conout.text.text yview"
pack .conout.text.scroll -side right -fill y 
pack .conout.text.text -side left -fill both -expand 1

#------------------------------------------------------------------------------
# the console input
#------------------------------------------------------------------------------
set conin_height 2
set conin_width 80
frame .conin
label .conin.lab -text "Console Input" -relief groove -background grey75
frame .conin.text
pack .conin.lab -side top -fill x -expand 0
pack .conin.text -side top -fill both -expand 1

text .conin.text.text \
        -height $conin_height -width $conin_width \
        -relief sunken -bd 2 -font $console_font \
        -yscrollcommand ".conin.text.scroll set"
scrollbar .conin.text.scroll -command ".conin.text.text yview"
pack .conin.text.scroll -side right -fill y
pack .conin.text.text -side left -fill both -expand 1

#------------------------------------------------------------------------------
# put the pieces together for the main window
pack .mbar .pstate .loadfile .statusline -side top -fill x
pack .conout .conin -side top -fill both -expand 1

###############################################################################
# toplevel widgets to display supervisor and user text
###############################################################################
foreach mode {super user} {
    set top [format {.%s_text} $mode]

    toplevel $top
    wm withdraw $top

    frame $top.mem
    pack $top.mem -side top -fill both -expand yes

    frame $top.range
    pack $top.range -side top -fill x

    frame $top.range.start
    frame $top.range.end
    button $top.range.update -width 6 -text "Update" -bg lightgreen \
	-command "show_text $mode"
    pack $top.range.update -side left
    pack $top.range.start -side left -fill x
    pack $top.range.end -side left -fill x

    global text_start_$mode text_end_$mode

    label $top.range.start.lab -text Start
    entry $top.range.start.val -width 11 -font $text_font -relief sunken \
	-textvariable text_start_$mode
    bind $top.range.start.val <Return> "set_memrange text_start_$mode $mode"
    pack $top.range.start.lab -side left
    pack $top.range.start.val -side left -fill x

    label $top.range.end.lab -text End
    entry $top.range.end.val -width 11 -font $text_font -relief sunken \
	-textvariable text_end_$mode
    bind $top.range.end.val <Return> "set_memrange text_end_$mode $mode"
    pack $top.range.end.lab -side left
    pack $top.range.end.val -side left -fill x

    frame $top.buttons
    pack $top.buttons -side bottom -fill x

    listbox $top.mem.addr -font $text_font -width 11 -height 20 \
	-relief sunken -yscrollcommand "$top.mem.scroll set"

    bind $top.mem.addr <Double-Button-1> \
	{toggle_breakpoint_addr %W [selection get]}
    
    listbox $top.mem.breakp -font $text_font -width 2 -height 20 \
	-relief sunken -yscrollcommand "$top.mem.scroll set"

    listbox $top.mem.lab -font $text_font -width 11 -height 20 -relief sunken \
	-yscrollcommand "$top.mem.scroll set"
    listbox $top.mem.opr -font $text_font -width 11 -height 20 -relief sunken \
	-yscrollcommand "$top.mem.scroll set"
    listbox $top.mem.opnds -font $text_font -width 25 -height 20 \
	-relief sunken -yscrollcommand "$top.mem.scroll set"
    pack $top.mem.breakp $top.mem.addr $top.mem.lab $top.mem.opr \
	$top.mem.opnds -side left -fill both -expand yes

    scrollbar $top.mem.scroll -command scroll_text_$mode -relief ridge
    pack $top.mem.scroll -side left -fill y

    button $top.buttons.dismiss -text "Dismiss" -command "wm withdraw $top" \
	 -bg yellow
    button $top.buttons.help -text "Help" -bg red \
	-command "goto_help_label {Text display window} 1"
    pack $top.buttons.dismiss -side left
    pack $top.buttons.help -side right
}

proc scroll_text_super {args} {
    eval .super_text.mem.breakp yview $args
    eval .super_text.mem.addr yview $args
    eval .super_text.mem.lab yview $args
    eval .super_text.mem.opr yview $args
    eval .super_text.mem.opnds yview $args
}

proc scroll_text_user {args} {
    eval .user_text.mem.breakp yview $args
    eval .user_text.mem.addr yview $args
    eval .user_text.mem.lab yview $args
    eval .user_text.mem.opr yview $args
    eval .user_text.mem.opnds yview $args
}

wm title .super_text "ISEM: Supervisor Text"
make_delete_withdraw .super_text
wm title .user_text "ISEM: User Text"
make_delete_withdraw .user_text

###############################################################################
# toplevel widgets to display supervisor and user data
###############################################################################
foreach mode {super user} {
    set top [format {.%s_data} $mode]

    toplevel $top
    wm withdraw $top

    frame $top.mem
    pack $top.mem -side top -fill both -expand 1

    frame $top.range
    pack $top.range -side top

    frame $top.range.start
    frame $top.range.end
    button $top.range.update -width 6 -text "Update" -bg lightgreen\
	-command "show_data $mode"
    pack $top.range.update $top.range.start $top.range.end -side left

    global data_start_$mode data_end_$mode

    label $top.range.start.lab -text Start
    entry $top.range.start.val -width 11 -font $data_font -relief sunken \
	-textvariable data_start_$mode
    bind $top.range.start.val <Return> "set_memrange data_start_$mode $mode"
    pack $top.range.start.lab -side left
    pack $top.range.start.val -side left -fill x

    label $top.range.end.lab -text End
    entry $top.range.end.val -width 11 -font $data_font -relief sunken \
	-textvariable data_end_$mode
    bind $top.range.end.val <Return> "set_memrange data_end_$mode $mode"
    pack $top.range.end.lab $top.range.end.val -side left

    frame $top.buttons
    pack $top.buttons -side bottom -fill x

    listbox $top.mem.lab -font $data_font -width 11 -height 20 -relief sunken \
	-yscrollcommand "$top.mem.scroll set"
    listbox $top.mem.mem -font $data_font -width 11 -height 20 -relief sunken \
	-yscrollcommand "$top.mem.scroll set"
    listbox $top.mem.char -font $data_font -width 5 -height 20 -relief sunken \
	-yscrollcommand "$top.mem.scroll set"
    pack $top.mem.lab $top.mem.mem $top.mem.char -side left \
	-fill both -expand 1

    scrollbar $top.mem.scroll -command scroll_data_$mode -relief ridge
    pack $top.mem.scroll -side left -fill y

    button $top.buttons.dismiss -text "Dismiss" -command "wm withdraw $top" \
	 -bg yellow
    button $top.buttons.help -text "Help" -bg red \
	-command "goto_help_label {Data display window} 1"
    pack $top.buttons.dismiss -side left
    pack $top.buttons.help -side right
}

wm title .super_data "ISEM: Supervisor Data"
make_delete_withdraw .super_data
wm title .user_data "ISEM: User Data"
make_delete_withdraw .user_data


###############################################################################
# a simple view of the registers
###############################################################################

toplevel .gpregs
#bind .gpregs <Map> update_display
wm withdraw .gpregs
wm title .gpregs "ISEM: Registers"
make_delete_withdraw .gpregs

#------------------------------------------------------------------------------
# The dismiss and help buttons
#------------------------------------------------------------------------------
frame .gpregs.buttons
pack .gpregs.buttons -side bottom -fill x

button .gpregs.buttons.dismiss -text "Dismiss" -command "wm withdraw .gpregs" \
     -bg yellow
button .gpregs.buttons.update -text "Update" -bg lightgreen \
    -command "update_display 1"
pack .gpregs.buttons.dismiss .gpregs.buttons.update -side left
button .gpregs.buttons.help -text "Help" -bg red \
    -command "goto_help_label {Register window} 1"
pack .gpregs.buttons.help -side right

#------------------------------------------------------------------------------
# display the processor state registers
#------------------------------------------------------------------------------
frame .gpregs.pstate
pack .gpregs.pstate -side top -expand 1 -fill x

frame .gpregs.pstate.y
frame .gpregs.pstate.psr
frame .gpregs.pstate.wim
frame .gpregs.pstate.tbr

pack .gpregs.pstate.y -side left -anchor sw
pack .gpregs.pstate.psr -side left -expand 1
pack .gpregs.pstate.wim -side left -anchor s -expand 1
pack .gpregs.pstate.tbr -side left

label .gpregs.pstate.y.lab -font $gpreg_font -text Y -bg grey75
pack .gpregs.pstate.y.lab -side left
button .gpregs.pstate.y.val -font $gpreg_font -textvariable y -relief groove \
    -width 7 -command "edit_reg y" -bg lightblue
pack .gpregs.pstate.y.val -side left

label .gpregs.pstate.wim.lab -font $gpreg_font -text WIM
pack .gpregs.pstate.wim.lab -side left
button .gpregs.pstate.wim.val -font $gpreg_font -textvariable wim \
    -relief sunken
pack .gpregs.pstate.wim.val -side left

frame .gpregs.pstate.psr.labs
frame .gpregs.pstate.psr.vals
pack .gpregs.pstate.psr.labs .gpregs.pstate.psr.vals -side top

frame .gpregs.pstate.tbr.labs
frame .gpregs.pstate.tbr.vals
pack .gpregs.pstate.tbr.labs .gpregs.pstate.tbr.vals -side top

label .gpregs.pstate.psr.labs.blank -width 3 -font $gpreg_font -text " "
label .gpregs.pstate.psr.labs.impl -width 4 -font $gpreg_font -text impl
label .gpregs.pstate.psr.labs.ver -width 3 -font $gpreg_font -text ver
label .gpregs.pstate.psr.labs.n -width 1 -font $gpreg_font -text n
label .gpregs.pstate.psr.labs.z -width 1 -font $gpreg_font -text z
label .gpregs.pstate.psr.labs.v -width 1 -font $gpreg_font -text v
label .gpregs.pstate.psr.labs.c -width 1 -font $gpreg_font -text c
label .gpregs.pstate.psr.labs.res -width 3 -font $gpreg_font -text res
label .gpregs.pstate.psr.labs.ec -width 2 -font $gpreg_font -text EC
label .gpregs.pstate.psr.labs.ef -width 2 -font $gpreg_font -text EF
label .gpregs.pstate.psr.labs.pil -width 4 -font $gpreg_font -text PIL
label .gpregs.pstate.psr.labs.s -width 1 -font $gpreg_font -text S
label .gpregs.pstate.psr.labs.ps -width 2 -font $gpreg_font -text PS
label .gpregs.pstate.psr.labs.et -width 2 -font $gpreg_font -text ET
label .gpregs.pstate.psr.labs.cwp -width 5 -font $gpreg_font -text CWP
pack .gpregs.pstate.psr.labs.blank .gpregs.pstate.psr.labs.impl \
    .gpregs.pstate.psr.labs.ver .gpregs.pstate.psr.labs.n \
    .gpregs.pstate.psr.labs.z .gpregs.pstate.psr.labs.v \
    .gpregs.pstate.psr.labs.c .gpregs.pstate.psr.labs.res \
    .gpregs.pstate.psr.labs.ec .gpregs.pstate.psr.labs.ef \
    .gpregs.pstate.psr.labs.pil .gpregs.pstate.psr.labs.s \
    .gpregs.pstate.psr.labs.ps .gpregs.pstate.psr.labs.et \
    .gpregs.pstate.psr.labs.cwp -side left

label .gpregs.pstate.psr.vals.lab -width 3 -font $gpreg_font -text PSR
label .gpregs.pstate.psr.vals.impl -width 4 -font $gpreg_font -relief sunken
label .gpregs.pstate.psr.vals.ver -width 3 -font $gpreg_font -relief sunken
label .gpregs.pstate.psr.vals.n -width 1 -font $gpreg_font \
    -textvariable psr_n -relief sunken
label .gpregs.pstate.psr.vals.z -width 1 -font $gpreg_font \
    -textvariable psr_z -relief sunken
label .gpregs.pstate.psr.vals.v -width 1 -font $gpreg_font \
    -textvariable psr_v -relief sunken
label .gpregs.pstate.psr.vals.c -width 1 -font $gpreg_font \
    -textvariable psr_c -relief sunken
label .gpregs.pstate.psr.vals.res -width 3 -font $gpreg_font -relief sunken
label .gpregs.pstate.psr.vals.ec -width 2 -font $gpreg_font \
    -textvariable psr_ec -relief sunken
label .gpregs.pstate.psr.vals.ef -width 2 -font $gpreg_font \
    -textvariable psr_ef -relief sunken
label .gpregs.pstate.psr.vals.pil -width 4 -font $gpreg_font \
    -textvariable psr_pil -relief sunken
label .gpregs.pstate.psr.vals.s -width 1 -font $gpreg_font \
    -textvariable psr_s -relief sunken
label .gpregs.pstate.psr.vals.ps -width 2 -font $gpreg_font \
    -textvariable psr_ps -relief sunken
label .gpregs.pstate.psr.vals.et -width 2 -font $gpreg_font \
    -textvariable psr_et -relief sunken
label .gpregs.pstate.psr.vals.cwp -width 5 -font $gpreg_font \
    -textvariable psr_cwp -relief sunken
pack .gpregs.pstate.psr.vals.lab .gpregs.pstate.psr.vals.impl \
    .gpregs.pstate.psr.vals.ver .gpregs.pstate.psr.vals.n \
    .gpregs.pstate.psr.vals.z .gpregs.pstate.psr.vals.v \
    .gpregs.pstate.psr.vals.c .gpregs.pstate.psr.vals.res \
    .gpregs.pstate.psr.vals.ec .gpregs.pstate.psr.vals.ef \
    .gpregs.pstate.psr.vals.pil .gpregs.pstate.psr.vals.s \
    .gpregs.pstate.psr.vals.ps .gpregs.pstate.psr.vals.et \
    .gpregs.pstate.psr.vals.cwp -side left

label .gpregs.pstate.tbr.labs.blank -font $gpreg_font -text " " -width 3
label .gpregs.pstate.tbr.labs.tba -font $gpreg_font -text TBA -width 5
label .gpregs.pstate.tbr.labs.tt -font $gpreg_font -text TT -width 2
label .gpregs.pstate.tbr.labs.blank3 -font $gpreg_font -text " " -width 1
pack .gpregs.pstate.tbr.labs.blank .gpregs.pstate.tbr.labs.tba \
    .gpregs.pstate.tbr.labs.tt .gpregs.pstate.tbr.labs.blank3 -side left

set tbr_tba 00000
set tbr_tt 00
label .gpregs.pstate.tbr.vals.lab -font $gpreg_font -text TBR
label .gpregs.pstate.tbr.vals.tba -font $gpreg_font -textvariable tbr_tba \
    -relief sunken
label .gpregs.pstate.tbr.vals.tt -font $gpreg_font -textvariable tbr_tt \
    -relief sunken
label .gpregs.pstate.tbr.vals.blank3 -font $gpreg_font -text 0 -relief sunken
pack .gpregs.pstate.tbr.vals.lab .gpregs.pstate.tbr.vals.tba \
    .gpregs.pstate.tbr.vals.tt .gpregs.pstate.tbr.vals.blank3 -side left

#------------------------------------------------------------------------------
# display the program counter, next program counter and instruction
#------------------------------------------------------------------------------
frame .gpregs.instr
pack .gpregs.instr -side top -fill x

frame .gpregs.instr.pc
frame .gpregs.instr.npc
pack .gpregs.instr.pc -side left
pack .gpregs.instr.npc -side left -expand 1

label .gpregs.instr.pc.lab -font $gpreg_font -text PC -bg grey75
pack .gpregs.instr.pc.lab -side left
button .gpregs.instr.pc.val -font $gpreg_font -textvariable pc -relief groove \
    -width 7 -command "edit_reg pc"  -bg lightblue
pack .gpregs.instr.pc.val -side left

label .gpregs.instr.npc.lab -font $gpreg_font -text nPC -bg grey75
pack .gpregs.instr.npc.lab -side left
label .gpregs.instr.npc.val -font $gpreg_font -textvariable npc \
    -relief sunken -width 11
pack .gpregs.instr.npc.val -side left

frame .gpregs.instr.val
pack .gpregs.instr.val -side left

label .gpregs.instr.val.label -font $gpreg_font -text "Next Instr." -bg grey75
label .gpregs.instr.val.annul -font $gpreg_font -width 7 -bg grey75 \
    -textvariable instr_annul
frame .gpregs.instr.val.instr -relief sunken -bd 2
label .gpregs.instr.val.instr.lab -anchor w -font $gpreg_font \
    -textvariable instr_lab -width 9
label .gpregs.instr.val.instr.op -anchor w -font $gpreg_font \
    -textvariable instr_op -width 9
label .gpregs.instr.val.instr.opnds -anchor w -font $gpreg_font \
    -textvariable instr_opnds -width 20

pack .gpregs.instr.val.label .gpregs.instr.val.annul .gpregs.instr.val.instr \
    .gpregs.instr.val.instr.lab .gpregs.instr.val.instr.op \
    .gpregs.instr.val.instr.opnds -side left

# register names

#------------------------------------------------------------------------------
# build the register display
#------------------------------------------------------------------------------
set reg 0
frame .gpregs.regs
pack .gpregs.regs -side top

for {set row 0} {$row < 4} {incr row 1} {
    label .gpregs.regs.lab$row -font $gpreg_font -width 9 -anchor e -bg grey75
    grid .gpregs.regs.lab$row -row $row -column 0
    for {set col 1} {$col < 9} {incr col 1} {
	set r$reg 0x00000000
	button .gpregs.regs.$reg -font $gpreg_font -relief groove \
	    -width 7 -textvariable r$reg -command "edit_reg r$reg" \
	    -bg lightblue
	grid .gpregs.regs.$reg -row $row -column $col
	incr reg 1
    }
}

proc set_reg_view_window {} {
    global reg_view rname
    set reg_view window

    set rname(0) "%g0";  set rname(1) "%g1";  set rname(2) "%g2"
    set rname(3) "%g3";  set rname(4) "%g4";  set rname(5) "%g5"
    set rname(6) "%g6";  set rname(7) "%g7"
    set rname(8) "%o0";  set rname(9) "%o1";  set rname(10) "%o2"
    set rname(11) "%o3"; set rname(12) "%o4"; set rname(13) "%o5"
    set rname(14) "%sp"; set rname(15) "%o7"
    set rname(16) "%l0"; set rname(17) "%l1"; set rname(18) "%l2"
    set rname(19) "%l3"; set rname(20) "%l4"; set rname(21) "%l5"
    set rname(22) "%l6"; set rname(23) "%l7"
    set rname(24) "%i0"; set rname(25) "%i1"; set rname(26) "%i2"
    set rname(27) "%i3"; set rname(28) "%i4"; set rname(29) "%i5"
    set rname(30) "%fp"; set rname(31) "%i7"

    for {set row 0} {$row < 4} {incr row 1} {
	.gpregs.regs.lab$row configure \
	    -text [format "%s-%s" $rname([expr $row*8]) \
		       $rname([expr $row*8 + 7])]
    }
}

proc set_reg_view_regular {} {
    global reg_view rname
    set reg_view regular

    for {set i 0} {$i < 32} {incr i 1} {
	set rname($i) [format "%%r%d" $i]
    }

    for {set row 0} {$row < 4} {incr row 1} {
	.gpregs.regs.lab$row configure \
	    -text [format "%s-%s" $rname([expr $row*8]) \
		       $rname([expr $row*8 + 7])]
    }
}

set_reg_view_regular

#------------------------------------------------------------------------------
# build the register edit area
#  the register edit area uses two global variables -- ed_reg and ed_val -- 
#  to keep track of which register is being edited and what it's new value
#  is supposed to be.
#------------------------------------------------------------------------------
frame .gpregs.edit
pack .gpregs.edit -side top

label .gpregs.edit.lab -font $gpreg_font -text "Edit "
label .gpregs.edit.reg -width 10 -textvariable ed_reg_labels -anchor w
entry .gpregs.edit.val -font $gpreg_font -width 20 -textvariable ed_val \
    -relief sunken -width 11
bind .gpregs.edit.val <Return> set_edreg
button .gpregs.edit.set -text Set -command set_edreg
pack .gpregs.edit.lab .gpregs.edit.reg .gpregs.edit.val .gpregs.edit.set \
    -side left

proc edit_reg {reg} {
    upvar \#0 $reg r
    global ed_reg ed_val ed_reg_labels
    global rname

    if { $reg != "pc" && $reg != "npc" && $reg != "y"  } {
        set ed_reg_labels [format {%s} \
	    $rname([string range $reg 1 end])]
    } else {
	set ed_reg_labels [format {%%%s} $reg]
    }
    set ed_reg $reg
    set ed_val $r
}

proc set_edreg {} {
    global ed_reg ed_val proc_mode
    upvar \#0 $ed_reg r

    if { $ed_reg != "r0" } {
	set r [convert_val $ed_val $proc_mode $r]
	isem_reg set $ed_reg $r
    } else {
	set ed_val 0x00000000
    }
}

# Tue Feb 13 17:41:04 2001 Ackley: use 'scan' just for number format
# checking, not for its results.  On Linux anyway, scan %i (now)
# follows the strtol semantics (rather than strtoul), and produces
# 0x7fffffff when given 0xffffffff.  Tcl's native number interpreter,
# though, apparently (still) does not, so just use $val.

proc convert_val {val mode default} {
    if {[scan $val %i ignore] == 1} {    
	set value [format {0x%.8x} $val] 
    } else {
	upvar \#0 [format {%s_syms} $mode] syms
	if { [info exists syms($val)] } {
	    set value [lindex $syms($val) 0]
	} else {
	    set value $default
	}
    }
    return $value
}

set ed_reg r0
set ed_val 0x00000000

###############################################################################
# supervisor and user symbols
###############################################################################
set super_sort name
set user_sort name

foreach mode {super user} {
    set top [format {.%s_syms} $mode]

    toplevel $top
    wm withdraw $top

    frame $top.file -relief groove -bd 4
    frame $top.syms
    frame $top.sort
    frame $top.buttons
    pack $top.file -fill x
    pack $top.syms $top.sort -side top
    pack $top.buttons -side top -fill x

    label $top.file.label -text "File:"
    set file_var [format {%s_file} $mode]
    label $top.file.name -textvariable $file_var -anchor w
    pack $top.file.label -side left
    pack $top.file.name -side left -fill x -expand 1

    frame $top.syms.syms
    label $top.syms.syms.lab -text Symbol
    listbox $top.syms.syms.syms -font $sym_font -relief sunken \
	-yscrollcommand "$top.syms.scroll.bar set"
    pack $top.syms.syms.lab $top.syms.syms.syms -side top

    frame $top.syms.value
    label $top.syms.value.lab -text Value
    listbox $top.syms.value.vals -font $sym_font -relief sunken
    pack $top.syms.value.lab $top.syms.value.vals -side top
    frame $top.syms.scroll
    label $top.syms.scroll.text -text ""
    scrollbar $top.syms.scroll.bar -command scroll_$mode -relief ridge
    pack $top.syms.scroll.text -side top
    pack $top.syms.scroll.bar -side top -expand 1 -fill y

    pack $top.syms.syms $top.syms.value -side left
    pack $top.syms.scroll -side left -fill y

    label $top.sort.label -text "Sort by"
    set sort_var [format {%s_sort} $mode]
    radiobutton $top.sort.name -text Name -value name \
	-variable $sort_var -command "show_syms $mode"
    radiobutton $top.sort.value -text Value -value value \
	-variable $sort_var -command "show_syms $mode"
    pack $top.sort.label $top.sort.name $top.sort.value -side left

    button $top.buttons.dismiss -text "Dismiss" -command "wm withdraw $top" \
	 -bg yellow
    button $top.buttons.help -text "Help" -bg red \
	-command "goto_help_label {Symbol window} 1"
    pack $top.buttons.dismiss -side left
    pack $top.buttons.help -side right
}

wm title .super_syms "ISEM: Supervisor Symbols"
make_delete_withdraw .super_syms
wm title .user_syms "ISEM: User Symbols"
make_delete_withdraw .user_syms

###############################################################################
# supervisor and user breakpoints
###############################################################################

foreach mode {user super} {
    set top [format {.%s_break} $mode]
    toplevel $top
    wm withdraw $top

    frame $top.bp
    listbox $top.bp.labs -relief sunken -yscrollcommand "$top.bp.scroll set"
    listbox $top.bp.vals -relief sunken -yscrollcommand "$top.bp.scroll set"
    scrollbar $top.bp.scroll -command "scroll_bps $mode"
    pack $top.bp.labs -side left -fill x -expand 1
    pack $top.bp.vals -side left -fill x -expand 1
    pack $top.bp.scroll -side left -fill y

    set break_var [format {%s_break_var} $mode]
    global $break_var

    frame $top.edit
    button $top.edit.clear -text "Clear All" -command "clear_breaks $mode"
    button $top.edit.del -text Delete -command "rmv_break $break_var $mode"
    button $top.edit.add -text Add -command "set_bpoint $break_var $mode"
    entry $top.edit.val -width 20 -textvariable $break_var -relief sunken
    bind $top.edit.val <Return> "set_bpoint $break_var $mode"
    pack $top.edit.clear $top.edit.del -side left
    pack $top.edit.val $top.edit.add -side right

    frame $top.buttons
    button $top.buttons.dismiss -text "Dismiss" -command "wm withdraw $top" \
	 -bg yellow
    button $top.buttons.help -text "Help" -bg red \
	-command "goto_help_label {Breakpoint window} 1"
    pack $top.buttons.dismiss -side left
    pack $top.buttons.help -side right

    pack $top.bp -side top -fill x -expand 1
    pack $top.edit -side top
    pack $top.buttons -side top -fill x -expand 1
}

proc scroll_bps {mode top} {
    set base [format {.%s_break.bp} $mode]
    $base.vals yview $top
    $base.labs yview $top
}

wm title .user_break "User Breakpoints"
make_delete_withdraw .user_break
wm title .super_break "Supervisor Breakpoints"
make_delete_withdraw .super_break

###############################################################################
# ---- devices -----
###############################################################################

#------------------------------------------------------------------------------
# the device run list
#------------------------------------------------------------------------------
set dev_run_list {}
proc run_devices {} {
    global dev_run_list

    foreach dev_proc $dev_run_list {
	$dev_proc
    }
}

proc add_run {dev_proc} {
    global dev_run_list

    lappend dev_run_list $dev_proc
}

proc rmv_run {dev_proc} {
    global dev_run_list

    set index [lsearch -exact $dev_run_list $dev_proc]
    if { $index != -1 } {
	set dev_run_list [lreplace $dev_run_list $index $index]
    }    
}

#------------------------------------------------------------------------------
# the gx device
#------------------------------------------------------------------------------
proc gx {op addr bytemask value} {

    if {$op == "read"} {
	return [.gx.display read]
    } else {
	.gx.display write $value $addr
    }
}

isem_device gx $gx_address $gx_mode

#------------------------------------------------------------------------------
# the console device
#------------------------------------------------------------------------------
set in_count 0

proc console {op addr bytemask value} {
    global in_count

    if {$op == "write"} {
	.conout.text.text configure -state normal
	.conout.text.text insert end [format "%c" $value]
	.conout.text.text yview -pickplace end
	.conout.text.text configure -state disabled
    } else {
	set cur_index [.conin.text.text index "1.0 + $in_count chars"]
	scan $cur_index %i cur_line 
	
	set end_index [.conin.text.text index end]
	scan $end_index "%i.%i" last_line last_char
	
	if {$last_char == "0"} {
	    incr last_line -1
	}
	if {$last_line == $cur_line} {
	    return 0xffffffff
	} else {
	    incr in_count 1
	    scan [.conin.text.text get $cur_index] %c res
	    return $res
	}
    }
}

isem_device console $console_address $console_mode

#------------------------------------------------------------------------------
# the halt device
#------------------------------------------------------------------------------
proc halt {op addr bytemask value} {
    global stop_run proc_state

    set stop_run 1
}

isem_device halt $halt_address $halt_mode

#------------------------------------------------------------------------------
# the timer device
#------------------------------------------------------------------------------
set timer_period 0x00000000
set timer_count 0x00000000
set timer_interrupt 0

proc timer_tick {} {
    global timer_period timer_count
     if {$timer_period != 0} {
	set timer_count [format {0x%.8x} [expr $timer_count+1]]
	if {$timer_count == $timer_period} {
	    timer_interrupt 1
	    set timer_count 0x00000000
	}
    }
}

proc timer_interrupt {state} {
    global timer_interrupt timer_int_level

    set timer_interrupt $state
    isem_interrupt $timer_int_level $state
}

proc timer {op addr bytemask value} {
    global timer_period

    #puts [format "uartcall %s %d %d %d" $op $addr $bytemask $value]
    timer_interrupt 0
    if {$op == "write"} {
	set_timer_period $value
    } else {
        scan $timer_count 0x%x woof
        return $woof
    }
}

proc set_timer_period {period} {
    global timer_period timer_count

    set old_period $timer_period
    set timer_period [format {0x%.8x} $period]
    set timer_count 0x00000000
    if {$timer_period != 0 && $old_period == 0} {
	add_run timer_tick
    }
    if {$timer_period == 0 && $old_period != 0} {
	rmv_run timer_tick
    }
}

isem_device timer $timer_address $timer_mode

#-----------------------------------------------------------------------------
# the UART device
#-----------------------------------------------------------------------------
#.uart.keybd.txout.text tag configure uart_curr_tx -background blue\
#    -foreground white
#.uart.keybd.rxin.text tag configure uart_curr_rx -background blue\
#    -foreground white

proc uart_interrupt {state} {
    global UART_interrupt uart_int_level
    set UART_interrupt $state
    isem_interrupt $uart_int_level $state
}

proc uart_tx_tick {} {
    global UART_Tx_count UART_TXscale
    global UART_stat UART_ctrl
    global UART_sending UART_TXReg

    incr UART_Tx_count -1
    if { $UART_Tx_count == 0 } {
	.uart.keybd.txout.text configure -state normal
	if { $UART_sending > 126 } {
	    .uart.keybd.txout.text insert end [format "\\x%.2x" $UART_sending]
	} else {
	    .uart.keybd.txout.text insert end [format "%c" $UART_sending]
	}
	.uart.keybd.txout.text yview -pickplace end
	.uart.keybd.txout.text configure -state disabled
	
	if { [string compare $UART_TXReg "****"] != 0 } {
	    set UART_sending $UART_TXReg
	    set UART_TXReg "****"
	    set UART_stat [format 0x%.2x [expr $UART_stat | 1]]
	    .uart.reg.stat.bit0 configure -text "1"
	    if { $UART_ctrl & 1 } {
		uart_interrupt 1
	    }
	    set UART_Tx_count [expr ($UART_ctrl >> 2) * $UART_TXscale]
	} else {
	    set UART_sending "****"
	}
    }
}

proc uart_rx_tick {} {
    global UART_Rx_count UART_src_count UART_src
    global UART_RXReg UART_receiving
    global UART_stat UART_ctrl

    incr UART_Rx_count -1
    if { $UART_Rx_count == 0 } {
	if { [string compare $UART_RXReg "****"] == 0 } {
	    if { $UART_ctrl & 2 } {
		uart_interrupt 1
	    }
	} else {
	    # overrun error
	    set UART_stat [format 0x%.2x [expr $UART_stat | 4]]
	    .uart.reg.stat.bit2 configure -text "1"
	}
	.uart.reg.stat.bit1 configure -text "1"
	set UART_stat [format 0x%.2x [expr $UART_stat | 2]]
	set UART_RXReg $UART_receiving
	set UART_receiving "****"
	if { ($UART_src_count == 0) && ($UART_src != "none") } {
	    uart_getch
	}
    }
}

proc uart_src_tick {} {
    global UART_src_count UART_src UART_receiving

    incr UART_src_count -1
    if { ($UART_src_count == 0) && ($UART_src != "none") && ($UART_receiving == "****") } {
	uart_getch
    }
}

proc uart_getch {} {
    global UART_src UART_src_count
    global UART_srate
    global UART_ctrl
    global UART_RXscale UART_Rx_count
    global UART_receiving
    global UART_inchar

    if { $UART_src == "key" } {
	set cur_index [.uart.keybd.rxin.text index "1.0 + $UART_inchar chars"]
	scan $cur_index %i cur_line 
	
	set end_index [.uart.keybd.rxin.text index end]

	if { [string compare $cur_index $end_index] == 0 } {
	    # out of characters
	    set UART_src none
	} else {
	    incr UART_inchar
	    scan [.uart.keybd.rxin.text get $cur_index] %c res
	    set UART_src_count $UART_srate
	    set UART_receiving [format "0x%.2x" $res]
	    set UART_Rx_count [expr ($UART_ctrl>>2) * $UART_RXscale]
	}
    } elseif { $UART_src == "file" } {
	global UART_file
	set ch [read $UART_file 1]
	if { [string compare $ch ""] == 0 } {
	    # out of characters
	    set UART_src none
	} else {
	    scan $ch %c res
	    set UART_src_count $UART_srate
	    set UART_receiving [format "0x%.2x" $res]
	    set UART_Rx_count [expr ($UART_ctrl>>2) * $UART_RXscale]
	}
    } elseif { $UART_src == "rand_file" } {
	global UART_file
	gets $UART_file line
	set stat [scan $line "%d.%1s" count ch]
	if { $stat == 0 } {
	    # out of characters
	    set UART_src none
	} else {
	    if { $stat == 1 } {
		if { [string index $line [expr [string length $line] - 1]] == " " } {
		    set res 32
		} else {
		    set res 10
		}
	    } else {
		scan $ch %c res
	    }
	    puts "uart returning $res"
	    set UART_src_count $count
	    set UART_receiving [format "0x%.2x" $res]
	    set UART_Rx_count [expr ($UART_ctrl>>2) * $UART_RXscale]
	}
    }
}
    
proc uart_timer {}  {
    global UART_Tx_count UART_Rx_count UART_src_count
    global UART_running

    if { $UART_Tx_count != 0 } {
	uart_tx_tick
    } 
    if { $UART_Rx_count != 0 } {
	uart_rx_tick
    } 
    if { $UART_src_count != 0 } {
	uart_src_tick
    }
    if { ($UART_src_count==0) && ($UART_Tx_count==0) && ($UART_Rx_count==0) } {
	set UART_running 0
	rmv_run uart_timer
    }
}

proc uart {op addr bytemask value} {
    global UART_TXReg UART_sending UART_RXReg
    global UART_stat UART_ctrl
    global UART_Tx_count UART_TXscale
    global UART_running

    set uart_reg_addr [expr $addr & 0xf]
    switch -exact -- $uart_reg_addr {
	0 {
	    if {[string compare $op write] == 0} {
		set UART_ctrl $value
		uart_disp_reg creg $UART_ctrl
	    } else {
		scan $UART_stat 0x%x uart_byte
		uart_interrupt 0
		# clear the overrun bit if it's set
		if { $UART_stat & 4 } {
		    set UART_stat [format 0x%.2x [expr $UART_stat & 0xfb]]
		    .Uart.reg.stat.bit2 configure -text "0"
		}
		return $uart_byte
	    }
	}	
	4 {
	    if { [string compare $op write] == 0 } {
		if { [string compare $UART_sending "****"] == 0 } {
		    set UART_sending [format 0x%.2x $value]
		    set UART_Tx_count [expr ($UART_ctrl >> 2) * $UART_TXscale]
		    if { $UART_running == 0 } {
			set UART_running 1
			add_run uart_timer
		    }
		} else {
		    set UART_TXReg [format 0x%.2x $value]
		    set UART_stat [format 0x%.2x [expr $UART_stat & 0xfe]]
		    .uart.reg.stat.bit0 configure -text "0"
		}
	    } else {
		if { [string compare $UART_RXReg "****"] != 0 } {
		    scan $UART_RXReg 0x%x uart_byte
		    set UART_RXReg "****"
		    set UART_stat [format 0x%.2x [expr $UART_stat & 0xfd]]
		    .uart.reg.stat.bit1 configure -text "0"
		    return $uart_byte
		} else {
		    return 0
		}
	    }
	}	
    }
}
##################################################################

proc uart_tx_and_rx {}  {
    global UartRxInput UartTxOutput 
    global UartRxInFileID UartTxOutFileID 
    global UartTXReg UART_RXReg
    global UartRxIndex UartRxIndexCount
    global UART_stat UartMask
    
    set uartbitmask0 $UartMask
    set uartbitmask1 [expr $UartMask << 1]
    set uartbitmask2 [expr $UartMask << 2]
    
    #  if something in TX register, then
    #  if txout = file, write it to file and set status bit
    #  elseif txout = discard, set status bit
    #  else do nothing
    #  
    #  if nothing in RX register, then
    #  if rxin = file || keyboard, read it from textwindow, put in RXwindow, 
    #  and set status bit
    #  else do nothing
    
    if {[expr $UART_stat & $uartbitmask0] == 0}  {
	if {[string compare $UartTxOutput file] == 0}  {
	    set uart_char [format "%c" $UartTXReg]
	    puts -nonewline $UartTxOutFileID $uart_char 
	    set UART_stat [expr $UART_stat ^ $uartbitmask0]
	} elseif {[string compare $UartTxOutput discard] == 0}  {
	    set UART_stat [expr $UART_stat ^ $uartbitmask0]
	}
    }
    
    if {[expr $UART_stat & $uartbitmask1] == 0}  {
	if {[string compare $UartRxInput file] == 0 || \
		[string compare $UartRxInput keyboard] == 0} {
	    .uart.keybd.rxin.text tag remove uart_curr_rx \
		"$UartRxIndex + $UartRxIndexCount chars"
	    #set UartRxIndex {[$UartRxIndex + 1 chars]}
	    set UartRxIndexCount [expr $UartRxIndexCount + 1]
	    set uart_char [.uart.keybd.rxin.text get \
			       "$UartRxIndex + $UartRxIndexCount chars"]
	    .uart.keybd.rxin.text tag add uart_curr_rx \
		"$UartRxIndex + $UartRxIndexCount chars"
	    scan $uart_char "%c" uart_temp
	    .uart.line1.regRX.value config -text [format "%#x" $uart_temp]
	    set UART_RXReg [format "%#x" $uart_temp]
	    set UART_stat [expr $UART_stat ^ $uartbitmask1]
	}
    }
}

proc uart_clear {} {
    global UartTxInput UartRxInput UartTxOutput UartRxOutput 
    global UartTxInFileID UartRxInFileID UartTxOutFileID UartRxOutFileID
    global UartTXReg UART_RXReg
    global UART_stat UART_ctrl UartMask
    global UartTxIndex UartTxIndexCount
    
    set uartbitmask0 $UartMask
    set uartbitmask1 [expr $UartMask << 1]
    set uartbitmask2 [expr $UartMask << 2]
    set uartbitmask3 [expr $UartMask << 3]
    set uartbitmask4 [expr $UartMask << 4]
    set uartbitmask5 [expr $UartMask << 5]
    
    #  if nothing in TX register && TX interrupt enabled, then
    #  if txin = file || keyboard, read it from textwindow, put in TXwindow,
    #      and set status bit
    #  else do nothing
    #  
    #  if something in RX register && RX interrupt enabled, then
    #  if rxout = file, write it to file and set status bit
    #elseif rxout = discard, set status bit
    #  else do nothing
    
    # was it a tx interrupt ?
    if {[expr $UART_stat & $uartbitmask0] && [expr $UART_ctrl & $uartbitmask0]} {
	if {[string compare $UartTxInput file] == 0 || \
		[string compare $UartTxInput keyboard] == 0}  {
	    .uart.keybd.txout.text tag remove uart_curr_tx \
		"$UartTxIndex + $UartTxIndexCount chars"
	    set UartTxIndexCount [expr $UartTxIndexCount + 1]
	    set uart_char [.uart.keybd.txout.text get \
			       "$UartTxIndex + $UartTxIndexCount chars"]
	    .uart.keybd.txout.text tag add uart_curr_tx \
		"$UartTxIndex + $UartTxIndexCount chars"
	    scan $uart_char "%c" uart_temp
	    .uart.line1.regTX.value config -text [format "%#x" $uart_temp]
	    set UartTXReg [format "%#x" $uart_temp]
	    set UART_stat [expr $UART_stat ^ $uartbitmask0]
	}
    }
    
    # was it a rx interrupt?
    if {[expr $UART_stat & $uartbitmask1] > 0 && \
	    [expr $UART_ctrl & $uartbitmask1] > 0} {
	if {[string compare $UartRxOutput file] == 0}  {
	    set uart_char [format "%c" $UART_RXReg]
	    puts -nonewline $UartRxOutFileID $uart_char 
	    set UART_stat [expr $UART_stat ^ $uartbitmask1]
	} elseif {[string compare $UartRxOutput discard] == 0}  {
	    set UART_stat [expr $UART_stat ^ $uartbitmask1]
	} else {}
    }
}

proc uart_ovr_check {}  {
    global UartTxInput UartRxInput UartTxOutput UartRxOutput 
    global UartTxInFileID UartRxInFileID UartTxOutFileID UartRxOutFileID
    global UartTXReg UART_RXReg
    global UART_stat UART_ctrl UartMask
    global UartRxIndex UartRxIndexCount
    
    set uartbitmask1 [expr $UartMask << 1]
    
    if {[expr $UART_stat & $uartbitmask1] > 0}  {
	if {[string compare $UartRxInput file] == 0 || \
		[string compare $UartRxInput keyboard] == 0} {
	    .uart.keybd.rxin.text tag remove uart_curr_rx \
		"$UartRxIndex + $UartRxIndexCount chars"
	    set UartRxIndexCount [expr $UartRxIndexCount + 1]
	    set uart_char [.uart.keybd.rxin.text get \
			       "$UartRxIndex + $UartRxIndexCount chars"]
	    .uart.keybd.rxin.text tag add uart_curr_rx \
		"$UartRxIndex + $UartRxIndexCount chars"
	    scan $uart_char "%c" uart_temp
	    .uart.line1.regRX.value config -text [format "%#x" $uart_temp]
	    set UART_RXReg [format "%#x" $uart_temp]
	    set UART_stat [expr $UART_stat ^ $uartbitmask1]
	}
    }
}

isem_device uart $uart_address $uart_mode


###############################################################################
# this is where it starts!
###############################################################################

set total_cycles 0

isem_debug "Booting supervisor from $rom"
set load_mode super

set stop_run 0
set step_super 0
set update_super 0
set step_user 1
set update_user 1
update

if { "ok" == [load_file $rom] } {
    set_status_message "Running supervisor initialization..."
    driver
    set_state_regs
    set_gp_regs
    set_status_message "tk ISEM version Release $release ready"
} else {
    update
}

.conout.text.text yview -pickplace 0

set load_mode user
.loadfile.user.load configure -state normal
.loadfile.super.load configure -state normal
.run_stop configure -text Run -command run_button

.uprate set 1