#!/usr/bin/wish -f
#
#	xvapers
#
#	This TCL/TK program provides an interactive visual interface
#	for testing and debugging code using the TTL_VAPERS library.
#	To use this script, you will need to have wish installed and
#	you'll have to modify the first line of this file to reflect
#	the path to wish.  Popular places for wish include:
#
#	/usr/bin/wish  /usr/local/bin/wish  /usr/bin/X11/wish
#
#	There are also a few things you may need to customize.
#
#	There are a bunch of things within xvapers that rely on
#	having /proc.  If you don't have this, several features
#	need to be disabled by setting useproc to 0:

set useproc 1

#	If useproc is 0 and you terminate execution of a TTL_VAPERS
#	application unexpectedly, you might find that xvapers still
#	thinks the application is around because it sees the status
#	file.  This bug is now documented, so it is a feature.  ;-)
#
#	There are a couple of places where xvapers invokes an xterm.
#	It doesn't really need to be xterm, just something similar.
#	In any case, set the path of xterm (or perhaps color_xterm):

set xterm "/usr/bin/X11/xterm"

#	If useproc is 1, you may be able to run a debugger on a PE
#	process -- a very nifty feature.  If you want to do this, you
#	will probably want to add a debugging flag or two to the
#	Makefile for compiling your TTL_VAPERS applications, but you
#	can get at least some info even without any options.  We use
#	gdb as the debugger.  Set the path for your debugger (which
#	must be able to attach to a running process like gdb) here:

set gdb "/usr/bin/gdb"

#	Another feature of this script allows you to change the UNIX
#	priority of a PE process to simulate a slow processor.  This
#	is done using the renice command.  The path for renice is:

set renice "/usr/bin/renice"

#	Notice that renice generally only allows the priority to be
#	restored if it is run as root.  This script doesn't check.
#
#	We also need the path for the kill command to send signals:

set kill "/bin/kill"

#	Finally, you need to set the path for the two bitmaps and the
#	documentation files used by this script:

set vaperspath "./"
set vapersicon [format "%svapersicon.xbm" $vaperspath]
set vaperswood [format "%svaperswood.xbm" $vaperspath]

#	Once you have set the above options correctly, things should
#	work reasonably without any changes to the rest of the script.
#	Then again, this is an alpha release for a reason.  ;-)
#
#	Enjoy.
#
#	1995 by Hank Dietz
#


wm title . "VAPERS"
wm iconname . "VAPERS"
wm iconbitmap . @$vapersicon

