/*
 * Utilities for converting data types between Fortran and C/C++, in
 * particular bool and string.
 *
 * Author:  DTJ  5/ 1/92
 * Author:  X-Midas 4.6.1 fcinterface.h,v 1.32 2008/09/17 15:34:07 bcopley
 * Major Update 2020-06-26 - contributed by Duy Huang for GFC support
 *
 */
#ifndef _fcinterface_h
#define _fcinterface_h

#ifdef __cplusplus
#  include <ostream>
#  include <algorithm>
#  include <string>
#  include <cstring>
#  include <stdexcept>
#else
#  include <string.h>
#endif


/* Length of a Fortran string as passed from Fortran code (64-bit support).
   This matches XM456's typedef of fstring_len_t in fcinterface.h

   The implicit length argument for FORTRAN strings is passed as different
   sizes on different architectures and compilers.  We assume by default
   that an architecture will pass string lengths as a size_t; but some
   architectures pass string lengths as 32-bit integers.  The resulting
   typedef is used in the C++-FORTRAN translation jackets.
*/
#ifdef __cplusplus
namespace midas {
#endif

#if defined(_PGF77) || defined(_OSF) || defined(_PFC) || defined(_GFC)
typedef int fstring_len_t;
#else
typedef size_t fstring_len_t;
#endif

#ifdef __cplusplus
} // namespace midas
#endif


/* Definitions for the conversion types */

#define F2C_FLAG_LOWERCASE  0x0001
#define F2C_FLAG_TRIM       0x0002
#define F2C_FLAG_APPEND_    0x0004

/* Same bit for both */
#define C2F_FLAG_LONGSTRING 0x1000
#define F2C_FLAG_LONGSTRING 0x1000

#define F2C_UNIXFILE	    (F2C_FLAG_LOWERCASE|F2C_FLAG_TRIM|F2C_FLAG_LONGSTRING)
#define F2C_CASEFILE	    (F2C_FLAG_TRIM|F2C_FLAG_LONGSTRING)
#define F2C_TRIM	    F2C_FLAG_TRIM
#define F2C_SUBROUTINE      (F2C_FLAG_LOWERCASE|F2C_FLAG_TRIM|F2C_FLAG_APPEND_)

#define F2C_LITERAL	    0x0000

#define C2F_FLAG_UPPERCASE 0x0001
#define C2F_FLAG_FILL      0x0002
#define C2F_FLAG_FCONST    0x0004

#define C2F_FILL	   (C2F_FLAG_FILL|C2F_FLAG_FCONST)
#define C2F_CLEAN	   (C2F_FLAG_FILL|C2F_FLAG_UPPERCASE)

/* flags for addnullterminator() */
#define FLAG_NONE             0x00
#define FLAG_IGNORE_ZERO_POS  0x01

#ifdef __cplusplus
extern "C" {
#endif

/* function prototypes to convert Fortran to C or C++ strings */
char *strf2c(const char *fstr, int flen, char *cstr, int clen, int flags);
char *strc2f(const char *cstr, int clen, char *fstr, int flen, int flags);
char *addnullterminator(char* str, int maxlen, int pos, int flags);

#ifdef __cplusplus
} /* extern "C" */

/* =====================================================================
//   C++ <-> FORTRAN string interface

//  Convert a string in FORTRAN CHARACTER*n representation (passed as a
//  pointer to characters followed by a length) into a C++ string */
inline std::string strf2cpp (const char* fstr, std::string::size_type fcapacity)
{
  int ii = int(fcapacity - 1);
  while (ii >= 0 && fstr[ii] <= ' ')
    ii--;
  return std::string(fstr, ii + 1);
}

/*  Convert a string from C++ std::string representation into a FORTRAN
//  CHARACTER*n representation */
inline char *strcpp2f (const std::string& cppstr, char *fstr, int flen,
                       int flags = C2F_FILL)
{
  return strc2f(cppstr.c_str(), int(cppstr.length()), fstr, flen, flags);
}

/* A class to allow FORTRAN strings as in/out parameters.  It will
// either wrap a std::string& or can be constructed from an fstring<>
// defined below.  This allows FORTRAN strings in structures to be
// passed all places where an output std::string is required. */
class fstring_buf {
  public:
    /* We expose these two members as public as this class will likely
      only be declared in generated jacket code */
    std::string::size_type nchar;
    char* buf;

