#
# $Log: not supported by cvs2svn $
# Revision 1.39  2006/01/26 19:15:43  sereno
# Modified to work around bug seen on linux machines.
#
# Revision 1.38  2004/05/26 19:17:10  soliday
# Moved debugging statement in childResultCallback routine.
#
# Revision 1.37  2004/05/26 19:09:04  soliday
# Found and removed problems related to the parsing of results created by the comm library.
#
# Revision 1.36  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.35  2003/10/27 16:30:00  soliday
# Added the ability to launch parallel pem procedures and pass the stack to the
# new procedures.
#
# Revision 1.34  2000/06/28 20:37:14  soliday
# Make changes so that parallel procedures get properly destroyed when
# an error occurs.
#
# Revision 1.33  1999/12/02 14:47:10  soliday
# Added catch statement around puts command
#
# Revision 1.32  1998/11/19 18:52:05  soliday
# Replaced exec uname -n with info hostname
#
# Revision 1.31  1998/11/10 21:11:10  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.30  1998/11/06 22:25:36  borland
# Fixed problems with interprocess communcation (?) that prevented proper
# abort and exit operation.
#
# Revision 1.29  1998/06/15 21:57:03  borland
# Fixed bug in APSMpAbort (wasn't checking for existence of global
# variable).
#
# Revision 1.28  1998/04/22 22:12:36  borland
# Version that works under Tcl 8.0 and DP 4.0  Added optional debugging
# output.
#
# Revision 1.27  1998/04/22 18:03:41  borland
# Should now work with tcl 8.0 and dp 4.0, but I haven't been able to test
# it.
#
# Revision 1.26  1996/12/17 23:12:02  saunders
# Modified to use localhost to circumvent current problems with inetd.
#
# Revision 1.25  1996/12/16 16:38:29  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.24  1996/10/17 21:20:54  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.23  1996/09/25 16:07:16  saunders
# Additional testing done and passed.
#
# Revision 1.22  1996/09/24 18:38:05  saunders
# More on site testing since my sun4 box on phebos got taken away
#   unexpectedly.
#
# Revision 1.21  1996/09/24 18:09:32  saunders
# Option -onError added to APSMpAbort.
#
# Revision 1.20  1996/09/23 21:28:09  saunders
# Improved error message when trying to APSMpJoin an aborted procedure.
#
# Revision 1.19  1996/09/23 20:53:22  saunders
# Various bug fixes to APSMpAbort.
#
# Revision 1.18  1996/09/23 20:31:44  saunders
# Procedure APSMpAbort added. Allows aborting one or all outstanding
# parallel procedures.
#
# Revision 1.17  1996/09/16 16:13:23  saunders
# Set up File/Quit button to do clean abort.
#
# Revision 1.16  1996/07/30 16:56:02  saunders
# Implemented form of MUTEX on MpAbort so that it cannot occur during
# execution of APSMpParallel.
#
# Revision 1.15  1996/07/25 19:16:07  saunders
# Fixed APSMpInterface routine to work in cmd line environment.
#
# Revision 1.14  1996/07/25 19:09:35  saunders
# Fixed spelling error in help routine.
#
# Revision 1.13  1996/07/25 18:53:06  saunders
# Added APSMpInterface procedure and installed Help procedures.
#
# Revision 1.12  1996/07/24 22:34:55  saunders
# APSMpJoin now also requires use of catch statement in keeping with
# non-parallel usage.
#
# Revision 1.11  1996/07/24 22:09:48  saunders
# Modified return mechanism to use tcl error return. Catch should now
# be used to check return from machine procedures.
#
# Revision 1.10  1996/07/19 21:12:37  saunders
# Changed APSMpJoin return value. Now list with {errorcode returnval} is returned.
#
# Revision 1.9  1996/07/01 19:46:17  saunders
# Getting error trapping to work.
#
# Revision 1.8  1996/07/01 19:22:21  saunders
# Added error trapping for tcl errors in remote procedures.
#
# Revision 1.7  1996/06/27 19:34:19  saunders
# Pem now honors the APSDebugPath as well as pem cwd. Note that pem cwd
# does supersede any path additions via APSDebugPath.
#
# Revision 1.6  1996/06/24 21:52:03  saunders
# All stdout/stderr output from machine procedures is now funnelled
# through sockets back to the pem process and printed out.
#
# Revision 1.5  1996/06/24 17:25:57  saunders
# Yet another change in how I trap bad returns.
#
# Revision 1.4  1996/06/24 17:05:04  saunders
# Refined error return trapping further.
#
# Revision 1.3  1996/06/24 16:17:59  saunders
# Trap error that commonly occurs when user doesn't use APSMpReturn.
# Display useful error dialog when possible.
#
# Revision 1.2  1996/06/19 20:34:01  saunders
# Minor fixes so these procedures can be used from command
# line "runProc" environment.
#
# Revision 1.1  1996/06/18 20:11:43  saunders
# Added APSMpParallel/APSMpJoin capability. Required a number of
# modifications to pem and related scripts.
#
#

