Now that fixed sized modes are in place, simply comparing the mode of the result and operands is no longer enough to determine which built-in to use. It is necessary to compare precisions.
Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-low-reals.cc (a68_real_entier): Fix for non 64-bit targets. (a68_real_round): Likewise. (a68_real_pow): Likewise. gcc/testsuite/ChangeLog * algol68/execute/not-word-bits-1.a68: Fix for 32-bit targets. * algol68/execute/word-bits-shift-1.a68: Likewise. --- gcc/algol68/a68-low-reals.cc | 127 ++++++++---------- .../algol68/execute/not-word-bits-1.a68 | 21 ++- .../algol68/execute/word-bits-shift-1.a68 | 31 ++++- 3 files changed, 100 insertions(+), 79 deletions(-) diff --git a/gcc/algol68/a68-low-reals.cc b/gcc/algol68/a68-low-reals.cc index d184bfebf41..6754a90b1c9 100644 --- a/gcc/algol68/a68-low-reals.cc +++ b/gcc/algol68/a68-low-reals.cc @@ -381,54 +381,46 @@ a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode) { tree fn = NULL_TREE; tree to_type = CTYPE (to_mode); - - if (from_mode == M_REAL) + 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 (to_type == integer_type_node) + if (to_mode_prec == int_prec) fn = builtin_decl_explicit (BUILT_IN_IFLOORF); - else if (to_type == long_integer_type_node) + else if (to_mode_prec == long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LFLOORF); - else if (to_type == long_long_integer_type_node) + else if (to_mode_prec == long_long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LLFLOORF); else gcc_unreachable (); } - else if (from_mode == M_LONG_REAL) + else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_REAL))) { - if (to_type == integer_type_node) + if (to_mode_prec == int_prec) fn = builtin_decl_explicit (BUILT_IN_IFLOOR); - else if (to_type == long_integer_type_node) + else if (to_mode_prec == long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LFLOOR); - else if (to_type == long_long_integer_type_node) + else if (to_mode_prec == long_long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LLFLOOR); else gcc_unreachable (); } - else if (from_mode == M_LONG_LONG_REAL) + else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_LONG_REAL))) { - if (to_type == integer_type_node) + if (to_mode_prec == int_prec) fn = builtin_decl_explicit (BUILT_IN_IFLOORL); - else if (to_type == long_integer_type_node) + else if (to_mode_prec == long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LFLOORL); - else if (to_type == long_long_integer_type_node) + else if (to_mode_prec == long_long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LLFLOORL); else gcc_unreachable (); } - else if (from_mode == M_WORD_REAL) - { - if (to_type == integer_type_node) - fn = builtin_decl_explicit (BUILT_IN_IFLOOR); - else if (to_type == long_integer_type_node) - fn = builtin_decl_explicit (BUILT_IN_LFLOOR); - else if (to_type == long_long_integer_type_node) - fn = builtin_decl_explicit (BUILT_IN_LLFLOOR); - else if (to_type == a68_word_int_type) - /* XXX */ - fn = builtin_decl_explicit (BUILT_IN_LFLOOR); - else - gcc_unreachable (); - } else gcc_unreachable (); @@ -443,54 +435,46 @@ a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode) { tree fn = NULL_TREE; tree to_type = CTYPE (to_mode); - - if (from_mode == M_REAL) + 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 (to_type == integer_type_node) + if (to_mode_prec == int_prec) fn = builtin_decl_explicit (BUILT_IN_IROUNDF); - else if (to_type == long_integer_type_node) + else if (to_mode_prec == long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LROUNDF); - else if (to_type == long_long_integer_type_node) + else if (to_mode_prec == long_long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LLROUNDF); else gcc_unreachable (); } - else if (from_mode == M_LONG_REAL) + else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_REAL))) { - if (to_type == integer_type_node) + if (to_mode_prec == int_prec) fn = builtin_decl_explicit (BUILT_IN_IROUND); - else if (to_type == long_integer_type_node) + else if (to_mode_prec == long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LROUND); - else if (to_type == long_long_integer_type_node) + else if (to_mode_prec == long_long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LLROUND); else gcc_unreachable (); } - else if (from_mode == M_LONG_LONG_REAL) + else if (from_mode_prec == TYPE_PRECISION (CTYPE (M_LONG_LONG_REAL))) { - if (to_type == integer_type_node) + if (to_mode_prec == int_prec) fn = builtin_decl_explicit (BUILT_IN_IROUNDL); - else if (to_type == long_integer_type_node) + else if (to_mode_prec == long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LROUNDL); - else if (to_type == long_long_integer_type_node) + else if (to_mode_prec == long_long_int_prec) fn = builtin_decl_explicit (BUILT_IN_LLROUNDL); else gcc_unreachable (); } - else if (from_mode == M_WORD_REAL) - { - if (to_type == integer_type_node) - fn = builtin_decl_explicit (BUILT_IN_IROUND); - else if (to_type == long_integer_type_node) - fn = builtin_decl_explicit (BUILT_IN_LROUND); - else if (to_type == long_long_integer_type_node) - fn = builtin_decl_explicit (BUILT_IN_LLROUND); - else if (to_type == a68_word_int_type) - /* XXX */ - fn = builtin_decl_explicit (BUILT_IN_LROUND); - else - gcc_unreachable (); - } else gcc_unreachable (); @@ -601,27 +585,32 @@ 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)); + int b_mode_prec = TYPE_PRECISION (CTYPE (b_mode)); + + const int real_prec = TYPE_PRECISION (CTYPE (M_REAL)); + const int long_real_prec = TYPE_PRECISION (CTYPE (M_LONG_REAL)); + const int long_long_real_prec = TYPE_PRECISION (CTYPE (M_LONG_LONG_REAL)); + enum built_in_function built_in; - if (m == M_REAL) - { - gcc_assert (a_mode == M_REAL); - built_in = b_mode == M_REAL ? BUILT_IN_POWF : BUILT_IN_POWIF; - } - else if (m == M_LONG_REAL) + if (m_prec == real_prec) { - gcc_assert (a_mode == M_LONG_REAL); - built_in = b_mode == M_LONG_REAL ? BUILT_IN_POW : BUILT_IN_POWI; + gcc_assert (a_mode_prec == real_prec); + built_in + = (b_mode_prec == real_prec) ? BUILT_IN_POWF : BUILT_IN_POWIF; } - else if (m == M_LONG_LONG_REAL) + else if (m_prec == long_real_prec) { - gcc_assert (a_mode == M_LONG_LONG_REAL); - built_in = b_mode == M_LONG_LONG_REAL ? BUILT_IN_POWL : BUILT_IN_POWIL; + gcc_assert (a_mode_prec == long_real_prec); + built_in = + (b_mode_prec == long_real_prec) ? BUILT_IN_POW : BUILT_IN_POWI; } - else if (m == M_WORD_REAL) + else if (m_prec == long_long_real_prec) { - /* XXX */ - gcc_assert (a_mode == M_WORD_REAL); - built_in = b_mode == M_WORD_REAL ? BUILT_IN_POW : BUILT_IN_POWI; + gcc_assert (a_mode_prec == long_long_real_prec); + built_in + = (b_mode_prec == long_long_real_prec) ? BUILT_IN_POWL : BUILT_IN_POWIL; } else gcc_unreachable (); diff --git a/gcc/testsuite/algol68/execute/not-word-bits-1.a68 b/gcc/testsuite/algol68/execute/not-word-bits-1.a68 index d17930303ae..35182f88307 100644 --- a/gcc/testsuite/algol68/execute/not-word-bits-1.a68 +++ b/gcc/testsuite/algol68/execute/not-word-bits-1.a68 @@ -1,5 +1,18 @@ -begin word bits address = word 16rfff0ffff; - assert (NOT address = word 16rffffffff000f0000); - assert (~address = word 16rffffffff000f0000); - skip +begin + if word_bits_width = 64 + then + word bits address = word 16rfff0ffff; + assert ((NOT address AND word 16rffffffff) = word 16r000f0000); + assert ((~address AND word 16rffffffff) = word 16r000f0000) + elif word_bits_width = 32 + then word bits address = word 16rfff0ffff; + assert (NOT address = word 16r000f0000); + assert (~address = word 16r000f0000) + elif word_bits_width = 16 + then word bits address = word 16r0fff; + assert (NOT address = word 16rf000); + assert (~address = word 16rf000) + else + assert(false) + fi end diff --git a/gcc/testsuite/algol68/execute/word-bits-shift-1.a68 b/gcc/testsuite/algol68/execute/word-bits-shift-1.a68 index 91b543f3481..07646bdaeb4 100644 --- a/gcc/testsuite/algol68/execute/word-bits-shift-1.a68 +++ b/gcc/testsuite/algol68/execute/word-bits-shift-1.a68 @@ -1,7 +1,26 @@ -begin word bits address = word 16rfff0ffff; - assert (address SHL 4 = word 16rfff0ffff0); - assert (address UP 4 = word 16rfff0ffff0); - assert (address SHR 4 = word 16rfff0fff); - assert (address DOWN 4 = word 16rfff0fff); - skip +{ Note that this test should not feature bits constants bigger than + the minimum supported size of pointer. This is because the compiler + will emit a compile-time error message. } + +begin if word_bits_width = 64 + then word bits address = word 16r00ff0ffff; + assert (address SHL 4 = word 16r0ff0ffff0); + assert (address UP 4 = word 16r0ff0ffff0); + assert (address SHR 4 = word 16r000ff0fff); + assert (address DOWN 4 = word 16r000ff0fff) + elif word_bits_width = 32 + then word bits address = word 16r0000ffff; + assert (address SHL 4 = word 16r000ffff0); + assert (address UP 4 = word 16r000ffff0); + assert (address SHR 4 = word 16r00000fff); + assert (address DOWN 4 = word 16r00000fff) + elif word_bits_width = 16 + then word bits address = word 16rfff0; + assert (address SHL 4 = word 16rff00); + assert (address UP 4 = word 16rff00); + assert (address SHR 4 = word 16r0fff); + assert (address DOWN 4 = word 16r0fff) + else + assert(false) + fi end -- 2.39.5
