From: Paul Brook <paul@codesourcery.com>
Date: Thu, 8 Jul 2004 19:42:26 +0000 (+0000)
Subject: intrinsic.c (add_sym_4s): New function.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=60c9a35baf5b40b1fc9f58fb4f033ed083355a87;p=gcc.git

intrinsic.c (add_sym_4s): New function.

	* intrinsic.c (add_sym_4s): New function.
	(add_subroutines): Change gfc_add_sym_? to gfc_add_sym_?s.

From-SVN: r84304
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad9aa2ca59b..baba7be46ed 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2004-07-08  Paul Brook  <paul@codesourcery.com>
+
+	* intrinsic.c (add_sym_4s): New function.
+	(add_subroutines): Change gfc_add_sym_? to gfc_add_sym_?s.
+
 2004-07-04  Janne Blomqvist  <jblomqvi@cc.hut.fi>
 	Paul Brook  <paul@codesourcery.com>
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 258843bad05..022f1044e8e 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -561,6 +561,33 @@ static void add_sym_4 (const char *name, int elemental, int actual_ok, bt type,
 }
 
 
+static void add_sym_4s (const char *name, int elemental, int actual_ok,
+    bt type, int kind,
+    try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
+    gfc_expr *(*simplify)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
+    void (*resolve)(gfc_code *),
+    const char* a1, bt type1, int kind1, int optional1,
+    const char* a2, bt type2, int kind2, int optional2,
+    const char* a3, bt type3, int kind3, int optional3,
+    const char* a4, bt type4, int kind4, int optional4)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f4 = check;
+  sf.f4 = simplify;
+  rf.s1 = resolve;
+
+  add_sym (name, elemental, actual_ok, type, kind, cf, sf, rf,
+	   a1, type1, kind1, optional1,
+	   a2, type2, kind2, optional2,
+	   a3, type3, kind3, optional3,
+	   a4, type4, kind4, optional4,
+	   (void*)0);
+}
+
+
 static void add_sym_5 (const char *name, int elemental, int actual_ok, bt type,
 		       int kind,
 		       try (*check)(gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *,gfc_expr *),
@@ -1729,10 +1756,10 @@ add_subroutines (void)
 	      gfc_check_second_sub, NULL, gfc_resolve_second_sub,
 	      tm, BT_REAL, dr, 0);
 
-  add_sym_4 ("date_and_time", 0, 1, BT_UNKNOWN, 0,
-	     gfc_check_date_and_time, NULL, NULL,
-	     dt, BT_CHARACTER, dc, 1, tm, BT_CHARACTER, dc, 1,
-	     zn, BT_CHARACTER, dc, 1, vl, BT_INTEGER, di, 1);
+  add_sym_4s ("date_and_time", 0, 1, BT_UNKNOWN, 0,
+	      gfc_check_date_and_time, NULL, NULL,
+	      dt, BT_CHARACTER, dc, 1, tm, BT_CHARACTER, dc, 1,
+	      zn, BT_CHARACTER, dc, 1, vl, BT_INTEGER, di, 1);
 
   /* More G77 compatibility garbage. */
   add_sym_2s ("etime", 0, 1, BT_UNKNOWN, 0,
@@ -1743,27 +1770,28 @@ add_subroutines (void)
 	     gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
 	     vl, BT_REAL, 4, 0, tm, BT_REAL, 4, 0);
 
-  add_sym_2 ("getarg", 0, 1, BT_UNKNOWN, 0,
-	     NULL, NULL, gfc_resolve_getarg,
-	     c, BT_INTEGER, di, 0, vl, BT_CHARACTER, dc, 0);
+  add_sym_2s ("getarg", 0, 1, BT_UNKNOWN, 0,
+	      NULL, NULL, gfc_resolve_getarg,
+	      c, BT_INTEGER, di, 0, vl, BT_CHARACTER, dc, 0);
 
   /* F2003 commandline routines.  */
 
   add_sym_3s ("get_command", 0, 1, BT_UNKNOWN, 0,
-	     NULL, NULL, gfc_resolve_get_command,
-	     com, BT_CHARACTER, dc, 1,
-	     length, BT_INTEGER, di, 1,
-	     st, BT_INTEGER, di, 1);
-
-  add_sym_4 ("get_command_argument", 0, 1, BT_UNKNOWN, 0,
-	     NULL, NULL, gfc_resolve_get_command_argument,
-	     num, BT_INTEGER, di, 0,
-	     val, BT_CHARACTER, dc, 1,
-	     length, BT_INTEGER, di, 1,
-	     st, BT_INTEGER, di, 1);
+	      NULL, NULL, gfc_resolve_get_command,
+	      com, BT_CHARACTER, dc, 1,
+	      length, BT_INTEGER, di, 1,
+	      st, BT_INTEGER, di, 1);
+
+  add_sym_4s ("get_command_argument", 0, 1, BT_UNKNOWN, 0,
+	      NULL, NULL, gfc_resolve_get_command_argument,
+	      num, BT_INTEGER, di, 0,
+	      val, BT_CHARACTER, dc, 1,
+	      length, BT_INTEGER, di, 1,
+	      st, BT_INTEGER, di, 1);
 	     
   /* Extension */
 
+  /* This needs changing to add_sym_5s if it gets a resolution function.  */
   add_sym_5 ("mvbits", 1, 1, BT_UNKNOWN, 0,
 	     gfc_check_mvbits, gfc_simplify_mvbits, NULL,
 	     f, BT_INTEGER, di, 0, fp, BT_INTEGER, di, 0,