2004-12-02 Steven G. Kargl <kargls@comcast.net>

	Paul Brook  <paul@codesourcery.com>

libgfortran/
	* intrinsics/flush.c: New file.
	* intrinsics/fnum.c: ditto
	* intrinsics/stat.c: ditto
	* io/io.h (unit_to_fd): Add prototype.
	* io/unix.c (unit_to_fd): New function.
	* configure.ac: Add test for members of struct stat.  Check for
	sys/types.h and sys/stat.h
	* Makefile.am: Add intrinsics/{flush.c,fnum.c,stat.c}
	* configure.in: Regenerate.
	* config.h.in: Regenerate.
	* Makefile.in: Regenerate.
fortran/
	* check.c (gfc_check_flush, gfc_check_fnum): New functions.
	(gfc_check_fstat, gfc_check_fstat_sub): New functions.
	(gfc_check_stat, gfc_check_stat_sub): New functions.
	* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
	* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
	fstat, and stat to intrinsics symbol tables.
	* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
	(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
	* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
	(gfc_resolve_stat, gfc_resolve_flush): New functions.
	(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@91609 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 85 insertions, 0 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 0379d70132b..75168757fb7 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -553,6 +553,18 @@ gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
 
 void
+gfc_resolve_fnum (gfc_expr * f, gfc_expr * n)
+{
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  if (n->ts.kind != f->ts.kind)
+    gfc_convert_type (n, &f->ts, 2);
+  f->value.function.name = gfc_get_string (PREFIX("fnum_i%d"), f->ts.kind);
+}
+
+
+void
 gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
 {
 
@@ -1283,6 +1295,32 @@ gfc_resolve_sqrt (gfc_expr * f, gfc_expr * x)
 }
 
 
+/* Resolve the g77 compatibility function STAT AND FSTAT.  */
+
+void
+gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED,
+		  gfc_expr * a ATTRIBUTE_UNUSED)
+{
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX("stat_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_fstat (gfc_expr * f, gfc_expr * n, gfc_expr * a ATTRIBUTE_UNUSED)
+{
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  if (n->ts.kind != f->ts.kind)
+    gfc_convert_type (n, &f->ts, 2);
+
+  f->value.function.name = gfc_get_string (PREFIX("fstat_i%d"), f->ts.kind);
+}
+
+
 void
 gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 		 gfc_expr * mask)
@@ -1679,6 +1717,53 @@ gfc_resolve_exit (gfc_code * c)
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
+/* Resolve the FLUSH intrinsic subroutine.  */
+
+void
+gfc_resolve_flush (gfc_code * c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *n;
+
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_default_integer_kind;
+  n = c->ext.actual->expr;
+  if (n != NULL
+      && n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);
+
+  name = gfc_get_string (PREFIX("flush_i%d"), ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+/* Resolve the STAT and FSTAT intrinsic subroutines.  */
+
+void
+gfc_resolve_stat_sub (gfc_code * c)
+{
+  const char *name;
+
+  name = gfc_get_string (PREFIX("stat_i%d_sub"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fstat_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_expr *u;
+  gfc_typespec *ts;
+
+  u = c->ext.actual->expr;
+  ts = &c->ext.actual->next->expr->ts;
+  if (u->ts.kind != ts->kind)
+    gfc_convert_type (u, ts, 2);
+  name = gfc_get_string (PREFIX("fstat_i%d_sub"), ts->kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
 /* Resolve the UMASK intrinsic subroutine.  */
 
 void