# APSMpParallel, APSMpJoin, and support procedures.
#
# Executes a machine procedure in parallel by starting a runMP process
# and invoking the procedure in the runMP tcl interpreter's context.
# A unique id is returned identifying this process. Your calling
# procedure may continue executing various code. When you wish to
# synchronize with the parallel procedure, call APSMpJoin with the
# unique id. When sychronized, APSMpJoin will return the return
# value from the parallel procedure.
#
# Notes: APSMpParallel waits
# until the runMP process indicates it has initialized completely.
# A connection is then established with the process, and the machine
# procedure is scheduled to be run (ie. dp_RDO returns immediately)
# The callback "childResultCallback" is executed upon completion
# of the machine procedure, and/or the "childExit" callback is
# invoked.
#

set debugMode 0
set debugFID ""
proc DebugInfo {message} {
    global debugFID debugMode
    if {$debugMode && [string length $debugFID]} {
        puts $debugFID "$message"
        flush $debugFID
    }
}

proc APSMpParallelHelp {} {
    return "Usage: <id> APSMpParallel \n\[-procedure <string>\] where string is full procedure name with args\n\[-host <string>\]\n\[-interface 1\] force creation of a status interface in Automatic mode\n\[-mode <string>\] where mode is Manual, Semi-Automatic, or Automatic\n\nNote that mode and host are implied by current context. The mode and\nhost options permit overriding current settings.\nReturns a unique id for use by APSMpJoin."
}

