[PATCH 1/7] fortran: new abstract class gfc_dummy_arg

[Mikael Morin <mikael@gcc.gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1089 bytes --]


Introduce a new abstract class gfc_dummy_arg that provides a common
interface to both dummy arguments of user-defined procedures (which
have type gfc_formal_arglist) and dummy arguments of intrinsic procedures
(which have type gfc_intrinsic_arg).

gcc/fortran/
	* gfortran.h (gfc_dummy_arg): New.
	(gfc_formal_arglist, gfc_intrinsic_arg): Inherit gfc_dummy_arg.
	(gfc_get_formal_arglist, gfc_get_intrinsic_arg): Call constructor.
	* intrinsic.c (gfc_intrinsic_init_1): Merge the memory area of
	conversion intrinsics with that of regular function and
	subroutine intrinsics.
	Use a separate memory area for arguments.
	(add_sym, gfc_intrinsic_init_1): Don’t do pointer arithmetics
	with next_arg.
	(add_sym, make_alias, add_conv,
	add_char_conversions, gfc_intrinsic_init_1): Call constructor
	before filling object data.
	* resolve.c (resolve_select_type): Same.
---
 gcc/fortran/gfortran.h  | 22 ++++++++++++++-------
 gcc/fortran/intrinsic.c | 44 ++++++++++++++++++++++-------------------
 gcc/fortran/resolve.c   | 10 ++++++----
 3 files changed, 45 insertions(+), 31 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-fortran-new-abstract-class-gfc_dummy_arg.patch --]
[-- Type: text/x-patch; name="0001-fortran-new-abstract-class-gfc_dummy_arg.patch", Size: 6343 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 921aed93dc3..031e46d1457 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1131,17 +1131,25 @@ gfc_component;
 
 #define gfc_get_component() XCNEW (gfc_component)
 
+
+/* dummy arg of either an intrinsic or a user-defined procedure.  */
+class gfc_dummy_arg
+{
+};
+
+
 /* Formal argument lists are lists of symbols.  */
-typedef struct gfc_formal_arglist
+struct gfc_formal_arglist : public gfc_dummy_arg
 {
   /* Symbol representing the argument at this position in the arglist.  */
   struct gfc_symbol *sym;
   /* Points to the next formal argument.  */
   struct gfc_formal_arglist *next;
-}
-gfc_formal_arglist;
+};
+
+#define GFC_NEW(T) new (XCNEW (T)) T
 
-#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
+#define gfc_get_formal_arglist() GFC_NEW (gfc_formal_arglist)
 
 
 /* The gfc_actual_arglist structure is for actual arguments and
@@ -2159,7 +2167,7 @@ gfc_ref;
 
 
 /* Structures representing intrinsic symbols and their arguments lists.  */
-typedef struct gfc_intrinsic_arg
+struct gfc_intrinsic_arg : public gfc_dummy_arg
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
 
@@ -2169,9 +2177,9 @@ typedef struct gfc_intrinsic_arg
   gfc_actual_arglist *actual;
 
   struct gfc_intrinsic_arg *next;
+};
 
