#
# $Log: not supported by cvs2svn $
# Revision 1.80  2007/01/18 15:44:31  soliday
# Updated to work with the new domain names.
#
# Revision 1.79  2007/01/18 00:18:03  soliday
# Changed info hostname command to exec hostname command because of recent
# problems seen in the controlroom.
#
# Revision 1.78  2004/04/28 15:40:01  soliday
# Replaced dp_RPC calls with comm calls because comm is still supported by the
# Tcl community.
#
# Revision 1.77  2004/02/10 15:57:59  borland
# When an error occurs, the status text is turned red to make sure the user
# doesn't miss it.
#
# Revision 1.76  2003/10/29 19:08:20  soliday
# Added the stackPrefix option to APSMpStep
#
# Revision 1.75  2003/10/28 23:27:21  soliday
# Moved call to APSLogScriptAction so that calls to APSMpStep from
# parallel PEMs will also be logged.
#
# Revision 1.74  2003/10/27 16:31:00  soliday
# Parallel processes now log the correct stack.
#
# Revision 1.73  2003/09/24 14:55:45  soliday
# It no longer stops if the logDaemon is not running.
#
# Revision 1.72  2003/09/03 17:26:44  soliday
# Added package require dp command.
#
# Revision 1.71  2003/01/23 19:41:55  soliday
# The accelerator subnet changed to accel.ntw0rk
#
# Revision 1.70  2002/07/11 17:36:48  borland
# Reverted to prior version.
#
# Revision 1.68  2001/01/31 19:02:14  soliday
# Increased width of screen.
#
# Revision 1.67  2000/12/04 20:58:56  soliday
# Fixed some problems with logMessage.
#
# Revision 1.66  2000/12/04 19:36:13  soliday
# Fixed problem with last change.
#
# Revision 1.65  2000/12/04 19:16:59  soliday
# Changed logMessage commands and added APSLogScriptAction.
#
# Revision 1.64  2000/05/04 15:52:23  borland
# Now detects if the error message is blank and makes a default message.
# This works around a bug in the logMessage/logDaemon progrmas.
#
# Revision 1.63  2000/03/17 23:07:10  borland
# Added logging of errors to PEMErrorLog file using logDaemon.
#
# Revision 1.62  1999/12/09 16:02:40  soliday
# Displays the correct step name when a subprocedure is many levels deep
#
# Revision 1.61  1999/12/09 15:56:42  soliday
# If a process is running without a window APSMpStep now sends its output
# up the chain to the first process with a window.
#
# Revision 1.60  1999/04/20 16:35:33  soliday
# When the dialog box is closed by the window manager it now aborts the pem
# procedure.
#
# Revision 1.59  1999/02/16 22:10:38  soliday
# Fixed the Cancel button by having it act the same as the abort button
#
# Revision 1.58  1998/11/19 18:55:32  soliday
# Replaced some exec commands with native tcl commands.  Also added an
# dp_RPC call to set the return code and value prior to exiting APSMpReturn.
#
# Revision 1.57  1998/11/10 21:11:12  borland
# Fixed problem with return value not getting set in multi-level parallel
# procedures.   I created some backup return variables that are set from
# the child process using dp_RPC.  Look at the end of runMP or in
# APSMpJoin for details.
#
# Revision 1.56  1998/11/09 21:40:43  soliday
# Added Abort button to child windows.
#
# Revision 1.55  1998/11/06 22:25:36  borland
# Fixed problems with interprocess communcation (?) that prevented proper
# abort and exit operation.
#
# Revision 1.54  1998/04/22 18:03:18  borland
# Now works with tcl 8.0 and dp 4.0
# Also improved debugging features.
#
# Revision 1.53  1996/12/16 16:38:32  saunders
# Fixed race condition in abort sequence. Added info exists test in
# MpAbort for childPortToSd, since normal exit of child may unset this,
# but leave apsMpParallelList populated. Also added a debugging switch
# for future diagnosis work.
#
# Revision 1.52  1996/11/14 19:04:43  saunders
# Added APSMpButton routine and support code in other sections.
#
# Revision 1.51  1996/11/13 19:15:00  saunders
# Added APSMpSetScrolledStatusSize procedure.
#
# Revision 1.50  1996/10/17 21:20:59  saunders
# Numerous changes made to implement logDaemon logging of machine
# procedure execution Start,Finish,Error,Abort. Currently logs all
# pem and parallel procedures. More work needed to selectively log
# only call level 2 procedures (ie. only highest level).
#
# Revision 1.49  1996/09/25 16:29:13  saunders
# Added buttons to scrolled status widgets.
#
# Revision 1.48  1996/09/16 16:13:26  saunders
# Set up File/Quit button to do clean abort.
#
# Revision 1.47  1996/08/08 19:00:51  saunders
# Added abort button to initDialog in runMP.
#
# Revision 1.46  1996/07/30 16:56:03  saunders
# Implemented form of MUTEX on MpAbort so that it cannot occur during
# execution of APSMpParallel.
#
# Revision 1.45  1996/07/30 16:16:17  saunders
# More intermediate abort work.
#
# Revision 1.44  1996/07/30 16:08:17  saunders
# Restored immediate abort. Problem with abort request: when in Manual
# mode, abort will not take effect until you hit Continue button.
# Must now implement some sort of MUTEX on APSMpParallel so that abort
# cannot take effect within APSMpParallel, leaving resources hanging.
#
# Revision 1.43  1996/07/30 13:41:50  saunders
# Changed absolute abort to an abort request. Request is checked at
# beginning of each APSMpStep. This to prevent all sorts of errors
# that can crop up when a client exits suddenly.
#
# Revision 1.42  1996/07/29 21:32:47  saunders
# Fixing yet another race condition raised by aborting a procedure
# which has outstanding parallel procedures.
#
# Revision 1.41  1996/07/29 20:50:55  saunders
# Moving abort functions in runMP from exit callback to a separate
# function called MpAbort. This to avoid some race conditions due
# to the order in which callback activity is scheduled.
#
# Revision 1.40  1996/07/29 20:40:13  saunders
# Bug fix in runMP related to abort function.
#
# Revision 1.39  1996/07/29 20:35:51  saunders
# Abort button added to PEM which aborts selected procedure and any
# outstanding spawned parallel procedures.
#
# Revision 1.38  1996/07/26 19:43:44  saunders
# Removed unnecessary output to status window.
#
# Revision 1.37  1996/07/26 15:26:43  saunders
# Fixed minor problem whereby error return from lower-level machine
# procs is not being printed.
#
# Revision 1.36  1996/07/25 15:53:42  saunders
# Changed automatic APSMpJoin so that errors are caught, but ignored.
#
# Revision 1.35  1996/07/24 22:09:50  saunders
# Modified return mechanism to use tcl error return. Catch should now
# be used to check return from machine procedures.
#
# Revision 1.34  1996/07/01 16:19:18  saunders
# Fixed scrolling of steps displayed during execution.
#
# Revision 1.33  1996/06/27 19:34:23  saunders
# Pem now honors the APSDebugPath as well as pem cwd. Note that pem cwd
# does supersede any path additions via APSDebugPath.
#
# Revision 1.32  1996/06/24 15:53:47  saunders
# Fixed bug with button enable/disable behavior. Tidied up some
# status messages.
#
# Revision 1.31  1996/06/21 21:02:38  saunders
# Add to APSMpReturn so that user is forced to acknowledge an error
# return from a procedure if $mpInterface is 1.
#
# Revision 1.30  1996/06/20 20:48:03  saunders
# Removed error reporting on dp_CloseRPC call in mpExit. It is
# possible for this to fail, but it shouldn't matter, since
# the parent process is exiting anyways.
#
# Revision 1.29  1996/06/20 18:24:48  saunders
# Added call to APSStandardSetup when no interface requested.
#
# Revision 1.28  1996/06/18 20:11:46  saunders
# Added APSMpParallel/APSMpJoin capability. Required a number of
# modifications to pem and related scripts.
#
# Revision 1.27  1996/04/30 21:29:59  saunders
# Added lib_patch to auto_path of runMP.
#
# Revision 1.26  1996/03/04  22:29:02  saunders
# Improved display of green and red status for steps.
#
# Revision 1.25  1996/03/04  21:59:37  saunders
# Another minor fix.
#
# Revision 1.24  1996/03/04  21:35:37  saunders
# Removed stupid "y" char at beginning which emacs put in there.
#
# Revision 1.23  1996/03/04  21:13:39  saunders
# Added "semi-automatic" mode.
#
# Revision 1.22  1996/01/31  20:57:13  saunders
# Fixed execution when calling machine procedures hierarchically.
#
# Revision 1.21  1996/01/31  19:43:16  saunders
# APSMpReturn proc now uses "return -code return".
#
# Revision 1.20  1996/01/31  19:39:34  saunders
# Interface improvements. Arguments now passed to mp, and a dialog can
# be specified for prompting user at each mpStep.
#
# Revision 1.19  1996/01/30  17:02:55  saunders
# Odd stuff.
#
# Revision 1.18  1996/01/30  00:05:17  saunders
# Added manual mode "continue", and "prompt" buttons.
#
# Revision 1.17  1996/01/29  23:27:04  saunders
# Steps shown on the fly now, not up-front.
#
# Revision 1.16  1996/01/29  23:10:09  saunders
# Added update.
#
# Revision 1.15  1996/01/29  23:06:51  saunders
# Assorted changes
#
# Revision 1.14  1996/01/29  21:29:46  saunders
# Now default args can be passed to machine procedure from pemConfig file.
#
# Revision 1.13  1996/01/29  17:27:04  saunders
# Minor status report format changes.
#
# Revision 1.12  1996/01/28  21:51:44  saunders
# Add which executable is generating alert dialog (confusing).
#
# Revision 1.11  1996/01/28  21:43:34  saunders
# Another var scope bug fix.
#
# Revision 1.10  1996/01/28  21:40:09  saunders
# Var scope bug fix (pemSd).
#
# Revision 1.9  1996/01/28 21:34:29  saunders
# Added code which attempts to recover after IPC failure when possible.
#
# Revision 1.8  1996/01/28  03:14:29  saunders
# Added catch statements to all dp calls. Must look more into when
# I can clean up, and when I must exit completely.
#
# Revision 1.7  1996/01/25  22:57:54  saunders
# Added unique number to uniquely identify open socket descriptor when
# async callback occurs. This should fix interleaving problem when
# multiple instances of one procedure are rapidly executed.
#
# Revision 1.6  1996/01/25  20:20:16  saunders
# Minor improvements.
#
# Revision 1.5  1996/01/25  17:12:55  saunders
# More fixes to auto_load.
#
# Revision 1.4  1996/01/25  16:59:24  saunders
# Using tcl auto_load to load in machine procedure.
#
# Revision 1.3  1996/01/25  16:39:53  saunders
# Current working directory of PEM now passed in context to runMP.
#
#

