From 247981ce150940b26b7a62ef18cb4916e5cff676 Mon Sep 17 00:00:00 2001
From: fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri, 28 Oct 2005 21:16:17 +0000
Subject: 	* check.c (gfc_check_alarm_sub, gfc_check_signal, 
 gfc_check_signal_sub): New functions. 	* gfortran.h (gfc_generic_isym_id):
 Add GFC_ISYM_SIGNAL. 	* intrinsic.c (add_functions): Add signal intrinsic. 
 (add_subroutines): Add signal and alarm intrinsics. 	* intrinsic.texi:
 Document the new intrinsics. 	* iresolve.c (gfc_resolve_signal,
 gfc_resolve_alarm_sub, 	gfc_resolve_signal_sub): New functions. 
 * trans-intrinsic.c (gfc_conv_intrinsic_function): Add case 	for
 GFC_ISYM_SIGNAL. 	* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
 	gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal, 
 gfc_resolve_alarm_sub, gfc_resolve_signal_sub.

	* Makefile.am (intrinsics): Add signal.c.
	* Makefile.in: Regenerate.
	* configure.ac: Checks for signal and alarm.
	* config.h.in: Regenerate.
	* configure: Regenerate.
	* intrinsics/signal.c: New file for SIGNAL and ALARM intrinsics.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@105967 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/iresolve.c | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 83 insertions(+)

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

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 09d85e33974..ae55aa78e87 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1391,6 +1391,27 @@ gfc_resolve_sign (gfc_expr * f, gfc_expr * a, gfc_expr * b ATTRIBUTE_UNUSED)
 }
 
 
+void
+gfc_resolve_signal (gfc_expr * f, gfc_expr *number, gfc_expr *handler)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      if (handler->ts.kind != gfc_c_int_kind)
+	gfc_convert_type (handler, &f->ts, 2);
+      f->value.function.name = gfc_get_string (PREFIX("signal_func_int"));
+    }
+  else
+    f->value.function.name = gfc_get_string (PREFIX("signal_func"));
+
+  if (number->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (number, &f->ts, 2);
+}
+
+
 void
 gfc_resolve_sin (gfc_expr * f, gfc_expr * x)
 {
@@ -1700,6 +1721,37 @@ gfc_resolve_verify (gfc_expr * f, gfc_expr * string,
 
 /* Intrinsic subroutine resolution.  */
 
+void
+gfc_resolve_alarm_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_expr *seconds, *handler, *status;
+  gfc_typespec ts;
+
+  seconds = c->ext.actual->expr;
+  handler = c->ext.actual->next->expr;
+  status = c->ext.actual->next->next->expr;
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      if (handler->ts.kind != gfc_c_int_kind)
+	gfc_convert_type (handler, &ts, 2);
+      name = gfc_get_string (PREFIX("alarm_sub_int"));
+    }
+  else
+    name = gfc_get_string (PREFIX("alarm_sub"));
+
+  if (seconds->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (seconds, &ts, 2);
+  if (status != NULL && status->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (status, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
 void
 gfc_resolve_cpu_time (gfc_code * c ATTRIBUTE_UNUSED)
 {
@@ -1926,6 +1978,37 @@ gfc_resolve_get_environment_variable (gfc_code * code)
   code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
+void
+gfc_resolve_signal_sub (gfc_code * c)
+{
+  const char *name;
+  gfc_expr *number, *handler, *status;
+  gfc_typespec ts;
+
+  number = c->ext.actual->expr;
+  handler = c->ext.actual->next->expr;
+  status = c->ext.actual->next->next->expr;
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      if (handler->ts.kind != gfc_c_int_kind)
+	gfc_convert_type (handler, &ts, 2);
+      name = gfc_get_string (PREFIX("signal_sub_int"));
+    }
+  else
+    name = gfc_get_string (PREFIX("signal_sub"));
+
+  if (number->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (number, &ts, 2);
+  if (status != NULL && status->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (status, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
 /* Resolve the SYSTEM intrinsic subroutine.  */
 
 void
-- 
cgit v1.2.1