
/**
 * @file
 * Routines d'entree-sorties rapides en C pour Unix.
 *
 * Ces routines utilisent des fonction d'acces,ecriture
 * lecture... de bas niveau sous unix (meilleures perf ?)
 *    P.Valiron & P.Begou
 * Symplifying code and formatting comments for compliance with Doxygen
 *    E. Reynier
 */

#ifndef BITS64
/* Ensure that the component stat.st_size from include stat.h is large
   enough to measure files larger than 2 GB */
#define _FILE_OFFSET_BITS 64
#endif

#include "sysc.h"

/*****************************************************************************
 *                           Dependencies                                    *
 *****************************************************************************/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <signal.h>
#include <math.h>
#include <fcntl.h>
#include <errno.h>
#include <signal.h>
#include <time.h>
#include <ctype.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <unistd.h>
#include <dirent.h>
#include <locale.h>
#ifndef WIN32
#include <sys/ioctl.h>
#include <sys/times.h>
#include <sys/time.h>
#include <sys/resource.h>
#ifdef __APPLE__
#include <sys/sysctl.h>
#else
#include <sys/sysinfo.h>
#endif
#else /* WIN32 */
#include "win32.h"
#include <sys/time.h>
#endif /* WIN32 */
#if defined(darwin)
#define _DIRENT_HAVE_D_TYPE 1
#endif

#include "gag_trace.h"
#include "gsys-message-c.h"
#include "sic_util.h"

/*****************************************************************************
 *                        Definitions & Macros                               *
 *****************************************************************************/

/* OPEN_MODE macro definition */
#ifdef WIN32
#define OPEN_MODE (_S_IFREG|_S_IREAD|S_IWRITE)
#else /* WIN32 */
#if defined( _S_IFREF)                 /* POSIX conformant definition */
#define OPEN_MODE (_S_IFREG|S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH)
#elif defined( S_IFREF)                /* X_OPEN conformant definition */
#define OPEN_MODE (S_IFREG|S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH)
#else
#define OPEN_MODE (S_IRUSR|S_IWUSR|S_IRGRP|S_IROTH)
#endif
#endif /* WIN32 */

/* O_FLAGS macro definition */
#ifdef WIN32
#define O_FLAGS (O_RDWR|O_CREAT|O_BINARY)
#else /* WIN32 */
#define O_FLAGS (O_RDWR|O_CREAT)
#endif /* WIN32 */

#define GAG_MAX_PATH_LENGTH 1024
#define GAG_MAX_COMMAND_LENGTH 1024


/*****************************************************************************
 *                           Function bodies                                 *
 *****************************************************************************/

/**
 * Create a new file
 *
 * @param[out] fd gives the file descriptor, or -1 on error.
 * @param[in] file is the filename.
 */
void CFC_API gag_filnew( int *fd, CFC_FString file CFC_DECLARE_STRING_LENGTH( file))
{
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, file, CFC_STRING_LENGTH_MIN( file, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filnew \"%s\"", tmp);
    *fd = open( tmp, O_FLAGS | O_TRUNC, OPEN_MODE);
    if (*fd == -1)
        gsys_c_message(seve_e, "CFILE", "Open error on %s", tmp);
}

/**
 * Open a file
 *
 * @param[out] fd gives the file descriptor, or -1 on error.
 * @param[in] file is the filename.
 */
void CFC_API gag_filopen( int *fd, CFC_FString file CFC_DECLARE_STRING_LENGTH( file))
{
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, file, CFC_STRING_LENGTH_MIN( file, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filopen \"%s\"", tmp);
    *fd = open( tmp, O_FLAGS, OPEN_MODE);
    if (*fd == -1)
        gsys_c_message(seve_e, "CFILE", "Open error on %s", tmp);
}

/**
 * Open a file in readonly mode
 *
 * @param[out] fd gives the file descriptor, or -1 on error.
 * @param[in] file is the filename.
 */
void CFC_API gag_fillook( int *fd, CFC_FString file CFC_DECLARE_STRING_LENGTH( file))
{
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, file, CFC_STRING_LENGTH_MIN( file, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_fillook \"%s\"", tmp);
    *fd = open( tmp, O_RDONLY | O_EXCL, OPEN_MODE);
    if (*fd == -1)
        gsys_c_message(seve_e, "CFILE", "Open error on %s", tmp);
}

/**
 * Test file existence.
 *
 * @param[in] file is the filename to test.
 * @return 0 if file exists, -1 otherwise.
 */
int CFC_API gag_filtest( CFC_FString file CFC_DECLARE_STRING_LENGTH( file))
{
    struct stat stbuf;
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, file, CFC_STRING_LENGTH_MIN( file, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filtest \"%s\"", tmp);
    return stat( tmp, &stbuf);
}

/**
 * Close a file.
 *
 * @param[in] fd is the file descriptor.
 */
void CFC_API gag_filclose( int *fd)
{
    gag_trace( "<trace> gag_filclose");
    close( *fd);
}

/**
 * Read a string in the file.
 *
 * @param[in] fd is the file descriptor.
 * @param[out] buf is the buffer to store the string.
 * @param[out] len is the size of the buffer.
 * @return the number of bytes written, or -1 on error.
 */
int CFC_API gag_filread( int *fd, CFC_FString buf, int *len)
{
    return read( *fd, CFC_f2c_string( buf), *len);
}

/**
 * Write a string in the file.
 *
 * @param[in] fd is the file descriptor.
 * @param[in] buf is the string to write.
 * @param[in] len is the length of the string in @e buf.
 * @return the number of bytes written, or -1 on error.
 */
int CFC_API gag_filwrite( int *fd, CFC_FString buf, int *len)
{
    return write( *fd, CFC_f2c_string( buf), *len);
}

/**
 * Reposition the file descriptor offset.
 *
 * @param[in] fd is the file descriptor.
 * @param[in] offset is the offset in bytes.
 * @return the current resulting offset in bytes, or -1 on error.
 */
int CFC_API gag_filseek( int *fd, int *offset)
{
    return lseek( *fd, *offset, SEEK_SET);
}

/**
 * Terminate process.
 * Its sends a SIGINT signal and exits with 1.
 */
void CFC_API gag_crash( )
{
    gag_trace( "<trace> gag_crash");
#ifdef WIN32
    raise( SIGINT);
#else
    kill( getppid( ), SIGINT);
#endif
    exit( 1);                           /* Make it non 0 */
}

/**
 * Get process id
 *
 * @return the process ID
 */
int32_t CFC_API gag_getpid()
{
  return (int32_t) getpid();
}

/**
 * Turn ON/OFF the debug message printed by gag_system
 *
 * @param[in] sw switch 0=OFF, 1=ON
 */
static int debug_system = 0;
void CFC_API gag_debug_system(int *sw)
{
  debug_system = *sw;
}

/**
 * Execute a system command
 *
 * @param[in] string command to be exectuted (Fortran string)
 */
int CFC_API gag_system( CFC_FString string CFC_DECLARE_STRING_LENGTH( string))
{
    int ret;
    char tmp[GAG_MAX_COMMAND_LENGTH];

    CFC_f2c_strcpy( tmp, string, CFC_STRING_LENGTH_MIN( string, GAG_MAX_COMMAND_LENGTH));
    gag_trace( "<trace> gag_system \"%s\"", tmp);
    if (debug_system)
      gsys_c_message(seve_i, "SYSTEM", "Executing command: %s", tmp);
    ret = system( tmp);
    if (ret == -1)
        perror( "system");
    return ret;
}

/**
 * Return the text corresponding to an error message
 *
 */
void CFC_API gag_errno(int *error, CFC_FString string CFC_DECLARE_STRING_LENGTH( string))
{
    char *env;

    env = strerror(*error) ;
    gag_trace( "<trace> gag_error \"%s\"", env);
    CFC_c2f_strcpy( string, CFC_STRING_LENGTH( string), env) ;
}

