upshot.in

MPICH是MPI的重要研究,提供了一系列的接口函数,为并行计算的实现提供了编程环境.

   if {[llength $line] == 7} {
      set sender [lindex $line 4]
      set type [lindex $line 5]
      set len [lindex $line 6]
   } else {
      puts "Error in format of line: $line"
      return -1
      # error in the format
   }

   # record time, sender, type, and length of message
   DrawRecv $id $node $sender $type $len $time
   GatherEvent $id $setting($id,states,recv_blocking,end) $node $time
}

proc Picl_ReadRecordData(block_begin) {id time node status_name line lineNo} {
   # see comments for ReadRecordData(send)
   global numTasks setting

   if {[llength $line] == 7} {
      set blockType [lindex $line 4]
   } else {
      puts "Error in format of line $lineNo:\n$line"
      return -1
      # error in the format
   }

   set stateNum [expr $blockType%$numTasks]

   if $blockType==-1 {
      set stateName barrier
   } elseif $blockType==-2 {
      set stateName bcast0
   } elseif $blockType==-3 {
      set stateName bcast1
   } elseif $blockType==-4 {
      set stateName globalOp
   } else {
      set stateName state_[expr $blockType%$numTasks]
   }
   
   GatherEvent $id $setting($id,states,$stateName,start) $node $time
}
   

   

proc Picl_ReadRecordData(block_end) {id time node status_name line lineNo} {
   # see comments for ReadRecordData(send)
   global numTasks setting

   if {[llength $line] == 7} {
      set blockType [lindex $line 4]
   } else {
      puts "Error in format of line $lineNo:\n$line"
      return -1
      # error in the format
   }

   set stateNum [expr $blockType%$numTasks]

   if $blockType==-1 {
      set stateName barrier
   } elseif $blockType==-2 {
      set stateName bcast0
   } elseif $blockType==-3 {
      set stateName bcast1
   } elseif $blockType==-4 {
      set stateName globalOp
   } else {
      set stateName state_[expr $blockType%$numTasks]
   }

   GatherEvent $id $setting($id,states,$stateName,end) $node $time
}


   

proc Picl_ReadRecordData(sync) {id time node status_name line lineNo} {
   # see comments for Picl_ReadRecordData(send)
   global setting
   upvar $status_name status

   set status($node,mode) sync
   set status($node,time) $time

   # record time
   GatherEvent $id $setting($id,states,sync,start) $node $time
}
   

proc Picl_ReadRecordData(compstats) {id time node status_name line lineNo} {
   # see comments for Picl_ReadRecordData(send)
   global setting
   upvar $status_name status
   
   if {![info exists status($node,mode)]} {
      # if this node has never been called, give it a resting status and
      # null mode
      set status($node,status) 0
      set status($node,mode) ""
   }

   if {[lsearch {send recv sync} $status($node,mode)]>-1} {
      # the node is in send/recv/sync mode
      if {$status($node,status)} {
	 # active status
	 GatherEvent $id $setting($id,states,$status($node,mode),end) $node \
	       $time
	 # end the state
	 if ![string compare $status($node,mode) send] {
	    DrawSend $id $node $status($node,send,receiver) \
		  $status($node,send,type) $status($node,send,len) $time
	 } elseif ![string compare $status($node,mode) recv] {
	    DrawRecv $id $node $status($node,recv,sender) \
		  $status($node,recv,type) $status($node,recv,len) $time
	 }

	 set status($node,mode) ""
	 set status($node,status) 0
	 # clear the status
      } elseif {$time==$status($node,time)} {
	 # this time matches that time in the mode, thus this compstat
	 # if meant to time this mode
	 set status($node,status) 1
	 # active status
      } else {
	 puts "compstat at $time does not match $status($node,mode) at \
	       $status($node,time)."
      }
   } else {
      # puts "compstat at $time is for what?"
   }
}
set gatherEvt(proclist) ""
proc GatherEvent {id type procnum time} {
   # Gather single events into states
   # one list is kept for each process (gatherEvt(0-x)), new start events
   # are added to the end; when removed, succeeding events slide down;
   # when drawn, the index is taken as the overlap level
   #
   # gatherEvt(proclist) - list of process numbers encountered
   # gatherEvt($procnum,nstates) - size of the list of states on each \
	 this process
   # gatherEvt($procnum,states,x) - list of states the process is in
   # gatherEvt($procnum,times,x) - times each of the current states started
   global setting gatherEvt

   # might need to check if the array has been created yet

   # puts "GatherEvent $id $type $procnum $time"

   set idx [lsearch $setting($id,startEvents,list) $type]
   if $idx==-1 {
      set idx [lsearch $setting($id,endEvents,list) $type]
      if $idx==-1 {
	 DrawEvent $id $type $procnum $time
	 return
      } else {
	 set stateName $setting($id,endEvents,$type)
	 set isStartEvent 0
      }
   } else {
      set stateName $setting($id,startEvents,$type)
      set isStartEvent 1
   }
   # get the state name by checking start and end event lists
   if $isStartEvent {
      GatherAddState $procnum $stateName $time

#      puts "State added:"
#      for {set i 0} {$i<$gatherEvt($procnum,nstates)} {incr i} {
#	 puts "slot $i: $gatherEvt($procnum,states,$i)\
#	       $gatherEvt($procnum,times,$i)"
#      }

      # add to the list of states that need to be finished
   } else {
      set idx [GatherRemoveState $procnum $stateName]
      # state name is removed, but the time remains in $procnum,times,$idx
      if $idx==-1 {
	 puts "End state $stateName without start at $time"
      } else {
	 set startTime $gatherEvt($procnum,times,$idx)
	 DrawTimeBar $id $stateName $startTime $time $procnum $idx
      }
   }
}

