#! @TCL_SHELL@
#
#  This demonstrates how to implement a custom Tcl "main" for the
#  simulavr dynamic library and to access the behavioral modification
#  features used by main().  It provides access to nearly every feature
#  available from the C++ version's command line.  Plus since it is
#  in Tcl, it is dynamically interpreted and you have the ability to
#  add customizations.
#
#  Extra Features:
#    + -s Tcl File - source a Tcl file to allow user application to
#                    customize the simulation without duplicating
#                    this file.
#    + -l library  - specify the name of the simulavr dynamic library to use
#                    Otherwise searches along a reasonable path
#    + -S Tcl file - specify the name of a user provided simulation feedback
#                    Tcl file
#
#  Command Line Issues:
#    + The -T and -B arguments do not behave like the C++.  Currently I
#      only know how to support an argument appearing once.
#
#  ISSUES:
#    + Need to be able to specify a custom directory for "gui.tcl"
#    + More extenions point are likely to be needed.
#
#  $Id$
#

########################################################################
########################################################################
# ===========================================================================
# syntax: Getopts <arglist> <optstring> <var1> <var2> ... <varn>
#
# arglist is the *name* of the list of arguments to be parsed (no '$'), 
#    which may contain the forms "-x", "-x<arg>", or "-x <arg>"
# optstring is the list of options allowed in the form "abc:d:"
#    opts followed by ':' take an arg, others are on/off switches
# var1, var2, ... varn are variable names to which the option values
#    are assigned
# after Getopts runs, what remains in arglist will be any command line
#    parameters that did not follow an option, like filenames, etc.
# this routine does not obey the convention that '--' marks the last
#    option.  Options may appear anywhere in the arglist
#
# examples:
#    Getopts argv "k:q" kill_it quiet
#    myprog -k125 -q
#       $kill_it = "125"
#       $quiet = 1
#    myprog -k 257
#       $kill_it = "257"
#       $quiet = 0
#
#  SOURCE for "proc Getopts":
#    http://www.koders.com/tcl/fidAD8C8C3E7366141DBA25FCEEB10B6CB52CDFEE46.aspx
# ---------------------------------------------------------------------------
proc Getopts {alistname args} {
   upvar $alistname pargs
   set opts [split [lindex $args 0] ""]
   set names [lrange $args 1 end]
   
   foreach vname $names {
	   upvar $vname x$vname
	   set x$vname ""
   }
   
   set adx 0
   for {set idx 0} {$idx < [llength $opts]} {incr idx} {
	   set opt($adx,name) [lindex $opts $idx]
	   if {[regexp ":" [lindex $opts [expr $idx + 1]]]} {
         set opt($adx,re) "^(-$opt($adx,name)(.*))"
         set opt($adx,arg) 1
         set opt($adx,trg) "[lindex $names $adx]"
         incr idx
	   } else {
         set opt($adx,re) "^(-$opt($adx,name))"
         set opt($adx,arg) 0
         set opt($adx,trg) "[lindex $names $adx]"
         set $opt($adx,trg) 0
         eval set x$opt($adx,trg) \$$opt($adx,trg)
	   }
	   incr adx
   }
   
   foreach key [array names opt *name] {
	   regsub "name" $key "re" rkey
	   regsub "name" $key "trg" tkey
	   regsub "name" $key "arg" akey
	   for {set adx 0} {$adx < [llength $pargs]} {} {
         set aarg [lindex $pargs $adx]
         if {[regexp $opt($rkey) $aarg xxx xxx $opt($tkey)]} {
            set pargs [lreplace $pargs $adx $adx]
            if {$opt($akey) && [eval regexp "^$" \$$opt($tkey)]} {
               set $opt($tkey) [lindex $pargs $adx]
               set pargs [lreplace $pargs $adx $adx]
            } elseif {! $opt($akey)} {
               set $opt($tkey) 1
            }
            eval set x$opt($tkey) \$$opt($tkey)
         } else {
            incr adx
         }
	   }
   }
}  

########################################################################
########################################################################

#parse arguments?

Getopts argv "hVt:m:f:d:F:ua:e:W:R:gGp:ns:l:S:" \
  doHelp verbose traceFile maxRunTime \
  AvrExecutable AvrCPUModel Frequency hasUserInterface\
  abortOffset exitOffset writeToArgs readFromArgs \
  gdbEnable gdbDebugEnable gdbPort gdbWaitArg \
  sourceFile libraryDir simFeedbackFile

proc splitOffset {str off ofile} {
  upvar $off loff
  upvar $ofile lofile
  if { ! [info exists loff] } { set loff "" }
  if { ! [info exists ofile] } { set ofile "" }

  regsub ",.*$" ${str} "" loff
  if { [string match "*,*" ${str}] } {
    regsub "^.*," ${str} "" lofile
  } else {
    set lofile "-"
  }
}