proc APSTestPort {} {
}
proc APSMpParallel {args} {
    # Do not allow an abort to take place during this procedure
    global abortHold abortRequest apsPemStackPrefix env
    set abortHold 1
    if {![info exists abortRequest]} {

    }

    set level [info level]
    set stack $apsPemStackPrefix[join [APSStackTrace -level $level] "->"]->>

    global debugMode debugFID
    if {$debugMode && ![string length $debugFID]} {
        set debugFID [open "/tmp/MpPar.[pid].log" a]
    }

    global pemHost execMode inetdPort env apsMpParallelServerPort tcl_platform
    global childPort childPortToSd cwd apsMpParallelProcesses
    global apsScriptUser
    DebugInfo "********** APSMpParallel invoked\nglobal vars:"
    foreach var {pemHost execMode inetdPort apsMpParallelServerPort childPort childPortToSd cwd apsMpParallelProcesses apsScriptUser} {
        if {[info exists $var]} {
            catch {DebugInfo "$var: [subst \$$var]"
            }
        }
    }

    global abortOnErrorList
    if {![info exists abortOnErrorList]} {
	set abortOnErrorList {}
    }
    global invokedBy
    if {![info exists invokedBy]} {
	set invokedBy runMP
    }
    
    set host [exec hostname]
    set childHost $host
    set procedure ""
    set interface 0
    if {[info exists execMode]} {
	set mode $execMode
    } else {
	set execMode Automatic
	set mode $execMode
    }
    APSParseArguments {host procedure interface mode}

    # Display given by pem, or defaults to this machine.
    if {![info exists pemHost]} {
	set pemHost $host
    }

    if {[string compare $mode Automatic]} {
	set interface 1
    }
    DebugInfo "** Commandline-args:\nhost:\n$host\nprocedure:\n$procedure\ninterface:\n$interface"

    # Extract out just procedure name
    regexp "(\[^ \t]*)" $procedure procName
    DebugInfo "Procedure name : $procName"

    set inetdPort 1605

    # Make our process capable of receiving RPC calls from runMP processes.
    # Do this only once.
    if {![info exists apsMpParallelServerPort]} {
        DebugInfo "** making RPC connection"
        if {$env(useDP)} {
            if {[catch {dp_MakeRPCServer} result]} {
                # Execute MpAbort if abortRequest is pending
                set abortHold 0
                if {[string length $abortRequest]} {
                    MpAbort $abortRequest
                }
                return -code error -errorinfo "MakeRPCServer failed" -1
            } else {
                global tcl_version
                if {$tcl_version<8.0} {
                    set apsMpParallelServerPort $result
                } else {
                    set apsMpParallelServerPort [fconfigure $result -myport]
                }
                DebugInfo "port is $apsMpParallelServerPort"
            }
        } else {
            ::comm::comm new ::comm::comm2 -port 0 -local 0 -listen 1
            set apsMpParallelServerPort [::comm::comm2 self]
            #Try to connect to self to check that the port works.
            for {set i 0} {$i < 1000} {incr i} {
                if {[catch {::comm::comm2 send "$apsMpParallelServerPort $childHost" APSTestPort} result]} {
                    incr apsMpParallelServerPort
                    ::comm::comm2 config -port $apsMpParallelServerPort
                    continue
                }
                break
            }
        }
    }

    if {$tcl_platform(os) == "Linux"} {
        set xDisplay $env(DISPLAY)
    } else {
        # Handle annoying case of DISPLAY with no host qualification, ie. :0.0
        if {![string compare [string index $env(DISPLAY) 0] ":"]} {
            set xDisplay ${pemHost}$env(DISPLAY)
        } else {
            set xDisplay $env(DISPLAY)
        }
    }
    DebugInfo "xDisplay is $xDisplay"

    # Check for APSDebugPath env variables.
    if {[info exists env(OAG_DEBUG_PATH)]} {
	set debugPath $env(OAG_DEBUG_PATH)
    } else {
	set debugPath ""
    }
    if {[info exists env(OAG_DEBUG_AUTO_PATH)]} {
	set debugAutoPath $env(OAG_DEBUG_AUTO_PATH)
    } else {
	set debugAutoPath ""
    }

    set runMPservExec /usr/local/oag/bin_patch/$env(HOST_ARCH)/runMPserv
    if {![file exists $runMPservExec]} {
        set runMPservExec /usr/local/oag/apps/bin/$env(HOST_ARCH)/runMPserv
        if {![file exists $runMPservExec]} {
            set runMPservExec /lustre/oagsoftware/bin/runMPserv
            if {![file exists $runMPservExec]} {
                set runMPservExec runMPserv
            }
        }
    }
    if {[catch {open "|oagtclsh $runMPservExec" r+} result]} {
        set abortHold 0
        if {[string length $abortRequest]} {
            MpAbort $abortRequest
        }
        return -code error -errorinfo "open runMPserv failed" -1
    } else {
        set runMPSd $result
    }
    DebugInfo "runMPServ started"
    set geometry ""
    #set geometry [winfo geometry .]

    # Capture stdout/stderr of runMP process and put on our stdout.
    fileevent $runMPSd readable [list processMpOutput $runMPSd]

    if {[catch {puts $runMPSd "$apsMpParallelServerPort~$host~$xDisplay~$interface~$debugPath~$debugAutoPath~$apsScriptUser~$geometry~$stack\n"} result]} {
        close $runMPSd
        # Execute MpAbort if abortRequest is pending
        set abortHold 0
        if {[string length $abortRequest]} {
            MpAbort $abortRequest
        }
        return -code error -errorinfo "initial puts runMPSd failed" -1
    }
    flush $runMPSd
    DebugInfo "Data sent to runMPserv"

    # Wait until runMP process has started up (it sets childPort with RPC call)
    tkwait variable childPort
    DebugInfo "runMP started"

    # For now, this will be closed by fileevent handler instead.
    #  close $runMPSd

    # Establish RPC connection with runMP process
    if {$env(useDP)} {
        if {[catch {dp_MakeRPCClient $host $childPort} result]} {
            # Execute MpAbort if abortRequest is pending
            set abortHold 0
            if {[string length $abortRequest]} {
                MpAbort $abortRequest
            }
            return -code error -errorinfo "makeRPCClient failed" -1
        } else {
            set childSd $result
        }
    } else {
        set childSd "$childPort $host"
    }

    # We first must save the socket descriptor for this particular runMP
    # instance. I use $host, $childPort, and a unique number to 
    # identify it. Technically, a unique number would suffice, but the
    # host and port info is better for debugging.
    #
    # When machine procedure completes and invokes our childResultCallback,
    # we index the associated socket descriptor using host, port, and id.
    #
    set id [APSUniqueNumber]
    set childPortToSd($host:$childPort:$id) $childSd
    
    # Set up execution context in runMP interpreter
    set context [list \
                     [list childId $id] \
                     [list childSdFP $childSd] \
                     [list childPortFP $childPort] \
                     [list execMode $mode] \
                     [list cwd $cwd] \
                     [list invokedBy runMP] \
                     [list procName $procName]]
    DebugInfo "APSMpParallel: childSd = $childSd"
    global status
    # set status "Parallel job started: $host:$childPort:$id"
    if {$env(useDP)} {
        if {[catch {dp_RPC $childSd configMP $procName $context} result]} {
            unset childPortToSd($host:$childPort:$id) $childSd
            dp_CloseRPC $childSd
            
            # Execute MpAbort if abortRequest is pending
            set abortHold 0
            if {[string length $abortRequest]} {
                MpAbort $abortRequest
            }
            return -code error -errorinfo "RPC call to send context failed" -1
        }
    } else {
        if {[catch {::comm::comm2 send $childSd [list configMP $procName $context]} result]} {
            unset childPortToSd($host:$childPort:$id) $childSd
            ::comm::comm2 shutdown $childSd
            
            # Execute MpAbort if abortRequest is pending
            set abortHold 0
            if {[string length $abortRequest]} {
                MpAbort $abortRequest
            }
            return -code error -errorinfo "RPC call to send context failed" -1
        }
    }
    # Create unique id to be used for APSMpJoin procedure
    set blockingVar apsMp:$host:$childPort:$id
    global $blockingVar
    set $blockingVar 0

    # Keep global list of parallel processes. This so that I can
    #  force a join with all prior to returning from the highest
    #  level procedure.
    DebugInfo "APSMpParallel: adding $blockingVar to apsMpParallelProcesses list"
    lappend apsMpParallelProcesses $blockingVar

    # Create a unique var to hold return value from parallel procedure.
    set returnVar apsMp:$host:$childPort:$id:Return
    set returnCodeVar apsMp:$host:$childPort:$id:ReturnCode
    global $returnVar $returnCodeVar
    set $returnVar -1
    set $returnCodeVar unknown

    # Execute MP asynchronously. Callback on completion.
    if {$env(useDP)} {
        set errorCb [list childErrorCallback $childSd $procName]
        set mpCmd [list dp_RDO $childSd -callback childResultCallback \
                       -onerror $errorCb]
        if {[catch {eval $mpCmd $procedure} result]} {
            # Execute MpAbort if abortRequest is pending
            set abortHold 0
            if {[string length $abortRequest]} {
                MpAbort $abortRequest
            }
            return -code error -errorinfo "RDO call to invoke proc failed" -1
        }
    } else {
        if {[catch {::comm::comm2 send -command childResultCallback $childSd $procedure} result]} {
            # Execute MpAbort if abortRequest is pending
            set abortHold 0
            if {[string length $abortRequest]} {
                MpAbort $abortRequest
            }
            return -code error -errorinfo "comm send call to invoke proc failed" -1
        }
    }

    # Execute MpAbort if abortRequest is pending
    set abortHold 0
    if {[string length $abortRequest]} {
	DebugInfo "APSMpParallel: issuing delayed abort"
	MpAbort $abortRequest
    }
    DebugInfo "APSMpParallel: started $procName-> $blockingVar"
    return $blockingVar
}

