13.3. Datatype Mapping

The extended Sather 1.1 library provides a set of built-in classes interfacing to Fortran. These types are "binary" compatible with their Fortran 77 counterparts. Only these built-in classes may be used in signatures of routines implemented in Fortran or Sather routines called from Fortran. Fortran scalar types can be used alone or as parametrizations for built-in Fortran array classes. Sather also provides a convenient way for packaging Sather routines and passing them to Fortran functions or subroutines that expect externally defined subroutines as arguments.

Built-in Scalar Types

Fortran 77 -> Sather class

Features

integer -> F_INTEGER

binary compatible with Fortran 77 integers and can be used whenever Fortran integer type is expected. Supports arithmetic and relational operations, construction from and convention to INT

real -> F_REAL

represents Fortran 77 reals and can be used whenever Fortran real type is expected. Supports arithmetic and relational operations, construction from and convention to FLT

logical -> F_LOGICAL

binary compatible with Fortran 77 logical. Supports logical operations and constructors from Sather BOOL type.

double precision -> F_DOUBLE

binary compatible with Fortran 77 double precision type. Supports a set of features simialr to F_REAL

complex -> F_COMPLEX

binary compatible with Fortran 77 complex type. Supports arithmetic operations and creation from Sather CPX type (although the binary representation is quite different from CPX)

double complex -> F_DOUBLE_COMPLEX

binary compatible with Fortran 77 double complex type. Supports a set of features similar to F_COMPLEX, but uses double precision arithmetic.

character,character*1 -> F_CHARACTER

binary compatible with both Fortran 77 character and character*1 types. As an optimizations, inside Sather space it is represented by a single byte and is, therefore, more efficient than corresponding Fortran 77 types.

character*n -> F_STRING

binary compatible with Fortran 77 character*n type (including character*1). Intra Sather calls are slightly more efficient than corresponding Fortran/Fortran, Sather/Fortran or Fortran/Sather calls.

Array Types

Fortran 77 -> Sather Types

Features

Various array types -> F_ARRAYn{T<$F_SCALAR} where n = 1,2,..

Can be parametrized by any scalar Fortran types, binary compatible with the corresponding Fortran 77 arrays: use the same layout. Can be constructed using Sather arrays, matrix and vector classes. arr:F_ARRAY{F_INTEGER} corresponds to INTEGER arrr(*) in Fortran.

Fortran Routine and Exception Handler Types

Fortran 77 -> Sather Type

Features

External subroutines passed as arguments -> F_ROUT{}

Used to bind Fortran routines, strongly type checked. Can be passed as arguments to external Fortran routines that expect externally defined subroutines as parameters.

Alternate returns (exception handling) -> F_HANDLER

