+static struct block*
+block_lookup (struct block *context, char *raw_name)
+{
+ char *name;
+ struct ada_symbol_info *syms;
+ int nsyms;
+ struct symtab *symtab;
+
+ if (raw_name[0] == '\'')
+ {
+ raw_name += 1;
+ name = raw_name;
+ }
+ else
+ name = ada_encode (raw_name);
+
+ nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
+ if (context == NULL &&
+ (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK))
+ symtab = lookup_symtab (name);
+ else
+ symtab = NULL;
+
+ if (symtab != NULL)
+ return BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK);
+ else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)
+ {
+ if (context == NULL)
+ error (_("No file or function \"%s\"."), raw_name);
+ else
+ error (_("No function \"%s\" in specified context."), raw_name);
+ }
+ else
+ {
+ if (nsyms > 1)
+ warning (_("Function name \"%s\" ambiguous here"), raw_name);
+ return SYMBOL_BLOCK_VALUE (syms[0].sym);
+ }
+}
+
+static struct symbol*
+select_possible_type_sym (struct ada_symbol_info *syms, int nsyms)
+{
+ int i;
+ int preferred_index;
+ struct type *preferred_type;
+
+ preferred_index = -1; preferred_type = NULL;
+ for (i = 0; i < nsyms; i += 1)
+ switch (SYMBOL_CLASS (syms[i].sym))
+ {
+ case LOC_TYPEDEF:
+ if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type))
+ {
+ preferred_index = i;
+ preferred_type = SYMBOL_TYPE (syms[i].sym);
+ }
+ break;
+ case LOC_REGISTER:
+ case LOC_ARG:
+ case LOC_REF_ARG:
+ case LOC_REGPARM:
+ case LOC_REGPARM_ADDR:
+ case LOC_LOCAL:
+ case LOC_LOCAL_ARG:
+ case LOC_BASEREG:
+ case LOC_BASEREG_ARG:
+ case LOC_COMPUTED:
+ case LOC_COMPUTED_ARG:
+ return NULL;
+ default:
+ break;
+ }
+ if (preferred_type == NULL)
+ return NULL;
+ return syms[preferred_index].sym;
+}
+
+static struct type*
+find_primitive_type (char *name)
+{
+ struct type *type;
+ type = language_lookup_primitive_type_by_name (current_language,
+ current_gdbarch,
+ name);
+ if (type == NULL && strcmp ("system__address", name) == 0)
+ type = type_system_address ();
+
+ if (type != NULL)
+ {
+ /* Check to see if we have a regular definition of this
+ type that just didn't happen to have been read yet. */
+ int ntypes;
+ struct symbol *sym;
+ char *expanded_name =
+ (char *) alloca (strlen (name) + sizeof ("standard__"));
+ strcpy (expanded_name, "standard__");
+ strcat (expanded_name, name);
+ sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL, NULL);
+ if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
+ type = SYMBOL_TYPE (sym);
+ }
+
+ return type;
+}
+
+static int
+chop_selector (char *name, int end)
+{
+ int i;
+ for (i = end - 1; i > 0; i -= 1)
+ if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
+ return i;
+ return -1;
+}
+
+/* Given that SELS is a string of the form (<sep><identifier>)*, where
+ <sep> is '__' or '.', write the indicated sequence of
+ STRUCTOP_STRUCT expression operators. */
+static void
+write_selectors (char *sels)
+{
+ while (*sels != '\0')
+ {
+ struct stoken field_name;
+ char *p;
+ while (*sels == '_' || *sels == '.')
+ sels += 1;
+ p = sels;
+ while (*sels != '\0' && *sels != '.'
+ && (sels[0] != '_' || sels[1] != '_'))
+ sels += 1;
+ field_name.length = sels - p;
+ field_name.ptr = p;
+ write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
+ }
+}
+
+/* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
+ NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
+ a temporary symbol that is valid until the next call to ada_parse.
+ */
+static void
+write_ambiguous_var (struct block *block, char *name, int len)
+{
+ struct symbol *sym =
+ obstack_alloc (&temp_parse_space, sizeof (struct symbol));
+ memset (sym, 0, sizeof (struct symbol));
+ SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
+ SYMBOL_LINKAGE_NAME (sym) = obsavestring (name, len, &temp_parse_space);
+ SYMBOL_LANGUAGE (sym) = language_ada;
+
+ write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_block (block);
+ write_exp_elt_sym (sym);
+ write_exp_elt_opcode (OP_VAR_VALUE);
+}
+
+
+/* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
+ expression_block_context if NULL). If it denotes a type, return
+ that type. Otherwise, write expression code to evaluate it as an
+ object and return NULL. In this second case, NAME0 will, in general,
+ have the form <name>(.<selector_name>)*, where <name> is an object
+ or renaming encoded in the debugging data. Calls error if no
+ prefix <name> matches a name in the debugging data (i.e., matches
+ either a complete name or, as a wild-card match, the final
+ identifier). */
+
+static struct type*
+write_var_or_type (struct block *block, struct stoken name0)
+{
+ int depth;
+ char *encoded_name;
+ int name_len;
+
+ if (block == NULL)
+ block = expression_context_block;
+
+ encoded_name = ada_encode (name0.ptr);
+ name_len = strlen (encoded_name);
+ encoded_name = obsavestring (encoded_name, name_len, &temp_parse_space);
+ for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
+ {
+ int tail_index;
+
+ tail_index = name_len;
+ while (tail_index > 0)
+ {
+ int nsyms;
+ struct ada_symbol_info *syms;
+ struct symbol *type_sym;
+ int terminator = encoded_name[tail_index];
+
+ encoded_name[tail_index] = '\0';
+ nsyms = ada_lookup_symbol_list (encoded_name, block,
+ VAR_DOMAIN, &syms);
+ encoded_name[tail_index] = terminator;
+
+ /* A single symbol may rename a package or object. */
+
+ if (nsyms == 1 && !ada_is_object_renaming (syms[0].sym))
+ {
+ struct symbol *renaming_sym =
+ ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym),
+ syms[0].block);
+
+ if (renaming_sym != NULL)
+ syms[0].sym = renaming_sym;
+ }
+
+ type_sym = select_possible_type_sym (syms, nsyms);
+ if (type_sym != NULL)
+ {
+ struct type *type = SYMBOL_TYPE (type_sym);
+
+ if (TYPE_CODE (type) == TYPE_CODE_VOID)
+ error (_("`%s' matches only void type name(s)"), name0.ptr);
+ else if (ada_is_object_renaming (type_sym))
+ {
+ write_object_renaming (block, type_sym,
+ MAX_RENAMING_CHAIN_LENGTH);
+ write_selectors (encoded_name + tail_index);
+ return NULL;
+ }
+ else if (ada_renaming_type (SYMBOL_TYPE (type_sym)) != NULL)
+ {
+ int result;
+ char *renaming = ada_simple_renamed_entity (type_sym);
+ int renaming_len = strlen (renaming);
+
+ char *new_name
+ = obstack_alloc (&temp_parse_space,
+ renaming_len + name_len - tail_index
+ + 1);
+ strcpy (new_name, renaming);
+ xfree (renaming);
+ strcpy (new_name + renaming_len, encoded_name + tail_index);
+ encoded_name = new_name;
+ name_len = renaming_len + name_len - tail_index;
+ goto TryAfterRenaming;
+ }
+ else if (tail_index == name_len)
+ return type;
+ else
+ error (_("Invalid attempt to select from type: \"%s\"."), name0.ptr);
+ }
+ else if (tail_index == name_len && nsyms == 0)
+ {
+ struct type *type = find_primitive_type (encoded_name);
+
+ if (type != NULL)
+ return type;
+ }
+
+ if (nsyms == 1)
+ {
+ write_var_from_sym (block, syms[0].block, syms[0].sym);
+ write_selectors (encoded_name + tail_index);
+ return NULL;
+ }
+ else if (nsyms == 0)
+ {
+ int i;
+ struct minimal_symbol *msym
+ = ada_lookup_simple_minsym (encoded_name);
+ if (msym != NULL)
+ {
+ write_exp_msymbol (msym, lookup_function_type (type_int ()),
+ type_int ());
+ /* Maybe cause error here rather than later? FIXME? */
+ write_selectors (encoded_name + tail_index);
+ return NULL;
+ }
+
+ if (tail_index == name_len
+ && strncmp (encoded_name, "standard__",
+ sizeof ("standard__") - 1) == 0)
+ error (_("No definition of \"%s\" found."), name0.ptr);
+
+ tail_index = chop_selector (encoded_name, tail_index);
+ }
+ else
+ {
+ write_ambiguous_var (block, encoded_name, tail_index);
+ write_selectors (encoded_name + tail_index);
+ return NULL;
+ }
+ }
+
+ if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
+ error (_("No symbol table is loaded. Use the \"file\" command."));
+ if (block == expression_context_block)
+ error (_("No definition of \"%s\" in current context."), name0.ptr);
+ else
+ error (_("No definition of \"%s\" in specified context."), name0.ptr);
+
+ TryAfterRenaming: ;
+ }
+
+ error (_("Could not find renamed symbol \"%s\""), name0.ptr);
+
+}
+
+/* Write a left side of a component association (e.g., NAME in NAME =>
+ exp). If NAME has the form of a selected component, write it as an
+ ordinary expression. If it is a simple variable that unambiguously
+ corresponds to exactly one symbol that does not denote a type or an
+ object renaming, also write it normally as an OP_VAR_VALUE.
+ Otherwise, write it as an OP_NAME.
+
+ Unfortunately, we don't know at this point whether NAME is supposed
+ to denote a record component name or the value of an array index.
+ Therefore, it is not appropriate to disambiguate an ambiguous name
+ as we normally would, nor to replace a renaming with its referent.
+ As a result, in the (one hopes) rare case that one writes an
+ aggregate such as (R => 42) where R renames an object or is an
+ ambiguous name, one must write instead ((R) => 42). */
+
+static void
+write_name_assoc (struct stoken name)
+{
+ if (strchr (name.ptr, '.') == NULL)
+ {
+ struct ada_symbol_info *syms;
+ int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
+ VAR_DOMAIN, &syms);
+ if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF)
+ write_exp_op_with_string (OP_NAME, name);
+ else
+ write_var_from_sym (NULL, syms[0].block, syms[0].sym);
+ }
+ else
+ if (write_var_or_type (NULL, name) != NULL)
+ error (_("Invalid use of type."));
+}
+