splitOffset $writeToArgs writeToOffset writeToFile
splitOffset $readFromArgs readFromOffset readFromFile

if { "${gdbPort}" == "" } {
  set gdbPort 1212
}

if { ${gdbWaitArg} == 0 } {
  set gdbWait 1
} else {
  set gdbWait 0
}

# if the user specified one, source their support file
if { "${sourceFile}" != "" } {
  if { [file exists ${sourceFile}] } {
    set extensionPoint "Initialization"
    source ${sourceFile}
  } else {
    error "${sourceFile} does not exist"
  }
}

proc isSet { str } {
  if { "X${str}" == "X" } { return "NOT SET" }
  return ${str}
}

if { ${verbose} == 1 } {
  puts "Verbose           : ${verbose}"
  puts "Trace File        : [isSet ${traceFile}]" 
  puts "maxRunTime        : [isSet ${maxRunTime}]"
  puts "AvrExecutable     : ${AvrExecutable}"
  puts "AvrCPUModel       : ${AvrCPUModel}"
  puts "Frequency         : [isSet ${Frequency}]"
  puts "hasUserInterface  : ${hasUserInterface}"
  puts "abortOffset       : [isSet ${abortOffset}]"
  puts "exitOffset        : [isSet ${exitOffset}]"
  if { ${writeToArgs} == "" } {
    puts "writeToArgs       : NOT SET"
  } else {
    puts "writeToArgs       : ${writeToArgs} (${writeToOffset}/${writeToFile})"
  }
  if { ${readFromArgs} == "" } {
    puts "readFromArgs      : NOT SET"
  } else {
    puts "readFromArgs      : ${readFromArgs} (${readFromOffset}/${readFromFile})"
  }
  puts "sourceFile        : [isSet ${sourceFile}]"
  puts "libraryDir        : [isSet ${libraryDir}]"
  puts "gdbEnable         : ${gdbEnable}"
  puts "gdbDebugEnable    : ${gdbDebugEnable}"
  puts "gdbPort           : ${gdbPort}"
  puts "gdbWait           : ${gdbWait}"
  puts "simFeedbackFile   : ${simFeedbackFile}"
}

if { ${doHelp} == 1 } {
  # TBD OPTIONS
  puts "  -h                print this message"
  puts "  -u                enable user information for external pin"
  puts "                    handling at port 7777"
  puts "  -f <file>         load elf-<file> for execution in simulated target"
  puts "  -d <device>       simulate AVR model <device> "
  puts "  -g                run as gdb-server"
  puts "  -G                run as gdb-server and write debug info"
  puts "  -m <nanoseconds>  maximum run time of <nanoseconds>"
  puts "  -M                disable messages for bad I/O and memory references"
  puts "  -p <port>         use <port> for gdb server>"
  puts "  -t <file>         enable trace output to <file>"
  puts "  -n                do not wait for gdb connection"
  puts "  -F <Hz>           set the cpu frequency to <Hz>"
  puts "  -W <port>         add a special register at IO <offset> which outputs"
  puts "                    to stdout when written"
  puts "  -R <port>         add a special register at IO <offset> which reads"
  puts "                    from stdout when read from"
  puts "  -a <port>         add a special register at IO <offset> which aborts"
  puts "                    simulator run when accessed"
  puts "  -e <port>         add a special register at IO <offset> which exits"
  puts "                    simulator run when accessed"
  puts "  -V                output some hints to console"
# puts "  -T <label> or <address>"
# puts "                    stops simulation if PC runs on <label> or <address>"
# puts "  -B <label> or <address>"
# puts "                    same as -T for backward compatibility"

  # extra arguments
  puts "  -s <Tcl File>     source the <Tcl File> and allow the user to further"
  puts "                    tailor or augment the simulation"
  puts "  -l <library>      path of the simulavrxx dynamic <library>"
  puts "  -S <Tcl file>     specify <Tcl file> as a simulation feedback module"
  exit
}

if { "${AvrExecutable}" == "" } {
  error "Executable name not set"
}

if { ${hasUserInterface} == 1 && ${simFeedbackFile} != "" } {
  error "Cannot enable  GUI and Simulation Feedback"
}

if { ${simFeedbackFile} != "" } {
  if { ${simFeedbackFile} != "-" } {
    if { ! [file executable ${simFeedbackFile}] } {
      error "${simFeedbackFile} is not executable"
    }
  }
}

if { "${Frequency}" == "" } {
  set Frequency 4000000
}

proc locateInDirs {name dirs} {

  foreach dir ${dirs}  {
     set toTest ${dir}/${name}
     if { [file exists ${toTest}] } {
       return ${toTest}
     }
  }
  error "unable to locate ${name}"
}

set prefix  @prefix@
set libdir  @prefix@/lib
set guidir  @prefix@/shared

