upshot.in

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

      set nbytes [gets $logFileHandle string]
   }
   # while reading

   foreach stateName $setting($id,states,list) {
      if {$setting($id,states,$stateName,used) == 0} {
	 # puts "removing $stateName"
	 RemoveState $id $stateName
      } else {
	 unset setting($id,states,$stateName,used)
      }
   }
	    

   close $logFileHandle

   return [CheckForNeededInfo $id]
}


proc Alog_StateDef {id line logfilename lineNo} {
   global setting colorlist bitmaplist global colorNo bitmapNo

   if {[scan $line "%*d %*d %d %d %*d %*d %s %\[^\n\]" startEvt \
	 endEvt coloring stateName]!=4} {
      LogFormatError $logfilename $line $lineNo
   } else {
      if {[info exists setting($id,states,list)] && \
	    [lsearch $setting($id,states,list) $stateName]>=0} {
	 return
      }
      # stateArray(stateName) = {start event, end event, color, \
	    bitmap}
      set color [lindex [split $coloring :] 0]
      if {![string length $color]} {
	 set color [lindex $colorlist $colorNo]
	 incr colorNo
	 if $colorNo==[llength $colorlist] {
	    set colorNo 0
	 }
      }
      # set default color

      set bitmap [lindex [split $coloring :] 1]
      if {![string length $bitmap]} {
	 set bitmap [lindex $bitmaplist $bitmapNo]
	 incr bitmapNo
	 if $bitmapNo==[llength $bitmaplist] {
	    set bitmapNo 0
	 }
      }
      # set default bitmap

      lappend setting($id,states,list) $stateName
      set setting($id,states,$stateName,start) $startEvt
      set setting($id,states,$stateName,end) $endEvt
      set setting($id,states,$stateName,color) $color
      set setting($id,states,$stateName,bitmap) $bitmap
      set setting($id,states,$stateName,used) 0
      # per state settings

      lappend setting($id,startEvents,list) $startEvt
      set setting($id,startEvents,$startEvt) $stateName
      lappend setting($id,endEvents,list) $endEvt
      set setting($id,endEvents,$endEvt) $stateName
#      puts "State $stateName defined:\
#	    $setting($id,states,$stateName,start)\
#	    $setting($id,states,$stateName,end)\
#	    $setting($id,states,$stateName,color)\
#	    $setting($id,states,$stateName,bitmap)\
#	    setting($id,startEvents,$startEvt)=\
#	    $setting($id,startEvents,$startEvt)\
#	    setting($id,endEvents,$endEvt)=\
#	    $setting($id,endEvents,$endEvt)"
	    
   }
}




proc ProcessLog(alog) {id logFileName} {
   global setting alog_process_vs_pre_ratio

   set log [open $logFileName r]

   set lineNo 0
   # line number

   set nbytes [gets $log line]
   while {$nbytes>=0} {
      incr lineNo
      AddPctDone $id [expr $alog_process_vs_pre_ratio*($nbytes+1)]
      
      if [scan $line "%d %d %d %d %d %lf" type proc task data cycle \
	    timestamp]!=6 {
	       LogFormatError $logFileName $line $lineNo
      } else {
	 if {$type>=0 || $type<-100} {
	    if $type==-101 {
	       scan $line "%*d %*d %*d %*d %*d %*lf %d %d" tag size
	       DrawSend $id $proc $data $tag $size \
		     [expr $timestamp+$cycle*$setting($id,rolloverPt)]
		     
	       # pass sender and receiver
	    } elseif $type==-102 {
	       scan $line "%*d %*d %*d %*d %*d %*lf %d %d" tag size
	       DrawRecv $id $proc $data $tag $size \
		     [expr $timestamp+$cycle*$setting($id,rolloverPt)]
	       # pass receiver and sender
	    } else {
	       GatherEvent $id $type $proc \
		     [expr $timestamp+$cycle*$setting($id,rolloverPt)]
	       # gather lone events into states
	    }
	    # check type number
	 }
	 # filter out nonpositive events
      }
      # if !formaterror
      set nbytes [gets $log line]
   }
   # while reading
   
   NoMoreEvents $id
   ClosePctDone $id
   close $log
}
set numTasks 6
set picl_process_vs_pre_ratio 1.5