    /* The following constructor is used by fstring<>'s
    // to outcast to fstring_buf. */
    fstring_buf (char* cbuf, int bufsize, int conv_flags = C2F_FILL) :
      nchar(adjust_bufsize(bufsize)),
      buf(cbuf),
      convFlags_(conv_flags),
      str_(0)
    { }

    /* The following constructor will take a std::string& and
    // create an fstring buffer equivalent for the underlying
    // wrapper. */
    fstring_buf (std::string& s, int bufsize = 0, int conv_flags = C2F_FILL) :
      nchar(adjust_bufsize(bufsize)),
      buf(0),
      convFlags_(conv_flags),
      str_(&s)
    { if (bufsize) allocate(bufsize); }

    ~fstring_buf ()
    { flush(); }

    std::string str () const;

    inline fstring_buf& assign (const char* s)
    { strc2f(s, int(std::strlen(s)), buf, int(nchar), convFlags_); return *this; }

    fstring_buf& operator= (const std::string& fromStr)
    {
      if (!buf) allocate(fromStr.size());
      strc2f(fromStr.c_str(), int(fromStr.size()), buf, int(nchar), convFlags_);
      return *this;
    }

    fstring_buf& operator= (const char* c_str)
    {
      int slen = int(std::strlen(c_str));
      if (!buf) allocate(slen);
      strc2f(c_str, slen, buf, int(nchar), convFlags_);
      return *this;
    }

    fstring_buf& operator= (char c)
    {
      if (!buf) allocate(1);
      strc2f(&c, 1, buf, int(nchar), convFlags_);
      return *this;
    }

    /* When wrapping a std::string&, provide a max buf-length if one
    // was not provided.  If this is NOT called buf will be NULL. */
    void allocate (std::string::size_type bufsize)
    {
      if (str_ && !buf) {
        buf = new char[nchar = bufsize];
	/* No need to concern ourselves with convFlags_
	// and the possibility of a longstring here;
	// that is only possible if 'buf' is nonzero. */
	std::fill(buf, buf + nchar, ' ');
        strcpp2f(*str_, buf, int(nchar));
      }
    }

    /* When wrapping a std::string&, provide a method to flush the
    // contents of the buffer (typically written into by a FORTRAN
    // routine) back out to the wrapped std::string.  This method is
    // also called in the destructor if it hasn't yet been called. */
    void flush ()
    {
      if (str_ && buf) {
        *str_ = str();
        delete[] buf;
        buf = 0;
      }
    }

  private:
    int convFlags_;
    std::string::size_type adjust_bufsize(int bufsize);
    std::string* str_;
}; // end class fstring_buf

/*  A variant of the fstring_buf which is used for strings copied out from
//  a function but not into a function (i.e. out-only string parameters) */
class fstring_out_buf : public fstring_buf
{
  public:
    fstring_out_buf(char* cbuf, std::string::size_type bufsize,
                    int conv_flags = C2F_FLAG_FILL) :
      fstring_buf(cbuf, int(bufsize), conv_flags)
    { }

    fstring_out_buf(std::string& s, std::string::size_type bufsize = 0) :
      fstring_buf(s, int(bufsize))
    { }

    fstring_out_buf& operator= (const std::string& fromStr)
    {
      fstring_buf::operator=(fromStr);
      return *this;
    }

    fstring_out_buf& operator= (const char* c_str)
    {
      fstring_buf::operator=(c_str);
      return *this;
    }

    fstring_out_buf& operator= (char c)
    {
      fstring_buf::operator=(c);
      return *this;
    }
}; // end class fstring_out_buf

