This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.

Index Nav:	[Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav:	[Date Prev] [Date Next]	[Thread Prev] [Thread Next]
Other format:	[Raw text]

[gfortran] PATCH implement g77 intrinsics

From: François-Xavier Coudert <Francois-Xavier dot Coudert at lcp dot u-psud dot fr>
To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
Date: Thu, 17 Mar 2005 22:36:37 +0100
Subject: [gfortran] PATCH implement g77 intrinsics

Hi all,

Please find attached a patch (g77_intrinsics.diff and all .c files)
implementing some g77 intrinsics into gfortran (the exact list is: chdir,
gerror, getlog, hostnm, ierrno, kill, link, perror, rename, sleep,
symlnk, time, time8).

Added are two testcases (g77_intrinsics_funcs.f and g77_intrinsics_sub.f)
to be added to the gfortran testsuite.

All this is bootstrapped and regtested on i686-linux, for both mainline
and 4.0. As this patch is rather self-contained and doesn't interfere
with the rest of the compiler, I hope to get a quick approval.

OK for mainline and 4.0?



2005-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

	* gcc/fortran/check.c, gcc/fortran/gfortran.h,
	  gcc/fortran/intrinsic.c, gcc/fortran/intrinsic.h,
	  gcc/fortran/iresolve.c, gcc/fortran/trans-intrinsic.c:
	  add support for resolving and checking arguments for the
	  new intrinsics.

	* chdir.c, gerror.c, getlog.c, hostnm.c, ierrno.c, kill.c,
	  link.c, perror.c, rename.c, sleep.c, symlnk.c, time.c:
	  implement intrinsics themselves.

	* libgfortran/Makefile.am: Added new files.
	
	* libgfortran/configure.ac: add checks for signal.h headers
	  file, as well as following functions: chdir, strerror,
	  getlogin, gethostname, kill, link, symlink, perror, sleep,
	  time.



2005-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>

	* g77_intrinsics_funcs.f: New test.
	* g77_intrinsics_sub.f: New test.

Attachment: g77_intrinsics.diff
Description: Text document

Attachment: g77_intrinsics_funcs.f
Description: Text document

Attachment: g77_intrinsics_sub.f
Description: Text document

/* Implementation of the CHDIR intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#include "../io/io.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

/* SUBROUTINE CHDIR(DIR, STATUS)
   CHARACTER(len=*), INTENT(IN) :: DIR
   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */

#ifdef HAVE_CHDIR
extern void chdir_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
iexport_proto(chdir_i4_sub);

void
chdir_i4_sub (char *dir, GFC_INTEGER_4 *status, gfc_charlen_type dir_len)
{
  int val;
  char *str;

  /* Trim trailing spaces from paths.  */
  while (dir_len > 0 && dir[dir_len - 1] == ' ')
    dir_len--;

  /* Make a null terminated copy of the strings.  */
  str = gfc_alloca (dir_len + 1);
  memcpy (str, dir, dir_len);
  str[dir_len] = '\0'; 

  val = chdir (str);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(chdir_i4_sub);

extern void chdir_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type);
iexport_proto(chdir_i8_sub);

void
chdir_i8_sub (char *dir, GFC_INTEGER_8 *status, gfc_charlen_type dir_len)
{
  int val;
  char *str;

  /* Trim trailing spaces from paths.  */
  while (dir_len > 0 && dir[dir_len - 1] == ' ')
    dir_len--;

  /* Make a null terminated copy of the strings.  */
  str = gfc_alloca (dir_len + 1);
  memcpy (str, dir, dir_len);
  str[dir_len] = '\0'; 

  val = chdir (str);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(chdir_i8_sub);

extern GFC_INTEGER_4 chdir_i4 (char *, gfc_charlen_type);
export_proto(chdir_i4);

GFC_INTEGER_4
chdir_i4 (char *dir, gfc_charlen_type dir_len)
{
  GFC_INTEGER_4 val;
  chdir_i4_sub (dir, &val, dir_len);
  return val;
}

extern GFC_INTEGER_8 chdir_i8 (char *, gfc_charlen_type);
export_proto(chdir_i8);

GFC_INTEGER_8
chdir_i8 (char *dir, gfc_charlen_type dir_len)
{
  GFC_INTEGER_8 val;
  chdir_i8_sub (dir, &val, dir_len);
  return val;
}
#endif

/* Implementation of the GERROR g77 intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#ifdef HAVE_STRING_H
#include <string.h>
#endif


/* GERROR (MESSAGE), g77 intrinsic for retrieving the system error
   message corresponding to the last system error (C errno).
   CHARACTER(len=*), INTENT(OUT) :: MESSAGE  */

#ifdef HAVE_STRERROR
void PREFIX(gerror) (char *, gfc_charlen_type);
export_proto_np(PREFIX(gerror));

void 
PREFIX(gerror) (char * msg, gfc_charlen_type msg_len)
{
  int p_len;
  char *p;

  memset (msg, ' ', msg_len); /* Blank the string.  */

  p = strerror (errno);
  if (p == NULL)
    return;

  p_len = strlen (p);
  if (msg_len < p_len)
    memcpy (msg, p, msg_len);
  else
    memcpy (msg, p, p_len);
}
#endif

/* Implementation of the GETLOG g77 intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif


/* GETLOG (LOGIN), g77 intrinsic for retrieving the login name for the
   process.
   CHARACTER(len=*), INTENT(OUT) :: LOGIN  */

#ifdef HAVE_GETLOGIN
void PREFIX(getlog) (char *, gfc_charlen_type);
export_proto_np(PREFIX(getlog));

void 
PREFIX(getlog) (char * login, gfc_charlen_type login_len)
{
  int p_len;
  char *p;

  memset (login, ' ', login_len); /* Blank the string.  */

  p = getlogin ();
  if (p == NULL)
    return;

  p_len = strlen (p);
  if (login_len < p_len)
    memcpy (login, p, login_len);
  else
    memcpy (login, p, p_len);
}
#endif

/* Implementation of the HOSTNM intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>
#include <string.h>

#ifdef HAVE_UNISTD_H
#include <unistd.h> 
#endif

#include "../io/io.h"

/* SUBROUTINE HOSTNM(NAME, STATUS)
   CHARACTER(len=*), INTENT(OUT) :: NAME
   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */

#ifdef HAVE_GETHOSTNAME
extern void hostnm_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
iexport_proto(hostnm_i4_sub);

void
hostnm_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len)
{
  int val, i;
  char *p;

  memset (name, ' ', name_len);
  p = gfc_alloca (name_len + 1);

  val = gethostname (p, name_len);

  if (val == 0)
  {
    i = -1;
    while (i < name_len && p[++i] != '\0')
      name[i] = p[i];
  }

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(hostnm_i4_sub);

extern void hostnm_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type);
iexport_proto(hostnm_i8_sub);

void
hostnm_i8_sub (char *name, GFC_INTEGER_8 *status, gfc_charlen_type name_len)
{
  int val, i;
  char *p;

  memset (name, ' ', name_len);
  p = gfc_alloca (name_len + 1);

  val = gethostname (p, name_len);

  if (val == 0)
  {
    i = -1;
    while (i < name_len && p[++i] != '\0')
      name[i] = p[i];
  }

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(hostnm_i8_sub);

extern GFC_INTEGER_4 hostnm (char *, gfc_charlen_type);
export_proto(hostnm);

GFC_INTEGER_4
hostnm (char *name, gfc_charlen_type name_len)
{
  GFC_INTEGER_4 val;
  hostnm_i4_sub (name, &val, name_len);
  return val;
}
#endif

/* Implementation of the IERRNO intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#include "../io/io.h"


/* INTEGER FUNCTION IERRNO()  */

extern GFC_INTEGER_4 ierrno_i4 (void);
export_proto(ierrno_i4);

GFC_INTEGER_4
ierrno_i4 (void)
{
  return (GFC_INTEGER_4) errno;
}

extern GFC_INTEGER_8 ierrno_i8 (void);
export_proto(ierrno_i8);

GFC_INTEGER_8
ierrno_i8 (void)
{
  return (GFC_INTEGER_8) errno;
}

/* Implementation of the KILL g77 intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif

#ifdef HAVE_SIGNAL_H
#include <signal.h>
#endif

#include <errno.h>

#include "../io/io.h"

/* SUBROUTINE KILL(PID, SIGNAL, STATUS)
   INTEGER, INTENT(IN) :: PID, SIGNAL
   INTEGER(KIND=1), INTENT(OUT), OPTIONAL :: STATUS

   INTEGER(KIND=1) FUNCTION KILL(PID, SIGNAL)
   INTEGER, INTENT(IN) :: PID, SIGNAL */

#ifdef HAVE_KILL
extern void kill_i4_sub (GFC_INTEGER_4 *, GFC_INTEGER_4 *, GFC_INTEGER_4 *);
iexport_proto(kill_i4_sub);

void
kill_i4_sub (GFC_INTEGER_4 *pid, GFC_INTEGER_4 *signal,
	     GFC_INTEGER_4 *status)
{
  int val;

  val = kill (pid, signal);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(kill_i4_sub);

extern void kill_i8_sub (GFC_INTEGER_8 *, GFC_INTEGER_8 *, GFC_INTEGER_8 *);
iexport_proto(kill_i8_sub);

void
kill_i8_sub (GFC_INTEGER_8 *pid, GFC_INTEGER_8 *signal,
	     GFC_INTEGER_8 *status)
{
  int val;

  val = kill (pid, signal);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(kill_i8_sub);

extern GFC_INTEGER_4 kill_i4 (GFC_INTEGER_4 *, GFC_INTEGER_4 *);
export_proto(kill_i4);

GFC_INTEGER_4
kill_i4 (GFC_INTEGER_4 *pid, GFC_INTEGER_4 *signal)
{
  GFC_INTEGER_4 val;
  kill_i4_sub (pid, signal, &val);
  return val;
}

extern GFC_INTEGER_8 kill_i8 (GFC_INTEGER_8 *, GFC_INTEGER_8 *);
export_proto(kill_i8);

GFC_INTEGER_8
kill_i8 (GFC_INTEGER_8 *pid, GFC_INTEGER_8 *signal)
{
  GFC_INTEGER_8 val;
  kill_i8_sub (pid, signal, &val);
  return val;
}
#endif

/* Implementation of the LINK intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#include "../io/io.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

/* SUBROUTINE LINK(PATH1, PATH2, STATUS)
   CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */

#ifdef HAVE_LINK
extern void link_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
	                 gfc_charlen_type);
iexport_proto(link_i4_sub);

void
link_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
             gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = link (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(link_i4_sub);

extern void link_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type,
	                 gfc_charlen_type);
iexport_proto(link_i8_sub);

void
link_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
             gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = link (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(link_i8_sub);

extern GFC_INTEGER_4 link_i4 (char *, char *, gfc_charlen_type,
	                      gfc_charlen_type);
export_proto(link_i4);

GFC_INTEGER_4
link_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
         gfc_charlen_type path2_len)
{
  GFC_INTEGER_4 val;
  link_i4_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}

extern GFC_INTEGER_8 link_i8 (char *, char *, gfc_charlen_type,
	                      gfc_charlen_type);
export_proto(link_i8);

GFC_INTEGER_8
link_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
	 gfc_charlen_type path2_len)
{
  GFC_INTEGER_8 val;
  link_i8_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}
#endif

/* Implementation of the PERROR intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <stdio.h>
#include <errno.h>

#include "../io/io.h"


/* SUBROUTINE PERROR(STRING)
   CHARACTER(len=*), INTENT(IN) :: STRING   */

#ifdef HAVE_PERROR
extern void perror_sub (char *, gfc_charlen_type);
iexport_proto(perror_sub);

void
perror_sub (char *string, gfc_charlen_type string_len)
{
  char * str;

  /* Trim trailing spaces from paths.  */
  while (string_len > 0 && string[string_len - 1] == ' ')
    string_len--;

  /* Make a null terminated copy of the strings.  */
  str = gfc_alloca (string_len + 1);
  memcpy (str, string, string_len);
  str[string_len] = '\0'; 

  perror (str);
}
iexport(perror_sub);
#endif

/* Implementation of the RENAME intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#include "../io/io.h"

/* SUBROUTINE RENAME(PATH1, PATH2, STATUS)
   CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */

extern void rename_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
	                   gfc_charlen_type);
iexport_proto(rename_i4_sub);

void
rename_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
	       gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = rename (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(rename_i4_sub);

extern void rename_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type,
	                   gfc_charlen_type);
iexport_proto(rename_i8_sub);

void
rename_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
	       gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = rename (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(rename_i8_sub);

extern GFC_INTEGER_4 rename_i4 (char *, char *, gfc_charlen_type,
	                        gfc_charlen_type);
export_proto(rename_i4);

GFC_INTEGER_4
rename_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
	   gfc_charlen_type path2_len)
{
  GFC_INTEGER_4 val;
  rename_i4_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}

extern GFC_INTEGER_8 rename_i8 (char *, char *, gfc_charlen_type,
	                        gfc_charlen_type);
export_proto(rename_i8);

GFC_INTEGER_8
rename_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
	   gfc_charlen_type path2_len)
{
  GFC_INTEGER_8 val;
  rename_i8_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}

