2004-08-29 Steven G. Kargl <kargls@comcast.net>

	Paul Brook  <paul@codesourcery.com>

	* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_GET?ID.
	(gfc_check_f, gfc_simplify_f): Add f0.
	* intrinsic.c (do_check): Call f0.  Flatten.
	(add_sym_0): Fix prototype.  Set f0.
	(add_functions): Add getgid, getgid and getuid.
	(resolve_intrinsic): Remove obsolete comment.
	(do_simplify): Call f0.
	* intrinsic.h (gfc_resolve_getgid, gfc_resolve_getpid,
	gfc_resolve_getuid): Add prototypes.
	* iresolve.c (gfc_resolve_getgid, gfc_resolve_getpid,
	gfc_resolve_getuid): New functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Handle
	GFC_ISYM_GET?ID.
libgfortran/
	* Makefile.am: Add intrinsics/getXid.c.
	* configure.ac: Add tests for get{g,p,u}id.
	* config.h.in: Regenerate.
	* Makefile.in: Regenerate.
	* configure: Regenerate.


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

6 files changed, 103 insertions, 51 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 18cda167417..85c4d23b06e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2004-08-29  Steven G. Kargl  <kargls@comcast.net>
+	Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_GET?ID.
+	(gfc_check_f, gfc_simplify_f): Add f0.
+	* intrinsic.c (do_check): Call f0.  Flatten.
+	(add_sym_0): Fix prototype.  Set f0.
+	(add_functions): Add getgid, getgid and getuid.
+	(resolve_intrinsic): Remove obsolete comment.
+	(do_simplify): Call f0.
+	* intrinsic.h (gfc_resolve_getgid, gfc_resolve_getpid,
+	gfc_resolve_getuid): Add prototypes.
+	* iresolve.c (gfc_resolve_getgid, gfc_resolve_getpid,
+	gfc_resolve_getuid): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Handle
+	GFC_ISYM_GET?ID.
+
 2004-08-28  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* error.c (gfc_error_init_1): Remove blank line in front of
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 09b832370f4..a6336037536 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -306,6 +306,9 @@ enum gfc_generic_isym_id
   GFC_ISYM_EXPONENT,
   GFC_ISYM_FLOOR,
   GFC_ISYM_FRACTION,
+  GFC_ISYM_GETGID,
+  GFC_ISYM_GETPID,
+  GFC_ISYM_GETUID,
   GFC_ISYM_IACHAR,
   GFC_ISYM_IAND,
   GFC_ISYM_IARGC,
@@ -918,6 +921,7 @@ gfc_intrinsic_arg;
 
 typedef union
 {
+  try (*f0)(void);
   try (*f1)(struct gfc_expr *);
   try (*f1m)(gfc_actual_arglist *);
   try (*f2)(struct gfc_expr *, struct gfc_expr *);
@@ -937,6 +941,7 @@ gfc_check_f;
 
 typedef union
 {
+  struct gfc_expr *(*f0)(void);
   struct gfc_expr *(*f1)(struct gfc_expr *);
   struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
   struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 744ce387fd2..4e680907f78 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -153,51 +153,36 @@ static try
 do_check (gfc_intrinsic_sym * specific, gfc_actual_arglist * arg)
 {
   gfc_expr *a1, *a2, *a3, *a4, *a5;
-  try t;
+
+  if (arg == NULL)
+    return (*specific->check.f0) ();
 
   a1 = arg->expr;
   arg = arg->next;
-
   if (arg == NULL)
-    t = (*specific->check.f1) (a1);
-  else
-    {
-      a2 = arg->expr;
-      arg = arg->next;
+    return (*specific->check.f1) (a1);
 
-      if (arg == NULL)
-	t = (*specific->check.f2) (a1, a2);
-      else
-	{
-	  a3 = arg->expr;
-	  arg = arg->next;
+  a2 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f2) (a1, a2);
 
-	  if (arg == NULL)
-	    t = (*specific->check.f3) (a1, a2, a3);
-	  else
-	    {
-	      a4 = arg->expr;
-	      arg = arg->next;
+  a3 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f3) (a1, a2, a3);
 
-	      if (arg == NULL)
-		t = (*specific->check.f4) (a1, a2, a3, a4);
-	      else
-		{
-		  a5 = arg->expr;
-		  arg = arg->next;
+  a4 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f4) (a1, a2, a3, a4);
 
-		  if (arg == NULL)
-		    t = (*specific->check.f5) (a1, a2, a3, a4, a5);
-		  else
-		    {
-		      gfc_internal_error ("do_check(): too many args");
-		    }
-		}
-	    }
-	}
-    }
+  a5 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f5) (a1, a2, a3, a4, a5);
 