/* A class to wrap a raw char buffer with methods so that it behaves
// like a FORTRAN string.  Note that the size of this class is the
// size of the char buffer it contains and can thus take the place of
// a raw char buffer in a struct without adding any overhead.  This is
// how the X-Midas libraries share char buffers in structures between
// FORTRAN and C++.
//
// FORTRAN: character*80 name
//       C: char name[80];
//     C++: fstring<80> name;
//
// Note: according to the standard (sec 10.4.12) a class with a
// constructor, destructor or copy operation cannot be the type of a
// union member.  We purposely do NOT define those member functions
// for this class so that it CAN be part of a union or part of a
// structure that is part of a union. */
template <std::string::size_type nchar> struct fstring {

  char buf[nchar];

  /* ///// Methods */

  inline std::string substr (std::string::size_type start = 0,
                        std::string::size_type len = std::string::npos) const
  { return str().substr(start, len); }

  inline std::string str () const { return std::string(buf, length()); }
  inline const char* data () const { return buf; }

  inline std::string::size_type length () const
  { int i = nchar - 1; while (i >= 0 && buf[i] <= ' ') --i; return i + 1; }

  inline bool empty () const
  { std::string::size_type i = 0; while (i < nchar && buf[i] <= ' ') ++i; return i == nchar; }

  inline std::string::size_type capacity () const { return nchar; }
  inline std::string::size_type max_size () const { return nchar; }

  inline void clear () { std::memset(buf, ' ', nchar); }

  inline fstring<nchar>& erase (std::string::size_type pos = 0,
                                std::string::size_type num_chars = std::string::npos)
  {
    if (num_chars < nchar) {
      std::string s(str());
      *this = s.erase(pos, num_chars);
    } else if (pos < nchar) {
      std::memset(buf + pos, ' ', nchar - pos);
    }
    return *this;
  }

  inline fstring<nchar>& insert (std::string::size_type pos, const char* s)
  { std::string temp = str(); return (*this = temp.insert(pos, s)); }

  inline fstring<nchar>& insert (std::string::size_type pos, const std::string& s)
  { std::string temp = str(); return (*this = temp.insert(pos, s)); }

  /* ///// For the STL */

  inline std::string::size_type size () const { return length(); }

  inline char* begin () { return buf; }
  inline char* end () { return buf + size(); }

  inline const char* begin () const { return buf; }
  inline const char* end () const { return buf + size(); }


  /* ///// Operators */

  inline bool operator== (const char* s) const
  { std::string::size_type len = std::strlen(s);
    return len == length() && !std::strncmp(buf, s, len); }

  inline bool operator== (const std::string& s) const
  { return s.length() == length() && !std::strncmp(buf, s.c_str(), s.length()); }

  inline bool operator== (const fstring<nchar>& fstr) const
  { std::string::size_type len = length();
    return len == fstr.length() && !std::strncmp(buf, fstr.buf, len); }

  inline bool operator!= (const char* s) const
  { return !(*this == s); }

  inline bool operator!= (const std::string& s) const
  { return !(*this == s); }

  inline bool operator!= (const fstring<nchar>& fstr) const
  { return !(*this == fstr); }

  inline fstring& operator= (char c)
  { strc2f(&c, 1, buf, nchar, C2F_FLAG_FILL); return *this; }

  inline fstring& operator= (const char* s)
  { strc2f(s, std::strlen(s), buf, nchar, C2F_FLAG_FILL); return *this;  }

  inline fstring& operator= (const std::string& s)
  { strc2f(s.c_str(), s.length(), buf, nchar, C2F_FLAG_FILL); return *this;}

  inline fstring& assign (const char* s)
  { strc2f(s, std::strlen(s), buf, nchar, C2F_FLAG_FILL); return *this; }

  inline fstring& operator+= (const char* c2)
  { return *this = str() + c2; }

  inline fstring& operator+= (const std::string& s)
  { return *this = str() + s; }

  inline operator std::string () const
  { return str(); }

  inline operator fstring_buf ()
  { return fstring_buf(buf, nchar); }

  inline operator fstring_out_buf ()
  { return fstring_out_buf(buf, nchar); }

  inline char operator[] (int subscript) const
  { return buf[subscript]; }

  inline char& operator[] (int subscript)
  { return buf[subscript]; }
}; // end template <std::string::size_type nchar> struct fstring

template <std::string::size_type nchar>
inline std::ostream& operator<< (std::ostream& out, const fstring<nchar>& fin)
{ out << fin.str(); return out; }

template <std::string::size_type nchar>
inline std::string operator+ (const fstring<nchar>& s1, const std::string& s2)
{ return s1.str() + s2; }

template <std::string::size_type nchar>
inline std::string operator+ (const std::string& s1, const fstring<nchar>& s2)
{ return s1 + s2.str(); }