proc PreprocessLog(picl) {id logfilename} {
   global setting compactList verboseList numTasks picl_process_vs_pre_ratio
   global colorlist bitmaplist

   Picl_GetCompactList compactList verboseList
   # return array of the compact forms of record types, indexed by 
   # verbose name

   set tracefile [open $logfilename r]
   # open the tracefile

   global numTasks

   set maxTime 0
   set maxProc 0
   set nevents 0
   set lineNo 0
   set setting($id,hostProc) 0

   StartPctDone $id \
	 [expr [file size $logfilename]*($picl_process_vs_pre_ratio+1)]
   # set optional percent-done widget to 0

   set nchars [gets $tracefile line]
   while {$nchars>=0} {
      AddPctDone $id [expr $nchars+1]
      incr lineNo

      set type [lindex $line 0]
      if [regexp "^\[a-zA-Z_\]*$" $type] {
	 set verbose 1
	 set type $compactList($type)
      } else {
	 set verbose 0
      }
      set clock [expr {$verbose?(1000000*[lindex $line 2]+[lindex $line 3]): \
	    1000000*[lindex $line 1]+[lindex $line 2]}]
      if $clock>$maxTime {
	 set maxTime $clock
      }
      set node [lindex $line [expr $verbose?5:3]]
      if $node>$maxProc {
	 set maxProc $node
      } elseif $node==-32768 {
	 set setting($id,hostProc) 1
      }
      if $type==4 {
	 Picl_AddState $id send
      } elseif $type==6 {
	 Picl_AddState $id recv
      } elseif $type==7 {
	 Picl_AddState $id recv_blocking
      } elseif $type==10 {
	 Picl_AddState $id sync
      }

      if {$type==20} {
	 set blockType [lindex $line [expr $verbose?7:4]]
	 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]
	 }
	 Picl_AddState $id $stateName
      }
      set nchars [gets $tracefile line]
   }

   set setting($id,states,list) [lsort $setting($id,states,list)]
   set i 0
   foreach stateName [lsort $setting($id,states,list)] {
      set setting($id,states,$stateName,color) \
	    [lindex $colorlist [expr $i%[llength $colorlist]]]
      set setting($id,states,$stateName,bitmap) \
	    [lindex $bitmaplist [expr $i%[llength $bitmaplist]]]
      incr i
   }
      
   set setting($id,numProcs) [expr $maxProc+$setting($id,hostProc)+1]
   # add one to the number of processes if a host is involved
   set setting($id,firstTime) 0
   set setting($id,lastTime) $maxTime
   set setting($id,rolloverPt) 0
}


proc ProcessLog(picl) {id logfilename} {
   global setting compactList verboseList numTasks picl_process_vs_pre_ratio

   set tracefile [open $logfilename r]
   set lineNo 0
   set status(0) 0
   set nchars [gets $tracefile line]
   while {$nchars>=0} {
      incr lineNo
      AddPctDone $id [expr $picl_process_vs_pre_ratio*($nchars+1)]
      Picl_ExtractVerbose compactList line
      Picl_GetTypeTimeNode $id $line type time node
      #puts "$verboseList($type): $type, time: $time, node: $node, line: $line"

      Picl_ReadRecordData($verboseList($type)) $id $time $node status $line \
	    $lineNo
      set nchars [gets $tracefile line]
   }

   NoMoreEvents $id
   # for the drawing stuff
   ClosePctDone $id
   # for the percent-done widget
   close $tracefile
}

proc Picl_GetCompactList {compactList_name verboseList_name} {
   upvar $compactList_name compactList
   upvar $verboseList_name verboseList

   set i 1
   foreach type {trace_start open load send probe recv recv_blocking \
	 recv_waking message sync compstats commstats close \
	 trace_level trace_mark trace_message trace_stop trace_flush \
	 trace_exit block_begin block_end trace_marks} {
      set compactList($type) $i
      set verboseList($i) $type
      incr i 
   }
}



proc Picl_ExtractVerbose {compactList_name line_name} {
   upvar $line_name line
   upvar $compactList_name compactList

   set type [lindex $line 0]
   if {[regexp "^\[a-zA-Z_\]*$" $type]} {
      set line [lreplace $line 0 0 $compactList($type)]
        # replace the verbose type
      lremove line {1 4}
        # remove 'clock' and 'node'

      case $type in {
	 {trace_start send recv recv_waking trace_level block_begin block_end}
	    {lremove line {4 6 8}}
	    # remove three verbose names

	 {recv_blocking trace_mark trace_flush trace_exit}
	    {lremove line 4}
	 # remove one verbose name

	 {open} {
	    if {[llength $line]!=4} {
	       lremove line {4 6}
	    }
	 }

	 {load} {
	    lremove line {4 5}
	 }
      }
   }
}



proc Picl_AddState {id name} {
   global bitmaplist colorList setting

   if ![info exists setting($id,states,max_id)] {
      set setting($id,states,max_id) 0
      set setting($id,states,list) ""
   }
   if [lsearch $setting($id,states,list) $name]>=0 {
      return
   }

   set state_id [expr $setting($id,states,max_id)+1]
   set start [expr $state_id*2]
   set end  [expr $state_id*2+1]
   lappend setting($id,states,list) $name

   set setting($id,states,$name,start) $start
   lappend setting($id,startEvents,list) $start
   set setting($id,startEvents,$start) $name

   set setting($id,states,$name,end) $end
   lappend setting($id,endEvents,list) $end
   set setting($id,endEvents,$end) $name
   # state id, start and end events

   incr setting($id,states,max_id)

#   puts "Add state $name: $setting($id,states,$name,start)\
#	 $setting($id,states,$name,end)"
}

proc Picl_GetTypeTimeNode {id line type_name time_name node_name} {
   upvar $type_name type
   upvar $time_name time
   upvar $node_name node
   global setting

   set type [lindex $line 0]
   set time [expr 1000000*[lindex $line 1]+[lindex $line 2]]
   set node [lindex $line 3]
   if $setting($id,hostProc) {
      incr node
      if $node==-32767 {
	 set node 0
      }
   }
}



foreach doNothingFn {trace_start open load probe message \
      commstats close message \
      trace_level trace_mark trace_message trace_stop trace_flush \
      trace_exit trace_marks} {
   proc Picl_ReadRecordData($doNothingFn) {id time node status_name \
	 line lineNo} {}
}



proc Picl_ReadRecordData(send) {id time node status_name line lineNo} {
   # Send events are short events in the PICL traceformat; they are not
   # explicitly given length.  You must check for a matching 'compstats'
   # event that may point out overhead involved in the send.  For example:
   #   Send at 5.3 sec.
   #   Compstat at 5.3 sec. reporting x idle time
   #   Compstat at 5.7 sec. reporting x+.4 idle time
   #
   # Kind of a bass-ackwards way of doing it, but oh well...
   # So, we want to remember that we just did a 'send', and if a 'compstat'
   # occurs, check if the time matches the last send (or recv or sync), if so,
   # the next compstat should tell up how much idle time we have there.

   global setting
   upvar $status_name status

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

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

   # record time, receiver, type, and length of message

   set status($node,send,receiver) $receiver
   set status($node,send,type) $type
   set status($node,send,len) $len
   GatherEvent $id $setting($id,states,send,start) $node $time
}
   

proc Picl_ReadRecordData(recv) {id time node status_name line lineNo} {
   # see comments for Picl_ReadRecordData(send)

   global setting
   upvar $status_name status

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

   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 $lineNo:\n$line"
      return -1
      # error in the format
   }

   # record time, sender, type, and length of message
   set status($node,recv,sender) $sender
   set status($node,recv,type) $type
   set status($node,recv,len) $len
   GatherEvent $id $setting($id,states,recv,start) $node $time
}
   

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

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

   GatherEvent $id $setting($id,states,recv_blocking,start) $node $time
}
   

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