src/whirl2xaif/ty2xaif.cxx

Go to the documentation of this file.

// ##########################################################
// # This file is part of OpenADFortTk.                     #
// # The full COPYRIGHT notice can be found in the top      #
// # level directory of the OpenADFortTk source tree.       #
// # For more information visit                             #
// # http://www.mcs.anl.gov/openad                          #
// ##########################################################

#include <sstream> 

#include "Open64IRInterface/Open64BasicTypes.h"

#include "wn2xaif.h"
#include "wn2xaif_mem.h"
#include "st2xaif.h"
#include "ty2xaif.h"

namespace whirl2xaif { 

  extern WN* PU_Body;
  extern BOOL Array_Bnd_Temp_Var;

  /* TY2F_Handler[] maps a TY_kind to a function that translates
   * a type of the given kind into Fortran.  Should the ordinal
   * numbering of the KIND change in "../common/com/stab.h", then
   * a corresponding change must be made here.
   */

  typedef void (*TY2F_HANDLER_FUNC)(xml::ostream&, TY_IDX, PUXlationContext& ctxt);

  static void 
  TY2F_invalid(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_scalar(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_array(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_array_for_pointer(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_struct(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_2_struct(xml::ostream& xos,TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_pointer(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);
  static void 
  TY2F_void(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt);

  // ***************************************************************************

  static const TY2F_HANDLER_FUNC TY2F_Handler[KIND_LAST/*TY_KIND*/] = {
    &TY2F_invalid,   /* KIND_INVALID */
    &TY2F_scalar,    /* KIND_SCALAR */
    &TY2F_array,     /* KIND_ARRAY */
    &TY2F_struct,    /* KIND_STRUCT */
    &TY2F_pointer,   /* KIND_POINTER */
    &TY2F_invalid,   /* KIND_FUNCTION */
    &TY2F_void,      /* KIND_VOID */
  }; /* TY2F_Handler */

  /* detect parts of f90 dope vectors which should be output. Most are
     I4 boundaries except the bofst >16 - just for num_dims */
#define NOT_BITFIELD_OR_IS_FIRST_OF_BITFIELD(f)                         \
  (!FLD_is_bit_field(f) || (FLD_is_bit_field(f) && (FLD_bofst(f) == 0) || FLD_bofst(f) > 16))

  // ***************************************************************************

  void
  TY2F_translate(xml::ostream& xos, TY_IDX ty, BOOL notyapp, PUXlationContext& ctxt)
  {
    // Dispatch the translation-task to the appropriate handler function.
    if (!notyapp)
      TY2F_Handler[TY_kind(Ty_Table[ty])](xos, ty, ctxt);
    else
      TY2F_2_struct(xos, ty, ctxt);
  }

  void 
  TY2F_translate(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt)
  {
    TY2F_translate(xos, ty, 0, ctxt);
  }


  /*---------------------- A few utility routines -----------------------*/
  /*---------------------------------------------------------------------*/

  // static void
  // WN2F_tempvar_rhs(xml::ostream& xos, WN * wn)
  // {
  //   /* The rhs */
  //   PUXlationContext ctxt;
  //   whirl2xaif::TranslateWN(xos, WN_kid0(wn), ctxt);
  // }

  // static void
  // GetTmpVarTransInfo(xml::ostream& xos, ST_IDX arbnd, WN* wn)
  // {
  //   WN * stmt;
  //   stmt = WN_first(wn);
  //   while ((stmt !=NULL)
  //     && ((WN_operator(stmt)!=OPR_STID) || (WN_operator(stmt) ==OPR_STID)
  //         && strcmp(ST_name(WN_st(stmt)), ST_name(ST_ptr(arbnd)))))
  //     stmt = WN_next(stmt);
  //   if (stmt != NULL)
  //     WN2F_tempvar_rhs(xos, stmt);
  // }

  static std::string
  TY2F_Append_Array_Bnd_Ph(ST_IDX arbnd)
  {
    // FIXME: 
    std::ostringstream xos_abdstr;
    xml::ostream xos_abd(xos_abdstr.rdbuf());

#if 0 // FIXME
    WN* wn = PU_Body; // FIXME--Yuck!!!
    GetTmpVarTransInfo(xos_abd, arbnd, wn);
#endif
  
    return xos_abdstr.str();
  } 

  static void
  TY2F_Append_ARB(xml::ostream& xos, ARB_HANDLE arb, TY_IDX ty_idx, 
                  PUXlationContext& ctxt)
  {  
    if (TY_is_f90_deferred_shape(ty_idx)) {

      xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
          << xml::Attr("name", "shape") << xml::Attr("value", ':') << xml::EndElem;
    
    } else {

      std::string lb, ub;
      if (ARB_const_lbnd(arb)) {
        lb = TCON2F_translate(Host_To_Targ(MTYPE_I4, ARB_lbnd_val(arb)), 
                              FALSE /*is_logical*/);
      } else if (ARB_lbnd_var(arb) != 0) {
        lb = TY2F_Append_Array_Bnd_Ph(ARB_lbnd_var(arb));
      }
    
      if (ARB_const_ubnd(arb)) {
        ub = TCON2F_translate(Host_To_Targ(MTYPE_I4, ARB_ubnd_val(arb)),
                              FALSE /*is_logical*/); 
      } else if (ARB_ubnd_var(arb) != 0) {
        ub = TY2F_Append_Array_Bnd_Ph(ARB_ubnd_var(arb));
      }

      xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
          << xml::Attr("name", "lb") << xml::Attr("value", lb) << xml::EndElem;
      xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
          << xml::Attr("name", "ub") << xml::Attr("value", ub) << xml::EndElem;

    }
  } 

  static BOOL
  TY2F_is_character(TY_IDX ty)
  {
    while (TY_kind(ty) == KIND_ARRAY)
      ty = TY_etype(ty);

    return TY_is_character(ty);
  }
  /*------ Utilities for accessing and declaring KIND_STRUCT FLDs ------
   *---------------------------------------------------------------------*/

#define FLD_INFO_ALLOC_CHUNK 16
  static FLD_PATH_INFO *Free_Fld_Path_Info = NULL;


  static BOOL
  TY2F_Pointer_To_Dope(TY_IDX ty)
  {
    /* Is this a pointer to a dope vector base */
    return (strcmp(TY_name(TY_pointed(ty)),".base.") == 0) ;
  }

  static FLD_PATH_INFO *
  New_Fld_Path_Info(FLD_HANDLE fld)
  {
    /* Allocates a new FLD_PATH_INFO, reusing any that have earlier
     * been freed up.  Dynamic allocation occurs in chunks of 16
     * (FLD_INFO_ALLOC_CHUNK) FLD_PATH_INFOs at a time.
     */
    FLD_PATH_INFO *fld_info;
   
    if (Free_Fld_Path_Info != NULL)
      {
        fld_info = Free_Fld_Path_Info;
        Free_Fld_Path_Info = fld_info->next;
      }
    else
      {
        INT info_idx;
      
        /* Allocate a new chunk of path infos, and put all except the
         * first one on the free-list.
         */
        fld_info = TYPE_MEM_POOL_ALLOC_N(FLD_PATH_INFO, Malloc_Mem_Pool, 
                                         FLD_INFO_ALLOC_CHUNK);
        fld_info[FLD_INFO_ALLOC_CHUNK-1].next = Free_Fld_Path_Info;
        for (info_idx = FLD_INFO_ALLOC_CHUNK-2; info_idx > 0; info_idx--)
          fld_info[info_idx].next = &fld_info[info_idx+1];
        Free_Fld_Path_Info = &fld_info[1];
      }

    fld_info->next = NULL;
    fld_info->arr_elt = FALSE;
    fld_info->arr_ofst = 0;
    fld_info->arr_wn = NULL;
    fld_info->fld = fld;
    return fld_info;
  } /* New_Fld_Path_Info */

  static STAB_OFFSET
  TY2F_Fld_Size(FLD_HANDLE this_fld, mUINT64  max_size)
  {
    /* Returns the size of the field, taking into account the offset
     * to the next (non-equivalence) field and the maximum field-size
     * (based on the structure size).
     */
  
    mUINT64 fld_size = TY_size(FLD_type(this_fld));

    /* Restrict the fld_size to the max_size */
    if (fld_size > max_size)
      fld_size = max_size;
  
    /* If this_fld is an equivalence field, then just return the current
     * fld_size (cannot be any different), otherwise search for a non-
     * equivalent next_fld at a higher offset.
     * TODO: mfef90 & mfef77 set the flag slightly differently in COMMON.
     * this really works only for mfef77.
     */

    if (!FLD_equivalence(this_fld))
      {
        FLD_ITER fld_iter = Make_fld_iter(this_fld);

        if (!FLD_last_field (fld_iter)) 
          {
            ++fld_iter;
            BOOL found = FALSE;
            mUINT64 noffset = 0; 

            do
              {
                FLD_HANDLE next_fld (fld_iter);

                if (!FLD_is_bit_field(next_fld)) 
                  if (!(FLD_equivalence(next_fld) || FLD_ofst(this_fld) >= FLD_ofst(next_fld)))
                    {
                      found  = TRUE;
                      noffset =  FLD_ofst(next_fld) ;
                      break ;
                    }
              } while (!FLD_last_field (fld_iter ++ )) ;

            if (found) 
              if (fld_size > noffset - FLD_ofst(this_fld))
                fld_size = noffset - FLD_ofst(this_fld) ;
          }
      }
    return fld_size;
  } /* TY2F_Fld_Size */


  static FLD_PATH_INFO *
  Select_Best_Fld_Path(FLD_PATH_INFO *path1,
                       FLD_PATH_INFO *path2,
                       TY_IDX         desired_ty,
                       mUINT64        desired_offset)
  {
    /* PRECONDITION: Both paths must be non-NULL and lead to a field
     *    at the desired_offset.
     *
     * Try to find the best of two paths to a field.  This routine
     * will be called for EVERY field at every place where a struct,
     * union, or equivalence field is accessed, so efficiency is of
     * uttmost importance.  The best path is returned, while the other
     * on is freed up.
     */
    FORTTK_ASSERT(path1 && path2, fortTkSupport::Diagnostics::UnexpectedInput);
   
    FLD_PATH_INFO *best_path;
    mUINT64        offs1, offs2;
    FLD_PATH_INFO *p1, *p2;
    TY_IDX         t1,  t2;
   
    /* Find the last field on each path */
    offs1 = FLD_ofst(path1->fld) + path1->arr_ofst;
    for (p1 = path1; p1->next != NULL; p1 = p1->next)
      offs1 += FLD_ofst(p1->next->fld) + p1->next->arr_ofst;
    offs2 = FLD_ofst(path2->fld) + path2->arr_ofst;
    for (p2 = path2; p2->next != NULL; p2 = p2->next)
      offs2 += FLD_ofst(p2->next->fld) + p2->next->arr_ofst;

    FORTTK_ASSERT(offs1 == desired_offset && offs2 == desired_offset,
                  "Unexpected offset");

    /* Get the element type (either the field type or the type of an
     * array element.
     */
    if (p1->arr_elt)
      t1 = TY_AR_etype(FLD_type(p1->fld));
    else
      t1 = FLD_type(p1->fld);
    if (p2->arr_elt)
      t2 = TY_AR_etype(FLD_type(p2->fld));
    else
      t2 = FLD_type(p2->fld);

    /* Compare types, in order of increasing accuracy */
    if (TY_mtype(t1) == TY_mtype(desired_ty) &&
        TY_mtype(t2) != TY_mtype(desired_ty))
      best_path = path1;
    else if (TY_mtype(t2) == TY_mtype(desired_ty) &&
             TY_mtype(t1) != TY_mtype(desired_ty))
      best_path = path2;
    else if (Stab_Identical_Types(t1, desired_ty,
                                  FALSE,  /* check_quals */
                                  TRUE,   /* check_scalars */
                                  FALSE)) /* ptrs_as_scalars */
      best_path = path1; /* path2 cannot possibly be any better */
    else if (Stab_Identical_Types(t2, desired_ty,
                                  FALSE,  /* check_quals */
                                  TRUE,   /* check_scalars */
                                  FALSE)) /* ptrs_as_scalars */
      best_path = path2;
    else
      best_path = path1;

    /* Free up the path not chosen */
    if (best_path == path1)
      TY2F_Free_Fld_Path(path2);
    else
      TY2F_Free_Fld_Path(path1);

    return best_path;
  } /* Select_Best_Fld_Path */


  static FLD_PATH_INFO *
  Construct_Fld_Path(FLD_HANDLE   fld,
                     TY_IDX    struct_ty,
                     TY_IDX    desired_ty,
                     mUINT64   desired_offset,
                     mUINT64   max_fld_size)
  {
    /* Returns the field path through "fld" found to best match the 
     * given offset and type.  As a minimum requirement, the offset 
     * must be as desired and the type must have the desired size
     * and alignment (with some concessions allowed for substrings).
     * The path is terminate with a NULL next pointer.  When no 
     * field matches the desired type and offset, NULL is returned.
     */
    FLD_PATH_INFO    *fld_path;
    const mUINT64     fld_offset = FLD_ofst(fld);
    TY_IDX            fld_ty = FLD_type(fld);
    BOOL              is_array_elt = FALSE;
    STAB_OFFSET       ofst_in_fld = 0;
  
    if (TY_is_f90_pointer(fld_ty))
      fld_ty = TY_pointed(fld_ty);
  
  
    /* This field cannot be on the path to a field with the given
     * attributes, unless the desired_offset is somewhere within
     * the field.
     */
#if DBGPATH
    printf (" Construct: fld %s, struct %s, desired %s , des off %d \n",
            FLD_name(fld), TY_name(struct_ty), TY_name(desired_ty),
            desired_offset);
#endif

    if (desired_offset < fld_offset ||
        desired_offset >= (fld_offset + TY_size(fld_ty))) {
      /* This field cannot be on the path to a field with the given
       * attributes, since the desired_offset is nowhere within
       * the field.
       */
      fld_path = NULL;
#if DBGPATH
      printf ("     found NULL\n");
#endif
    } else if (TY_Is_Array(fld_ty) && TY_is_character(fld_ty) &&
               TY_Is_Array(desired_ty) && TY_is_character(desired_ty)) {
#if DBGPATH
      printf ("     found char substring\n");
#endif
      /* A match is found! */
      ofst_in_fld = (desired_offset - fld_offset)/TY_size(TY_AR_etype(fld_ty));
      ofst_in_fld *= TY_size(TY_AR_etype(fld_ty));
      if ((ofst_in_fld + TY_size(desired_ty)) > TY_size(fld_ty)) {
        fld_path = NULL; /* The string does not fit */
      } else {
        fld_path = New_Fld_Path_Info(fld);
        if (TY_size(fld_ty) != TY_size(desired_ty)) {
          fld_path->arr_elt = TRUE;
          fld_path->arr_ofst = ofst_in_fld;
        } 
      }
    } else {
      /* See if the field we are looking for may be an array element */
    
      if (TY_kind(desired_ty)==KIND_POINTER)   
        desired_ty = TY_pointed(desired_ty);
      if (TY_kind(desired_ty)==KIND_ARRAY)
        desired_ty = TY_AR_etype(desired_ty);

      is_array_elt = (TY_Is_Array(fld_ty) &&
                      (TY_Is_Structured(TY_AR_etype(fld_ty))||
                       TY2F_is_character(fld_ty) ||
                       Stab_Identical_Types(TY_AR_etype(fld_ty), desired_ty,
                                            FALSE,   /* check_quals */
                                            FALSE,   /* check_scalars */
                                            TRUE))); /* ptrs_as_scalars */
#if DBGPATH
      printf ("     is_array = %d, fld_ty %s \n",is_array_elt,TY_name(fld_ty));
#endif

      if (is_array_elt) {
        fld_ty = TY_AR_etype(fld_ty);
        ofst_in_fld =
          ((desired_offset - fld_offset)/TY_size(fld_ty)) * TY_size(fld_ty);
      }
    
      if (TY_Is_Structured(fld_ty) &&
          !Stab_Identical_Types(fld_ty, desired_ty,
                                FALSE,  /* check_quals */
                                FALSE,  /* check_scalars */
                                TRUE)) {  /* ptrs_as_scalars */
#if DBGPATH
        printf ("     recurse \n");
#endif
        FLD_PATH_INFO *fld_path2 = 
          TY2F_Get_Fld_Path(fld_ty, desired_ty, 
                            desired_offset - (fld_offset+ofst_in_fld));
      
        /* If a matching path was found, attach "fld" to the path */
        if (fld_path2 != NULL) {
          if (TY_split(Ty_Table[fld_ty]))
            fld_path = fld_path2; /* A stransparent substructure */
          else {
            fld_path = New_Fld_Path_Info(fld);
            fld_path->arr_elt = is_array_elt;
            fld_path->arr_ofst = ofst_in_fld;
            fld_path->next = fld_path2;
          }
        } else {
          fld_path = NULL;
        }
      } else { /* This may be a field we want to take into account */
        const STAB_OFFSET fld_size = TY2F_Fld_Size(fld, max_fld_size);

        /* We only match a field with the expected size, offset
         * and alignment.
         */
        if (desired_offset != fld_offset+ofst_in_fld || /* unexpected ofst */
            // fld_size < (TY_size(fld_ty)+ofst_in_fld) || /* unexpected size */
            TY_align(struct_ty) < TY_align(fld_ty)) {   /* unexpected align */
#if DBGPATH
          printf ("     account - miss\n");
#endif
        
          fld_path = NULL;
        } else { /* A match is found! */
#if DBGPATH
          printf ("     account - match\n");
#endif
          fld_path = New_Fld_Path_Info(fld);
          fld_path->arr_elt = is_array_elt;
          fld_path->arr_ofst = ofst_in_fld;
        }/*if*/
      } /*if*/
    } /*if*/
  
    return fld_path;
  } /* Construct_Fld_Path */


  static const char * 
  TY2F_Fld_Name(FLD_HANDLE fld, 
                BOOL       common_or_equivalence,
                BOOL       alt_return_name)
  {
    /* Since fields may be accessed in an unqualified manner in Fortran,
     * e.g. for common block members and equivalences, so we need to treat
     * them similar to the way we would treat regular objects.
     */
    const char *fld_name = NULL;

    if (common_or_equivalence && !alt_return_name) {
      fld_name = FLD_name(fld);
    } else {
      fld_name = FLD_name(fld);
    }
    if (fld_name == NULL || *fld_name == '\0') { fld_name = "anon-fld"; }

    return fld_name;
  } /* TY2F_Fld_Name */


  /*------ Utilities for accessing and declaring KIND_STRUCTs ------
   *----------------------------------------------------------------*/

  static void
  TY2F_Equivalence(xml::ostream& xos, 
                   const char  *equiv_name, 
                   const char  *fld_name,
                   STAB_OFFSET  fld_ofst)
  {
    /* Append one equivalence statement to the tokens buffer,
     * keeping in mind that the equiv_name is based at index 1. */
    xos << "EQUIVALENCE(" << equiv_name; /* equiv_name at given offset */
    xos << "(" << Num2Str(fld_ofst, "%lld") << "),";
    xos << fld_name << ")";  /* fld_name at offset zero */
  } /* TY2F_Equivalence */


  static void
  TY2F_Equivalence_FldList(xml::ostream& xos, 
                           FLD_HANDLE   fldlist,
                           UINT         equiv_var_idx,
                           mUINT64      ofst,
                           BOOL        *common_block_equivalenced)
  {
    FLD_ITER fld_iter = Make_fld_iter(fldlist);

    do {
      FLD_HANDLE fld (fld_iter);

      if (TY_split(Ty_Table[FLD_type(fld)]))
        {
          TY2F_Equivalence_FldList(xos, 
                                   TY_flist(Ty_Table[FLD_type(fld)]),
                                   equiv_var_idx,
                                   ofst + FLD_ofst(fld),
                                   common_block_equivalenced);
        }
      else if (FLD_equivalence(fld) || !*common_block_equivalenced)
        {
          xos << std::endl;
          const char* tmpvar = StrCat("tmp", Num2Str(equiv_var_idx, "%d"));
          TY2F_Equivalence(xos, tmpvar, TY2F_Fld_Name(fld_iter, TRUE/*equiv*/,
                                                      FALSE/*alt_ret*/),
                           ofst + FLD_ofst(fld));
          if (!FLD_equivalence(fld))
            *common_block_equivalenced = TRUE;
        }

    }
    while (!FLD_last_field (fld_iter++)) ;

  } /* TY2F_Equivalence_FldList */


  static void
  TY2F_Equivalence_List(xml::ostream& xos, 
                        const TY_IDX struct_ty)
  {
    /* Append a nameless EQUIVALENCE specification statement for
     * each equivalence field in the given struct.  Declare a 
     * dummy symbol as an array of INTEGER*1 elements to represent
     * the structure and each EQUIVALENCE specification will then 
     * equivalence a field to this dummy-symbol at the field offset.
     *
     * Group these declarations together by prepending each 
     * declaration (including the first one) with a newline.
     *
     * For COMMON blocks, it is also necessary to emit one element
     * that is not an equivalence!
     */
    TY_IDX     equiv_ty;
    UINT       equiv_var_idx;
    BOOL       common_block_equivalenced = FALSE;

    /* Declare an INTEGER*1 array (or CHARACTER string?) variable
     * to represent the whole equivalenced structure. Don't unlock
     * the tmpvar, or a similar equivalence group (ie: TY) will 
     * get the same temp.
     */
    equiv_ty = Stab_Array_Of(Stab_Mtype_To_Ty(MTYPE_I1), TY_size(struct_ty));
    equiv_var_idx = Stab_Lock_Tmpvar(equiv_ty, &ST2F_Declare_Tempvar);

    /* Relate every equivalence field to the temporary variable.
     */
    TY2F_Equivalence_FldList(xos, 
                             TY_flist(Ty_Table[struct_ty]),
                             equiv_var_idx,
                             0, /* Initial offset */
                             &common_block_equivalenced);

  } /* TY2F_Equivalence_List */

  // static void
  // TY2F_Translate_Structure(xml::ostream& xos, TY_IDX ty)
  // {
  //   FORTTK_ASSERT(TY_kind(ty) == KIND_STRUCT, "Unexpected type " << TY_kind(ty));

  //   FLD_ITER     fld_iter;
  //   TY& ty_rt  = Ty_Table[ty];

  //   PUXlationContext ctxt;// FIXME

  //   xos << std::endl;
  
  //   /* Emit structure header */
  //   xos << "TYPE " << TY_name(ty);
  
  //   if (TY_is_sequence(ty_rt)) {
  //     xos << std::endl << "SEQUENCE ";
  //   }
  
  //   /* Emit structure body */
  //   FLD_IDX flist = ty_rt.Fld();
  
  //   if (flist != 0) {
  //     fld_iter = Make_fld_iter(TY_flist(ty_rt));
  //     do {
  //       FLD_HANDLE fld (fld_iter);
      
  //       /* if it's a bitfield, then assume it's part of a dope vector & */
  //       /* just put out the name of the first bitfield in this I4       */
  //       if (NOT_BITFIELD_OR_IS_FIRST_OF_BITFIELD(fld_iter)) {
  //    /* See if this field starts a map or a union */
        
  //    xos << std::endl;
  //    if (FLD_begin_union(fld)) {
  //      xos << "  UNION" << std::endl;
  //    } else if (FLD_begin_map(fld)) {
  //      xos << "  MAP" << std::endl;
  //    }
        
  //    /* Declare this field */
  //    if (FLD_is_pointer(fld)) {
  //      xos << ",POINTER::";
  //    }

  //    xos << TY2F_Fld_Name(fld_iter, FALSE/*common*/, FALSE/*alt_ret_name*/);
        
  //    if (FLD_is_pointer(fld) && (TY_kind(FLD_type(fld)) == KIND_ARRAY)) {
  //      TY2F_array_for_pointer(xos, FLD_type(fld), ctxt);
  //    } else {
  //      TY2F_translate(xos, FLD_type(fld), ctxt);
  //    }
        
  //    /* See if this field terminates a map or union */
  //    if (FLD_end_union(fld)) {
  //      xos << std::endl << "END UNION";
  //    } else if (FLD_end_map(fld)) {
  //      xos << std::endl << "END MAP";
  //    }
  //       }       
  //     } while (!FLD_last_field (fld_iter++)) ;
  //   }
  
  //   /* Emit structure tail */
  //   xos << std::endl;
  //   xos << "END TYPE" << std::endl;
  // }


  static void
  TY2F_Translate_EquivCommon_PtrFld(xml::ostream& xos, FLD_HANDLE fld)
  {
    assert(0);
  }

  static void
  TY2F_Declare_Common_Flds(xml::ostream& xos,
                           FLD_HANDLE   fldlist, 
                           BOOL         alt_return, /* Alternate return points */
                           BOOL        *is_equiv)   /* out */
  {
    assert(0);
  } 

  static void
  TY2F_List_Common_Flds(xml::ostream& xos, FLD_HANDLE fldlist)
  {
    FLD_ITER fld_iter = Make_fld_iter(fldlist);

    do {
      FLD_HANDLE fld (fld_iter);
      TY & ty  = Ty_Table[FLD_type(fld)];       
    
      if (TY_split(ty)) {
        /* Treat a full split element as a transparent data-structure */
        TY2F_List_Common_Flds(xos, TY_flist(ty));
      } else if (!FLD_equivalence(fld)) {
        xos << TY2F_Fld_Name(fld_iter, TRUE/*common*/, FALSE/*alt_ret_name*/);
      }
    
      if (!FLD_last_field(fld)) {
        FLD_ITER  next_iter = fld_iter ;
        FLD_HANDLE next (++next_iter);
        if (!FLD_equivalence(next))
          xos << ',';
      }
    
    } while (!FLD_last_field (fld_iter++)) ;

  } /* TY2F_List_Common_Flds */

  /*------------- Hidden routines to declare variable types -------------*/
  /*---------------------------------------------------------------------*/

  static void
  TY2F_invalid(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt)
  {
    FORTTK_DIE(fortTkSupport::Diagnostics::UnexpectedInput << TY_kind(Ty_Table[ty]));
  }

  static void
  TY2F_scalar(xml::ostream& xos, TY_IDX ty_idx, PUXlationContext& ctxt)
  {
    FORTTK_ASSERT(TY_kind(ty_idx) == KIND_SCALAR, fortTkSupport::Diagnostics::UnexpectedInput);
  
    TY&   ty = Ty_Table[ty_idx];
    MTYPE mt = TY_mtype(ty);

    const char* type_str;
    if (TY_is_character(ty)) {
      type_str = "CHARACTER";
    } else if (TY_is_logical(ty)) {
      type_str = "LOGICAL";
    } else {
      switch(mt) {
      case MTYPE_U1: // Strictly speaking unsigned integers not supported
      case MTYPE_U2: // in Fortran, but we are lenient and treat them
      case MTYPE_U4: // as the signed equivalent.
      case MTYPE_U8:
      
      case MTYPE_I1:
      case MTYPE_I2:
      case MTYPE_I4:
      case MTYPE_I8:
        type_str = "INTEGER";
        break;
      
      case MTYPE_F4:
      case MTYPE_F8:
      case MTYPE_FQ:
        type_str = "REAL";
        break;
      
      case MTYPE_C4:
      case MTYPE_C8:
      case MTYPE_CQ:
        type_str = "COMPLEX";
        break;
      
      case MTYPE_M:
        type_str = "memory block";
        break;
      
      default:
        FORTTK_DIE("Unexpected type " << MTYPE_name(mt));
      }
    }
  
    const char* size_str;
    INT64 size;
    if (TY_size(ty) > 0) {
      if (ctxt.isF90() && MTYPE_is_complex(mt)) {
        size = TY_size(ty) / 2; 
      } else {
        size = TY_size(ty);
      }
      size_str = Num2Str(size, "%lld");
    } else {
      if (mt == MTYPE_M) {
        size_str = ".mblock.";
      } else {
        FORTTK_ASSERT(TY_is_character(ty), 
                      "Unexpected type size " << TY_size(ty));
        size_str = "*";
      }
    }

    const char* str = StrCat(type_str, size_str);

    xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
        << xml::Attr("name", "type") << xml::Attr("value", str) << xml::EndElem;

    xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
        << xml::Attr("name", "whirltype") << xml::Attr("value", TY_name(ty)) << xml::EndElem;
  }

  static void
  TY2F_array(xml::ostream& xos, TY_IDX ty_idx, PUXlationContext& ctxt)
  {
    TY& ty = Ty_Table[ty_idx];

    FORTTK_ASSERT(TY_kind(ty) == KIND_ARRAY, fortTkSupport::Diagnostics::UnexpectedInput);

    xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
        << xml::Attr("name", "whirlkind") << xml::Attr("value", "array") << xml::EndElem;


    if (TY_is_character(ty)) { // FIXME
      // A character string... 
      if (TY_size(ty) > 0) /* ... of known size */
        xos << "CHARACTER*" << Num2Str(TY_size(ty), "%lld");
      else /* ... of unknown size */
        xos << "CHARACTER*(*)";

    } else {
      // A regular array, so prepend the element type and append
      // the index bounds.
      ARB_HANDLE arb_base = TY_arb(ty);
      INT32 dim = ARB_dimension(arb_base) ;
      INT32 co_dim = ARB_co_dimension(arb_base);
      INT32 array_dim = dim - co_dim;
      INT32 revdim = 0;

      if (ARB_co_dimension(arb_base) <= 0) {
        co_dim = 0;
        array_dim = dim;
      }

      // 1. Translate element type
      xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
          << xml::Attr("name", "ArrayElementType");

      // Do not permit pointers as elements of arrays, so just use
      // the corresponding integral type instead.  We do not expect
      // such pointers to be dereferenced anywhere. (FIXME)
      if (TY_Is_Pointer(TY_AR_etype(ty)))
        TY2F_translate(xos, Stab_Mtype_To_Ty(TY_mtype(TY_AR_etype(ty))), ctxt);
      else
        TY2F_translate(xos, TY_AR_etype(ty), ctxt);
    
      xos << xml::EndElem;

      // 2. Translate dimension attributes
      while (array_dim > 0) {
      
        xos << xml::BegElem("xaif:Property") << xml::Attr("id", ctxt.currentXlationContext().getNewVertexId()) 
            << xml::Attr("name", "ArrayDimensionAttr") << xml::Attr("dim", dim);
      
        ARB_HANDLE arb = arb_base[dim-1];
        TY2F_Append_ARB(xos, arb, ty_idx, ctxt);
      
        xos << xml::EndElem;
      
        array_dim--;
        dim--;
        revdim++;
      } 

      // 3. What is this???
      dim = ARB_dimension(arb_base);
      array_dim = dim - co_dim;
      --dim;
    
      if (co_dim > 0) {
        xos << '[';
        while (co_dim > 0) {
          ARB_HANDLE arb = arb_base[dim-array_dim];
        

          if (TY_is_f90_deferred_shape(ty))
            TY2F_Append_ARB(xos, arb, ty_idx, ctxt);
          else {
            if (co_dim == 1)
              TY2F_Append_ARB(xos, arb, ty_idx, ctxt); // TRUE
            else
              TY2F_Append_ARB(xos, arb, ty_idx, ctxt); // FALSE
          }
        
          dim--;

          if (co_dim > 1)
            xos << ',';

          co_dim--;
          ++revdim;
        }
        xos << ']';
      }

    }
  } /* TY2F_array */


  static void
  TY2F_array_for_pointer(xml::ostream& xos, TY_IDX ty_idx, PUXlationContext& ctxt)
  {
    TY& ty = Ty_Table[ty_idx] ;

    FORTTK_ASSERT(TY_kind(ty) == KIND_ARRAY, fortTkSupport::Diagnostics::UnexpectedInput);
  
    if (TY_is_character(ty)) {
      /* A character string...
       */
      if (TY_size(ty) > 0) /* ... of known size */
        xos << "CHARACTER*" << Num2Str(TY_size(ty), "%lld");
      else /* ... of unknown size */
        xos << "CHARACTER*(*)";
    } else {
      /* A regular array, so prepend the element type and append
       * the index bounds.
       */
      ARB_HANDLE arb_base = TY_arb(ty);
      INT32       dim = ARB_dimension(arb_base) ;
      INT32       co_dim = ARB_co_dimension(arb_base);
      INT32       array_dim = dim-co_dim;
      INT32       revdim = 0;
    
      /* Do not permit pointers as elements of arrays, so just use
       * the corresponding integral type instead.  We do not expect
       * such pointers to be dereferenced anywhere.
       */
      if (TY_Is_Pointer(TY_AR_etype(ty)))
        TY2F_translate(xos, Stab_Mtype_To_Ty(TY_mtype(TY_AR_etype(ty))), ctxt);
      else
        TY2F_translate(xos, TY_AR_etype(ty), ctxt);
    
      if (ARB_co_dimension(arb_base)<=0) {
        co_dim=0;
        array_dim = dim;
      }
    
      if (array_dim>0) {
        xos << "(";
      
        while (array_dim > 0) {
          ARB_HANDLE arb = arb_base[dim-1];
          xos << ':';
          if (array_dim-- > 1)
            xos << ',';
        
          --dim;
          ++revdim;
        }
      
        xos << ')';
      }
    
      dim = ARB_dimension(arb_base);
      array_dim = dim - co_dim;
      --dim;
    
      if (co_dim > 0) {
        xos << '[';
        while (co_dim > 0) {
          ARB_HANDLE arb = arb_base[dim-array_dim];
          xos << ':';
          dim--;

          if (co_dim-- > 1)
            xos << ',';
        
          ++revdim;
        }
        xos << ']';
      }
    }
  } /* TY2F_array_for_pointer */


  static void
  TY2F_struct(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt)
  {
    /* Structs are supported by VAX-Fortran and Fortran-90.  Note
     * that we here emit a RECORD declaration, while we expect
     * the STRUCTURE to have been declared through a call to
     * TY2F_Translate_Structure().
     */
    TY& ty_rt = Ty_Table[ty];
    FORTTK_ASSERT(TY_kind(ty_rt) == KIND_STRUCT, fortTkSupport::Diagnostics::UnexpectedInput);
  
    xos << "(" << TY_name(ty) << ")" << "TYPE";
  
#if 0 // see Open64 stab_attr.cxx; if needed simulate thru PUXlationContext
    if (!TY_is_translated_to_c(ty)) {
      TY2F_Translate_Structure(xos, ty);
      Set_TY_is_translated_to_c(ty); /* Really, translated to Fortran, not C */
    }
#endif
  }


  static void
  TY2F_2_struct(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt)
  {
    /* Structs are supported by VAX-Fortran and Fortran-90.  Note
     * that we here emit a RECORD declaration, while we expect
     * the STRUCTURE to have been declared through a call to
     * TY2F_Translate_Structure().
     */
    TY & ty_rt = Ty_Table[ty];
    FORTTK_ASSERT(TY_kind(ty_rt) == KIND_STRUCT, fortTkSupport::Diagnostics::UnexpectedInput);

#if 0 // see Open64 stab_attr.cxx; if needed simulate thru PUXlationContext
    if (!TY_is_translated_to_c(ty)) {
      TY2F_Translate_Structure(xos, ty);
      Set_TY_is_translated_to_c(ty); /* Really, translated to Fortran, not C */
    }
#endif
  }


  static void
  TY2F_pointer(xml::ostream& xos, TY_IDX ty, PUXlationContext& ctxt)
  {
    /* Is a dope vector base address? Put out an integer large enough */
    /* to hold an address for now. Don't really want POINTER because  */
    /* implies cray/f90 pointer instead of address slot               */
  
    if (TY2F_Pointer_To_Dope(ty)) {
#if 0
      Prepend_Token_String(xos,",POINTER ::");
#endif
      TY2F_translate(xos,Be_Type_Tbl(Pointer_Mtype), ctxt);
    } else {
      /* avoid recursive type declarations */
      if (TY_kind(TY_pointed(ty)) == KIND_STRUCT) {
#if 0
        Prepend_Token_String(xos,",POINTER ::");
        Prepend_Token_String(xos, TY_name(TY_pointed(ty)));
#endif
        TY2F_translate(xos,Be_Type_Tbl(Pointer_Mtype), ctxt);
      
      } else
        TY2F_translate(xos,TY_pointed(ty), ctxt);
    }
  } /* TY2F_pointer */

  static void
  TY2F_void(xml::ostream& xos, TY_IDX ty_idx, PUXlationContext& ctxt)
  {
    TY& ty = Ty_Table[ty_idx];
    FORTTK_ASSERT(TY_kind(ty) == KIND_VOID, fortTkSupport::Diagnostics::UnexpectedInput);
    xos << std::endl << "! <Void Type>";
  }

  /*------------------------ exported routines --------------------------*/
  /*---------------------------------------------------------------------*/


  // JU: I don't think the conditions under which this method is called
  // in the rest of the code are ever satisfied. 
  void 
  TY2F_Translate_ArrayElt(xml::ostream& xos, 
                          TY_IDX       arr_ty_idx,
                          STAB_OFFSET  arr_ofst)
  {  
        std::cout << "TEMP WARNING" << std::endl; 
  }


  void
  TY2F_Translate_Common(xml::ostream& xos, const char *name, TY_IDX ty_idx)
  {
    TY& ty = Ty_Table[ty_idx];
    BOOL is_equiv = FALSE;
  
    FORTTK_ASSERT(TY_kind(ty) == KIND_STRUCT, 
                  fortTkSupport::Diagnostics::UnexpectedInput << TY_kind(ty));

    // Emit specification statements for every element of the common
    // block, including equivalences.
    xos << xml::BegComment << "COMMON";
    if (name != NULL && *name != '\0') { xos << " name = " << name; }
    xos << xml::EndComment;

#if 0 // FIXME
    TY2F_List_Common_Flds(xos, TY_flist(ty));
  
    // variables in common block type declaration
    TY2F_Declare_Common_Flds(xos, TY_flist(ty), FALSE /*alt_return*/, &is_equiv);
  
    // Emit equivalences, if there are any
    if (is_equiv)
      TY2F_Equivalence_List(xos, ty_idx /*struct_ty*/);
#endif
  }


  void
  TY2F_Translate_Equivalence(xml::ostream& xos, TY_IDX ty_idx, BOOL alt_return)
  {
    /* When alt_return==TRUE, this represents an alternate return variable,
     * in which case we should declare the elements of the equivalence
     * with unmangled names and ignore the fact that they are in an
     * equivalence.  The first element in such an alternate return is
     * the function/subprogram return-variable, which we should never
     * declare.
     */
    TY& ty = Ty_Table[ty_idx];

    FLD_HANDLE first_fld;
    BOOL is_equiv;
   
    FORTTK_ASSERT(TY_kind(ty) == KIND_STRUCT, 
                  fortTkSupport::Diagnostics::UnexpectedInput << TY_kind(ty));

    if (alt_return) {
      first_fld = FLD_next(TY_flist(ty)); /* skip func_entry return var */
    } else {
      first_fld = TY_flist(ty);
    }

    /* Emit specification statements for every element of the
     * equivalence block.
     */  
    TY2F_Declare_Common_Flds(xos, first_fld, alt_return,
                             &is_equiv);  /* Redundant in this call */

    if (!alt_return)
      TY2F_Equivalence_List(xos, ty_idx /*struct_ty*/);

  } /* TY2F_Translate_Equivalence */


  FLD_PATH_INFO * 
  TY2F_Free_Fld_Path(FLD_PATH_INFO *fld_path)
  {
    FLD_PATH_INFO *free_list;
   
    if (fld_path != NULL) {
      free_list = Free_Fld_Path_Info;
      Free_Fld_Path_Info = fld_path;
      while (fld_path->next != NULL)
        fld_path = fld_path->next;
      fld_path->next = free_list;
    }
    return NULL;
  } /* TY2F_Free_Fld_Path */


  FLD_PATH_INFO * 
  TY2F_Get_Fld_Path(const TY_IDX struct_ty, const TY_IDX object_ty, 
                    STAB_OFFSET offset)
  {
    FLD_PATH_INFO* fld_path;
    FLD_PATH_INFO* fld_path2 = NULL;
    TY& s_ty = Ty_Table[struct_ty];
    FLD_ITER fld_iter;

    FORTTK_ASSERT(TY_kind(s_ty) == KIND_STRUCT, 
                  fortTkSupport::Diagnostics::UnexpectedInput << TY_kind(s_ty));
  
    /* Get the best matching field path into fld_path2 */
    fld_iter = Make_fld_iter(TY_flist(s_ty));
  
    do {
      FLD_HANDLE fld (fld_iter);
    
      if (NOT_BITFIELD_OR_IS_FIRST_OF_BITFIELD(fld_iter)) {
        fld_path = Construct_Fld_Path(fld_iter, struct_ty, object_ty,
                                      offset, TY_size(s_ty));
        if (fld_path2 == NULL)
          fld_path2 = fld_path;
        else if (fld_path != NULL)
          fld_path2 = Select_Best_Fld_Path(fld_path2, fld_path, object_ty,
                                           offset);
      }
    } while (!FLD_last_field (fld_iter++));
  
    /* POSTCONDITION: fld_path2 points to the best match found */
    return fld_path2;
  }

  void
  TY2F_Translate_Fld_Path(xml::ostream&   xos,
                          FLD_PATH_INFO *fld_path, 
                          BOOL           deref, 
                          BOOL           member_of_common, 
                          BOOL           alt_ret_name,
                          PUXlationContext& ctxt)
  {
    /* Append the name of each field to the tokens, separated them
     * from each other by the field-selection operator ('.').  The
     * first name on the path may optionally be emitted in unclobbered 
     * form, as it may represent an alternate return point.
     */
    while (fld_path != NULL) {
      FLD_HANDLE f (fld_path->fld);
      const char* str = TY2F_Fld_Name(f, member_of_common, alt_ret_name);
      if (deref && TY_Is_Pointer(FLD_type(f))) {
        str = StrCat("deref_", str); // W2CF_Symtab_Nameof_Fld_Pointee(f);
      }
      xos << xml::BegElem("TYFLD") << xml::Attr("***name", str) << xml::EndElem;

      member_of_common = FALSE; /* Can only be true first time around */
    
      /* if an array element, form the subscript list. If an OPC_ARRAY */
      /* provides the subscripts, use it o/w use offset                */
      if (fld_path->arr_elt) {
        if (fld_path->arr_wn != NULL)
          WN2F_array_bounds(xos, fld_path->arr_wn, FLD_type(f), ctxt);
      }
    
      /* Separate fields with the dot-notation. */
      fld_path = fld_path->next;
      if (fld_path != NULL) {
        TY2F_Fld_Separator(xos) ;
        alt_ret_name = FALSE; /* Only applies to first field on the path */
      }
    } /* while */
  
  } /* TY2F_Translate_Fld_Path */


  extern void
  TY2F_Fld_Separator(xml::ostream& xos)
  {
    /* puts out the appropriate structure component separator*/
    xos << '%';
  }

  extern FLD_HANDLE
  TY2F_Last_Fld(FLD_PATH_INFO *fld_path)
  {
    FLD_HANDLE f = FLD_HANDLE () ;

    while (fld_path != NULL) {
      f = fld_path->fld;
      fld_path = fld_path->next ;
    }
  
    return f;
  }

  extern FLD_PATH_INFO * 
  TY2F_Point_At_Path(FLD_PATH_INFO * path, STAB_OFFSET off)
  {
    /* given a fld path, return a pointer to */
    /* the slot at the given offset          */
    while (path != NULL) {
      if ((INT64)FLD_ofst(path->fld) >= off)
        break ;    
      path=path->next;
    }
    return path;
  }

  extern void
  TY2F_Dump_Fld_Path(FLD_PATH_INFO *fld_path)
  {
    printf ("path ::");
    while (fld_path != NULL) {
      FLD_HANDLE f = fld_path->fld;
    
      printf ("%s(#%d)",TY2F_Fld_Name(f,FALSE,FALSE),f.Idx ());
    
      if (fld_path->arr_elt)
        printf (" array");
    
      if (fld_path->arr_ofst)
        printf (" offset 0x%x",(mINT32) fld_path->arr_ofst);
    
      if (fld_path->arr_wn != NULL)
        printf (" tree 0x%p",fld_path->arr_wn);
    
      printf (" ::");
      fld_path = fld_path->next ;
    }
    printf ("\n");
  }


  // ***************************************************************************
  //
  // ***************************************************************************


  const char*
  TranslateTYToSymType(TY_IDX ty_idx)
  {
    TY& ty = Ty_Table[ty_idx];
    const char* str = NULL;

    if (TY_kind(ty) == KIND_SCALAR) {
      MTYPE mt = TY_mtype(ty);
      if (TY_is_character(ty)) {
        str = "char"; 
      } 
      else if (TY_is_logical(ty)) {
        str = "bool"; 
      } 
      else if (MTYPE_is_integral(mt)) {
        str = "integer"; 
      } 
      else if (MTYPE_is_complex(mt)) { /* must come before 'float' */
        str = "complex";
      } 
      else if (MTYPE_is_float(mt)) { 
        str = "real"; 
      }
    } 
    else if (TY_kind(ty) == KIND_ARRAY) {
      if (TY_is_character(ty)) { 
        str = "string"; 
      } 
      else {
        // Do not permit pointers as elements of arrays, so just use
        // the corresponding integral type instead.  We do not expect
        // such pointers to be dereferenced anywhere. (FIXME)
        TY_IDX ety_idx = TY_AR_etype(ty);
        if (TY_Is_Pointer(ety_idx)) {
          ety_idx = Stab_Mtype_To_Ty(TY_mtype(ety_idx));
        } 
        str = TranslateTYToSymType(ety_idx);
      }
    } 
    else if (TY_kind(ty) == KIND_STRUCT 
             || 
             TY_kind(ty) == KIND_INVALID) {
      // the latter applies to symbols that are f90 interface names
      str = "opaque";
    }  
    else if (TY_kind(ty) == KIND_FUNCTION) {
      str = "void";
    } 
    else if (TY_kind(ty) == KIND_POINTER) { 
      str = "opaque";
      if (TY_kind(TY_pointed(ty)) == KIND_FUNCTION) {
        str = "void";
      }
    } 
    else 
      FORTTK_DIE("whirl2xaif::TranslateTYToSymType: no logic to handle type of kind " << TY_kind(ty));
    return str;
  }

  const char*
  TranslateTYToMType(TY_IDX ty_idx) {
    TY& ty_r = Ty_Table[ty_idx];
    if (TY_kind(ty_r) == KIND_SCALAR) {
      return Mtype_Name(TY_mtype(ty_r));
    } 
    else if (TY_kind(ty_r) == KIND_ARRAY) {
      if (TY_is_character(ty_r)) { 
        return Mtype_Name(TY_mtype(ty_r));
      } 
      else {
        // Do not permit pointers as elements of arrays, so just use
        // the corresponding integral type instead.  We do not expect
        // such pointers to be dereferenced anywhere. (FIXME)
        TY_IDX ety_idx = TY_AR_etype(ty_r);
        if (TY_Is_Pointer(ety_idx)) {
          ety_idx = Stab_Mtype_To_Ty(TY_mtype(ety_idx));
        } 
        return TranslateTYToMType(ety_idx);
      }
    } 
    else if (TY_kind(ty_r) == KIND_STRUCT 
             || 
             TY_kind(ty_r) == KIND_INVALID
             ||
             TY_kind(ty_r) == KIND_FUNCTION) { 
      return Mtype_Name(TY_mtype(ty_r));
    } 
    else if (TY_kind(ty_r) == KIND_POINTER) { 
      return TranslateTYToMType(TY_pointed(ty_r));
    } 
    else 
      FORTTK_DIE("whirl2xaif::TranslateTYToMType: no logic to handle type of kind " << TY_kind(ty_r));
    return "";
  }

  const char*
  TranslateTYToSymShape(TY_IDX ty_idx)
  {
    TY& ty = Ty_Table[ty_idx];
    const char* str = NULL;
  
    if (TY_kind(ty) == KIND_SCALAR) {
      str = "scalar";
    } 
    else if (TY_kind(ty) == KIND_ARRAY) {
    
      ARB_HANDLE arb_base = TY_arb(ty);
      INT32 dim = ARB_dimension(arb_base);
      // ARB_co_dimension(arb_base) <= 0 FIXME

      if (TY_is_character(ty)) { 
        str = "scalar"; 
      } 
      else {
        switch (dim) {
        case 1:  str = "vector"; break;
        case 2:  str = "matrix"; break;
        case 3:  str = "three_tensor"; break;
        case 4:  str = "four_tensor"; break;
        case 5:  str = "five_tensor"; break;
        case 6:  str = "six_tensor"; break;
        case 7:  str = "seven_tensor"; break;
        default: 
          FORTTK_DIE("Invalid array dimension: " << dim);
        }
      }

    } 
    else if (TY_kind(ty) == KIND_STRUCT
             || 
             TY_kind(ty) == KIND_INVALID) {
      // the latter applies to symbols that are f90 interface names
      str = "scalar"; // FIXME
    }  
    else if ((TY_kind(ty) == KIND_POINTER) &&
             (TY_kind(TY_pointed(ty)) == KIND_FUNCTION)) {
      str = "void";
    }
  
    return str;
  }

}