set hostArch [lindex $argv 2]
set auto_path [linsert $auto_path 0 /usr/local/oag/apps/lib/$hostArch]
set auto_path [linsert $auto_path 0 /usr/local/oag/lib_patch/$hostArch]
set cwd [pwd]
set auto_path [linsert $auto_path 0 $cwd]

#APSDebugPath

set returnValuesFromMpReturn ""

set fpDebug ""
set runMPDebug 0
proc Debug {msg} {
    global runMPDebug fpDebug
    if {$runMPDebug && ![string length $fpDebug]} {
        set fpDebug [open /tmp/runMP.[pid].log w]
    }
    if {$runMPDebug} {
	puts $fpDebug "$msg"
        flush $fpDebug
    }
}

Debug "runMPstarting: [clock format [clock seconds]]"
Debug "arguments: [join $argv ,]"
Debug "library: [info library]"
Debug "vars: [info vars]"
foreach item [info vars] {
    catch {Debug "$item: [subst \$$item]"}
}

# The PEM passes its port number as argument 1
set pemServerPort [lindex $argv 0]
set pemHost [lindex $argv 1]
set mpInterface [lindex $argv 3]
set pemUser [lindex $argv 4]
set pemGeometry [lindex $argv 5]
set pemStack [lindex $argv 6]

