FORTRAN via open pipe

Martin Lemburg - 02.10.2002:

To execute and control a FORTRAN executable I've chosen to use open this executable using a pipe. The only things to be done is to configure the resulting channel and to setup the event handlers for the events readable and/or writable. But ... it's true, it depends not on a FORTRAN executable, any executable could be handled like that.

I wrote a package named runExe. I need this package explicitely to control a FORTRAN executable doing calculations. This package works with an callback, which is called when ...

the execution of the executable should be prepared
the executable delivers text, input occurs
the executable needs text, output is needed
the execution of the executable is finished

The bold words above are the keywords the callback could rely on to determine, which mode is currently active.

The callback could contain substitutes (like bind callbacks), which are replaced before the execution of the callback:

%m = execution mode of the blocking command (prepare, input, output or finished)
%e = name of the executable (including all parameters)
%s = success flag (boolean)
%t = timeout flag (boolean)
%o = output variable contents
%O = name of the output variable

If the callback is called in the input mode, than to the callback retrieves as additional argument the text the executable delivered. If the callback is called in the output mode, than the callback has to return the text to be send to the executable.

So the callback should be written like this:

 proc executableCallback { ... args } {
   ...

   return $output;
 }

AM (See also Managing Fortran programs for details on the Fortran side.) I like this package, but could you perhaps add a worked-out example?

Martin Lemburg - 04.10.2002:

Sorry, the only really working example is one I can't really publish.

I developed this package to be used to control external "machine controller software".

As explaination:

I work in a team that works on a simulation software to simulate presslines, dies, die kinematics for sheet metal manifacturing.

We have the need to use pressline manifacture software, calculating the movement of pressline components - called controllers. Most of these controllers are "old" or have to do so much mathmatics, that they are written in FORTRAN. So we have external blackboxes doing the calculations and all we have to do is giving information to this blackboxes and to extract the needed information from the blackboxes calculation results.

This package works for "our" controllers, but none of them needs input via stdin!

I use this package in the way, that my callback prepares the information to be handed to the controller blackboxes, if called in the prepare mode. Called in the finished mode, the callback extracts the needed information from the calculation results. My callback doesn't react on the input and output modes.

So much about my usage, but ... sorry ... I can't tell really more.

AM No problem, there are at least two people (including myself :-) interested in this type of things. So, a small, though trivial example might help out. Perhaps a slight adaptation of my example (see the referenced page) could achieve just that.

Martin Lemburg - 04.10.2002:

Ok, I added an example at the bottom of the page!

Syntax:

runExe options ?arg arg ...?

runExe run executable mode blocking callback timeout ?outputvar?

Description:

runs the executable in the r/w mode
blocks the application or not
executes the callback (if not empty) on execution prepare, input, output and at the end
cares for the timeout
stores all text retrieved from the executable in the given output variable.

Arguments:

executable - string or list containing the path of the executable and all parameters.
mode - the open mode, which can be r, r+, w or w+.
blocking - flag to specify if the application should be blocked during the execution. If the execution should block the application the callback must be specified.
callback - string or list defining a script to be used as callback during the preparation, input, output and at the end of the executable execution. Must be given if blocking is false.
timeout - double value specifying the timeout duration in seconds. if the value is 0, the timeout is disabled.
outputvar - name of a global variable to be used to store every output of the executable in.

Result:

In the blocking mode the return value is a boolean for a succeeded (true) or failed (false) execution. If a timeout occurs, than it returns false.
In the non-blocking mode it returns the process channel id of the created process

runExe stop pid

Description:

stops the executable belonging to the given process channel id
cleans up the internal datastructures
only needed if the executable is executed in the non-blocking mode

Arguments:

pid - process channel id (result of an open with pipe)

Result:

none

runExe cleanup pid

Description:

cleans up the internal datastructures
only needed if the executable is executed in the non-blocking mode

Arguments:

pid - process channel id (result of an open with pipe)

Result:

none

runExe running pid

Description:

detects if the process belonging to the given process channel id is still running
only needed if the executable is executed in the non-blocking mode

Arguments:

pid - process channel id (result of an open with pipe)

Result:

if the given process is still running, than the return value is true, otherwise false

Here the pkgIndex.tcl code:

 package ifneeded runExe 1.0 [list source [file join $dir runExe.tcl]];

