[RFC 2/7 V2] a68: parser: support fixed sized modes
Jose E. Marchesi
jemarch@gnu.org
Mon Sep 21 10:26:26 GMT 2026
Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>
gcc/algol68/ChangeLog
* a68.h (a68_word_bits_type): Define.
(a68_word_bytes_type): Likewise.
(a68_word_int_type): Likewise.
(a68_word_real_type): Likewise.
* a68-types.h (enum a68_tree_index): Add enumerated values
A68_WORD_{INT,BITS,BYTES,REAL}_TYPE.
* a68-lang.cc (a68_build_a68_type_nodes): Initialize
a68_word_{int,bits,bytes,real}_type.
(a68_type_for_mode): Handle a68_word_{int,bits,bytes,real}_type.
---
gcc/algol68/a68-lang.cc | 39 +++++++++++++++++++-
gcc/algol68/a68-moids-misc.cc | 35 ++++++++++++++++++
gcc/algol68/a68-moids-to-string.cc | 18 ++++++++-
gcc/algol68/a68-parser-attrs.def | 2 +
gcc/algol68/a68-parser-bottom-up.cc | 28 ++++++++++++++
gcc/algol68/a68-parser-keywords.cc | 1 +
gcc/algol68/a68-parser-modes.cc | 34 +++++++++++++++--
gcc/algol68/a68-parser-moids-check.cc | 15 ++++++++
gcc/algol68/a68-parser-prelude.cc | 5 +++
gcc/algol68/a68-parser-victal.cc | 2 +-
gcc/algol68/a68-types.h | 20 +++++++---
gcc/algol68/a68.h | 24 ++++++++++++
gcc/testsuite/algol68/execute/xor-bits-1.a68 | 5 ++-
13 files changed, 216 insertions(+), 12 deletions(-)
diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc
index 1cefb08c5ab..6c3e607cb0c 100644
--- a/gcc/algol68/a68-lang.cc
+++ b/gcc/algol68/a68-lang.cc
@@ -169,6 +169,10 @@ 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 */
@@ -196,17 +200,44 @@ a68_build_a68_type_nodes (void)
else
a68_long_long_bits_type = a68_long_bits_type;
+ /* WORD BITS */
+ /* WORD INT */
+ a68_word_bits_type
+ = build_nonstandard_integer_type (POINTER_SIZE, 1);
+
+ a68_word_bits_type = long_unsigned_type_node;
+
/* 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 */
a68_real_type = float_type_node;
a68_long_real_type = double_type_node;
a68_long_long_real_type = long_double_type_node;
+
+ /* WORD REAL */
+ if (TYPE_PRECISION (a68_real_type) == POINTER_SIZE)
+ a68_word_real_type = a68_real_type;
+ else if (TYPE_PRECISION (a68_long_real_type) == POINTER_SIZE)
+ a68_word_real_type = a68_long_real_type;
+ else if (TYPE_PRECISION (a68_long_long_real_type) == POINTER_SIZE)
+ a68_word_real_type = a68_long_long_real_type;
+ else if (float16_type_node && TYPE_PRECISION (float16_type_node) == POINTER_SIZE)
+ a68_word_real_type = float16_type_node;
+ else if (bfloat16_type_node && TYPE_PRECISION (bfloat16_type_node) == POINTER_SIZE)
+ a68_word_real_type = bfloat16_type_node;
+ else
+ /* This should not happen for 16-, 32- and 64- bit targets. */
+ gcc_unreachable ();
}
/* Language hooks data structures. This is the main interface between
@@ -281,6 +312,9 @@ a68_type_for_mode (enum machine_mode mode, int unsignedp)
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 (a68_word_bits_type))
+ return unsignedp ? a68_word_bits_type : a68_word_int_type;
+
if (mode == TYPE_MODE (a68_real_type))
return a68_real_type;
@@ -290,6 +324,9 @@ a68_type_for_mode (enum machine_mode mode, int unsignedp)
if (mode == TYPE_MODE (a68_long_long_real_type))
return a68_long_long_real_type;
+ if (mode == TYPE_MODE (a68_word_real_type))
+ return a68_word_real_type;
+
if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
return build_pointer_type (char_type_node);
@@ -542,7 +579,7 @@ a68_handle_option (size_t scode,
if (file == NULL)
fatal_error (UNKNOWN_LOCATION,
"cannot open modules map file %<%s%>", arg);
-
+
ssize_t ssize = a68_file_size (fileno (file));
if (ssize < 0)
fatal_error (UNKNOWN_LOCATION,
diff --git a/gcc/algol68/a68-moids-misc.cc b/gcc/algol68/a68-moids-misc.cc
index fc5fe2f7fb5..615ca120d68 100644
--- a/gcc/algol68/a68-moids-misc.cc
+++ b/gcc/algol68/a68-moids-misc.cc
@@ -439,12 +439,16 @@ a68_is_transput_mode (MOID_T *p, char rw)
return true;
else if (p == M_LONG_LONG_INT)
return true;
+ else if (p == M_WORD_INT)
+ return true;
else if (p == M_REAL)
return true;
else if (p == M_LONG_REAL)
return true;
else if (p == M_LONG_LONG_REAL)
return true;
+ else if (p == M_WORD_REAL)
+ return true;
else if (p == M_BOOL)
return true;
else if (p == M_CHAR)
@@ -459,12 +463,16 @@ a68_is_transput_mode (MOID_T *p, char rw)
return true;
else if (p == M_LONG_LONG_BITS)
return true;
+ else if (p == M_WORD_BITS)
+ return true;
else if (p == M_COMPLEX)
return true;
else if (p == M_LONG_COMPLEX)
return true;
else if (p == M_LONG_LONG_COMPLEX)
return true;
+ else if (p == M_WORD_COMPLEX)
+ return true;
else if (p == M_ROW_CHAR)
return true;
else if (p == M_STRING)
@@ -745,6 +753,13 @@ a68_widens_to (MOID_T *p, MOID_T *q)
else
return NO_MOID;
}
+ else if (p == M_WORD_INT)
+ {
+ if (q == M_WORD_REAL)
+ return M_WORD_REAL;
+ else
+ return NO_MOID;
+ }
else if (p == M_REAL)
{
if (q == M_COMPLEX)
@@ -770,6 +785,13 @@ a68_widens_to (MOID_T *p, MOID_T *q)
else
return NO_MOID;
}
+ else if (p == M_WORD_REAL)
+ {
+ if (q == M_WORD_COMPLEX)
+ return M_WORD_COMPLEX;
+ else
+ return NO_MOID;
+ }
else if (p == M_BITS)
{
if (q == M_ROW_BOOL)
@@ -815,14 +837,27 @@ a68_widens_to (MOID_T *p, MOID_T *q)
else
return NO_MOID;
}
+ else if (p == M_WORD_BITS)
+ {
+ if (q == M_ROW_BOOL)
+ return M_ROW_BOOL;
+ else if (q = M_FLEX_ROW_BOOL)
+ return M_FLEX_ROW_BOOL;
+ else
+ return NO_MOID;
+ }
else if (p == M_BYTES && q == M_ROW_CHAR)
return M_ROW_CHAR;
else if (p == M_LONG_BYTES && q == M_ROW_CHAR)
return M_ROW_CHAR;
+ else if (p == M_WORD_BYTES && q == M_ROW_CHAR)
+ return M_ROW_CHAR;
else if (p == M_BYTES && q == M_FLEX_ROW_CHAR)
return M_FLEX_ROW_CHAR;
else if (p == M_LONG_BYTES && q == M_FLEX_ROW_CHAR)
return M_FLEX_ROW_CHAR;
+ else if (p == M_WORD_BYTES && q == M_FLEX_ROW_CHAR)
+ return M_FLEX_ROW_CHAR;
else
return NO_MOID;
}
diff --git a/gcc/algol68/a68-moids-to-string.cc b/gcc/algol68/a68-moids-to-string.cc
index 9140329db8d..328c30f233c 100644
--- a/gcc/algol68/a68-moids-to-string.cc
+++ b/gcc/algol68/a68-moids-to-string.cc
@@ -95,6 +95,7 @@ static void moid_to_string_2 (char *b, MOID_T *n, size_t *w, NODE_T *idf,
const char *strop_compl = supper_stropping ? "compl" : "COMPL";
const char *strop_long_compl = supper_stropping ? "long compl" : "LONG COMPL";
const char *strop_long_long_compl = supper_stropping ? "long long compl" : "LONG LONG COMPL";
+ const char *strop_word_compl = supper_stropping ? "word compl" : "WORD COMPL";
const char *strop_string = supper_stropping ? "string" : "STRING";
const char *strop_collitem = supper_stropping ? "collitem" : "COLLITEM";
const char *strop_simplin = supper_stropping ? "%%<simplin%%>" : "%%<SIMPLIN%%>";
@@ -103,6 +104,7 @@ static void moid_to_string_2 (char *b, MOID_T *n, size_t *w, NODE_T *idf,
const char *strop_vacuum = supper_stropping ? "%%<vacuum%%>" : "%%<VACUUM%%>";
const char *strop_long = supper_stropping ? "long" : "LONG";
const char *strop_short = supper_stropping ? "short" : "SHORT";
+ const char *strop_word = supper_stropping ? "word" : "WORD";
const char *strop_ref = supper_stropping ? "ref" : "REF";
const char *strop_flex = supper_stropping ? "flex" : "FLEX";
const char *strop_struct = supper_stropping ? "struct" : "STRUCT";
@@ -153,6 +155,8 @@ static void moid_to_string_2 (char *b, MOID_T *n, size_t *w, NODE_T *idf,
add_to_moid_text (b, strop_long_compl, w);
else if (n == M_LONG_LONG_COMPLEX)
add_to_moid_text (b, strop_long_long_compl, w);
+ else if (n == M_WORD_COMPLEX)
+ add_to_moid_text (b, strop_word_compl, w);
else if (n == M_STRING)
add_to_moid_text (b, strop_string, w);
else if (n == M_COLLITEM)
@@ -167,7 +171,19 @@ static void moid_to_string_2 (char *b, MOID_T *n, size_t *w, NODE_T *idf,
add_to_moid_text (b, strop_vacuum, w);
else if (IS (n, VOID_SYMBOL) || IS (n, STANDARD) || IS (n, INDICANT))
{
- if (DIM (n) > 0)
+ if (DIM (n) == 100 /* special DIM value for word */)
+ {
+ if ((*w) >= strlen ("WORD ") + strlen (NSYMBOL (NODE (n))))
+ {
+ add_to_moid_text (b, strop_word, w);
+ add_to_moid_text (b, " ", w);
+ const char *strop_symbol = a68_strop_keyword (NSYMBOL (NODE (n)));
+ add_to_moid_text (b, strop_symbol, w);
+ }
+ else
+ add_to_moid_text (b, "..", w);
+ }
+ else if (DIM (n) > 0)
{
size_t k = DIM (n);
diff --git a/gcc/algol68/a68-parser-attrs.def b/gcc/algol68/a68-parser-attrs.def
index 6f4e1183e7d..ac1b7573d7d 100644
--- a/gcc/algol68/a68-parser-attrs.def
+++ b/gcc/algol68/a68-parser-attrs.def
@@ -134,6 +134,7 @@ A68_ATTR(FIELD_IDENTIFIER, "field-identifier")
A68_ATTR(FILE_SYMBOL, "file-symbol")
A68_ATTR(FIRM, "firm context")
A68_ATTR(FIXED_C_PATTERN, "fixed-c-pattern")
+A68_ATTR(FIXETY, "fixety")
A68_ATTR(FI_SYMBOL, "fi-symbol")
A68_ATTR(FLEX_SYMBOL, "flex-symbol")
A68_ATTR(FLOAT_C_PATTERN, "float C format pattern")
@@ -384,6 +385,7 @@ A68_ATTR(WHILE_PART, "while-part")
A68_ATTR(WHILE_SYMBOL, "while-symbol")
A68_ATTR(WIDENING, "widening coercion")
A68_ATTR(WILDCARD, "wildcard")
+A68_ATTR(WORD_SYMBOL, "word-symbol")
/*
Local variables:
diff --git a/gcc/algol68/a68-parser-bottom-up.cc b/gcc/algol68/a68-parser-bottom-up.cc
index 0ddf1f63fa8..803211b883c 100644
--- a/gcc/algol68/a68-parser-bottom-up.cc
+++ b/gcc/algol68/a68-parser-bottom-up.cc
@@ -756,6 +756,7 @@ reduce_declarers (NODE_T *p, enum a68_attribute expect)
for (q = p; q != NO_NODE; FORWARD (q))
{
siga = true;
+ reduce (q, NO_NOTE, NO_TICK, FIXETY, WORD_SYMBOL, STOP);
reduce (q, NO_NOTE, NO_TICK, LONGETY, LONG_SYMBOL, STOP);
reduce (q, NO_NOTE, NO_TICK, SHORTETY, SHORT_SYMBOL, STOP);
while (siga)
@@ -835,6 +836,30 @@ reduce_declarers (NODE_T *p, enum a68_attribute expect)
}
}
}
+ else if (a68_whether (q, FIXETY, INDICANT, STOP))
+ {
+ int a;
+
+ if (SUB_NEXT (q) == NO_NODE)
+ {
+ a68_error (NEXT (q), "appropriate declarer expected");
+ reduce (q, NO_NOTE, NO_TICK, DECLARER, FIXETY, INDICANT, STOP);
+ }
+ else
+ {
+ a = ATTRIBUTE (SUB_NEXT (q));
+ if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL
+ || a == BYTES_SYMBOL || a == COMPL_SYMBOL)
+ {
+ reduce (q, NO_NOTE, NO_TICK, DECLARER, FIXETY, INDICANT, STOP);
+ }
+ else
+ {
+ a68_error (NEXT (q), "appropriate declarer expected");
+ reduce (q, NO_NOTE, NO_TICK, DECLARER, FIXETY, INDICANT, STOP);
+ }
+ }
+ }
}
for (q = p; q != NO_NODE; FORWARD (q))
@@ -1208,6 +1233,9 @@ reduce_primary_parts (NODE_T *p, enum a68_attribute expect)
reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, INT_DENOTATION, STOP);
reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, REAL_DENOTATION, STOP);
reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, BITS_DENOTATION, STOP);
+ reduce (q, NO_NOTE, NO_TICK, DENOTATION, FIXETY, INT_DENOTATION, STOP);
+ reduce (q, NO_NOTE, NO_TICK, DENOTATION, FIXETY, REAL_DENOTATION, STOP);
+ reduce (q, NO_NOTE, NO_TICK, DENOTATION, FIXETY, BITS_DENOTATION, STOP);
reduce (q, NO_NOTE, NO_TICK, DENOTATION, INT_DENOTATION, STOP);
reduce (q, NO_NOTE, NO_TICK, DENOTATION, REAL_DENOTATION, STOP);
reduce (q, NO_NOTE, NO_TICK, DENOTATION, BITS_DENOTATION, STOP);
diff --git a/gcc/algol68/a68-parser-keywords.cc b/gcc/algol68/a68-parser-keywords.cc
index fe157dcdfb1..3fcb202b0be 100644
--- a/gcc/algol68/a68-parser-keywords.cc
+++ b/gcc/algol68/a68-parser-keywords.cc
@@ -148,6 +148,7 @@ a68_set_up_tables (void)
add_keyword (&A68 (top_keyword), BRIEF_COMMENT_BEGIN_SYMBOL, "{");
add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "}");
add_keyword (&A68 (top_keyword), QUOTE_SYMBOL, "'");
+ add_keyword (&A68 (top_keyword), WORD_SYMBOL, "WORD");
if (OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING)
{
diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc
index 9cbf4f962e4..20fe20d890d 100644
--- a/gcc/algol68/a68-parser-modes.cc
+++ b/gcc/algol68/a68-parser-modes.cc
@@ -54,7 +54,10 @@ count_bounds (NODE_T *p)
}
}
-/* Count number of SHORTs or LONGs. */
+/* Count number of SHORTs or LONGs.
+
+ Non-cummulative sizes use fixed codes:
+ WORD - 100 */
static int
count_sizety (NODE_T *p)
@@ -65,10 +68,14 @@ count_sizety (NODE_T *p)
return count_sizety (SUB (p)) + count_sizety (NEXT (p));
else if (IS (p, SHORTETY))
return count_sizety (SUB (p)) + count_sizety (NEXT (p));
+ else if (IS (p, FIXETY))
+ return count_sizety (SUB (p));
else if (IS (p, LONG_SYMBOL))
return 1;
else if (IS (p, SHORT_SYMBOL))
return -1;
+ else if (IS (p, WORD_SYMBOL))
+ return 100;
else
return 0;
}
@@ -352,7 +359,10 @@ search_standard_mode (int sizety, NODE_T *indicant)
return p;
}
- /* Map onto greater precision. */
+ if (sizety >= 100)
+ /* Modes with sizety > 100 are non-cummulative. */
+ return NO_MOID;
+
if (sizety < 0)
return search_standard_mode (sizety + 1, indicant);
else if (sizety > 0)
@@ -509,6 +519,17 @@ get_mode_from_declarer (NODE_T *p)
else
return NO_MOID;
}
+ else if (IS (p, FIXETY))
+ {
+ if (a68_whether (p, FIXETY, INDICANT, STOP))
+ {
+ int k = count_sizety (SUB (p));
+ MOID (p) = search_standard_mode (k, NEXT (p));
+ return MOID (p);
+ }
+ else
+ return NO_MOID;
+ }
else if (IS (p, INDICANT))
{
MOID_T *q = search_standard_mode (0, p);
@@ -662,6 +683,8 @@ get_mode_from_denotation (NODE_T *p, int sizety)
MOID (p) = M_LONG_INT;
else if (sizety == 2)
MOID (p) = M_LONG_LONG_INT;
+ else if (sizety == 100)
+ MOID (p) = M_WORD_INT;
else
MOID (p) = (sizety > 0 ? M_LONG_LONG_INT : M_INT);
}
@@ -673,6 +696,8 @@ get_mode_from_denotation (NODE_T *p, int sizety)
MOID (p) = M_LONG_REAL;
else if (sizety == 2)
MOID (p) = M_LONG_LONG_REAL;
+ else if (sizety == 100)
+ MOID (p) = M_WORD_REAL;
else
MOID (p) = (sizety > 0 ? M_LONG_LONG_REAL : M_REAL);
}
@@ -688,10 +713,12 @@ get_mode_from_denotation (NODE_T *p, int sizety)
MOID (p) = M_LONG_BITS;
else if (sizety == 2)
MOID (p) = M_LONG_LONG_BITS;
+ else if (sizety == 100)
+ MOID (p) = M_WORD_BITS;
else
MOID (p) = (sizety > 0 ? M_LONG_LONG_BITS : M_BITS);
}
- else if (IS (p, LONGETY) || IS (p, SHORTETY))
+ else if (IS (p, LONGETY) || IS (p, SHORTETY) || IS (p, FIXETY))
{
get_mode_from_denotation (NEXT (p), count_sizety (SUB (p)));
MOID (p) = MOID (NEXT (p));
@@ -1185,6 +1212,7 @@ compute_derived_modes (MODULE_T *mod)
resolve_equivalent (&M_COMPLEX);
resolve_equivalent (&M_LONG_COMPLEX);
resolve_equivalent (&M_LONG_LONG_COMPLEX);
+ resolve_equivalent (&M_WORD_COMPLEX);
resolve_equivalent (&M_SEMA);
/* UNION members could be resolved. */
absorb_unions (TOP_MOID (mod));
diff --git a/gcc/algol68/a68-parser-moids-check.cc b/gcc/algol68/a68-parser-moids-check.cc
index ab664d415ba..92e0e3f7c8b 100644
--- a/gcc/algol68/a68-parser-moids-check.cc
+++ b/gcc/algol68/a68-parser-moids-check.cc
@@ -1000,6 +1000,13 @@ find_operator (TABLE_T *s, const char *n, MOID_T *x, MOID_T *y)
}
if (a68_is_coercible (x, M_LONG_LONG_COMPLEX, STRONG, SAFE_DEFLEXING))
z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_COMPLEX, NO_MOID);
+ if (a68_is_coercible (x, M_WORD_COMPLEX, STRONG, SAFE_DEFLEXING))
+ {
+ z= search_table_for_operator (OPERATORS (A68_STANDENV), n,
+ M_WORD_COMPLEX, NO_MOID);
+ if (z != NO_TAG)
+ return z;
+ }
}
return NO_TAG;
}
@@ -1089,6 +1096,14 @@ find_operator (TABLE_T *s, const char *n, MOID_T *x, MOID_T *y)
if (z != NO_TAG)
return z;
}
+ if (a68_is_coercible_series (u, M_WORD_COMPLEX, STRONG, SAFE_DEFLEXING))
+ {
+ z = search_table_for_operator (OPERATORS (A68_STANDENV), n,
+ M_WORD_COMPLEX, M_WORD_COMPLEX);
+ if (z != NO_TAG)
+ return z;
+ }
+
/* (C.4) Now allow for depreffing for REF REAL +:= INT and alike. */
v = a68_get_balanced_mode (u, STRONG, A68_DEPREF, SAFE_DEFLEXING);
z = search_table_for_operator (OPERATORS (A68_STANDENV), n, v, v);
diff --git a/gcc/algol68/a68-parser-prelude.cc b/gcc/algol68/a68-parser-prelude.cc
index 75c53da38ea..eac691f7dd6 100644
--- a/gcc/algol68/a68-parser-prelude.cc
+++ b/gcc/algol68/a68-parser-prelude.cc
@@ -171,6 +171,11 @@ stand_moids (void)
a68_mode (0, "COMPL", &M_COMPLEX);
a68_mode (0, "BITS", &M_BITS);
a68_mode (0, "BYTES", &M_BYTES);
+ /* Non-cummulative precision. */
+ a68_mode (100, "INT", &M_WORD_INT);
+ a68_mode (100, "BITS", &M_WORD_BITS);
+ a68_mode (100, "BYTES", &M_WORD_BYTES);
+ a68_mode (100, "REAL", &M_WORD_REAL);
/* Multiple precision. */
a68_mode (-2, "INT", &M_SHORT_SHORT_INT);
a68_mode (-2, "BITS", &M_SHORT_SHORT_BITS);
diff --git a/gcc/algol68/a68-parser-victal.cc b/gcc/algol68/a68-parser-victal.cc
index fc7d8acd80a..b0627adee4b 100644
--- a/gcc/algol68/a68-parser-victal.cc
+++ b/gcc/algol68/a68-parser-victal.cc
@@ -261,7 +261,7 @@ victal_check_declarer (NODE_T *p, int x)
return false;
else if (IS (p, DECLARER))
return victal_check_declarer (SUB (p), x);
- else if (a68_is_one_of (p, LONGETY, SHORTETY, STOP))
+ else if (a68_is_one_of (p, LONGETY, SHORTETY, FIXETY, STOP))
return true;
else if (a68_is_one_of (p, VOID_SYMBOL, INDICANT, STANDARD, STOP))
return true;
diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h
index ebe74ca8a80..4253108615d 100644
--- a/gcc/algol68/a68-types.h
+++ b/gcc/algol68/a68-types.h
@@ -55,16 +55,20 @@ enum a68_tree_index
ATI_BITS_TYPE,
ATI_LONG_BITS_TYPE,
ATI_LONG_LONG_BITS_TYPE,
+ ATI_WORD_BITS_TYPE,
ATI_BYTES_TYPE,
ATI_LONG_BYTES_TYPE,
+ ATI_WORD_BYTES_TYPE,
ATI_SHORT_SHORT_INT_TYPE,
ATI_SHORT_INT_TYPE,
ATI_INT_TYPE,
ATI_LONG_INT_TYPE,
ATI_LONG_LONG_INT_TYPE,
+ ATI_WORD_INT_TYPE,
ATI_REAL_TYPE,
ATI_LONG_REAL_TYPE,
ATI_LONG_LONG_REAL_TYPE,
+ ATI_WORD_REAL_TYPE,
/* Sentinel. */
ATI_MAX
};
@@ -294,6 +298,8 @@ struct MODES_T
*C_STRING, *ERROR, *FILE, *FORMAT, *HEX_NUMBER, *HIP, *INT, *LONG_BITS, *LONG_BYTES,
*LONG_COMPL, *LONG_COMPLEX, *LONG_INT, *LONG_LONG_BITS, *LONG_LONG_COMPL,
*LONG_LONG_COMPLEX, *LONG_LONG_INT, *LONG_LONG_REAL, *LONG_REAL, *NUMBER,
+ *WORD_INT, *WORD_BITS, *WORD_BYTES, *WORD_REAL, *REF_WORD_INT, *REF_WORD_REAL,
+ *WORD_COMPLEX, *REF_WORD_COMPLEX,
*PROC_REAL_REAL, *PROC_LONG_REAL_LONG_REAL, *PROC_REF_FILE_BOOL, *PROC_REF_FILE_VOID, *PROC_ROW_CHAR,
*PROC_STRING, *PROC_VOID, *REAL, *REF_BITS, *REF_BOOL, *REF_BYTES,
*REF_CHAR, *REF_COMPL, *REF_COMPLEX, *REF_FILE, *REF_INT,
@@ -1145,23 +1151,27 @@ struct GTY(()) A68_T
|| (m) == M_LONG_INT \
|| (m) == M_LONG_LONG_INT \
|| (m) == M_SHORT_INT \
- || (m) == M_SHORT_SHORT_INT)
+ || (m) == M_SHORT_SHORT_INT \
+ || (m) == M_WORD_INT)
#define IS_BITS(m) \
((m) == M_BITS \
|| (m) == M_LONG_BITS \
|| (m) == M_LONG_LONG_BITS \
|| (m) == M_SHORT_BITS \
- || (m) == M_SHORT_SHORT_BITS)
+ || (m) == M_SHORT_SHORT_BITS \
+ || (m) == M_WORD_BITS)
#define IS_BYTES(m) \
- ((m) == M_BYTES || (m) == M_LONG_BYTES)
+ ((m) == M_BYTES || (m) == M_LONG_BYTES || (m) == M_WORD_BYTES)
#define IS_COMPLEX(m) \
((m) == M_COMPLEX \
|| (m) == M_LONG_COMPLEX \
- || (m) == M_LONG_LONG_COMPLEX)
+ || (m) == M_LONG_LONG_COMPLEX \
+ || (m) == M_WORD_COMPLEX)
#define IS_REAL(m) \
((m) == M_REAL \
|| (m) == M_LONG_REAL \
- || (m) == M_LONG_LONG_REAL)
+ || (m) == M_LONG_LONG_REAL \
+ || (m) == M_WORD_REAL)
#define IS_ROW(m) IS ((m), ROW_SYMBOL)
#define IS_STRUCT(m) IS ((m), STRUCT_SYMBOL)
#define IS_UNION(m) IS ((m), UNION_SYMBOL)
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 16642c6e0bd..380c034df73 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -175,6 +175,14 @@ extern GTY(()) A68_T a68_common;
#define M_LONG_LONG_INT (MODE (LONG_LONG_INT))
#define M_LONG_LONG_REAL (MODE (LONG_LONG_REAL))
#define M_LONG_REAL (MODE (LONG_REAL))
+#define M_WORD_INT (MODE (WORD_INT))
+#define M_WORD_BITS (MODE (WORD_BITS))
+#define M_WORD_BYTES (MODE (WORD_BYTES))
+#define M_WORD_REAL (MODE (WORD_REAL))
+#define M_WORD_COMPLEX (MODE (WORD_COMPLEX))
+#define M_REF_WORD_INT (MODE (REF_WORD_INT))
+#define M_REF_WORD_REAL (MODE (REF_WORD_REAL))
+#define M_REF_WORD_COMPLEX (MODE (REF_WORD_COMPLEX))
#define M_NIL (MODE (NIL))
#define M_NUMBER (MODE (NUMBER))
#define M_PROC_LONG_REAL_LONG_REAL (MODE (PROC_LONG_REAL_LONG_REAL))
@@ -277,16 +285,20 @@ uint32_t *a68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t
#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_word_bits_type A68_GLOBAL_TREES[ATI_WORD_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_word_bytes_type A68_GLOBAL_TREES[ATI_WORD_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_word_int_type A68_GLOBAL_TREES[ATI_WORD_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]
+#define a68_word_real_type A68_GLOBAL_TREES[ATI_WORD_REAL_TYPE]
struct lang_type *a68_build_lang_type (MOID_T *moid);
struct lang_decl *a68_build_lang_decl (NODE_T *node);
@@ -1035,39 +1047,51 @@ tree a68_lower_maxabschar (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_sqrt (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_sqrt (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_sqrt (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_sqrt (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_tan (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_tan (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_tan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_tan (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_sin (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_sin (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_sin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_sin (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_cos (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_cos (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_cos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_cos (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_acos (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_acos (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_acos (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_acos (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_asin (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_asin (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_asin (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_asin (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_atan (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_atan (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_atan (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_atan (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_ln (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_ln (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_ln (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_ln (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_log (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_log (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_log (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_log (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_exp (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_exp (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_long_long_exp (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_word_exp (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_reali (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_longreali (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_wordreali (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_inti (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_longinti (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx);
+tree a68_lower_wordinti (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_im2 (NODE_T *p, LOW_CTX_T ctx);
tree a68_lower_conj2 (NODE_T *p, LOW_CTX_T ctx);
diff --git a/gcc/testsuite/algol68/execute/xor-bits-1.a68 b/gcc/testsuite/algol68/execute/xor-bits-1.a68
index beeafb592fb..f651abae9b3 100644
--- a/gcc/testsuite/algol68/execute/xor-bits-1.a68
+++ b/gcc/testsuite/algol68/execute/xor-bits-1.a68
@@ -14,5 +14,8 @@ BEGIN BITS b = 16rf0f0;
ASSERT ((ss XOR SHORT 16r00ff) = SHORT 16rf00f);
SHORT SHORT BITS sss = SHORT SHORT 16rf0;
ASSERT ((sss XOR SHORT SHORT 16r0f) = SHORT SHORT 16rff);
- ASSERT ((sss XOR SHORT SHORT 16rff) = SHORT SHORT 16r0f)
+ ASSERT ((sss XOR SHORT SHORT 16rff) = SHORT SHORT 16r0f);
+ WORD BITS bb = WORD 16rf0f0;
+ ASSERT ((bb XOR WORD 16r0f0f) = WORD 16rffff);
+ ASSERT ((bb XOR WORD 16r00ff) = WORD 16rf00f);
END
--
2.39.5
More information about the Algol68
mailing list