proc GatherAddState {procnum name time} {
   global gatherEvt

   if ![info exists gatherEvt($procnum,nstates)] {
      lappend gatherEvt(proclist) $procnum
      set gatherEvt($procnum,nstates) 1
      set gatherEvt($procnum,states,0) $name
      set gatherEvt($procnum,times,0) $time
   } else {
      for {set i 0} {$i<$gatherEvt($procnum,nstates)} {incr i} {
	 if ![string compare $gatherEvt($procnum,states,$i) ""] {
	    set gatherEvt($procnum,states,$i) $name
	    set gatherEvt($procnum,times,$i) $time
	    return
	 }
      }
      set i $gatherEvt($procnum,nstates)
      set gatherEvt($procnum,states,$i) $name
      set gatherEvt($procnum,times,$i) $time
      incr gatherEvt($procnum,nstates)
   }

#   puts "added $name to process $procnum:"
#   for {set i 0} {$i<$gatherEvt($procnum,nstates)} {incr i} {
#      puts "  $gatherEvt($procnum,states,$i)"
#   }

}

proc GatherRemoveState {procnum name} {
   # don't remove the time from $procnum,times,$idx
   global gatherEvt

   if ![info exists gatherEvt($procnum,nstates)] {
      return -1
   }
   set i [expr $gatherEvt($procnum,nstates)-1]
   if $i>=0 {
      if ![string compare $gatherEvt($procnum,states,$i) $name] {
	 incr gatherEvt($procnum,nstates) -1

#   puts "removed $name from process $procnum:"
#   for {set j 0} {$j<$gatherEvt($procnum,nstates)} {incr j} {
#      puts "  $gatherEvt($procnum,states,$j)"
#   }

	 return $i
      } else {
	 for {incr i -1} {$i>=0} {incr i -1} {
	    if ![string compare $gatherEvt($procnum,states,$i) $name] {
	       set gatherEvt($procnum,states,$i) ""

#   puts "removed $name from process $procnum:"
#   for {set j 0} {$j<$gatherEvt($procnum,nstates)} {incr j} {
#      puts "  $gatherEvt($procnum,states,$j)"
#   }

	       return $i
	    }
	 }
	 return -1
      }
   }
   return -1
}


proc NoMoreEvents {id} {
   # flush the events that may still be waiting to finish

   global setting gatherEvt

   # go through the list for each process
   if ![info exists gatherEvt(proclist)] return
   foreach procnum $gatherEvt(proclist) {
      # if it is in >0 states,
      if $gatherEvt($procnum,nstates) {
	 # check each of these states
	 for {set i [expr $gatherEvt($procnum,nstates)-1]} {$i>=0} \
	       {incr i -1} {
	    # if the state is non-null
	    if [string compare $gatherEvt($procnum,states,$i) ""] {
	       DrawTimeBar $id $gatherEvt($procnum,states,$i) \
		     $gatherEvt($procnum,times,$i) \
		     $setting($id,lastTime) $procnum $i
	    }
	 }
      }
   }

   unset gatherEvt
}