Implements Fortran exception handling in Sather. Can be passed as an arguments to Fortran subroutines with alternate returns (Fortran's way to handle exceptional or abnormal conditions.)

There is also a facility for Sather to provide exception handlers for Fortran subroutines with alternate returns (Fortran's way to handle exceptional or abnormal conditions).

13.3.1. Scalar Types

There are eight built-in scalar types: F_INTEGER, F_REAL, F_LOGICAL, F_DOUBLE, F_COMPLEX, F_DOUBLE_COMPLEX, F_CHARACTER, and F_STRING. They correspond to Fortran 77 types as shown in the table. All scalar Fortran types are subtypes of $F_SCALAR ($F_SCALAR is used as a bound for array parametrizations to ensure that arrays are parameterized with scalar types only).

It is important to distinguish between external Fortran interface types and "regular" Sather types with similar semantics. For example, Sather type INT is different from Fortran F_INTEGER, although both abstract the meaning of integers. There is no sub- or super-typing relationship between INT and F_INTEGER and these types cannot be used interchangeably. No assumption could be made about the relative amounts of memory the Sather and Fortran types need. This is defined differently by Sather and Fortran 77 language specifications. For instance, the only relevant Fortran 77 rule guarantees that integer, logical, and real Fortran types occupy the same amount of memory, and double precision and complex types occupy twice as much (the language does not specify the absolute amounts). Sather, on the other hand, does not specifically support these assumptions.

F_INTEGER

F_INTEGER is a Sather 1.1 class representing Fortran 77 integer type. It can be used whenever a Fortran 77 integer is expected: calls to routines implemented in Fortran, Fortran array parametrizations, etc. The Sather 1.1 library defines the following features for F_INTEGER
class F_INTEGER is
   create(x:INT):F_INTEGER is ...  -- construct from INT
   int:INT is ...                  -- INT version of self
   str:STR is ...                  -- string representation
   zero:SAME is ...                -- zero and
   nil:SAME is ...                 -- nil values
   is_nil:BOOL is ...              -- true if self is nil
   plus(i:SAME):SAME is ...
   minus(i:SAME):SAME is ...
   times(i:SAME):SAME is ...
   div(i:SAME):SAME is ...
   is_eq(i:SAME):BOOL is ...
   is_lt(i:SAME):BOOL is ...
end;

F_INTEGER could be created using a Sather INT type. An existing F_INTEGER could also yield a corresponding Sather INT value. Although the intended use for F_INTEGER variables is to be passed as arguments to and from external Fortran routines, some simple operations on F_INTEGER variables are built-in and could be performed in Sather directly without going through Fortran. Such operations are the regular arithmetic operations (+ -* /) and logical operations. Syntactic sugar and operator precedence rules are same as those for Sather types.

This example uses an external function defined in Fortran to implement a factorial function missing in the F_INTEGER interface:
*     A Fortran function that implements factorial of N
      INTEGER FUNCTION FACTORIAL(N)
      INTEGER N
      FACTORIAL = 1
      DO 10, I=1,N
         FACTORIAL = FACTORIAL * I
 10   CONTINUE
      END

external FORTRAN class USEFUL_FUNCTIONS is
   factorial(i:F_INTEGER):F_INTEGER;
   -- a function implemented in Fortran that returns factorial of i
end;

class MAIN is
   main is
      i:F_INTEGER := #(4);
      a:F_INTEGER := USEFUL_FUNCTIONS::factorial(i);
      #OUT + "This " + a.str + " should be 24\n";
   end;
end;

F_REAL

F_INTEGER, F_REAL represents Fortran 77 real type.
class F_REAL is
   create(x:FLT):F_REAL is ...  -- construct from FLT
   flt:INT is ...               -- FLT version of self
   str:STR is ...               -- string representation
   zero:SAME is ...             -- zero and
   nil:SAME is ...              -- nil values
   is_nil:BOOL is ...           -- true if self is nil
   plus(i:SAME):SAME is ...
   minus(i:SAME):SAME is ...
   times(i:SAME):SAME is ...
   div(i:SAME):SAME is ...
   is_eq(i:SAME):BOOL is ...
   is_lt(i:SAME):BOOL is ...
end;

Sather syntactic sugar for arithmetic and relational operations and operator precedence rules apply to F_REAL. Now, we can extend USEFUL_FUNCTIONS class with a power routine for F_REAL:
external FORTRAN class USEFUL_FUNCTIONS is
   -- external Fortran function that raises x to power y
   power(x:F_REAL,y:F_REAL):F_REAL;
end;

F_DOUBLE

F_DOUBLE represents Fortran 77 double type.
class F_REAL is
   create(x:FLTD):F_REAL is ...       -- construct from FLTD
   fltd:INT is ...                    -- FLTD version of self
   str:STR is ...                     -- string representation
   zero:SAME is ...                   -- zero and
   nil:SAME is ...                    -- nil values
   is_nil:BOOL is ...                 -- true if self is nil
   plus(i:SAME):SAME is ...
   minus(i:SAME):SAME is ...
   times(i:SAME):SAME is ...
   div(i:SAME):SAME is ...
   is_eq(i:SAME):BOOL is ...
   is_lt(i:SAME):BOOL is ...
end;

Sather syntactic sugar for arithmetic and relational operations and operator precedence rules apply to F_DOUBLE.

F_LOGICAL

F_LOGICAL is a Sather class representing Fortran 77 logical type. It is "binary" compatible with Fortran's "logical" type (Sather BOOL has a vastly different representation in ICSI 1.1 compiler). In particular, F_LOGICAL occupies the same amount of space as Fortran integer and real types to conform to Fortran 77 rules.
class F_LOGICAL is
   create(x:BOOL):F_LOGICAL is ...  -- construct from INT
   bool:BOOL is ...                 -- INT version of self
   str:STR is ...                   -- string representation
   not:SAME is ...
   is_eq(B:SAME):BOOL is ...
   f_or(b:SAME):SAME is ...
   f_and(b:SAME):SAME is ...
end;

Logical operations are called f_or and f_and to avoid name collisions with short-circuited Sather operators 'and' and 'or'. The following function implementing exclusive or can be added to USEFUL_FUNCTIONS
xor(a:F_LOGICAL,b:F_LOGICAL):F_LOGICAL is
   return (a.not.f_and(b)).f_or(a.f_and(b.not));
end;

F_COMPLEX

F_COMPLEX is a Sather class binary compatible with Fortran 77 COMPLEX type. Although F_COMPLEX provides a constructor that accepts a variable of Sather CPX type, F_COMPLEX has a binary representation quite different from that of CPX. F_COMPLEX provides a set of features for setting and returning the values of the real and imaginary parts. It also provides useful constructors and supports a set of arithmetic operations.
class F_COMPLEX is
   re:F_REAL is ...             -- return real part
   re(x:F_REAL) is ...          -- set real part
   im:F_REAL is ...             -- return imaginary part
   im(x:F_REAL) is ...          -- set imaginary part
   create(c:CPX):SAME is ...    -- create new and
                                -- initialize to value of c
   create(re:F_REAL,im:F_REAL):SAME is ...
   create(re:FLT,im:FLT):SAME is ...
   create(fc:F_COMPLEX):SAME is ...
   cpx:CPX is ...               -- Sather comlplex type
   str:STR is ...               -- string representation
   zero:SAME is ...             -- zero and
   nil:SAME is ...              -- nil value
   is_nil:BOOL is ...           -- true if self is nil
   plus(c:SAME):SAME is ...
   minus(c:SAME):SAME is ...
   times(c:SAME):SAME is ...
   div(c:SAME):SAME is ...
   is_eq(c:SAME):BOOL is ...
end;

This is a possible implementation of addition of F_COMPLEX numbers:
plus(c:F_COMPLEX):F_COMPLEX is
   return #F_COMPLEX(re+c.re,im+c.im);
end;

F_DOUBLE_COMPLEX

Similar to F_COMPLEX, F_DOUBLE_COMPLEX is a Sather class binary compatible with the Fortran double complex type. Double complex type is an extension to Fortran 77 supported by many F77 compiler. F_DOUBLE_COMPLEX class provides functionality similar to F_COMPLEX, but works with double precision floating point representations.
class F_DOUBLE_COMPLEX is
   re:F_DOUBLE is ...           -- return real part
   re(x:F_DOUBLE) is ...        -- set real part
   im:F_DOUBLE is ...           -- return imagianry part
   im(x:F_DOUBLE) is ...        -- set imaginary part
   create(c:CPXD):SAME is ...   -- create new and
                                -- initialize to value of c
   create(re:F_DOUBLE,im:F_DOUBLE):SAME is ...
   create(re:FLTD,im:FLTD):SAME is ...
   create(fc:F_DOUBLE_COMPLEX):SAME is ...
   cpxd:CPXD is ...             -- CPXD version of self
   str:STR is ...               -- string representation
   zero:SAME is ...             -- zero and
   nil:SAME is ...              -- nil value
   is_nil:BOOL is ...           -- true if self is nil
   plus(c:SAME):SAME is ...
   minus(c:SAME):SAME is ...
   times(c:SAME):SAME is ...
   div(c:SAME):SAME is ...
   is_eq(c:SAME):BOOL is ...
end;

F_CHARACTER

F_CHARACTER is binary compatible with Fortran 77 types character and character*1. Fortran 77 character and character*1 types are, in fact, instances of character*n types with n set to 1. In Sather terms, they are strings with size always set to one. For parameter passing purposes, Fortran character and character*1 variables behave exactly as generic character*n types (the length of the string which is always one is passed as an extra parameter for each character or character*1 argument). Since the goal for F_CHARACTER is binary compatibility with Fortran, this is how F_CHARACTER class behave when a call crosses the language boundary. However, as long as F_CHARACTER variables stay within the Sather space, they are represented and passed to routines more efficiently, as a single byte. As a result, simple character operations performed on F_CHARACTER class in Sather are more efficient than their Fortran versions!
class F_CHARACTER is
   create(c:CHAR):SAME is ...  -- create new and
                               -- initialize to value of c
   char:CHAR is ...            -- CHAR version of self
   str:STR is ...              -- STR version of self
   zero:SAME is ...            -- zero
   is_eq(c:SAME):BOOL is ...
   is_lt(c:SAME):BOOL is ...
end;

F_STRING

F_STRING is binary compatible with Fortran 77 character*n types. Note, that both F_CHARACTER and F_STRING can be used to interface with Fortran character*1 type, but F_CHARACTER yields better performance for computations performed in Sather.

F_STRING is internally represented by a tuple: the first field points to the string itself, and the second records the string length. An inter-language call requires that both be passed as separate arguments. In unnamedlink you find more information on this. Inside Sather however (calls using the Sather parameter passing convention), F_STRING is passed as a whole, which is slightly more efficient than the Fortran calls.
class F_STRING is
   create(s:STR):SAME is ...   -- create new and
                               -- initialize to value of s
   create(n:INT):SAME is ...   -- new of size n
   create(c:CHAR):SAME is ...  -- create from c
   address:C_CHAR_PTR is ...   -- the "string" part
   size:INT is ...             -- string length
   str:STR is ...              -- STR version of self
end;

13.3.2. Fortran Array Classes

Providing a convenient array interface is an important goal for Sather/Fortran interoperability. A set of parametrized classes F_ARRAY{T<$F_SCALAR}, and F_ARRAYn{T<$F_SCALAR}, where n=2,3... are used for this purpose. Array classes can be parametrized by any of the scalar types. For example, F_ARRAY{F_INTEGER} corresponds to a Fortran 77 integer array type. Similarly, F_ARRAY2{F_REAL} represents a Fortran 77 two-dimensional array of real numbers.

F_ARRAY classes must be binary compatible with the Fortran 77 arrays and therefore they conform to the Fortran array layouts. For instance, this requires that in a two dimensional arrays successive elements of a column are in a contiguous memory locations (i.e. column major layout.) Note that regular Sather arrays (ARRAY{}, ARRAY2{}, etc.) support C-like row-major layout. Thus, creation of Fortran arrays based on Sather arrays may require a layout change. On the other hand, matrix classes provided by the Sather Math library have the same layout as Fortran arrays. F_ARRAY2 classes provide constructors from MAT classes that have reference semantics - thus the creation procedure is fairly inexpensive.

Combining materials from this chapter, and using Fortran array types, we can construct a simple Sather interface to standard Fortran BLAS single precision matrix multiplication routine as follows:
    SUBROUTINE SGEMM (TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,BETA,C,LDC)
    CHARACTER*1        TRANSA, TRANSB
    INTEGER            M, N, K, LDA, LDB, LDC
    REAL               ALPHA, BETA
    REAL               A( LDA, * ), B( LDB, * ), C( LDC, * )

external FORTRAN class BLAS is
   sgemm(transa:F_CHARACTER, transb:F_CHARACTER, m,n,k:F_INTEGER,
         alpha:F_REAL, a:F_ARRAY2{F_REAL}, lda:F_INTEGER,
         b:F_ARRAY2{F_REAL}, ldb:F_INTEGER,beta:F_REAL,
         C:F_ARRAY2{F_REAL},ldc:F_INTEGER);
   -- this corresponds to the fortran BLAS signature
end;

class TEST_BLAS is
   main is
      fa,fb,fc:F_ARRAY2{F_REAL};
      sa,sb,sc:MAT;
      initialize(sa,sb,sc);
      fa := #(sa);  -- these creations has "reference" semantics
      fb := #(sb);
      fc := #(sc);
      dim:F_INTEGER := #(fa.size);
      TEST_BLAS::sgemm(#('N'),#('N'),#(sa.nr),#(sb.nc),#(sa.nc),#(1.0),
                       fa,#(sa.size1),fb,#(sb.size1),#(0.0),fc,#(sc.size1));
      -- at this point, both fc and sc have a multiplication result
   end;

   initialize(sa:MAT,sb:MAT,sc:MAT) is
       -- initialization code ...
   end;
end;

We can go one step father and hide the details of Fortran implementation of sgemm entirely from the user:
class MAT is
   ...
   various methods from MAT class
   ...
   times(m:SAME):SAME is
      -- multiply self by m and return the resulting matrix
      -- For efficiency, uses high-performance Fortran 77 BLAS sgemm
      res:MAT := #(nr,m.nc); -- storage for result
      fa,fb,fc:F_ARRAY2{F_REAL};
      fa := #(self);
      fb := #(m);
      fc := #(res);
      -- now, call the Fortran BLAS sgemm
      TEST_BLAS::sgemm(#('N'),#('N'),#(nr),#(m.nc),#(nc),#(1.0),
      fa,#(size1),fb,#(m.size1),#(0.0),fc,#(res.size1));
      -- at this point, both fc and res have a multiplication result
      return res;
   end;
end;

-- now it is really easy to multiply matrices!
a,b,c:MAT;
c := a*b;

This code shows that using high-performance Fortran BLAS in Sather is, in fact, much easier than in Fortran! The internal workings of BLAS could be buried in the libraries. As a result, matrix multiplication is expressed as easily as "a*b" in the example. If the code is compiled with compiler optimizations on, the Sather inlining stage eliminates an extra routine call, and the end result will be as efficient as calling "sgemm" from Fortran directly. However, we get away with not specifying about a dozen parameters in the most general case.

In the given example, the space for the multiplication result 'fc' needs to be allocated in Sather (Fortran 77 has no means for a dynamic memory allocation). This is also necessary even when Fortran arrays are returned by functions.

Points to note

13.3.3. F_ROUT and F_HANDLER Types

Passing Routines as Arguments, F_ROUT{}

Fortran 77 supports passing procedures as arguments to subroutines and functions. It is desirable to be able to package a Sather routine and pass it as an argument to Fortran code. It may prove necessary for example, when Fortran numerical code expects a differentiation or integration function to be passed as an argument. Since we would like to exploit Sather flexibility and development speed whenever possible, a natural thing to do is to write such integration routines in Sather and pass them to numerical Fortran code.

Sather 1.1 provides a way to bundle any routine in the External class that supports the Fortran parameter passing convention and pass it as a functional argument to Fortran code that expects external procedures as parameters. A Fortran routine type F_ROUT{} serves this purpose. In many ways, F_ROUTs are similar to Sather routine closures. Just as routine closures, they are strongly typed and provide similar creation facilities. However, unlike routine closures, all arguments in the Fortran routine used for creation must be left unbound. This is necessary to adhere to Fortran semantics and for performance considerations.

'#F_ROUT(...)' is a creation expression that surrounds a Fortran calls with all arguments replaced by the underscore character '_'. For example, this code may be used to compute a distance between two points on the plane whose coordinates are represented by Fortran complex numbers:
external FORTRAN class STAT is
   distance(point1:F_COMPLEX, point2:F_COMPLEX,res:F_REAL) is
      -- this routine is compiled using the Fortran parameter
      -- passing convention and name binding. It could be called
      -- from either Sather or Fortran
      x1:FLT := point1.re.flt; y1:FLT := point1.im.flt;
      x2:FLT := point2.re.flt; y2:FLT := point2.im.flt;
      res := #F_REAL(((x1-x2).square + (y1-y2).square).sqrt);
   end;

   -- this routine is implemented externally in Fortran
   process_points(array1:F_ARRAY{F_COMPLEX}, array2:F_ARRAY{F_COMPLEX},
                  func:F_ROUT{F_COMPLEX,F_COMPLEX,F_REAL),size:F_INTEGER);
end;

In the above example, an externally implemented Fortran subroutine process_points expects two arrays of complex numbers and a function that will be applied to corresponding elements in the arrays:
    SUBROUTINE PROCESS_POINTS(ARRAY1,ARRAY2,FUNC,SIZE)
    COMPLEX ARRAY1(*), ARRAY2(*)
    EXTERNAL FUNC
    INTEGER SIZE

    REAL RES
    DO 10 I=1,SIZE
      CALL FUNC(ARRAY1(I),ARRAY2(I),RES)
      PRINT *, RES
10  CONTINUE
    END

We can pass a routine defined in Sather to Fortran subroutine process_points the following way:
-- This code appears in some STAT feature
array1, array2:F_ARRAY{F_COMPLEX}
-- some code to initialize array1 and array2

rout:F_ROUT{F_COMPLEX,F_COMPLEX,F_REAL} := #F_ROUT(distance(_,_,_));
process_points(array1,array2,rout); -- call Fortran code

Variables of F_ROUT type behave similarly to ROUT variables. It is possible to assign to such variables, pass them as parameters, etc.:
rout:F_ROUT{F_COMPLEX,F_COMPLEX,F_REAL} := #F_ROUT(distance(_,_,_));

rout1:F_ROUT{F_COMPLEX,F_COMPLEX,F_REAL);
rout1 := rout;  -- F_ROUT assignment: lhs and rhs types are the same

Points to note

Exceptional Condition Handling, F_HANDLER

It is possible in Fortran to anticipate exceptional conditions and have different flow paths depending on whether the called subroutine has terminated properly, or has detected abnormal circumstances. This is achieved using the alternate RETURN facility.
*       A call to a subroutine with "alternate returns"
*       This is a Fortran's way to handle exceptional conditions
*       If, for some reason, FOO detects an abnormality
*       it can choose to return to exception handlers
*       (passed as labels 100 and 200), rather than to the caller
        CALL FOO(I,J,*100,*200)
1       ....

*       Handle exceptions
*       Exception Handler 1
100     ....
        GO TO 1
200     Exception Handler 2
        ....
        GO TO 1

*       A subroutine with alternate returns
*       Two exception handlers are passed in (marked by *)
*       RETURN 1 transfers control to the first handler, and
*       RETURN 2 transfers control to the second handler
*       "Normal" RETURN transfers control to the caller
        SUBROUTINE FOO(I,J,*,*)
        ...
*       Detect abnormal conditions and transfer control to
        the appropriate exception handlers
        IF (I.EQ.0) RETURN 1
        IF (J.EQ.0) RETURN 2
        END

In the given example, the argument list of the call to subroutine FOO includes 2 labels corresponding to the exception handler entries. If an exceptional condition of some sort arises, FOO will transfer control to the appropriate exception handler (passed as an argument) rather than the caller. For example, if the value of argument I is 0, the control is transferred to exception handler 1, if J is 0, exception handler 2 handles the exception. The exception handlers are indicated by the dummy asterisk arguments in the subroutine argument list. Only subroutines are allowed to have such arguments.

Since alternate returns are a part of Fortran, they may be present in the interfaces provided by the Fortran libraries. It is, therefore, desirable to call such subroutines from Sather and provide exception handlers written in Sather for such calls.

The F_HANDLER class captures the essence of the Fortran exception handlers and could be passed in as an argument to a subroutine with alternate returns. F_HANDLER provides a single constructor create(rout:ROUT):SAME. The argument is a bound routine with no arguments since Fortran handlers do not have any arguments. Now, we will call the Fortran subroutine FOO, but supply Sather exception handlers at the moment of the call.
class HANDLERS is
   h(i:INT) is
      #OUT + "Sather handler for Fortran exception " + i.str + "\n";
   end;

   create:SAME is
      return new;
   end;
end;

external FORTRAN class FOO is
   foo(i:F_INTEGER,j:F_INTEGER,handler1:F_HANDLER, handler2:F_HANDLER);
   -- note that foo can't have a return value - this is a Fortran
   -- restriction on subroutine with alternate returns
end;

-- code that calls Fortran FOO
handlers:HANDLERS := #;
handler1:F_HANDLER := #(bind(handlers.h(1))); -- create first handler
handler2:F_HANDLER := #(bind(handlers.h(2))); -- create second handler
FOO::foo(#(1),#(0),handler1,handler2);

When this code is executed, it prints: "Sather handler for Fortran exception 2".

F_HANDLER mechanism allows to integrate Fortran and Sather exceptions even more closely. For example, we can use Sather exception handlers that catch Fortran exceptions to raise standard Sather exceptions that are caught by the Sather protect mechanism. Essentially, this turns Fortran exception into regular Sather exceptions:
class HANDLERS is
   r_h(i:INT) is
      raise "FORTRAN->Sather exception redirected by handler #" + i.str;
   end;
   create:SAME is return new; end;
end;

external FORTRAN class FOO is
   foo(i:F_INTEGER,j:F_INTEGER,handler1:F_HANDLER, handler2:F_HANDLER);
   -- note that foo can't have a return value - this is a Fortran
   -- restriction on subroutine with alternate returns
end;

-- code that calls Fortran FOO
handlers:HANDLERS := #;
redirect_handler1:F_HANDLER := #(bind(handlers.r_h(1)));
redirect_handler2:F_HANDLER := #(bind(handlers.r_h(2)));
protect
   FOO::foo(#(1),#(0),redirect_handler1,redirect_handler2);
when STR then
   #OUT + "Sather exception for "+exception+\n";
end

This code produces: "Sather exception for FORTRAN->Sather exception redirected by handler 2"

Points to note