/****************************************************************************/
#if _SOL

template <std::string::size_type nchar> struct fstringu {

  char buf[nchar];

  /* ///// Methods */

  inline fstringu& assign (const char* s)
  { strc2f(s, std::strlen(s), buf, nchar, C2F_FLAG_FILL); return *this; }

  inline std::string substr (std::string::size_type start = 0,
                        std::string::size_type len = std::string::npos) const
  { return str().substr(start, len); }

  inline std::string str () const { return std::string(buf, length()); }
  inline const char* data () const { return buf; }

  inline std::string::size_type length () const
  { int i = nchar; while (--i >= 0 && buf[i] <= ' '); return i + 1; }

  inline bool empty () const
  { std::string::size_type i = 0; while (i < nchar && buf[i] <= ' ') ++i; return i == nchar; }

  inline std::string::size_type capacity () const { return nchar; }
  inline std::string::size_type max_size () const { return nchar; }

  inline void clear () { std::memset(buf, ' ', nchar); }

  inline fstringu<nchar>& erase (std::string::size_type pos = 0,
                                std::string::size_type num_chars = std::string::npos)
  {
    if (num_chars < nchar) {
      std::string s(str());
      *this = s.erase(pos, num_chars);
    } else if (pos < nchar) {
      std::memset(buf + pos, ' ', nchar - pos);
    }
    return *this;
  }

  inline fstringu<nchar>& insert (std::string::size_type pos, const char* s)
  { std::string temp = str(); return (*this = temp.insert(pos, s)); }

  inline fstringu<nchar>& insert (std::string::size_type pos, const std::string& s)
  { std::string temp = str(); return (*this = temp.insert(pos, s)); }

  /* ///// For the STL */

  inline std::string::size_type size () const { return length(); }

  inline char* begin () { return buf; }
  inline char* end () { return buf + size(); }

  inline const char* begin () const { return buf; }
  inline const char* end () const { return buf + size(); }


  /* ///// Operators */

  inline bool operator== (const char* s) const
  { std::string::size_type len = std::strlen(s);
    return len == length() && !std::strncmp(buf, s, len); }

  inline bool operator== (const std::string& s) const
  { return s.length() == length() && !std::strncmp(buf, s.c_str(), s.length()); }

  inline bool operator== (const fstringu<nchar>& fstr) const
  { std::string::size_type len = length();
    return len == fstr.length() && !std::strncmp(buf, fstr.buf, len); }

  inline bool operator!= (const char* s) const
  { return !(*this == s); }

  inline bool operator!= (const std::string& s) const
  { return !(*this == s); }

  inline bool operator!= (const fstringu<nchar>& fstr) const
  { return !(*this == fstr); }

  inline fstringu& operator+= (const char* c2)
  { return *this = str() + c2; }

  inline fstringu& operator+= (const std::string& s)
  { return *this = str() + s; }

  inline operator std::string () const
  { return str(); }

  inline operator fstring_buf ()
  { return fstring_buf(buf, nchar); }

  inline const char& operator[] (int subscript) const
  { return buf[subscript]; }

  inline char& operator[] (int subscript)
  { return buf[subscript]; }
}; // end template <std::string::size_type nchar> struct fstringu

template <std::string::size_type nchar>
inline std::ostream& operator<< (std::ostream& out, const fstringu<nchar>& fin)
{ out << fin.str(); return out; }

template <std::string::size_type nchar>
inline std::string operator+ (const fstringu<nchar>& s1, const std::string& s2)
{ return s1.str() + s2; }

template <std::string::size_type nchar>
inline std::string operator+ (const std::string& s1, const fstringu<nchar>& s2)
{ return s1 + s2.str(); }

#endif /* _SOL */

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

#define FSTRING(NAME, LEN) fstring<LEN> NAME
#define FSTRING_ARRAY(NAME, LEN, ELEMS) fstring<LEN> NAME[ELEMS]

/********************/
#if _SOL

#define FSTRINGU(NAME, LEN) fstringu<LEN> NAME
#define FSTRINGU_ARRAY(NAME, LEN, ELEMS) fstringu<LEN> NAME[ELEMS]

#else

#define FSTRINGU(NAME, LEN) fstring<LEN> NAME
#define FSTRINGU_ARRAY(NAME, LEN, ELEMS) fstring<LEN> NAME[ELEMS]