#load the avr-simulator package
set libraryFile [locateInDirs libsimulavr.so \
  [list ${libraryDir} \
        . src/.libs ../src/.libs ../../src/.libs \
        ${libdir}/lib /lib /usr/lib]]
if { ${verbose} == 1 } { puts "Loading ${libraryFile}" }
load ${libraryFile}

# optionally spawn the GUI
set GuiDir ""
if { ${hasUserInterface} == 1 } {
  set GuiFile [locateInDirs gui.tcl \
    [list ${GuiDir} .. examples ${guidir} /usr/share]]
  if { ${verbose} == 1 } { puts "Loading ${libraryFile}" }
  #start external generic gui server 
  exec @TCL_WISH@ ${GuiFile} &
}

# optionally spawn a simulation feedback instance
if { ${simFeedbackFile} != "" && ${simFeedbackFile} != "-" } {
  exec xterm -sb -T "Simulation Feedback ${simFeedbackFile}" \
    -e "${simFeedbackFile}" &
}

#create new device -- exits if invalid
set dev1 [AvrFactory_makeDevice [AvrFactory_instance] ${AvrCPUModel}]

#start the trace output to given filename
if { "$traceFile" != "" } {
  ${sysConHandler} SetTraceFile ${traceFile} 1000000
  SimulationMember_trace_on_set $dev1 1
}

#set the clock cycle time [ns]
set ClockCycleNS [expr 1000000000 / $Frequency ]
if { ${verbose} == 1 } {
  puts "Clock Cycle Time: ${ClockCycleNS} nanoseconds"
}
AvrDevice_SetClockFreq ${dev1} ${ClockCycleNS}

# Abort magic register
if { ${abortOffset} != "" } {
  set abortInstance [new_RWAbort ${dev1}]
  AvrDevice_ReplaceIoRegister ${dev1} ${abortOffset} $abortInstance
}

# Exit magic register
if { ${exitOffset} != "" } {
  set exitInstance [new_RWExit ${dev1}]
  AvrDevice_ReplaceIoRegister ${dev1} ${exitOffset} $exitInstance
}

set global_verbose_on ${verbose}

# Write magic register (only stdout supported)
if { "${writeToOffset}" != "" } {
  set writeToPipeInstance [new_RWWriteToFile ${dev1} "FWRITE" ${writeToFile}]
  AvrDevice_ReplaceIoRegister ${dev1} ${writeToOffset} ${writeToPipeInstance}
}

# Read magic register (only stdout supported)
if { "${readFromOffset}" != "" } {
  set readFromPipeInstance [new_RWReadFromFile ${dev1} "FREAD" ${readFromFile}]
  AvrDevice_ReplaceIoRegister ${dev1} ${readFromOffset} ${readFromPipeInstance}
}

#load elf file to the device -- REPLACE IO REGISTERS ABOVE HERE!!!
AvrDevice_Load ${dev1} "${AvrExecutable}"

AvrDevice_RegisterTerminationSymbol ${dev1} "exit"

#systemclock must know that this device will be stepped from application
set sc [GetSystemClock]
$sc Add ${dev1}

# Invoke the user extension for just before adding the CPU
if { "${sourceFile}" != "" } {
  set extensionPoint "CPU"
  source ${sourceFile}
}

# start the remote interface client 
if { ${hasUserInterface} == 1 || ${simFeedbackFile} != "" } {
  set ui [new_UserInterface 7777]
}

# Invoke the user extension for tailoring the external objects
if { "${sourceFile}" != "" } {
  set extensionPoint "Gui"
  source ${sourceFile}
}

# also the UI to GUI or Feedback updates after each cycle
if { ${hasUserInterface} == 1 || ${simFeedbackFile} != "" } {
  $sc AddAsyncMember $ui
}

#lets the simulation run until CTRL-C
if { "${gdbEnable}" == 0 } {
  if { "${maxRunTime}" == "" } {
    puts "Simulation running endless, please press CTRL-C to abort"
    $sc Endless
  } else {
    puts "Simulation running (limit=${maxRunTime} ns), \
           please press CTRL-C to abort"
    $sc Run ${maxRunTime}
  }
} else {
  set gdb1 [new_GdbServer ${dev1} ${gdbPort} ${gdbDebugEnable} ${gdbWait}]
  $sc Add ${gdb1}
  set f [open avr-gdb-cmds [list WRONLY CREAT TRUNC]]
  puts $f "file ${AvrExecutable}"
  puts $f "target remote localhost:${gdbPort}"
  puts $f "break main"
  # Invoke the user extension for just adding special gdb commands
  if { "${sourceFile}" != "" } {
    set extensionPoint "GdbCommands"
    source ${sourceFile}
  }
  puts $f "shell rm -f avr-gdb-cmds"
  close $f
  exec xterm -sb -T "AVR GDB ${AvrExecutable}" \
    -e "avr-gdb --command avr-gdb-cmds" &
  after 1000
  $sc Endless
}
exit