https://gcc.gnu.org/g:ef7c6104e5afce9ad8b1112ac21875d2856e0254
commit r16-5749-gef7c6104e5afce9ad8b1112ac21875d2856e0254 Author: Jose E. Marchesi <[email protected]> Date: Sat Oct 11 19:50:32 2025 +0200 a68: parser: extraction of tags from phrases Signed-off-by: Jose E. Marchesi <[email protected]> Co-authored-by: Marcel van der Veer <[email protected]> Diff: --- gcc/algol68/a68-parser-extract.cc | 895 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 895 insertions(+) diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc new file mode 100644 index 000000000000..e6474e9c744c --- /dev/null +++ b/gcc/algol68/a68-parser-extract.cc @@ -0,0 +1,895 @@ +/* Extract tags from phrases. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + <http://www.gnu.org/licenses/>. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* This is part of the bottom-up parser. Here is a set of routines that gather + definitions from phrases. This way we can apply tags before defining them. + These routines do not look very elegant as they have to scan through all kind + of symbols to find a pattern that they recognise. */ + +/* Insert alt equals symbol. */ + +static void +insert_alt_equals (NODE_T *p) +{ + NODE_T *q = a68_new_node (); + *q = *p; + INFO (q) = a68_new_node_info (); + *INFO (q) = *INFO (p); + GINFO (q) = a68_new_genie_info (); + *GINFO (q) = *GINFO (p); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), "=")); + NEXT (p) = q; + PREVIOUS (q) = p; + if (NEXT (q) != NO_NODE) + PREVIOUS (NEXT (q)) = q; +} + +/* Detect redefined keyword. */ + +static void +detect_redefined_keyword (NODE_T *p, int construct) +{ + if (p != NO_NODE && a68_whether (p, KEYWORD, EQUALS_SYMBOL, STOP)) + a68_error (p, "attempt to redefine keyword Y in A", + NSYMBOL (p), construct); +} + +/* Skip anything until a FED or ALT_ACCESS_SYMBOL is found. */ + +static NODE_T * +skip_module_text (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, FED_SYMBOL) || IS (p, ALT_ACCESS_SYMBOL)) + return p; + } + + return NO_NODE; +} + +/* Skip anything until a comma, semicolon or EXIT is found. */ + +static NODE_T * +skip_unit (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, COMMA_SYMBOL)) + return p; + else if (IS (p, SEMI_SYMBOL)) + return p; + else if (IS (p, EXIT_SYMBOL)) + return p; + } + return NO_NODE; +} + +/* Attribute of entry in symbol table. */ + +static int +find_tag_definition (TABLE_T *table, const char *name) +{ + if (table != NO_TABLE) + { + int ret = 0; + bool found = false; + for (TAG_T *s = INDICANTS (table); s != NO_TAG && !found; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + { + ret += INDICANT; + found = true; + } + } + found = false; + for (TAG_T *s = OPERATORS (table); s != NO_TAG && !found; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + { + ret += OPERATOR; + found = true; + } + } + found = false; + for (TAG_T *s = MODULES (table); s != NO_TAG && !found; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + { + ret += MODULE_INDICANT; + found = true; + } + } + + if (ret == 0) + return find_tag_definition (PREVIOUS (table), name); + else + return ret; + } + else + return 0; +} + +/* Fill in whether bold tag is operator, indicant or module indicant. */ + +void +a68_elaborate_bold_tags (NODE_T *p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, BOLD_TAG)) + { + switch (find_tag_definition (TABLE (q), NSYMBOL (q))) + { + case 0: + a68_error (q, "tag S has not been declared properly"); + break; + case INDICANT: + ATTRIBUTE (q) = INDICANT; + break; + case OPERATOR: + ATTRIBUTE (q) = OPERATOR; + break; + case MODULE_INDICANT: + ATTRIBUTE (q) = MODULE_INDICANT; + break; + } + } + } +} + +/* Skip declarer, or argument pack and declarer. */ + +static NODE_T * +skip_pack_declarer (NODE_T *p) +{ + /* Skip () REF [] REF FLEX [] [] ... */ + while (p != NO_NODE + && (a68_is_one_of (p, SUB_SYMBOL, OPEN_SYMBOL, REF_SYMBOL, + FLEX_SYMBOL, SHORT_SYMBOL, LONG_SYMBOL, STOP))) + { + FORWARD (p); + } + + /* Skip STRUCT (), UNION () or PROC [()]. */ + if (p != NO_NODE && (a68_is_one_of (p, STRUCT_SYMBOL, UNION_SYMBOL, STOP))) + return NEXT (p); + else if (p != NO_NODE && IS (p, PROC_SYMBOL)) + return skip_pack_declarer (NEXT (p)); + else + return p; +} + +/* Extract a revelation. */ + +static void +extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED) +{ + /* Store in the symbol table. */ + TAG_T *tag = a68_add_tag (TABLE (q), MODULE_SYMBOL, q, NO_MOID, STOP); + gcc_assert (tag != NO_TAG); + EXPORTED (tag) = false; // XXX depends on PUB! + /* Import the MOIF and install it in the tag. */ + MOIF_T *moif = a68_open_packet (NSYMBOL (q)); + if (moif == NULL) + { + a68_error (q, "cannot find module Z", NSYMBOL (q)); + return; + } + MOIF (tag) = moif; // XXX add to existing list of moifs. + + /* Store all the modes from the MOIF in the moid list. + + The front-end depends on being able to compare any two modes by pointer + value. For example, the parser mode equivalence and coercion code relies + on this. The lowerer also relies on this to make sure the same lowered + trees are used for the same modes. */ + + for (MOID_T *m : MODES (moif)) + { + /* Note that m == NO_MOID if the imported mode was already known to the + compiler and has been replaced. */ + if (m != NO_MOID) + { + MOID_T *r = a68_register_extra_mode (&TOP_MOID (&A68_JOB), m); + if (r != m) + gcc_unreachable (); + } + } + + /* Store mode indicants from the MOIF in the symbol table, + and also in the moid list. */ + for (EXTRACT_T *e : INDICANTS (moif)) + { + /* Indicants stored in the indicants area of a symbol + table are expected to be INDICANT nodes originating in + parsing, with the following subtree: + + INDICANT - EQUALS_SYMBOL - DECLARER + + where MOID (DECLARER) is determined to be the mode + associated by INDICANT, or its "equivalent" mode. + Therefore we have to synthesize something like that + here, since the mode comes from a module interface and + we don't have a declarer tree for it.. */ + + /* INDICANT node. */ + NODE_T *n = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e))); + /* EQUALS_SYMBOL node. */ + NEXT (n) = a68_some_node ("="); + ATTRIBUTE (NEXT (n)) = EQUALS_SYMBOL; + /* DECLARER node. */ + NEXT (NEXT (n)) = a68_some_node (""); + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + MOID (NEXT (NEXT (n))) = EXTRACT_MODE (e); + TABLE (n) = TABLE (q); + + /* Now add the INDICANT subtree to the symbol table of + this access clause lexical level. */ + TAG_T *tag = a68_add_tag (TABLE (q), INDICANT, n, NO_MOID, 0); + gcc_assert (tag != NO_TAG); + + /* Finally add the mode indicant to the moids list. Note + that the mode in DECLARER is associated to the + INDICANT in the table at some point later, via + EQUIVALENT. Hence the NO_MOID in the call to + a68_add_mode. */ + MOID_T *effective_mode = a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, + 0, n, NO_MOID, NO_PACK); + gcc_assert (effective_mode != NO_MOID); + } + + /* Store priorities from the MOIF. */ + for (EXTRACT_T *e : PRIOS (moif)) + { + NODE_T *n + = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e))); + /* XXX sensible location somehow? */ + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + TABLE (n) = TABLE (q); + TAG_T *tag = a68_add_tag (TABLE (q), PRIO_SYMBOL, n, NO_MOID, + EXTRACT_PRIO (e)); + gcc_assert (tag != NO_TAG); + MOIF (tag) = moif; // XXX add to existing list of moifs. + } + + /* Store identifiers from the MOIF. */ + for (EXTRACT_T *e : IDENTIFIERS (moif)) + { + NODE_T *n + = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e))); + /* XXX sensible location somehow? */ + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + TABLE (n) = TABLE (q); + + TAG_T *tag = a68_add_tag (TABLE (q), IDENTIFIER, + n, EXTRACT_MODE (e), NORMAL_IDENTIFIER); + gcc_assert (tag != NO_TAG); + EXTERN_SYMBOL (tag) = ggc_strdup (EXTRACT_SYMBOL (e)); + VARIABLE (tag) = VARIABLE (e); + IN_PROC (tag) = IN_PROC (e); + HEAP (tag) = STATIC_SYMBOL; + MOIF (tag) = moif; + } + + /* Store operators from the MOIF. */ + for (EXTRACT_T *e : OPERATORS (moif)) + { + NODE_T *n + = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e), + true /* operator */)); + MOID (n) = EXTRACT_MODE (e); + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + TABLE (n) = TABLE (q); + TAG_T *tag = a68_add_tag (TABLE (q), OP_SYMBOL, + n, EXTRACT_MODE (e), STOP); + gcc_assert (tag != NO_TAG); + VARIABLE (tag) = VARIABLE (e); + IN_PROC (tag) = IN_PROC (e); + HEAP (tag) = STATIC_SYMBOL; + MOIF (tag) = moif; + EXTERN_SYMBOL (tag) = ggc_strdup (EXTRACT_SYMBOL (e)); + } +} + +/* Search [MODE|MODULE] A = .., B = .. + and ACCESS A, B, .. + and store indicants. */ + +void +a68_extract_indicants (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (IS (q, ACCESS_SYMBOL) || IS (q, ALT_ACCESS_SYMBOL)) + { + /* An access clause implies the declaration of module indicants, + provided they are found in a suitable packet. */ + do + { + FORWARD (q); + detect_redefined_keyword (q, MODE_DECLARATION); + if (IS (q, BOLD_TAG)) + { + extract_revelation (q, false /* is_public */); + FORWARD (q); + } + else if (a68_whether (q, PUBLIC_SYMBOL, BOLD_TAG, STOP)) + { + extract_revelation (q, true /* is_public */); + FORWARD (q); + FORWARD (q); + } + } + while (q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else if (IS (q, MODULE_SYMBOL)) + { + bool siga = true; + do + { + FORWARD (q); + detect_redefined_keyword (q, MODE_DECLARATION); + if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) + { + /* Store in the symbol table. + XXX also add to global list of modules? + Position of definition (q) connects to this lexical + level! */ + ATTRIBUTE (q) = DEFINING_MODULE_INDICANT; + TAG_T *tag = a68_add_tag (TABLE (p), MODULE_SYMBOL, q, NO_MOID, STOP); + gcc_assert (tag != NO_TAG); + EXPORTED (tag) = true; + FORWARD (q); + ATTRIBUTE (q) = EQUALS_SYMBOL; /* XXX why not ALT_EQUALS_SYMBOL */ + q = skip_module_text (NEXT (q)); + FORWARD (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else if (IS (q, MODE_SYMBOL)) + { + bool siga = true; + do + { + FORWARD (q); + detect_redefined_keyword (q, MODE_DECLARATION); + if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) + { + /* Store in the symbol table, but also in the moid list. + Position of definition (q) connects to this lexical + level! */ + if (a68_add_tag (TABLE (p), INDICANT, q, NO_MOID, STOP) == NO_TAG) + gcc_unreachable (); + if (a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, 0, q, NO_MOID, NO_PACK) == NO_MOID) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_INDICANT; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_pack_declarer (NEXT (q)); + FORWARD (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +#define GET_PRIORITY(q, k) \ + do \ + { \ + errno=0; \ + (k) = atoi (NSYMBOL (q)); \ + if (errno != 0) { \ + a68_error ((q), "invalid priority declaration"); \ + (k) = MAX_PRIORITY; \ + } else if ((k) < 1 || (k) > MAX_PRIORITY) { \ + a68_error ((q), "invalid priority declaration"); \ + (k) = MAX_PRIORITY; \ + } \ + } \ + while (0) + +/* Search PRIO X = .., Y = .. and store priorities. */ + +void +a68_extract_priorities (NODE_T *p) +{ + NODE_T *q = p; + while (q != NO_NODE) + { + if (IS (q, PRIO_SYMBOL)) + { + bool siga = true; + do + { + FORWARD (q); + detect_redefined_keyword (q, PRIORITY_DECLARATION); + /* An operator tag like ++ or && gives strange errors so we catch + it here. */ + if (a68_whether (q, OPERATOR, OPERATOR, STOP)) + { + NODE_T *y = q; + a68_error (q, "invalid operator tag"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + /* Remove one superfluous operator, and hope it was only + one. */ + NEXT (q) = NEXT_NEXT (q); + PREVIOUS (NEXT (q)) = q; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + FORWARD (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } + else if (a68_whether (q, OPERATOR, EQUALS_SYMBOL, INT_DENOTATION, STOP) + || a68_whether (q, EQUALS_SYMBOL, EQUALS_SYMBOL, INT_DENOTATION, STOP)) + { + NODE_T *y = q; + ATTRIBUTE (q) = DEFINING_OPERATOR; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + FORWARD (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } + else if (a68_whether (q, BOLD_TAG, IDENTIFIER, STOP)) + { + siga = false; + } + else if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, INT_DENOTATION, STOP)) + { + NODE_T *y = q; + ATTRIBUTE (q) = DEFINING_OPERATOR; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + FORWARD (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } else if (a68_whether (q, BOLD_TAG, INT_DENOTATION, STOP) + || a68_whether (q, OPERATOR, INT_DENOTATION, STOP) + || a68_whether (q, EQUALS_SYMBOL, INT_DENOTATION, STOP)) + { + /* The scanner cannot separate operator and "=" sign so we do this here. */ + int len = (int) strlen (NSYMBOL (q)); + if (len > 1 && NSYMBOL (q)[len - 1] == '=') + { + NODE_T *y = q; + char *sym = (char *) xmalloc ((size_t) (len + 1)); + a68_bufcpy (sym, NSYMBOL (q), len + 1); + sym[len - 1] = '\0'; + NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym)); + free (sym); + if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=') + a68_error (q, "probably a missing symbol near invalid operator S"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + insert_alt_equals (q); + q = NEXT_NEXT (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } + else + siga = false; + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search OP [( .. ) ..] X = .., Y = .. and store operators. */ + +void +a68_extract_operators (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (!IS (q, OP_SYMBOL)) + FORWARD (q); + else + { + bool siga = true; + bool in_proc = true; + /* Skip operator plan. */ + if (NEXT (q) != NO_NODE && IS (NEXT (q), OPEN_SYMBOL)) + { + q = skip_pack_declarer (NEXT (q)); + in_proc = false; + } + /* Sample operators. */ + if (q != NO_NODE) + { + do + { + FORWARD (q); + detect_redefined_keyword (q, OPERATOR_DECLARATION); + /* Unacceptable operator tags like ++ or && could give + strange errors. */ + if (a68_whether (q, OPERATOR, OPERATOR, STOP)) + { + a68_error (q, "invalid operator tag"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + /* Remove one superfluous operator, and hope it was only one. */ + NEXT (q) = NEXT_NEXT (q); + PREVIOUS (NEXT (q)) = q; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, OPERATOR, EQUALS_SYMBOL, STOP) + || a68_whether (q, EQUALS_SYMBOL, EQUALS_SYMBOL, STOP)) + { + ATTRIBUTE (q) = DEFINING_OPERATOR; + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, BOLD_TAG, IDENTIFIER, STOP)) + { + siga = false; + } + else if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) + { + ATTRIBUTE (q) = DEFINING_OPERATOR; + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (q != NO_NODE && (a68_is_one_of (q, OPERATOR, BOLD_TAG, EQUALS_SYMBOL, STOP))) + { + /* The scanner cannot separate operator and "=" sign so + we do this here. */ + int len = (int) strlen (NSYMBOL (q)); + if (len > 1 && NSYMBOL (q)[len - 1] == '=') + { + char *sym = (char *) xmalloc ((size_t) (len + 1)); + a68_bufcpy (sym, NSYMBOL (q), len + 1); + sym[len - 1] = '\0'; + NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym)); + if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=') + a68_error (q, "probably a missing symbol near invalid operator S"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + insert_alt_equals (q); + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + FORWARD (q); + q = skip_unit (q); + } + else + siga = false; + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + } + } +} + +/* Search and store labels. */ + +void +a68_extract_labels (NODE_T *p, int expect) +{ + /* Only handle candidate phrases as not to search indexers!. */ + if (expect == SERIAL_CLAUSE || expect == ENQUIRY_CLAUSE || expect == SOME_CLAUSE) + { + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, IDENTIFIER, COLON_SYMBOL, STOP)) + { + TAG_T *z = a68_add_tag (TABLE (p), LABEL, q, NO_MOID, LOCAL_LABEL); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + UNIT (z) = NO_NODE; + } + } + } +} + +/* Search MOID x = .., y = .. and store identifiers. */ + +static void +extract_identities (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, DECLARER, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + bool siga = true; + do + { + if (a68_whether ((FORWARD (q)), IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + if (tag == NO_TAG) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search MOID x [:= ..], y [:= ..] and store identifiers. */ + +static void +extract_variables (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, HEAP_SYMBOL, DECLARER, IDENTIFIER, STOP) + || a68_whether (q, LOC_SYMBOL, DECLARER, IDENTIFIER, STOP) + || a68_whether (q, DECLARER, IDENTIFIER, STOP)) + { + if (!IS (q, DECLARER)) + FORWARD (q); + + bool siga = true; + do + { + FORWARD (q); + if (a68_whether (q, IDENTIFIER, STOP)) + { + if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + ATTRIBUTE (NEXT (q)) = ASSIGN_SYMBOL; + } + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + if (tag == NO_TAG) + gcc_unreachable (); + VARIABLE (tag) = true; + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + q = skip_unit (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search PROC x = .., y = .. and stores identifiers. */ + +static void +extract_proc_identities (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, PROC_SYMBOL, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + bool siga = true; + do + { + FORWARD (q); + if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + TAG_T *t = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + IN_PROC (t) = true; + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search PROC x [:= ..], y [:= ..]; store identifiers. */ + +static void +extract_proc_variables (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, PROC_SYMBOL, IDENTIFIER, STOP)) + { + bool siga = true; + do + { + FORWARD (q); + if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP)) + { + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + gcc_assert (tag != NO_TAG); + VARIABLE (tag) = true; + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + q = skip_unit (FORWARD (q)); + } + else if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + gcc_assert (tag != NO_TAG); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ASSIGN_SYMBOL; + q = skip_unit (q); + } else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Schedule gathering of definitions in a phrase. */ + +void +a68_extract_declarations (NODE_T *p) +{ + /* Get definitions so we know what is defined in this range. */ + extract_identities (p); + extract_variables (p); + extract_proc_identities (p); + extract_proc_variables (p); + /* By now we know whether "=" is an operator or not. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, EQUALS_SYMBOL)) + ATTRIBUTE (q) = OPERATOR; + else if (IS (q, ALT_EQUALS_SYMBOL)) + ATTRIBUTE (q) = EQUALS_SYMBOL; + } + + /* Get qualifiers. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, LOC_SYMBOL, DECLARER, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + if (a68_whether (q, HEAP_SYMBOL, DECLARER, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + if (a68_whether (q, LOC_SYMBOL, PROC_SYMBOL, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + if (a68_whether (q, HEAP_SYMBOL, PROC_SYMBOL, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + } + + /* Give priorities to operators. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, OPERATOR)) + { + if (a68_find_tag_global (TABLE (q), OP_SYMBOL, NSYMBOL (q))) + { + TAG_T *s = a68_find_tag_global (TABLE (q), PRIO_SYMBOL, NSYMBOL (q)); + + if (s != NO_TAG) + PRIO (INFO (q)) = PRIO (s); + else + PRIO (INFO (q)) = 0; + } + else + { + a68_error (q, "tag S has not been declared properly"); + PRIO (INFO (q)) = 1; + } + } + } +}
