https://gcc.gnu.org/g:4962345a370f5924e34d1b083b7cca0832fbb2d9
commit r17-4868-g4962345a370f5924e34d1b083b7cca0832fbb2d9 Author: Jose E. Marchesi <[email protected]> Date: Sun Sep 20 03:08:57 2026 +0200 a68: low: support for fixed sized modes Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-low-bits.cc (a68_get_bits_skip_tree): Handle fixed sized modes. * a68-low-prelude.cc (a68_lower_wordbitswidth): New function. (a68_lower_wordreali): Likewise. (a68_lower_wordinti): Likewise. * a68-low-units.cc (a68_lower_denotation): Likewise. * a68-low-reals.cc (a68_real_pow): Likewise. (a68_real_round): Likewise. (a68_real_entier): Likewise. (a68_get_real_skip_tree): Likewise. * a68-low-moids.cc (lower_standard_mode): Likewise. * a68-low-ints.cc (a68_get_int_skip_tree): Likewise. * a68-low-decls.cc: Likewise. * a68-low-complex.cc (a68_complex_widen_from_real): Likewise. * a68-low-coercions.cc: Likewise. (a68_lower_widening): Likewise. Diff: --- gcc/algol68/a68-low-bits.cc | 2 ++ gcc/algol68/a68-low-coercions.cc | 16 +++++++++------- gcc/algol68/a68-low-complex.cc | 2 ++ gcc/algol68/a68-low-decls.cc | 1 + gcc/algol68/a68-low-ints.cc | 2 ++ gcc/algol68/a68-low-moids.cc | 11 ++++++++++- gcc/algol68/a68-low-prelude.cc | 30 ++++++++++++++++++++++++++++++ gcc/algol68/a68-low-reals.cc | 39 +++++++++++++++++++++++++++++++++++++++ gcc/algol68/a68-low-units.cc | 28 +++++++++++++++++++++------- 9 files changed, 116 insertions(+), 15 deletions(-) diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc index 12b91cd66699..0809ad0b2871 100644 --- a/gcc/algol68/a68-low-bits.cc +++ b/gcc/algol68/a68-low-bits.cc @@ -59,6 +59,8 @@ a68_get_bits_skip_tree (MOID_T *m) type = a68_short_bits_type; else if (m == M_SHORT_SHORT_BITS) type = a68_short_short_bits_type; + else if (m == M_WORD_BITS) + type = a68_word_bits_type; else gcc_unreachable (); diff --git a/gcc/algol68/a68-low-coercions.cc b/gcc/algol68/a68-low-coercions.cc index 54079122880d..c5fe8c688187 100644 --- a/gcc/algol68/a68-low-coercions.cc +++ b/gcc/algol68/a68-low-coercions.cc @@ -315,30 +315,32 @@ a68_lower_rowing (NODE_T *p, LOW_CTX_T ctx) Widening allows the following conversions of mode: - LONGSETY INT to LONGSETY REAL - LONGSETY REAL to LONGSETY COMPL - LONGSETY BITS to []BOOL - LONGSETY BYTES to []CHAR */ + SIZETY INT to LONGSETY REAL + SIZETY REAL to LONGSETY COMPL + SIZETY BITS to []BOOL + SIZETY BYTES to []CHAR */ tree a68_lower_widening (NODE_T *p, LOW_CTX_T ctx) { if (MOID (p) == M_REAL || MOID (p) == M_LONG_REAL - || MOID (p) == M_LONG_LONG_REAL) + || MOID (p) == M_LONG_LONG_REAL + || MOID (p) == M_WORD_REAL) { return convert_to_real (CTYPE (MOID (p)), a68_lower_tree (SUB (p), ctx)); } if (MOID (p) == M_COMPLEX || MOID (p) == M_LONG_COMPLEX - || MOID (p) == M_LONG_LONG_COMPLEX) + || MOID (p) == M_LONG_LONG_COMPLEX + || MOID (p) == M_WORD_COMPLEX) { return a68_complex_widen_from_real (MOID (p), a68_lower_tree (SUB (p), ctx)); } else if (MOID (p) == M_ROW_BOOL) { - /* Widen a LONGSETY BITS to a row of BOOLs. */ + /* Widen a SIZETY BITS to a row of BOOLs. */ tree coercend = a68_lower_tree (SUB (p), ctx); tree coercend_type = TREE_TYPE (coercend); HOST_WIDE_INT bits_size = int_size_in_bytes (coercend_type); diff --git a/gcc/algol68/a68-low-complex.cc b/gcc/algol68/a68-low-complex.cc index aed1c3c3dab6..027ddc2a4a98 100644 --- a/gcc/algol68/a68-low-complex.cc +++ b/gcc/algol68/a68-low-complex.cc @@ -108,6 +108,8 @@ a68_complex_widen_from_real (MOID_T *mode, tree r) gcc_assert (TREE_TYPE (r) == a68_long_real_type); else if (mode == M_LONG_LONG_COMPLEX) gcc_assert (TREE_TYPE (r) == a68_long_long_real_type); + else if (mode == M_WORD_COMPLEX) + gcc_assert (TREE_TYPE (r) == a68_word_real_type); else gcc_unreachable (); diff --git a/gcc/algol68/a68-low-decls.cc b/gcc/algol68/a68-low-decls.cc index 606e5fdf5efd..a3ae61c6a10e 100644 --- a/gcc/algol68/a68-low-decls.cc +++ b/gcc/algol68/a68-low-decls.cc @@ -492,6 +492,7 @@ a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx) declarer : indicant; longety, indicant; shortety, indicant; + fixety, indicant; flex symbol, declarer; flex symbol, bounds, declarer; flex symbol, formal bounds, declarer; diff --git a/gcc/algol68/a68-low-ints.cc b/gcc/algol68/a68-low-ints.cc index 4bf97e9ebea4..3707e4d19913 100644 --- a/gcc/algol68/a68-low-ints.cc +++ b/gcc/algol68/a68-low-ints.cc @@ -59,6 +59,8 @@ a68_get_int_skip_tree (MOID_T *m) type = a68_short_int_type; else if (m == M_SHORT_SHORT_INT) type = a68_short_short_int_type; + else if (m == M_WORD_INT) + type = a68_word_int_type; else gcc_unreachable (); diff --git a/gcc/algol68/a68-low-moids.cc b/gcc/algol68/a68-low-moids.cc index 54c1a42863d9..d9d63b9741d3 100644 --- a/gcc/algol68/a68-low-moids.cc +++ b/gcc/algol68/a68-low-moids.cc @@ -190,7 +190,8 @@ lower_hip_mode (MOID_T *m) /* Lower a standard mode to a GENERIC tree. Note that this function only has to handle the standard modes that have not - been resolved to some equivalent. */ + been resolved to some equivalent. In particular, this excludes the complex + modes, for which equivalent modes are declared in a68-parser-prelude.cc. */ static tree lower_standard_mode (MOID_T *m) @@ -213,12 +214,16 @@ lower_standard_mode (MOID_T *m) type = a68_long_int_type; else if (m == M_LONG_LONG_INT) type = a68_long_long_int_type; + else if (m == M_WORD_INT) + type = a68_word_int_type; else if (m == M_REAL) type = a68_real_type; else if (m == M_LONG_REAL) type = a68_long_real_type; else if (m == M_LONG_LONG_REAL) type = a68_long_long_real_type; + else if (m == M_WORD_REAL) + type = a68_word_real_type; else if (m == M_SHORT_SHORT_BITS) type = a68_short_short_bits_type; else if (m == M_SHORT_BITS) @@ -229,10 +234,14 @@ lower_standard_mode (MOID_T *m) type = a68_long_bits_type; else if (m == M_LONG_LONG_BITS) type = a68_long_long_bits_type; + else if (m == M_WORD_BITS) + type = a68_word_bits_type; else if (m == M_BYTES) type = a68_bytes_type; else if (m == M_LONG_BYTES) type = a68_long_bytes_type; + else if (m == M_WORD_BYTES) + type = a68_word_bytes_type; else if (m == M_FILE) /* XXX for now this is a file descriptor. */ type = integer_type_node; diff --git a/gcc/algol68/a68-low-prelude.cc b/gcc/algol68/a68-low-prelude.cc index eea57ae666cc..a32c3668475a 100644 --- a/gcc/algol68/a68-low-prelude.cc +++ b/gcc/algol68/a68-low-prelude.cc @@ -1215,6 +1215,12 @@ a68_lower_shortshortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBU return a68_bits_width (a68_short_short_bits_type); } +tree +a68_lower_wordbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_width (a68_word_bits_type); +} + tree a68_lower_pi (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) { @@ -1753,6 +1759,17 @@ a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx) return t; } +tree +a68_lower_wordreali (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_WORD_COMPLEX, op1, op2); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + tree a68_lower_inti (NODE_T *p, LOW_CTX_T ctx) { @@ -1792,6 +1809,19 @@ a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx) return t; } +tree +a68_lower_wordinti (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_WORD_COMPLEX, + convert_to_real (a68_word_real_type, op1), + convert_to_real (a68_word_real_type, op2)); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + tree a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx) { diff --git a/gcc/algol68/a68-low-reals.cc b/gcc/algol68/a68-low-reals.cc index f24add7b43f1..d184bfebf41d 100644 --- a/gcc/algol68/a68-low-reals.cc +++ b/gcc/algol68/a68-low-reals.cc @@ -65,6 +65,11 @@ a68_get_real_skip_tree (MOID_T *m) int_type = a68_long_long_int_type; real_type = a68_long_long_real_type; } + else if (m == M_WORD_REAL) + { + int_type = a68_word_int_type; + real_type = a68_word_real_type; + } else gcc_unreachable (); @@ -410,6 +415,20 @@ a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode) 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 (); @@ -458,6 +477,20 @@ a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode) 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 (); @@ -584,6 +617,12 @@ a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode, gcc_assert (a_mode == M_LONG_LONG_REAL); built_in = b_mode == M_LONG_LONG_REAL ? BUILT_IN_POWL : BUILT_IN_POWIL; } + else if (m == M_WORD_REAL) + { + /* XXX */ + gcc_assert (a_mode == M_WORD_REAL); + built_in = b_mode == M_WORD_REAL ? BUILT_IN_POW : BUILT_IN_POWI; + } else gcc_unreachable (); diff --git a/gcc/algol68/a68-low-units.cc b/gcc/algol68/a68-low-units.cc index b53a1c1b50fe..ef5d372d43bb 100644 --- a/gcc/algol68/a68-low-units.cc +++ b/gcc/algol68/a68-low-units.cc @@ -208,7 +208,10 @@ a68_lower_string_denotation (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) longety, bits denotation; shortety, int denotation; shortety, real denotation; - shortety, bits denotation. + shortety, bits denotation; + word symbol, int denotation; + word symbol, real denotation; + word symbol, bits denotation. Denotations lower into GENERIC cst expressions. */ @@ -239,13 +242,16 @@ a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx) || moid == M_LONG_INT || moid == M_LONG_LONG_INT || moid == M_SHORT_INT - || moid == M_SHORT_SHORT_INT) + || moid == M_SHORT_SHORT_INT + || moid == M_WORD_INT) { /* SIZETY INT */ tree type; char *end; NODE_T *s = NO_NODE; - if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY)) + if (IS (SUB (p), LONGETY) + || IS (SUB (p), SHORTETY) + || IS (SUB (p), FIXETY)) s = NEXT (SUB (p)); else s = SUB (p); @@ -274,14 +280,17 @@ a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx) || moid == M_LONG_BITS || moid == M_LONG_LONG_BITS || moid == M_SHORT_BITS - || moid == M_SHORT_SHORT_BITS) + || moid == M_SHORT_SHORT_BITS + || moid == M_WORD_BITS) { /* SIZETY BITS */ tree type; char *end; NODE_T *s = NO_NODE; - if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY)) + if (IS (SUB (p), LONGETY) + || IS (SUB (p), SHORTETY) + || IS (SUB (p), FIXETY)) s = NEXT (SUB (p)); else s = SUB (p); @@ -313,12 +322,15 @@ a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx) } else if (moid == M_REAL || moid == M_LONG_REAL - || moid == M_LONG_LONG_REAL) + || moid == M_LONG_LONG_REAL + || moid == M_WORD_REAL) { /* SIZETY REAL */ tree type; NODE_T *s = NO_NODE; - if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY)) + if (IS (SUB (p), LONGETY) + || IS (SUB (p), SHORTETY) + || IS (SUB (p), FIXETY)) s = NEXT (SUB (p)); else s = SUB (p); @@ -329,6 +341,8 @@ a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx) type = a68_long_real_type; else if (moid == M_LONG_LONG_REAL) type = a68_long_long_real_type; + else if (moid == M_WORD_REAL) + type = a68_word_real_type; else gcc_unreachable ();