-  return t;
+  gfc_internal_error ("do_check(): too many args");
 }
 
 
@@ -307,17 +292,17 @@ add_sym (const char *name, int elemental, int actual_ok ATTRIBUTE_UNUSED,
 
 static void add_sym_0 (const char *name, int elemental, int actual_ok, bt type,
 		       int kind,
-		       try (*check)(gfc_expr *),
-		       gfc_expr *(*simplify)(gfc_expr *),
-		       void (*resolve)(gfc_expr *,gfc_expr *)
+		       try (*check)(void),
+		       gfc_expr *(*simplify)(void),
+		       void (*resolve)(gfc_expr *)
 		       ) {
   gfc_simplify_f sf;
   gfc_check_f cf;
   gfc_resolve_f rf;
 
-  cf.f1 = check;
-  sf.f1 = simplify;
-  rf.f1 = resolve;
+  cf.f0 = check;
+  sf.f0 = simplify;
+  rf.f0 = resolve;
 
   add_sym (name, elemental, actual_ok, type, kind, cf, sf, rf,
 	   (void*)0);
@@ -1172,6 +1157,16 @@ add_functions (void)
 
   make_generic ("fraction", GFC_ISYM_FRACTION);
 
+  /* Unix IDs (g77 compatibility)  */
+  add_sym_0 ("getgid", 1, 0, BT_INTEGER, di, NULL, NULL, gfc_resolve_getgid);
+  make_generic ("getgid", GFC_ISYM_GETGID);
+
+  add_sym_0 ("getpid", 1, 0, BT_INTEGER, di, NULL, NULL, gfc_resolve_getpid);
+  make_generic ("getpid", GFC_ISYM_GETPID);
+
+  add_sym_0 ("getuid", 1, 0, BT_INTEGER, di, NULL, NULL, gfc_resolve_getuid);
+  make_generic ("getuid", GFC_ISYM_GETUID);
+
   add_sym_1 ("huge", 0, 1, BT_REAL, dr,
 	     gfc_check_huge, gfc_simplify_huge, NULL,
 	     x, BT_UNKNOWN, dr, 0);
@@ -2273,15 +2268,6 @@ resolve_intrinsic (gfc_intrinsic_sym * specific, gfc_expr * e)
 
   arg = e->value.function.actual;
 
-  /* At present only the iargc extension intrinsic takes no arguments,
-     and it doesn't need a resolution function, but this is here for
-     generality.  */
-  if (arg == NULL)
-    {
-      (*specific->resolve.f0) (e);
-      return;
-    }
-
   /* Special case hacks for MIN and MAX.  */
   if (specific->resolve.f1m == gfc_resolve_max
       || specific->resolve.f1m == gfc_resolve_min)
@@ -2290,6 +2276,12 @@ resolve_intrinsic (gfc_intrinsic_sym * specific, gfc_expr * e)
       return;
     }
 
+  if (arg == NULL)
+    {
+      (*specific->resolve.f0) (e);
+      return;
+    }
+
   a1 = arg->expr;
   arg = arg->next;
 
@@ -2373,6 +2365,12 @@ do_simplify (gfc_intrinsic_sym * specific, gfc_expr * e)
 
   arg = e->value.function.actual;
 
+  if (arg == NULL)
+    {
+      result = (*specific->simplify.f0) ();
+      goto finish;
+    }
+
   a1 = arg->expr;
   arg = arg->next;
 
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index ef4fad57870..cff8a534da3 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -252,6 +252,9 @@ void gfc_resolve_exp (gfc_expr *, gfc_expr *);
 void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
 void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_fraction (gfc_expr *, gfc_expr *);
+void gfc_resolve_getgid (gfc_expr *);
+void gfc_resolve_getpid (gfc_expr *);
+void gfc_resolve_getuid (gfc_expr *);
 void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 24734ac251d..eef424f3fdb 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -545,6 +545,32 @@ gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
 
 
 void
+gfc_resolve_getgid (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX("getgid"));
+}
+
+
+void
+gfc_resolve_getpid (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX("getpid"));
+}
+
+
+void
+gfc_resolve_getuid (gfc_expr * f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX("getuid"));
+}
+
+void
 gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j ATTRIBUTE_UNUSED)
 {
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 396a3da6bb8..43e1e94e27f 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2925,6 +2925,9 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
     case GFC_ISYM_RAND:
     case GFC_ISYM_ETIME:
     case GFC_ISYM_SECOND:
+    case GFC_ISYM_GETGID:
+    case GFC_ISYM_GETPID:
+    case GFC_ISYM_GETUID:
       gfc_conv_intrinsic_funcall (se, expr);
       break;