#
# This fileevent callback handler is attached to the pem side of the
#   socket connection which is used to initially contact inetd and 
#   fire up a runMP process. Since inetd copies the sd to the runMP 
#   process' stdin/stdout/stderr, any time a machine procedure writes
#   to stdout or stderr, the bytes will appear here and invoke this
#   handler. As such, output from multiple outstanding machine 
#   procedures will probably be arbitrarily interleaved on a line
#   by line basis on pem's stdout.
#
proc processMpOutput {sd} {
    if {[eof $sd]} {
	catch {close $sd}
	return
    }
    gets $sd line
    if {[string length $line] > 0} {
        catch {puts stdout $line}
    }
    flush stdout
}

#
# childUp is executed by runMP process to notify us it is ready to 
# have a machine procedure executed in its context. Our 
# APSMpParallel procedure blocks until this var is set.
#
proc childUp {childServerPort} {
    global childPort
    set childPort $childServerPort
}

#
# childExit is executed by runMP process to notify us it is just
# about to exit. This allows us to free up connection resources.
#
proc childExit {childServerPort childHost childId} {
    global childPortToSd abortOnErrorList env
    set childPort $childServerPort
    set childSd $childPortToSd($childHost:$childPort:$childId)
    DebugInfo "Parallel childExit: $childHost:$childPort:$childId $childSd"

    unset childPortToSd($childHost:$childPort:$childId)
    if {$env(useDP)} {
        if {[catch {dp_CloseRPC $childSd} result]} {
            DebugInfo "Parallel childExit: dp_CloseRPC error: $result"
        }
    } else {
        if {[catch {::comm::comm2 shutdown $childSd} result]} {
            DebugInfo "Parallel childExit: comm shutdown call error: $result"
        }
    }

    # Unblock any APSMpJoin that may be waiting. Var is set to 1
    #  so if APSMpJoin is invoked later, it will not block.
    #
    set blockingVar apsMp:$childHost:$childPort:$childId
    global $blockingVar
    set $blockingVar 1

    # If there is something on the abortOnErrorList,
    # check our return status. If an error occurred, and this
    # pid is on abortOnErrorList, abort the other procedures on
    # abortOnErrorList.
    if {[llength $abortOnErrorList]} {
        DebugInfo "Parallel childExit: checking abort on error list"
	set returnVar apsMp:$childHost:$childPort:$childId:Return
	global $returnVar
	set returnValue [set $returnVar]
        DebugInfo "Parallel childExit: return value is $returnValue"
	if {$returnValue == -1 || \
                ![string compare [lindex $returnValue 0] "error"]} {
	    set abortNow {}
	    set newAbortList {}
	    foreach item $abortOnErrorList {
		set ix [lsearch -exact $item $blockingVar]
		if {$ix > -1} {
		    append abortNow "[lreplace $item $ix $ix] "
		} else {
		    append newAbortList "$item "
		}
	    }
	    set abortOnErrorList $newAbortList
	    foreach item $abortNow {
		global ${item}:Return
		set ${item}:Return "error"
		lappend ${item}:Return "Aborted by parallel procedure: [lindex $returnValue 1]"
		APSMpAbort $item
	    }
	}
    }
}