/* Implementation of the SLEEP intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#include "../io/io.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

/* SUBROUTINE SLEEP(SECONDS)
   INTEGER, INTENT(IN) :: SECONDS
   
   A choice had to be made if SECONDS is negative. For g77, this is
   equivalent to SLEEP(0).  */

#ifdef HAVE_SLEEP
extern void sleep_i4_sub (GFC_INTEGER_4 *);
iexport_proto(sleep_i4_sub);

void
sleep_i4_sub (GFC_INTEGER_4 *seconds)
{
  sleep (*seconds < 0 ? 0 : (unsigned int) *seconds);
}
iexport(sleep_i4_sub);

extern void sleep_i8_sub (GFC_INTEGER_8 *);
iexport_proto(sleep_i8_sub);

void
sleep_i8_sub (GFC_INTEGER_8 *seconds)
{
  sleep (*seconds < 0 ? 0 : (unsigned int) *seconds);
}
iexport(sleep_i8_sub);
#endif

/* Implementation of the SYMLNK intrinsic.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#include <errno.h>

#include "../io/io.h"

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

/* SUBROUTINE SYMLNK(PATH1, PATH2, STATUS)
   CHARACTER(len=*), INTENT(IN) :: PATH1, PATH2
   INTEGER, INTENT(OUT), OPTIONAL :: STATUS  */

