intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG, LSTAT, MCLOCK and MCLOCK8 intrinsic functions.

	* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,
	LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
	(add_subroutines): Add LSTAT intrinsic subroutine.
	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
	GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
	and GFC_ISYM_MCLOCK8.
	* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
	gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
	gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
	* check.c (gfc_check_intconv): New function.
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
	the added GFC_ISYM_*.
	* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
	gfc_simplify_int8, gfc_simplify_long): New functions.
	* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
	gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
	gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
	gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
	Add prototypes.

	* gfortran.dg/mclock.f90: New test.
	* gfortran.dg/int_conv_1.f90: New test.
	* gfortran.dg/stat_1.f90: New test.
	* gfortran.dg/stat_2.f90: New test.

	* configure.ac: Check for function clock.
	* Makefile.am: Compile new file intrinsics/clock.c.
	* intrinsics/clock.c: New file.
	* Makefile.in: Regenerate.
	* configure: Regenerate.
	* config.h.in: Regenerate.
	* intrinsics/stat.c: Rename the old stat_i?_sub functions to
	helper functions stat_i?_sub_0, and use them for both STAT and
	LSTAT.

From-SVN: r115754

8 files changed, 232 insertions, 2 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7940ea5..e863f2d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,25 @@
+2006-07-26  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,
+	LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
+	(add_subroutines): Add LSTAT intrinsic subroutine.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
+	GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
+	and GFC_ISYM_MCLOCK8.
+	* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
+	gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
+	gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
+	* check.c (gfc_check_intconv): New function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
+	the added GFC_ISYM_*.
+	* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
+	gfc_simplify_int8, gfc_simplify_long): New functions.
+	* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
+	gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
+	gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
+	gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
+	Add prototypes.
+
 2006-07-24  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/28416
@@ -17,7 +39,7 @@
 
 2006-07-22  Steven Bosscher  <steven@gcc.gnu.org> 
 
-    PR fortran/28439
+	PR fortran/28439
 	* trans-stmt.c (gfc_trans_arithmetic_if): Evaluate the condition once.
 
 2006-07-16  Jakub Jelinek  <jakub@redhat.com>
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 1332c2b..4384fdb 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1200,6 +1200,16 @@ gfc_check_int (gfc_expr * x, gfc_expr * kind)
 
 
 try