#endif
/********************/

#else

#define FSTRING(NAME, LEN) char NAME[LEN]
#define FSTRING_ARRAY(NAME, LEN, ELEMS) char NAME[ELEMS][LEN]

#define FSTRINGU(NAME, LEN) char NAME[LEN]
#define FSTRINGU_ARRAY(NAME, LEN, ELEMS) char NAME[ELEMS][LEN]

#endif /* __cplusplus */

#ifdef __cplusplus

/* =====================================================================
//   C++ <-> FORTRAN boolean interface

//  X-Midas has boolean values shared between C/C++ and FORTRAN, both
//  as structure / record elements in shared memory and as parameters
//  and return values at function interfaces.  This means that C/C++
//  must be able to deal with the internal representation of the FORTRAN
//  .true. and .false. values.  C programmers must be able to handle the
//  FORTRAN representation by convention, while C++ programmers can use
//  the classes below to translate between different representations of
//  truth and falsehood at the interlanguage interface.

//  Between the C++ and FORTRAN languages, the number of bytes used to
//  represent a boolean, the representation of "true" values and the
//  method of testing for truth all differ:
//  - FORTRAN LOGICAL variables are specified in their declarations to
//    take up a certain number of bytes.  In C++, bool variables take up
//    a compiler-defined number of bytes (usually 1).
//  - FORTRAN sets all bits of the variable to one or zero when assigning
//    .true. or .false.  respectively.  The internal represenation of true
//    and false is compiler-defined in C++, but is generally 1 and 0
//    respectively for ease of implementation.
//  - When testing a variable for true or falsehood, FORTRAN checks only
//    the value of the least signficant bit, which if 1 is considered
//    .true. and if 0 is considered .false.; C++ (and C) considers the
//    entire variable, where a value of zero is false and any nonzero value
//    is true.
//  - When complementing a boolean value, FORTRAN (via .not.) complements
//    all bits of the internal representation of a LOGICAL value, while the
//    C and C++ '!' operator performs a logical negation (nonzero values
//    become zero, and a zero becomes some nonzero value).

//  The Promula FORTRAN-to-C compiler does not follow the normal FORTRAN
//  conventions for logical values; as such, the conversion routines are
//  no-ops.

//  C programmers using X-Midas must keep these conventions in mind when
//  accessing boolean variables kept in FORTRAN LOGICAL representation.
//  C++ programmers are given the logical<> class template for accessing
//  variables in shared memory, and the jacket functions generated for
//  calls between C++ and FORTRAN will use helper classes to convert
//  values between representations. */


/*  Value translation helper functions */

/*  Convert a C++ bool value into a FORTRAN LOGICAL value.  The template
//  parameter is the underlying C++ type which corresponds to the FORTRAN
//  type we convert to (e.g. LOGICAL*4's corresponding C++ type is a
//  4-byte unsigned int, int_u4 for X-Midas). */
template <class T> inline T
cppb2fl(bool boolean_value)
{
#if _PFC|_GFC
    return static_cast<T>(boolean_value);
#else
    T retval = 0;
    if (boolean_value)
        retval = ~retval;
    return retval;
#endif
}

/*  Convert a FORTRAN LOGICAL*n value to a C++ bool value.  The template
//  parameter is the underlying C++ type which corresponds to the FORTRAN
//  type from which we convert  */
template <class T> inline bool
fl2cppb(T boolean_value)
{
#if _PFC|_GFC
    return static_cast<bool>(boolean_value);
#else
    return ((boolean_value & 0x1) == 1);
#endif
}