# Create a user interface only if run from PEM. This allows me to
# reuse this code to implement APSMpParallel and APSMpJoin.

if {!$mpInterface} {
    wm withdraw .
} else {
    if {[llength $pemGeometry]} {
        wm geometry . +[join [lrange [split $pemGeometry +] 1 2] +]
    }
}

# Get standard setup, but override apsScriptUser, as inetd doesn't have one
APSStandardSetup
set apsScriptUser $pemUser
set apsPemStackPrefix $pemStack

#
# Initialize execution context variables (usually reset by PEM)
set execMode "Semi-Automatic"
set cwd "."

set hostName [exec hostname]
set status "Initializing..."
set exitFlag 0
set firstPromptDialog 1

# List of buttons currently added to runMP interface by machine procedure
set apsMpButtonList {}

# Globals needed for implementing abort function
set parallelAbort 0
set abortHold 0
set abortRequest ""

# For manual mode. Allows user to do one APSMpStep at a time.
set continue 0
set done 0
set ackError 0

if {$mpInterface} {
    #
    # Set up graphical interface for runMP process
    #
    APSApplication . -name "MP Host $hostName" -version 1.0 \
        -overview "Coordinates execution and displays status of a single machine procedure." \
        -contextHelp "Coordinates execution and displays status of a single machine procedure."

    # Configure File/Quit so it aborts machine procedure cleanly.
    # .menu.file.menu entryconfigure Quit -command "MpAbort pem"
    
    APSScrolledStatus .ss -parent .userFrame -textVariable status \
	-packOption "-side top -fill x" -height 8 -withButtons 1\
	-contextHelp "Provides execution status and operation hints." \
	-width 80

    APSScrolledText .procSteps -parent .userFrame -contextHelp \
        "Shows execution of steps in machine procedure."
    set steps .userFrame.procSteps.text
    $steps tag configure currentTag -background green
    $steps tag configure stopTag -background red
    
    APSFrameGrid .stepButtons -parent .userFrame -xList {frame} \
        -packOption "-side top -fill both"
    
    APSButton .continue -parent .userFrame.stepButtons.frame -text "Continue" \
        -command "set continue 1"
    set continueButton .userFrame.stepButtons.frame.continue.button
    APSButton .done -parent .userFrame.stepButtons.frame -text "Done" \
        -command "set done 1"
    set doneButton .userFrame.stepButtons.frame.done.button
    APSButton .ackError -parent .userFrame.stepButtons.frame -text \
        "Acknowledge Error" -command "set ackError 1"
    set ackErrorButton .userFrame.stepButtons.frame.ackError.button
    APSButton .abort -parent .userFrame.stepButtons.frame -text "Abort" \
	-command {MpAbort pem}
    APSDisableButton $doneButton
    APSDisableButton $ackErrorButton
    
    tkwait visibility $ackErrorButton
}
if {![info exists env(useDP)]} {
    set env(useDP) 0
}