+gfc_check_intconv (gfc_expr * x)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_ior (gfc_expr * i, gfc_expr * j)
 {
   if (type_check (i, 0, BT_INTEGER) == FAILURE)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 37d70f3..ba73d1d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -377,6 +377,8 @@ enum gfc_generic_isym_id
   GFC_ISYM_IERRNO,
   GFC_ISYM_INDEX,
   GFC_ISYM_INT,
+  GFC_ISYM_INT2,
+  GFC_ISYM_INT8,
   GFC_ISYM_IOR,
   GFC_ISYM_IRAND,
   GFC_ISYM_ISATTY,
@@ -391,15 +393,19 @@ enum gfc_generic_isym_id
   GFC_ISYM_LGT,
   GFC_ISYM_LLE,
   GFC_ISYM_LLT,
-  GFC_ISYM_LOG,
   GFC_ISYM_LOC,
+  GFC_ISYM_LOG,
   GFC_ISYM_LOG10,
   GFC_ISYM_LOGICAL,
+  GFC_ISYM_LONG,
+  GFC_ISYM_LSTAT,
   GFC_ISYM_MALLOC,
   GFC_ISYM_MATMUL,
   GFC_ISYM_MAX,
   GFC_ISYM_MAXLOC,
   GFC_ISYM_MAXVAL,
+  GFC_ISYM_MCLOCK,
+  GFC_ISYM_MCLOCK8,
   GFC_ISYM_MERGE,
   GFC_ISYM_MIN,
   GFC_ISYM_MINLOC,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 3ee0829..1b8e7cd 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1535,6 +1535,26 @@ add_functions (void)
 
   make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
 
+  add_sym_1 ("int2", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_alias ("short", GFC_STD_GNU);
+
+  make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
+
+  add_sym_1 ("int8", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
+
+  add_sym_1 ("long", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
+
   add_sym_2 ("ior", 1, 1, BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
@@ -1679,6 +1699,12 @@ add_functions (void)
 
   make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
 
+  add_sym_2 ("lstat", 0, 1, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_stat, NULL, gfc_resolve_lstat,
+	     a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
+
   add_sym_1 ("malloc", 0, 1, BT_INTEGER, ii, GFC_STD_GNU, gfc_check_malloc,
 	     NULL, gfc_resolve_malloc, a, BT_INTEGER, di, REQUIRED);
 
@@ -1739,6 +1765,16 @@ add_functions (void)
 
   make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
 
+  add_sym_0 ("mclock", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+	     NULL, NULL, gfc_resolve_mclock);
+
+  make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
+
+  add_sym_0 ("mclock8", 1, 0, BT_INTEGER, di, GFC_STD_GNU,
+	     NULL, NULL, gfc_resolve_mclock8);
+
+  make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
+
   add_sym_3 ("merge", 1, 1, BT_REAL, dr, GFC_STD_F95,
 	     gfc_check_merge, NULL, gfc_resolve_merge,
 	     ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
@@ -2410,6 +2446,11 @@ add_subroutines (void)
 	      ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
 	      st, BT_INTEGER, di, OPTIONAL);
 
+  add_sym_3s ("lstat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
+	      name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
+	      st, BT_INTEGER, di, OPTIONAL);
+
   add_sym_3s ("stat", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
 	      name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 63e0ff0..e2a81c8 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -74,6 +74,7 @@ try gfc_check_idnint (gfc_expr *);
 try gfc_check_ieor (gfc_expr *, gfc_expr *);
 try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_int (gfc_expr *, gfc_expr *);
+try gfc_check_intconv (gfc_expr *);
 try gfc_check_ior (gfc_expr *, gfc_expr *);
 try gfc_check_irand (gfc_expr *);
 try gfc_check_isatty (gfc_expr *);
@@ -222,6 +223,9 @@ gfc_expr *gfc_simplify_ichar (gfc_expr *);
 gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_int2 (gfc_expr *);
+gfc_expr *gfc_simplify_int8 (gfc_expr *);
+gfc_expr *gfc_simplify_long (gfc_expr *);
 gfc_expr *gfc_simplify_ifix (gfc_expr *);
 gfc_expr *gfc_simplify_idint (gfc_expr *);
 gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
@@ -352,6 +356,9 @@ void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ichar (gfc_expr *, gfc_expr *);
 void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
 void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_int2 (gfc_expr *, gfc_expr *);
+void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
+void gfc_resolve_long (gfc_expr *, gfc_expr *);
 void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_isatty (gfc_expr *, gfc_expr *);
 void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *);
@@ -365,11 +372,14 @@ void gfc_resolve_loc (gfc_expr *, gfc_expr *);
 void gfc_resolve_log (gfc_expr *, gfc_expr *);
 void gfc_resolve_log10 (gfc_expr *, gfc_expr *);
 void gfc_resolve_logical (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lstat (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_malloc (gfc_expr *, gfc_expr *);
 void gfc_resolve_matmul (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_max (gfc_expr *, gfc_actual_arglist *);
 void gfc_resolve_maxloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_maxval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_mclock (gfc_expr *);
+void gfc_resolve_mclock8 (gfc_expr *);
 void gfc_resolve_merge (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_min (gfc_expr *, gfc_actual_arglist *);
 void gfc_resolve_minloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -448,6 +458,7 @@ void gfc_resolve_get_environment_variable (gfc_code *);
 void gfc_resolve_hostnm_sub (gfc_code *);
 void gfc_resolve_idate (gfc_code *);
 void gfc_resolve_itime (gfc_code *);
+void gfc_resolve_lstat_sub (gfc_code *);
 void gfc_resolve_kill_sub (gfc_code *);
 void gfc_resolve_mvbits (gfc_code *);
 void gfc_resolve_perror (gfc_code *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 3eeebc7..a65992e 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -854,6 +854,42 @@ gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
 
 
 void
+gfc_resolve_int2 (gfc_expr * f, gfc_expr * a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 2;
+
+  f->value.function.name =
+    gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type),
+		    a->ts.kind);
+}
+
+
+void
+gfc_resolve_int8 (gfc_expr * f, gfc_expr * a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+
+  f->value.function.name =
+    gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type),
+		    a->ts.kind);
+}
+
+
+void
+gfc_resolve_long (gfc_expr * f, gfc_expr * a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+
+  f->value.function.name =
+    gfc_get_string ("__int_%d_%c%d", f->ts.kind, gfc_type_letter (a->ts.type),
+		    a->ts.kind);
+}
+
+
+void
 gfc_resolve_isatty (gfc_expr * f, gfc_expr * u)
 {
   gfc_typespec ts;
@@ -1191,6 +1227,24 @@ gfc_resolve_maxval (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
 
 
 void
+gfc_resolve_mclock (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = PREFIX("mclock");
+}
+
+
+void
+gfc_resolve_mclock8 (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name = PREFIX("mclock8");
+}
+
+
+void
 gfc_resolve_merge (gfc_expr * f, gfc_expr * tsource,
 		   gfc_expr * fsource ATTRIBUTE_UNUSED,
 		   gfc_expr * mask ATTRIBUTE_UNUSED)
@@ -1804,6 +1858,16 @@ gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED,
 
 
 void
+gfc_resolve_lstat (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("lstat_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;
@@ -2656,6 +2720,16 @@ gfc_resolve_stat_sub (gfc_code * c)
 
 
 void
+gfc_resolve_lstat_sub (gfc_code * c)
+{
+  const char *name;
+
+  name = gfc_get_string (PREFIX("lstat_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;
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index b77537c..8a7d79b 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -1610,6 +1610,66 @@ gfc_simplify_int (gfc_expr * e, gfc_expr * k)
 }
 
 
+static gfc_expr *
+gfc_simplify_intconv (gfc_expr * e, int kind, const char *name)
+{
+  gfc_expr *rpart, *rtrunc, *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_constant_result (BT_INTEGER, kind, &e->where);
+
+  switch (e->ts.type)
+    {
+    case BT_INTEGER:
+      mpz_set (result->value.integer, e->value.integer);
+      break;
+
+    case BT_REAL:
+      rtrunc = gfc_copy_expr (e);
+      mpfr_trunc (rtrunc->value.real, e->value.real);
+      gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real);
+      gfc_free_expr (rtrunc);
+      break;
+
+    case BT_COMPLEX:
+      rpart = gfc_complex2real (e, kind);
+      rtrunc = gfc_copy_expr (rpart);
+      mpfr_trunc (rtrunc->value.real, rpart->value.real);
+      gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real);
+      gfc_free_expr (rpart);
+      gfc_free_expr (rtrunc);
+      break;
+
+    default:
+      gfc_error ("Argument of %s at %L is not a valid type", name, &e->where);
+      gfc_free_expr (result);
+      return &gfc_bad_expr;
+    }
+
+  return range_check (result, name);
+}
+
+gfc_expr *
+gfc_simplify_int2 (gfc_expr * e)
+{
+  return gfc_simplify_intconv (e, 2, "INT2");
+}
+
+gfc_expr *
+gfc_simplify_int8 (gfc_expr * e)
+{
+  return gfc_simplify_intconv (e, 8, "INT8");
+}
+
+gfc_expr *
+gfc_simplify_long (gfc_expr * e)
+{
+  return gfc_simplify_intconv (e, 4, "LONG");
+}
+
+
 gfc_expr *
 gfc_simplify_ifix (gfc_expr * e)
 {
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index b23fc5f..472d982d9 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3477,6 +3477,9 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       /* Integer conversions are handled separately to make sure we get the
          correct rounding mode.  */
     case GFC_ISYM_INT:
+    case GFC_ISYM_INT2:
+    case GFC_ISYM_INT8:
+    case GFC_ISYM_LONG:
       gfc_conv_intrinsic_int (se, expr, FIX_TRUNC_EXPR);
       break;
 
@@ -3732,8 +3735,11 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_IRAND:
     case GFC_ISYM_ISATTY:
     case GFC_ISYM_LINK:
+    case GFC_ISYM_LSTAT:
     case GFC_ISYM_MALLOC:
     case GFC_ISYM_MATMUL:
+    case GFC_ISYM_MCLOCK:
+    case GFC_ISYM_MCLOCK8:
     case GFC_ISYM_RAND:
     case GFC_ISYM_RENAME:
     case GFC_ISYM_SECOND: