tkgate-data 1.8.7-4 / usr / share / tkgate-1.8.7 / scripts / simulator.tcl

#   Copyright (C) 1987-2007 by Jeffery P. Hansen
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# Last edit by hansen on Fri Dec  5 14:24:53 2003
#

set simId 0
set simOn 0

set tkg_simDisplayedVal 0

proc tkg_disableEditModes {} {
  catch {
     toolbar:hideEdit

    .mbar.edit configure -state disabled
    .mbar.tool configure -state disabled
    .mbar.make configure -state disabled
    .mbar.gate configure -state disabled
  }
}

proc tkg_enableEditModes {} {
  catch {
    toolbar:showEdit
    .mbar.edit configure -state normal
    .mbar.tool configure -state normal
    .mbar.make configure -state normal
    .mbar.gate configure -state normal
  }
}

proc tkg_setupSimMenus {} {
  catch {
    .mbar.sim.menu entryconfigure 1 -label [m simend] -underline [ul 0] -command {gat_setMajorMode edit} -accelerator "Ctl-S e"

    .mbar.sim.menu entryconfigure 3 -state normal
    .mbar.sim.menu entryconfigure 4 -state normal
    .mbar.sim.menu entryconfigure 5 -state normal
    .mbar.sim.menu entryconfigure 6 -state normal
    .mbar.sim.menu entryconfigure 7 -state normal
    .mbar.sim.menu entryconfigure 8 -state normal
    .mbar.sim.menu entryconfigure 10 -state normal
    .mbar.sim.menu entryconfigure 11 -state normal
    .mbar.sim.menu entryconfigure 13 -state normal

    toolbar:showSim
  }
}

proc tkg_teardownSimMenus {} {
  catch {
    .mbar.sim.menu entryconfigure 1 -label [m simbegin] -underline [ul 0] -command { gat_setMajorMode simulate } -accelerator "Ctl-S b"

    .mbar.sim.menu entryconfigure 3 -state disabled
    .mbar.sim.menu entryconfigure 4 -state disabled
    .mbar.sim.menu entryconfigure 5 -state disabled
    .mbar.sim.menu entryconfigure 6 -state disabled
    .mbar.sim.menu entryconfigure 7 -state disabled
    .mbar.sim.menu entryconfigure 8 -state disabled
    .mbar.sim.menu entryconfigure 10 -state disabled
    .mbar.sim.menu entryconfigure 11 -state disabled
    .mbar.sim.menu entryconfigure 13 -state disabled

     toolbar:hideSim
  }
}

#############################################################################
#
# Verifiy that simulator is running
#
proc tkg_simCheck {} {
  global simOn

  if { $simOn == 0 } {
    errmsg "Command not valid when not in simulation mode."
    return 0
  }
  return 1
}

proc tkg_readSimInitScript {} {
  global sopts_simInitScript
  if { $sopts_simInitScript != "" } {
    gat_simScript $sopts_simInitScript
  }
}

########################################
#
# start up the simulator
#
proc tkg_startSim {fname} {
  global simId simOn mode simExec tkg_simDelayFile tkg_simDefaultDelayFile tkg_simCustomDelay tkg_currentFile tkg_simDebugInterface
  set basename ""

  if { $simOn } { return }

  set p [string last "/" $tkg_currentFile]
  if { $p > 0 } {
    set basename [string range $tkg_currentFile 0 $p]
    set basename "-B $basename"
  }

  if { $tkg_simCustomDelay } {
    set delayFile $tkg_simDelayFile
  } {
    set delayFile $tkg_simDefaultDelayFile
  }

  set delayFile $tkg_simDefaultDelayFile
  foreach f $tkg_simDelayFile {
    set delayFile "${delayFile}:$f"
  }

  if { $tkg_simDebugInterface } {
    puts "Exec: $simExec -D $delayFile $basename $fname"
  }

  if { [catch { set simId [open "|$simExec -D $delayFile $basename $fname" r+ ] } ] } {
    errmsg "Failed to start simultor '${simExec}'"
    return
  }

  fileevent $simId readable { tkg_readSim; update idletasks }
  set simOn 1
  set mode 1

  tkg_setupSimMenus

  tkg_resetLogo

  return $simId
}