if {$env(useDP)} {
    package require dp
} else {
    if {[info exists tcl_pkgPath]} {
        set snitFile [file join [lindex $tcl_pkgPath 0] tcllib1.18 snit snit2.tcl]
        if {($tcl_platform(os) == "Linux") && [file exists $snitFile]} {
            source $snitFile
        } else {
            package require snit
        }
    } else {
        package require snit
    }
    if {[info exists tcl_pkgPath]} {
        set commFile [file join [lindex $tcl_pkgPath 0] tcllib1.18 comm comm.tcl]
        if {($tcl_platform(os) == "Linux") && [file exists $commFile]} {
            source $commFile
        } else {
            package require comm
        }
    } else {
        package require comm
    }
}


# Connect to the PEM's server port so we can communicate our status.
if {$env(useDP)} {
    if {[catch {dp_MakeRPCClient $pemHost $pemServerPort} result]} {
        Debug "pemHost = $pemHost"
        Debug "pemServerPort = $pemServerPort"
        Debug "result: $result"
        if {$mpInterface} {
            APSAlertBox .ipcFail -errorMessage "runMP: >dp_MakeRPCClient $pemHost $pemServerPort< call failed: $result\n   Aborting machine procedure!"
        }
        exit
    } else {
        set pemSd $result
    }
} else {
    set pemSd "$pemServerPort $pemHost"
}

# Make our process capable of receiving RPC calls from the PEM
proc TestPort {} {
}
if {$env(useDP)} {
    if {[catch {dp_MakeRPCServer} result]} {
        if {$mpInterface} {
            APSAlertBox .ipcFail -errorMessage "runMP: dp_MakeRPCServer call failed: $result\n   Aborting machine procedure!"
        }
        exit
    } else {
        if {$tcl_version<8.0} {
            set childServerPort $result
        } else {
            set childServerPort [fconfigure  $result -myport]
        }
    }
} else {
    set childServerPort [::comm::comm self]
    ::comm::comm config -local 0
    #Try to connect to self to check that the port works.
    for {set i 0} {$i < 1000} {incr i} {
        if {[catch {::comm::comm send "$childServerPort $hostName" TestPort} result]} {
            incr childServerPort
            ::comm::comm config -port $childServerPort
            continue
        }
        break
    }
}
set childHost $hostName

# catch {dp_RPC $pemSd set status "runMP ok"} 

# Callback procedure executed whenever this interpreter exits.
#  Used to notify the PEM that we are exiting so it can do its 
#  own cleanup of resources.
proc MpExit {} {
    global pemSd childServerPort childHost childId mpInterface 
    global parallelAbort procName env

    Debug "MpExit in $procName: exiting..."
    # Don't need to do clean exit in parent of parallel procedures,
    # so skip calling childExit. This avoids sticky problem of
    # parent aborting before child-parallel processes do, leaving
    # socket connections hanging on child side.
    if {!$parallelAbort} {
        Debug "MpExit doing parallel abort:"
        if {$env(useDP)} {
            Debug "dp_RPC $pemSd childExit $childServerPort $childHost $childId"
            if {[catch {dp_RPC $pemSd childExit $childServerPort $childHost \
                            $childId} result]} {
                if {$mpInterface} {
                    APSAlertBox .ipcFail -errorMessage \
                        "runMP: dp_RPC childExit call failed: $result"
                }
                Debug "$result"
            }
        } else {
            if {[catch {::comm::comm send $pemSd [list childExit $childServerPort $childHost $childId]} result]} {
                if {$mpInterface} {
                    APSAlertBox .ipcFail -errorMessage \
                        "runMP: comm send childExit call failed: $result"
                }
                Debug "$result"                
            }
        }
    }
    if {$env(useDP)} {
        if {[catch {dp_CloseRPC $pemSd} result]} {
        }
    } else {
        if {[catch {::comm::comm shutdown $pemSd} result]} {
        }
    }
}