Here the package runExe code:

 uplevel #0 {
   global auto_path env;

   if {[lsearch -exact $auto_path [file dirname [info script]]] < 0} {
     lappend auto_path [file dirname [info script]];
   }

   package provide runExe 1.0;

   proc runExe {args} {
     if {![llength $args]} {
       error "runExe option ?arg arg ...?";
     }

     set options {run stop cleanup running};
     set option  [lindex $args 0];
     set args    [lrange $args 1 end];

     if {[set idx [lsearch -glob $options ${option}*]] >= 0} {
       return [eval runExe::[lindex $options $idx] $args];
     }

     error "bad option \"$option\": must be [join [linsert [join [lsort -dictionary $options] {, }] end-1 {or}]]";
   }
 }

 namespace eval ::runExe {
   variable executables;

   proc this {} "return [namespace current];";

   # proc run
   #
   # args
   #
   #  executable - name of the executable and all parameters
   #  mode       - access mode to the pipe to be created (r, r+, w, or w+)
   #  blocking   - flag to signal if this proc should wait until the executable
   #               is finished
   #  callback   - script to be executed to prepare the execution, to return input
   #               for the executable, to get output of the executable, to be the
   #               execution finish callback. Must be given, if blocking is disabled!
   #  timeout    - double value in seconds, 0 disables the timeout handler
   #  outputVar  - (optional) name of the name of a variable to contain the
   #               output of the executable
   #
   proc run {executable mode blocking callback timeout {outputVar ""}} {
     if {[lsearch -exact {r r+ w w+} $mode] < 0} {
       error "bad mode \"$mode\": must be r, r+, w, or w+";
     }

     if {![string is boolean -strict $blocking]} {
       error "expected valid boolean as blocking flag, but got \"$blocking\"";
     }

     if {![string is double -strict $timeout]} {
       error "expected valid double as timeout in seconds, but got \"$timeout\"";
     }

     if {!$blocking && ($callback == "")} {
       error "expected callback script, because blocking is disabled";
     }

     # (re)set the variable to store outputs of the executable in
     #
     if {$outputVar != ""} {
       global $outputVar;

       set $outputVar  "";
     }

     # do preparations to be done before starting the executable
     #
     if {$callback != ""} {
       execCallback $callback prepare $executable $blocking 0 0 $outputVar;
     }

     if {[catch {set pid [open "|$executable" $mode];} reason]} {
       error "couldn't run executable with \"$executable\": $reason";
     }

     # set the process related variables
     #
     set [this]::executables($pid.executable) $executable;
     set [this]::executables($pid.success)    -1;
     set [this]::executables($pid.blocking)   $blocking;
     set [this]::executables($pid.callback)   $callback;
     set [this]::executables($pid.after)      "";
     set [this]::executables($pid.timeout)    $timeout;
     set [this]::executables($pid.outputVar)  $outputVar;

     # start if wanted the timeout handler
     #
     if {$timeout} {
       set [this]::executables($pid.after) [after \
         [expr {int($timeout * 1000)}] \
         [list [this]::timeoutCB $pid] \
       ];
     }

     # configure the process channel
     #
     fconfigure $pid -buffering none -blocking 0;

     if {[lsearch {r r+ w+} $mode] >= 0} {
       fileevent $pid readable [list [this]::inCB $pid];
     }

     if {[lsearch {r+ w w+} $mode] >= 0} {
       fileevent $pid readable [list [this]::outCB $pid];
     }

     # let this proc wait if blocking is wanted
     # and set the return value depending on the blocking flag
     #
     if {$blocking} {
       if {[info commands tk] == ""} {
         vwait [this]::executables($pid.success);
       } else {
         tkwait variable [this]::executables($pid.success);
       }

       set result  [set [this]::executables($pid.success)];

       cleanup $pid;
     } elseif {!$blocking && ($callback != "")} {
       set result $pid;
     }

     return $result;
   }

   proc stop {pid} {
     if {[running $pid]} {
       finishCB $pid;
     }

     cleanup $pid;

     return;
   }

   proc cleanup {pid} {
     array unset [this]::executables $pid.*;

     return;
   }

   proc running {pid} {
     if {[array names [this]::executables $pid.*] == ""} {
       return 0;
     }

     if {([file channels $pid] == "") || [eof $pid]} {
       return 0;
     }

     return 1;
   }

   proc execCallback {callback mode executable blocking success timeout outputVar args} {
     # replace all substitutes for ...
     #    %m = execution mode of the blocking command (prepare, input, output or finished)
     #    %e = name of the executable (including all parameters)
     #    %s = success flag (boolean)
     #    %t = timeout flag (boolean)
     #    %o = output variable contents
     #    %O = name of the output variable
     #
     regsub -all -- {%m} $callback $mode callback;
     regsub -all -- {%e} $callback $executable callback;
     regsub -all -- {%b} $callback $blocking callback;
     regsub -all -- {%s} $callback $success callback;
     regsub -all -- {%t} $callback $timeout callback;
     regsub -all -- {%O} $callback $outputVar callback;

     if {$outputVar != ""} {
       global $outputVar;

       set output  [set $outputVar];
     } else {
       set output  "";
     }

     regsub -all -- {%o} $callback $output callback;

     # execute the blocking command (or callback)
     #
     return [uplevel #0 $callback $args];
   }

   proc finishCB {pid {timeout 0}} {
     if {[set [this]::executables($pid.after)] != ""} {
       after cancel [set [this]::executables($pid.after)];
     }

     fileevent $pid readable {};
     fconfigure $pid -blocking 1;

     if {[catch {close $pid;}] || $timeout} {
       set [this]::executables($pid.success)  0;
     } else {
       set [this]::executables($pid.success)  1;
     }

     # set the output variable, if given
     #
     set outputVar  [set [this]::executables($pid.outputVar)];

     if {$outputVar != ""} {
       global $outputVar;

       set $outputVar  [join [set $outputVar] "\n"];
     }

     # execute the callback, if set
     #
     set callback  [set [this]::executables($pid.callback)];

     if {$callback != ""} {
       execCallback \
         $callback \
         finished \
         [set [this]::executables($pid.executable)] \
         [set [this]::executables($pid.blocking)] \
         [set [this]::executables($pid.success)] \
         $timeout \
         [set [this]::executables($pid.outputVar)];
     }

     return;
   }

   proc inCB {pid} {
     if {[file channels $pid] == ""} {
       return;
     }

     if {[eof $pid]} {
       finishCB $pid;
     } else {
       set outputVar  [set [this]::executables($pid.outputVar)];

       if {$outputVar != ""} {
         upvar #0 $outputVar dummy;
       }

       lappend dummy  [set output [read $pid]];

       if {$output != ""} {
         execCallback \
           [set [this]::executables($pid.callback)] \
           output \
           [set [this]::executables($pid.executable)] \
           [set [this]::executables($pid.blocking)] \
           [set [this]::executables($pid.success)] \
           [set [this]::executables($pid.timeout)] \
           [set [this]::executables($pid.outputVar)] \
           $output;
       }
     }

     return;
   }

   proc outCB {pid} {
     if {[file channels $pid] == ""} {
       return;
     }

     if {[eof $pid]} {
       finishCB $pid;
     } else {
       puts $pid [execCallback \
         [set [this]::executables($pid.callback)] \
         input \
         [set [this]::executables($pid.executable)] \
         [set [this]::executables($pid.blocking)] \
         [set [this]::executables($pid.success)] \
         [set [this]::executables($pid.timeout)] \
         [set [this]::executables($pid.outputVar)] \
       ];

       flush $pid;
     }

     return;
   }

   proc timeoutCB {pid} {
     if {[file channels $pid] != ""} {
       finishCB $pid 1;
     }

     return;
   }

   namespace export [list run stop cleanup running];
 }

Example:

This example has two procedures (both inside a namespace):

calc starts the controller blackbox via "runExe run ...".
ExecCB is handed to the runExe package and is called in the prepare and the finished mode (in this case, the only two interessting modes). ExecCB itself calles the procedures Prepare, Delete, MoveTo, which are not listed here.

 variable blackboxDir .;
 variable pwd         "";

 proc calc {args} {
   if {([set argsc [llength $args]] < 4) || ($argsc > 10) || ($argsc % 2)} {
     error "wrong # args: should be \"calc ?options? scheme strokeRate xPitch yPitch\"";
   }

   # parse options (possible are: -moveto, -outputvar, -timeout)
   #
   set matched  0;

   foreach {name var type default} {
     -moveto    moveTo    ""     ""
     -outputvar outputVar ""     ""
     -timeout   timeout   double 0
   } {
     if {![info exists $var]} {
       set $var $default;
     }

     foreach {option value} $args {
       if {![string match {-*} $option]} {
         set matched  1;
         break;
       }

       if {[string length $option] <= 2} {
         error "bad option \"$option\": must be -moveto, or -outputvar";
       }

       if {[string equal -length [string length $option] $option $name]} {
         if {($type == "") || [string is $type -strict $value]} {
           set $var    $value;
           set matched  1;
           set args    [lreplace $args 0 1];
           break;
         } else {
           error "expected $type value for $name, but got \"$value\"";
         }
       }
     }

     if {!$matched} {
       error "bad option \"$option\": must be -moveto, or -outputvar";
     }
   }

   if {[llength $args] != 4} {
     error "wrong # args: should be \"calc ?options? scheme strokeRate xPitch yPitch\"";
   }

   # validating the given arguments
   #
   foreach {scheme strokeRate xPitch yPitch} $args {break;};

   if {![string is double -strict $strokeRate]} {
     error "expected valid double as strokes per minute, but got \"$strokeRate\"";
   }

   if {![string is double -strict $xPitch]} {
     error "expected valid double as horizontal transfer pitch, but got \"$xPitch\"";
   }

   if {![string is double -strict $yPitch]} {
     error "expected valid double as vertical transfer pitch, but got \"$yPitch\"";
   }

   # run the blackbox
   #
   variable blackboxDir;

   if {$moveTo == ""} {
     set moveTo  [file join $blackboxDir $scheme];
   }

   return [runExe run \
     [file join $blackboxDir bin blackbox] r \
     1 [list ExecCB %m $scheme $strokeRate $xPitch $yPitch $moveTo] \
     $timeout \
     $outputVar \
   ];
 }

 proc ExecCB {mode scheme strokeRate xPitch yPitch moveTo args} {
   switch -exact -- $mode {
     prepare  {
       variable blackboxDir;
       variable pwd;

       # create the input data/file for the controller
       # based on a scheme/template
       #
       Prepare $scheme $strokeRate $xPitch $yPitch;

       # delete eventually existing output data/files,
       # because the controller won't work if existent
       #
       Delete;

       set pwd [pwd];

       cd [file join $blackboxDir bin];
     }
     finished {
       variable pwd;

       cd $pwd;

       # move the output data to the scheme directory
       # or another given directory
       #
       Move $moveTo;
     }
   }

   return;
 }