########################################
#
# read a command from simulator
#
proc tkg_readSim {} {
  global simId simOn

  if { !$simOn } { return }

  if { [catch { set command [gets $simId] } ] } {
    gat_setMajorMode edit
    errmsg "Simulator has died (read error)."
    return
  }
  if { $command == "" && [eof $simId] } {
    gat_setMajorMode edit
    errmsg "Simulator has died (eof in read)."
    return
  }

  gat_scopeCommand $command
  return 0
}

proc tkg_simWrite {msg} {
  global simId tkg_simDebugInterface sopts_simLogFile

  if { $sopts_simLogFile != "" } {
    set log [open $sopts_simLogFile "a+"]
    puts $log $msg
    close $log
  }

  if { $tkg_simDebugInterface } {
    puts "->sim: $msg"
    flush stdout
  }

  if { [catch { puts $simId $msg }] } {
    gat_setMajorMode edit
    errmsg "Simulator has died (in write)."
    return
  }
  tkg_simFlush
}

proc tkg_simFlush {} {
  global simId
  if { [catch { flush $simId } ] } {
    gat_setMajorMode edit
    errmsg "Simulator has died (in flush)."
    return
  }
}

proc tkg_endSim {} {
  global simId simOn tkg_simDebugInterface 

  if { $tkg_simDebugInterface } {
    puts "tkg_endSim"
  }

  catch { fileevent $simId readable }
  catch { close $simId }
  set simOn 0
  tkg_teardownSimMenus
  gat_setMajorMode edit
  tkg_editLogo
  tkg_rmttys
}

#############################################################################
#
# breakpoint handling
#

proc tkg_BPdialog {str} {
  set w .ebp
  global ebp_str

  if { [catch { toplevel $w }] } {
    return
  }

  wm resizable $w 0 0
  wm title $w "TkGate: Edit Breakpoint"
  wm geometry $w [offsetgeometry . 50 50]
  wm transient $w .

  set ebp_str $str

  frame $w.f -relief raised -bd 2
  label $w.f.l -text "[m sim.breakpt]: "
  entry $w.f.e -width 40 -textvariable ebp_str
  pack $w.f.l $w.f.e -side left -padx 5 -pady 5

  okcancel $w.b { destroy .ebp } { global ebp_str; set ebp_str ""; destroy .ebp }

  bind $w.f.e <KeyPress-Return>  { destroy .ebp }


  pack $w.f -fill both -ipadx 10 -ipady 20
  pack $w.b -fill both

  helpon $w.f.l [m ho.sim.break]

  grab set $w
  tkwait window $w
  grab release $w

  return $ebp_str
}

proc tkg_editBP {} {
  set s [.bpedit.f.g.l curselection]  
  if { $s != "" } {
    set old_bp [.bpedit.f.g.l get $s]  
    set old_bp [string trim $old_bp "=> "]
    set new_bp [tkg_BPdialog $old_bp]
    if { $new_bp != "" } {
      if { [gat_breakpoint -replace $s $new_bp] >= 0 } {
        .bpedit.f.g.l delete $s
        .bpedit.f.g.l insert $s $new_bp
      }
    }
  } {
    errmsg "No breakpoint selected"
  }

}

#
# Add a new breakpoint.  If no arguments are specified, a dialog box is used
# to get the breakpoint text.  If an argument is specified, the breakpoint
# is taken from the command line.  The id number of the breakpoint is returned
# on success, or a -1 on failure.
#
proc tkg_addBP args {

  if { $args == "" } {
    set bp [tkg_BPdialog ""]
  } {
    set bp $args
  }

  set id -1
  catch {
    if {$bp != ""} {
      set id [gat_breakpoint -insert -1 $bp]
      if { $id >= 0 } {
        .bpedit.f.g.l insert end $bp
      }
    }
  }
  return $id
}

#
# Delete an existing breakpoint.  If no arguments are specified, the breakpoint
# is deleted based on the selected element in the breakpoint listbox, otherwise
# the specified breakpoint is deleted.
#
proc tkg_deleteBP args {
  if { $args == "" } {
    set s [.bpedit.f.g.l curselection]  
  } {
    set s $args
  }

  catch {
    if { $s != "" } {
      if { [gat_breakpoint -delete $s] >= 0 } {
        .bpedit.f.g.l delete $s
      }
    } {
      errmsg "No breakpoint selected"
    }
  }
}