# Procedure executed by pem process when requesting an abort. 
#  First aborts any outstanding parallel processes. There shouldn't
#  be any unless, of course, the procedure in this interpreter is
#  being explicitly aborted. Then we call exit, which will in turn
#  invoke the MpExit callback above.
proc MpAbort {abortSource} {
    global parallelAbort apsMpParallelProcesses childPortToSd
    global abortHold abortRequest procName apsNetworkDomain
    global pemHost hostName apsScriptUser apsPemStackPrefix env

    # If a hold has been asserted, simply register request for an abort
    if {$abortHold} {
	Debug "MpAbort in $procName: abort request from $abortSource, delaying request"
	set abortRequest $abortSource
	return
    } else {
	Debug "MpAbort in $procName: abort request from $abortSource, immediate"
    }

    # Flag whether pem or runMP is source of abort (needed by MpExit)
    if {![string compare $abortSource "runMP"]} {
	set parallelAbort 1
    }
    # Abort any outstanding parallel processes
    if {[info exists apsMpParallelProcesses]} {
	foreach id $apsMpParallelProcesses {
	    regexp "apsMp:(\[^ \t\]*)" $id match sdIndex
	    if {[info exists childPortToSd($sdIndex)]} {
		set childSd $childPortToSd($sdIndex)
		Debug "MpAbort in $procName: attempting to abort $id"
                if {$env(useDP)} {
                    if {[catch {dp_RDO $childSd MpAbort runMP} results]} {
                        puts stderr "runMP: dp_RDO failed in MpExit while aborting parallel procs"
                    }
                } else {
                    if {[catch {::comm::comm send $childSd [list MpAbort runMP]} results]} {
                    }
                }
	    } 
	}
    }
    # Log abort
    if {(![string compare $apsNetworkDomain "accel.ntw0rk"]) || (![string compare $apsNetworkDomain "aps4.anl.gov"])} {
        if {[llength $apsPemStackPrefix]} {
            set stack ${apsPemStackPrefix}
        } else {
            set stack None
        }        
	set logCmd "logMessage -sourceId=scriptAction -tag=User $apsScriptUser -tag=Host \"$hostName\" -tag=Procedure $procName -tag=Action Abort -tag=Parameters ? -tag=Status ? -tag=Script ? -tag=Stack \"$stack\""
	catch {eval exec $logCmd}
    }

    # Indirectly invoke MpExit routine
    global exitFlag
    set exitFlag 2
    exit
}

#
# Machine procedure utility function. Allows user to reconfigure
# width and height of scrolled status widget.
#
proc APSMpSetScrolledStatusSize {args} {
    global mpInterface

    if {!$mpInterface} {
	return
    }

    set width ""
    set height ""
    APSParseArguments {width height} 
    
    set optString ""
    if {[string length width]} {
	set optString "-width $width"
    }
    if {[string length height]} {
	set optString "$optString -height $height"
    }
    eval .userFrame.ss.frame.fg.top.text configure $optString
}

#
# Machine procedure utility function. Allows user to place a standard
# APSButton on the bottom of the "step dislay" window. 
#
proc APSMpButton {widget args} {
    global mpInterface

    if {!$mpInterface} {
	return
    }
    global apsMpButtonList
    set text notext
    set command ""
    set highlight 0
    set size medium
    set before ""
    set after ""
    set contextHelp ""
    APSParseArguments {text command highlight size before after contextHelp}

    set procName [lindex [info level [expr {[info level] - 1}]] 0]

    set len [llength $apsMpButtonList]
    set buttonFrame .userFrame.userButtons.frame
    if {$len == 0} {
	APSFrame .userButtons -parent .userFrame -label "$procName Buttons:" \
            -packOption "-side top -fill both"
	set apsMpButtonList [list [list $procName [list $widget]]]
	APSButton $widget -parent $buttonFrame -highlight $highlight \
            -text $text -command $command -size $size -contextHelp \
            $contextHelp
    } else {
	set lastIx [expr {$len - 1}]
	set lastEl [lindex $apsMpButtonList $lastIx]
	.userFrame.userButtons.label configure -text "$procName Buttons:"
	# If button row for this proc is already established, add to it
	if {[string match $procName [lindex $lastEl 0]]} {
	    foreach el [lindex $lastEl 1] {
		APSRemap ${buttonFrame}${el}
	    }
	    APSButton $widget -parent $buttonFrame -text $text -highlight \
                $highlight -command $command -size $size -contextHelp \
                $contextHelp
	    set apsMpButtonList [lreplace $apsMpButtonList $lastIx $lastIx \
                                     [list $procName [linsert [lindex $lastEl 1] end $widget]]]
	} else {
	    # Unmap buttons from previous call frame
	    foreach el [lindex $lastEl 1] {
		APSUnmap ${buttonFrame}${el}
	    }
	    APSButton $widget -parent $buttonFrame -highlight $highlight \
                -text $text -command $command -size $size -contextHelp \
                $contextHelp
	    lappend apsMpButtonList [list $procName [list $widget]]
	}
    } 
    return $buttonFrame$widget
}