#ifdef HAVE_SYMLINK
extern void symlnk_i4_sub (char *, char *, GFC_INTEGER_4 *, gfc_charlen_type,
	                 gfc_charlen_type);
iexport_proto(symlnk_i4_sub);

void
symlnk_i4_sub (char *path1, char *path2, GFC_INTEGER_4 *status,
             gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = symlink (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(symlnk_i4_sub);

extern void symlnk_i8_sub (char *, char *, GFC_INTEGER_8 *, gfc_charlen_type,
	                 gfc_charlen_type);
iexport_proto(symlnk_i8_sub);

void
symlnk_i8_sub (char *path1, char *path2, GFC_INTEGER_8 *status,
             gfc_charlen_type path1_len, gfc_charlen_type path2_len)
{
  int val;
  char *str1, *str2;

  /* Trim trailing spaces from paths.  */
  while (path1_len > 0 && path1[path1_len - 1] == ' ')
    path1_len--;
  while (path2_len > 0 && path2[path2_len - 1] == ' ')
    path2_len--;

  /* Make a null terminated copy of the strings.  */
  str1 = gfc_alloca (path1_len + 1);
  memcpy (str1, path1, path1_len);
  str1[path1_len] = '\0'; 

  str2 = gfc_alloca (path2_len + 1);
  memcpy (str2, path2, path2_len);
  str2[path2_len] = '\0'; 

  val = symlink (str1, str2);

  if (status != NULL) 
    *status = (val == 0) ? 0 : errno;
}
iexport(symlnk_i8_sub);

extern GFC_INTEGER_4 symlnk_i4 (char *, char *, gfc_charlen_type,
	                      gfc_charlen_type);
export_proto(symlnk_i4);

GFC_INTEGER_4
symlnk_i4 (char *path1, char *path2, gfc_charlen_type path1_len,
         gfc_charlen_type path2_len)
{
  GFC_INTEGER_4 val;
  symlnk_i4_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}

extern GFC_INTEGER_8 symlnk_i8 (char *, char *, gfc_charlen_type,
	                      gfc_charlen_type);
export_proto(symlnk_i8);

GFC_INTEGER_8
symlnk_i8 (char *path1, char *path2, gfc_charlen_type path1_len,
	 gfc_charlen_type path2_len)
{
  GFC_INTEGER_8 val;
  symlnk_i8_sub (path1, path2, &val, path1_len, path2_len);
  return val;
}
#endif

/* Implementation of the TIME and TIME8 g77 intrinsics.
   Copyright (C) 2005 Free Software Foundation, Inc.
   Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>

This file is part of the GNU Fortran 95 runtime library (libgfortran).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.

In addition to the permissions in the GNU General Public License, the
Free Software Foundation gives you unlimited permission to link the
compiled version of this file into combinations with other programs,
and to distribute those combinations without any restriction coming
from the use of this file.  (The General Public License restrictions
do apply in other respects; for example, they cover modification of
the file, and distribution when not linked into a combine
executable.)

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public
License along with libgfortran; see the file COPYING.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include "libgfortran.h"

#ifdef TIME_WITH_SYS_TIME
#  include <sys/time.h>
#  include <time.h>
#else
#  if HAVE_SYS_TIME_H
#    include <sys/time.h>
#  else
#    ifdef HAVE_TIME_H
#      include <time.h>
#    endif
#  endif
#endif

#include "../io/io.h"


/* INTEGER(KIND=1) FUNCTION TIME()  */

#ifdef HAVE_TIME
extern GFC_INTEGER_4 time_func (void);
export_proto(time_func);

GFC_INTEGER_4
time_func (void)
{
  return (GFC_INTEGER_4) time (NULL);
}

/* INTEGER(KIND=2) FUNCTION TIME8()  */

extern GFC_INTEGER_8 time8_func (void);
export_proto(time8_func);

GFC_INTEGER_8
time8_func (void)
{
  return (GFC_INTEGER_8) time (NULL);
}
#endif

Follow-Ups:
- Re: [gfortran] PATCH implement g77 intrinsics
  - From: Steve Kargl
- Re: [gfortran] PATCH implement g77 intrinsics
  - From: Tobias Schlüter
- Re: [gfortran] PATCH implement g77 intrinsics
  - From: Feng Wang
- Re: [gfortran] PATCH implement g77 intrinsics
  - From: Steve Kargl
- Re: [gfortran] PATCH implement g77 intrinsics
  - From: Steve Kargl
- Re: [gfortran] PATCH implement g77 intrinsics
  - From: Richard Henderson

Index Nav:	[Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav:	[Date Prev] [Date Next]	[Thread Prev] [Thread Next]