# 
# childErrorCallback is executed asynchronously when the runMP process
# executing a particular machine procedure has encountered a tcl error
# that would normally abort a procedure. This callback receives the
# internal error message.
#
proc childErrorCallback {childSd procName errorMessage} {
    global status mpInterface env
    DebugInfo "childErrorCallback: $childSd $procName $errorMessage"
    if {$mpInterface} {
	APSAlertBox .rpcFail -errorMessage "Tcl error in $procName: $errorMessage"
    }
    
    if {$env(useDP)} {
        if {[catch {dp_RPC $childSd set exitFlag 1} result]} {
        }
    } else {
        if {[catch {::comm::comm2 send $childSd [list set exitFlag 1]} result]} {
        }
    }
    set status "$procName tcl error: $errorMessage"
}

#
# childResultCallback is executed asynchronously when the runMP process
# executing a particular machine procedure has returned. Here we get
# the returned results, and tell the runMP process to exit.
#
if {![info exists env(useDP)]} {
    set env(useDP) 0
}

proc childResultCallback {args} {
    global childPortToSd mpInterface env

    if {$env(useDP)} {
        set result $args
    } else {
        set id ""
        set serial ""
        set chan ""
        set code ""
        set errorcode ""
        set errorinfo ""
        set result ""
#        APSStrictParseArguments {id serial chan code errorcode errorinfo result}
        APSParseArguments {id serial chan code errorcode result}
        if {$code == "error"} {
            childErrorCallback $id "PEM" $result
        }
        if {($code == -1) && (($result == "Connection shutdown by request") || ($result == "target application died or connection lost"))} {
            return
        }
        if {[catch {llength $result} resultlength]} {
            return
        }
    }
    set childPort [lindex $result 0]
    set childHost [lindex $result 1]
    set childId   [lindex $result 2]
    # Trap error that commonly occurs when user doesn't use APSMpReturn
    #   in their machine procedure. Display dialog.
    if {![info exists childPortToSd($childHost:$childPort:$childId)]} {
        if {$mpInterface} {
            bell
            APSAlertBox .noReturn -errorMessage "Your machine procedure probably did not return correctly. You must use APSMpReturn, not the tcl return statement. APSMpReturn must also be the last executed statement of your procedure, even if you return nothing."
        }
        set returnCode ""
        set returnData ""
        set status "Probable incorrect return from procedure."
        return
    }
    DebugInfo "childResultCallback: $result  $childHost:$childPort:$childId  $childPortToSd($childHost:$childPort:$childId)"
    
    set childSd $childPortToSd($childHost:$childPort:$childId)
    
    set returnCode [lindex $result 3]
    set returnData [lindex $result 4]

    if {$env(useDP)} {  
        if {[catch {dp_RPC $childSd set exitFlag 1} result]} {
            DebugInfo "childResultCallback: Error from dp_RPC: $result"
        }
    } else {
        if {[catch {::comm::comm2 send $childSd [list set exitFlag 1]} result]} {
            DebugInfo "childResultCallback: Error from comm send: $result"
        }
    }
}

