aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog17
-rw-r--r--gcc/fortran/gfortran.h5
-rw-r--r--gcc/fortran/intrinsic.c100
-rw-r--r--gcc/fortran/intrinsic.h3
-rw-r--r--gcc/fortran/iresolve.c26
-rw-r--r--gcc/fortran/trans-intrinsic.c3
6 files changed, 103 insertions, 51 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 18cda16..85c4d23 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 09b8323..a633603 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 744ce38..4e68090 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 ef4fad5..cff8a53 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 24734ac..eef424f 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 396a3da..43e1e94 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;
generated by cgit v1.1 at 2025-05-28 06:34:01 +0000