#
# CSCE 451/851
# Homework #1
# Question #10
# Script to print the call trace for context switching
#
# Robert Hill
# March 2, 1998
#
# To use this script, you should start SmartGDB on your nachos executable 
# from the nachos/test subdirectory.  Then, configure your arguments to
# Nachos, load this script, and run Nachos:
#
#      cd nachos/test
#      smartgdb ../userprog/nachos
#      conf args -x fork-yield
#      source Prob10-routines.tcl
#      run
#
# You can then type 'c' to continue from each breakpoint
#

#
# Find the value of an expression in SmartGDB
#
proc value {expression} {
  set lst [ p $expression ]
  set ind [ lsearch $lst "=" ]
  if { $ind == -1 } {
    return [ lindex $lst [ expr [ llength $lst ] - 1 ] ]
  } else {
    return [ lrange $lst [ expr $ind + 1 ] [ expr [ llength $lst ] - 1 ] ]
  }
}

#
# Return just the numeric value for an expression
#
proc actualvalue {expression} {
  set val [ value $expression ]
  set lastval [ lindex $val [ expr [ llength $val ] - 1 ] ]
}


#
# Print the name and value of an expression
#
proc printout {val} {
  puts -nonewline "$val = "
  puts [ value $val ]
}


#
# Set a breakpoint and attach a TCL procedure to it
#
proc breakproc {breakpoint procedure} {
  set output [ b $breakpoint ]
  set lines [ split $output \n ]
  set loc [ expr [ llength $lines ] - 2 ]
  set number [ lindex [ lindex $lines $loc ] 1 ]
  setproc $number $procedure
}

#
# Print the current Thread if there is one
#
proc printcurrent {} {
  if { [ actualvalue currentThread ] != 0x0 } {
    printout currentThread->ThreadID
  } else {
    puts "No current thread"
  }
}


#
# TCL Procedures to attach to breakpoints
#
proc exceptionhandler {} {
  printcurrent
  printout which
  printout type
}

proc raiseexception {} {
  printcurrent
  printout which
}

proc dosystemcall {} {
  printcurrent
  printout syscall_num
  printout reg4
  printout reg5
  printout reg6
  printout reg7
}

proc threadfork {} {
  printout func
  printout arg
}

proc copyfrom {} {
  printcurrent
  printout ((Thread*)voidOurThread)->ThreadID
}

proc setlevel {} {
  printcurrent
  printout level
  printout now
}

proc readytorun {} {
  printcurrent
  printout thread->ThreadID
}

proc findnexttorun {} {
  printcurrent
  set val [ actualvalue scheduler->readyList->first ]
  if { $val != 0x0 } {
    printout ((Thread*)(scheduler->readyList->first->item))->ThreadID
  } else {
    puts "ReadyList is Empty"
  }
}

proc schedulerrun {} {
  printcurrent
  printout nextThread->ThreadID
}


#
# Attach TCL Procedures to breakpoints
#
breakproc Machine::RaiseException  raiseexception
breakproc System_Fork              printcurrent
breakproc System_Yield             printcurrent
breakproc Thread::Thread           printcurrent
breakproc Thread::Fork             threadfork
breakproc Thread::Yield            printcurrent
breakproc Do_Fork                  printcurrent
breakproc AddrSpace::CopyFrom      copyfrom
breakproc Interrupt::SetLevel      setlevel
breakproc Scheduler::ReadyToRun    readytorun
breakproc Scheduler::FindNextToRun findnexttorun
breakproc Scheduler::Run           schedulerrun
breakproc TimerInterruptHandler    printcurrent
breakproc Interrupt::YieldOnReturn printcurrent
breakproc exception.cc:57          exceptionhandler
breakproc systemcall.cc:31         dosystemcall