proc APSMpAbortHelp {} {
    return "Usage: APSMpAbort <id>\nAbort the parallel procedure identified by <id>.\nIf <id> is \"all\", then abort all outstanding parallel procedures. Useful\nfor aborting a set of parallel procedures when one of them returns an error.\nOtherwise one would block on APSMpReturn/APSMpJoin until the others completed."
}

proc APSMpAbort {parallelId args} {
    global apsMpParallelProcesses invokedBy childPortToSd abortOnErrorList env

    set onError 0
    APSParseArguments {onError}
    
    if {![info exists apsMpParallelProcesses]} return

    # Keyword "all" means abort all outstanding parallel processes
    if {![string compare $parallelId "all"]} {
	set pidList $apsMpParallelProcesses
    } else {
	set pidList $parallelId
    }
    # Automatically abort if an error occurs, else abort now
    if {$onError} {
	lappend abortOnErrorList $pidList
    } else {
	foreach pid $pidList {
	    global $pid
	    # note: if pid value is 1, then parallel proc is already exiting
	    if {[set $pid] == 0} {
		regexp "apsMp:(\[^ \t\]*)" $pid match sdIndex
		if {[info exists childPortToSd($sdIndex)]} {
		    set childSd $childPortToSd($sdIndex)
                    if {$env(useDP)} {
                        if {[catch {dp_RDO $childSd MpAbort $invokedBy} results]} {
                            puts stderr "runMP: dp_RDO failed in APSMpAbort while aborting parallel procs: $results"
                        }
                    } else {
                        if {[catch {::comm::comm2 send $childSd [list MpAbort $invokedBy]} results]} {
                        }
                    }
		    set $pid 1
		}
	    }
	}
    }
}

