diff options
Diffstat (limited to 'gcc/fortran/trans-intrinsic.cc')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 176 |
1 files changed, 176 insertions, 0 deletions
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index b6ea26e..e0f86b1 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -10376,6 +10376,178 @@ conv_intrinsic_ieee_minmax (gfc_se * se, gfc_expr * expr, int max, } +/* Generate code for comparison functions IEEE_QUIET_* and + IEEE_SIGNALING_*. */ + +static void +conv_intrinsic_ieee_comparison (gfc_se * se, gfc_expr * expr, int signaling, + const char *name) +{ + tree args[2]; + tree arg1, arg2, res; + + /* Evaluate arguments only once. */ + conv_ieee_function_args (se, expr, args, 2); + arg1 = gfc_evaluate_now (args[0], &se->pre); + arg2 = gfc_evaluate_now (args[1], &se->pre); + + if (startswith (name, "eq")) + { + if (signaling) + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISEQSIG), + 2, arg1, arg2); + else + res = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, + arg1, arg2); + } + else if (startswith (name, "ne")) + { + if (signaling) + { + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISEQSIG), + 2, arg1, arg2); + res = fold_build1_loc (input_location, TRUTH_NOT_EXPR, + logical_type_node, res); + } + else + res = fold_build2_loc (input_location, NE_EXPR, logical_type_node, + arg1, arg2); + } + else if (startswith (name, "ge")) + { + if (signaling) + res = fold_build2_loc (input_location, GE_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISGREATEREQUAL), + 2, arg1, arg2); + } + else if (startswith (name, "gt")) + { + if (signaling) + res = fold_build2_loc (input_location, GT_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISGREATER), + 2, arg1, arg2); + } + else if (startswith (name, "le")) + { + if (signaling) + res = fold_build2_loc (input_location, LE_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISLESSEQUAL), + 2, arg1, arg2); + } + else if (startswith (name, "lt")) + { + if (signaling) + res = fold_build2_loc (input_location, LT_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISLESS), + 2, arg1, arg2); + } + else + gcc_unreachable (); + + se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), res); +} + + +/* Generate code for comparison functions IEEE_QUIET_* and + IEEE_SIGNALING_*. */ + +static void +conv_intrinsic_ieee_comparison (gfc_se * se, gfc_expr * expr, int signaling, + const char *name) +{ + tree args[2]; + tree arg1, arg2, res; + + /* Evaluate arguments only once. */ + conv_ieee_function_args (se, expr, args, 2); + arg1 = gfc_evaluate_now (args[0], &se->pre); + arg2 = gfc_evaluate_now (args[1], &se->pre); + + if (startswith (name, "eq")) + { + if (signaling) + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISEQSIG), + 2, arg1, arg2); + else + res = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, + arg1, arg2); + } + else if (startswith (name, "ne")) + { + if (signaling) + { + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISEQSIG), + 2, arg1, arg2); + res = fold_build1_loc (input_location, TRUTH_NOT_EXPR, + logical_type_node, res); + } + else + res = fold_build2_loc (input_location, NE_EXPR, logical_type_node, + arg1, arg2); + } + else if (startswith (name, "ge")) + { + if (signaling) + res = fold_build2_loc (input_location, GE_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISGREATEREQUAL), + 2, arg1, arg2); + } + else if (startswith (name, "gt")) + { + if (signaling) + res = fold_build2_loc (input_location, GT_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISGREATER), + 2, arg1, arg2); + } + else if (startswith (name, "le")) + { + if (signaling) + res = fold_build2_loc (input_location, LE_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISLESSEQUAL), + 2, arg1, arg2); + } + else if (startswith (name, "lt")) + { + if (signaling) + res = fold_build2_loc (input_location, LT_EXPR, logical_type_node, + arg1, arg2); + else + res = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISLESS), + 2, arg1, arg2); + } + else + gcc_unreachable (); + + se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), res); +} + + /* Generate code for an intrinsic function from the IEEE_ARITHMETIC module. */ @@ -10418,6 +10590,10 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr) conv_intrinsic_ieee_minmax (se, expr, 0, name + 23); else if (startswith (name, "_gfortran_ieee_max_num_")) conv_intrinsic_ieee_minmax (se, expr, 1, name + 23); + else if (startswith (name, "_gfortran_ieee_quiet_")) + conv_intrinsic_ieee_comparison (se, expr, 0, name + 21); + else if (startswith (name, "_gfortran_ieee_signaling_")) + conv_intrinsic_ieee_comparison (se, expr, 1, name + 25); else /* It is not among the functions we translate directly. We return false, so a library function call is emitted. */ |