proc tkg_editBreakpoints args {
  set w ".bpedit"

  if { ![tkg_simCheck] } return

  set parent "."
  parseargs $args {-parent}

#
# Do nothing if window is active.
#
  if { [catch { toplevel $w }] } {
    return
  }

  wm resizable $w 0 0
  wm title $w "TkGate: Breakpoints"
  wm geometry $w [offsetgeometry . 50 50]
  wm transient $w $parent

  frame $w.f -relief raised -bd 2
  frame $w.f.g
  frame $w.f.ops

  frame $w.cf -relief raised -bd 2

  listbox $w.f.g.l -width 40 -yscrollcommand "$w.f.g.vsb set" -xscrollcommand "$w.f.g.hsb set" -takefocus 0 -relief sunken -bd 2
  scrollbar $w.f.g.vsb -command "$w.f.g.l yview" -takefocus 0
  scrollbar $w.f.g.hsb -command "$w.f.g.l yview" -orient horizontal -takefocus 0
  grid $w.f.g.l -row 0 -column 0 -padx 3 -pady 3
  grid $w.f.g.vsb -row 0 -column 1 -padx 3 -pady 3 -sticky ns
  grid $w.f.g.hsb -row 1 -column 0 -padx 3 -pady 3 -sticky ew
  pack $w.f.g

  button $w.f.ops.add -text [m b.add] -command tkg_addBP
  button $w.f.ops.edit -text [m b.edit] -command tkg_editBP
  button $w.f.ops.del -text [m b.deleteb] -command tkg_deleteBP
  pack $w.f.ops.add $w.f.ops.edit $w.f.ops.del -side left -padx 5 -pady 5
  pack $w.f.ops

  button $w.cf.ok -text [m b.dismiss] -command { destroy .bpedit }
  pack $w.cf.ok -padx 5 -pady 5

  pack $w.f -ipadx 5 -ipady 5 -fill both
  pack $w.cf -ipadx 5 -ipady 5 -fill both

  bind $w <KeyPress-Delete> tkg_deleteBP 
  bind $w.f.g.l <Double-ButtonRelease-1> tkg_editBP 

  gat_breakpoint -load $w.f.g.l

#  grab set $w
#  tkwait window $w
#  grab release $w
}

#
# Delete all old breakpoint displays
#
proc tkg_clearBreaks {} {
  catch {
    set N [.bpedit.f.g.l size]
    for {set i 0} {$i < $N} {incr i} {
      set e [string trim [.bpedit.f.g.l get $i] "=> "]
      .bpedit.f.g.l delete $i
      .bpedit.f.g.l insert $i $e
    }
  }
}

proc tkg_seeBreaks args {
  if { [llength $args] <= 0 } {
    tkg_clearBreaks
    return
  }

  tkg_editBreakpoints
  tkg_clearBreaks

  catch {
    while { [llength $args] > 0 } {
      set i [lindex $args 0]
      set args [lrange $args 1 end]
      set e [.bpedit.f.g.l get $i]
      set e "==> $e"
      .bpedit.f.g.l delete $i
      .bpedit.f.g.l insert $i $e
    }
  }
}

#############################################################################
#
# Simulation script handling
#

proc tkg_doSimScript args {
  global simScript_filter simScript_filetypes

  if { ![tkg_simCheck] } return

  set parent "."
  parseargs $args {-parent}

  set fileName [tk_getOpenFile -defaultextension $simScript_filter -parent $parent -filetypes $simScript_filetypes ]
  if { $fileName != "" } {
    gat_simScript $fileName
  }
}

#############################################################################
#
# Load/Dump memory
#

proc tkg_simLoadMem args {
  global mem_filetypes mem_filter

  if { ![tkg_simCheck] } return

  set parent "."
  parseargs $args {-parent}

  set g [gat_simSelected ram rom]

  set load [tk_getOpenFile -defaultextension $mem_filter -parent $parent -filetypes $mem_filetypes ]
  if { $load != "" } {
#    tkg_simGateCmd $g load $load
    tkg_simWrite "memload $load $g"
  }
}

proc tkg_simDumpMem args {
  global mem_filetypes mem_filter

  if { ![tkg_simCheck] } return

  set parent "."
  parseargs $args {-parent}

  set g [gat_simSelected ram rom]
  if { $g == "" } {
    errmsg "RAM or ROM circuit element not selected."
    return
  }

  set dump [tk_getSaveFile -defaultextension $mem_filter -parent $parent -filetypes $mem_filetypes ]
  if { $dump != "" } {
    tkg_simGateCmd $g dump $dump
  }
}