canvas .vapers -relief raised -borderwidth 1 -background #eed8c5919175 -width 3.75c -height 6c
.vapers create bitmap 1.85c 3c -bitmap @$vaperswood -foreground #8b855a8b2b1c -tag oak
.vapers create text 1.5c 1.25c -text PE3
.vapers create text 1.5c 2c -text PE2
.vapers create text 1.5c 2.75c -text PE1
.vapers create text 1.5c 3.5c -text PE0
.vapers create text 2.0c 4.625c -text power -justify right
set pe3 [.vapers create oval 0.625c 1.125c 0.875c 1.375c -fill #000000000000]
set pe2 [.vapers create oval 0.625c 1.875c 0.875c 2.125c -fill #000000000000]
set pe1 [.vapers create oval 0.625c 2.625c 0.875c 2.875c -fill #000000000000]
set pe0 [.vapers create oval 0.625c 3.375c 0.875c 3.625c -fill #000000000000]
set pwr [.vapers create oval 2.875c 4.5c 3.125c 4.75c -fill #000000000000]

pack .vapers

.vapers bind oak <1> {newstat}
.vapers bind oak <2> {newstat}
.vapers bind oak <3> {vdoc}


set power 0
set led "#000000000000"
set autoref 0

if {[file "exists" "/proc"] == 0} {
	useproc = 1
	puts stderr "/proc exists"
}

option add *Background #000
option add *Button.background #444
option add *Menubutton.background #444
option add *Menu.background #444
option add *Foreground #b90


after 1000 tick


proc tick {} {
	global power
	global autoref

	chkstat
	shostat

	if {$autoref == 1} {
		geninfo .status.stat.list
		after 1000 tick
	} elseif {$power == 1} {
		after 200 tick
	} else {
		after 1000 tick
	}
}


proc chkstat {} {
	global pe0_0 pe0_1 pe0_2 pe0_3 pe0_4 pe0_5 pe0_6 pe0_7
	global pe1_0 pe1_1 pe1_2 pe1_3 pe1_4 pe1_5 pe1_6 pe1_7
	global pe2_0 pe2_1 pe2_2 pe2_3 pe2_4 pe2_5 pe2_6 pe2_7
	global pe3_0 pe3_1 pe3_2 pe3_3 pe3_4 pe3_5 pe3_6 pe3_7
	global vapers_0 vapers_1 vapers_2 vapers_3
	global vapers_4 vapers_5 vapers_6 vapers_7
	global power
	global useproc


	if [info exists env(PAPERS_STATFILE)] {
		set statfile $env(PAPERS_STATFILE)
	} else {
		set statfile "VAPERS_status"
	}

	if {[file "isfile" $statfile] == 0} {
		clrstat
		set power 0
		return
	}


	set fd [open $statfile "RDONLY"]

	scan [read $fd 8] "%x" pe0_0
	scan [read $fd 8] "%x" pe0_1
	scan [read $fd 8] "%x" pe0_2
	scan [read $fd 8] "%x" pe0_3
	scan [read $fd 8] "%x" pe0_4
	scan [read $fd 8] "%x" pe0_5
	scan [read $fd 8] "%x" pe0_6
	scan [read $fd 8] "%x" pe0_7

	scan [read $fd 8] "%x" pe1_0
	scan [read $fd 8] "%x" pe1_1
	scan [read $fd 8] "%x" pe1_2
	scan [read $fd 8] "%x" pe1_3
	scan [read $fd 8] "%x" pe1_4
	scan [read $fd 8] "%x" pe1_5
	scan [read $fd 8] "%x" pe1_6
	scan [read $fd 8] "%x" pe1_7

	scan [read $fd 8] "%x" pe2_0
	scan [read $fd 8] "%x" pe2_1
	scan [read $fd 8] "%x" pe2_2
	scan [read $fd 8] "%x" pe2_3
	scan [read $fd 8] "%x" pe2_4
	scan [read $fd 8] "%x" pe2_5
	scan [read $fd 8] "%x" pe2_6
	scan [read $fd 8] "%x" pe2_7

	scan [read $fd 8] "%x" pe3_0
	scan [read $fd 8] "%x" pe3_1
	scan [read $fd 8] "%x" pe3_2
	scan [read $fd 8] "%x" pe3_3
	scan [read $fd 8] "%x" pe3_4
	scan [read $fd 8] "%x" pe3_5
	scan [read $fd 8] "%x" pe3_6
	scan [read $fd 8] "%x" pe3_7

	scan [read $fd 8] "%x" vapers_0
	scan [read $fd 8] "%x" vapers_1
	scan [read $fd 8] "%x" vapers_2
	scan [read $fd 8] "%x" vapers_3
	scan [read $fd 8] "%x" vapers_4
	scan [read $fd 8] "%x" vapers_5
	scan [read $fd 8] "%x" vapers_6
	scan [read $fd 8] "%x" vapers_7

	set power 1


	close $fd


	if {$useproc == 1} {
		if {[file "exists" [join "/proc/ $vapers_0" ""]] == 0} {
			clrstat
			set power 0
		}
	}
}


proc clrstat {} {
	global pe0_0 pe0_1 pe0_2 pe0_3 pe0_4 pe0_5 pe0_6 pe0_7
	global pe1_0 pe1_1 pe1_2 pe1_3 pe1_4 pe1_5 pe1_6 pe1_7
	global pe2_0 pe2_1 pe2_2 pe2_3 pe2_4 pe2_5 pe2_6 pe2_7
	global pe3_0 pe3_1 pe3_2 pe3_3 pe3_4 pe3_5 pe3_6 pe3_7
	global vapers_0 vapers_1 vapers_2 vapers_3
	global vapers_4 vapers_5 vapers_6 vapers_7


	set pe0_0 0
	set pe0_1 0
	set pe0_2 0
	set pe0_3 0
	set pe0_4 0
	set pe0_5 0
	set pe0_6 0
	set pe0_7 0

	set pe1_0 0
	set pe1_1 0
	set pe1_2 0
	set pe1_3 0
	set pe1_4 0
	set pe1_5 0
	set pe1_6 0
	set pe1_7 0

	set pe2_0 0
	set pe2_1 0
	set pe2_2 0
	set pe2_3 0
	set pe2_4 0
	set pe2_5 0
	set pe2_6 0
	set pe2_7 0

	set pe3_0 0
	set pe3_1 0
	set pe3_2 0
	set pe3_3 0
	set pe3_4 0
	set pe3_5 0
	set pe3_6 0
	set pe3_7 0

	set vapers_0 0
	set vapers_1 0
	set vapers_2 0
	set vapers_3 0
	set vapers_4 0
	set vapers_5 0
	set vapers_6 0
	set vapers_7 0
}


proc shostat {} {
	global pe0_0 pe0_1 pe0_2 pe0_3 pe0_4 pe0_5 pe0_6 pe0_7
	global pe1_0 pe1_1 pe1_2 pe1_3 pe1_4 pe1_5 pe1_6 pe1_7
	global pe2_0 pe2_1 pe2_2 pe2_3 pe2_4 pe2_5 pe2_6 pe2_7
	global pe3_0 pe3_1 pe3_2 pe3_3 pe3_4 pe3_5 pe3_6 pe3_7
	global vapers_0 vapers_1 vapers_2 vapers_3
	global vapers_4 vapers_5 vapers_6 vapers_7
	global power
	global pwr pe3 pe2 pe1 pe0 led

	.vapers delete $pwr
	if {$power == 0} {
set pwr [.vapers create oval 2.875c 4.5c 3.125c 4.75c -fill #000000000000]
	} else {
set pwr [.vapers create oval 2.875c 4.5c 3.125c 4.75c -fill #7fffbfffffff]
	}

	peled $pe3_1
	.vapers delete $pe3
set pe3 [.vapers create oval 0.625c 1.125c 0.875c 1.375c -fill $led]
	peled $pe2_1
	.vapers delete $pe2
set pe2 [.vapers create oval 0.625c 1.875c 0.875c 2.125c -fill $led]
	peled $pe1_1
	.vapers delete $pe1
set pe1 [.vapers create oval 0.625c 2.625c 0.875c 2.875c -fill $led]
	peled $pe0_1
	.vapers delete $pe0
set pe0 [.vapers create oval 0.625c 3.375c 0.875c 3.625c -fill $led]

}


proc peled {pout} {
	global power
	global led

	if {$power == 0} {
		set led "#000000000000"
		return
	}

	set t [expr $pout "&" 48]
	if {$t == 16} {
		set led "#7fffffff7fff"
	} elseif {$t == 32} {
		set led "#ffff00000000"
	} elseif {$t == 0} {
		set led "#000000000000"
	} else {
		set led "#ffffbfff0000"
	}
}


proc newstat {{w .status}} {
	global vapersicon
	global pe0_0 pe0_1 pe0_2 pe0_3 pe0_4 pe0_5 pe0_6 pe0_7
	global pe1_0 pe1_1 pe1_2 pe1_3 pe1_4 pe1_5 pe1_6 pe1_7
	global pe2_0 pe2_1 pe2_2 pe2_3 pe2_4 pe2_5 pe2_6 pe2_7
	global pe3_0 pe3_1 pe3_2 pe3_3 pe3_4 pe3_5 pe3_6 pe3_7
	global vapers_0 vapers_1 vapers_2 vapers_3
	global vapers_4 vapers_5 vapers_6 vapers_7
	global power
	global autoref reftxt
	global xterm renice


	catch {set autoref 0
	       destroy $w}
	toplevel $w
	wm geometry $w +100+100
	wm title $w "VAPERS Status And Control Panel"
	wm iconname $w "V Stat"
	wm iconbitmap $w @$vapersicon
	wm minsize $w 1 1


	frame $w.menu -borderwidth 2
	menubutton $w.menu.all -text "All PEs Menu" \
		-menu $w.menu.all.m -relief raised
	menu $w.menu.all.m
	$w.menu.all.m add command -label "Stop at next barrier" \
		-command {csignal 10}
	$w.menu.all.m add command -label "Continue from barrier" \
		-command {csignal 12}
	$w.menu.all.m add command -label "Stop now" \
		-command {pesignal 19}
	$w.menu.all.m add command -label "Continue now" \
		-command {pesignal 18}
	$w.menu.all.m add command -label "Kill" \
		-command {csignal 9}

	menubutton $w.menu.one -text "One PE Menu" \
		-menu $w.menu.one.m -relief raised
	menu $w.menu.one.m
	$w.menu.one.m add command -label "Debug PE3" \
		-command {debug $pe3_0 3}
	$w.menu.one.m add command -label "Debug PE2" \
		-command {debug $pe2_0 2}
	$w.menu.one.m add command -label "Debug PE1" \
		-command {debug $pe1_0 1}
	$w.menu.one.m add command -label "Debug PE0" \
		-command {debug $pe0_0 0}
	$w.menu.one.m add command -label "Nice PE3" \
		-command {exec $renice 5 $pe3_0 >/dev/null &}
	$w.menu.one.m add command -label "Nice PE2" \
		-command {exec $renice 5 $pe2_0 >/dev/null &}
	$w.menu.one.m add command -label "Nice PE1" \
		-command {exec $renice 5 $pe1_0 >/dev/null &}
	$w.menu.one.m add command -label "Nice PE0" \
		-command {exec $renice 5 $pe0_0 >/dev/null &}
	$w.menu.one.m add command -label "De-nice PE3" \
		-command {exec $renice 0 $pe3_0 >/dev/null &}
	$w.menu.one.m add command -label "De-nice PE2" \
		-command {exec $renice 0 $pe2_0 >/dev/null &}
	$w.menu.one.m add command -label "De-nice PE1" \
		-command {exec $renice 0 $pe1_0 >/dev/null &}
	$w.menu.one.m add command -label "De-nice PE0" \
		-command {exec $renice 0 $pe0_0 >/dev/null &}

	menubutton $w.menu.vapers -text "VAPERS Menu" \
		-menu $w.menu.vapers.m -relief raised
	menu $w.menu.vapers.m
	$w.menu.vapers.m add command -label "Browse doc files" \
		-command {vdoc}
	$w.menu.vapers.m add command -label "Destroy this window" \
		-command {set autoref 0
			  destroy .status}
	$w.menu.vapers.m add command -label "Quit VAPERS" \
		-command {destroy .}
	$w.menu.vapers.m add command -label "Xterm" \
		-command {exec $xterm \
			"-sb" \
			"-fg" "#b90" \
			"-bg" "Black" \
			"-T" "XTerm (from VAPERS)" \
			"-n" "XTerm" &}

	pack $w.menu.all -side left
	pack $w.menu.one -side left
	pack $w.menu.vapers -side left


	frame $w.stat -borderwidth 2
	scrollbar $w.stat.yscroll \
		-command "$w.stat.list yview" \
		-foreground #444 -activeforeground #b90
	scrollbar $w.stat.xscroll -orient horiz \
		-command "$w.stat.list xview" \
		-foreground #444 -activeforeground #b90
	listbox $w.stat.list -geometry 40x8 \
		-font -Adobe-Courier-Medium-R-Normal-*-120-* \
		-yscroll "$w.stat.yscroll set" \
		-xscroll "$w.stat.xscroll set" \
		-relief sunken -setgrid yes -background Black
	pack $w.stat.yscroll -side right -fill y
	pack $w.stat.xscroll -side bottom -fill x
	pack $w.stat.list -expand yes -fill both


	button $w.refresh -textvariable reftxt \
		-command {refinfo}


	pack $w.menu -side top -fill x
	pack $w.stat -side top -expand yes -fill both
	pack $w.refresh -side top -fill x

	set autoref 0
	refinfo
}


proc refinfo {} {
	global autoref reftxt

	if {$autoref == 0} {
		set autoref 1
		set reftxt "Freeze Status Text Display"
	} else {
		set autoref 0
		set reftxt "Automatic Update Status Text Display"
	}
}


proc geninfo {list} {
	global pe0_0 pe0_1 pe0_2 pe0_3 pe0_4 pe0_5 pe0_6 pe0_7
	global pe1_0 pe1_1 pe1_2 pe1_3 pe1_4 pe1_5 pe1_6 pe1_7
	global pe2_0 pe2_1 pe2_2 pe2_3 pe2_4 pe2_5 pe2_6 pe2_7
	global pe3_0 pe3_1 pe3_2 pe3_3 pe3_4 pe3_5 pe3_6 pe3_7
	global vapers_0 vapers_1 vapers_2 vapers_3
	global vapers_4 vapers_5 vapers_6 vapers_7
	global power

	$list delete 0 end

	chkstat

	if {$power == 0} {
		$list insert end "No parallel program is running."
		return
	}

	$list insert end [concat "TTL_VAPERS is PID" $vapers_0]
	$list insert end [concat $vapers_1 "barriers executed"]
	$list insert end " "
	$list insert end "PE#    PID   OUT    IN  MODE      Early"
	$list insert end [format "%3s  %5d  0x%02x  0x%02x  0x%02x  %9d" PE3 $pe3_0 $pe3_1 $pe3_2 $pe3_3 $pe3_4]
	$list insert end [format "%3s  %5d  0x%02x  0x%02x  0x%02x  %9d" PE2 $pe2_0 $pe2_1 $pe2_2 $pe2_3 $pe2_4]
	$list insert end [format "%3s  %5d  0x%02x  0x%02x  0x%02x  %9d" PE1 $pe1_0 $pe1_1 $pe1_2 $pe1_3 $pe1_4]
	$list insert end [format "%3s  %5d  0x%02x  0x%02x  0x%02x  %9d" PE0 $pe0_0 $pe0_1 $pe0_2 $pe0_3 $pe0_4]
	$list insert end " "
	$list insert end "PE#    Value of IPROC for this PE"
	$list insert end "PID    UNIX PID of this PE"
	$list insert end "OUT    Hex value on OUT port"
	$list insert end "IN     Hex value on IN port"
	$list insert end "MODE   Hex value on MODE port"
	$list insert end "Early  Count of early barrier arrivals"
}


proc pesignal {sig} {
	global pe3_0 pe2_0 pe1_0 pe0_0
	global power
	global kill


	if {$power == 0} {
		return
	}

	set negsig [expr 0 "-" $sig]

	exec $kill $negsig $pe3_0
	exec $kill $negsig $pe2_0
	exec $kill $negsig $pe1_0
	exec $kill $negsig $pe0_0
}


proc csignal {sig} {
	global vapers_0
	global power
	global kill


	if {$power == 0} {
		return
	}

	set negsig [expr 0 "-" $sig]

	exec $kill $negsig $vapers_0
}


proc debug {pid penum} {
	global useproc
	global xterm gdb

	if {$useproc == 1} {
		set progname "program_name_not_found"
		set fd [open [join "/proc/ $pid /cmdline" ""] "RDONLY"]
		scan [read $fd 512] "%s" progname
		close $fd
		exec $xterm \
			"-sb" \
			"-fg" "#b90" \
			"-bg" "Black" \
			"-T" \
			[format "Debug PE%d (%s)" $penum $progname] \
			"-n" \
			[format "PE%d" $penum] \
			"-e" \
			$gdb $progname $pid &
	}
}


proc vdoc {{w .vdoc}} {
	global vapersicon
	global docheader


	catch {destroy $w}
	toplevel $w
	wm geometry $w +100+100
	wm title $w "VAPERS Documentation Browser"
	wm iconname $w "V Doc"
	wm iconbitmap $w @$vapersicon
	wm minsize $w 1 1


	set docheader ""

	frame $w.menu -borderwidth 2
	button $w.menu.readme -text "README" \
		-command {loadfile .vdoc.info.text README}
	button $w.menu.info -text "Overview" \
		-command {loadfile .vdoc.info.text vapers.doc}
	button $w.menu.lib -text "Library" \
		-command {loadfile .vdoc.info.text library.doc}
	message $w.menu.msg -textvariable docheader -width 32c

	pack $w.menu.readme -side left
	pack $w.menu.info -side left
	pack $w.menu.lib -side left
	pack $w.menu.msg -side left


	frame $w.info -borderwidth 2
	scrollbar $w.info.yscroll \
		-command "$w.info.text yview" \
		-foreground #444 -activeforeground #b90
	text $w.info.text -width 80 -height 24\
		-font -Adobe-Courier-Medium-R-Normal-*-120-* \
		-yscrollcommand "$w.info.yscroll set" \
		-relief sunken -setgrid yes -background Black
	button $w.done -text "Destroy This Window" -command "destroy $w"

	pack $w.info.text -side left -expand yes -fill both
	pack $w.info.yscroll -side right -fill y

	pack $w.menu -side top -fill x
	pack $w.info -expand yes -fill both
	pack $w.done -side bottom -fill x

	$w.info.text insert 0.0 {Click one of the buttons above to select a document.

The following notice applies to all software in this alpha release:

The authors and Purdue University make this code freely available as a
public domain release.  Neither the authors nor Purdue University can be
held responsible for any problems deriving from use of this code; however,
the authors would like to be informed of any problems, and intend to
actively support the package.

The primary author is:

	Prof. Hank Dietz, email hankd@ecn.purdue.edu

Debugging help has come from:

	Tim Mattox, email tmattox@ecn.purdue.edu

This description was last updated May 18, 1995.}

	bind $w <Any-Enter> "focus $w.info.text"
}


proc loadfile {w file} {
	global docheader
	global vaperspath


	set docheader [format "Browsing: %s" $file]

	set f [open [format "%s%s" $vaperspath $file]]
	$w delete 1.0 end
	while {![eof $f]} {
		$w insert end [read $f 10000]
	}
	close $f
}