/*  Helper class template to convert OUT arguments from C++ types which
//  parallel the FORTRAN logical*4 data types to the latter, including
//  conversion of representations of true and false between C++ and
//  FORTRAN's .true. and .false. in "both directions".  The template
//  parameter is the C++ type which corresponds to the FORTRAN LOGICAL*n
//  data type to which we are translating.

//  out_bool is created with a C++ bool reference, takes that reference's
//  value and translates it into a FORTRAN value, passing a reference to
//  the new value to the function.  When the function returns and the
//  out_bool is destroyed, it copies that FORTRAN-represented value (which
//  the function stored as its out-parameter back) to the original C++
//  bool type.
//  out_bool can be created with references to regular bool variables as
//  well as integer or bool_n variables.  */
template <typename T>
class out_bool
{
    enum out_type { BOOL_TYPE, BOOLn_TYPE, INT_TYPE };
  public:
    explicit out_bool(bool& bool_var);
    explicit out_bool(T& bool_var);
    explicit out_bool(int& bool_var);
    ~out_bool()
      { if (copy_back_flag)         /* If we gave away a reference to */
            this -> do_copy_back(); /*  our inner bool_4, copy it back out */
      }
    T& ref()
      { copy_back_flag = true; return value; }
  private:
    void do_copy_back();
    bool copy_back_flag;
    T value;
    out_type out_type_tag;
    void* const out_ref;
};

/*  out_bool constructors
//    These functions clear the copy_back_flag variable (which will be set
//  if this instance hands out a reference), converts the value in the passed
//  reference to FORTRAN representation and stores it, and sets up the type
//  tag and pointer to the variable referenced (these last determine how and
//  where the OUT value will be stored upon function exit and instance
//  destruction).  */

/*  Construct an out_bool from a regular boolean reference */
template <typename T>
out_bool<T>::out_bool(bool& bool_var)
    : copy_back_flag(false), value(cppb2fl<T>(bool_var)),
      out_type_tag(BOOL_TYPE), out_ref(&bool_var)
{ }

/*  Construct an out_bool from a bool_4 reference */
template <typename T>
out_bool<T>::out_bool(T& bool_var)
    : copy_back_flag(false), value(cppb2fl<T>(bool_var)),
      out_type_tag(BOOLn_TYPE), out_ref(&bool_var)
{ }

/*  Construct an out_bool from a int reference  */
template <typename T>
out_bool<T>::out_bool(int& bool_var)
    : copy_back_flag(false), value(cppb2fl<T>(bool_var)),
      out_type_tag(INT_TYPE), out_ref(&bool_var)
{ }

/*  Called if the instance has handed out a reference to its internal
//  variable (which was passed to a FORTRAN-language routine).  Converts
//  the value stored in our 'value' field (in FORTRAN representation) into
//  the C++ representation of the same boolean state, then writes that
//  representation back to the variable passed by reference when the
//  instance was constructed.  Voila - pass-by-value-result with
//  representation translation! */
template <typename T> void
out_bool<T>::do_copy_back()
{
    bool val = fl2cppb(value); /*  Translate value to be copied */
    switch (out_type_tag)      /*  Decide how to copy based on type tag */
    {
      case BOOL_TYPE:
        *(static_cast<bool*>(out_ref)) = val;
        break;
      case BOOLn_TYPE:
        *(static_cast<T*>(out_ref)) = val;
        break;
      case INT_TYPE:
        *(static_cast<int*>(out_ref)) = val;
        break;
      default:
        throw std::logic_error("Invalid type tag in out_bool::do_copy_back");
    }
}

/*  Helper class template to convert OUT arguments from FORTRAN LOGICAL*n
//  variables to C++ booleans, performing any needed conversions on the
//  values of the differing representations.  The two template parameters
//  are (in order) the C++ type corresponding to the FORTRAN type used in
//  the call, and the C++ type of the function being called.  These will
//  often but not always be teh same type.

//  out_logical is created with a reference to a FORTRAN LOGICAL*n, takes
//  that reference's value and translates it into a C++ bool-like value, and
//  passes a reference to the C++ value to the jacketed function.  When
//  the function returns and the out_logical is destroyed, it copies that
//  C++ value (which the function stored as its out-parameter) back to the
//  original FORTRAN LOGICAL*n type. */
template <typename T>
class out_logical
{
  public:
    explicit out_logical(T& bool_var)
      : copy_back_flag(false), value(fl2cppb(bool_var)), out_ref(bool_var)
      {}
    ~out_logical()
      { if (copy_back_flag)            /*  If we gave away a reference to */
            out_ref = cppb2fl<T>(value); /* our bool_n, copy it back out */
      }
    T& ref()
      { copy_back_flag = true; return value; }
  private:
    bool copy_back_flag;
    T value;
    T& out_ref;
};

#endif /* __cplusplus */

#endif /* _fcinterface_h */