#proc DrawTimeBar {id state start end proc overlap tags} {
#   puts "time bar from $start to $end: $id $state $proc $overlap $tags"
#}
proc PrintLegend {id left top right bottom} {
   global fg bg blackWhite bitmapdir setting

   set canvas $setting($id,tlc)
   # margins
   set marginVert 5
   set marginHoriz 5
   # dimensions of boxes with sample color or bitmap
   set boxWidth 45
   set boxHeight 15
   set boxMiddle [expr $boxHeight/2]
   # space between box and corresponding label
   set spcBtwnBoxLbl 10
   # space between label and the next box
   set spcBtwnLblBox 20
   # vertical spacing between rows of boxes&labels
   set spcVert 5

   if ![string compare $setting($id,states,list) {}] {
      return 0
   }

   set ycor $top
   foreach stateName [lsort $setting($id,states,list)] {
      if {$blackWhite} {
	 $canvas create rectangle $right $ycor [expr $right+$boxWidth] \
	       [expr $ycor+$boxHeight]  -fill $fg \
	       -outline $fg -tags [list tempPrint legend l_$stateName] \
	       -stipple @${bitmapdir}/$setting($id,states,$stateName,bitmap)
      } else {
	 $canvas create rectangle $right $ycor [expr $right+45] \
	       [expr $ycor+15] -outline $fg \
	       -fill $setting($id,states,$stateName,color) \
	       -tags [list tempPrint legend l_$stateName]
      }
      $canvas create text [expr $right+$boxWidth+$spcBtwnBoxLbl] \
	    [expr $ycor+$boxMiddle]  -anchor w -text $stateName \
	    -tags [list tempPrint legend l_$stateName] -fill $fg
      #set y-coordinate of next box and label
      set ycor [expr [lindex [$canvas bbox l_$stateName] 3]+$spcVert]
   }
   
   set AddToLine {
      lappend thisLine $stateName
      if {$bheight>$maxHeight} {set maxHeight $bheight}
      set availWidth [expr $availWidth-$bwidth-$spcBtwnLblBox]
   }
   set ResetLine {
      lappend legendLines [list $thisLine $maxHeight]
      set maxHeight 0
      set availWidth $width
      set thisLine {}
   }

   set width [expr $right-$left-2*$marginHoriz]
   # legendLines = list of {maxHeight {0 1 2...}}
   set legendLines {}
   set availWidth $width
   # maxHeight = tallest state in this line
   set maxHeight 0
   # thisLine = {0 1 2... (which states are in this line)}
   set thisLine {}
   foreach stateName [lsort $setting($id,states,list)] {
      # get width of current box and label
      set bwidth [expr "[lindex [$canvas bbox l_$stateName] 2]-\
	    [lindex [$canvas bbox l_$stateName] 0]"]
      set bheight [expr "[lindex [$canvas bbox l_$stateName] 3]-\
	    [lindex [$canvas bbox l_$stateName] 1]"]
      if {$availWidth>($bwidth+$spcBtwnLblBox)} {
	 # if this state fits, good
	 eval $AddToLine
      } elseif {[llength $thisLine]==0} {
	 # if this state is too long, but the only one on the line,
	 # well, tough luck.
	 eval $AddToLine
	 eval $ResetLine
      } else {
	 # state is too long, go to next line
	 eval $ResetLine
	 eval $AddToLine
      }	 
   }
   if {[llength $thisLine]!=0} {eval $ResetLine}

   set startVert [expr $top+$spcVert-$marginVert]
   foreach line $legendLines {
      set startVert [expr $startVert-[lindex $line 1]-$spcVert]
   }
   # create border and cover up unwanted stuff
   set border [$canvas create rectangle $left \
	 [expr $startVert-$marginVert] $right $top \
	 -fill $bg -outline $fg -tags {tempPrint border}]
   # push border under the legend entries
   $canvas lower $border legend
   $canvas addtag legend withtag $border
   
   set vert $startVert
   foreach line $legendLines {
      set horiz [expr $left+$marginHoriz]
      foreach stateName [lindex $line 0] {
	 $canvas move l_$stateName \
	       [expr $horiz-[lindex [$canvas bbox l_$stateName] 0]] \
	       [expr $vert-[lindex [$canvas bbox l_$stateName] 1]]
	 set horiz \
	       [expr [lindex [$canvas bbox l_$stateName] 2]+$spcBtwnLblBox]
      }
      set vert [expr $vert+[lindex $line 1]+$spcVert]
   }
   return [expr $startVert-$marginVert]
}


proc PrintProcNums {id left top right bottom} {
   global fg bg setting

   set procNums $setting($id,pnc)
   set canvas $setting($id,tlc)
   set scrollregion [lindex [$procNums configure -scrollregion] 4]
   set pleft  [lindex $scrollregion 0]
   set pright [lindex $scrollregion 2]

   set visibleProc [$procNums find overlapping $pleft $top $pright $bottom]
   set offset [expr $left-$pright]
   foreach process $visibleProc {
      set coords [$procNums coords $process]
      set xcoord [expr [lindex $coords 0]+$offset]
      set ycoord [lindex $coords 1]
      set label [lindex [$procNums itemconfigure $process -text] 4]
      $canvas create text $xcoord $ycoord -text $label -tags \
	    {tempPrint procNums} -fill $fg -anchor e
   }
   return [expr $left+$pleft-$pright]
}

proc PrintTempObjects {id} {
   global numDHashMarks ndigitsPrecD fg bg setting

   set canvas $setting($id,tlc)
   set procNums $setting($id,pnc)
   set left   [$canvas canvasx 0]
   set top    [$canvas canvasy 0]
   set right  [expr [winfo width  $canvas]+$left]
   set bottom [expr [winfo height $canvas]+$top]
   set topMargin 20
   set rightMargin 20

   # temporarily create border rectangle
   $canvas create rectangle $left $top $right $bottom \
	 -tags {tempPrint border} -outline $fg

   # draw hash marks and labels
   for {set i 0} {$i<$numDHashMarks} {incr i} {
      set xpos [expr ($i+.5)/$numDHashMarks*($right-$left)+$left]
      $canvas create line $xpos $bottom $xpos [expr $bottom+12] \
	    -tags {tempPrint hashMark} -fill $fg
      #build variable name and evaluate
      # eval set val $[join [list scaleLabel $i] {}]
      $canvas create text $xpos [expr $bottom+15] \