[fortran] PR 37131, inline matmul

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9dab49e..1ccd93d 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2208,6 +2208,7 @@  gfc_resolve_fe_runtime_error (gfc_code *c)
     a->name = "%VAL";
 
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+  c->resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_FE_RUNTIME_ERROR);
 }
 
 void
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 1155481..bed8a1e 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -195,18 +195,14 @@  gfc_builtin_decl_for_float_kind (enum built_in_function double_built_in,
    generated code to be ignored.  */
 
 static void
-gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
-				  tree *argarray, int nargs)
+conv_intrinsic_procedure_args (gfc_se *se, gfc_intrinsic_arg *formal,
+			       gfc_actual_arglist *actual, tree *argarray,
+			       int nargs)
 {
-  gfc_actual_arglist *actual;
   gfc_expr *e;
-  gfc_intrinsic_arg  *formal;
   gfc_se argse;
   int curr_arg;
 
-  formal = expr->value.function.isym->formal;
-  actual = expr->value.function.actual;
-
    for (curr_arg = 0; curr_arg < nargs; curr_arg++,
 	actual = actual->next,
 	formal = formal ? formal->next : NULL)
@@ -248,16 +244,29 @@  gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
     }
 }
 
+
+static void
+gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
+				  tree *argarray, int nargs)
+{
+  gfc_actual_arglist *actual;
+  gfc_intrinsic_arg  *formal;
+
+  formal = expr->value.function.isym->formal;
+  actual = expr->value.function.actual;
+  conv_intrinsic_procedure_args (se, formal, actual, argarray, nargs);
+}
+
+
 /* Count the number of actual arguments to the intrinsic function EXPR
    including any "hidden" string length arguments.  */
 
 static unsigned int
-gfc_intrinsic_argument_list_length (gfc_expr *expr)
+intrinsic_argument_list_length (gfc_actual_arglist *actual)
 {
   int n = 0;
-  gfc_actual_arglist *actual;
 
-  for (actual = expr->value.function.actual; actual; actual = actual->next)
+  for (; actual; actual = actual->next)
     {
       if (!actual->expr)
 	continue;
@@ -272,6 +281,13 @@  gfc_intrinsic_argument_list_length (gfc_expr *expr)
 }
 
 
+static unsigned int
+gfc_intrinsic_argument_list_length (gfc_expr *expr)
+{
+  return intrinsic_argument_list_length (expr->value.function.actual);
+}
+
+
 /* Conversions between different types are output by the frontend as
    intrinsic functions.  We implement these directly with inline code.  */
 
@@ -837,17 +853,31 @@  gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
 /* Convert an intrinsic function into an external or builtin call.  */
 
 static void
-gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
+conv_intrinsic_lib_procedure (gfc_se * se, tree fndecl,
+			      gfc_intrinsic_arg * formal,
+			      gfc_actual_arglist * actual)
 {
-  gfc_intrinsic_map_t *m;
-  tree fndecl;
   tree rettype;
   tree *args;
   unsigned int num_args;
-  gfc_isym_id id;
 
-  id = expr->value.function.isym->id;
-  /* Find the entry for this function.  */
+  /* Get the decl and generate the call.  */
+  num_args = intrinsic_argument_list_length (actual);
+  args = XALLOCAVEC (tree, num_args);
+
+  conv_intrinsic_procedure_args (se, formal, actual, args, num_args);
+  rettype = TREE_TYPE (TREE_TYPE (fndecl));
+
+  fndecl = build_addr (fndecl, current_function_decl);
+  se->expr = build_call_array_loc (input_location, rettype, fndecl, num_args, args);
+}
+
+
+static gfc_intrinsic_map_t *
+find_intrinsic_map (enum gfc_isym_id id, const char *name)
+{
+  gfc_intrinsic_map_t *m;
+
   for (m = gfc_intrinsic_map;
        m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
     {
@@ -858,19 +888,32 @@  gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
   if (m->id == GFC_ISYM_NONE)
     {
       gfc_internal_error ("Intrinsic function %qs (%d) not recognized",
-			  expr->value.function.name, id);
+			  name, id);
     }
 
-  /* Get the decl and generate the call.  */
-  num_args = gfc_intrinsic_argument_list_length (expr);
-  args = XALLOCAVEC (tree, num_args);
+  return m;
+}
 
-  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+
+/* Convert an intrinsic function into an external or builtin call.  */
+
+static void
+gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
+{
+  gfc_intrinsic_map_t *m;
+  tree fndecl;
+  gfc_isym_id id;
+  gfc_intrinsic_arg *formal;
+  gfc_actual_arglist *actual;
+
+  id = expr->value.function.isym->id;
+  m = find_intrinsic_map (id, expr->value.function.name);
   fndecl = gfc_get_intrinsic_lib_fndecl (m, expr);
-  rettype = TREE_TYPE (TREE_TYPE (fndecl));
 
-  fndecl = build_addr (fndecl, current_function_decl);
-  se->expr = build_call_array_loc (input_location, rettype, fndecl, num_args, args);
+  formal = expr->value.function.isym->formal;
+  actual = expr->value.function.actual;
+
+  conv_intrinsic_lib_procedure (se, fndecl, formal, actual);
 }
 
 
@@ -9481,6 +9524,23 @@  conv_intrinsic_move_alloc (gfc_code *code)
 }
 
 
+static tree
+conv_intrinsic_runtime_error (gfc_code *c)
+{
+  stmtblock_t block;
+  gfc_se se;
+
+  gfc_start_block (&block);
+
+  gfc_init_se (&se, NULL);
+  conv_intrinsic_lib_procedure (&se, gfor_fndecl_runtime_error,
+				c->resolved_isym->formal,
+				c->ext.actual);
+
+  return gfc_finish_block (&block);
+}
+
+
 tree
 gfc_conv_intrinsic_subroutine (gfc_code *code)
 {
@@ -9531,6 +9591,10 @@  gfc_conv_intrinsic_subroutine (gfc_code *code)
       res = conv_co_collective (code);
       break;
 
+    case GFC_ISYM_FE_RUNTIME_ERROR:
+      res = conv_intrinsic_runtime_error (code);
+      break;
+
     case GFC_ISYM_SYSTEM_CLOCK:
       res = conv_intrinsic_system_clock (code);
       break;