summaryrefslogtreecommitdiff
path: root/gcc/fortran/iresolve.c
diff options
context:
space:
mode:
authorsteven <steven@138bc75d-0d04-0410-961f-82ee72b054a4>2004-11-20 01:44:49 +0000
committersteven <steven@138bc75d-0d04-0410-961f-82ee72b054a4>2004-11-20 01:44:49 +0000
commitab5619bc02bf3cd848c2d8162656e22184e20bc4 (patch)
treeb1ef78f610bfdcc13867c75b1e08219b8aa591c5 /gcc/fortran/iresolve.c
parentff8365c7a0369c879e6b69256d5c3b34cbaeb9e1 (diff)
downloadgcc-ab5619bc02bf3cd848c2d8162656e22184e20bc4.tar.gz
* check.c (gfc_check_getcwd_sub): Fix seg fault.
* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub, gfc_check_unlink,gfc_check_unlink_sub): New functions * gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols * intrinsic.c (add_functions,add_subroutines): Add umask, unlink, exit to intrinsics symbol tables. * intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit, gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask, gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub, gfc_resolve_unlink_sub): Add and sort prototypes. * iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit, gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions * trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols libgfortran/ * Makefile.am: Add intrinsics/{umask.c,unlink.c,exit.c} * Makefile.in: Regenerated * intrinsics/umask.c: New file * intrinsics/unlink.c: ditto * intrinsics/exit.c: ditto git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@90949 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/iresolve.c')
-rw-r--r--gcc/fortran/iresolve.c75
1 files changed, 75 insertions, 0 deletions
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index d6bbe268bff..0379d70132b 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1433,6 +1433,29 @@ gfc_resolve_ubound (gfc_expr * f, gfc_expr * array,
}
+/* Resolve the g77 compatibility function UMASK. */
+
+void
+gfc_resolve_umask (gfc_expr * f, gfc_expr * n)
+{
+
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = n->ts.kind;
+ f->value.function.name = gfc_get_string (PREFIX("umask_i%d"), n->ts.kind);
+}
+
+
+/* Resolve the g77 compatibility function UNLINK. */
+
+void
+gfc_resolve_unlink (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
+{
+
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = 4;
+ f->value.function.name = gfc_get_string (PREFIX("unlink"));
+}
+
void
gfc_resolve_unpack (gfc_expr * f, gfc_expr * vector, gfc_expr * mask,
gfc_expr * field ATTRIBUTE_UNUSED)
@@ -1639,6 +1662,58 @@ gfc_resolve_system_clock (gfc_code * c)
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
+/* Resolve the EXIT intrinsic subroutine. */
+
+void
+gfc_resolve_exit (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->expr != NULL)
+ kind = c->ext.actual->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("exit_i%d"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+/* Resolve the UMASK intrinsic subroutine. */
+
+void
+gfc_resolve_umask_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->expr != NULL)
+ kind = c->ext.actual->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("umask_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+/* Resolve the UNLINK intrinsic subroutine. */
+
+void
+gfc_resolve_unlink_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->expr != NULL)
+ kind = c->ext.actual->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("unlink_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
void
gfc_iresolve_init_1 (void)
{