#
# Override dummy definitions of APSMpStep and APSMpReturn. These versions
# communicate machine procedure state to the runMP graphical interface.
#
proc APSMpStep {stepName args} {
    global execMode steps status firstPromptDialog mpInterface continueButton
    global apsNetworkDomain pemHost hostName apsScriptUser apsPemStackPrefix env
    set promptDialog ""
    set vars ""
    set displayOnly 0
    set subProcName ""
    set depth 0
    set procName [lindex [info level [expr {[info level] - 1}]] 0]
    set procedure ?
    set action $stepName
    set parameters ?
    set state ?
    set stackPrefix ""
    
    if {![string compare $stepName "init"] && [info level] == 2 && \
            ((![string compare $apsNetworkDomain "accel.ntw0rk"]) || (![string compare $apsNetworkDomain "aps4.anl.gov"]))} {
        if {[llength $apsPemStackPrefix]} {
            set stack ${apsPemStackPrefix}
        } else {
            set stack None
        }
	set logCmd "logMessage -sourceId=scriptAction -tag=User $apsScriptUser -tag=Host \"$hostName\" -tag=Procedure $procName -tag=Action Start -tag=Parameters ? -tag=Status ? -tag=Script ? -tag=Stack \"$stack\""
	catch {eval exec $logCmd}
    }

    # Do an update to handle any pending call to MpAbort
    update
    APSParseArguments {depth subProcName stackPrefix}
    if {!$mpInterface} {
	global pemSd
	incr depth
	if {$depth > 1} {
	    set procName $subProcName
        }
        if {[string length $stackPrefix] == 0} {
            set stackPrefix ${apsPemStackPrefix}${procName}->
        }
        if {$env(useDP)} {
            catch {dp_RPC $pemSd APSMpStep $stepName -displayOnly 1 -subProcName $procName -depth $depth -stackPrefix "$stackPrefix"}
        } else {
            catch {::comm::comm send $pemSd [list APSMpStep $stepName -displayOnly 1 -subProcName $procName -depth $depth -stackPrefix "$stackPrefix"]}
        }
	return
    }

    APSParseArguments {promptDialog vars displayOnly procedure action parameters state}

    if {$promptDialog == ""} {
	set prompt 0
    } else {
	global $procName
	set prompt 1
    }

    $steps tag remove currentTag "insert -1 lines" "insert"
    if {(![string compare $apsNetworkDomain "accel.ntw0rk"]) || (![string compare $apsNetworkDomain "aps4.anl.gov"])} {
	catch {APSLogScriptAction -procedure $procedure -action $action \
                   -parameters $parameters -state $state -stackPrefix "$stackPrefix"}
    }

    if {$displayOnly} {
	set marker ""
	for {set i 0} {$i < $depth} {incr i} {
	    append marker +
        } 
        $steps insert end "$marker$subProcName:$stepName\n" currentTag
        $steps see end
        update
        return
    }

    switch $execMode {
	"Automatic" {
	    $steps insert end "$procName:$stepName\n" currentTag
	    $steps see end
	}
	"Semi-Automatic" {
	    if {$firstPromptDialog} {
		$steps insert end "$procName:$stepName\n" stopTag
		$steps see end
		update 
		set firstPromptDialog 0
		if {$prompt} {
		    # Copy "var" value to a global so that dialog can get at it
		    foreach var $vars {
			upvar $var $var
			set ${procName}($var) [set $var]
		    }
		    
		    # Bring up dialog
		    APSDialogBox .promptDialog -name \
			"Step $stepName of $procName" \
			-cancelCommand "MpAbort pem"
		    wm protocol .promptDialog WM_DELETE_WINDOW "MpAbort pem"
		    APSEnableButton .promptDialog.buttonRow.ok.button
		    APSDialogBoxAddButton .abort -parent .promptDialog \
                        -text Abort -command "MpAbort pem" -contextHelp \
                        "Aborts this machine procedure."
		    tkwait visibility .promptDialog.buttonRow.ok.button
                    global pemGeometry
                    if {[llength $pemGeometry]} {
                        wm geometry .promptDialog +[join [lrange [split $pemGeometry +] 1 2] +]
                    }
		    uplevel \#0 $promptDialog .promptDialog.userFrame
		    tkwait window .promptDialog

		    
		    # Update value of "var" after dialog is finished
		    foreach var $vars {
			set $var [set ${procName}($var)]
		    }
		}
		$steps tag remove stopTag "insert -1 lines" "insert"
		$steps tag add currentTag "insert -1 lines" "insert"
	    } else {
		$steps insert end "$procName:$stepName\n" currentTag
		$steps see end
	    }
	}
	"Manual" {
	    $steps insert end "$procName:$stepName\n" stopTag
	    $steps see end
	    update
	    if {$prompt} {
		# Copy "var" value to a global so that dialog can get at it
		foreach var $vars {
		    upvar $var $var
		    set ${procName}($var) [set $var]
		}

		# Bring up dialog
		APSDialogBox .promptDialog -name "Step $stepName of $procName" \
		    -cancelCommand "MpAbort pem"
		wm protocol .promptDialog WM_DELETE_WINDOW "MpAbort pem"
		APSDialogBoxAddButton .abort -parent .promptDialog \
                    -text Abort -command "MpAbort pem" -contextHelp \
                    "Aborts this machine procedure."
		APSEnableButton .promptDialog.buttonRow.ok.button
		tkwait visibility .promptDialog.buttonRow.ok.button
		uplevel \#0 $promptDialog .promptDialog.userFrame
		tkwait window .promptDialog

		# Update value of "var" after dialog is finished
		foreach var $vars {
		    set $var [set ${procName}($var)]
		}
	    } else {
		APSEnableButton $continueButton
		if {[string compare $status "Press Continue..."]} {
		    set status "Press Continue..."
		}
		tkwait variable continue
	    }
	    $steps tag remove stopTag "insert -1 lines" "insert"
	    $steps tag add currentTag "insert -1 lines" "insert"

	}
    }
    update
}

