https://gcc.gnu.org/g:462b63c068dcade0dfce78d4e61de0a155612cc5
commit r17-4867-g462b63c068dcade0dfce78d4e61de0a155612cc5 Author: Jose E. Marchesi <[email protected]> Date: Sun Sep 20 01:55:44 2026 +0200 a68: parser: support fixed sized modes Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-parser-attrs.def (FIXETY): New attribute. (WORD_SYMBOL): Likewise. * 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. * a68-moids-misc.cc (a68_is_transput_mode): Handle fixed sized modes. (a68_widens_to): Likewise. * a68-moids-to-string.cc (moid_to_string_2): Likewise. * a68-parser-bottom-up.cc (reduce_declarers): Reduce fixetys. (reduce_primary_parts): Likewise. * a68-parser-keywords.cc (a68_set_up_tables): Add keyword for WORD_SYMBOL. * a68-parser-modes.cc (count_sizety): Handle sizetys. (get_mode_from_declarer): Likewise. (get_mode_from_denotation): Likewise. * a68-parser-victal.cc (victal_check_declarer): Likewise. (compute_derived_modes): Resolve equivalences in M_WORD_* standard modes. * a68-parser-moids-check.cc (find_operator): Handle fixed sized modes. * a68-parser-prelude.cc (stand_moids): Build standard fixed sized modes and operators. gcc/testsuite/ChangeLog * algol68/execute/xor-bits-1.a68: New test.a Diff: --- 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 77ddbf08788b..e2c47d2eacdd 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 @@ -282,6 +313,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; @@ -291,6 +325,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); @@ -529,7 +566,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 fc5fe2f7fb54..257f43bddd4f 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 9140329db8db..328c30f233c3 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 6f4e1183e7d1..ac1b7573d7df 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 0ddf1f63fa88..803211b883cb 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 fe157dcdfb12..3fcb202b0be6 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 19f8e7f5cbc8..d5077c0ca637 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) a68_resolve_equivalent (&M_COMPLEX); a68_resolve_equivalent (&M_LONG_COMPLEX); a68_resolve_equivalent (&M_LONG_LONG_COMPLEX); + a68_resolve_equivalent (&M_WORD_COMPLEX); a68_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 ab664d415ba0..92e0e3f7c8be 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 75c53da38eaa..eac691f7dd6f 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 fc7d8acd80ae..b0627adee4b3 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 0a3611f8b3e4..6024af53a8af 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, @@ -1152,23 +1158,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 90f5467cf65b..8afb12886736 100644 --- a/gcc/algol68/a68.h +++ b/gcc/algol68/a68.h @@ -174,6 +174,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)) @@ -276,16 +284,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); @@ -1036,39 +1048,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 beeafb592fb6..f651abae9b38 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
