From ab5619bc02bf3cd848c2d8162656e22184e20bc4 Mon Sep 17 00:00:00 2001
From: steven <steven@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Sat, 20 Nov 2004 01:44:49 +0000
Subject: 	* 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
---
 gcc/fortran/iresolve.c | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 75 insertions(+)

(limited to 'gcc/fortran/iresolve.c')

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)
 {
-- 
cgit v1.2.1