proc APSMpReturn {code {results ""}} {
    global childServerPort childHost childId status execMode steps
    global continueButton doneButton ackErrorButton mpInterface ackError
    global done apsNetworkDomain pemHost hostName apsScriptUser
    global apsMpButtonList apsPemStackPrefix env

    set procName [lindex [info level [expr {[info level] - 1}]] 0]

    if {$mpInterface} {
	$steps tag remove currentTag "insert -1 lines" "insert"

	# Remove any buttons put up by this procedure
	set len [llength $apsMpButtonList]
	if {$len > 0} {
	    set buttonFrame .userFrame.userButtons.frame	
	    set lastIx [expr {$len - 1}]
	    set lastEl [lindex $apsMpButtonList $lastIx]
	    if {[string match $procName [lindex $lastEl 0]]} {
		foreach el [lindex $lastEl 1] {
		    catch "destroy ${buttonFrame}${el}"
		}
		set apsMpButtonList [lreplace $apsMpButtonList $lastIx $lastIx]
	    }
	}
    } 

    if {[info level] == 2} {
	# Before returning to top level calling context, synchronize
	#   with all outstanding parallel processes first.
	global apsMpParallelProcesses
	if {[info exists apsMpParallelProcesses]} {
            set status "Joining outstanding parallel processes."
            # set status "IDs: [join $apsMpParallelProcesses \n]"
            update
	    foreach id $apsMpParallelProcesses {
		catch {APSMpJoin $id}
	    }
	}
	if {(([string compare $apsNetworkDomain "accel.ntw0rk"]==0) || ([string compare $apsNetworkDomain "aps4.anl.gov"]==0)) && \
                [string compare $code "error"]==0} {
            # log error
            bell
            bell
            bell
            set logResults "$results"
            if {[string length $logResults]==0} {
                set logResults "{No information given}"
            }
            if {[llength $apsPemStackPrefix]} {
                set stack ${apsPemStackPrefix}
            } else {
                set stack None
            }
	    set logCmd "logMessage -sourceId=scriptAction -tag=User $apsScriptUser -tag=Host \"$hostName\" -tag=Procedure $procName -tag=Action Error -tag=Parameters ? -tag=Status \"$logResults\" -tag=Script ? -tag=Stack \"$stack\""
	    catch {eval exec $logCmd}
	}
	if {$mpInterface} {
	    set status "Completion status: $code"
	    update idletasks
	    if {![string compare $code "error"]} {
                .userFrame.ss.frame.fg.top.text configure -fg Red 
                if {[string length $results]} {
                    set status "Returns: $results"
                }
		bell
		set status "Please acknowledge error..."
		APSDisableButton $continueButton
		APSEnableButton $ackErrorButton
                for {set i 0} {$i<3} {incr i} {
                    bell
                    after 1000
                }
		tkwait variable ackError
		APSDisableButton $ackErrorButton
	    } else {
                if {[string length $results]} {
                    set status "Returns: $results"
                }
            }
	    update idletasks
	    switch $execMode {
		"Automatic" {}
		"Semi-Automatic" {}
		"Manual" {
		    APSDisableButton $continueButton
		    APSEnableButton $doneButton
		    set status "Press Done to complete..."
		    tkwait variable done
		}
	    }
	    update idletasks
	}
	if {(![string compare $apsNetworkDomain "accel.ntw0rk"]) || (![string compare $apsNetworkDomain "aps4.anl.gov"])} {
	    if {![string compare $code "ok"]} {
		set action Finish
	    } else {
		set action Error
	    }
            if {[llength $apsPemStackPrefix]} {
                set stack ${apsPemStackPrefix}
            } else {
                set stack None
            }
	    set logCmd "logMessage -sourceId=scriptAction -tag=User $apsScriptUser -tag=Host \"$hostName\" -tag=Procedure $procName -tag=Action $action -tag=Parameters ? -tag=Status ? -tag=Script ? -tag=Stack \"$stack\""
	    catch {eval exec $logCmd}
	}
        after 1000 {set exitFlag 1}
        global returnValuesFromMpReturn pemSd childPortFP
        set returnValuesFromMpReturn [list $results $code]
        Debug "APSMpReturn: returning $childServerPort $childHost $childId - $code - $results"
        if {$env(useDP)} {
            if {[catch {dp_RPC $pemSd set apsMp:$childHost:$childPortFP:$childId:Return \
                            [list $code $results]} result]} {
                Debug "dp_RPC problem: $result"
            }
        } else {
            if {[catch {::comm::comm send $pemSd [list set apsMp:$childHost:$childPortFP:$childId:Return [list $code $results]]} result]} {
                Debug "comm send problem: $result"
            }
        }
	return -code return \
            [list $childServerPort $childHost $childId $code $results]
    } else {
	if {$mpInterface} {
	    set status "Completion status: $code"
	    if {[string length $results]} {
		set status "Returns: $results"
	    }
	    update idletasks
	    if {![string compare $code "error"]} {
		set status "Please acknowledge error..."
		APSDisableButton $continueButton
		APSEnableButton $ackErrorButton
                for {set i 0} {$i<3} {incr i} {
                    bell
                    after 1000
                }
		tkwait variable ackError
		APSDisableButton $ackErrorButton
	    }
	}
	if {![string compare $code "ok"]} {
	    return -code return $results
	} else {
	    return -code error $results
	}
    }
}

