1# Copyright (C) 1987-2015 by Jeffery P. Hansen 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License along 14# with this program; if not, write to the Free Software Foundation, Inc., 15# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 16# 17# Last edit by hansen on Sat Sep 26 18:18:20 2009 18# 19 20set simId 0 21set simOn 0 22set currentSimTime 0ns 23 24set tkg_simDisplayedVal 0 25 26namespace eval SimWatcher { 27 variable w "" 28 29 proc addText {s} { 30 variable w 31 if {$w == ""} return 32 33 if {[string range $s 0 2] == "<--" } { 34 $w.text insert end "$s\n" red 35 } else { 36 $w.text insert end "$s\n" blue 37 } 38 $w.text see end 39 } 40 41 proc flushText {} { 42 variable w 43 if {$w == ""} return 44 45 $w.text delete 1.0 end 46 } 47 48 proc destroyNotify {} { 49 variable w 50 51 set w "" 52 } 53 54 proc post {} { 55 variable w 56 57 set w .simwatcher 58 if { [catch { toplevel $w }] } { 59 flushText 60 return 61 } 62 63 wm resizable $w 0 0 64 wm title $w "TkGate: Simulation Watch" 65 wm geometry $w [offsetgeometry . 50 50] 66 67 bind $w <Destroy> SimWatcher::destroyNotify 68 69 button $w.dismiss -text [m b.dismiss] -command "destroy $w" 70 text $w.text -yscrollcommand "$w.vb set" 71 scrollbar $w.vb -command "$w.text yview" 72 73 pack $w.dismiss -side bottom -fill x 74 pack $w.text $w.vb -side left -fill y 75 $w.text tag configure blue -foreground blue 76 $w.text tag configure red -foreground red 77 } 78} 79 80############################################################################# 81# 82# Verifiy that simulator is running 83# 84proc tkg_simCheck {} { 85 global simOn 86 87 if { $simOn == 0 } { 88 errmsg [m err.simonly] 89 return 0 90 } 91 return 1 92} 93 94######################################## 95# 96# start up the simulator 97# 98proc tkg_startSim {fname initTime} { 99 global simId simOn mode simExec tkg_simDelayFile tkg_simDefaultDelayFile tkg_simCustomDelay 100 global tkg_currentFile tkg_simDebugInterface tkg_warningMode 101 102 set basename "" 103 104 if { $simOn } { return } 105 106 set p [string last "/" $tkg_currentFile] 107 if { $p > 0 } { 108 set basename [string range $tkg_currentFile 0 $p] 109 } else { 110 set basename "/" 111 } 112 113 if { $tkg_simCustomDelay } { 114 set delayFile $tkg_simDelayFile 115 } { 116 set delayFile $tkg_simDefaultDelayFile 117 } 118 119 set delayFile $tkg_simDefaultDelayFile 120 foreach f $tkg_simDelayFile { 121 set delayFile "${delayFile}:$f" 122 } 123 124 # 125 # Construct the commmand line to use for starting the simulator. 126 # 127 set simCmd "$simExec -i -B \"$basename\" -W $tkg_warningMode -I \"$initTime\" \"$fname\"" 128 129 # 130 # Start up the simulator 131 # 132 if { [catch { set simId [open "|$simCmd" r+ ] } ] } { 133 errmsg "Failed to start simulator '${simExec}'" 134 return 135 } 136 137 if { $tkg_simDebugInterface } { 138 SimWatcher::post 139 } 140 141 fileevent $simId readable { tkg_readSim; update idletasks } 142 set simOn 1 143 set mode 1 144 145 tkg_resetLogo 146 147 return $simId 148} 149 150######################################## 151# 152# read a command from simulator 153# 154proc tkg_readSim {} { 155 global simId simOn tkg_simDebugInterface 156 157 if { !$simOn } { return } 158 159 if { [catch { set command [gets $simId] } ] } { 160 gat_setMajorMode edit 161 errmsg "Simulator has died (read error)." 162 return 163 } 164 if { $command == "" && [eof $simId] } { 165 gat_setMajorMode edit 166 errmsg "Simulator has died (eof in read)." 167 return 168 } 169 170 if { $tkg_simDebugInterface } { 171 SimWatcher::addText "--> $command" 172 } 173 174 gat_scopeCommand $command 175 return 0 176} 177 178proc tkg_endSim {} { 179 global simId simOn 180 181 catch { fileevent $simId readable } 182 catch { close $simId } 183 set simOn 0 184 gat_breakpoint -clear 185 gat_setMajorMode edit 186 tkg_editLogo 187} 188 189############################################################################# 190# 191# Simulation script handling 192# 193 194proc tkg_doSimScript args { 195 global simScript_filter simScript_filetypes 196 197 if { ![tkg_simCheck] } return 198 199 set parent "." 200 parseargs $args {-parent} 201 202 set fileName [tk_getOpenFile -defaultextension $simScript_filter -parent $parent -filetypes $simScript_filetypes ] 203 if { $fileName != "" } { 204 ScriptMgr::load $fileName 205 } 206} 207 208############################################################################# 209# 210# Load a memory from a file. 211# 212proc tkg_simLoadMem args { 213 global mem_filetypes mem_filter 214 215 if { ![tkg_simCheck] } return 216 217 set parent "." 218 parseargs $args {-parent} 219 220 set g [gat_simSelected ram rom] 221 222 set load [tk_getOpenFile -defaultextension $mem_filter -parent $parent -filetypes $mem_filetypes ] 223 if { $load != "" } { 224# tkg_simGateCmd $g load $load 225 Simulator::cmdSend "\$memload $load $g" 226 } 227} 228 229############################################################################# 230# 231# Dump a memory to a file. 232# 233proc tkg_simDumpMem args { 234 global mem_filetypes mem_filter 235 236 if { ![tkg_simCheck] } return 237 238 set parent "." 239 parseargs $args {-parent} 240 241 set g [gat_simSelected ram rom] 242 243 set dump [tk_getSaveFile -defaultextension $mem_filter -parent $parent -filetypes $mem_filetypes ] 244 if { $dump != "" } { 245 if { $g == "" } { 246 Simulator::cmdSend "\$memdump $dump" 247 } else { 248 Simulator::cmdSend "\$memdump $dump $g" 249 } 250 } 251} 252 253############################################################################# 254# 255# basic commands 256# 257proc tkg_simNetSet {net val} { 258 if { ![tkg_simCheck] } return 259 260 Simulator::cmdSend "\$set $net $val" 261} 262 263############################################################################# 264# 265# Put simulator in continuous run mode. 266# 267proc tkg_simRun {} { 268 global simOn 269 270 if { $simOn == 0 } { 271 gat_setMajorMode simulate 272 } { 273 gat_breakpoint -clear 274 Simulator::cmdSend "\$go" 275 } 276} 277 278############################################################################# 279# 280# Stop the simulator (put it in pause mode) 281# 282proc tkg_simStop {} { 283 global simOn 284 285 if { $simOn == 0 } { 286 } { 287 Simulator::cmdSend "\$stop" 288 } 289} 290 291############################################################################# 292# 293# args: +/- # after [clock] 294# 295proc tkg_simCycle args { 296 global tkg_simClockOverStep tkg_simActClock tkg_simUseActClock tkg_simClockStepSize 297 global simOn 298 299 if { $simOn == 0 } return 300 301 gat_editCircProps load simProps 302 303 set tkg_simClockStepSize [validate_posint $tkg_simClockStepSize] 304 set tkg_simClockOverStep [validate_nonnegint $tkg_simClockOverStep] 305 306 gat_breakpoint -clear 307 308 if { $args == "" } { 309 if { $::simProps(clockMode) == 1 } { 310 Simulator::cmdSend "\$clock + $tkg_simClockStepSize $tkg_simClockOverStep $::simProps(clockName).Z" 311 } else { 312 Simulator::cmdSend "\$clock + $tkg_simClockStepSize $tkg_simClockOverStep" 313 } 314 } { 315 Simulator::cmdSend "\$clock $args" 316 } 317} 318 319############################################################################# 320# 321# Simulator interface 322# 323namespace eval Simulator { 324 variable dipValue 325 variable dipWindow 326 variable timeUpdate_ev 327 328 proc doTimeUpdate {} { 329 variable timeUpdate_ev 330 331 if { [cmdSend -ignoreerrors "\$time"] } { 332 set timeUpdate_ev [after 500 Simulator::doTimeUpdate] 333 } 334 } 335 336 proc startTimeUpdates {} { 337 variable timeUpdate_ev 338 catch { 339 catch { after cancel $timeUpdate_ev } 340 set timeUpdate_ev [after 500 Simulator::doTimeUpdate] 341 } 342 } 343 344 proc stopTimeUpdates {} { 345 variable timeUpdate_ev 346 catch { after cancel $timeUpdate_ev } 347 } 348 349 ############################################################################# 350 # 351 # Step simulator by a single epoch. 352 # 353 proc stepEpoch args { 354 global tkg_simStepSize 355 global simOn 356 357 if { $simOn == 0 } return 358 359 gat_breakpoint -clear 360 361 set tkg_simStepSize [validate_posint $tkg_simStepSize] 362 363 if { $args == "" } { 364 Simulator::cmdSend "\$step $tkg_simStepSize" 365 } { 366 Simulator::cmdSend "\$step $args" 367 } 368 } 369 370 proc showValue {n} { 371 global tkg_simDisplayedVal tkg_showValueEv tkg_valuePopUpDelay 372 373 set tkg_simDisplayedVal "-" 374 375 Simulator::cmdSend "\$show $n" 376 377 scan [winfo pointerxy .] "%d %d" x y 378 379 set tkg_showValueEv [after $tkg_valuePopUpDelay "Simulator::postShowValue $x $y"] 380 } 381 382 proc postShowValue {x y} { 383 global tkg_simDisplayedVal 384 385 catch { destroy .showv } 386 toplevel .showv -bg bisque 387 388 wm geometry .showv +[expr $x + 5]+[expr $y - 30] 389 wm transient .showv . 390 wm overrideredirect .showv 1 391 392 label .showv.l -textvariable tkg_simDisplayedVal -bg bisque 393 pack .showv.l -padx 4 -pady 4 394 } 395 proc hideValue {} { 396 global tkg_showValueEv 397 398 catch { after cancel $tkg_showValueEv } 399 catch { destroy .showv } 400 } 401 402 # 403 # Apply value in dip value selector 404 # 405 proc dipApply {w g} { 406 variable dipValue 407 set q [ gat_setDip $g $dipValue($g) ] 408 set dipValue($g) $q 409 dipSetIndicator $w 0 410 } 411 412 # 413 # Destroy a DIP entry window 414 # 415 proc dipDestroy {w g} { 416 variable dipWindow 417 418 set dipWindow($g) "" 419 catch { trace vdelete Simulator::dipValue($g) w "Simulator::dipSetIndicator $w 1" } 420 catch { destroy $w } 421 } 422 423 # 424 # Set the "changed" indicator 425 # 426 proc dipSetIndicator {w changed args} { 427 if { $changed } { 428 set color red 429 } else { 430 set color green 431 } 432 $w.top.indicator itemconfigure indicator -fill $color -outline $color 433 } 434 435 # 436 # Create a window for entering a dip value. 437 # 438 proc dipEntry {g v x y} { 439 variable dipValue 440 variable dipWindow 441 442 # 443 # If DIP window is already open, just raise it. 444 # 445 if { [catch { set w $dipWindow($g) } ] } { set w "" } 446 if { $w != "" } { 447 raise $w 448 return 449 } 450 451 # 452 # Choose a top-level window for the dip setter 453 # 454 for {set i 0} { [catch { set w [toplevel .dipe$i] }] } { incr i } { } 455 456 set dipWindow($g) $w 457 458 wm resizable $w 0 0 459 wm title $w [m db.dip.title] 460 wm geometry $w [offsetgeometry . $x $y] 461 wm transient $w . 462 463 set dipValue($g) $v 464 465 frame $w.top 466 canvas $w.top.indicator -width 12 -height 12 -bd 0 -bg [$w cget -bg] -highlightthickness 0 467 $w.top.indicator create oval 2 2 10 10 -fill green -outline green -tags indicator 468 469 label $w.top.label -text "$g:" 470 incdecEntry $w.entr -width 10 -font dipFont -variable Simulator::dipValue($g) \ 471 -format %x -validatecommand hexValidate 472 473 button $w.apply -text [m b.apply] -command "Simulator::dipApply $w $g" 474 button $w.close -text [m b.close] -command "Simulator::dipDestroy $w $g" 475 476 bindtags $w.entr [concat [list HexEntry] [bindtags $w.entr]] 477 478 479 pack $w.top.indicator -side left 480 pack $w.top.label -side left -fill both -padx 2 481 pack $w.top -side top -fill both 482 pack $w.close -side bottom -fill both -pady 3 483 pack $w.entr $w.apply -side left -pady 5 -padx 5 484 485 trace variable Simulator::dipValue($g) w "Simulator::dipSetIndicator $w 1" 486 bind $w <Destroy> "Simulator::dipDestroy $w $g" 487 bind $w.entr.e <Return> "Simulator::dipApply $w $g" 488 bind .scope <Destroy> "+ Simulator::dipDestroy $w $g" 489 } 490 491 #tkg_simWrite 492 proc cmdSend {args} { 493 global simId tkg_simDebugInterface 494 495 set ignoreerrors 0 496 497 if {[llength $args] > 1} { 498 if {[lsearch $args -ignoreerrors] >= 0} { 499 set ignoreerrors 1 500 } 501 set msg [lindex $args [expr [llength $args]-1]] 502 } else { 503 set msg [lindex $args 0] 504 } 505 506 if { $tkg_simDebugInterface } { 507 SimWatcher::addText "<-- $msg" 508 } 509 510 if { [catch { puts $simId $msg }] } { 511 gat_setMajorMode edit 512 if {!$ignoreerrors} { 513 errmsg "Simulator has died (in write)." 514 } 515 return 0 516 } 517 cmdFlush 518 return 1 519 } 520 521 #tkg_simFlush 522 proc cmdFlush {} { 523 global simId 524 if { [catch { flush $simId } ] } { 525 gat_setMajorMode edit 526 errmsg "Simulator has died (in flush)." 527 return 528 } 529 } 530 531 ############################################################################# 532 # 533 # Inform simulator of security settings 534 # 535 proc setupSecurity {} { 536 global tkg_securityHandling tkg_securityExec tkg_securityWriteMem tkg_securityOpen 537 global tkg_securitySend tkg_securityEnqueue 538 539 Simulator::cmdSend "\$option sec.send $tkg_securitySend" 540 Simulator::cmdSend "\$option sec.fopen $tkg_securityOpen" 541 Simulator::cmdSend "\$option sec.writemem $tkg_securityWriteMem" 542 Simulator::cmdSend "\$option sec.queue $tkg_securityEnqueue" 543 Simulator::cmdSend "\$option sec.exec $tkg_securityExec" 544 Simulator::cmdSend "\$option sec.handling $tkg_securityHandling" 545 } 546} 547