proc APSMpJoinHelp {} {
    return "Usage: <results> APSMpJoin <id>\nSynchronize current execution with parallel procedure identified\nby <id>. This call will cause execution to block until <id> completes.\nAny return value of your parallel procedure is returned in <results>.\nNote: you should surround this with catch, since an error in the parallel\nprocedure will generate an error during the later join."
}

proc APSMpJoin {parallelId} {
    global $parallelId apsMpParallelProcesses

    APSMpStep "APSMpJoin waiting for parallel process to complete"
    # Potential race condition here. It is possible that parallelId
    # could be set between "set" and "tkwait" commands. Depends on
    # how dp schedules execution of callbacks within tcl. 
    if {[set $parallelId] == 0} {
	tkwait variable $parallelId
    }
    APSMpStep "APSMpJoin parallel process completed"

    # Get parallel procedure's return value (if none, returns -1 by default)
    set returnVar $parallelId:Return
    global $returnVar ${returnVar}Value ${returnVar}Code
    set returnValue [set $returnVar]
    global status
    
    # set status "APSMpJoin: returnVar is $parallelId:Return   value is $returnValue"

    if {[string compare $returnValue -1]==0} {
        if {[info exists ${returnVar}Value]} {
            set returnValue [list [set ${returnVar}Code] [set ${returnVar}Value]]
        } else {
            set status "${returnVar}Value not found!"
        }
    }

    # Clean up global vars allocated for this parallel procedure and
    #   remove from global apsMpParallelProcesses list.
    DebugInfo "APSMpJoin: removing $parallelId from apsMpParallelProcesses"
    DebugInfo "APSMpJoin: returnValue = $returnValue"
    set apsMpParallelProcesses \
        [APSMpParallelListDelete $apsMpParallelProcesses $parallelId]
    unset $returnVar
    unset $parallelId

    if {$returnValue == -1} {
	# Return value never set due to tcl error or abort
        set status "Return value never set!"
	return -code error "aborted"
    } else {
	if {![string compare [lindex $returnValue 0] "ok"]} {
	    return [lindex $returnValue 1]
	} else {
	    return -code error [lindex $returnValue 1]
	}
    }
}

proc APSMpParallelListDelete {list value} {
    set ix [lsearch -exact $list $value]
    if {$ix >=0} {
	return [lreplace $list $ix $ix]
    } else {
	return $list
    }
}

proc APSMpInterfaceHelp {} {
    return "Usage: APSMpInterface\nReturns 1 if the current execution environment of your procedure permits\nthe use of graphical widgets, 0 otherwise."
}

proc APSMpInterface {} {
    global mpInterface

    if {[info exists mpInterface]} {
	return $mpInterface
    } else {
	return 0
    }
}

