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