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.
---
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 12b91cd6669..0809ad0b287 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 54079122880..c5fe8c68818 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 aed1c3c3dab..027ddc2a4a9 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 606e5fdf5ef..a3ae61c6a10 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 4bf97e9ebea..3707e4d1991 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 54c1a42863d..d9d63b9741d 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 eea57ae666c..a32c3668475 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 f24add7b43f..d184bfebf41 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 b53a1c1b50f..ef5d372d43b 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 ();
--
2.39.5