-}
-gfc_intrinsic_arg;
+#define gfc_get_intrinsic_arg() GFC_NEW (gfc_intrinsic_arg)
 
 
 /* Specifies the various kinds of check functions used to verify the
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 219f04f2317..ba79eb3242b 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -376,6 +376,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
       break;
 
     case SZ_NOTHING:
+      next_sym = new (next_sym) gfc_intrinsic_sym;
       next_sym->name = gfc_get_string ("%s", name);
 
       strcpy (buf, "_gfortran_");
@@ -406,6 +407,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
   va_start (argp, resolve);
 
   first_flag = 1;
+  gfc_intrinsic_arg * previous_arg;
 
   for (;;)
     {
@@ -422,12 +424,12 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
 	nargs++;
       else
 	{
-	  next_arg++;
+	  next_arg = new (next_arg) gfc_intrinsic_arg;
 
 	  if (first_flag)
 	    next_sym->formal = next_arg;
 	  else
-	    (next_arg - 1)->next = next_arg;
+	    previous_arg->next = next_arg;
 
 	  first_flag = 0;
 
@@ -437,6 +439,9 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
 	  next_arg->optional = optional;
 	  next_arg->value = 0;
 	  next_arg->intent = intent;
+
+	  previous_arg = next_arg;
+	  next_arg++;
 	}
     }
 
@@ -1270,6 +1275,7 @@ make_alias (const char *name, int standard)
       break;
 
     case SZ_NOTHING:
+      next_sym = new (next_sym) gfc_intrinsic_sym;
       next_sym[0] = next_sym[-1];
       next_sym->name = gfc_get_string ("%s", name);
       next_sym->standard = standard;
@@ -3991,7 +3997,7 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
   to.type = to_type;
   to.kind = to_kind;
 
-  sym = conversion + nconv;
+  sym = new (conversion + nconv) gfc_intrinsic_sym;
 
   sym->name = conv_name (&from, &to);
   sym->lib_name = sym->name;
@@ -4167,15 +4173,17 @@ add_char_conversions (void)
 	to.type = BT_CHARACTER;
 	to.kind = gfc_character_kinds[j].kind;
 
-	char_conversions[n].name = conv_name (&from, &to);
-	char_conversions[n].lib_name = char_conversions[n].name;
-	char_conversions[n].simplify.cc = gfc_convert_char_constant;
-	char_conversions[n].standard = GFC_STD_F2003;
-	char_conversions[n].elemental = 1;
-	char_conversions[n].pure = 1;
-	char_conversions[n].conversion = 0;
-	char_conversions[n].ts = to;
-	char_conversions[n].id = GFC_ISYM_CONVERSION;
+	gfc_intrinsic_sym *current_conv;
+	current_conv = new (&char_conversions[n]) gfc_intrinsic_sym;
+	current_conv->name = conv_name (&from, &to);
+	current_conv->lib_name = char_conversions[n].name;
+	current_conv->simplify.cc = gfc_convert_char_constant;
+	current_conv->standard = GFC_STD_F2003;
+	current_conv->elemental = 1;
+	current_conv->pure = 1;
+	current_conv->conversion = 0;
+	current_conv->ts = to;
+	current_conv->id = GFC_ISYM_CONVERSION;
 
 	n++;
       }
@@ -4198,16 +4206,13 @@ gfc_intrinsic_init_1 (void)
   sizing = SZ_CONVS;
   add_conversions ();
 
-  functions = XCNEWVAR (struct gfc_intrinsic_sym,
-			sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
-			+ sizeof (gfc_intrinsic_arg) * nargs);
+  next_sym = XCNEWVEC (struct gfc_intrinsic_sym, nfunc + nsub + nconv);
 
-  next_sym = functions;
+  functions = next_sym;
   subroutines = functions + nfunc;
+  conversion = subroutines + nsub;
 
-  conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
-
-  next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
+  next_arg = XCNEWVEC (gfc_intrinsic_arg, nargs);
 
   sizing = SZ_NOTHING;
   nconv = 0;
@@ -4225,7 +4230,6 @@ void
 gfc_intrinsic_done_1 (void)
 {
   free (functions);
-  free (conversion);
   free (char_conversions);
   gfc_free_namespace (gfc_intrinsic_namespace);
 }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad387ac..8f13582e4b4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9676,10 +9676,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	  new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st);
 	  new_st->expr1->value.function.actual->next->expr->where = code->loc;
 	  /* Set up types in formal arg list.  */
-	  new_st->expr1->value.function.isym->formal = XCNEW (gfc_intrinsic_arg);
-	  new_st->expr1->value.function.isym->formal->ts = new_st->expr1->value.function.actual->expr->ts;
-	  new_st->expr1->value.function.isym->formal->next = XCNEW (gfc_intrinsic_arg);
-	  new_st->expr1->value.function.isym->formal->next->ts = new_st->expr1->value.function.actual->next->expr->ts;
+	  gfc_intrinsic_sym *e1_isym = new_st->expr1->value.function.isym;
+	  gfc_actual_arglist *e1_actual = new_st->expr1->value.function.actual;
+	  e1_isym->formal = gfc_get_intrinsic_arg ();
+	  e1_isym->formal->ts = e1_actual->expr->ts;
+	  e1_isym->formal->next = gfc_get_intrinsic_arg ();
+	  e1_isym->formal->next->ts = e1_actual->next->expr->ts;
 
 	  new_st->next = body->next;
 	}