[COMMITTED] algol68: reorganize global front-end trees for types
Jose E. Marchesi
jemarch@gnu.org
Sat Mar 15 13:09:14 GMT 2025
This patch also adapts a68_type_for_mode and a68_type_for_size to use
the global trees rather than the previous likely wrong implementation.
---
gcc/algol68/a68-lang.cc | 166 ++++++++++++++++++++++++++++++-----
gcc/algol68/a68-low-moids.cc | 84 ++++--------------
gcc/algol68/a68.h | 46 ++++++++++
3 files changed, 209 insertions(+), 87 deletions(-)
diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc
index dff7284100b..5e8fdc491ba 100644
--- a/gcc/algol68/a68-lang.cc
+++ b/gcc/algol68/a68-lang.cc
@@ -43,6 +43,10 @@ static GTY(()) tree global_context;
/* Array of all global declarations to pass back to the middle-end. */
static GTY(()) vec <tree, va_gc> *global_declarations;
+/* Array of global type/decl nodes used by this front-end. */
+
+tree a68_global_trees[ATI_MAX];
+
/* Types expected by gcc's garbage collector.
These types exist to allow language front-ends to
add extra information in gcc's parse tree data structure. */
@@ -128,6 +132,87 @@ a68_type_moid (tree type)
return TYPE_LANG_SPECIFIC (type)->moid;
}
+/* Build the type trees in a68_global_trees. */
+
+static void
+a68_build_a68_type_nodes (void)
+{
+ /* VOID */
+ a68_void_type = void_type_node;
+
+ /* BOOL */
+ a68_bool_type = boolean_type_node;
+
+ /* CHAR */
+ a68_char_type = uint32_type_node;
+
+ /* SHORT SHORT INT
+ SHORT INT
+ INT */
+ a68_short_short_int_type = signed_char_type_node;
+ a68_short_int_type = short_integer_type_node;
+ a68_int_type = integer_type_node;
+
+ /* LONG INT */
+ if (int_size_in_bytes (long_integer_type_node)
+ > int_size_in_bytes (a68_int_type))
+ a68_long_int_type = long_integer_type_node;
+ else if (int_size_in_bytes (long_long_integer_type_node)
+ > int_size_in_bytes (a68_int_type))
+ a68_long_int_type = long_long_integer_type_node;
+ else
+ a68_long_int_type = a68_int_type;
+
+ /* LONG LONG INT */
+ if (int_size_in_bytes (long_integer_type_node)
+ > int_size_in_bytes (a68_long_int_type))
+ a68_long_long_int_type = long_integer_type_node;
+ else if (int_size_in_bytes (long_long_integer_type_node)
+ > int_size_in_bytes (a68_long_int_type))
+ a68_long_long_int_type = long_long_integer_type_node;
+ else
+ a68_long_long_int_type = a68_long_int_type;
+
+ /* SHORT SHORT BITS
+ SHORT BITS
+ BITS */
+ a68_short_short_bits_type = unsigned_char_type_node;
+ a68_short_bits_type = short_unsigned_type_node;
+ a68_bits_type = unsigned_type_node;
+
+ /* LONG BITS */
+ if (int_size_in_bytes (long_unsigned_type_node)
+ > int_size_in_bytes (a68_bits_type))
+ a68_long_bits_type = long_unsigned_type_node;
+ else if (int_size_in_bytes (long_long_unsigned_type_node)
+ > int_size_in_bytes (a68_bits_type))
+ a68_long_bits_type = long_long_unsigned_type_node;
+ else
+ a68_long_bits_type = a68_bits_type;
+
+ /* LONG LONG BITS */
+ if (int_size_in_bytes (long_unsigned_type_node)
+ > int_size_in_bytes (a68_long_bits_type))
+ a68_long_long_bits_type = long_unsigned_type_node;
+ else if (int_size_in_bytes (long_long_unsigned_type_node)
+ > int_size_in_bytes (a68_long_bits_type))
+ a68_long_long_bits_type = long_long_unsigned_type_node;
+ else
+ a68_long_long_bits_type = a68_long_bits_type;
+
+ /* BYTES
+ LONG BYTES */
+ a68_bytes_type = unsigned_type_node;
+ a68_long_bytes_type = long_unsigned_type_node;
+
+ /* REAL
+ LONG REAL
+ LONG LONG REAL */
+ a68_real_type = float_type_node;
+ a68_long_real_type = double_type_node;
+ a68_long_long_real_type = long_double_type_node;
+}
+
/* Language hooks data structures. This is the main interface between
the GCC front-end and the GCC middle-end/back-end. A list of
language hooks can be found in langhooks.h. */
@@ -143,6 +228,7 @@ a68_init (void)
{
build_common_tree_nodes (false);
targetm.init_builtins ();
+ a68_build_a68_type_nodes ();
build_common_builtin_nodes ();
a68_install_builtins ();
@@ -178,36 +264,36 @@ a68_option_lang_mask (void)
#undef LANG_HOOKS_OPTION_LANG_MASK
#define LANG_HOOKS_OPTION_LANG_MASK a68_option_lang_mask
-/* Implements the lang_hooks.types.type_for_mode routine for language Algol
- 68. */
+
+/* Return a data type that has machine mode MODE. If the mode is an
+ integer, then UNSIGNEDP selects between signed and unsigned types. */
static tree
-a68_type_for_mode (enum machine_mode mode ATTRIBUTE_UNUSED,
- int unsignedp ATTRIBUTE_UNUSED)
+a68_type_for_mode (enum machine_mode mode, int unsignedp)
{
if (mode == QImode)
- return unsignedp ? unsigned_char_type_node : char_type_node;
+ return unsignedp ? a68_short_short_bits_type :a68_short_short_int_type;
if (mode == HImode)
- return unsignedp ? short_unsigned_type_node: short_integer_type_node;
+ return unsignedp ? a68_short_bits_type : a68_short_int_type;
if (mode == SImode)
- return unsignedp ? unsigned_type_node : integer_type_node;
+ return unsignedp ? a68_bits_type : a68_int_type;
if (mode == DImode)
- return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+ return unsignedp ? a68_long_bits_type : a68_long_int_type;
- // if (mode == TYPE_MODE (d_cent_type))
- // return unsignedp ? d_ucent_type : d_cent_type;
+ if (mode == TYPE_MODE (a68_long_long_bits_type))
+ return unsignedp ? a68_long_long_bits_type : a68_long_long_int_type;
- if (mode == TYPE_MODE (float_type_node))
- return float_type_node;
+ if (mode == TYPE_MODE (a68_real_type))
+ return a68_real_type;
- if (mode == TYPE_MODE (double_type_node))
- return double_type_node;
+ if (mode == TYPE_MODE (a68_long_real_type))
+ return a68_long_real_type;
- if (mode == TYPE_MODE (long_double_type_node))
- return long_double_type_node;
+ if (mode == TYPE_MODE (a68_long_long_real_type))
+ return a68_long_long_real_type;
if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
return build_pointer_type (char_type_node);
@@ -232,14 +318,52 @@ a68_type_for_mode (enum machine_mode mode ATTRIBUTE_UNUSED,
#undef LANG_HOOKS_TYPE_FOR_MODE
#define LANG_HOOKS_TYPE_FOR_MODE a68_type_for_mode
-/* XXX */
+
+/* Return an integer type with BITS bits of precision,
+ that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
static tree
-a68_type_for_size (unsigned int bits ATTRIBUTE_UNUSED,
- int unsignedp ATTRIBUTE_UNUSED)
+a68_type_for_size (unsigned int bits, int unsignedp)
{
- /* XXX this is not correct. */
- return integer_type_node;
+ if (unsignedp)
+ {
+ if (bits <= TYPE_PRECISION (a68_short_short_bits_type))
+ return a68_short_short_bits_type;
+ if (bits <= TYPE_PRECISION (a68_short_bits_type))
+ return a68_short_bits_type;
+ if (bits <= TYPE_PRECISION (a68_bits_type))
+ return a68_bits_type;
+ if (bits <= TYPE_PRECISION (a68_long_bits_type))
+ return a68_long_bits_type;
+ if (bits <= TYPE_PRECISION (a68_long_long_bits_type))
+ return a68_long_long_bits_type;
+ }
+ else
+ {
+ if (bits <= TYPE_PRECISION (a68_short_short_int_type))
+ return a68_short_short_int_type;
+ if (bits <= TYPE_PRECISION (a68_short_int_type))
+ return a68_short_int_type;
+ if (bits <= TYPE_PRECISION (a68_int_type))
+ return a68_int_type;
+ if (bits <= TYPE_PRECISION (a68_long_int_type))
+ return a68_long_int_type;
+ if (bits <= TYPE_PRECISION (a68_long_long_int_type))
+ return a68_long_long_int_type;
+ }
+
+ for (int i = 0; i < NUM_INT_N_ENTS; ++i)
+ {
+ if (int_n_enabled_p[i] && bits == int_n_data[i].bitsize)
+ {
+ if (unsignedp)
+ return int_n_trees[i].unsigned_type;
+ else
+ return int_n_trees[i].signed_type;
+ }
+ }
+
+ return 0;
}
#undef LANG_HOOKS_TYPE_FOR_SIZE
diff --git a/gcc/algol68/a68-low-moids.cc b/gcc/algol68/a68-low-moids.cc
index aaef52d8c28..25528ae482e 100644
--- a/gcc/algol68/a68-low-moids.cc
+++ b/gcc/algol68/a68-low-moids.cc
@@ -235,89 +235,41 @@ lower_standard_mode (MOID_T *m)
tree type = NULL_TREE;
if (m == M_VOID)
- type = void_type_node;
+ type = a68_void_type;
else if (m == M_BOOL)
- type = boolean_type_node;
+ type = a68_bool_type;
else if (m == M_CHAR)
- type = uint32_type_node;
+ type = a68_char_type;
else if (m == M_SHORT_SHORT_INT)
- type = signed_char_type_node;
+ type = a68_short_short_int_type;
else if (m == M_SHORT_INT)
- type = short_integer_type_node;
+ type = a68_short_int_type;
else if (m == M_INT)
- type = integer_type_node;
+ type = a68_int_type;
else if (m == M_LONG_INT)
- {
- if (!CTYPE (M_INT))
- (void) a68_lower_mode (M_INT);
-
- if (int_size_in_bytes (long_integer_type_node)
- > int_size_in_bytes (CTYPE (M_INT)))
- type = long_integer_type_node;
- else if (int_size_in_bytes (long_long_integer_type_node)
- > int_size_in_bytes (CTYPE (M_INT)))
- type = long_long_integer_type_node;
- else
- type = CTYPE (M_INT);
- }
+ type = a68_long_int_type;
else if (m == M_LONG_LONG_INT)
- {
- if (!CTYPE (M_LONG_INT))
- (void) a68_lower_mode (M_LONG_INT);
-
- if (int_size_in_bytes (long_integer_type_node)
- > int_size_in_bytes (CTYPE (M_LONG_INT)))
- type = long_integer_type_node;
- else if (int_size_in_bytes (long_long_integer_type_node)
- > int_size_in_bytes (CTYPE (M_LONG_INT)))
- type = long_long_integer_type_node;
- else
- type = CTYPE (M_LONG_INT);
- }
+ type = a68_long_long_int_type;
else if (m == M_REAL)
- type = float_type_node;
+ type = a68_real_type;
else if (m == M_LONG_REAL)
- type = double_type_node;
+ type = a68_long_real_type;
else if (m == M_LONG_LONG_REAL)
- type = long_double_type_node;
+ type = a68_long_long_real_type;
else if (m == M_SHORT_SHORT_BITS)
- type = unsigned_char_type_node;
+ type = a68_short_short_bits_type;
else if (m == M_SHORT_BITS)
- type = short_unsigned_type_node;
+ type = a68_short_bits_type;
else if (m == M_BITS)
- type = unsigned_type_node;
+ type = a68_bits_type;
else if (m == M_LONG_BITS)
- {
- if (!CTYPE (M_BITS))
- (void) a68_lower_mode (M_BITS);
-
- if (int_size_in_bytes (long_unsigned_type_node)
- > int_size_in_bytes (CTYPE (M_BITS)))
- type = long_unsigned_type_node;
- else if (int_size_in_bytes (long_long_unsigned_type_node)
- > int_size_in_bytes (CTYPE (M_BITS)))
- type = long_long_unsigned_type_node;
- else
- type = CTYPE (M_BITS);
- }
+ type = a68_long_bits_type;
else if (m == M_LONG_LONG_BITS)
- {
- if (!CTYPE (M_LONG_BITS))
- (void) a68_lower_mode (M_LONG_BITS);
-
- if (int_size_in_bytes (long_unsigned_type_node)
- > int_size_in_bytes (CTYPE (M_LONG_BITS)))
- type = long_unsigned_type_node;
- else if (int_size_in_bytes (long_long_unsigned_type_node)
- > int_size_in_bytes (CTYPE (M_LONG_BITS)))
- type = long_long_unsigned_type_node;
- else
- type = CTYPE (M_LONG_BITS);
- }
+ type = a68_long_long_bits_type;
else if (m == M_BYTES)
- type = unsigned_type_node;
+ type = a68_bytes_type;
else if (m == M_LONG_BYTES)
- type = long_unsigned_type_node;
+ type = a68_long_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.h b/gcc/algol68/a68.h
index ea71f116370..74c0f53592f 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -183,6 +183,52 @@ uint32_t *a68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t
/* a68-lang.cc */
+enum a68_tree_index
+{
+ /* Type trees. */
+ ATI_VOID_TYPE,
+ ATI_BOOL_TYPE,
+ ATI_CHAR_TYPE,
+ ATI_SHORT_SHORT_BITS_TYPE,
+ ATI_SHORT_BITS_TYPE,
+ ATI_BITS_TYPE,
+ ATI_LONG_BITS_TYPE,
+ ATI_LONG_LONG_BITS_TYPE,
+ ATI_BYTES_TYPE,
+ ATI_LONG_BYTES_TYPE,
+ ATI_SHORT_SHORT_INT_TYPE,
+ ATI_SHORT_INT_TYPE,
+ ATI_INT_TYPE,
+ ATI_LONG_INT_TYPE,
+ ATI_LONG_LONG_INT_TYPE,
+ ATI_REAL_TYPE,
+ ATI_LONG_REAL_TYPE,
+ ATI_LONG_LONG_REAL_TYPE,
+ /* Sentinel. */
+ ATI_MAX
+};
+
+extern GTY(()) tree a68_global_trees[ATI_MAX];
+
+#define a68_void_type a68_global_trees[ATI_VOID_TYPE]
+#define a68_bool_type a68_global_trees[ATI_BOOL_TYPE]
+#define a68_char_type a68_global_trees[ATI_CHAR_TYPE]
+#define a68_short_short_bits_type a68_global_trees[ATI_SHORT_SHORT_BITS_TYPE]
+#define a68_short_bits_type a68_global_trees[ATI_SHORT_BITS_TYPE]
+#define a68_bits_type a68_global_trees[ATI_BITS_TYPE]
+#define a68_long_bits_type a68_global_trees[ATI_LONG_BITS_TYPE]
+#define a68_long_long_bits_type a68_global_trees[ATI_LONG_LONG_BITS_TYPE]
+#define a68_bytes_type a68_global_trees[ATI_BYTES_TYPE]
+#define a68_long_bytes_type a68_global_trees[ATI_LONG_BYTES_TYPE]
+#define a68_short_short_int_type a68_global_trees[ATI_SHORT_SHORT_INT_TYPE]
+#define a68_short_int_type a68_global_trees[ATI_SHORT_INT_TYPE]
+#define a68_int_type a68_global_trees[ATI_INT_TYPE]
+#define a68_long_int_type a68_global_trees[ATI_LONG_INT_TYPE]
+#define a68_long_long_int_type a68_global_trees[ATI_LONG_LONG_INT_TYPE]
+#define a68_real_type a68_global_trees[ATI_REAL_TYPE]
+#define a68_long_real_type a68_global_trees[ATI_LONG_REAL_TYPE]
+#define a68_long_long_real_type a68_global_trees[ATI_LONG_LONG_REAL_TYPE]
+
struct lang_type *a68_build_lang_type (MOID_T *moid);
struct lang_decl *a68_build_lang_decl (NODE_T *node);
MOID_T *a68_type_moid (tree type);
--
2.30.2
More information about the Algol68
mailing list