/**
 * Suppress a file
 *
 * @param[in] file is the filename.
 */
void CFC_API gag_filrm( CFC_FString file CFC_DECLARE_STRING_LENGTH( file))
{
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, file, CFC_STRING_LENGTH_MIN( file, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filrm \"%s\"", tmp);
    if (unlink( tmp) == -1)
        gsys_c_message(seve_e, "CFILE", "File %s not found", tmp);
}

/**
 * Copy a file to another one
 *
 * @param[in] fromfile is the source file.
 * @param[in] tofile is the destination file.
 * @return 0 if success.
 */
int CFC_API gag_filcopy( CFC_FString fromfile, CFC_FString tofile
                         CFC_DECLARE_STRING_LENGTH( fromfile)
                         CFC_DECLARE_STRING_LENGTH( tofile))
{
    char tmp1[GAG_MAX_PATH_LENGTH];
    char tmp2[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp1, fromfile, CFC_STRING_LENGTH_MIN( fromfile, GAG_MAX_PATH_LENGTH));
    CFC_f2c_strcpy( tmp2, tofile, CFC_STRING_LENGTH_MIN( tofile, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filcopy \"%s\" \"%s\"", tmp1, tmp2);

    return filcopy_or_filappend(tmp1,tmp2,"wb");

}


/**
 * Short utility checking if 2 files are the same or not. Per the
 * <sys/stat.h> specification:
 * "The st_ino and st_dev fields taken together uniquely identify the
 * file within the system."
 *
 * Note that if any of the 2 files is inexistant, result is false. This
 * is a desired feature.
 * In case of symlink, evaluation is made on the target.
 * By definition, hard links share the same inode.
 *
 * @return 1 if files are identical, 0 if not.
 */
int same_file(char *file1, char *file2) {
    struct stat stat1, stat2;
    if (stat(file1, &stat1) < 0) return 0;
    if (stat(file2, &stat2) < 0) return 0;
    if ((stat1.st_dev == stat2.st_dev) && (stat1.st_ino == stat2.st_ino)) {
       return 1;
    } else {
       return 0;
    }
}


/**
 * Check if 2 files are the same or not.
 * See function 'same_file' for details.
 *
 * @param[in] file1 is the first file to be compared
 * @param[in] file2 is the second file to be compared
 * @return 1 if files are identical, 0 if not.
 */
int CFC_API gag_filsame_c( CFC_FString file1, CFC_FString file2
                           CFC_DECLARE_STRING_LENGTH( file1)
                           CFC_DECLARE_STRING_LENGTH( file2))
{
    char tmp1[GAG_MAX_PATH_LENGTH];
    char tmp2[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp1, file1, CFC_STRING_LENGTH_MIN( file1, GAG_MAX_PATH_LENGTH));
    CFC_f2c_strcpy( tmp2, file2, CFC_STRING_LENGTH_MIN( file2, GAG_MAX_PATH_LENGTH));

    return same_file(tmp1,tmp2);
}


/**
 * Copy or append a file to another one. Do not call directly. Use
 * overlays gag_filcopy or gag_filappend instead.
 *
 * @param[in] tmp1 is the source file.
 * @param[in] tmp2 is the destination file.
 * @param[in] myflag is the copy (O_TRUNC) or append (O_APPEND) system flag.
 * @return 0 if success.
 */
int filcopy_or_filappend(char *tmp1,char *tmp2, const char *myflag)
{
    FILE *ffd;
    FILE *tfd;
    size_t count;
    static char buf[16*1024*1024]; /* 16MB */

    if (same_file(tmp1,tmp2)>0) {
        gsys_c_message(seve_e, "CFILE", "%s and %s are identical files", tmp1, tmp2);
        return 1;
    }

    if ((ffd = fopen( tmp1, "rb")) == NULL) {
        gsys_c_message(seve_e, "CFILE", "Open error on %s", tmp1);
        return 1;
    }
    if ((tfd = fopen( tmp2, myflag)) == NULL) {
        gsys_c_message(seve_e, "CFILE", "Open error on %s", tmp2);
        return 1;
    }
    while ((count = fread(buf, 1, sizeof(buf), ffd)) > 0)
        fwrite(buf, 1, count, tfd);
    fclose( tfd);
    fclose( ffd);
    return 0;
}

/**
 * Move a file using shell mv command. Typical uses are:
 * - rename a file or directory (possibly moving it to another directory)
 * - move a file or directory to another directory.
 * Shell patterns can NOT be used here because of double-quotes protection.
 * Beware this function uses system() call, i.e. needs to fork the
 * current process thus temporarily doubling the memory consumption.
 *
 * See also gag_filrename which does not have this limitation.
 *
 * @param[in] fromfile is the initial name.
 * @param[in] tofile is the final name.
 */
int CFC_API gag_filmove( CFC_FString fromfile, CFC_FString tofile
                         CFC_DECLARE_STRING_LENGTH( fromfile)
                         CFC_DECLARE_STRING_LENGTH( tofile))
{
    char string[GAG_MAX_COMMAND_LENGTH];
    char tmp1[GAG_MAX_PATH_LENGTH];
    char tmp2[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp1, fromfile, CFC_STRING_LENGTH_MIN( fromfile, GAG_MAX_PATH_LENGTH));
    CFC_f2c_strcpy( tmp2, tofile, CFC_STRING_LENGTH_MIN( tofile, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filmove \"%s\" \"%s\"", tmp1, tmp2);

    /* The code below DOES work if there is a path name in the filenames, */
    /* but does not support moving a file to a directory */
    /* return rename( fromfile,tofile); */
    /* Use stupid method instead */
#ifdef WIN32
    sprintf( string, "move \"%s\" \"%s\"", tmp1, tmp2);
#else
    sprintf( string, "mv \"%s\" \"%s\"", tmp1, tmp2);
#endif
    if (debug_system)
      gsys_c_message(seve_i, "SYSTEM", "Executing command: %s", string);
    return system( string);
}

/**
 * Rename a file or a directory, possibly moving to another directory,
 * e.g.
 *   oldname        -> newname         !
 *   olddir/oldname -> newdir/newname  ! newdir must exit
 * If target already exists, it is "atomically replaced" (basically:
 * overwritten). If renaming a directory to an already existing target
 * directory, the target must be empty.
 *
 * Pure moves are NOT accepted
 *   olddir/oldname -> newdir
 * This is interpreted as a request to rename oldname as newdir. Use
 * instead:
 *   olddir/oldname -> newdir/oldname
 * This could be implemented within this subroutine though...
 *
 * See also gag_filmove
 *
 * @param[in] fromfile is the initial name.
 * @param[in] tofile is the final name.
 */
int CFC_API gag_filrename( CFC_FString fromfile, CFC_FString tofile
                           CFC_DECLARE_STRING_LENGTH( fromfile)
                           CFC_DECLARE_STRING_LENGTH( tofile))
{
    char tmp1[GAG_MAX_PATH_LENGTH];
    char tmp2[GAG_MAX_PATH_LENGTH];
    int ier;

    CFC_f2c_strcpy( tmp1, fromfile, CFC_STRING_LENGTH_MIN( fromfile, GAG_MAX_PATH_LENGTH));
    CFC_f2c_strcpy( tmp2, tofile, CFC_STRING_LENGTH_MIN( tofile, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filrename \"%s\" \"%s\"", tmp1, tmp2);

#ifdef WIN32
    /* POSIX.1-2001 says rename() should overwrite the target name if it already
     * exists. MINGW does not seem to respect this feature. */
    struct stat filestat;
    if ( stat(tmp2, &filestat) == 0)  { unlink(tmp2); }
#endif

    ier = rename(tmp1,tmp2);

    if (ier != 0) {
      gsys_c_message(seve_e, "RENAME", "Could not rename %s to %s: %s", tmp1,tmp2,strerror(errno));
    }

    return ier;
}

/**
 * Append a file to another one
 *
 * @param[in] fromfile is the source file.
 * @param[in] tofile is the destination file.
 */
int CFC_API gag_filappend( CFC_FString fromfile, CFC_FString tofile
                           CFC_DECLARE_STRING_LENGTH( fromfile)
                           CFC_DECLARE_STRING_LENGTH( tofile))
{
    char tmp1[GAG_MAX_PATH_LENGTH];
    char tmp2[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp1, fromfile, CFC_STRING_LENGTH_MIN( fromfile, GAG_MAX_PATH_LENGTH));
    CFC_f2c_strcpy( tmp2, tofile, CFC_STRING_LENGTH_MIN( tofile, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_filappend \"%s\" \"%s\"", tmp1, tmp2);

    return filcopy_or_filappend(tmp1,tmp2,"ab");
}

/**
 * Return the number of standard files in a directory. In order to remain
 * fast it counts everything, including subdirectories, symbolic links,
 * '.' and '..'.
 * You can use the Fortran overlay 'gag_directory_num' to translate Sic
 * logicals in the directory name.
 *
 * @param[in] dirname is the directory name,
 * @param[out] count the number of files found.
 */
int CFC_API gag_directory_num_c( CFC_FString dirname, int *count
                                 CFC_DECLARE_STRING_LENGTH( dirname))
{
  DIR *dir;
  struct dirent *entry;
  int ier;
  char tmp[GAG_MAX_PATH_LENGTH];

  CFC_f2c_strcpy( tmp, dirname, CFC_STRING_LENGTH_MIN( dirname, GAG_MAX_PATH_LENGTH));

  ier = 0;
  *count = 0;
  if ((dir = opendir(tmp)) == NULL)
    ier = 1;
  else {
    while ((entry = readdir(dir)) != NULL) {
      (*count)++;
    }
    closedir(dir);
  }

  return ier;
}

/**
 * Delete recursively the named directory and all its contents (files,
 * subdirectories, symlinks, ...). No support for pattern substitution.
 *
 * Fortran entry point.
 *
 * @param[in] dirname is the directory name (Fortran string),
 * @param[out] gag_rmdir function value on return is the error status.
 */
int CFC_API gag_rmdir( CFC_FString dirname
                       CFC_DECLARE_STRING_LENGTH( dirname) )
{
  char tmp[GAG_MAX_PATH_LENGTH+1];

  CFC_f2c_strcpy( tmp, dirname, CFC_STRING_LENGTH_MIN( dirname, GAG_MAX_PATH_LENGTH));

  return gag_directory_remove(tmp);

}

/**
 * Delete recursively the named directory and all its contents (files,
 * subdirectories, symlinks, ...). No support for pattern substitution.
 *
 * C entry point.
 *
 * @param[in] dirname is the directory name (C string),
 * @param[out] gag_directory_remove function value on return is the error status.
 */
int gag_directory_remove( char *dirname)
{
  DIR *dir;
  struct dirent *entry;
  int ier;
  char entname[GAG_MAX_PATH_LENGTH+1];

  if ((dir = opendir(dirname)) == NULL)  return 1;

  /* Loop on all entries in directory */
  ier = 0;
  while ((entry = readdir(dir)) != NULL) {
    if (!strcmp(entry->d_name,".") || !strcmp(entry->d_name,"..")) {
      /* Skip . and .. */
      continue;
    }

    strcpy(entname,dirname);
    strcat(entname,"/");
    strcat(entname,entry->d_name);

#if defined(_DIRENT_HAVE_D_TYPE)
    if (entry->d_type == DT_DIR) {
#else
    struct stat fstat;
    if (!stat(entname, &fstat) && S_ISDIR(fstat.st_mode)) {
#endif
      /* This is a directory: delete its contents and the directory
         itself with a recursive call */
      /* printf("Deleting directory %s\n",entname); */
      ier = gag_directory_remove(entname);
    } else {
      /* This is not a directory: remove */
      /* printf("Deleting file %s\n",entname); */
      ier = unlink(entname);
      if (ier != 0) {
        if (errno==EPERM || errno==EACCES) {
          gsys_c_message(seve_e,"RMDIR","Could not delete file %s: permission denied",entname);
        } else {
          gsys_c_message(seve_e,"RMDIR","Could not delete file %s",entname);
        }
      }
    }
  }
  closedir(dir);

  /* And finally delete the directory itself */
  ier = rmdir(dirname);
  if (ier != 0) {
    if (errno==EPERM || errno==EACCES) {
      gsys_c_message(seve_e,"RMDIR","Could not delete directory %s: permission denied",dirname);
    } else if (errno==ENOTEMPTY) {
      gsys_c_message(seve_e,"RMDIR","Could not delete directory %s: directory not empty",dirname);
    } else {
      gsys_c_message(seve_e,"RMDIR","Could not delete directory %s",dirname);
    }
  }

  return ier;
}

/**
 * Get an environment variable.
 *
 * @param[in] name is the variable name.
 * @param[out] trans gives the value of variable @e name.
 */
void CFC_API sic_getenv( CFC_FString name, CFC_FString trans
                         CFC_DECLARE_STRING_LENGTH( name)
                         CFC_DECLARE_STRING_LENGTH( trans))
{
    char tmp[GAG_MAX_PATH_LENGTH];
    char *env;

    CFC_f2c_strcpy( tmp, name, CFC_STRING_LENGTH_MIN( name, GAG_MAX_PATH_LENGTH));
    env = getenv( tmp);
    gag_trace( "<trace> sic_getenv %s=\"%s\"", tmp, env);
    CFC_c2f_strcpy( trans, CFC_STRING_LENGTH( trans), env);
}

int CFC_API sic_setenv( CFC_FString name, CFC_FString trans
                         CFC_DECLARE_STRING_LENGTH( name)
                         CFC_DECLARE_STRING_LENGTH( trans))
{
    char tmpnam[GAG_MAX_PATH_LENGTH];
    char tmptran[GAG_MAX_PATH_LENGTH];
    int ret;

    CFC_f2c_strcpy( tmpnam, name, CFC_STRING_LENGTH_MIN( name, GAG_MAX_PATH_LENGTH));
    CFC_f2c_strcpy( tmptran, trans, CFC_STRING_LENGTH_MIN( trans, GAG_MAX_PATH_LENGTH));
#ifdef WIN32
    printf("sic_setenv is not implemented on this system\n");
    ret = 1;
#else
    ret = setenv(tmpnam, tmptran, 1);
    gag_trace( "<trace> sic_setenv %s=\"%s\"", tmpnam, tmptran);
#endif
    return ret;
}


/**
 * Replace each environment variable name by its value
 * and heading ~ by $HOME.
 *
 * @param[in] src is the input string.
 * @param[out] dst is the output string.
 */
void CFC_API sic_resolve_env( CFC_FString src, CFC_FString dst
                              CFC_DECLARE_STRING_LENGTH( src)
                              CFC_DECLARE_STRING_LENGTH( dst))
{
#define ENV_MAX_LENGTH 8192
    char tmp1[ENV_MAX_LENGTH];
    char tmp2[ENV_MAX_LENGTH];
    char tmp3[ENV_MAX_LENGTH];
    char *s;
    char* t;
    char c;

    CFC_f2c_strcpy( tmp1, src, CFC_STRING_LENGTH_MIN( src, ENV_MAX_LENGTH));
    s = tmp1;
    t = tmp2;
    while ((c = *s++) && (t - tmp2 + 1 < ENV_MAX_LENGTH)) {
        long l;
        char *u;
        if (c == '$') {
            u = s;
            while ((c = *s)) {
                if (!isalnum( c) && c != '_')
                    break;
                s++;
            }
            l = s - u;
            strncpy( tmp3, u, l);
            tmp3[l] = '\0';
            u = getenv( tmp3);
        } else if (c == '~' && t == tmp2) {
            u = getenv( "HOME");
        } else {
            u = NULL;
            if (t + 1 - tmp2 < ENV_MAX_LENGTH) {
                *t++ = c;
            }
        }
        if (u != NULL) {
            l = strlen(u);
            if (t + l - tmp2 >= ENV_MAX_LENGTH) {
                l = ENV_MAX_LENGTH - (t - tmp2) - 1;
            }
            strncpy( t, u, l);
            t += l;
        }
    }
    *t = '\0';
    CFC_c2f_strcpy( dst, CFC_STRING_LENGTH( dst), tmp2);
}

/**
 * Test file existence.
 *
 * @remark Also works for directories. See also gag_isdir.
 * @param[in] infile is the filename to test.
 * @param[in] length is the length of @e infile.
 * @return 0 if file exists, -1 otherwise.
 */
int CFC_API gag_inquire( const CFC_FString infile, const int *length)
{
    struct stat stat_file;
    char file[GAG_MAX_PATH_LENGTH];
    int status;

    CFC_f2c_strcpy( file, infile, *length);
    gag_trace( "<trace> gag_inquire \"%s\"", file);

    status = stat( file, &stat_file);

#ifndef WIN32
    if (status!=0 && errno==EOVERFLOW)
       status = 0;  /* File is too large but exists */
#endif

    return status;
}

/**
 * Test directory existence.
 *
 * Fortran entry point.
 *
 * @param[in] dirname is the directory name (Fortran string),
 * @param[out] gag_isdir return 0 is directory exists, non-zero otherwise.
 */
int CFC_API gag_isdir( CFC_FString dirname
                       CFC_DECLARE_STRING_LENGTH( dirname) )
{
    struct stat dirstat;
    char tmp[GAG_MAX_PATH_LENGTH+1];

    CFC_f2c_strcpy( tmp, dirname, CFC_STRING_LENGTH_MIN( dirname, GAG_MAX_PATH_LENGTH));

    if (!stat(tmp, &dirstat) && S_ISDIR(dirstat.st_mode)) {
        return 0;
    } else {
        return -1;  /* same as gag_inquire */
    }

}

/**
 * Get the file size in bytes. If file is a symlink, evaluation is made on
 * its target.
 *
 * @param[in] path of the file.
 * @param[out] file size (long integer).
 */
int CFC_API gag_filsize( const CFC_FString path, int64_t *size
                         CFC_DECLARE_STRING_LENGTH( path))
{
    int ier;
    struct stat buf;
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, path, CFC_STRING_LENGTH_MIN( path, GAG_MAX_PATH_LENGTH));
    ier = stat( tmp, &buf);
    *size = (int64_t)buf.st_size;
    return ier;
}


/**
 * Get file time of last modification, in seconds since 01-jan-1970.
 * The file can be a regular file or a directory. If file is a symlink,
 * evaluation is made on its target.
 *
 * @param[in] path of the file.
 * @param[out] modification time.
 */
int CFC_API gag_mdate( const CFC_FString path, int *date
                        CFC_DECLARE_STRING_LENGTH( path))
{
    int ier;
    struct stat buf;
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, path, CFC_STRING_LENGTH_MIN( path, GAG_MAX_PATH_LENGTH));
    ier = stat( tmp, &buf);
    *date = (int)buf.st_mtime;
    return ier;
}

/**
 * Get file time (sec,nsec from 01-jan-1970) of last modification, in
 * 2 separate integers. The file can be a regular file or a directory.
 * If file is a symlink, evaluation is made on its target.
 * DO NOT CALL DIRECTLY! CALL FORTRAN OVERLAY GAG_MTIME instead.
 * Should return "sec" as long integer before the "year 2038 problem".
 *
 * @param[in] path of the file.
 * @param[out] modification time.
 */
int CFC_API gag_mtime_c( const CFC_FString path, int *sec, int *nsec
                         CFC_DECLARE_STRING_LENGTH( path))
{
    int ier;
    struct stat buf;
    char tmp[GAG_MAX_PATH_LENGTH];

    CFC_f2c_strcpy( tmp, path, CFC_STRING_LENGTH_MIN( path, GAG_MAX_PATH_LENGTH));
    ier = stat( tmp, &buf);
    *sec = (int)buf.st_mtime;
    /* See man stat for versions supporting tv_nsec (nanoseconds) */
    /* Remember this is intrinsicly limited to the filesystem timestamp
       granularity (e.g. 1 second for ext3, 1 nanosecond for ext4) */
#if (defined(_POSIX_C_SOURCE) && _POSIX_C_SOURCE >= 200809L) || (defined(_XOPEN_SOURCE) && _XOPEN_SOURCE >= 700)
    *nsec = buf.st_mtim.tv_nsec;
#else
    *nsec = 0;
#endif
    return ier;
}

/**
 * Get current time (sec,nsec from 01-jan-1970), in 2 separate integers.
 * DO NOT CALL DIRECTLY! CALL FORTRAN OVERLAY GAG_TIME instead.
 * Should return "sec" as long integer before the "year 2038 problem".
 *
 * @param[out] sec gives the seconds.
 * @param[out] nsec gives the nanoseconds.
 */
int CFC_API gag_time_c( int *sec, int *nsec)
{
    int ier;
    struct timeval tv;

    ier = gettimeofday(&tv, NULL);
    *sec = tv.tv_sec;
    *nsec = tv.tv_usec*1000;  /* Should return nanosec! */
    return ier;
}

/**
 * Formats input date and time as a string with format "%d%b%y %H:%M"
 *
 * @param[in]  rawtime is the raw time.
 * @param[out] returned_asciitime gives the string.
 * @param[out] len gives the length of @e returned_asciitime.
 */
void CFC_API sic_c_datetime_from_raw( int *rawtime, CFC_FString returned_asciitime CFC_DECLARE_STRING_LENGTH( returned_asciitime) )
{
    time_t t;
    char tmp[256];

    t = (time_t) *rawtime;

    strftime( tmp, sizeof(tmp), "%d%b%y %H:%M", localtime( &t));

    CFC_c2f_strcpy( returned_asciitime, CFC_STRING_LENGTH( returned_asciitime), tmp);

}

/**
 * Returns the current date and time as a string with format "%d-%b-%Y %H:%M:%S"
 *
 * @param[out] returned_asciitime gives the string.
 * @param[out] len gives the length of @e returned_asciitime.
 */
void CFC_API sic_c_datetime( CFC_FString returned_asciitime
                             CFC_DECLARE_STRING_LENGTH( returned_asciitime))
{
    char tmp[256];
    time_t now;

    time( &now);
    strftime( tmp, sizeof(tmp), "%d-%b-%Y %H:%M:%S", gmtime( &now));
    CFC_c2f_strcpy( returned_asciitime, CFC_STRING_LENGTH( returned_asciitime), tmp);
}

/**
 * Returns the current UTC date and time in pieces as integer values
 *
 * @param[out] vals[6] [year,month,day,hour,minutes,seconds]
 * @param[out] frac    sub-second fraction
 */
void CFC_API sic_c_idatetime( int32_t vals[6], float *frac )
{
    struct timeval now1;
    time_t now2;
    struct tm t;

    gettimeofday(&now1, NULL);
    now2 = (time_t)now1.tv_sec;
#ifdef WIN32
    gmtime_s( &t, &now2);
#else
    gmtime_r( &now2, &t);
#endif

    vals[0] = 1900+t.tm_year;
    vals[1] = 1+t.tm_mon;
    vals[2] = t.tm_mday;
    vals[3] = t.tm_hour;
    vals[4] = t.tm_min;
    vals[5] = t.tm_sec;
    *frac   = now1.tv_usec*1.e-6;
}

/**
 * Returns the current date and time as a ISO #8601 string with format
 * "%d-%b-%Y %H:%M:%S"
 *
 * @param[out] returned_asciitime gives the string.
 * @param[out] len gives the length of @e returned_asciitime.
 */
void CFC_API sic_c_isodatetime( CFC_FString returned_asciitime
                                CFC_DECLARE_STRING_LENGTH( returned_asciitime))
{
    char tmp1[128];
    char tmp2[128];
    struct timeval now;

    gettimeofday(&now, NULL);
    strftime( tmp1, sizeof(tmp1), "%Y-%m-%dT%H:%M:%S", gmtime( (time_t *)&now.tv_sec));

    /* Append sub-seconds parts */
    sprintf(tmp2,"%s.%06ld",tmp1,now.tv_usec);

    CFC_c2f_strcpy( returned_asciitime, CFC_STRING_LENGTH( returned_asciitime), tmp2);
}

/**
 * Returns the current time as a string with format "%H:%M:%S"
 *
 * @param[out] returned_time gives the string.
 * @param[out] len gives the length of @e returned_time.
 */
void CFC_API sic_c_time( CFC_FString returned_time
                         CFC_DECLARE_STRING_LENGTH( returned_time))
{
    char tmp[256];
    time_t t;

    time( &t);
    strftime( tmp, sizeof(tmp), "%H:%M:%S", gmtime( &t));
    CFC_c2f_strcpy( returned_time, CFC_STRING_LENGTH( returned_time), tmp);
}

/**
 * Returns the current date as a string with format "%d-%b-%Y"
 *
 * @param[out] returned_date gives the string.
 * @param[out] len gives the length of @e returned_date.
 */
void CFC_API sic_c_date( CFC_FString returned_date
                         CFC_DECLARE_STRING_LENGTH( returned_date))
{
    char tmp[256];
    time_t t;

    time( &t);
    strftime( tmp, sizeof(tmp), "%d-%b-%Y", gmtime( &t));
    CFC_c2f_strcpy( returned_date, CFC_STRING_LENGTH( returned_date), tmp);
}

/**
 * Returns timing information of current process.
 *
 * @param[out] time gives the number of clock ticks, the user time,
 *             the system time, the user time of children, the system
 *             time of children.
 */
void CFC_API gag_c_cputime( double time[5])
{
#ifdef WIN32
    double factor;
    HANDLE hProcess;            // specifies the process of interest

    // The FILETIME structure is a 64-bit value representing the number
    // of 100-nanosecond intervals since January 1, 1601.
    FILETIME lpCreationTime;  // when the process was created
    FILETIME lpExitTime;      // when the process exited
    FILETIME lpKernelTime;    // time the process has spent in kernel mode
    FILETIME lpUserTime;      // time the process has spent in user mode
    LONGLONG ltmp;
    LONGLONG atmp, btmp;

    factor = 1.e-7;                    // 100-nanosecond units

    hProcess = GetCurrentProcess( );
    GetProcessTimes( hProcess, &lpCreationTime, &lpExitTime, &lpKernelTime, &lpUserTime);
    atmp = *(LONGLONG*)&lpCreationTime;
    btmp = *(LONGLONG*)&lpExitTime;
    time[0] = (double)((btmp - atmp) * factor);
    ltmp = *(LONGLONG*)&lpUserTime;
    time[1] = (double)(ltmp * factor);
    ltmp = *(LONGLONG*)&lpKernelTime;
    time[2] = (double)(ltmp * factor);
    // time[1]=buf.tms_utime*factor;
    // time[2]=buf.tms_stime*factor;
    ltmp = *(LONGLONG*)&lpUserTime;
    time[3] = (double)(ltmp * factor);
    ltmp = *(LONGLONG*)&lpKernelTime;
    time[4] = (double)(ltmp * factor);
#else
    struct rusage r_usage;
    struct timeval tv;

    gettimeofday(&tv, NULL);
    time[0] = tv.tv_sec + tv.tv_usec / 1e6;
    getrusage(RUSAGE_SELF, &r_usage);
    time[1] = r_usage.ru_utime.tv_sec + r_usage.ru_utime.tv_usec / 1e6;
    time[2] = r_usage.ru_stime.tv_sec + r_usage.ru_stime.tv_usec / 1e6;
    getrusage(RUSAGE_CHILDREN, &r_usage);
    time[3] = r_usage.ru_utime.tv_sec + r_usage.ru_utime.tv_usec / 1e6;
    time[4] = r_usage.ru_stime.tv_sec + r_usage.ru_stime.tv_usec / 1e6;
#endif
}

/**
 * Test if standard input refers to a terminal.
 *
 * @param[out] sic_isatty is 1 for interactive terminals, 0 otherwise
 */
int CFC_API sic_isatty()
{
    return isatty( 0) ? 1 : 0;
}

/**
 * Return the terminal width
 *
 * @param[out] sic_ttyncol the width, default 76
 */
int CFC_API sic_ttyncol()
{
  int w = 76;
#ifndef WIN32
  struct winsize win;
  int ier;

  ier = ioctl(STDOUT_FILENO, TIOCGWINSZ, &win);
  if (ier == 0)  w = win.ws_col;
  if (w <= 0)  w = 76;
#endif

  return w;
}

/**
 * Return the terminal height, if terminal is a tty
 *
 * @param[out] sic_ttynlin the height, default 24
 */
int CFC_API sic_ttynlin()
{
  int h = 24;
#ifndef WIN32
  struct winsize win;
  int ier;

  ier = ioctl(STDOUT_FILENO, TIOCGWINSZ, &win);
  if (ier == 0)  h = win.ws_row;
  if (h <= 0)  h = 24;
#endif

  return h;
}


/**
 * Wait for a decimal number of seconds
 *
 * @param[in] time the number of seconds.
 */
void CFC_API sic_wait( float *time)
{
    gag_trace( "<trace> sic_wait \"%f\"", *time);
    usleep( (unsigned long)((*time) * 1000000));
}

/**
 * Test for finite float value
 *
 * @param[in] x the float value.
 * @return a non-zero value if value is neither infinite nor a "not-a-number"
 *  (NaN) value, and 0 otherwise.
 */
int CFC_API sic_fini4( float *x)
{
    return finite( *x);
}

/**
 * Test for finite double value
 *
 * @param[in] x the double value.
 * @return a non-zero value if value is neither infinite nor a "not-a-number"
 *  (NaN) value, and 0 otherwise.
 */
int CFC_API sic_fini8( double *x)
{
    return finite( *x);
}

/**
 * Returns the class string (NaNQ, +INF, ...) of a real value
 *
 * @param[in] anum The real value.
 * @param[out] string The class string.
 * @param[out] stringLength The length of @e string.
 */
void CFC_API sic_c_infini( double *anum, CFC_FString string, int *stringLength
                           CFC_DECLARE_STRING_LENGTH( string))
{
    /* se demerder avec les FLT_INFINITY, DBL_QNAN etc... */
    *stringLength = 0;
}

/**
 * Virtual memory mapping routines for Unix
 * @author T. Forveille
 */

/**
 * Allocate a block of memory (32-bit nwords version)
 *
 * @param[in] 32-bit nwords number of words (4 bytes) to allocate.
 * @param[out] addr address of the allocated block.
 */
int CFC_API sic_getvm4( int32_t *nwords32, fortran_pointer *addr)
{
    size_t nbytes = ((size_t) *nwords32) * 4;

    if ((*addr = malloc( nbytes)) == NULL) {
        gsys_c_message(seve_f,"SIC_GETVM4",
          "Memory allocation failed: errno=%d, Nwords=%d, Nbytes=%ld\n",
          errno, *nwords32, nbytes);
        errno = 0;
        return 0;
    }
    return 1;
}

/**
 * Allocate a block of memory (64-bit nwords version)
 *
 * @param[in] 64-bit nwords number of words (4 bytes) to allocate.
 * @param[out] addr address of the allocated block.
 */
int CFC_API sic_getvm8( int64_t *nwords64, fortran_pointer *addr)
{
    size_t nbytes = ((size_t) *nwords64) * 4;

    if ((*addr = malloc( nbytes)) == NULL) {
        gsys_c_message(seve_f,"SIC_GETVM8",
          "Memory allocation failed: errno=%d, Nwords=%ld, Nbytes=%ld\n",
          errno, *nwords64, nbytes);
        errno = 0;
        return 0;
    }
    return 1;
}

/**
 * Allocate a block of memory (32-bit nwords version)
 *
 * @param[in] 32-bit nwords number of words (4 bytes) to allocate.
 * @param[out] addr address of the allocated block.
 */
int CFC_API sic_getvm4c( int32_t *nwords32, fortran_pointer *addr)
{
    size_t nbytes = ((size_t) *nwords32) * 4;

    if ((*addr = malloc( nbytes)) == NULL) {
        gsys_c_message(seve_f,"SIC_GETVM4C",
          "Memory allocation failed: errno=%d, Nwords=%d, Nbytes=%ld\n",
          errno, *nwords32, nbytes);
        errno = 0;
        return 0;
    }
    return 1;
}

/**
 * Allocate a block of memory (64-bit nwords version)
 *
 * @param[in] 64-bit nwords number of words (4 bytes) to allocate.
 * @param[out] addr address of the allocated block.
 */
int CFC_API sic_getvm8c( int64_t *nwords64, fortran_pointer *addr)
{
    size_t nbytes = ((size_t) *nwords64) * 4;

    if ((*addr = malloc( nbytes)) == NULL) {
        gsys_c_message(seve_f,"SIC_GETVM8",
          "Memory allocation failed: errno=%d, Nwords=%ld, Nbytes=%ld\n",
          errno, *nwords64, nbytes);
        errno = 0;
        return 0;
    }
    return 1;
}

/**
 * Free a block of memory (32-bit nwords version)
 *
 * @param[in] 32-bit nwords (not used)
 * @param[in] addr is the address of the block.
 */
void CFC_API free_vm4( int32_t *nwords32, fortran_pointer *addr)
{
    free( *addr);
}

/**
 * Free a block of memory (64-bit nwords version)
 *
 * @param[in] 64-bit nwords (not used)
 * @param[in] addr is the address of the block.
 */
void CFC_API free_vm8( int64_t *nwords64, fortran_pointer *addr)
{
    free( *addr);
}

/**
 * Unknown utility !!!
 */
fortran_pointer CFC_API gag_pointer( fortran_pointer *adr, fortran_pointer *mem)
{
    return (((*adr - (fortran_pointer)mem) >> 2) + (fortran_pointer)1);
}

/**
 * Unknown utility !!!
 */
fortran_pointer CFC_API bytpnt( fortran_pointer *adr, fortran_pointer *mem)
{
    return (*adr - (fortran_pointer)mem + (fortran_pointer)1);
}

/**
 * Set working directory.
 *
 * @param[in,out] dir is the directory name. It receives the absolute path of
 * the directory.
 * @return 0 if success, -1 otherwise.
 */
int CFC_API set_dir( CFC_FString dir
                     CFC_DECLARE_STRING_LENGTH( dir))
{
    char tmp[GAG_MAX_PATH_LENGTH];
    int err = 0;

    CFC_f2c_strcpy( tmp, dir, CFC_STRING_LENGTH_MIN( dir, SIC_MAX_PATH_LENGTH));
    gag_trace( "<trace> set_dir \"%s\"", tmp);

    if (tmp[0])
        err = chdir( tmp);
    if (err == 0) {
        getcwd( tmp, sizeof(tmp));
        CFC_c2f_strcpy( dir, CFC_STRING_LENGTH( dir), tmp);
    }
    return err;
}

/**
 * Return the address of a character string (passed by reference)
 * Called by some fortran routines
 */
char *CFC_API locstr( CFC_FString string)
{
    return CFC_f2c_string( string);
}

/**
 * Return the address of any word (passed by reference)
 * Called by some fortran routines
 */
int *CFC_API locwrd( int *word)
{
    return word;
}

/**
 * Returns the default extension (normally .EXE) for tasks (@e ie executable
 *  files)
 */
void CFC_API executable_extension( CFC_FString ext
                                   CFC_DECLARE_STRING_LENGTH( ext))
{
    CFC_c2f_strcpy( ext, CFC_STRING_LENGTH( ext), "exe");
}


void CFC_API sic_c_assert( long *condition, const CFC_FString message
                           CFC_DECLARE_STRING_LENGTH( message))
{
    if (!*condition) {
        char tmp[GAG_MAX_MESSAGE_LENGTH];

        CFC_f2c_strcpy( tmp, message, CFC_STRING_LENGTH_MIN( message, GAG_MAX_MESSAGE_LENGTH));
        fprintf( stderr, "SIC_ASSERT: %s\n", tmp);
        exit( 1);
    }
}

/*
#include <sys/types.h>
#include <sys/stat.h>
#include <err.h>
#include <errno.h>
#include <string.h>
*/

/* Code taken directly from mkdir(1).

 * mkpath -- create directories.
 *  path     - path
 */
int gsys_c_mkpath(char *path)
{
  struct stat sb;
  char *slash;
  int done = 0;
#ifndef WIN32
#define DIR_SEP_STRING "/"
#define DIR_SEP_CHAR '/'
#else
#define DIR_SEP_STRING "\\"
#define DIR_SEP_CHAR '\\'
#endif

  slash = path;

  while (!done) {
    slash += strspn(slash, DIR_SEP_STRING);
    slash += strcspn(slash, DIR_SEP_STRING);

    done = (*slash == '\0');
    *slash = '\0';

#ifdef WIN32
        /* driver letter case */
        if (!path[2] && path[1] == ':') {
        } else
#endif
    if (stat(path, &sb)) {
      if (errno != ENOENT || (
#ifndef WIN32
                mkdir(path, 0777)
#else
                _mkdir(path)
#endif
                && errno != EEXIST)) {
        return (-1);
      }
#ifndef WIN32
    } else if (!S_ISDIR(sb.st_mode)) {
#else
    } else if (!(sb.st_mode & _S_IFDIR)) {
#endif
      return (-1);
    }

    *slash = DIR_SEP_CHAR;
  }

  return (0);
}

void CFC_API gag_mkpath( const CFC_FString path, int *error
                           CFC_DECLARE_STRING_LENGTH( path))
{
        char tmp[SIC_MAX_PATH_LENGTH];

        CFC_f2c_strcpy( tmp, path, CFC_STRING_LENGTH_MIN( path, SIC_MAX_PATH_LENGTH));
        *error = gsys_c_mkpath( tmp);
}

#define GAG_MAX_LOCKS 64
static char s_locks[GAG_MAX_LOCKS][GAG_MAX_PATH_LENGTH];
static int s_nb_locks = 0;

/*
 * Handler called on exit to remove locked files.
 */
static void remove_locks()
{
    int i;

    for (i = 0; i < s_nb_locks; i++)
        unlink( s_locks[i]);
    s_nb_locks = 0;
}

/*
 * Record locked filenames to be able to delete them.
 */
static void record_lock( char *filename)
{

    if (!s_nb_locks)
        /* register procedure to be called on exit */
        atexit( remove_locks);
    if (s_nb_locks == GAG_MAX_LOCKS) {
        gsys_c_message(seve_f, "RECORD_LOCK", "Maximum number of locked files reached");
        return;
    }
    strcpy(s_locks[s_nb_locks++], filename);
}

/*
 * Output locked files via message.
 */
#define gag_show_locked_files CFC_EXPORT_NAME(gag_show_locked_files)
void CFC_API gag_show_locked_files()
{
    int i;

    for (i = 0; i < s_nb_locks; i++)
        gsys_c_message(seve_r, "LOCKED_FILE", s_locks[i]);
}

/**
 * Lock a user resource.
 *
 * @param[name] name is the resource name.
 * @return 0 on success, -1 if file already exists, an error number otherwise.
 */
#define gag_lock_file CFC_EXPORT_NAME(gag_lock_file)
int CFC_API gag_lock_file( CFC_FString filename CFC_DECLARE_STRING_LENGTH(filename))
{
    char tmp[GAG_MAX_PATH_LENGTH];
    struct stat stat_file;
    FILE *fp;

    CFC_f2c_strcpy( tmp, filename, CFC_STRING_LENGTH_MIN( filename, GAG_MAX_PATH_LENGTH));
    gag_trace( "<trace> gag_lock_file \"%s\"", tmp);

    errno = 0;
    if (!stat( tmp, &stat_file))
        return -1;
    else if(errno != ENOENT) {
        gsys_c_message(seve_e,"lock_file",strerror(errno));
        return errno;
        }
    errno = 0;

    fp = fopen( tmp, "w");
    if (fp == NULL) {
        gsys_c_message(seve_e,"lock_file",strerror(errno));
        return errno;
    }

    fclose( fp);
    record_lock( tmp);

    return 0;
}

/**
 *   C emulation of Fortran string comparison. Input strings are given by
 * address only (e.g. membyt(ip)) and may not be real Fortran strings. Their
 * real length must also be given.
 *   This routine can be useful in the Sic variables context, where the Sic
 * character strings are just some bytes in memory. Comparing them this way
 * avoids wasting copying them in real Fortran strings.
 *
 * @param[s1] first string address,
 * @param[n1] first string length,
 * @param[s2] second string address,
 * @param[n2] second string length,
 * @return 0 if equal, 1 if not equal (like strcmp).
 */

#define cmp_fstring CFC_EXPORT_NAME(cmp_fstring)
int CFC_API cmp_fstring( CFC_FString s1, int *n1, CFC_FString s2, int *n2)
{
    int n, m;
    char *s;

    if (*n1 > *n2) {
        n = *n2;
        m = *n1 - *n2;
        s = s1 + n;
    } else {
        n = *n1;
        m = *n2 - *n1;
        s = s2 + n;
    }
    while (n && *s1++ == *s2++) n--;
    if (n)
        return 1;
    while (m && *s++ == ' ') m--;
    if (m)
        return 1;
    else
        return 0;
}

/**
  * Display getrusage and getrlimit values (ressources usage and limits)
  *
  * @return nothing
  */
void CFC_API gag_resources()
{
#if defined(LINUX)
  int ier;
  struct rusage self,children,thread;
  struct rlimit rlp;

  /* See man getrusage */
  printf("\nCurrent usage (self/children/thread):\n");

  ier = getrusage(RUSAGE_SELF,&self);
  if (ier != 0) {
    printf("Error calling getrusage\n");
    return;
  }
  ier = getrusage(RUSAGE_CHILDREN,&children);
#if defined(RUSAGE_THREAD)
  ier = getrusage(RUSAGE_THREAD,&children);
#else
  printf("Warning: no thread usage\n");
  thread.ru_utime.tv_sec = 0;
  thread.ru_utime.tv_usec = 0;
  thread.ru_stime.tv_sec = 0;
  thread.ru_stime.tv_usec = 0;
  thread.ru_maxrss = 0;
  thread.ru_ixrss = 0;
  thread.ru_idrss = 0;
  thread.ru_isrss = 0;
  thread.ru_minflt = 0;
  thread.ru_majflt = 0;
  thread.ru_nswap = 0;
  thread.ru_inblock = 0;
  thread.ru_oublock = 0;
  thread.ru_msgsnd = 0;
  thread.ru_msgrcv = 0;
  thread.ru_nsignals = 0;
  thread.ru_nvcsw = 0;
  thread.ru_nivcsw = 0;
#endif

  printf("utime_sec:  %12ld %12ld %12ld\n",(long)self.ru_utime.tv_sec,(long)children.ru_utime.tv_sec,(long)thread.ru_utime.tv_sec);
  printf("utime_usec: %12ld %12ld %12ld\n",(long)self.ru_utime.tv_usec,(long)children.ru_utime.tv_usec,(long)thread.ru_utime.tv_usec);
  printf("stime_sec:  %12ld %12ld %12ld\n",(long)self.ru_stime.tv_sec,(long)children.ru_stime.tv_sec,(long)thread.ru_stime.tv_sec);
  printf("stime_usec: %12ld %12ld %12ld\n",(long)self.ru_stime.tv_usec,(long)children.ru_stime.tv_usec,(long)thread.ru_stime.tv_usec);
  printf("maxrss:     %12ld %12ld %12ld\n",self.ru_maxrss,children.ru_maxrss,thread.ru_maxrss);
  printf("ixrss:      %12ld %12ld %12ld\n",self.ru_ixrss,children.ru_ixrss,thread.ru_ixrss);
  printf("idrss:      %12ld %12ld %12ld\n",self.ru_idrss,children.ru_idrss,thread.ru_idrss);
  printf("isrss:      %12ld %12ld %12ld\n",self.ru_isrss,children.ru_isrss,thread.ru_isrss);
  printf("minflt:     %12ld %12ld %12ld\n",self.ru_minflt,children.ru_minflt,thread.ru_minflt);
  printf("majflt:     %12ld %12ld %12ld\n",self.ru_majflt,children.ru_majflt,thread.ru_majflt);
  printf("nswap:      %12ld %12ld %12ld\n",self.ru_nswap,children.ru_nswap,thread.ru_nswap);
  printf("inblock:    %12ld %12ld %12ld\n",self.ru_inblock,children.ru_inblock,thread.ru_inblock);
  printf("oublock:    %12ld %12ld %12ld\n",self.ru_oublock,children.ru_oublock,thread.ru_oublock);
  printf("msgsnd:     %12ld %12ld %12ld\n",self.ru_msgsnd,children.ru_msgsnd,thread.ru_msgsnd);
  printf("msgrcv:     %12ld %12ld %12ld\n",self.ru_msgrcv,children.ru_msgrcv,thread.ru_msgrcv);
  printf("nsignals:   %12ld %12ld %12ld\n",self.ru_nsignals,children.ru_nsignals,thread.ru_nsignals);
  printf("nvcsw:      %12ld %12ld %12ld\n",self.ru_nvcsw,children.ru_nvcsw,thread.ru_nvcsw);
  printf("nivcsw:     %12ld %12ld %12ld\n",self.ru_nivcsw,children.ru_nivcsw,thread.ru_nivcsw);


  /* See man getrlimit */
  printf("\nCurrent limits (soft/hard):\n");

  ier = getrlimit(RLIMIT_CPU,&rlp);
  printf("%-17s %12ld %12ld %s\n","CPU time",(long)rlp.rlim_cur,(long)rlp.rlim_max,"seconds");

  ier = getrlimit(RLIMIT_FSIZE,&rlp);
  printf("%-17s %12ld %12ld %s\n","File size",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");

  ier = getrlimit(RLIMIT_DATA,&rlp);
  printf("%-17s %12ld %12ld %s\n","Data size",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");

  ier = getrlimit(RLIMIT_STACK,&rlp);
  printf("%-17s %12ld %12ld %s\n","Stack size",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");

  ier = getrlimit(RLIMIT_CORE,&rlp);
  printf("%-17s %12ld %12ld %s\n","Core file size",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");

  ier = getrlimit(RLIMIT_RSS,&rlp);
  printf("%-17s %12ld %12ld %s\n","Resident set",(long)rlp.rlim_cur,(long)rlp.rlim_max,"pages");

  ier = getrlimit(RLIMIT_NPROC,&rlp);
  printf("%-17s %12ld %12ld %s\n","Processes",(long)rlp.rlim_cur,(long)rlp.rlim_max,"processes");

  ier = getrlimit(RLIMIT_NOFILE,&rlp);
  printf("%-17s %12ld %12ld %s\n","Open files",(long)rlp.rlim_cur,(long)rlp.rlim_max,"files");

  ier = getrlimit(RLIMIT_MEMLOCK,&rlp);
  printf("%-17s %12ld %12ld %s\n","Locked memory",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");

  ier = getrlimit(RLIMIT_AS,&rlp);
  printf("%-17s %12ld %12ld %s\n","Address space",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");

#if defined(RLIMIT_LOCKS)
  ier = getrlimit(RLIMIT_LOCKS,&rlp); /* (Early Linux 2.4 only) */
  printf("%-17s %12ld %12ld %s\n","File locks",(long)rlp.rlim_cur,(long)rlp.rlim_max,"locks");
#endif

#if defined(RLIMIT_SIGPENDING)
  ier = getrlimit(RLIMIT_SIGPENDING,&rlp); /* (Since Linux 2.6.8) */
  printf("%-17s %12ld %12ld %s\n","Pending signals",(long)rlp.rlim_cur,(long)rlp.rlim_max,"signals");
#endif

#if defined(RLIMIT_MSGQUEUE)
  ier = getrlimit(RLIMIT_MSGQUEUE,&rlp); /* (Since Linux 2.6.8) */
  printf("%-17s %12ld %12ld %s\n","Msgqueue size",(long)rlp.rlim_cur,(long)rlp.rlim_max,"bytes");
#endif

#if defined(RLIMIT_NICE)
  ier = getrlimit(RLIMIT_NICE,&rlp); /*  (since Linux 2.6.12) */
  printf("%-17s %12ld %12ld %s\n","Nice priority",(long)rlp.rlim_cur,(long)rlp.rlim_max,"");
#endif

#if defined(RLIMIT_RTPRIO)
  ier = getrlimit(RLIMIT_RTPRIO,&rlp); /* (Since Linux 2.6.12) */
  printf("%-17s %12ld %12ld %s\n","Realtime priority",(long)rlp.rlim_cur,(long)rlp.rlim_max,"");
#endif

#if defined(RLIMIT_RTTIME)
  ier = getrlimit(RLIMIT_RTTIME,&rlp); /* (Since Linux 2.6.25) */
  printf("%-17s %12ld %12ld %s\n","Realtime timeout",(long)rlp.rlim_cur,(long)rlp.rlim_max,"usec");
#endif

#endif /* Linux */
}

/**
  *  Set the locale to the named value. Use with care, Gildas is only English-
  * speaking! This may be useful if a Gildas dependency is (re)setting the
  * locale by itself. This happens at least with gtk_init, and some Python
  * modules.
  *  Setting something else than "C" or English variants can break reading
  * numeric (e.g. "1.23" is not recognized anymore, French form is "1,23")
  *
  * @return error code
  */
int CFC_API gag_setlocale(CFC_FString fchain CFC_DECLARE_STRING_LENGTH(fchain))
{
    char cchain[24];

    CFC_f2c_strcpy( cchain, fchain, CFC_STRING_LENGTH_MIN( fchain, 24) );

    if (setlocale( LC_ALL, cchain) == NULL) {
        /* suppress warning */
        fprintf( stderr, "Warning, Unable to set locale to \"%s\"\n",cchain);
        return 1;
    } else {
        return 0;
    }

}

/**
  *  Print the current locale details
  *
  * @return nothing
  */
void CFC_API gag_printlocale()
{
   char *curlocale;
   struct lconv * lc;

   /* Get current locale name */
   curlocale = setlocale(LC_ALL, NULL);
   printf("Current locale LC_ALL is : %s\n",curlocale);

   /* Print current locale details */
   lc = localeconv();
   printf("Decimal point            : %s\n",lc->decimal_point);
   printf("Thousands separator      : %s\n",lc->thousands_sep);
   printf("Digits grouping          : %s\n",lc->grouping);
   /* Below useless for Gildas
   printf("International currency symbol : %s\n",lc->int_curr_symbol);
   printf("Local currency symbol         : %s\n",lc->currency_symbol);
   printf("Monetary decimal point        : %s\n",lc->mon_decimal_point);
   printf("Monetary thousands separator  : %s\n",lc->mon_thousands_sep);
   printf("Monetary grouping             : %s\n",lc->mon_grouping);
   printf("Monetary positive sign        : %s\n",lc->positive_sign);
   printf("Monetary negative sign        : %s\n",lc->negative_sign);
   printf("Monetary Intl Decimal Digits  : %c\n",lc->int_frac_digits);
   printf("Monetary Decimal Digits       : %c\n",lc->frac_digits);
   printf("Monetary + Precedes           : %c\n",lc->p_cs_precedes);
   printf("Monetary + Space              : %c\n",lc->p_sep_by_space);
   printf("Monetary - Precedes           : %c\n",lc->n_cs_precedes);
   printf("Monetary - Space              : %c\n",lc->n_sep_by_space);
   printf("Monetary + Sign Position      : %c\n",lc->p_sign_posn);
   printf("Monetary - Sign Position      : %c\n",lc->n_sign_posn); */

}


/**
  * Return the physical memory size, in MiB
  *
  * @param[ramsize] the returned size
  * @return nothing
  */
void CFC_API gag_ramsize(int64_t *ramsize)
{
#ifdef WIN32
    MEMORYSTATUSEX statex;

    statex.dwLength = sizeof (statex);
    GlobalMemoryStatusEx (&statex);
    *ramsize = (int64_t) (statex.ullTotalPhys / 1024 / 1024);
#elif defined(__APPLE__)
    int mib[] = { CTL_HW, HW_MEMSIZE };
    unsigned long physmem;

    size_t len = sizeof(physmem);
    sysctl(mib, sizeof(mib) / sizeof(int), &physmem, &len, NULL, 0);
    *ramsize = (int64_t) (physmem / 1024 / 1024);
#else
    struct sysinfo info;

    sysinfo( &info);
    *ramsize = (int64_t) (info.totalram / 1024 / 1024);
#endif
}

/**
  * Return the CPU cache sizes, in kiB
  *
  * @param[l1size] L1 cache size
  * @param[l2size] L2 cache size
  * @param[l3size] L3 cache size
  * @param[l4size] L4 cache size
  * @return nothing
  */
void CFC_API gag_cachesize(int64_t *l1size,
                           int64_t *l2size,
                           int64_t *l3size,
                           int64_t *l4size)
{
#ifdef WIN32
    /* Not yet implemented */
    *l1size = 0;
    *l2size = 0;
    *l3size = 0;
    *l4size = 0;
#elif defined(__APPLE__)
    size_t csize = 0;
    size_t sizeof_csize = sizeof(csize);
    sysctlbyname("hw.l1dcachesize", &csize, &sizeof_csize, 0, 0);
    *l1size = (int64_t) (csize / 1024);
    sysctlbyname("hw.l2cachesize", &csize, &sizeof_csize, 0, 0);
    *l2size = (int64_t) (csize / 1024);
    sysctlbyname("hw.l3cachesize", &csize, &sizeof_csize, 0, 0);
    *l3size = (int64_t) (csize / 1024);
    *l4size = 0;  /* Not available */
#else
    *l1size = sysconf (_SC_LEVEL1_DCACHE_SIZE) / 1024;  /* L1 data cache size*/
    *l2size = sysconf (_SC_LEVEL2_CACHE_SIZE) / 1024;
    *l3size = sysconf (_SC_LEVEL3_CACHE_SIZE) / 1024;
    *l4size = sysconf (_SC_LEVEL4_CACHE_SIZE) / 1024;
#endif
}