#############################################################################
#
# basic commands
#

proc tkg_simNetSet {net val} {
  if { ![tkg_simCheck] } return

  tkg_simWrite "set $net $val"
}

proc tkg_simRun {} {
  global simOn

  if { $simOn == 0  } {
    gat_setMajorMode simulate
  } {
    gat_breakpoint -clear
    tkg_clearBreaks
    tkg_simWrite "go 1"
    tkg_runLogo
  }
}

proc tkg_simStop {} {
  global simOn

  if { $simOn == 0  } {
  } {
    tkg_simWrite "go 0"
  }

  tkg_pauseLogo
}

#
# args: +/- # after [clock]
#
#
proc tkg_simCycle args {
  global tkg_simClockOverStep tkg_simActClock tkg_simUseActClock tkg_simClockStepSize
  global simOn

  if { $simOn == 0  } return

  gat_breakpoint -clear
  tkg_clearBreaks

  if { $args == "" } {
    if { $tkg_simUseActClock != 0 && $tkg_simActClock != "" } {
      tkg_simWrite "clock + $tkg_simClockStepSize $tkg_simClockOverStep $tkg_simActClock"
    } else {
      tkg_simWrite "clock + $tkg_simClockStepSize $tkg_simClockOverStep"
    }
  } {
    tkg_simWrite "clock $args"
  }
}

proc tkg_simStep args {
  global tkg_simStepSize
  global simOn

  if { $simOn == 0  } return

  gat_breakpoint -clear
  tkg_clearBreaks

  if { $args == "" } {
    tkg_simWrite "step $tkg_simStepSize"
  } {
    tkg_simWrite "step $args"
  }
}

proc tkg_simGateCmd args {
   if { ![tkg_simCheck] } return
   tkg_simWrite "command $args"
}

#
# Create a window for entering a dip value.
#
proc tkg_dipEntry {g v x y} {
  global dip_set

  if { [catch { set e $dip_set($g) } ] } { set e "" }
  if { $e != "" } { 
    raise $e
    return
   }

  for {set i 0} { [catch { set w [toplevel .dipe$i] }] } { incr i } { }

  set dip_set($g) $w

  wm resizable $w 0 0
  wm title $w "TkGate: Dip Value"
  wm geometry $w [offsetgeometry . $x $y]
  wm transient $w .

  bind .scope <Destroy> "+ set dip_set($g) \"\"; destroy $w"

  label $w.t -text "$g:"
  entry $w.entr -width 10
  $w.entr insert 0 $v

  button $w.apply -text [m b.apply] -command " set q \[ gat_setDip $g \[ $w.entr get \] \]; $w.entr delete 0 end; $w.entr insert 0 \$q"
  button $w.close -text [m b.close] -command " set dip_set($g) \"\"; destroy $w"

  bindtags $w.entr [concat [list HexEntry] [bindtags $w.entr]]

  bind $w.entr <Return> "$w.apply configure -state active; after 500 \"$w.apply configure -state normal\"; $w.apply invoke"

  pack $w.t -side top -fill both
  pack $w.close -side bottom -fill both -pady 3
  pack $w.entr $w.apply -side left -pady 5 -padx 5 
}

proc tkg_simShowValue {n} {
  global tkg_simDisplayedVal tkg_showValueEv tkg_valuePopUpDelay

  set tkg_simDisplayedVal "-"

  tkg_simWrite "show $n"

  scan [winfo pointerxy .] "%d %d" x y

  set tkg_showValueEv  [after $tkg_valuePopUpDelay "tkg_postShowValue $x $y"]
}

proc tkg_postShowValue {x y} {
  global tkg_simDisplayedVal

  catch { destroy .showv }
  toplevel .showv -bg bisque

  wm geometry .showv +[expr $x + 5]+[expr $y - 30]
  wm transient .showv .
  wm overrideredirect .showv 1

  label .showv.l -textvariable tkg_simDisplayedVal -bg bisque
  pack .showv.l -padx 4 -pady 4
}

proc tkg_simHideValue {} {
  global tkg_showValueEv

  catch { after cancel $tkg_showValueEv }
  catch { destroy .showv }
}