https://gcc.gnu.org/g:8fde2beee78b5132ae8575ed2913fe21b57e0491
commit r17-5276-g8fde2beee78b5132ae8575ed2913fe21b57e0491 Author: Jose E. Marchesi <[email protected]> Date: Sat Oct 17 17:55:19 2026 +0200 a68: make fixed sized modes of standard types Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-lang.cc (a68_build_a68_type_nodes): Define fixed sized modes in terms of standard types. * a68-low-reals.cc (a68_real_pow): Dispatch builtins based on type equality rather than precision. (a68_real_round): Likewise. (a68_real_entier): Likewise. Diff: --- gcc/algol68/a68-lang.cc | 53 +++++++++++++++----- gcc/algol68/a68-low-reals.cc | 117 ++++++++++++++++++++++++------------------- 2 files changed, 106 insertions(+), 64 deletions(-) diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc index e80b274dbee8..cf39453f99f4 100644 --- a/gcc/algol68/a68-lang.cc +++ b/gcc/algol68/a68-lang.cc @@ -169,10 +169,6 @@ a68_build_a68_type_nodes (void) else a68_long_long_int_type = a68_long_int_type; - /* WORD INT */ - a68_word_int_type - = build_nonstandard_integer_type (POINTER_SIZE, 0); - /* SHORT SHORT BITS SHORT BITS BITS */ @@ -200,20 +196,11 @@ a68_build_a68_type_nodes (void) else a68_long_long_bits_type = a68_long_bits_type; - /* WORD BITS */ - a68_word_bits_type - = build_nonstandard_integer_type (POINTER_SIZE, 1); - /* BYTES LONG BYTES */ a68_bytes_type = unsigned_type_node; a68_long_bytes_type = long_unsigned_type_node; - - /* WORD BYTES */ - a68_word_bytes_type - = build_nonstandard_integer_type (POINTER_SIZE, 1); - /* REAL LONG REAL LONG LONG REAL */ @@ -221,6 +208,46 @@ a68_build_a68_type_nodes (void) a68_long_real_type = double_type_node; a68_long_long_real_type = long_double_type_node; + /* Please note that it is important for the fixed sized modes defined below + (like word int, word real, etc) to be defined in terms of standard types, + since there is code in the lowering pass that relies on that. */ + + /* WORD INT */ + if (TYPE_PRECISION (a68_int_type) == POINTER_SIZE) + a68_word_int_type = a68_int_type; + else if (TYPE_PRECISION (a68_long_int_type) == POINTER_SIZE) + a68_word_int_type = a68_long_int_type; + else if (TYPE_PRECISION (a68_long_long_int_type) == POINTER_SIZE) + a68_word_int_type = a68_long_long_int_type; + else if (TYPE_PRECISION (a68_short_int_type) == POINTER_SIZE) + a68_word_int_type = a68_short_int_type; + else if (TYPE_PRECISION (a68_short_short_int_type) == POINTER_SIZE) + a68_word_int_type = a68_short_short_int_type; + else + gcc_unreachable (); + + /* WORD BITS */ + if (TYPE_PRECISION (a68_bits_type) == POINTER_SIZE) + a68_word_bits_type = a68_bits_type; + else if (TYPE_PRECISION (a68_long_bits_type) == POINTER_SIZE) + a68_word_bits_type = a68_long_bits_type; + else if (TYPE_PRECISION (a68_long_long_bits_type) == POINTER_SIZE) + a68_word_bits_type = a68_long_long_bits_type; + else if (TYPE_PRECISION (a68_short_bits_type) == POINTER_SIZE) + a68_word_bits_type = a68_short_bits_type; + else if (TYPE_PRECISION (a68_short_short_bits_type) == POINTER_SIZE) + a68_word_bits_type = a68_short_short_bits_type; + else + gcc_unreachable (); + + /* WORD BYTES */ + if (TYPE_PRECISION (a68_bytes_type) == POINTER_SIZE) + a68_word_bytes_type = a68_bytes_type; + else if (TYPE_PRECISION (a68_long_bytes_type) == POINTER_SIZE) + a68_word_bytes_type = a68_long_bytes_type; + else + gcc_unreachable (); + /* WORD REAL */ if (TYPE_PRECISION (a68_real_type) == POINTER_SIZE) a68_word_real_type = a68_real_type; diff --git a/gcc/algol68/a68-low-reals.cc b/gcc/algol68/a68-low-reals.cc index b9596ce27eda..8f94567b0ee5 100644 --- a/gcc/algol68/a68-low-reals.cc +++ b/gcc/algol68/a68-low-reals.cc @@ -380,43 +380,38 @@ tree a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode) { tree fn = NULL_TREE; + tree from_type = CTYPE (from_mode); tree to_type = CTYPE (to_mode); - int from_mode_prec = TYPE_PRECISION (CTYPE (from_mode)); - int to_mode_prec = TYPE_PRECISION (to_type); - const int int_prec = TYPE_PRECISION (integer_type_node); - const int long_int_prec = TYPE_PRECISION (long_integer_type_node); - const int long_long_int_prec = TYPE_PRECISION (long_long_integer_type_node); - - if (from_mode_prec == TYPE_PRECISION (CTYPE (M_REAL))) + if (from_type == float_type_node) { - if (to_mode_prec == int_prec) + if (to_type == integer_type_node) fn = builtin_decl_explicit (BUILT_IN_IFLOORF); - else if (to_mode_prec == long_int_prec) + else if (to_type == long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LFLOORF); - else if (to_mode_prec == long_long_int_prec) + else if (to_type == long_long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LLFLOORF); else gcc_unreachable (); } - else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_REAL))) + else if (from_type == double_type_node) { - if (to_mode_prec == int_prec) + if (to_type == integer_type_node) fn = builtin_decl_explicit (BUILT_IN_IFLOOR); - else if (to_mode_prec == long_int_prec) + else if (to_type == long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LFLOOR); - else if (to_mode_prec == long_long_int_prec) + else if (to_type == long_long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LLFLOOR); else gcc_unreachable (); } - else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_LONG_REAL))) + else if (from_type == long_double_type_node) { - if (to_mode_prec == int_prec) + if (to_type == integer_type_node) fn = builtin_decl_explicit (BUILT_IN_IFLOORL); - else if (to_mode_prec == long_int_prec) + else if (to_type == long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LFLOORL); - else if (to_mode_prec == long_long_int_prec) + else if (to_type == long_long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LLFLOORL); else gcc_unreachable (); @@ -435,42 +430,37 @@ a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode) { tree fn = NULL_TREE; tree to_type = CTYPE (to_mode); - int from_mode_prec = TYPE_PRECISION (CTYPE (from_mode)); - int to_mode_prec = TYPE_PRECISION (to_type); - - const int int_prec = TYPE_PRECISION (integer_type_node); - const int long_int_prec = TYPE_PRECISION (long_integer_type_node); - const int long_long_int_prec = TYPE_PRECISION (long_long_integer_type_node); + tree from_type = CTYPE (from_mode); - if (from_mode_prec == TYPE_PRECISION (CTYPE (M_REAL))) + if (from_type == float_type_node) { - if (to_mode_prec == int_prec) + if (to_type == integer_type_node) fn = builtin_decl_explicit (BUILT_IN_IROUNDF); - else if (to_mode_prec == long_int_prec) + else if (to_type == long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LROUNDF); - else if (to_mode_prec == long_long_int_prec) + else if (to_type == long_long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LLROUNDF); else gcc_unreachable (); } - else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_REAL))) + else if (from_type == double_type_node) { - if (to_mode_prec == int_prec) + if (to_type == integer_type_node) fn = builtin_decl_explicit (BUILT_IN_IROUND); - else if (to_mode_prec == long_int_prec) + else if (to_type == long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LROUND); - else if (to_mode_prec == long_long_int_prec) + else if (to_type == long_long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LLROUND); else gcc_unreachable (); } - else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_LONG_REAL))) + else if (from_type == long_double_type_node) { - if (to_mode_prec == int_prec) + if (to_type == integer_type_node) fn = builtin_decl_explicit (BUILT_IN_IROUNDL); - else if (to_mode_prec == long_int_prec) + else if (to_type == long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LROUNDL); - else if (to_mode_prec == long_long_int_prec) + else if (to_type == long_long_integer_type_node) fn = builtin_decl_explicit (BUILT_IN_LLROUNDL); else gcc_unreachable (); @@ -585,30 +575,55 @@ tree a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode, tree a, tree b, location_t loc) { - int m_prec = TYPE_PRECISION (CTYPE (m)); - int a_mode_prec = TYPE_PRECISION (CTYPE (a_mode)); - - const int float_prec = TYPE_PRECISION (float_type_node); - const int double_prec = TYPE_PRECISION (double_type_node); - const int long_double_prec = TYPE_PRECISION (long_double_type_node); + tree m_type = CTYPE (m); + tree a_type = CTYPE (a_mode); + tree b_type = CTYPE (b_mode); enum built_in_function built_in; - if (m_prec == float_prec) + if (m_type == float_type_node) { - gcc_assert (a_mode_prec == float_prec); - built_in = IS_REAL (b_mode) ? BUILT_IN_POWF : BUILT_IN_POWIF; + gcc_assert (a_type == float_type_node); + if (IS_REAL (b_mode)) + { + gcc_assert (b_type == float_type_node); + built_in = BUILT_IN_POWF; + } + else + { + gcc_assert (b_type == integer_type_node); + built_in = BUILT_IN_POWIF; + } } - else if (m_prec == double_prec) + else if (m_type == double_type_node) { - gcc_assert (a_mode_prec == double_prec); - built_in = IS_REAL (b_mode) ? BUILT_IN_POW : BUILT_IN_POWI; + gcc_assert (a_type == double_type_node); + if (IS_REAL (b_mode)) + { + gcc_assert (b_type == double_type_node); + built_in = BUILT_IN_POW; + } + else + { + gcc_assert (b_type == integer_type_node); + built_in = BUILT_IN_POWI; + } } - else if (m_prec == long_double_prec) + else if (m_type == long_double_type_node) { - gcc_assert (a_mode_prec == long_double_prec); - built_in = IS_REAL (b_mode) ? BUILT_IN_POWL : BUILT_IN_POWIL; + gcc_assert (a_type == long_double_type_node); + if (IS_REAL (b_mode)) + { + gcc_assert (b_type == long_double_type_node); + built_in = BUILT_IN_POWL; + } + else + { + gcc_assert (b_type == integer_type_node); + built_in = BUILT_IN_POWIL; + } } else + /* XXX handle float16_type_node and bfloat16_type_node */ gcc_unreachable (); tree call = builtin_decl_explicit (built_in);