#
# This procedure configures the execution context.
#
proc configMP {proc context} {
    global status steps auto_path cwd hostName
    global promptButton continueButton mpInterface env

    if {$mpInterface} {
	wm title . "MP $proc on Host $hostName"
    }

    # Context contains {varName value} pairs. Create a global var for
    # each, thereby establishing execution context.
    foreach item $context {
	set var [lindex $item 0]
	set value [lindex $item 1]
	global $var
	set $var $value
    }

    # Now that context is set up, add PEM's working dir to our path.
    # Note that APSDebugPath is honored, though, so this is just a plus.
    set auto_path [linsert $auto_path 0 $cwd]

    # Note: must do this to cause tcl to re-read procs in auto_path.
    global auto_index auto_oldpath
    unset auto_index
    unset -nocomplain auto_oldpath

    # If mode is Automatic, disable some of the interface buttons.
    if {$execMode == "Automatic"} {
	if {$mpInterface} {
	    APSDisableButton $continueButton
	}
    }

    # Source the appropriate library file to get proc into interpreter
    auto_load $proc

    # Reset File/Quit menu entry now, because context tells us
    #   whether pem or APSMpParallel started us.
    if {$mpInterface} {
	# Configure File/Quit so it aborts machine procedure cleanly.
	.menu.file.menu entryconfigure Quit -command "MpAbort $invokedBy"
    }
    
    global pemSd
    if {$env(useDP)} {
        catch {dp_RPC $pemSd set status "$procName started."}
    } else {
        catch {::comm::comm send $pemSd [list set status "$procName started."]}
    }
}

proc findProcSteps {body} {
    set stepList {}
    set nlIndex [string first "\n" $body]

    while {$nlIndex != -1} {
	set stepName ""
	set line [string range $body 0 [expr {$nlIndex - 1}]]
	set lineLength [string length $line]

	# Find occurrence of APSMpStep string and extract out step name
	regexp "APSMpStep\[ \t\]*(\[a-zA-Z0-9\]*)" $line match stepName
	if {$stepName != ""} {
	    lappend stepList $stepName
	}
	
	set body [string range $body [expr {$nlIndex + 1}] end]
	set nlIndex [string first "\n" $body]
    }
    return $stepList
}

# Establish the interpreter "exit" callback
dp_atexit set atExitList
dp_atexit append MpExit


# Notify the PEM that we are initialized and ready to have a machine
# procedure executed in this current interpreter context. We must
# send the PEM our server's assigned port number.
if {$env(useDP)} {
    if {[catch {dp_RPC $pemSd childUp $childServerPort} result]} {
        if {$mpInterface} {
            APSAlertBox .ipcFail -errorMessage "runMP: dp_RPC call failed: $result"
        }
    }
} else {
    if {[catch {::comm::comm send $pemSd [list childUp $childServerPort]} result]} {
        if {$mpInterface} {
            APSAlertBox .ipcFail -errorMessage "runMP: comm send call failed: $result"
        }
    }
}

# This interpreter process sits here while an RPC call from the PEM
# executes a machine procedure. Upon completion, the PEM sets the
# exitFlag with another RPC call, and we exit. Our exit callback
# in turn notifies the PEM that we are exiting. So even if we exit
# prematurely, the PEM is notified.

if {!$exitFlag} {
    Debug "Waiting for exit flag"
    tkwait variable exitFlag
    if {$exitFlag == 2} {
        #MpAbort set exitFlag to 2 to stop tkwait command
        exit
    }
    Debug "Exit flag received"
    after 1000
    # Set some auxiliary return values to fall back on in the event the
    # normal return callback doesn't run executed.
    if {$env(useDP)} {
        catch {dp_RPC $pemSd set status "$procName exiting."}
        if {[catch {dp_RPC $pemSd set apsMp:$childHost:$childPortFP:$childId:ReturnValue \
                        [lindex $returnValuesFromMpReturn 0]
            dp_RPC $pemSd set apsMp:$childHost:$childPortFP:$childId:ReturnCode \
                        [lindex $returnValuesFromMpReturn 1]} result]} {
            Debug "dp_RPC problem: $result"
        }
    } else {
        catch {::comm::comm send $pemSd [list set status "$procName exiting."]}
        if {[catch {::comm::comm send $pemSd [list set apsMp:$childHost:$childPortFP:$childId:ReturnValue [lindex $returnValuesFromMpReturn 0]]
            ::comm::comm send $pemSd [list set apsMp:$childHost:$childPortFP:$childId:ReturnCode [lindex $returnValuesFromMpReturn 1]]} result]} {
            Debug "comm send problem: $result"
        }
    }
}
exit
