aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPer Bothner <per@bothner.com>1995-11-30 03:26:34 +0000
committerPer Bothner <per@bothner.com>1995-11-30 03:26:34 +0000
commit5e54886116dd58d05183a465350c127f65fa4460 (patch)
treedf9f188beaf544b89ab36d73c970de5fb00a7f85
parentdcdba37e2d5970979f1d87cef209495aae83f94c (diff)
downloadgdb-5e54886116dd58d05183a465350c127f65fa4460.zip
gdb-5e54886116dd58d05183a465350c127f65fa4460.tar.gz
gdb-5e54886116dd58d05183a465350c127f65fa4460.tar.bz2
* ch-exp.y: Replaced by ...
* ch-exp.c: New file. Use recursive-descent. Recognize labelled array tuples and powerset ranges. * Makefile.in: Update for no longer using yacc for ch-exp. * c-lang.c: Make various functions non-static. * c-lang.h: Add bunches of prototypes. * cp-valprint.c (cp_print_value_fields): Also take address. (cp_print_value): Likewise. Use baselcass_offset. * stabsread.c (current_symbol): New static variable. (type_synonym_name): Remove. (read_type): If copying, make copy be a TYPE_CODE_TYPEDEF. (read_array_type): Don't need to handle undefined element type here. (cleanup_undefined_types): Ditto. (read_range_type): Look for Chill ranges. * valops.c (value_assign): Fix case lval_internalvar - don't try to assign into old value (which might be too small!). (value_coerce_array): No longer need special VALUE_REPEATED handling. (value_arg_coerce): Cleaner array->pointer decay mechanism. (search_struct_field): Use baseclass_offset rather than baseclass_addr. (value_slice): Use get_discrete_bounds. * value.h (COERCE_VARYING_ARRAY): Take type argumnt as well. * values.c (baseclass_offset): Change parameter interface. (baseclass_addr): Removed. * c-typeprint.c, c-valprint.c, ch-valprint.c, values.c, valops.c: Add check_typedef/CHECK_TYPEDEF as needed.
-rw-r--r--gdb/ChangeLog28
-rw-r--r--gdb/Makefile.in47
-rw-r--r--gdb/c-lang.c8
-rw-r--r--gdb/c-lang.h48
-rw-r--r--gdb/c-typeprint.c12
-rw-r--r--gdb/c-valprint.c57
-rw-r--r--gdb/ch-exp.c1974
-rw-r--r--gdb/ch-exp.y1664
-rw-r--r--gdb/ch-valprint.c22
-rw-r--r--gdb/cp-valprint.c87
-rw-r--r--gdb/stabsread.c110
-rw-r--r--gdb/valops.c332
-rw-r--r--gdb/values.c164
13 files changed, 2388 insertions, 2165 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 2d97855..076e30b 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -26,6 +26,34 @@ Wed Nov 29 13:35:18 1995 Per Bothner <bothner@kalessin.cygnus.com>
* gdbtypes.c, ch-lang.c, ch-typeprint.c (numerous places):
Add check_typedef/CHECK_TYPEDEF as needed.
+ * ch-exp.y: Replaced by ...
+ * ch-exp.c: New file. Use recursive-descent.
+ Recognize labelled array tuples and powerset ranges.
+ * Makefile.in: Update for no longer using yacc for ch-exp.
+
+ * c-lang.c: Make various functions non-static.
+ * c-lang.h: Add bunches of prototypes.
+ * cp-valprint.c (cp_print_value_fields): Also take address.
+ (cp_print_value): Likewise. Use baselcass_offset.
+ * stabsread.c (current_symbol): New static variable.
+ (type_synonym_name): Remove.
+ (read_type): If copying, make copy be a TYPE_CODE_TYPEDEF.
+ (read_array_type): Don't need to handle undefined element type here.
+ (cleanup_undefined_types): Ditto.
+ (read_range_type): Look for Chill ranges.
+ * valops.c (value_assign): Fix case lval_internalvar - don't try
+ to assign into old value (which might be too small!).
+ (value_coerce_array): No longer need special VALUE_REPEATED handling.
+ (value_arg_coerce): Cleaner array->pointer decay mechanism.
+ (search_struct_field): Use baseclass_offset rather than
+ baseclass_addr.
+ (value_slice): Use get_discrete_bounds.
+ * value.h (COERCE_VARYING_ARRAY): Take type argumnt as well.
+ * values.c (baseclass_offset): Change parameter interface.
+ (baseclass_addr): Removed.
+ * c-typeprint.c, c-valprint.c, ch-valprint.c, values.c, valops.c:
+ Add check_typedef/CHECK_TYPEDEF as needed.
+
* alpha-tdep.c, c-exp.y, h8500-tdep.c, f-exp.y, f-valprint.c,
findvar.c, hppa-tdep.c, infcmd.c, language.c, printcmd.c,
rs6000-tdep.c, symmisc.c, symtab.c, mdebugread.c:
diff --git a/gdb/Makefile.in b/gdb/Makefile.in
index 44e0b22..cd6ef84 100644
--- a/gdb/Makefile.in
+++ b/gdb/Makefile.in
@@ -347,7 +347,7 @@ TARGET_FLAGS_TO_PASS = \
# SFILES is used in building the distribution archive.
SFILES = blockframe.c breakpoint.c buildsym.c callback.c c-exp.y c-lang.c \
- c-typeprint.c c-valprint.c ch-exp.y ch-lang.c ch-typeprint.c \
+ c-typeprint.c c-valprint.c ch-exp.c ch-lang.c ch-typeprint.c \
ch-valprint.c coffread.c command.c complaints.c corefile.c cp-valprint.c \
dbxread.c demangle.c dwarfread.c \
elfread.c environ.c eval.c expprint.c \
@@ -466,7 +466,7 @@ COMMON_OBS = version.o blockframe.o breakpoint.o findvar.o stack.o thread.o \
exec.o objfiles.o minsyms.o maint.o demangle.o \
dbxread.o coffread.o elfread.o \
dwarfread.o mipsread.o stabsread.o corefile.o \
- c-lang.o ch-lang.o f-lang.o m2-lang.o \
+ c-lang.o ch-exp.o ch-lang.o f-lang.o m2-lang.o \
scm-exp.o scm-lang.o scm-valprint.o complaints.o typeprint.o \
c-typeprint.o ch-typeprint.o f-typeprint.o m2-typeprint.o \
c-valprint.o cp-valprint.o ch-valprint.o f-valprint.o m2-valprint.o \
@@ -485,8 +485,8 @@ NTSSTART = kdb-start.o
SUBDIRS = doc testsuite nlm
# For now, shortcut the "configure GDB for fewer languages" stuff.
-YYFILES = c-exp.tab.c f-exp.tab.c m2-exp.tab.c ch-exp.tab.c
-YYOBJ = c-exp.tab.o f-exp.tab.o m2-exp.tab.o ch-exp.tab.o
+YYFILES = c-exp.tab.c f-exp.tab.c m2-exp.tab.c
+YYOBJ = c-exp.tab.o f-exp.tab.o m2-exp.tab.o
# Things which need to be built when making a distribution.
@@ -630,10 +630,10 @@ libgdb-files: $(LIBGDBDEPS) Makefile.in
saber_gdb: $(SFILES) $(DEPFILES) copying.c version.c
#setopt load_flags $(CFLAGS) $(BFD_CFLAGS) -DHOST_SYS=SUN4_SYS
#load ./init.c $(SFILES)
- #unload $(srcdir)/c-exp.y $(srcdir)/m2-exp.y $(srcdir)/ch-exp.y
+ #unload $(srcdir)/c-exp.y $(srcdir)/m2-exp.y
#unload vx-share/*.h
#unload nindy-share/[A-Z]*
- #load c-exp.tab.c m2-exp.tab.c ch-exp.tab.c
+ #load c-exp.tab.c m2-exp.tab.c
#load copying.c version.c
#load ../opcodes/libopcodes.a
#load ../libiberty/libiberty.a
@@ -722,7 +722,7 @@ clean mostlyclean:
rm -f gdb core make.log libgdb-files
rm -f gdb[0-9]
-# This used to depend on c-exp.tab.c m2-exp.tab.c ch-exp.tab.c TAGS
+# This used to depend on c-exp.tab.c m2-exp.tab.c TAGS
# I believe this is wrong; the makefile standards for distclean just
# describe removing files; the only sort of "re-create a distribution"
# functionality described is if the distributed files are unmodified.
@@ -737,7 +737,7 @@ maintainer-clean realclean: clean
@echo "This command is intended for maintainers to use;"
@echo "it deletes files that may require special tools to rebuild."
@$(MAKE) $(FLAGS_TO_PASS) DO=maintainer-clean "DODIRS=$(SUBDIRS)" subdir_do
- rm -f c-exp.tab.c f-exp.tab.c m2-exp.tab.c ch-exp.tab.c
+ rm -f c-exp.tab.c f-exp.tab.c m2-exp.tab.c
rm -f TAGS $(INFOFILES)
rm -f nm.h tm.h xm.h config.status
rm -f y.output yacc.acts yacc.tmp
@@ -825,35 +825,12 @@ f-exp.tab.c: f-exp.y c-exp.tab.c
-rm y.tab.c
mv f-exp.new ./f-exp.tab.c
-# ch-exp.tab.c is generated in objdir from ch-exp.y if it doesn't exist
-# in srcdir, then compiled in objdir to ch-exp.tab.o.
-# Remove bogus decls for malloc/realloc/free which conflict with everything
-# else.
-ch-exp.tab.o: ch-exp.tab.c
-# the dependency here on f-exp.tab.c is artificial. Without this
-# dependency, a parallel make will attempt to build both at the same
-# time and the second yacc will pollute the first y.tab.c file.
-ch-exp.tab.c: ch-exp.y f-exp.tab.c
- $(YACC) $(YFLAGS) $(srcdir)/ch-exp.y
- -sed -e '/extern.*malloc/d' \
- -e '/extern.*realloc/d' \
- -e '/extern.*free/d' \
- -e '/include.*malloc.h/d' \
- -e 's/malloc/xmalloc/g' \
- -e 's/realloc/xrealloc/g' \
- < y.tab.c > ch-exp.new
- -rm y.tab.c
- mv ch-exp.new ./ch-exp.tab.c
-
# m2-exp.tab.c is generated in objdir from m2-exp.y if it doesn't exist
# in srcdir, then compiled in objdir to m2-exp.tab.o.
# Remove bogus decls for malloc/realloc/free which conflict with everything
# else.
m2-exp.tab.o: m2-exp.tab.c
-# the dependency here on ch-exp.tab.c is artificial. Without this
-# dependency, a parallel make will attempt to build both at the same
-# time and the second yacc will pollute the first y.tab.c file.
-m2-exp.tab.c: m2-exp.y ch-exp.tab.c
+m2-exp.tab.c: m2-exp.y
$(YACC) $(YFLAGS) $(srcdir)/m2-exp.y
-sed -e '/extern.*malloc/d' \
-e '/extern.*realloc/d' \
@@ -866,7 +843,7 @@ m2-exp.tab.c: m2-exp.y ch-exp.tab.c
mv m2-exp.new ./m2-exp.tab.c
# These files are updated atomically, so make never has to remove them
-.PRECIOUS: m2-exp.tab.c ch-exp.tab.c f-exp.tab.c c-exp.tab.c
+.PRECIOUS: m2-exp.tab.c f-exp.tab.c c-exp.tab.c
lint: $(LINTFILES)
$(LINT) $(INCLUDE_CFLAGS) $(LINTFLAGS) $(LINTFILES) \
@@ -1525,10 +1502,6 @@ c-exp.tab.o: c-exp.tab.c c-lang.h $(defs_h) $(expression_h) \
$(gdbtypes_h) language.h parser-defs.h $(symtab_h) $(value_h) \
$(bfd_h) objfiles.h symfile.h
-ch-exp.tab.o: ch-exp.tab.c ch-lang.h $(defs_h) $(expression_h) \
- $(gdbtypes_h) language.h parser-defs.h $(symtab_h) $(value_h) \
- $(bfd_h) objfiles.h symfile.h
-
f-exp.tab.o: f-exp.tab.c f-lang.h $(defs_h) $(expression_h) \
language.h parser-defs.h $(value_h) $(bfd_h) objfiles.h symfile.h
diff --git a/gdb/c-lang.c b/gdb/c-lang.c
index 6ed5dc7..66ee3e1 100644
--- a/gdb/c-lang.c
+++ b/gdb/c-lang.c
@@ -78,7 +78,7 @@ emit_char (c, stream, quoter)
}
}
-static void
+void
c_printchar (c, stream)
int c;
GDB_FILE *stream;
@@ -93,7 +93,7 @@ c_printchar (c, stream)
are printed as appropriate. Print ellipses at the end if we
had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
-static void
+void
c_printstr (stream, string, length, force_ellipses)
GDB_FILE *stream;
char *string;
@@ -211,7 +211,7 @@ c_printstr (stream, string, length, force_ellipses)
starts taking it's fundamental type information directly from the
debugging information supplied by the compiler. fnf@cygnus.com */
-static struct type *
+struct type *
c_create_fundamental_type (objfile, typeid)
struct objfile *objfile;
int typeid;
@@ -333,7 +333,7 @@ c_create_fundamental_type (objfile, typeid)
/* Table mapping opcodes into strings for printing operators
and precedences of the operators. */
-static const struct op_print c_op_print_tab[] =
+const struct op_print c_op_print_tab[] =
{
{",", BINOP_COMMA, PREC_COMMA, 0},
{"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
diff --git a/gdb/c-lang.h b/gdb/c-lang.h
index 6f91b37..259fa8d 100644
--- a/gdb/c-lang.h
+++ b/gdb/c-lang.h
@@ -36,3 +36,51 @@ c_val_print PARAMS ((struct type *, char *, CORE_ADDR, GDB_FILE *, int, int,
extern int
c_value_print PARAMS ((struct value *, GDB_FILE *, int, enum val_prettyprint));
+
+/* These are in c-lang.c: */
+
+extern void c_printchar PARAMS ((int, GDB_FILE*));
+
+extern void c_printstr PARAMS ((GDB_FILE *, char *, unsigned int, int));
+
+extern struct type * c_create_fundamental_type PARAMS ((struct objfile*, int));
+
+extern const struct op_print c_op_print_tab[];
+
+extern struct type ** const (c_builtin_types[]);
+
+/* These are in c-typeprint.c: */
+
+extern void
+c_type_print_base PARAMS ((struct type *, GDB_FILE *, int, int));
+
+extern void
+c_type_print_varspec_prefix PARAMS ((struct type *, GDB_FILE *, int, int));
+
+extern void
+cp_type_print_method_args PARAMS ((struct type **, char *, char *, int,
+ GDB_FILE *));
+/* These are in cp-valprint.c */
+
+extern void
+cp_type_print_method_args PARAMS ((struct type **, char *, char *, int,
+ GDB_FILE *));
+
+extern int vtblprint; /* Controls printing of vtbl's */
+
+extern void
+cp_print_class_member PARAMS ((char *, struct type *, GDB_FILE *, char *));
+
+extern void
+cp_print_class_method PARAMS ((char *, struct type *, GDB_FILE *));
+
+extern void
+cp_print_value_fields PARAMS ((struct type *, char *, CORE_ADDR,
+ GDB_FILE *, int, int, enum val_prettyprint,
+ struct type**, int));
+
+extern int
+cp_is_vtbl_ptr_type PARAMS ((struct type *));
+
+extern int
+cp_is_vtbl_member PARAMS ((struct type *));
diff --git a/gdb/c-typeprint.c b/gdb/c-typeprint.c
index af61d8a..9be2d52 100644
--- a/gdb/c-typeprint.c
+++ b/gdb/c-typeprint.c
@@ -50,9 +50,6 @@ cp_type_print_derivation_info PARAMS ((GDB_FILE *, struct type *));
void
c_type_print_varspec_prefix PARAMS ((struct type *, GDB_FILE *, int, int));
-void
-c_type_print_base PARAMS ((struct type *, GDB_FILE *, int, int));
-
/* Print a description of a type in the format of a
typedef for the current language.
@@ -64,6 +61,7 @@ c_typedef_print (type, new, stream)
struct symbol *new;
GDB_FILE *stream;
{
+ CHECK_TYPEDEF (type);
switch (current_language->la_language)
{
#ifdef _LANG_c
@@ -118,6 +116,9 @@ c_print_type (type, varstring, stream, show, level)
register enum type_code code;
int demangled_args;
+ if (show > 0)
+ CHECK_TYPEDEF (type);
+
c_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
@@ -315,6 +316,7 @@ c_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
case TYPE_CODE_STRING:
case TYPE_CODE_BITSTRING:
case TYPE_CODE_COMPLEX:
+ case TYPE_CODE_TYPEDEF:
/* These types need no prefix. They are listed here so that
gcc -Wall will reveal any types that haven't been handled. */
break;
@@ -453,6 +455,7 @@ c_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
case TYPE_CODE_STRING:
case TYPE_CODE_BITSTRING:
case TYPE_CODE_COMPLEX:
+ case TYPE_CODE_TYPEDEF:
/* These types do not need a suffix. They are listed so that
gcc -Wall will report types that may not have been considered. */
break;
@@ -510,10 +513,11 @@ c_type_print_base (type, stream, show, level)
return;
}
- check_stub_type (type);
+ CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
+ case TYPE_CODE_TYPEDEF:
case TYPE_CODE_ARRAY:
case TYPE_CODE_PTR:
case TYPE_CODE_MEMBER:
diff --git a/gdb/c-valprint.c b/gdb/c-valprint.c
index 042ac2f..f4abf7f 100644
--- a/gdb/c-valprint.c
+++ b/gdb/c-valprint.c
@@ -26,40 +26,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
#include "demangle.h"
#include "valprint.h"
#include "language.h"
-
-/* BEGIN-FIXME */
-
-extern int vtblprint; /* Controls printing of vtbl's */
-
-extern void
-cp_print_class_member PARAMS ((char *, struct type *, GDB_FILE *, char *));
-
-extern void
-cp_print_class_method PARAMS ((char *, struct type *, GDB_FILE *));
-
-extern void
-cp_print_value_fields PARAMS ((struct type *, char *, GDB_FILE *, int, int,
- enum val_prettyprint, struct type **, int));
-
-extern int
-cp_is_vtbl_ptr_type PARAMS ((struct type *));
-
-extern int
-cp_is_vtbl_member PARAMS ((struct type *));
-
-/* END-FIXME */
-
-
-/* BEGIN-FIXME: Hooks into c-typeprint.c */
-
-extern void
-c_type_print_varspec_prefix PARAMS ((struct type *, GDB_FILE *, int, int));
-
-extern void
-cp_type_print_method_args PARAMS ((struct type **, char *, char *, int,
- GDB_FILE *));
-/* END-FIXME */
-
+#include "c-lang.h"
/* Print data of type TYPE located at VALADDR (within GDB), which came from
@@ -94,12 +61,13 @@ c_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
LONGEST val;
CORE_ADDR addr;
+ CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
case TYPE_CODE_ARRAY:
if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
{
- elttype = TYPE_TARGET_TYPE (type);
+ elttype = check_typedef (TYPE_TARGET_TYPE (type));
eltlen = TYPE_LENGTH (elttype);
len = TYPE_LENGTH (type) / eltlen;
if (prettyprint_arrays)
@@ -169,11 +137,12 @@ c_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
stream, demangle);
break;
}
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_METHOD)
+ elttype = check_typedef (TYPE_TARGET_TYPE (type));
+ if (TYPE_CODE (elttype) == TYPE_CODE_METHOD)
{
cp_print_class_method (valaddr, type, stream);
}
- else if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_MEMBER)
+ else if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
{
cp_print_class_member (valaddr,
TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type)),
@@ -183,7 +152,6 @@ c_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
{
addr = unpack_pointer (type, valaddr);
print_unpacked_pointer:
- elttype = TYPE_TARGET_TYPE (type);
if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
{
@@ -266,10 +234,11 @@ c_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
break;
case TYPE_CODE_REF:
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_MEMBER)
+ elttype = check_typedef (TYPE_TARGET_TYPE (type));
+ if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
{
cp_print_class_member (valaddr,
- TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type)),
+ TYPE_DOMAIN_TYPE (elttype),
stream, "");
break;
}
@@ -285,7 +254,7 @@ c_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
/* De-reference the reference. */
if (deref_ref)
{
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_UNDEF)
+ if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
{
value_ptr deref_val =
value_at
@@ -318,10 +287,10 @@ c_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
print_address_demangle(*((int *) (valaddr + /* FIXME bytesex */
TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8)),
stream, demangle);
- break;
}
- cp_print_value_fields (type, valaddr, stream, format, recurse, pretty,
- NULL, 0);
+ else
+ cp_print_value_fields (type, valaddr, address, stream, format,
+ recurse, pretty, NULL, 0);
break;
case TYPE_CODE_ENUM:
diff --git a/gdb/ch-exp.c b/gdb/ch-exp.c
new file mode 100644
index 0000000..28f44fd
--- /dev/null
+++ b/gdb/ch-exp.c
@@ -0,0 +1,1974 @@
+/* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
+ Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
+
+This file is part of GDB.
+
+This program 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 2 of the License, or
+(at your option) any later version.
+
+This program 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 this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+
+/* Parse a Chill expression from text in a string,
+ and return the result as a struct expression pointer.
+ That structure contains arithmetic operations in reverse polish,
+ with constants represented by operations that are followed by special data.
+ See expression.h for the details of the format.
+ What is important here is that it can be built up sequentially
+ during the process of parsing; the lower levels of the tree always
+ come first in the result.
+
+ Note that malloc's and realloc's in this file are transformed to
+ xmalloc and xrealloc respectively by the same sed command in the
+ makefile that remaps any other malloc/realloc inserted by the parser
+ generator. Doing this with #defines and trying to control the interaction
+ with include files (<malloc.h> and <stdlib.h> for example) just became
+ too messy, particularly when such includes can be inserted at random
+ times by the parser generator.
+
+ Also note that the language accepted by this parser is more liberal
+ than the one accepted by an actual Chill compiler. For example, the
+ language rule that a simple name string can not be one of the reserved
+ simple name strings is not enforced (e.g "case" is not treated as a
+ reserved name). Another example is that Chill is a strongly typed
+ language, and certain expressions that violate the type constraints
+ may still be evaluated if gdb can do so in a meaningful manner, while
+ such expressions would be rejected by the compiler. The reason for
+ this more liberal behavior is the philosophy that the debugger
+ is intended to be a tool that is used by the programmer when things
+ go wrong, and as such, it should provide as few artificial barriers
+ to it's use as possible. If it can do something meaningful, even
+ something that violates language contraints that are enforced by the
+ compiler, it should do so without complaint.
+
+ */
+
+#include "defs.h"
+#include <string.h>
+#include <ctype.h>
+#include "expression.h"
+#include "language.h"
+#include "value.h"
+#include "parser-defs.h"
+#include "ch-lang.h"
+#include "bfd.h" /* Required by objfiles.h. */
+#include "symfile.h" /* Required by objfiles.h. */
+#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
+
+typedef union
+
+ {
+ LONGEST lval;
+ unsigned LONGEST ulval;
+ struct {
+ LONGEST val;
+ struct type *type;
+ } typed_val;
+ double dval;
+ struct symbol *sym;
+ struct type *tval;
+ struct stoken sval;
+ struct ttype tsym;
+ struct symtoken ssym;
+ }YYSTYPE;
+
+enum ch_terminal {
+ END_TOKEN = 0,
+ /* '\001' ... '\xff' come first. */
+ TOKEN_NOT_READ = 999,
+ INTEGER_LITERAL,
+ BOOLEAN_LITERAL,
+ CHARACTER_LITERAL,
+ FLOAT_LITERAL,
+ GENERAL_PROCEDURE_NAME,
+ LOCATION_NAME,
+ EMPTINESS_LITERAL,
+ CHARACTER_STRING_LITERAL,
+ BIT_STRING_LITERAL,
+ TYPENAME,
+ FIELD_NAME,
+ CASE,
+ OF,
+ ESAC,
+ LOGIOR,
+ ORIF,
+ LOGXOR,
+ LOGAND,
+ ANDIF,
+ NOTEQUAL,
+ GEQ,
+ LEQ,
+ IN,
+ SLASH_SLASH,
+ MOD,
+ REM,
+ NOT,
+ POINTER,
+ RECEIVE,
+ UP,
+ IF,
+ THEN,
+ ELSE,
+ FI,
+ ELSIF,
+ ILLEGAL_TOKEN,
+ NUM,
+ PRED,
+ SUCC,
+ ABS,
+ CARD,
+ MAX_TOKEN,
+ MIN_TOKEN,
+ ADDR_TOKEN,
+ SIZE,
+ UPPER,
+ LOWER,
+ LENGTH,
+ ARRAY,
+ GDB_VARIABLE,
+ GDB_ASSIGNMENT
+};
+
+/* Forward declarations. */
+static void parse_expr ();
+static void parse_primval ();
+static void parse_untyped_expr ();
+static int parse_opt_untyped_expr ();
+static void parse_if_expression_body PARAMS((void));
+static void write_lower_upper_value PARAMS ((enum exp_opcode, struct type *));
+static enum ch_terminal ch_lex ();
+
+#define MAX_LOOK_AHEAD 2
+static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD+1] = {
+ TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
+static YYSTYPE yylval;
+static YYSTYPE val_buffer[MAX_LOOK_AHEAD+1];
+
+/*int current_token, lookahead_token;*/
+
+#ifdef __GNUC__
+__inline__
+#endif
+static enum ch_terminal
+PEEK_TOKEN()
+{
+ if (terminal_buffer[0] == TOKEN_NOT_READ)
+ {
+ terminal_buffer[0] = ch_lex ();
+ val_buffer[0] = yylval;
+ }
+ return terminal_buffer[0];
+}
+#define PEEK_LVAL() val_buffer[0]
+#define PEEK_TOKEN1() peek_token_(1)
+#define PEEK_TOKEN2() peek_token_(2)
+static enum ch_terminal
+peek_token_ (i)
+ int i;
+{
+ if (i > MAX_LOOK_AHEAD)
+ fatal ("internal error - too much lookahead");
+ if (terminal_buffer[i] == TOKEN_NOT_READ)
+ {
+ terminal_buffer[i] = ch_lex ();
+ val_buffer[i] = yylval;
+ }
+ return terminal_buffer[i];
+}
+
+static void
+pushback_token (code, node)
+ enum ch_terminal code;
+ YYSTYPE node;
+{
+ int i;
+ if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
+ fatal ("internal error - cannot pushback token");
+ for (i = MAX_LOOK_AHEAD; i > 0; i--)
+ {
+ terminal_buffer[i] = terminal_buffer[i - 1];
+ val_buffer[i] = val_buffer[i - 1];
+ }
+ terminal_buffer[0] = code;
+ val_buffer[0] = node;
+}
+
+static void
+forward_token_()
+{
+ int i;
+ for (i = 0; i < MAX_LOOK_AHEAD; i++)
+ {
+ terminal_buffer[i] = terminal_buffer[i+1];
+ val_buffer[i] = val_buffer[i+1];
+ }
+ terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
+}
+#define FORWARD_TOKEN() forward_token_()
+
+/* Skip the next token.
+ if it isn't TOKEN, the parser is broken. */
+
+void
+require(token)
+ enum ch_terminal token;
+{
+ if (PEEK_TOKEN() != token)
+ {
+ char buf[80];
+ sprintf (buf, "internal parser error - expected token %d", (int)token);
+ fatal(buf);
+ }
+ FORWARD_TOKEN();
+}
+
+int
+check_token (token)
+ enum ch_terminal token;
+{
+ if (PEEK_TOKEN() != token)
+ return 0;
+ FORWARD_TOKEN ();
+ return 1;
+}
+
+/* return 0 if expected token was not found,
+ else return 1.
+*/
+int
+expect(token, message)
+ enum ch_terminal token;
+ char *message;
+{
+ if (PEEK_TOKEN() != token)
+ {
+ if (message)
+ error (message);
+ else if (token < 256)
+ error ("syntax error - expected a '%c' here '%s'", token, lexptr);
+ else
+ error ("syntax error");
+ return 0;
+ }
+ else
+ FORWARD_TOKEN();
+ return 1;
+}
+
+#if 0
+static tree
+parse_opt_name_string (allow_all)
+ int allow_all; /* 1 if ALL is allowed as a postfix */
+{
+ int token = PEEK_TOKEN();
+ tree name;
+ if (token != NAME)
+ {
+ if (token == ALL && allow_all)
+ {
+ FORWARD_TOKEN ();
+ return ALL_POSTFIX;
+ }
+ return NULL_TREE;
+ }
+ name = PEEK_LVAL();
+ for (;;)
+ {
+ FORWARD_TOKEN ();
+ token = PEEK_TOKEN();
+ if (token != '!')
+ return name;
+ FORWARD_TOKEN();
+ token = PEEK_TOKEN();
+ if (token == ALL && allow_all)
+ return get_identifier3(IDENTIFIER_POINTER (name), "!", "*");
+ if (token != NAME)
+ {
+ if (pass == 1)
+ error ("'%s!' is not followed by an identifier",
+ IDENTIFIER_POINTER (name));
+ return name;
+ }
+ name = get_identifier3(IDENTIFIER_POINTER(name),
+ "!", IDENTIFIER_POINTER(PEEK_LVAL()));
+ }
+}
+
+static tree
+parse_simple_name_string ()
+{
+ int token = PEEK_TOKEN();
+ tree name;
+ if (token != NAME)
+ {
+ error ("expected a name here");
+ return error_mark_node;
+ }
+ name = PEEK_LVAL ();
+ FORWARD_TOKEN ();
+ return name;
+}
+
+static tree
+parse_name_string ()
+{
+ tree name = parse_opt_name_string (0);
+ if (name)
+ return name;
+ if (pass == 1)
+ error ("expected a name string here");
+ return error_mark_node;
+}
+
+/* Matches: <name_string>
+ Returns if pass 1: the identifier.
+ Returns if pass 2: a decl or value for identifier. */
+
+static tree
+parse_name ()
+{
+ tree name = parse_name_string ();
+ if (pass == 1 || ignoring)
+ return name;
+ else
+ {
+ tree decl = lookup_name (name);
+ if (decl == NULL_TREE)
+ {
+ error ("`%s' undeclared", IDENTIFIER_POINTER (name));
+ return error_mark_node;
+ }
+ else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
+ return error_mark_node;
+ else if (TREE_CODE (decl) == CONST_DECL)
+ return DECL_INITIAL (decl);
+ else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
+ return convert_from_reference (decl);
+ else
+ return decl;
+ }
+}
+#endif
+
+#if 0
+static void
+pushback_paren_expr (expr)
+ tree expr;
+{
+ if (pass == 1 && !ignoring)
+ expr = build1 (PAREN_EXPR, NULL_TREE, expr);
+ pushback_token (EXPR, expr);
+}
+#endif
+
+/* Matches: <case label> */
+
+static void
+parse_case_label ()
+{
+ if (check_token (ELSE))
+ error ("ELSE in tuples labels not implemented");
+ /* Does not handle the case of a mode name. FIXME */
+ parse_expr ();
+ if (check_token (':'))
+ {
+ parse_expr ();
+ write_exp_elt_opcode (BINOP_RANGE);
+ }
+}
+
+static int
+parse_opt_untyped_expr ()
+{
+ switch (PEEK_TOKEN ())
+ {
+ case ',':
+ case ':':
+ case ')':
+ return 0;
+ default:
+ parse_untyped_expr ();
+ return 1;
+ }
+}
+
+static void
+parse_unary_call ()
+{
+ FORWARD_TOKEN ();
+ expect ('(', NULL);
+ parse_expr ();
+ expect (')', NULL);
+}
+
+/* Parse NAME '(' MODENAME ')'. */
+
+struct type *
+parse_mode_call ()
+{
+ struct type *type;
+ FORWARD_TOKEN ();
+ expect ('(', NULL);
+ if (PEEK_TOKEN () != TYPENAME)
+ error ("expect MODENAME here `%s'", lexptr);
+ type = PEEK_LVAL().tsym.type;
+ FORWARD_TOKEN ();
+ expect (')', NULL);
+ return type;
+}
+
+struct type *
+parse_mode_or_normal_call ()
+{
+ struct type *type;
+ FORWARD_TOKEN ();
+ expect ('(', NULL);
+ if (PEEK_TOKEN () == TYPENAME)
+ {
+ type = PEEK_LVAL().tsym.type;
+ FORWARD_TOKEN ();
+ }
+ else
+ {
+ parse_expr ();
+ type = NULL;
+ }
+ expect (')', NULL);
+ return type;
+}
+
+/* Parse something that looks like a function call.
+ Assume we have parsed the function, and are at the '('. */
+
+static void
+parse_call ()
+{
+ int arg_count;
+ require ('(');
+ /* This is to save the value of arglist_len
+ being accumulated for each dimension. */
+ start_arglist ();
+ if (parse_opt_untyped_expr ())
+ {
+ int tok = PEEK_TOKEN ();
+ arglist_len = 1;
+ if (tok == UP || tok == ':')
+ {
+ FORWARD_TOKEN ();
+ parse_expr ();
+ expect (')', "expected ')' to terminate slice");
+ end_arglist ();
+ write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
+ : TERNOP_SLICE);
+ return;
+ }
+ while (check_token (','))
+ {
+ parse_untyped_expr ();
+ arglist_len++;
+ }
+ }
+ else
+ arglist_len = 0;
+ expect (')', "expected ')' here");
+ arg_count = end_arglist ();
+ write_exp_elt_opcode (MULTI_SUBSCRIPT);
+ write_exp_elt_longcst (arg_count);
+ write_exp_elt_opcode (MULTI_SUBSCRIPT);
+}
+
+static void
+parse_named_record_element ()
+{
+ struct stoken label = PEEK_LVAL ().sval;
+ expect (FIELD_NAME, "expected a field name here `%s'", lexptr);
+ if (check_token (','))
+ parse_named_record_element ();
+ else if (check_token (':'))
+ parse_expr ();
+ else
+ error ("syntax error near `%s' in named record tuple element", lexptr);
+ write_exp_elt_opcode (OP_LABELED);
+ write_exp_string (label);
+ write_exp_elt_opcode (OP_LABELED);
+}
+
+/* Returns one or nore TREE_LIST nodes, in reverse order. */
+
+static void
+parse_tuple_element ()
+{
+ if (PEEK_TOKEN () == FIELD_NAME)
+ {
+ /* Parse a labelled structure tuple. */
+ parse_named_record_element ();
+ return;
+ }
+
+ if (check_token ('('))
+ {
+ if (check_token ('*'))
+ {
+ expect (')', "missing ')' after '*' case label list");
+ error ("(*) not implemented in case label list");
+ }
+ else
+ {
+ parse_case_label ();
+ while (check_token (','))
+ {
+ parse_case_label ();
+ write_exp_elt_opcode (BINOP_COMMA);
+ }
+ expect (')', NULL);
+ }
+ }
+ else
+ parse_untyped_expr ();
+ if (check_token (':'))
+ {
+ /* A powerset range or a labeled Array. */
+ parse_untyped_expr ();
+ write_exp_elt_opcode (BINOP_RANGE);
+ }
+}
+
+/* Matches: a COMMA-separated list of tuple elements.
+ Returns a list (of TREE_LIST nodes). */
+static void
+parse_opt_element_list ()
+{
+ arglist_len = 0;
+ if (PEEK_TOKEN () == ']')
+ return;
+ for (;;)
+ {
+ parse_tuple_element ();
+ arglist_len++;
+ if (PEEK_TOKEN () == ']')
+ break;
+ if (!check_token (','))
+ error ("bad syntax in tuple");
+ }
+}
+
+/* Parses: '[' elements ']'
+ If modename is non-NULL it prefixed the tuple. */
+
+static void
+parse_tuple (mode)
+ struct type *mode;
+{
+ require ('[');
+ start_arglist ();
+ parse_opt_element_list ();
+ expect (']', "missing ']' after tuple");
+ write_exp_elt_opcode (OP_ARRAY);
+ write_exp_elt_longcst ((LONGEST) 0);
+ write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
+ write_exp_elt_opcode (OP_ARRAY);
+ if (mode)
+ {
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (mode);
+ write_exp_elt_opcode (UNOP_CAST);
+ }
+}
+
+static void
+parse_primval ()
+{
+ struct type *type;
+ enum exp_opcode op;
+ char *op_name;
+ switch (PEEK_TOKEN ())
+ {
+ case INTEGER_LITERAL:
+ case CHARACTER_LITERAL:
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (PEEK_LVAL ().typed_val.type);
+ write_exp_elt_longcst ((LONGEST) (PEEK_LVAL ().typed_val.val));
+ write_exp_elt_opcode (OP_LONG);
+ FORWARD_TOKEN ();
+ break;
+ case BOOLEAN_LITERAL:
+ write_exp_elt_opcode (OP_BOOL);
+ write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
+ write_exp_elt_opcode (OP_BOOL);
+ FORWARD_TOKEN ();
+ break;
+ case FLOAT_LITERAL:
+ write_exp_elt_opcode (OP_DOUBLE);
+ write_exp_elt_type (builtin_type_double);
+ write_exp_elt_dblcst (PEEK_LVAL ().dval);
+ write_exp_elt_opcode (OP_DOUBLE);
+ FORWARD_TOKEN ();
+ break;
+ case EMPTINESS_LITERAL:
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (lookup_pointer_type (builtin_type_void));
+ write_exp_elt_longcst (0);
+ write_exp_elt_opcode (OP_LONG);
+ FORWARD_TOKEN ();
+ break;
+ case CHARACTER_STRING_LITERAL:
+ write_exp_elt_opcode (OP_STRING);
+ write_exp_string (PEEK_LVAL ().sval);
+ write_exp_elt_opcode (OP_STRING);
+ FORWARD_TOKEN ();
+ break;
+ case BIT_STRING_LITERAL:
+ write_exp_elt_opcode (OP_BITSTRING);
+ write_exp_bitstring (PEEK_LVAL ().sval);
+ write_exp_elt_opcode (OP_BITSTRING);
+ FORWARD_TOKEN ();
+ break;
+ case ARRAY:
+ FORWARD_TOKEN ();
+ /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
+ which casts to an artificial array. */
+ expect ('(', NULL);
+ expect (')', NULL);
+ if (PEEK_TOKEN () != TYPENAME)
+ error ("missing MODENAME after ARRAY()");
+ type = PEEK_LVAL().tsym.type;
+ expect ('(', NULL);
+ parse_expr ();
+ expect (')', "missing right parenthesis");
+ type = create_array_type ((struct type *) NULL, type,
+ create_range_type ((struct type *) NULL,
+ builtin_type_int, 0, 0));
+ TYPE_ARRAY_UPPER_BOUND_TYPE(type) = BOUND_CANNOT_BE_DETERMINED;
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (type);
+ write_exp_elt_opcode (UNOP_CAST);
+ break;
+#if 0
+ case CONST:
+ case EXPR:
+ val = PEEK_LVAL();
+ FORWARD_TOKEN ();
+ break;
+#endif
+ case '(':
+ FORWARD_TOKEN ();
+ parse_expr ();
+ expect (')', "missing right parenthesis");
+ break;
+ case '[':
+ parse_tuple (NULL);
+ break;
+ case GENERAL_PROCEDURE_NAME:
+ case LOCATION_NAME:
+ write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_block (NULL);
+ write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
+ write_exp_elt_opcode (OP_VAR_VALUE);
+ FORWARD_TOKEN ();
+ break;
+ case GDB_VARIABLE: /* gdb specific */
+ FORWARD_TOKEN ();
+ break;
+ case NUM:
+ parse_unary_call ();
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (builtin_type_int);
+ write_exp_elt_opcode (UNOP_CAST);
+ break;
+ case PRED: op_name = "PRED"; goto unimplemented_unary_builtin;
+ case SUCC: op_name = "SUCC"; goto unimplemented_unary_builtin;
+ case ABS: op_name = "ABS"; goto unimplemented_unary_builtin;
+ case CARD: op_name = "CARD"; goto unimplemented_unary_builtin;
+ case MAX_TOKEN: op_name = "MAX"; goto unimplemented_unary_builtin;
+ case MIN_TOKEN: op_name = "MIN"; goto unimplemented_unary_builtin;
+ unimplemented_unary_builtin:
+ parse_unary_call ();
+ error ("not implemented: %s builtin function", op_name);
+ break;
+ case ADDR_TOKEN:
+ parse_unary_call ();
+ write_exp_elt_opcode (UNOP_ADDR);
+ break;
+ case SIZE:
+ type = parse_mode_or_normal_call ();
+ if (type)
+ { write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_int);
+ CHECK_TYPEDEF (type);
+ write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
+ write_exp_elt_opcode (OP_LONG);
+ }
+ else
+ write_exp_elt_opcode (UNOP_SIZEOF);
+ break;
+ case LOWER:
+ op = UNOP_LOWER;
+ goto lower_upper;
+ case UPPER:
+ op = UNOP_UPPER;
+ goto lower_upper;
+ lower_upper:
+ type = parse_mode_or_normal_call ();
+ write_lower_upper_value (op, type);
+ break;
+ case LENGTH:
+ parse_unary_call ();
+ write_exp_elt_opcode (UNOP_LENGTH);
+ break;
+ case TYPENAME:
+ type = PEEK_LVAL ().tsym.type;
+ FORWARD_TOKEN ();
+ switch (PEEK_TOKEN())
+ {
+ case '[':
+ parse_tuple (type);
+ break;
+ case '(':
+ FORWARD_TOKEN ();
+ parse_expr ();
+ expect (')', "missing right parenthesis");
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (type);
+ write_exp_elt_opcode (UNOP_CAST);
+ break;
+ default:
+ error ("typename in invalid context");
+ }
+ break;
+
+ default:
+ error ("invalid expression syntax at `%s'", lexptr);
+ }
+ for (;;)
+ {
+ switch (PEEK_TOKEN ())
+ {
+ case FIELD_NAME:
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (PEEK_LVAL ().sval);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ FORWARD_TOKEN ();
+ continue;
+ case POINTER:
+ FORWARD_TOKEN ();
+ if (PEEK_TOKEN () == TYPENAME)
+ {
+ type = PEEK_LVAL ().tsym.type;
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (lookup_pointer_type (type));
+ write_exp_elt_opcode (UNOP_CAST);
+ FORWARD_TOKEN ();
+ }
+ write_exp_elt_opcode (UNOP_IND);
+ continue;
+ case '(':
+ parse_call ();
+ continue;
+ case CHARACTER_STRING_LITERAL:
+ case CHARACTER_LITERAL:
+ case BIT_STRING_LITERAL:
+ /* Handle string repetition. (See comment in parse_operand5.) */
+ parse_primval ();
+ write_exp_elt_opcode (MULTI_SUBSCRIPT);
+ write_exp_elt_longcst (1);
+ write_exp_elt_opcode (MULTI_SUBSCRIPT);
+ continue;
+ }
+ break;
+ }
+ return;
+}
+
+static void
+parse_operand6 ()
+{
+ if (check_token (RECEIVE))
+ {
+ parse_primval ();
+ error ("not implemented: RECEIVE expression");
+ }
+ else if (check_token (POINTER))
+ {
+ parse_primval ();
+ write_exp_elt_opcode (UNOP_ADDR);
+ }
+ else
+ parse_primval();
+}
+
+static void
+parse_operand5()
+{
+ enum exp_opcode op;
+ /* We are supposed to be looking for a <string repetition operator>,
+ but in general we can't distinguish that from a parenthesized
+ expression. This is especially difficult if we allow the
+ string operand to be a constant expression (as requested by
+ some users), and not just a string literal.
+ Consider: LPRN expr RPRN LPRN expr RPRN
+ Is that a function call or string repetition?
+ Instead, we handle string repetition in parse_primval,
+ and build_generalized_call. */
+ switch (PEEK_TOKEN())
+ {
+ case NOT: op = UNOP_LOGICAL_NOT; break;
+ case '-': op = UNOP_NEG; break;
+ default:
+ op = OP_NULL;
+ }
+ if (op != OP_NULL)
+ FORWARD_TOKEN();
+ parse_operand6();
+ if (op != OP_NULL)
+ write_exp_elt_opcode (op);
+}
+
+static void
+parse_operand4 ()
+{
+ enum exp_opcode op;
+ parse_operand5();
+ for (;;)
+ {
+ switch (PEEK_TOKEN())
+ {
+ case '*': op = BINOP_MUL; break;
+ case '/': op = BINOP_DIV; break;
+ case MOD: op = BINOP_MOD; break;
+ case REM: op = BINOP_REM; break;
+ default:
+ return;
+ }
+ FORWARD_TOKEN();
+ parse_operand5();
+ write_exp_elt_opcode (op);
+ }
+}
+
+static void
+parse_operand3 ()
+{
+ enum exp_opcode op;
+ parse_operand4 ();
+ for (;;)
+ {
+ switch (PEEK_TOKEN())
+ {
+ case '+': op = BINOP_ADD; break;
+ case '-': op = BINOP_SUB; break;
+ case SLASH_SLASH: op = BINOP_CONCAT; break;
+ default:
+ return;
+ }
+ FORWARD_TOKEN();
+ parse_operand4();
+ write_exp_elt_opcode (op);
+ }
+}
+
+static void
+parse_operand2 ()
+{
+ enum exp_opcode op;
+ parse_operand3 ();
+ for (;;)
+ {
+ if (check_token (IN))
+ {
+ parse_operand3();
+ write_exp_elt_opcode (BINOP_IN);
+ }
+ else
+ {
+ switch (PEEK_TOKEN())
+ {
+ case '>': op = BINOP_GTR; break;
+ case GEQ: op = BINOP_GEQ; break;
+ case '<': op = BINOP_LESS; break;
+ case LEQ: op = BINOP_LEQ; break;
+ case '=': op = BINOP_EQUAL; break;
+ case NOTEQUAL: op = BINOP_NOTEQUAL; break;
+ default:
+ return;
+ }
+ FORWARD_TOKEN();
+ parse_operand3();
+ write_exp_elt_opcode (op);
+ }
+ }
+}
+
+static void
+parse_operand1 ()
+{
+ enum exp_opcode op;
+ parse_operand2 ();
+ for (;;)
+ {
+ switch (PEEK_TOKEN())
+ {
+ case LOGAND: op = BINOP_BITWISE_AND; break;
+ case ANDIF: op = BINOP_LOGICAL_AND; break;
+ default:
+ return;
+ }
+ FORWARD_TOKEN();
+ parse_operand2();
+ write_exp_elt_opcode (op);
+ }
+}
+
+static void
+parse_operand0 ()
+{
+ enum exp_opcode op;
+ parse_operand1();
+ for (;;)
+ {
+ switch (PEEK_TOKEN())
+ {
+ case LOGIOR: op = BINOP_BITWISE_IOR; break;
+ case LOGXOR: op = BINOP_BITWISE_XOR; break;
+ case ORIF: op = BINOP_LOGICAL_OR; break;
+ default:
+ return;
+ }
+ FORWARD_TOKEN();
+ parse_operand1();
+ write_exp_elt_opcode (op);
+ }
+}
+
+static void
+parse_expr ()
+{
+ parse_operand0 ();
+ if (check_token (GDB_ASSIGNMENT))
+ {
+ parse_expr ();
+ write_exp_elt_opcode (BINOP_ASSIGN);
+ }
+}
+
+static void
+parse_then_alternative ()
+{
+ expect (THEN, "missing 'THEN' in 'IF' expression");
+ parse_expr ();
+}
+
+static void
+parse_else_alternative ()
+{
+ if (check_token (ELSIF))
+ parse_if_expression_body ();
+ else if (check_token (ELSE))
+ parse_expr ();
+ else
+ error ("missing ELSE/ELSIF in IF expression");
+}
+
+/* Matches: <boolean expression> <then alternative> <else alternative> */
+
+static void
+parse_if_expression_body ()
+{
+ parse_expr ();
+ parse_then_alternative ();
+ parse_else_alternative ();
+ write_exp_elt_opcode (TERNOP_COND);
+}
+
+static void
+parse_if_expression ()
+{
+ require (IF);
+ parse_if_expression_body ();
+ expect (FI, "missing 'FI' at end of conditional expression");
+}
+
+/* An <untyped_expr> is a superset of <expr>. It also includes
+ <conditional expressions> and untyped <tuples>, whose types
+ are not given by their constituents. Hence, these are only
+ allowed in certain contexts that expect a certain type.
+ You should call convert() to fix up the <untyped_expr>. */
+
+static void
+parse_untyped_expr ()
+{
+ switch (PEEK_TOKEN())
+ {
+ case IF:
+ parse_if_expression ();
+ return;
+ case CASE:
+ error ("not implemented: CASE expression");
+ case '(':
+ switch (PEEK_TOKEN1())
+ {
+ case IF:
+ case CASE:
+ goto skip_lprn;
+ case '[':
+ skip_lprn:
+ FORWARD_TOKEN ();
+ parse_untyped_expr ();
+ expect (')', "missing ')'");
+ return;
+ default: ;
+ /* fall through */
+ }
+ default:
+ parse_operand0 ();
+ }
+}
+
+int
+chill_parse ()
+{
+ terminal_buffer[0] = TOKEN_NOT_READ;
+ if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
+ {
+ write_exp_elt_opcode(OP_TYPE);
+ write_exp_elt_type(PEEK_LVAL ().tsym.type);
+ write_exp_elt_opcode(OP_TYPE);
+ FORWARD_TOKEN ();
+ }
+ else
+ parse_expr ();
+ if (terminal_buffer[0] != END_TOKEN)
+ {
+ if (comma_terminates && terminal_buffer[0] == ',')
+ lexptr--; /* Put the comma back. */
+ else
+ error ("Junk after end of expression.");
+ }
+ return 0;
+}
+
+
+/* Implementation of a dynamically expandable buffer for processing input
+ characters acquired through lexptr and building a value to return in
+ yylval. */
+
+static char *tempbuf; /* Current buffer contents */
+static int tempbufsize; /* Size of allocated buffer */
+static int tempbufindex; /* Current index into buffer */
+
+#define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
+
+#define CHECKBUF(size) \
+ do { \
+ if (tempbufindex + (size) >= tempbufsize) \
+ { \
+ growbuf_by_size (size); \
+ } \
+ } while (0);
+
+/* Grow the static temp buffer if necessary, including allocating the first one
+ on demand. */
+
+static void
+growbuf_by_size (count)
+ int count;
+{
+ int growby;
+
+ growby = max (count, GROWBY_MIN_SIZE);
+ tempbufsize += growby;
+ if (tempbuf == NULL)
+ {
+ tempbuf = (char *) malloc (tempbufsize);
+ }
+ else
+ {
+ tempbuf = (char *) realloc (tempbuf, tempbufsize);
+ }
+}
+
+/* Try to consume a simple name string token. If successful, returns
+ a pointer to a nullbyte terminated copy of the name that can be used
+ in symbol table lookups. If not successful, returns NULL. */
+
+static char *
+match_simple_name_string ()
+{
+ char *tokptr = lexptr;
+
+ if (isalpha (*tokptr) || *tokptr == '_')
+ {
+ char *result;
+ do {
+ tokptr++;
+ } while (isalnum (*tokptr) || (*tokptr == '_'));
+ yylval.sval.ptr = lexptr;
+ yylval.sval.length = tokptr - lexptr;
+ lexptr = tokptr;
+ result = copy_name (yylval.sval);
+ return result;
+ }
+ return (NULL);
+}
+
+/* Start looking for a value composed of valid digits as set by the base
+ in use. Note that '_' characters are valid anywhere, in any quantity,
+ and are simply ignored. Since we must find at least one valid digit,
+ or reject this token as an integer literal, we keep track of how many
+ digits we have encountered. */
+
+static int
+decode_integer_value (base, tokptrptr, ivalptr)
+ int base;
+ char **tokptrptr;
+ LONGEST *ivalptr;
+{
+ char *tokptr = *tokptrptr;
+ int temp;
+ int digits = 0;
+
+ while (*tokptr != '\0')
+ {
+ temp = *tokptr;
+ if (isupper (temp))
+ temp = tolower (temp);
+ tokptr++;
+ switch (temp)
+ {
+ case '_':
+ continue;
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ temp -= '0';
+ break;
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ temp -= 'a';
+ temp += 10;
+ break;
+ default:
+ temp = base;
+ break;
+ }
+ if (temp < base)
+ {
+ digits++;
+ *ivalptr *= base;
+ *ivalptr += temp;
+ }
+ else
+ {
+ /* Found something not in domain for current base. */
+ tokptr--; /* Unconsume what gave us indigestion. */
+ break;
+ }
+ }
+
+ /* If we didn't find any digits, then we don't have a valid integer
+ value, so reject the entire token. Otherwise, update the lexical
+ scan pointer, and return non-zero for success. */
+
+ if (digits == 0)
+ {
+ return (0);
+ }
+ else
+ {
+ *tokptrptr = tokptr;
+ return (1);
+ }
+}
+
+static int
+decode_integer_literal (valptr, tokptrptr)
+ LONGEST *valptr;
+ char **tokptrptr;
+{
+ char *tokptr = *tokptrptr;
+ int base = 0;
+ LONGEST ival = 0;
+ int explicit_base = 0;
+
+ /* Look for an explicit base specifier, which is optional. */
+
+ switch (*tokptr)
+ {
+ case 'd':
+ case 'D':
+ explicit_base++;
+ base = 10;
+ tokptr++;
+ break;
+ case 'b':
+ case 'B':
+ explicit_base++;
+ base = 2;
+ tokptr++;
+ break;
+ case 'h':
+ case 'H':
+ explicit_base++;
+ base = 16;
+ tokptr++;
+ break;
+ case 'o':
+ case 'O':
+ explicit_base++;
+ base = 8;
+ tokptr++;
+ break;
+ default:
+ base = 10;
+ break;
+ }
+
+ /* If we found an explicit base ensure that the character after the
+ explicit base is a single quote. */
+
+ if (explicit_base && (*tokptr++ != '\''))
+ {
+ return (0);
+ }
+
+ /* Attempt to decode whatever follows as an integer value in the
+ indicated base, updating the token pointer in the process and
+ computing the value into ival. Also, if we have an explicit
+ base, then the next character must not be a single quote, or we
+ have a bitstring literal, so reject the entire token in this case.
+ Otherwise, update the lexical scan pointer, and return non-zero
+ for success. */
+
+ if (!decode_integer_value (base, &tokptr, &ival))
+ {
+ return (0);
+ }
+ else if (explicit_base && (*tokptr == '\''))
+ {
+ return (0);
+ }
+ else
+ {
+ *valptr = ival;
+ *tokptrptr = tokptr;
+ return (1);
+ }
+}
+
+/* If it wasn't for the fact that floating point values can contain '_'
+ characters, we could just let strtod do all the hard work by letting it
+ try to consume as much of the current token buffer as possible and
+ find a legal conversion. Unfortunately we need to filter out the '_'
+ characters before calling strtod, which we do by copying the other
+ legal chars to a local buffer to be converted. However since we also
+ need to keep track of where the last unconsumed character in the input
+ buffer is, we have transfer only as many characters as may compose a
+ legal floating point value. */
+
+static enum ch_terminal
+match_float_literal ()
+{
+ char *tokptr = lexptr;
+ char *buf;
+ char *copy;
+ double dval;
+ extern double strtod ();
+
+ /* Make local buffer in which to build the string to convert. This is
+ required because underscores are valid in chill floating point numbers
+ but not in the string passed to strtod to convert. The string will be
+ no longer than our input string. */
+
+ copy = buf = (char *) alloca (strlen (tokptr) + 1);
+
+ /* Transfer all leading digits to the conversion buffer, discarding any
+ underscores. */
+
+ while (isdigit (*tokptr) || *tokptr == '_')
+ {
+ if (*tokptr != '_')
+ {
+ *copy++ = *tokptr;
+ }
+ tokptr++;
+ }
+
+ /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
+ of whether we found any leading digits, and we simply accept it and
+ continue on to look for the fractional part and/or exponent. One of
+ [eEdD] is legal only if we have seen digits, and means that there
+ is no fractional part. If we find neither of these, then this is
+ not a floating point number, so return failure. */
+
+ switch (*tokptr++)
+ {
+ case '.':
+ /* Accept and then look for fractional part and/or exponent. */
+ *copy++ = '.';
+ break;
+
+ case 'e':
+ case 'E':
+ case 'd':
+ case 'D':
+ if (copy == buf)
+ {
+ return (0);
+ }
+ *copy++ = 'e';
+ goto collect_exponent;
+ break;
+
+ default:
+ return (0);
+ break;
+ }
+
+ /* We found a '.', copy any fractional digits to the conversion buffer, up
+ to the first nondigit, non-underscore character. */
+
+ while (isdigit (*tokptr) || *tokptr == '_')
+ {
+ if (*tokptr != '_')
+ {
+ *copy++ = *tokptr;
+ }
+ tokptr++;
+ }
+
+ /* Look for an exponent, which must start with one of [eEdD]. If none
+ is found, jump directly to trying to convert what we have collected
+ so far. */
+
+ switch (*tokptr)
+ {
+ case 'e':
+ case 'E':
+ case 'd':
+ case 'D':
+ *copy++ = 'e';
+ tokptr++;
+ break;
+ default:
+ goto convert_float;
+ break;
+ }
+
+ /* Accept an optional '-' or '+' following one of [eEdD]. */
+
+ collect_exponent:
+ if (*tokptr == '+' || *tokptr == '-')
+ {
+ *copy++ = *tokptr++;
+ }
+
+ /* Now copy an exponent into the conversion buffer. Note that at the
+ moment underscores are *not* allowed in exponents. */
+
+ while (isdigit (*tokptr))
+ {
+ *copy++ = *tokptr++;
+ }
+
+ /* If we transfered any chars to the conversion buffer, try to interpret its
+ contents as a floating point value. If any characters remain, then we
+ must not have a valid floating point string. */
+
+ convert_float:
+ *copy = '\0';
+ if (copy != buf)
+ {
+ dval = strtod (buf, &copy);
+ if (*copy == '\0')
+ {
+ yylval.dval = dval;
+ lexptr = tokptr;
+ return (FLOAT_LITERAL);
+ }
+ }
+ return (0);
+}
+
+/* Recognize a string literal. A string literal is a sequence
+ of characters enclosed in matching single or double quotes, except that
+ a single character inside single quotes is a character literal, which
+ we reject as a string literal. To embed the terminator character inside
+ a string, it is simply doubled (I.E. "this""is""one""string") */
+
+static enum ch_terminal
+match_string_literal ()
+{
+ char *tokptr = lexptr;
+
+ for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
+ {
+ CHECKBUF (1);
+ if (*tokptr == *lexptr)
+ {
+ if (*(tokptr + 1) == *lexptr)
+ {
+ tokptr++;
+ }
+ else
+ {
+ break;
+ }
+ }
+ tempbuf[tempbufindex++] = *tokptr;
+ }
+ if (*tokptr == '\0' /* no terminator */
+ || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
+ {
+ return (0);
+ }
+ else
+ {
+ tempbuf[tempbufindex] = '\0';
+ yylval.sval.ptr = tempbuf;
+ yylval.sval.length = tempbufindex;
+ lexptr = ++tokptr;
+ return (CHARACTER_STRING_LITERAL);
+ }
+}
+
+/* Recognize a character literal. A character literal is single character
+ or a control sequence, enclosed in single quotes. A control sequence
+ is a comma separated list of one or more integer literals, enclosed
+ in parenthesis and introduced with a circumflex character.
+
+ EX: 'a' '^(7)' '^(7,8)'
+
+ As a GNU chill extension, the syntax C'xx' is also recognized as a
+ character literal, where xx is a hex value for the character.
+
+ Note that more than a single character, enclosed in single quotes, is
+ a string literal.
+
+ Also note that the control sequence form is not in GNU Chill since it
+ is ambiguous with the string literal form using single quotes. I.E.
+ is '^(7)' a character literal or a string literal. In theory it it
+ possible to tell by context, but GNU Chill doesn't accept the control
+ sequence form, so neither do we (for now the code is disabled).
+
+ Returns CHARACTER_LITERAL if a match is found.
+ */
+
+static enum ch_terminal
+match_character_literal ()
+{
+ char *tokptr = lexptr;
+ LONGEST ival = 0;
+
+ if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
+ {
+ /* We have a GNU chill extension form, so skip the leading "C'",
+ decode the hex value, and then ensure that we have a trailing
+ single quote character. */
+ tokptr += 2;
+ if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
+ {
+ return (0);
+ }
+ tokptr++;
+ }
+ else if (*tokptr == '\'')
+ {
+ tokptr++;
+
+ /* Determine which form we have, either a control sequence or the
+ single character form. */
+
+ if ((*tokptr == '^') && (*(tokptr + 1) == '('))
+ {
+#if 0 /* Disable, see note above. -fnf */
+ /* Match and decode a control sequence. Return zero if we don't
+ find a valid integer literal, or if the next unconsumed character
+ after the integer literal is not the trailing ')'.
+ FIXME: We currently don't handle the multiple integer literal
+ form. */
+ tokptr += 2;
+ if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
+ {
+ return (0);
+ }
+#else
+ return (0);
+#endif
+ }
+ else
+ {
+ ival = *tokptr++;
+ }
+
+ /* The trailing quote has not yet been consumed. If we don't find
+ it, then we have no match. */
+
+ if (*tokptr++ != '\'')
+ {
+ return (0);
+ }
+ }
+ else
+ {
+ /* Not a character literal. */
+ return (0);
+ }
+ yylval.typed_val.val = ival;
+ yylval.typed_val.type = builtin_type_chill_char;
+ lexptr = tokptr;
+ return (CHARACTER_LITERAL);
+}
+
+/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
+ Note that according to 5.2.4.2, a single "_" is also a valid integer
+ literal, however GNU-chill requires there to be at least one "digit"
+ in any integer literal. */
+
+static enum ch_terminal
+match_integer_literal ()
+{
+ char *tokptr = lexptr;
+ LONGEST ival;
+
+ if (!decode_integer_literal (&ival, &tokptr))
+ {
+ return (0);
+ }
+ else
+ {
+ yylval.typed_val.val = ival;
+#ifdef CC_HAS_LONG_LONG
+ if (ival > 2147483647 || ival < -2147483648)
+ yylval.typed_val.type = builtin_type_long_long;
+ else
+#endif
+ yylval.typed_val.type = builtin_type_int;
+ lexptr = tokptr;
+ return (INTEGER_LITERAL);
+ }
+}
+
+/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
+ Note that according to 5.2.4.8, a single "_" is also a valid bit-string
+ literal, however GNU-chill requires there to be at least one "digit"
+ in any bit-string literal. */
+
+static enum ch_terminal
+match_bitstring_literal ()
+{
+ register char *tokptr = lexptr;
+ int bitoffset = 0;
+ int bitcount = 0;
+ int bits_per_char;
+ int digit;
+
+ tempbufindex = 0;
+ CHECKBUF (1);
+ tempbuf[0] = 0;
+
+ /* Look for the required explicit base specifier. */
+
+ switch (*tokptr++)
+ {
+ case 'b':
+ case 'B':
+ bits_per_char = 1;
+ break;
+ case 'o':
+ case 'O':
+ bits_per_char = 3;
+ break;
+ case 'h':
+ case 'H':
+ bits_per_char = 4;
+ break;
+ default:
+ return (0);
+ break;
+ }
+
+ /* Ensure that the character after the explicit base is a single quote. */
+
+ if (*tokptr++ != '\'')
+ {
+ return (0);
+ }
+
+ while (*tokptr != '\0' && *tokptr != '\'')
+ {
+ digit = *tokptr;
+ if (isupper (digit))
+ digit = tolower (digit);
+ tokptr++;
+ switch (digit)
+ {
+ case '_':
+ continue;
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ digit -= '0';
+ break;
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ digit -= 'a';
+ digit += 10;
+ break;
+ default:
+ error ("Invalid character in bitstring or integer.");
+ }
+ if (digit >= 1 << bits_per_char)
+ {
+ /* Found something not in domain for current base. */
+ error ("Too-large digit in bitstring or integer.");
+ }
+ else
+ {
+ /* Extract bits from digit, packing them into the bitstring byte. */
+ int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
+ for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
+ TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
+ {
+ bitcount++;
+ if (digit & (1 << k))
+ {
+ tempbuf[tempbufindex] |=
+ (TARGET_BYTE_ORDER == BIG_ENDIAN)
+ ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
+ : (1 << bitoffset);
+ }
+ bitoffset++;
+ if (bitoffset == HOST_CHAR_BIT)
+ {
+ bitoffset = 0;
+ tempbufindex++;
+ CHECKBUF(1);
+ tempbuf[tempbufindex] = 0;
+ }
+ }
+ }
+ }
+
+ /* Verify that we consumed everything up to the trailing single quote,
+ and that we found some bits (IE not just underbars). */
+
+ if (*tokptr++ != '\'')
+ {
+ return (0);
+ }
+ else
+ {
+ yylval.sval.ptr = tempbuf;
+ yylval.sval.length = bitcount;
+ lexptr = tokptr;
+ return (BIT_STRING_LITERAL);
+ }
+}
+
+struct token
+{
+ char *operator;
+ int token;
+};
+
+static const struct token idtokentab[] =
+{
+ { "array", ARRAY },
+ { "length", LENGTH },
+ { "lower", LOWER },
+ { "upper", UPPER },
+ { "andif", ANDIF },
+ { "pred", PRED },
+ { "succ", SUCC },
+ { "card", CARD },
+ { "size", SIZE },
+ { "orif", ORIF },
+ { "num", NUM },
+ { "abs", ABS },
+ { "max", MAX_TOKEN },
+ { "min", MIN_TOKEN },
+ { "mod", MOD },
+ { "rem", REM },
+ { "not", NOT },
+ { "xor", LOGXOR },
+ { "and", LOGAND },
+ { "in", IN },
+ { "or", LOGIOR },
+ { "up", UP },
+ { "addr", ADDR_TOKEN },
+ { "null", EMPTINESS_LITERAL }
+};
+
+static const struct token tokentab2[] =
+{
+ { ":=", GDB_ASSIGNMENT },
+ { "//", SLASH_SLASH },
+ { "->", POINTER },
+ { "/=", NOTEQUAL },
+ { "<=", LEQ },
+ { ">=", GEQ }
+};
+
+/* Read one token, getting characters through lexptr. */
+/* This is where we will check to make sure that the language and the
+ operators used are compatible. */
+
+static enum ch_terminal
+ch_lex ()
+{
+ unsigned int i;
+ enum ch_terminal token;
+ char *inputname;
+ struct symbol *sym;
+
+ /* Skip over any leading whitespace. */
+ while (isspace (*lexptr))
+ {
+ lexptr++;
+ }
+ /* Look for special single character cases which can't be the first
+ character of some other multicharacter token. */
+ switch (*lexptr)
+ {
+ case '\0':
+ return END_TOKEN;
+ case ',':
+ case '=':
+ case ';':
+ case '!':
+ case '+':
+ case '*':
+ case '(':
+ case ')':
+ case '[':
+ case ']':
+ return (*lexptr++);
+ }
+ /* Look for characters which start a particular kind of multicharacter
+ token, such as a character literal, register name, convenience
+ variable name, string literal, etc. */
+ switch (*lexptr)
+ {
+ case '\'':
+ case '\"':
+ /* First try to match a string literal, which is any
+ sequence of characters enclosed in matching single or double
+ quotes, except that a single character inside single quotes
+ is a character literal, so we have to catch that case also. */
+ token = match_string_literal ();
+ if (token != 0)
+ {
+ return (token);
+ }
+ if (*lexptr == '\'')
+ {
+ token = match_character_literal ();
+ if (token != 0)
+ {
+ return (token);
+ }
+ }
+ break;
+ case 'C':
+ case 'c':
+ token = match_character_literal ();
+ if (token != 0)
+ {
+ return (token);
+ }
+ break;
+ case '$':
+ yylval.sval.ptr = lexptr;
+ do {
+ lexptr++;
+ } while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
+ yylval.sval.length = lexptr - yylval.sval.ptr;
+ write_dollar_variable (yylval.sval);
+ return GDB_VARIABLE;
+ break;
+ }
+ /* See if it is a special token of length 2. */
+ for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
+ {
+ if (STREQN (lexptr, tokentab2[i].operator, 2))
+ {
+ lexptr += 2;
+ return (tokentab2[i].token);
+ }
+ }
+ /* Look for single character cases which which could be the first
+ character of some other multicharacter token, but aren't, or we
+ would already have found it. */
+ switch (*lexptr)
+ {
+ case '-':
+ case ':':
+ case '/':
+ case '<':
+ case '>':
+ return (*lexptr++);
+ }
+ /* Look for a float literal before looking for an integer literal, so
+ we match as much of the input stream as possible. */
+ token = match_float_literal ();
+ if (token != 0)
+ {
+ return (token);
+ }
+ token = match_bitstring_literal ();
+ if (token != 0)
+ {
+ return (token);
+ }
+ token = match_integer_literal ();
+ if (token != 0)
+ {
+ return (token);
+ }
+
+ /* Try to match a simple name string, and if a match is found, then
+ further classify what sort of name it is and return an appropriate
+ token. Note that attempting to match a simple name string consumes
+ the token from lexptr, so we can't back out if we later find that
+ we can't classify what sort of name it is. */
+
+ inputname = match_simple_name_string ();
+
+ if (inputname != NULL)
+ {
+ char *simplename = (char*) alloca (strlen (inputname) + 1);
+
+ char *dptr = simplename, *sptr = inputname;
+ for (; *sptr; sptr++)
+ *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr;
+ *dptr = '\0';
+
+ /* See if it is a reserved identifier. */
+ for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
+ {
+ if (STREQ (simplename, idtokentab[i].operator))
+ {
+ return (idtokentab[i].token);
+ }
+ }
+
+ /* Look for other special tokens. */
+ if (STREQ (simplename, "true"))
+ {
+ yylval.ulval = 1;
+ return (BOOLEAN_LITERAL);
+ }
+ if (STREQ (simplename, "false"))
+ {
+ yylval.ulval = 0;
+ return (BOOLEAN_LITERAL);
+ }
+
+ sym = lookup_symbol (inputname, expression_context_block,
+ VAR_NAMESPACE, (int *) NULL,
+ (struct symtab **) NULL);
+ if (sym == NULL && strcmp (inputname, simplename) != 0)
+ {
+ sym = lookup_symbol (simplename, expression_context_block,
+ VAR_NAMESPACE, (int *) NULL,
+ (struct symtab **) NULL);
+ }
+ if (sym != NULL)
+ {
+ yylval.ssym.stoken.ptr = NULL;
+ yylval.ssym.stoken.length = 0;
+ yylval.ssym.sym = sym;
+ yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
+ switch (SYMBOL_CLASS (sym))
+ {
+ case LOC_BLOCK:
+ /* Found a procedure name. */
+ return (GENERAL_PROCEDURE_NAME);
+ case LOC_STATIC:
+ /* Found a global or local static variable. */
+ return (LOCATION_NAME);
+ 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:
+ if (innermost_block == NULL
+ || contained_in (block_found, innermost_block))
+ {
+ innermost_block = block_found;
+ }
+ return (LOCATION_NAME);
+ break;
+ case LOC_CONST:
+ case LOC_LABEL:
+ return (LOCATION_NAME);
+ break;
+ case LOC_TYPEDEF:
+ yylval.tsym.type = SYMBOL_TYPE (sym);
+ return TYPENAME;
+ case LOC_UNDEF:
+ case LOC_CONST_BYTES:
+ case LOC_OPTIMIZED_OUT:
+ error ("Symbol \"%s\" names no location.", inputname);
+ break;
+ }
+ }
+ else if (!have_full_symbols () && !have_partial_symbols ())
+ {
+ error ("No symbol table is loaded. Use the \"file\" command.");
+ }
+ else
+ {
+ error ("No symbol \"%s\" in current context.", inputname);
+ }
+ }
+
+ /* Catch single character tokens which are not part of some
+ longer token. */
+
+ switch (*lexptr)
+ {
+ case '.': /* Not float for example. */
+ lexptr++;
+ while (isspace (*lexptr)) lexptr++;
+ inputname = match_simple_name_string ();
+ if (!inputname)
+ return '.';
+ return FIELD_NAME;
+ }
+
+ return (ILLEGAL_TOKEN);
+}
+
+static void
+write_lower_upper_value (opcode, type)
+ enum exp_opcode opcode; /* Either UNOP_LOWER or UNOP_UPPER */
+ struct type *type;
+{
+ if (type == NULL)
+ write_exp_elt_opcode (opcode);
+ else
+ {
+ extern LONGEST type_lower_upper ();
+ struct type *result_type;
+ LONGEST val = type_lower_upper (opcode, type, &result_type);
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (result_type);
+ write_exp_elt_longcst (val);
+ write_exp_elt_opcode (OP_LONG);
+ }
+}
+
+void
+chill_error (msg)
+ char *msg;
+{
+ /* Never used. */
+}
diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y
index 70823ef..e69de29 100644
--- a/gdb/ch-exp.y
+++ b/gdb/ch-exp.y
@@ -1,1664 +0,0 @@
-/* YACC grammar for Chill expressions, for GDB.
- Copyright 1992, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of GDB.
-
-This program 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 2 of the License, or
-(at your option) any later version.
-
-This program 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 this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
-
-/* Parse a Chill expression from text in a string,
- and return the result as a struct expression pointer.
- That structure contains arithmetic operations in reverse polish,
- with constants represented by operations that are followed by special data.
- See expression.h for the details of the format.
- What is important here is that it can be built up sequentially
- during the process of parsing; the lower levels of the tree always
- come first in the result.
-
- Note that malloc's and realloc's in this file are transformed to
- xmalloc and xrealloc respectively by the same sed command in the
- makefile that remaps any other malloc/realloc inserted by the parser
- generator. Doing this with #defines and trying to control the interaction
- with include files (<malloc.h> and <stdlib.h> for example) just became
- too messy, particularly when such includes can be inserted at random
- times by the parser generator.
-
- Also note that the language accepted by this parser is more liberal
- than the one accepted by an actual Chill compiler. For example, the
- language rule that a simple name string can not be one of the reserved
- simple name strings is not enforced (e.g "case" is not treated as a
- reserved name). Another example is that Chill is a strongly typed
- language, and certain expressions that violate the type constraints
- may still be evaluated if gdb can do so in a meaningful manner, while
- such expressions would be rejected by the compiler. The reason for
- this more liberal behavior is the philosophy that the debugger
- is intended to be a tool that is used by the programmer when things
- go wrong, and as such, it should provide as few artificial barriers
- to it's use as possible. If it can do something meaningful, even
- something that violates language contraints that are enforced by the
- compiler, it should do so without complaint.
-
- */
-
-%{
-
-#include "defs.h"
-#include <string.h>
-#include <ctype.h>
-#include "expression.h"
-#include "language.h"
-#include "value.h"
-#include "parser-defs.h"
-#include "ch-lang.h"
-#include "bfd.h" /* Required by objfiles.h. */
-#include "symfile.h" /* Required by objfiles.h. */
-#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
-
-/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
- as well as gratuitiously global symbol names, so we can have multiple
- yacc generated parsers in gdb. Note that these are only the variables
- produced by yacc. If other parser generators (bison, byacc, etc) produce
- additional global names that conflict at link time, then those parser
- generators need to be fixed instead of adding those names to this list. */
-
-#define yymaxdepth chill_maxdepth
-#define yyparse chill_parse
-#define yylex chill_lex
-#define yyerror chill_error
-#define yylval chill_lval
-#define yychar chill_char
-#define yydebug chill_debug
-#define yypact chill_pact
-#define yyr1 chill_r1
-#define yyr2 chill_r2
-#define yydef chill_def
-#define yychk chill_chk
-#define yypgo chill_pgo
-#define yyact chill_act
-#define yyexca chill_exca
-#define yyerrflag chill_errflag
-#define yynerrs chill_nerrs
-#define yyps chill_ps
-#define yypv chill_pv
-#define yys chill_s
-#define yy_yys chill_yys
-#define yystate chill_state
-#define yytmp chill_tmp
-#define yyv chill_v
-#define yy_yyv chill_yyv
-#define yyval chill_val
-#define yylloc chill_lloc
-#define yyreds chill_reds /* With YYDEBUG defined */
-#define yytoks chill_toks /* With YYDEBUG defined */
-#define yylhs chill_yylhs
-#define yylen chill_yylen
-#define yydefred chill_yydefred
-#define yydgoto chill_yydgoto
-#define yysindex chill_yysindex
-#define yyrindex chill_yyrindex
-#define yygindex chill_yygindex
-#define yytable chill_yytable
-#define yycheck chill_yycheck
-
-#ifndef YYDEBUG
-#define YYDEBUG 0 /* Default to no yydebug support */
-#endif
-
-static void
-write_lower_upper_value PARAMS ((enum exp_opcode, struct type *type));
-
-int
-yyparse PARAMS ((void));
-
-static int
-yylex PARAMS ((void));
-
-void
-yyerror PARAMS ((char *));
-
-%}
-
-/* Although the yacc "value" of an expression is not used,
- since the result is stored in the structure being created,
- other node types do have values. */
-
-%union
- {
- LONGEST lval;
- unsigned LONGEST ulval;
- struct {
- LONGEST val;
- struct type *type;
- } typed_val;
- double dval;
- struct symbol *sym;
- struct type *tval;
- struct stoken sval;
- struct ttype tsym;
- struct symtoken ssym;
- int voidval;
- struct block *bval;
- enum exp_opcode opcode;
- struct internalvar *ivar;
-
- struct type **tvec;
- int *ivec;
- }
-
-%token <typed_val> INTEGER_LITERAL
-%token <ulval> BOOLEAN_LITERAL
-%token <typed_val> CHARACTER_LITERAL
-%token <dval> FLOAT_LITERAL
-%token <ssym> GENERAL_PROCEDURE_NAME
-%token <ssym> LOCATION_NAME
-%token <voidval> EMPTINESS_LITERAL
-%token <sval> CHARACTER_STRING_LITERAL
-%token <sval> BIT_STRING_LITERAL
-%token <tsym> TYPENAME
-%token <sval> FIELD_NAME
-
-%token <voidval> '.'
-%token <voidval> ';'
-%token <voidval> ':'
-%token <voidval> CASE
-%token <voidval> OF
-%token <voidval> ESAC
-%token <voidval> LOGIOR
-%token <voidval> ORIF
-%token <voidval> LOGXOR
-%token <voidval> LOGAND
-%token <voidval> ANDIF
-%token <voidval> '='
-%token <voidval> NOTEQUAL
-%token <voidval> '>'
-%token <voidval> GTR
-%token <voidval> '<'
-%token <voidval> LEQ
-%token <voidval> IN
-%token <voidval> '+'
-%token <voidval> '-'
-%token <voidval> '*'
-%token <voidval> '/'
-%token <voidval> SLASH_SLASH
-%token <voidval> MOD
-%token <voidval> REM
-%token <voidval> NOT
-%token <voidval> POINTER
-%token <voidval> RECEIVE
-%token <voidval> '['
-%token <voidval> ']'
-%token <voidval> '('
-%token <voidval> ')'
-%token <voidval> UP
-%token <voidval> IF
-%token <voidval> THEN
-%token <voidval> ELSE
-%token <voidval> FI
-%token <voidval> ELSIF
-%token <voidval> ILLEGAL_TOKEN
-%token <voidval> NUM
-%token <voidval> PRED
-%token <voidval> SUCC
-%token <voidval> ABS
-%token <voidval> CARD
-%token <voidval> MAX_TOKEN
-%token <voidval> MIN_TOKEN
-%token <voidval> ADDR_TOKEN
-%token <voidval> SIZE
-%token <voidval> UPPER
-%token <voidval> LOWER
-%token <voidval> LENGTH
-%token <voidval> ARRAY
-
-/* Tokens which are not Chill tokens used in expressions, but rather GDB
- specific things that we recognize in the same context as Chill tokens
- (register names for example). */
-
-%token <voidval> GDB_VARIABLE /* Convenience variable */
-%token <voidval> GDB_ASSIGNMENT /* Assign value to somewhere */
-
-%type <voidval> access_name
-%type <voidval> primitive_value
-%type <voidval> value_name
-%type <voidval> literal
-%type <voidval> tuple
-%type <voidval> slice
-%type <voidval> expression_conversion
-%type <voidval> value_built_in_routine_call
-%type <voidval> parenthesised_expression
-%type <voidval> value
-%type <voidval> expression
-%type <voidval> conditional_expression
-%type <voidval> then_alternative
-%type <voidval> else_alternative
-%type <voidval> operand_0
-%type <voidval> operand_1
-%type <voidval> operand_2
-%type <voidval> operand_3
-%type <voidval> operand_4
-%type <voidval> operand_5
-%type <voidval> operand_6
-%type <voidval> expression_list
-%type <tval> mode_argument
-%type <voidval> single_assignment_action
-%type <tsym> mode_name
-%type <lval> rparen
-
-/* Not implemented:
-%type <voidval> undefined_value
-%type <voidval> array_mode_name
-%type <voidval> string_mode_name
-%type <voidval> variant_structure_mode_name
-*/
-
-%%
-
-/* Z.200, 5.3.1 */
-
-start : value { }
- | mode_name
- { write_exp_elt_opcode(OP_TYPE);
- write_exp_elt_type($1.type);
- write_exp_elt_opcode(OP_TYPE);}
- ;
-
-value : expression
-/*
- | undefined_value
- { ??? }
-*/
- ;
-
-/* Z.200, 4.2.2 */
-
-access_name : LOCATION_NAME
- {
- write_exp_elt_opcode (OP_VAR_VALUE);
- write_exp_elt_block (NULL);
- write_exp_elt_sym ($1.sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
- }
- | GDB_VARIABLE /* gdb specific */
- ;
-
-/* Z.200, 4.2.8 */
-
-expression_list : expression
- {
- arglist_len = 1;
- }
- | expression_list ',' expression
- {
- arglist_len++;
- }
- ;
-
-maybe_expression_list: /* EMPTY */
- {
- arglist_len = 0;
- }
- | expression_list
- ;
-
-
-/* Z.200, 5.2.1 */
-
-primitive_value_lparen: primitive_value '('
- /* This is to save the value of arglist_len
- being accumulated for each dimension. */
- { start_arglist (); }
- ;
-
-rparen : ')'
- { $$ = end_arglist (); }
- ;
-
-primitive_value :
- access_name
- | primitive_value_lparen maybe_expression_list rparen
- {
- write_exp_elt_opcode (MULTI_SUBSCRIPT);
- write_exp_elt_longcst ($3);
- write_exp_elt_opcode (MULTI_SUBSCRIPT);
- }
- | primitive_value FIELD_NAME
- { write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($2);
- write_exp_elt_opcode (STRUCTOP_STRUCT);
- }
- | primitive_value POINTER
- {
- write_exp_elt_opcode (UNOP_IND);
- }
- | primitive_value POINTER mode_name
- {
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (lookup_pointer_type ($3.type));
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_opcode (UNOP_IND);
- }
- | value_name
- | literal
- | tuple
- | slice
- | expression_conversion
- | value_built_in_routine_call
-/*
- | start_expression
- { ??? }
- | zero_adic_operator
- { ??? }
-*/
- | parenthesised_expression
- ;
-
-/* Z.200, 5.2.3 */
-
-value_name : GENERAL_PROCEDURE_NAME
- {
- write_exp_elt_opcode (OP_VAR_VALUE);
- write_exp_elt_block (NULL);
- write_exp_elt_sym ($1.sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
- }
- ;
-
-/* Z.200, 5.2.4.1 */
-
-literal : INTEGER_LITERAL
- {
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type ($1.type);
- write_exp_elt_longcst ((LONGEST) ($1.val));
- write_exp_elt_opcode (OP_LONG);
- }
- | BOOLEAN_LITERAL
- {
- write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_BOOL);
- }
- | CHARACTER_LITERAL
- {
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type ($1.type);
- write_exp_elt_longcst ((LONGEST) ($1.val));
- write_exp_elt_opcode (OP_LONG);
- }
- | FLOAT_LITERAL
- {
- write_exp_elt_opcode (OP_DOUBLE);
- write_exp_elt_type (builtin_type_double);
- write_exp_elt_dblcst ($1);
- write_exp_elt_opcode (OP_DOUBLE);
- }
- | EMPTINESS_LITERAL
- {
- struct type *void_ptr_type
- = lookup_pointer_type (builtin_type_void);
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (void_ptr_type);
- write_exp_elt_longcst (0);
- write_exp_elt_opcode (OP_LONG);
- }
- | CHARACTER_STRING_LITERAL
- {
- write_exp_elt_opcode (OP_STRING);
- write_exp_string ($1);
- write_exp_elt_opcode (OP_STRING);
- }
- | BIT_STRING_LITERAL
- {
- write_exp_elt_opcode (OP_BITSTRING);
- write_exp_bitstring ($1);
- write_exp_elt_opcode (OP_BITSTRING);
- }
- ;
-
-/* Z.200, 5.2.5 */
-
-tuple_element : expression
- | named_record_element
- ;
-
-named_record_element: FIELD_NAME ',' named_record_element
- { write_exp_elt_opcode (OP_LABELED);
- write_exp_string ($1);
- write_exp_elt_opcode (OP_LABELED);
- }
- | FIELD_NAME ':' expression
- { write_exp_elt_opcode (OP_LABELED);
- write_exp_string ($1);
- write_exp_elt_opcode (OP_LABELED);
- }
- ;
-
-tuple_elements : tuple_element
- {
- arglist_len = 1;
- }
- | tuple_elements ',' tuple_element
- {
- arglist_len++;
- }
- ;
-
-maybe_tuple_elements : tuple_elements
- | /* EMPTY */
- ;
-
-tuple : '['
- { start_arglist (); }
- maybe_tuple_elements ']'
- {
- write_exp_elt_opcode (OP_ARRAY);
- write_exp_elt_longcst ((LONGEST) 0);
- write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
- write_exp_elt_opcode (OP_ARRAY);
- }
- |
- mode_name '['
- { start_arglist (); }
- maybe_tuple_elements ']'
- {
- write_exp_elt_opcode (OP_ARRAY);
- write_exp_elt_longcst ((LONGEST) 0);
- write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
- write_exp_elt_opcode (OP_ARRAY);
-
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type ($1.type);
- write_exp_elt_opcode (UNOP_CAST);
- }
- ;
-
-
-/* Z.200, 5.2.6 */
-
-
-slice: primitive_value_lparen expression ':' expression rparen
- {
- write_exp_elt_opcode (TERNOP_SLICE);
- }
- | primitive_value_lparen expression UP expression rparen
- {
- write_exp_elt_opcode (TERNOP_SLICE_COUNT);
- }
- ;
-
-/* Z.200, 5.2.11 */
-
-expression_conversion: mode_name parenthesised_expression
- {
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type ($1.type);
- write_exp_elt_opcode (UNOP_CAST);
- }
- | ARRAY '(' ')' mode_name parenthesised_expression
- /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
- which casts to an artificial array. */
- {
- struct type *range_type
- = create_range_type ((struct type *) NULL,
- builtin_type_int, 0, 0);
- struct type *array_type
- = create_array_type ((struct type *) NULL,
- $4.type, range_type);
- TYPE_ARRAY_UPPER_BOUND_TYPE(array_type)
- = BOUND_CANNOT_BE_DETERMINED;
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (array_type);
- write_exp_elt_opcode (UNOP_CAST);
- }
- ;
-
-/* Z.200, 5.2.16 */
-
-parenthesised_expression: '(' expression ')'
- ;
-
-/* Z.200, 5.3.2 */
-
-expression : operand_0
- | single_assignment_action
- | conditional_expression
- ;
-
-conditional_expression : IF expression then_alternative else_alternative FI
- { write_exp_elt_opcode (TERNOP_COND); }
-/*
- | CASE case_selector_list OF value_case_alternative ELSE expression ESAC
- { error ("not implemented: CASE expression" }
-*/
- ;
-
-then_alternative: THEN expression
- ;
-
-else_alternative: ELSE expression
- | ELSIF expression then_alternative else_alternative
- { write_exp_elt_opcode (TERNOP_COND); }
- ;
-
-/* Z.200, 5.3.3 */
-
-operand_0 : operand_1
- | operand_0 LOGIOR operand_1
- {
- write_exp_elt_opcode (BINOP_BITWISE_IOR);
- }
- | operand_0 ORIF operand_1
- {
- write_exp_elt_opcode (BINOP_LOGICAL_OR);
- }
- | operand_0 LOGXOR operand_1
- {
- write_exp_elt_opcode (BINOP_BITWISE_XOR);
- }
- ;
-
-/* Z.200, 5.3.4 */
-
-operand_1 : operand_2
- | operand_1 LOGAND operand_2
- {
- write_exp_elt_opcode (BINOP_BITWISE_AND);
- }
- | operand_1 ANDIF operand_2
- {
- write_exp_elt_opcode (BINOP_LOGICAL_AND);
- }
- ;
-
-/* Z.200, 5.3.5 */
-
-operand_2 : operand_3
- | operand_2 '=' operand_3
- {
- write_exp_elt_opcode (BINOP_EQUAL);
- }
- | operand_2 NOTEQUAL operand_3
- {
- write_exp_elt_opcode (BINOP_NOTEQUAL);
- }
- | operand_2 '>' operand_3
- {
- write_exp_elt_opcode (BINOP_GTR);
- }
- | operand_2 GTR operand_3
- {
- write_exp_elt_opcode (BINOP_GEQ);
- }
- | operand_2 '<' operand_3
- {
- write_exp_elt_opcode (BINOP_LESS);
- }
- | operand_2 LEQ operand_3
- {
- write_exp_elt_opcode (BINOP_LEQ);
- }
- | operand_2 IN operand_3
- {
- write_exp_elt_opcode (BINOP_IN);
- }
- ;
-
-
-/* Z.200, 5.3.6 */
-
-operand_3 : operand_4
- | operand_3 '+' operand_4
- {
- write_exp_elt_opcode (BINOP_ADD);
- }
- | operand_3 '-' operand_4
- {
- write_exp_elt_opcode (BINOP_SUB);
- }
- | operand_3 SLASH_SLASH operand_4
- {
- write_exp_elt_opcode (BINOP_CONCAT);
- }
- ;
-
-/* Z.200, 5.3.7 */
-
-operand_4 : operand_5
- | operand_4 '*' operand_5
- {
- write_exp_elt_opcode (BINOP_MUL);
- }
- | operand_4 '/' operand_5
- {
- write_exp_elt_opcode (BINOP_DIV);
- }
- | operand_4 MOD operand_5
- {
- write_exp_elt_opcode (BINOP_MOD);
- }
- | operand_4 REM operand_5
- {
- write_exp_elt_opcode (BINOP_REM);
- }
- ;
-
-/* Z.200, 5.3.8 */
-
-operand_5 : operand_6
- | '-' operand_6
- {
- write_exp_elt_opcode (UNOP_NEG);
- }
- | NOT operand_6
- {
- write_exp_elt_opcode (UNOP_LOGICAL_NOT);
- }
- | parenthesised_expression literal
-/* We require the string operand to be a literal, to avoid some
- nasty parsing ambiguities. */
- {
- write_exp_elt_opcode (BINOP_CONCAT);
- }
- ;
-
-/* Z.200, 5.3.9 */
-
-operand_6 : POINTER primitive_value
- {
- write_exp_elt_opcode (UNOP_ADDR);
- }
- | RECEIVE expression
- { error ("not implemented: RECEIVE expression"); }
- | primitive_value
- ;
-
-
-/* Z.200, 6.2 */
-
-single_assignment_action :
- primitive_value GDB_ASSIGNMENT value
- {
- write_exp_elt_opcode (BINOP_ASSIGN);
- }
- ;
-
-/* Z.200, 6.20.3 */
-
-value_built_in_routine_call :
- NUM '(' expression ')'
- {
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (builtin_type_int);
- write_exp_elt_opcode (UNOP_CAST);
- }
- | PRED '(' expression ')'
- { error ("not implemented: PRED builtin function"); }
- | SUCC '(' expression ')'
- { error ("not implemented: SUCC builtin function"); }
- | ADDR_TOKEN '(' expression ')'
- { write_exp_elt_opcode (UNOP_ADDR); }
- | ABS '(' expression ')'
- { error ("not implemented: ABS builtin function"); }
- | CARD '(' expression ')'
- { error ("not implemented: CARD builtin function"); }
- | MAX_TOKEN '(' expression ')'
- { error ("not implemented: MAX builtin function"); }
- | MIN_TOKEN '(' expression ')'
- { error ("not implemented: MIN builtin function"); }
- | SIZE '(' expression ')'
- { write_exp_elt_opcode (UNOP_SIZEOF); }
- | SIZE '(' mode_argument ')'
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (builtin_type_int);
- write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
- write_exp_elt_opcode (OP_LONG); }
- | LOWER '(' mode_argument ')'
- { write_lower_upper_value (UNOP_LOWER, $3); }
- | UPPER '(' mode_argument ')'
- { write_lower_upper_value (UNOP_UPPER, $3); }
- | LOWER '(' expression ')'
- { write_exp_elt_opcode (UNOP_LOWER); }
- | UPPER '(' expression ')'
- { write_exp_elt_opcode (UNOP_UPPER); }
- | LENGTH '(' expression ')'
- { write_exp_elt_opcode (UNOP_LENGTH); }
- ;
-
-mode_argument : mode_name
- {
- $$ = $1.type;
- }
-/*
- | array_mode_name '(' expression ')'
- { ??? }
- | string_mode_name '(' expression ')'
- { ??? }
- | variant_structure_mode_name '(' expression_list ')'
- { ??? }
-*/
- ;
-
-mode_name : TYPENAME
- ;
-
-%%
-
-/* Implementation of a dynamically expandable buffer for processing input
- characters acquired through lexptr and building a value to return in
- yylval. */
-
-static char *tempbuf; /* Current buffer contents */
-static int tempbufsize; /* Size of allocated buffer */
-static int tempbufindex; /* Current index into buffer */
-
-#define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
-
-#define CHECKBUF(size) \
- do { \
- if (tempbufindex + (size) >= tempbufsize) \
- { \
- growbuf_by_size (size); \
- } \
- } while (0);
-
-/* Grow the static temp buffer if necessary, including allocating the first one
- on demand. */
-
-static void
-growbuf_by_size (count)
- int count;
-{
- int growby;
-
- growby = max (count, GROWBY_MIN_SIZE);
- tempbufsize += growby;
- if (tempbuf == NULL)
- {
- tempbuf = (char *) malloc (tempbufsize);
- }
- else
- {
- tempbuf = (char *) realloc (tempbuf, tempbufsize);
- }
-}
-
-/* Try to consume a simple name string token. If successful, returns
- a pointer to a nullbyte terminated copy of the name that can be used
- in symbol table lookups. If not successful, returns NULL. */
-
-static char *
-match_simple_name_string ()
-{
- char *tokptr = lexptr;
-
- if (isalpha (*tokptr) || *tokptr == '_')
- {
- char *result;
- do {
- tokptr++;
- } while (isalnum (*tokptr) || (*tokptr == '_'));
- yylval.sval.ptr = lexptr;
- yylval.sval.length = tokptr - lexptr;
- lexptr = tokptr;
- result = copy_name (yylval.sval);
- return result;
- }
- return (NULL);
-}
-
-/* Start looking for a value composed of valid digits as set by the base
- in use. Note that '_' characters are valid anywhere, in any quantity,
- and are simply ignored. Since we must find at least one valid digit,
- or reject this token as an integer literal, we keep track of how many
- digits we have encountered. */
-
-static int
-decode_integer_value (base, tokptrptr, ivalptr)
- int base;
- char **tokptrptr;
- int *ivalptr;
-{
- char *tokptr = *tokptrptr;
- int temp;
- int digits = 0;
-
- while (*tokptr != '\0')
- {
- temp = *tokptr;
- if (isupper (temp))
- temp = tolower (temp);
- tokptr++;
- switch (temp)
- {
- case '_':
- continue;
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- temp -= '0';
- break;
- case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
- temp -= 'a';
- temp += 10;
- break;
- default:
- temp = base;
- break;
- }
- if (temp < base)
- {
- digits++;
- *ivalptr *= base;
- *ivalptr += temp;
- }
- else
- {
- /* Found something not in domain for current base. */
- tokptr--; /* Unconsume what gave us indigestion. */
- break;
- }
- }
-
- /* If we didn't find any digits, then we don't have a valid integer
- value, so reject the entire token. Otherwise, update the lexical
- scan pointer, and return non-zero for success. */
-
- if (digits == 0)
- {
- return (0);
- }
- else
- {
- *tokptrptr = tokptr;
- return (1);
- }
-}
-
-static int
-decode_integer_literal (valptr, tokptrptr)
- int *valptr;
- char **tokptrptr;
-{
- char *tokptr = *tokptrptr;
- int base = 0;
- int ival = 0;
- int explicit_base = 0;
-
- /* Look for an explicit base specifier, which is optional. */
-
- switch (*tokptr)
- {
- case 'd':
- case 'D':
- explicit_base++;
- base = 10;
- tokptr++;
- break;
- case 'b':
- case 'B':
- explicit_base++;
- base = 2;
- tokptr++;
- break;
- case 'h':
- case 'H':
- explicit_base++;
- base = 16;
- tokptr++;
- break;
- case 'o':
- case 'O':
- explicit_base++;
- base = 8;
- tokptr++;
- break;
- default:
- base = 10;
- break;
- }
-
- /* If we found an explicit base ensure that the character after the
- explicit base is a single quote. */
-
- if (explicit_base && (*tokptr++ != '\''))
- {
- return (0);
- }
-
- /* Attempt to decode whatever follows as an integer value in the
- indicated base, updating the token pointer in the process and
- computing the value into ival. Also, if we have an explicit
- base, then the next character must not be a single quote, or we
- have a bitstring literal, so reject the entire token in this case.
- Otherwise, update the lexical scan pointer, and return non-zero
- for success. */
-
- if (!decode_integer_value (base, &tokptr, &ival))
- {
- return (0);
- }
- else if (explicit_base && (*tokptr == '\''))
- {
- return (0);
- }
- else
- {
- *valptr = ival;
- *tokptrptr = tokptr;
- return (1);
- }
-}
-
-/* If it wasn't for the fact that floating point values can contain '_'
- characters, we could just let strtod do all the hard work by letting it
- try to consume as much of the current token buffer as possible and
- find a legal conversion. Unfortunately we need to filter out the '_'
- characters before calling strtod, which we do by copying the other
- legal chars to a local buffer to be converted. However since we also
- need to keep track of where the last unconsumed character in the input
- buffer is, we have transfer only as many characters as may compose a
- legal floating point value. */
-
-static int
-match_float_literal ()
-{
- char *tokptr = lexptr;
- char *buf;
- char *copy;
- double dval;
- extern double strtod ();
-
- /* Make local buffer in which to build the string to convert. This is
- required because underscores are valid in chill floating point numbers
- but not in the string passed to strtod to convert. The string will be
- no longer than our input string. */
-
- copy = buf = (char *) alloca (strlen (tokptr) + 1);
-
- /* Transfer all leading digits to the conversion buffer, discarding any
- underscores. */
-
- while (isdigit (*tokptr) || *tokptr == '_')
- {
- if (*tokptr != '_')
- {
- *copy++ = *tokptr;
- }
- tokptr++;
- }
-
- /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
- of whether we found any leading digits, and we simply accept it and
- continue on to look for the fractional part and/or exponent. One of
- [eEdD] is legal only if we have seen digits, and means that there
- is no fractional part. If we find neither of these, then this is
- not a floating point number, so return failure. */
-
- switch (*tokptr++)
- {
- case '.':
- /* Accept and then look for fractional part and/or exponent. */
- *copy++ = '.';
- break;
-
- case 'e':
- case 'E':
- case 'd':
- case 'D':
- if (copy == buf)
- {
- return (0);
- }
- *copy++ = 'e';
- goto collect_exponent;
- break;
-
- default:
- return (0);
- break;
- }
-
- /* We found a '.', copy any fractional digits to the conversion buffer, up
- to the first nondigit, non-underscore character. */
-
- while (isdigit (*tokptr) || *tokptr == '_')
- {
- if (*tokptr != '_')
- {
- *copy++ = *tokptr;
- }
- tokptr++;
- }
-
- /* Look for an exponent, which must start with one of [eEdD]. If none
- is found, jump directly to trying to convert what we have collected
- so far. */
-
- switch (*tokptr)
- {
- case 'e':
- case 'E':
- case 'd':
- case 'D':
- *copy++ = 'e';
- tokptr++;
- break;
- default:
- goto convert_float;
- break;
- }
-
- /* Accept an optional '-' or '+' following one of [eEdD]. */
-
- collect_exponent:
- if (*tokptr == '+' || *tokptr == '-')
- {
- *copy++ = *tokptr++;
- }
-
- /* Now copy an exponent into the conversion buffer. Note that at the
- moment underscores are *not* allowed in exponents. */
-
- while (isdigit (*tokptr))
- {
- *copy++ = *tokptr++;
- }
-
- /* If we transfered any chars to the conversion buffer, try to interpret its
- contents as a floating point value. If any characters remain, then we
- must not have a valid floating point string. */
-
- convert_float:
- *copy = '\0';
- if (copy != buf)
- {
- dval = strtod (buf, &copy);
- if (*copy == '\0')
- {
- yylval.dval = dval;
- lexptr = tokptr;
- return (FLOAT_LITERAL);
- }
- }
- return (0);
-}
-
-/* Recognize a string literal. A string literal is a sequence
- of characters enclosed in matching single or double quotes, except that
- a single character inside single quotes is a character literal, which
- we reject as a string literal. To embed the terminator character inside
- a string, it is simply doubled (I.E. "this""is""one""string") */
-
-static int
-match_string_literal ()
-{
- char *tokptr = lexptr;
-
- for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
- {
- CHECKBUF (1);
- if (*tokptr == *lexptr)
- {
- if (*(tokptr + 1) == *lexptr)
- {
- tokptr++;
- }
- else
- {
- break;
- }
- }
- tempbuf[tempbufindex++] = *tokptr;
- }
- if (*tokptr == '\0' /* no terminator */
- || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
- {
- return (0);
- }
- else
- {
- tempbuf[tempbufindex] = '\0';
- yylval.sval.ptr = tempbuf;
- yylval.sval.length = tempbufindex;
- lexptr = ++tokptr;
- return (CHARACTER_STRING_LITERAL);
- }
-}
-
-/* Recognize a character literal. A character literal is single character
- or a control sequence, enclosed in single quotes. A control sequence
- is a comma separated list of one or more integer literals, enclosed
- in parenthesis and introduced with a circumflex character.
-
- EX: 'a' '^(7)' '^(7,8)'
-
- As a GNU chill extension, the syntax C'xx' is also recognized as a
- character literal, where xx is a hex value for the character.
-
- Note that more than a single character, enclosed in single quotes, is
- a string literal.
-
- Also note that the control sequence form is not in GNU Chill since it
- is ambiguous with the string literal form using single quotes. I.E.
- is '^(7)' a character literal or a string literal. In theory it it
- possible to tell by context, but GNU Chill doesn't accept the control
- sequence form, so neither do we (for now the code is disabled).
-
- Returns CHARACTER_LITERAL if a match is found.
- */
-
-static int
-match_character_literal ()
-{
- char *tokptr = lexptr;
- int ival = 0;
-
- if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
- {
- /* We have a GNU chill extension form, so skip the leading "C'",
- decode the hex value, and then ensure that we have a trailing
- single quote character. */
- tokptr += 2;
- if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
- {
- return (0);
- }
- tokptr++;
- }
- else if (*tokptr == '\'')
- {
- tokptr++;
-
- /* Determine which form we have, either a control sequence or the
- single character form. */
-
- if ((*tokptr == '^') && (*(tokptr + 1) == '('))
- {
-#if 0 /* Disable, see note above. -fnf */
- /* Match and decode a control sequence. Return zero if we don't
- find a valid integer literal, or if the next unconsumed character
- after the integer literal is not the trailing ')'.
- FIXME: We currently don't handle the multiple integer literal
- form. */
- tokptr += 2;
- if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
- {
- return (0);
- }
-#else
- return (0);
-#endif
- }
- else
- {
- ival = *tokptr++;
- }
-
- /* The trailing quote has not yet been consumed. If we don't find
- it, then we have no match. */
-
- if (*tokptr++ != '\'')
- {
- return (0);
- }
- }
- else
- {
- /* Not a character literal. */
- return (0);
- }
- yylval.typed_val.val = ival;
- yylval.typed_val.type = builtin_type_chill_char;
- lexptr = tokptr;
- return (CHARACTER_LITERAL);
-}
-
-/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
- Note that according to 5.2.4.2, a single "_" is also a valid integer
- literal, however GNU-chill requires there to be at least one "digit"
- in any integer literal. */
-
-static int
-match_integer_literal ()
-{
- char *tokptr = lexptr;
- int ival;
-
- if (!decode_integer_literal (&ival, &tokptr))
- {
- return (0);
- }
- else
- {
- yylval.typed_val.val = ival;
- yylval.typed_val.type = builtin_type_int;
- lexptr = tokptr;
- return (INTEGER_LITERAL);
- }
-}
-
-/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
- Note that according to 5.2.4.8, a single "_" is also a valid bit-string
- literal, however GNU-chill requires there to be at least one "digit"
- in any bit-string literal. */
-
-static int
-match_bitstring_literal ()
-{
- register char *tokptr = lexptr;
- int bitoffset = 0;
- int bitcount = 0;
- int bits_per_char;
- int digit;
-
- tempbufindex = 0;
- CHECKBUF (1);
- tempbuf[0] = 0;
-
- /* Look for the required explicit base specifier. */
-
- switch (*tokptr++)
- {
- case 'b':
- case 'B':
- bits_per_char = 1;
- break;
- case 'o':
- case 'O':
- bits_per_char = 3;
- break;
- case 'h':
- case 'H':
- bits_per_char = 4;
- break;
- default:
- return (0);
- break;
- }
-
- /* Ensure that the character after the explicit base is a single quote. */
-
- if (*tokptr++ != '\'')
- {
- return (0);
- }
-
- while (*tokptr != '\0' && *tokptr != '\'')
- {
- digit = *tokptr;
- if (isupper (digit))
- digit = tolower (digit);
- tokptr++;
- switch (digit)
- {
- case '_':
- continue;
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- digit -= '0';
- break;
- case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
- digit -= 'a';
- digit += 10;
- break;
- default:
- return (0);
- break;
- }
- if (digit >= 1 << bits_per_char)
- {
- /* Found something not in domain for current base. */
- return (0);
- }
- else
- {
- /* Extract bits from digit, packing them into the bitstring byte. */
- int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
- for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
- TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
- {
- bitcount++;
- if (digit & (1 << k))
- {
- tempbuf[tempbufindex] |=
- (TARGET_BYTE_ORDER == BIG_ENDIAN)
- ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
- : (1 << bitoffset);
- }
- bitoffset++;
- if (bitoffset == HOST_CHAR_BIT)
- {
- bitoffset = 0;
- tempbufindex++;
- CHECKBUF(1);
- tempbuf[tempbufindex] = 0;
- }
- }
- }
- }
-
- /* Verify that we consumed everything up to the trailing single quote,
- and that we found some bits (IE not just underbars). */
-
- if (*tokptr++ != '\'')
- {
- return (0);
- }
- else
- {
- yylval.sval.ptr = tempbuf;
- yylval.sval.length = bitcount;
- lexptr = tokptr;
- return (BIT_STRING_LITERAL);
- }
-}
-
-struct token
-{
- char *operator;
- int token;
-};
-
-static const struct token idtokentab[] =
-{
- { "array", ARRAY },
- { "length", LENGTH },
- { "lower", LOWER },
- { "upper", UPPER },
- { "andif", ANDIF },
- { "pred", PRED },
- { "succ", SUCC },
- { "card", CARD },
- { "size", SIZE },
- { "orif", ORIF },
- { "num", NUM },
- { "abs", ABS },
- { "max", MAX_TOKEN },
- { "min", MIN_TOKEN },
- { "mod", MOD },
- { "rem", REM },
- { "not", NOT },
- { "xor", LOGXOR },
- { "and", LOGAND },
- { "in", IN },
- { "or", LOGIOR },
- { "up", UP },
- { "addr", ADDR_TOKEN },
- { "null", EMPTINESS_LITERAL }
-};
-
-static const struct token tokentab2[] =
-{
- { ":=", GDB_ASSIGNMENT },
- { "//", SLASH_SLASH },
- { "->", POINTER },
- { "/=", NOTEQUAL },
- { "<=", LEQ },
- { ">=", GTR }
-};
-
-/* Read one token, getting characters through lexptr. */
-/* This is where we will check to make sure that the language and the
- operators used are compatible. */
-
-static int
-yylex ()
-{
- unsigned int i;
- int token;
- char *inputname;
- struct symbol *sym;
-
- /* Skip over any leading whitespace. */
- while (isspace (*lexptr))
- {
- lexptr++;
- }
- /* Look for special single character cases which can't be the first
- character of some other multicharacter token. */
- switch (*lexptr)
- {
- case '\0':
- return (0);
- case ',':
- case '=':
- case ';':
- case '!':
- case '+':
- case '*':
- case '(':
- case ')':
- case '[':
- case ']':
- return (*lexptr++);
- }
- /* Look for characters which start a particular kind of multicharacter
- token, such as a character literal, register name, convenience
- variable name, string literal, etc. */
- switch (*lexptr)
- {
- case '\'':
- case '\"':
- /* First try to match a string literal, which is any
- sequence of characters enclosed in matching single or double
- quotes, except that a single character inside single quotes
- is a character literal, so we have to catch that case also. */
- token = match_string_literal ();
- if (token != 0)
- {
- return (token);
- }
- if (*lexptr == '\'')
- {
- token = match_character_literal ();
- if (token != 0)
- {
- return (token);
- }
- }
- break;
- case 'C':
- case 'c':
- token = match_character_literal ();
- if (token != 0)
- {
- return (token);
- }
- break;
- case '$':
- yylval.sval.ptr = lexptr;
- do {
- lexptr++;
- } while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
- yylval.sval.length = lexptr - yylval.sval.ptr;
- write_dollar_variable (yylval.sval);
- return GDB_VARIABLE;
- break;
- }
- /* See if it is a special token of length 2. */
- for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
- {
- if (STREQN (lexptr, tokentab2[i].operator, 2))
- {
- lexptr += 2;
- return (tokentab2[i].token);
- }
- }
- /* Look for single character cases which which could be the first
- character of some other multicharacter token, but aren't, or we
- would already have found it. */
- switch (*lexptr)
- {
- case '-':
- case ':':
- case '/':
- case '<':
- case '>':
- return (*lexptr++);
- }
- /* Look for a float literal before looking for an integer literal, so
- we match as much of the input stream as possible. */
- token = match_float_literal ();
- if (token != 0)
- {
- return (token);
- }
- token = match_bitstring_literal ();
- if (token != 0)
- {
- return (token);
- }
- token = match_integer_literal ();
- if (token != 0)
- {
- return (token);
- }
-
- /* Try to match a simple name string, and if a match is found, then
- further classify what sort of name it is and return an appropriate
- token. Note that attempting to match a simple name string consumes
- the token from lexptr, so we can't back out if we later find that
- we can't classify what sort of name it is. */
-
- inputname = match_simple_name_string ();
-
- if (inputname != NULL)
- {
- char *simplename = (char*) alloca (strlen (inputname) + 1);
-
- char *dptr = simplename, *sptr = inputname;
- for (; *sptr; sptr++)
- *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr;
- *dptr = '\0';
-
- /* See if it is a reserved identifier. */
- for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
- {
- if (STREQ (simplename, idtokentab[i].operator))
- {
- return (idtokentab[i].token);
- }
- }
-
- /* Look for other special tokens. */
- if (STREQ (simplename, "true"))
- {
- yylval.ulval = 1;
- return (BOOLEAN_LITERAL);
- }
- if (STREQ (simplename, "false"))
- {
- yylval.ulval = 0;
- return (BOOLEAN_LITERAL);
- }
-
- sym = lookup_symbol (inputname, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
- (struct symtab **) NULL);
- if (sym == NULL && strcmp (inputname, simplename) != 0)
- {
- sym = lookup_symbol (simplename, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
- (struct symtab **) NULL);
- }
- if (sym != NULL)
- {
- yylval.ssym.stoken.ptr = NULL;
- yylval.ssym.stoken.length = 0;
- yylval.ssym.sym = sym;
- yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_BLOCK:
- /* Found a procedure name. */
- return (GENERAL_PROCEDURE_NAME);
- case LOC_STATIC:
- /* Found a global or local static variable. */
- return (LOCATION_NAME);
- 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:
- if (innermost_block == NULL
- || contained_in (block_found, innermost_block))
- {
- innermost_block = block_found;
- }
- return (LOCATION_NAME);
- break;
- case LOC_CONST:
- case LOC_LABEL:
- return (LOCATION_NAME);
- break;
- case LOC_TYPEDEF:
- yylval.tsym.type = SYMBOL_TYPE (sym);
- return TYPENAME;
- case LOC_UNDEF:
- case LOC_CONST_BYTES:
- case LOC_OPTIMIZED_OUT:
- error ("Symbol \"%s\" names no location.", inputname);
- break;
- }
- }
- else if (!have_full_symbols () && !have_partial_symbols ())
- {
- error ("No symbol table is loaded. Use the \"file\" command.");
- }
- else
- {
- error ("No symbol \"%s\" in current context.", inputname);
- }
- }
-
- /* Catch single character tokens which are not part of some
- longer token. */
-
- switch (*lexptr)
- {
- case '.': /* Not float for example. */
- lexptr++;
- while (isspace (*lexptr)) lexptr++;
- inputname = match_simple_name_string ();
- if (!inputname)
- return '.';
- return FIELD_NAME;
- }
-
- return (ILLEGAL_TOKEN);
-}
-
-static void
-write_lower_upper_value (opcode, type)
- enum exp_opcode opcode; /* Either UNOP_LOWER or UNOP_UPPER */
- struct type *type;
-{
- extern LONGEST type_lower_upper ();
- struct type *result_type;
- LONGEST val = type_lower_upper (opcode, type, &result_type);
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (result_type);
- write_exp_elt_longcst (val);
- write_exp_elt_opcode (OP_LONG);
-}
-
-void
-yyerror (msg)
- char *msg;
-{
- error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
-}
diff --git a/gdb/ch-valprint.c b/gdb/ch-valprint.c
index 695530b..9b20137 100644
--- a/gdb/ch-valprint.c
+++ b/gdb/ch-valprint.c
@@ -78,6 +78,7 @@ chill_print_type_scalar (type, val, stream)
case TYPE_CODE_CHAR:
case TYPE_CODE_BOOL:
case TYPE_CODE_COMPLEX:
+ case TYPE_CODE_TYPEDEF:
default:
break;
}
@@ -114,7 +115,7 @@ chill_val_print_array_elements (type, valaddr, address, stream,
unsigned int reps;
LONGEST low_bound = TYPE_FIELD_BITPOS (range_type, 0);
- elttype = TYPE_TARGET_TYPE (type);
+ elttype = check_typedef (TYPE_TARGET_TYPE (type));
eltlen = TYPE_LENGTH (elttype);
len = TYPE_LENGTH (type) / eltlen;
@@ -205,6 +206,8 @@ chill_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
struct type *elttype;
CORE_ADDR addr;
+ CHECK_TYPEDEF (type);
+
switch (TYPE_CODE (type))
{
case TYPE_CODE_ARRAY:
@@ -289,7 +292,7 @@ chill_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
break;
}
addr = unpack_pointer (type, valaddr);
- elttype = TYPE_TARGET_TYPE (type);
+ elttype = check_typedef (TYPE_TARGET_TYPE (type));
/* We assume a NULL pointer is all zeros ... */
if (addr == 0)
@@ -338,7 +341,7 @@ chill_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
case TYPE_CODE_BITSTRING:
case TYPE_CODE_SET:
elttype = TYPE_INDEX_TYPE (type);
- check_stub_type (elttype);
+ CHECK_TYPEDEF (elttype);
if (TYPE_FLAGS (elttype) & TYPE_FLAG_STUB)
{
fprintf_filtered (stream, "<incomplete type>");
@@ -405,7 +408,7 @@ chill_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
case TYPE_CODE_STRUCT:
if (chill_varying_type (type))
{
- struct type *inner = TYPE_FIELD_TYPE (type, 1);
+ struct type *inner = check_typedef (TYPE_FIELD_TYPE (type, 1));
long length = unpack_long (TYPE_FIELD_TYPE (type, 0), valaddr);
char *data_addr = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
@@ -509,7 +512,7 @@ chill_print_value_fields (type, valaddr, stream, format, recurse, pretty,
int i, len;
int fields_seen = 0;
- check_stub_type (type);
+ CHECK_TYPEDEF (type);
fprintf_filtered (stream, "[");
len = TYPE_NFIELDS (type);
@@ -575,15 +578,14 @@ chill_value_print (val, stream, format, pretty)
enum val_prettyprint pretty;
{
struct type *type = VALUE_TYPE (val);
+ struct type *real_type = check_typedef (type);
/* If it is a pointer, indicate what it points to.
- Print type also if it is a reference.
+ Print type also if it is a reference. */
- C++: if it is a member pointer, we will take care
- of that when we print it. */
- if (TYPE_CODE (type) == TYPE_CODE_PTR ||
- TYPE_CODE (type) == TYPE_CODE_REF)
+ if (TYPE_CODE (real_type) == TYPE_CODE_PTR ||
+ TYPE_CODE (real_type) == TYPE_CODE_REF)
{
char *valaddr = VALUE_CONTENTS (val);
CORE_ADDR addr = unpack_pointer (type, valaddr);
diff --git a/gdb/cp-valprint.c b/gdb/cp-valprint.c
index cede47c..f68b753 100644
--- a/gdb/cp-valprint.c
+++ b/gdb/cp-valprint.c
@@ -29,6 +29,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
#include "demangle.h"
#include "annotate.h"
#include "gdb_string.h"
+#include "c-lang.h"
int vtblprint; /* Controls printing of vtbl's */
int objectprint; /* Controls looking up an object's derived type
@@ -43,22 +44,8 @@ cp_print_static_field PARAMS ((struct type *, value_ptr, GDB_FILE *, int, int,
enum val_prettyprint));
static void
-cplus_print_value PARAMS ((struct type *, char *, GDB_FILE *, int, int,
- enum val_prettyprint, struct type **));
-
-/* BEGIN-FIXME: Hooks into typeprint.c, find a better home for prototypes. */
-
-extern void
-c_type_print_base PARAMS ((struct type *, GDB_FILE *, int, int));
-
-extern void
-c_type_print_varspec_prefix PARAMS ((struct type *, GDB_FILE *, int, int));
-
-extern void
-cp_type_print_method_args PARAMS ((struct type **, char *, char *, int,
- GDB_FILE *));
-
-/* END-FIXME */
+cp_print_value PARAMS ((struct type *, char *, CORE_ADDR, GDB_FILE *,
+ int, int, enum val_prettyprint, struct type **));
void
cp_print_class_method (valaddr, type, stream)
@@ -76,9 +63,9 @@ cp_print_class_method (valaddr, type, stream)
struct symbol *sym;
unsigned len;
unsigned int i;
+ struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
- check_stub_type (TYPE_TARGET_TYPE (type));
- domain = TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type));
+ domain = TYPE_DOMAIN_TYPE (target_type);
if (domain == (struct type *)NULL)
{
fprintf_filtered (stream, "<unknown>");
@@ -204,20 +191,21 @@ cp_is_vtbl_member(type)
return 0;
}
-/* Mutually recursive subroutines of cplus_print_value and c_val_print to
- print out a structure's fields: cp_print_value_fields and cplus_print_value.
-
- TYPE, VALADDR, STREAM, RECURSE, and PRETTY have the
- same meanings as in cplus_print_value and c_val_print.
+/* Mutually recursive subroutines of cp_print_value and c_val_print to
+ print out a structure's fields: cp_print_value_fields and cp_print_value.
+
+ TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
+ same meanings as in cp_print_value and c_val_print.
DONT_PRINT is an array of baseclass types that we
should not print, or zero if called from top level. */
void
-cp_print_value_fields (type, valaddr, stream, format, recurse, pretty,
+cp_print_value_fields (type, valaddr, address, stream, format, recurse, pretty,
dont_print_vb, dont_print_statmem)
struct type *type;
char *valaddr;
+ CORE_ADDR address;
GDB_FILE *stream;
int format;
int recurse;
@@ -229,7 +217,7 @@ cp_print_value_fields (type, valaddr, stream, format, recurse, pretty,
struct obstack tmp_obstack;
char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
- check_stub_type (type);
+ CHECK_TYPEDEF (type);
fprintf_filtered (stream, "{");
len = TYPE_NFIELDS (type);
@@ -238,8 +226,8 @@ cp_print_value_fields (type, valaddr, stream, format, recurse, pretty,
/* Print out baseclasses such that we don't print
duplicates of virtual baseclasses. */
if (n_baseclasses > 0)
- cplus_print_value (type, valaddr, stream, format, recurse+1, pretty,
- dont_print_vb);
+ cp_print_value (type, valaddr, address, stream,
+ format, recurse+1, pretty, dont_print_vb);
if (!len && n_baseclasses == 1)
fprintf_filtered (stream, "<No data fields>");
@@ -390,10 +378,11 @@ cp_print_value_fields (type, valaddr, stream, format, recurse, pretty,
baseclasses. */
static void
-cplus_print_value (type, valaddr, stream, format, recurse, pretty,
- dont_print_vb)
+cp_print_value (type, valaddr, address, stream, format, recurse, pretty,
+ dont_print_vb)
struct type *type;
char *valaddr;
+ CORE_ADDR address;
GDB_FILE *stream;
int format;
int recurse;
@@ -417,14 +406,9 @@ cplus_print_value (type, valaddr, stream, format, recurse, pretty,
for (i = 0; i < n_baseclasses; i++)
{
- /* FIXME-32x64--assumes that a target pointer can fit in a char *.
- Fix it by nuking baseclass_addr. */
- char *baddr;
- int err;
- char *basename;
-
- check_stub_type (TYPE_BASECLASS (type, i));
- basename = TYPE_NAME (TYPE_BASECLASS (type, i));
+ int boffset;
+ struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
+ char *basename = TYPE_NAME (baseclass);
if (BASETYPE_VIA_VIRTUAL (type, i))
{
@@ -435,17 +419,13 @@ cplus_print_value (type, valaddr, stream, format, recurse, pretty,
- first_dont_print;
while (--j >= 0)
- if (TYPE_BASECLASS (type, i) == first_dont_print[j])
+ if (baseclass == first_dont_print[j])
goto flush_it;
- obstack_ptr_grow (&dont_print_vb_obstack, TYPE_BASECLASS (type, i));
+ obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
}
- /* Fix to use baseclass_offset instead. FIXME */
- baddr = baseclass_addr (type, i, valaddr, 0, &err);
- if (err == 0 && baddr == 0)
- error ("could not find virtual baseclass %s\n",
- basename ? basename : "");
+ boffset = baseclass_offset (type, i , valaddr, address);
if (pretty)
{
@@ -457,15 +437,11 @@ cplus_print_value (type, valaddr, stream, format, recurse, pretty,
baseclass name. */
fputs_filtered (basename ? basename : "", stream);
fputs_filtered ("> = ", stream);
- if (err != 0)
- {
- fprintf_filtered (stream, "<invalid address ");
- print_address_numeric ((CORE_ADDR) baddr, 1, stream);
- fprintf_filtered (stream, ">");
- }
+ if (boffset == -1)
+ fprintf_filtered (stream, "<invalid address>");
else
- cp_print_value_fields (TYPE_BASECLASS (type, i), baddr, stream, format,
- recurse, pretty,
+ cp_print_value_fields (baseclass, valaddr + boffset, address + boffset,
+ stream, format, recurse, pretty,
(struct type **) obstack_base (&dont_print_vb_obstack),
0);
fputs_filtered (", ", stream);
@@ -526,10 +502,9 @@ cp_print_static_field (type, val, stream, format, recurse, pretty)
obstack_grow (&dont_print_statmem_obstack, &VALUE_ADDRESS (val),
sizeof (CORE_ADDR));
- check_stub_type (type);
- cp_print_value_fields (type, VALUE_CONTENTS (val),
- stream, format, recurse, pretty,
- NULL, 1);
+ CHECK_TYPEDEF (type);
+ cp_print_value_fields (type, VALUE_CONTENTS (val), VALUE_ADDRESS (val),
+ stream, format, recurse, pretty, NULL, 1);
return;
}
val_print (type, VALUE_CONTENTS (val), VALUE_ADDRESS (val),
diff --git a/gdb/stabsread.c b/gdb/stabsread.c
index ac6c734..37c1b9d 100644
--- a/gdb/stabsread.c
+++ b/gdb/stabsread.c
@@ -199,6 +199,7 @@ struct complaint stabs_general_complaint =
static struct type **undef_types;
static int undef_types_allocated;
static int undef_types_length;
+static struct symbol *current_symbol = NULL;
/* Check for and handle cretinous stabs symbol name continuation! */
#define STABS_CONTINUE(pp) \
@@ -492,14 +493,6 @@ read_type_number (pp, typenums)
}
-/* To handle GNU C++ typename abbreviation, we need to be able to
- fill in a type's name as soon as space for that type is allocated.
- `type_synonym_name' is the name of the type being allocated.
- It is cleared as soon as it is used (lest all allocated types
- get this name). */
-
-static char *type_synonym_name;
-
#if !defined (REG_STRUCT_HAS_ADDR)
#define REG_STRUCT_HAS_ADDR(gcc_p,type) 0
#endif
@@ -544,7 +537,7 @@ define_symbol (valu, string, desc, type, objfile)
e.g. ":t10=*2" or a nameless enum like " :T16=ered:0,green:1,blue:2,;" */
nameless = (p == string || ((string[0] == ' ') && (string[1] == ':')));
- sym = (struct symbol *)
+ current_symbol = sym = (struct symbol *)
obstack_alloc (&objfile -> symbol_obstack, sizeof (struct symbol));
memset (sym, 0, sizeof (struct symbol));
@@ -1120,23 +1113,13 @@ define_symbol (valu, string, desc, type, objfile)
synonym = *p == 't';
if (synonym)
- {
- p++;
- type_synonym_name = obsavestring (SYMBOL_NAME (sym),
- strlen (SYMBOL_NAME (sym)),
- &objfile -> symbol_obstack);
- }
+ p++;
/* The semantics of C++ state that "struct foo { ... }" also defines
a typedef for "foo". Unfortunately, cfront never makes the typedef
when translating C++ into C. We make the typedef here so that
"ptype foo" works as expected for cfront translated code. */
else if (current_subfile->language == language_cplus)
- {
- synonym = 1;
- type_synonym_name = obsavestring (SYMBOL_NAME (sym),
- strlen (SYMBOL_NAME (sym)),
- &objfile -> symbol_obstack);
- }
+ synonym = 1;
SYMBOL_TYPE (sym) = read_type (&p, objfile);
@@ -1562,15 +1545,23 @@ read_type (pp, objfile)
now anyway). */
type = alloc_type (objfile);
- memcpy (type, xtype, sizeof (struct type));
-
- /* The idea behind clearing the names is that the only purpose
- for defining a type to another type is so that the name of
- one can be different. So we probably don't need to worry much
- about the case where the compiler doesn't give a name to the
- new type. */
- TYPE_NAME (type) = NULL;
- TYPE_TAG_NAME (type) = NULL;
+ if (SYMBOL_LINE (current_symbol) == 0)
+ {
+ *type = *xtype;
+ /* The idea behind clearing the names is that the only purpose
+ for defining a type to another type is so that the name of
+ one can be different. So we probably don't need to worry
+ much about the case where the compiler doesn't give a name
+ to the new type. */
+ TYPE_NAME (type) = NULL;
+ TYPE_TAG_NAME (type) = NULL;
+ }
+ else
+ {
+ TYPE_CODE (type) = TYPE_CODE_TYPEDEF;
+ TYPE_FLAGS (type) |= TYPE_FLAG_TARGET_STUB;
+ TYPE_TARGET_TYPE (type) = xtype;
+ }
}
if (typenums[0] != -1)
*dbx_lookup_type (typenums) = type;
@@ -1718,11 +1709,6 @@ read_type (pp, objfile)
case 's': /* Struct type */
case 'u': /* Union type */
type = dbx_alloc_type (typenums, objfile);
- if (!TYPE_NAME (type))
- {
- TYPE_NAME (type) = type_synonym_name;
- }
- type_synonym_name = NULL;
switch (type_descriptor)
{
case 's':
@@ -3049,15 +3035,6 @@ read_array_type (pp, type, objfile)
create_range_type ((struct type *) NULL, index_type, lower, upper);
type = create_array_type (type, element_type, range_type);
- /* If we have an array whose element type is not yet known, but whose
- bounds *are* known, record it to be adjusted at the end of the file. */
-
- if ((TYPE_FLAGS (element_type) & TYPE_FLAG_STUB) && !adjustable)
- {
- TYPE_FLAGS (type) |= TYPE_FLAG_TARGET_STUB;
- add_undefined_type (type);
- }
-
return type;
}
@@ -3497,7 +3474,7 @@ read_range_type (pp, typenums, objfile)
if (self_subrange && n2 == 0 && n3 == 0)
return init_type (TYPE_CODE_VOID, 1, 0, NULL, objfile);
- /* If n3 is zero and n2 is not, we want a floating type,
+ /* If n3 is zero and n2 is positive, we want a floating type,
and n2 is the width in bytes.
Fortran programs appear to use this for complex types also,
@@ -3529,6 +3506,10 @@ read_range_type (pp, typenums, objfile)
else if (self_subrange && n2 == 0 && n3 == 127)
return init_type (TYPE_CODE_INT, 1, 0, NULL, objfile);
+ else if (current_symbol && SYMBOL_LANGUAGE (current_symbol) == language_chill
+ && SYMBOL_LINE (current_symbol) > 0)
+ goto handle_true_range;
+
/* We used to do this only for subrange of self or subrange of int. */
else if (n2 == 0)
{
@@ -3794,7 +3775,7 @@ cleanup_undefined_types ()
case TYPE_CODE_ENUM:
{
/* Check if it has been defined since. Need to do this here
- as well as in check_stub_type to deal with the (legitimate in
+ as well as in check_typedef to deal with the (legitimate in
C though not C++) case of several types with the same name
in different source files. */
if (TYPE_FLAGS (*type) & TYPE_FLAG_STUB)
@@ -3831,43 +3812,6 @@ cleanup_undefined_types ()
}
break;
- case TYPE_CODE_ARRAY:
- {
- /* This is a kludge which is here for historical reasons
- because I suspect that check_stub_type does not get
- called everywhere it needs to be called for arrays. Even
- with this kludge, those places are broken for the case
- where the stub type is defined in another compilation
- unit, but this kludge at least deals with it for the case
- in which it is the same compilation unit.
-
- Don't try to do this by calling check_stub_type; it might
- cause symbols to be read in lookup_symbol, and the symbol
- reader is not reentrant. */
-
- struct type *range_type;
- int lower, upper;
-
- if (TYPE_LENGTH (*type) != 0) /* Better be unknown */
- goto badtype;
- if (TYPE_NFIELDS (*type) != 1)
- goto badtype;
- range_type = TYPE_FIELD_TYPE (*type, 0);
- if (TYPE_CODE (range_type) != TYPE_CODE_RANGE)
- goto badtype;
-
- /* Now recompute the length of the array type, based on its
- number of elements and the target type's length. */
- lower = TYPE_FIELD_BITPOS (range_type, 0);
- upper = TYPE_FIELD_BITPOS (range_type, 1);
- TYPE_LENGTH (*type) = (upper - lower + 1)
- * TYPE_LENGTH (TYPE_TARGET_TYPE (*type));
-
- /* If the target type is not a stub, we could be clearing
- TYPE_FLAG_TARGET_STUB for *type. */
- }
- break;
-
default:
badtype:
{
diff --git a/gdb/valops.c b/gdb/valops.c
index a5520ec..b30f4b0 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -55,6 +55,10 @@ static value_ptr cast_into_complex PARAMS ((struct type *, value_ptr));
#define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
+/* Flag for whether we want to abandon failed expression evals by default. */
+
+static int auto_abandon = 0;
+
/* Find the address of function name NAME in the inferior. */
@@ -129,49 +133,59 @@ value_cast (type, arg2)
struct type *type;
register value_ptr arg2;
{
- register enum type_code code1 = TYPE_CODE (type);
+ register enum type_code code1;
register enum type_code code2;
register int scalar;
+ struct type *type2;
if (VALUE_TYPE (arg2) == type)
return arg2;
+ CHECK_TYPEDEF (type);
+ code1 = TYPE_CODE (type);
COERCE_REF(arg2);
+ type2 = check_typedef (VALUE_TYPE (arg2));
/* A cast to an undetermined-length array_type, such as (TYPE [])OBJECT,
is treated like a cast to (TYPE [N])OBJECT,
where N is sizeof(OBJECT)/sizeof(TYPE). */
- if (code1 == TYPE_CODE_ARRAY
- && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
- && TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
+ if (code1 == TYPE_CODE_ARRAY)
{
struct type *element_type = TYPE_TARGET_TYPE (type);
- struct type *range_type = TYPE_INDEX_TYPE (type);
- int low_bound = TYPE_LOW_BOUND (range_type);
- int val_length = TYPE_LENGTH (VALUE_TYPE (arg2));
- int new_length = val_length / TYPE_LENGTH (element_type);
- if (val_length % TYPE_LENGTH (element_type) != 0)
- warning("array element type size does not divide object size in cast");
- /* FIXME-type-allocation: need a way to free this type when we are
- done with it. */
- range_type = create_range_type ((struct type *) NULL,
- TYPE_TARGET_TYPE (range_type),
- low_bound, new_length + low_bound - 1);
- VALUE_TYPE (arg2) = create_array_type ((struct type *) NULL,
- element_type, range_type);
- return arg2;
+ unsigned element_length = TYPE_LENGTH (check_typedef (element_type));
+ if (element_length > 0
+ && TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
+ {
+ struct type *range_type = TYPE_INDEX_TYPE (type);
+ int val_length = TYPE_LENGTH (type2);
+ LONGEST low_bound, high_bound, new_length;
+ if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
+ low_bound = 0, high_bound = 0;
+ new_length = val_length / element_length;
+ if (val_length % element_length != 0)
+ warning("array element type size does not divide object size in cast");
+ /* FIXME-type-allocation: need a way to free this type when we are
+ done with it. */
+ range_type = create_range_type ((struct type *) NULL,
+ TYPE_TARGET_TYPE (range_type),
+ low_bound,
+ new_length + low_bound - 1);
+ VALUE_TYPE (arg2) = create_array_type ((struct type *) NULL,
+ element_type, range_type);
+ return arg2;
+ }
}
if (current_language->c_style_arrays
- && TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_ARRAY)
+ && TYPE_CODE (type2) == TYPE_CODE_ARRAY)
arg2 = value_coerce_array (arg2);
- if (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_FUNC)
+ if (TYPE_CODE (type2) == TYPE_CODE_FUNC)
arg2 = value_coerce_function (arg2);
- COERCE_VARYING_ARRAY (arg2);
-
- code2 = TYPE_CODE (VALUE_TYPE (arg2));
+ type2 = check_typedef (VALUE_TYPE (arg2));
+ COERCE_VARYING_ARRAY (arg2, type2);
+ code2 = TYPE_CODE (type2);
if (code1 == TYPE_CODE_COMPLEX)
return cast_into_complex (type, arg2);
@@ -191,7 +205,7 @@ value_cast (type, arg2)
type of the target as a superclass. If so, we'll need to
offset the object in addition to changing its type. */
value_ptr v = search_struct_field (type_name_no_tag (type),
- arg2, 0, VALUE_TYPE (arg2), 1);
+ arg2, 0, type2, 1);
if (v)
{
VALUE_TYPE (v) = type;
@@ -204,15 +218,15 @@ value_cast (type, arg2)
|| code1 == TYPE_CODE_RANGE)
&& (scalar || code2 == TYPE_CODE_PTR))
return value_from_longest (type, value_as_long (arg2));
- else if (TYPE_LENGTH (type) == TYPE_LENGTH (VALUE_TYPE (arg2)))
+ else if (TYPE_LENGTH (type) == TYPE_LENGTH (type2))
{
if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
{
/* Look in the type of the source to see if it contains the
type of the target as a superclass. If so, we'll need to
offset the pointer rather than just change its type. */
- struct type *t1 = TYPE_TARGET_TYPE (type);
- struct type *t2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
+ struct type *t1 = check_typedef (TYPE_TARGET_TYPE (type));
+ struct type *t2 = check_typedef (TYPE_TARGET_TYPE (type2));
if ( TYPE_CODE (t1) == TYPE_CODE_STRUCT
&& TYPE_CODE (t2) == TYPE_CODE_STRUCT
&& TYPE_NAME (t1) != 0) /* if name unknown, can't have supercl */
@@ -236,19 +250,26 @@ value_cast (type, arg2)
struct type *range1, *range2, *eltype1, *eltype2;
value_ptr val;
int count1, count2;
+ LONGEST low_bound, high_bound;
char *valaddr, *valaddr_data;
if (code2 == TYPE_CODE_BITSTRING)
error ("not implemented: converting bitstring to varying type");
if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
- || (eltype1 = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)),
- eltype2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2)),
+ || (eltype1 = check_typedef (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1))),
+ eltype2 = check_typedef (TYPE_TARGET_TYPE (type2)),
(TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
/* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
error ("Invalid conversion to varying type");
range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
- range2 = TYPE_FIELD_TYPE (VALUE_TYPE (arg2), 0);
- count1 = TYPE_HIGH_BOUND (range1) - TYPE_LOW_BOUND (range1) + 1;
- count2 = TYPE_HIGH_BOUND (range2) - TYPE_LOW_BOUND (range2) + 1;
+ range2 = TYPE_FIELD_TYPE (type2, 0);
+ if (get_discrete_bounds (range1, &low_bound, &high_bound) < 0)
+ count1 = -1;
+ else
+ count1 = high_bound - low_bound + 1;
+ if (get_discrete_bounds (range2, &low_bound, &high_bound) < 0)
+ count1 = -1, count2 = 0; /* To force error before */
+ else
+ count2 = high_bound - low_bound + 1;
if (count2 > count1)
error ("target varying type is too small");
val = allocate_value (type);
@@ -289,7 +310,7 @@ value_zero (type, lv)
{
register value_ptr val = allocate_value (type);
- memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (type));
+ memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (check_typedef (type)));
VALUE_LVAL (val) = lv;
return val;
@@ -311,7 +332,7 @@ value_at (type, addr)
{
register value_ptr val;
- if (TYPE_CODE (type) == TYPE_CODE_VOID)
+ if (TYPE_CODE (check_typedef (type)) == TYPE_CODE_VOID)
error ("Attempt to dereference a generic pointer.");
val = allocate_value (type);
@@ -333,7 +354,7 @@ value_at_lazy (type, addr)
{
register value_ptr val;
- if (TYPE_CODE (type) == TYPE_CODE_VOID)
+ if (TYPE_CODE (check_typedef (type)) == TYPE_CODE_VOID)
error ("Attempt to dereference a generic pointer.");
val = allocate_value (type);
@@ -362,10 +383,10 @@ value_fetch_lazy (val)
register value_ptr val;
{
CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
+ int length = TYPE_LENGTH (VALUE_TYPE (val));
- if (TYPE_LENGTH (VALUE_TYPE (val)))
- read_memory (addr, VALUE_CONTENTS_RAW (val),
- TYPE_LENGTH (VALUE_TYPE (val)));
+ if (length)
+ read_memory (addr, VALUE_CONTENTS_RAW (val), length);
VALUE_LAZY (val) = 0;
return 0;
}
@@ -392,6 +413,7 @@ value_assign (toval, fromval)
type = VALUE_TYPE (toval);
if (VALUE_LVAL (toval) != lval_internalvar)
fromval = value_cast (type, fromval);
+ CHECK_TYPEDEF (type);
/* If TOVAL is a special machine register requiring conversion
of program values to a special raw format,
@@ -405,7 +427,8 @@ value_assign (toval, fromval)
int regno = VALUE_REGNO (toval);
if (REGISTER_CONVERTIBLE (regno))
{
- REGISTER_CONVERT_TO_RAW (VALUE_TYPE (fromval), regno,
+ struct type *fromtype = check_typedef (VALUE_TYPE (fromval));
+ REGISTER_CONVERT_TO_RAW (fromtype, regno,
VALUE_CONTENTS (fromval), raw_buffer);
use_buffer = REGISTER_RAW_SIZE (regno);
}
@@ -416,7 +439,7 @@ value_assign (toval, fromval)
{
case lval_internalvar:
set_internalvar (VALUE_INTERNALVAR (toval), fromval);
- break;
+ return VALUE_INTERNALVAR (toval)->value;
case lval_internalvar_component:
set_internalvar_component (VALUE_INTERNALVAR (toval),
@@ -603,15 +626,6 @@ Can't handle bitfield which doesn't fit in a single register.");
fromval = value_from_longest (type, fieldval);
}
- /* Return a value just like TOVAL except with the contents of FROMVAL
- (except in the case of the type if TOVAL is an internalvar). */
-
- if (VALUE_LVAL (toval) == lval_internalvar
- || VALUE_LVAL (toval) == lval_internalvar_component)
- {
- type = VALUE_TYPE (fromval);
- }
-
val = value_copy (toval);
memcpy (VALUE_CONTENTS_RAW (val), VALUE_CONTENTS (fromval),
TYPE_LENGTH (type));
@@ -702,21 +716,12 @@ value_ptr
value_coerce_array (arg1)
value_ptr arg1;
{
- register struct type *type;
+ register struct type *type = check_typedef (VALUE_TYPE (arg1));
if (VALUE_LVAL (arg1) != lval_memory)
error ("Attempt to take address of value not located in memory.");
- /* Get type of elements. */
- if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY
- || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_STRING)
- type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
- else
- /* A phony array made by value_repeat.
- Its type is the type of the elements, not an array type. */
- type = VALUE_TYPE (arg1);
-
- return value_from_longest (lookup_pointer_type (type),
+ return value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
(LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
}
@@ -741,7 +746,7 @@ value_ptr
value_addr (arg1)
value_ptr arg1;
{
- struct type *type = VALUE_TYPE (arg1);
+ struct type *type = check_typedef (VALUE_TYPE (arg1));
if (TYPE_CODE (type) == TYPE_CODE_REF)
{
/* Copy the value, but change the type from (T&) to (T*).
@@ -757,7 +762,7 @@ value_addr (arg1)
if (VALUE_LVAL (arg1) != lval_memory)
error ("Attempt to take address of value not located in memory.");
- return value_from_longest (lookup_pointer_type (type),
+ return value_from_longest (lookup_pointer_type (VALUE_TYPE (arg1)),
(LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
}
@@ -767,21 +772,22 @@ value_ptr
value_ind (arg1)
value_ptr arg1;
{
+ struct type *type1;
COERCE_ARRAY (arg1);
+ type1 = check_typedef (VALUE_TYPE (arg1));
- if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_MEMBER)
+ if (TYPE_CODE (type1) == TYPE_CODE_MEMBER)
error ("not implemented: member types in value_ind");
/* Allow * on an integer so we can cast it to whatever we want.
This returns an int, which seems like the most C-like thing
to do. "long long" variables are rare enough that
BUILTIN_TYPE_LONGEST would seem to be a mistake. */
- if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_INT)
+ if (TYPE_CODE (type1) == TYPE_CODE_INT)
return value_at (builtin_type_int,
(CORE_ADDR) value_as_long (arg1));
- else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR)
- return value_at_lazy (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)),
- value_as_pointer (arg1));
+ else if (TYPE_CODE (type1) == TYPE_CODE_PTR)
+ return value_at_lazy (TYPE_TARGET_TYPE (type1), value_as_pointer (arg1));
error ("Attempt to take contents of a non-pointer value.");
return 0; /* For lint -- never reached */
}
@@ -859,20 +865,14 @@ value_arg_coerce (arg, param_type)
value_ptr arg;
struct type *param_type;
{
- register struct type *type;
-
-#if 1 /* FIXME: This is only a temporary patch. -fnf */
- if (current_language->c_style_arrays
- && TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)
- arg = value_coerce_array (arg);
-#endif
-
- type = param_type ? param_type : VALUE_TYPE (arg);
+ register struct type *arg_type = check_typedef (VALUE_TYPE (arg));
+ register struct type *type
+ = param_type ? check_typedef (param_type) : arg_type;
switch (TYPE_CODE (type))
{
case TYPE_CODE_REF:
- if (TYPE_CODE (VALUE_TYPE (arg)) != TYPE_CODE_REF)
+ if (TYPE_CODE (arg_type) != TYPE_CODE_REF)
{
arg = value_addr (arg);
VALUE_TYPE (arg) = param_type;
@@ -893,9 +893,12 @@ value_arg_coerce (arg, param_type)
case TYPE_CODE_FUNC:
type = lookup_pointer_type (type);
break;
+ case TYPE_CODE_ARRAY:
+ if (current_language->c_style_arrays)
+ type = lookup_pointer_type (TYPE_TARGET_TYPE (type));
+ break;
case TYPE_CODE_UNDEF:
case TYPE_CODE_PTR:
- case TYPE_CODE_ARRAY:
case TYPE_CODE_STRUCT:
case TYPE_CODE_UNION:
case TYPE_CODE_VOID:
@@ -922,7 +925,7 @@ find_function_addr (function, retval_type)
value_ptr function;
struct type **retval_type;
{
- register struct type *ftype = VALUE_TYPE (function);
+ register struct type *ftype = check_typedef (VALUE_TYPE (function));
register enum type_code code = TYPE_CODE (ftype);
struct type *value_type;
CORE_ADDR funaddr;
@@ -939,8 +942,9 @@ find_function_addr (function, retval_type)
else if (code == TYPE_CODE_PTR)
{
funaddr = value_as_pointer (function);
- if (TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_FUNC
- || TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_METHOD)
+ ftype = check_typedef (TYPE_TARGET_TYPE (ftype));
+ if (TYPE_CODE (ftype) == TYPE_CODE_FUNC
+ || TYPE_CODE (ftype) == TYPE_CODE_METHOD)
{
#ifdef CONVERT_FROM_FUNC_PTR_ADDR
/* FIXME: This is a workaround for the unusual function
@@ -948,7 +952,7 @@ find_function_addr (function, retval_type)
in config/rs6000/tm-rs6000.h */
funaddr = CONVERT_FROM_FUNC_PTR_ADDR (funaddr);
#endif
- value_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype));
+ value_type = TYPE_TARGET_TYPE (ftype);
}
else
value_type = builtin_type_int;
@@ -1015,7 +1019,7 @@ call_function_by_hand (function, nargs, args)
CORE_ADDR funaddr;
int using_gcc;
CORE_ADDR real_pc;
- struct type *ftype = SYMBOL_TYPE (function);
+ struct type *ftype = check_typedef (SYMBOL_TYPE (function));
if (!target_has_execution)
noprocess();
@@ -1039,6 +1043,7 @@ call_function_by_hand (function, nargs, args)
#endif
funaddr = find_function_addr (function, &value_type);
+ CHECK_TYPEDEF (value_type);
{
struct block *b = block_for_pc (funaddr);
@@ -1127,40 +1132,43 @@ call_function_by_hand (function, nargs, args)
/* This is a machine like the sparc, where we may need to pass a pointer
to the structure, not the structure itself. */
for (i = nargs - 1; i >= 0; i--)
- if ((TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT
- || TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_UNION
- || TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_ARRAY
- || TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRING)
- && REG_STRUCT_HAS_ADDR (using_gcc, VALUE_TYPE (args[i])))
- {
- CORE_ADDR addr;
- int len = TYPE_LENGTH (VALUE_TYPE (args[i]));
+ {
+ struct type *arg_type = check_typedef (VALUE_TYPE (args[i]));
+ if ((TYPE_CODE (arg_type) == TYPE_CODE_STRUCT
+ || TYPE_CODE (arg_type) == TYPE_CODE_UNION
+ || TYPE_CODE (arg_type) == TYPE_CODE_ARRAY
+ || TYPE_CODE (arg_type) == TYPE_CODE_STRING)
+ && REG_STRUCT_HAS_ADDR (using_gcc, arg_type))
+ {
+ CORE_ADDR addr;
+ int len = TYPE_LENGTH (arg_type);
#ifdef STACK_ALIGN
- int aligned_len = STACK_ALIGN (len);
+ int aligned_len = STACK_ALIGN (len);
#else
- int aligned_len = len;
+ int aligned_len = len;
#endif
#if !(1 INNER_THAN 2)
- /* The stack grows up, so the address of the thing we push
- is the stack pointer before we push it. */
- addr = sp;
+ /* The stack grows up, so the address of the thing we push
+ is the stack pointer before we push it. */
+ addr = sp;
#else
- sp -= aligned_len;
+ sp -= aligned_len;
#endif
- /* Push the structure. */
- write_memory (sp, VALUE_CONTENTS (args[i]), len);
+ /* Push the structure. */
+ write_memory (sp, VALUE_CONTENTS (args[i]), len);
#if 1 INNER_THAN 2
- /* The stack grows down, so the address of the thing we push
- is the stack pointer after we push it. */
- addr = sp;
+ /* The stack grows down, so the address of the thing we push
+ is the stack pointer after we push it. */
+ addr = sp;
#else
- sp += aligned_len;
+ sp += aligned_len;
#endif
- /* The value we're going to pass is the address of the thing
- we just pushed. */
- args[i] = value_from_longest (lookup_pointer_type (value_type),
- (LONGEST) addr);
- }
+ /* The value we're going to pass is the address of the thing
+ we just pushed. */
+ args[i] = value_from_longest (lookup_pointer_type (value_type),
+ (LONGEST) addr);
+ }
+ }
}
#endif /* REG_STRUCT_HAS_ADDR. */
@@ -1345,7 +1353,7 @@ value_array (lowbound, highbound, elemvec)
error ("bad array bounds (%d, %d)", lowbound, highbound);
}
typelength = TYPE_LENGTH (VALUE_TYPE (elemvec[0]));
- for (idx = 0; idx < nelem; idx++)
+ for (idx = 1; idx < nelem; idx++)
{
if (TYPE_LENGTH (VALUE_TYPE (elemvec[idx])) != typelength)
{
@@ -1466,11 +1474,11 @@ typecmp (staticp, t1, t2)
struct type *tt1, *tt2;
if (! t2[i])
return i+1;
- tt1 = t1[i];
- tt2 = VALUE_TYPE(t2[i]);
+ tt1 = check_typedef (t1[i]);
+ tt2 = check_typedef (VALUE_TYPE(t2[i]));
if (TYPE_CODE (tt1) == TYPE_CODE_REF
/* We should be doing hairy argument matching, as below. */
- && (TYPE_CODE (TYPE_TARGET_TYPE (tt1)) == TYPE_CODE (tt2)))
+ && (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (tt1))) == TYPE_CODE (tt2)))
{
if (TYPE_CODE (tt2) == TYPE_CODE_ARRAY)
t2[i] = value_coerce_array (t2[i]);
@@ -1480,10 +1488,11 @@ typecmp (staticp, t1, t2)
}
while (TYPE_CODE (tt1) == TYPE_CODE_PTR
- && (TYPE_CODE(tt2)==TYPE_CODE_ARRAY || TYPE_CODE(tt2)==TYPE_CODE_PTR))
+ && ( TYPE_CODE (tt2) == TYPE_CODE_ARRAY
+ || TYPE_CODE (tt2) == TYPE_CODE_PTR))
{
- tt1 = TYPE_TARGET_TYPE(tt1);
- tt2 = TYPE_TARGET_TYPE(tt2);
+ tt1 = check_typedef (TYPE_TARGET_TYPE(tt1));
+ tt2 = check_typedef (TYPE_TARGET_TYPE(tt2));
}
if (TYPE_CODE(tt1) == TYPE_CODE(tt2)) continue;
/* Array to pointer is a `trivial conversion' according to the ARM. */
@@ -1516,7 +1525,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
{
int i;
- check_stub_type (type);
+ CHECK_TYPEDEF (type);
if (! looking_for_baseclass)
for (i = TYPE_NFIELDS (type) - 1; i >= TYPE_N_BASECLASSES (type); i--)
@@ -1586,6 +1595,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
{
value_ptr v;
+ struct type *basetype = check_typedef (TYPE_BASECLASS (type, i));
/* If we are looking for baseclasses, this is what we get when we
hit them. But it could happen that the base part's member name
is not yet filled in. */
@@ -1595,15 +1605,28 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
if (BASETYPE_VIA_VIRTUAL (type, i))
{
- value_ptr v2;
- /* Fix to use baseclass_offset instead. FIXME */
- baseclass_addr (type, i, VALUE_CONTENTS (arg1) + offset,
- &v2, (int *)NULL);
- if (v2 == 0)
+ int boffset = VALUE_OFFSET (arg1) + offset;
+ boffset = baseclass_offset (type, i,
+ VALUE_CONTENTS (arg1) + boffset,
+ VALUE_ADDRESS (arg1) + boffset);
+ if (boffset == -1)
error ("virtual baseclass botch");
if (found_baseclass)
- return v2;
- v = search_struct_field (name, v2, 0, TYPE_BASECLASS (type, i),
+ {
+ value_ptr v2 = allocate_value (basetype);
+ VALUE_LVAL (v2) = VALUE_LVAL (arg1);
+ VALUE_ADDRESS (v2) = VALUE_ADDRESS (arg1);
+ VALUE_OFFSET (v2) = VALUE_OFFSET (arg1) + offset + boffset;
+ if (VALUE_LAZY (arg1))
+ VALUE_LAZY (v2) = 1;
+ else
+ memcpy (VALUE_CONTENTS_RAW (v2),
+ VALUE_CONTENTS_RAW (arg1) + offset + boffset,
+ TYPE_LENGTH (basetype));
+ return v2;
+ }
+ v = search_struct_field (name, arg1, offset + boffset,
+ TYPE_BASECLASS (type, i),
looking_for_baseclass);
}
else if (found_baseclass)
@@ -1611,8 +1634,7 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
else
v = search_struct_field (name, arg1,
offset + TYPE_BASECLASS_BITPOS (type, i) / 8,
- TYPE_BASECLASS (type, i),
- looking_for_baseclass);
+ basetype, looking_for_baseclass);
if (v) return v;
}
return NULL;
@@ -1636,7 +1658,7 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
int name_matched = 0;
char dem_opname[64];
- check_stub_type (type);
+ CHECK_TYPEDEF (type);
for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; i--)
{
char *t_field_name = TYPE_FN_FIELDLIST_NAME (type, i);
@@ -1682,7 +1704,11 @@ search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
if (BASETYPE_VIA_VIRTUAL (type, i))
{
- base_offset = baseclass_offset (type, i, *arg1p, offset);
+ base_offset = VALUE_OFFSET (*arg1p) + offset;
+ base_offset =
+ baseclass_offset (type, i,
+ VALUE_CONTENTS (*arg1p) + base_offset,
+ VALUE_ADDRESS (*arg1p) + base_offset);
if (base_offset == -1)
error ("virtual baseclass botch");
}
@@ -1733,7 +1759,7 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
COERCE_ARRAY (*argp);
- t = VALUE_TYPE (*argp);
+ t = check_typedef (VALUE_TYPE (*argp));
/* Follow pointers until we get to a non-pointer. */
@@ -1743,7 +1769,7 @@ value_struct_elt (argp, args, name, static_memfuncp, err)
/* Don't coerce fn pointer to fn and then back again! */
if (TYPE_CODE (VALUE_TYPE (*argp)) != TYPE_CODE_FUNC)
COERCE_ARRAY (*argp);
- t = VALUE_TYPE (*argp);
+ t = check_typedef (VALUE_TYPE (*argp));
}
if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
@@ -1907,8 +1933,13 @@ check_field (arg1, name)
/* Follow pointers until we get to a non-pointer. */
- while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
- t = TYPE_TARGET_TYPE (t);
+ for (;;)
+ {
+ CHECK_TYPEDEF (t);
+ if (TYPE_CODE (t) != TYPE_CODE_PTR && TYPE_CODE (t) != TYPE_CODE_REF)
+ break;
+ t = TYPE_TARGET_TYPE (t);
+ }
if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
error ("not implemented: member type in check_field");
@@ -2124,21 +2155,26 @@ value_slice (array, lowbound, length)
value_ptr array;
int lowbound, length;
{
- COERCE_VARYING_ARRAY (array);
- if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_BITSTRING)
+ struct type *array_type;
+ array_type = check_typedef (VALUE_TYPE (array));
+ COERCE_VARYING_ARRAY (array, array_type);
+ if (TYPE_CODE (array_type) == TYPE_CODE_BITSTRING)
error ("not implemented - bitstring slice");
- if (TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_ARRAY
- && TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_STRING)
+ if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
+ && TYPE_CODE (array_type) != TYPE_CODE_STRING)
error ("cannot take slice of non-array");
else
{
struct type *slice_range_type, *slice_type;
value_ptr slice;
- struct type *range_type = TYPE_FIELD_TYPE (VALUE_TYPE (array), 0);
- struct type *element_type = TYPE_TARGET_TYPE (VALUE_TYPE (array));
- int lowerbound = TYPE_LOW_BOUND (range_type);
- int upperbound = TYPE_HIGH_BOUND (range_type);
- int offset = (lowbound - lowerbound) * TYPE_LENGTH (element_type);
+ struct type *range_type = TYPE_FIELD_TYPE (array_type,0);
+ struct type *element_type = TYPE_TARGET_TYPE (array_type);
+ LONGEST lowerbound, upperbound, offset;
+
+ if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
+ error ("slice from bad array");
+ offset
+ = (lowbound - lowerbound) * TYPE_LENGTH (check_typedef (element_type));
if (lowbound < lowerbound || length < 0
|| lowbound + length - 1 > upperbound)
error ("slice out of range");
@@ -2150,7 +2186,7 @@ value_slice (array, lowbound, length)
lowerbound + length - 1);
slice_type = create_array_type ((struct type*) NULL, element_type,
slice_range_type);
- TYPE_CODE (slice_type) = TYPE_CODE (VALUE_TYPE (array));
+ TYPE_CODE (slice_type) = TYPE_CODE (array_type);
slice = allocate_value (slice_type);
if (VALUE_LAZY (array))
VALUE_LAZY (slice) = 1;
@@ -2174,7 +2210,7 @@ value_ptr
varying_to_slice (varray)
value_ptr varray;
{
- struct type *vtype = VALUE_TYPE (varray);
+ struct type *vtype = check_typedef (VALUE_TYPE (varray));
LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
VALUE_CONTENTS (varray)
+ TYPE_FIELD_BITPOS (vtype, 0) / 8);
@@ -2235,3 +2271,15 @@ cast_into_complex (type, val)
else
error ("cannot cast non-number to complex");
}
+
+void
+_initialize_valops ()
+{
+#if 0
+ add_show_from_set
+ (add_set_cmd ("abandon", class_support, var_boolean, (char *)&auto_abandon,
+ "Set automatic abandonment of expressions upon failure.",
+ &setlist),
+ &showlist);
+#endif
+}
diff --git a/gdb/values.c b/gdb/values.c
index e076f5b..76062bb 100644
--- a/gdb/values.c
+++ b/gdb/values.c
@@ -73,10 +73,9 @@ allocate_value (type)
struct type *type;
{
register value_ptr val;
+ struct type *atype = check_typedef (type);
- check_stub_type (type);
-
- val = (struct value *) xmalloc (sizeof (struct value) + TYPE_LENGTH (type));
+ val = (struct value *) xmalloc (sizeof (struct value) + TYPE_LENGTH (atype));
VALUE_NEXT (val) = all_values;
all_values = val;
VALUE_TYPE (val) = type;
@@ -621,6 +620,8 @@ unpack_long (type, valaddr)
switch (code)
{
+ case TYPE_CODE_TYPEDEF:
+ return unpack_long (check_typedef (type), valaddr);
case TYPE_CODE_ENUM:
case TYPE_CODE_BOOL:
case TYPE_CODE_INT:
@@ -666,6 +667,7 @@ unpack_double (type, valaddr, invp)
register int nosign = TYPE_UNSIGNED (type);
*invp = 0; /* Assume valid. */
+ CHECK_TYPEDEF (type);
if (code == TYPE_CODE_FLT)
{
#ifdef INVALID_FLOAT
@@ -729,7 +731,7 @@ value_primitive_field (arg1, offset, fieldno, arg_type)
register value_ptr v;
register struct type *type;
- check_stub_type (arg_type);
+ CHECK_TYPEDEF (arg_type);
type = TYPE_FIELD_TYPE (arg_type, fieldno);
/* Handle packed fields */
@@ -835,6 +837,8 @@ value_virtual_fn_field (arg1p, f, j, type, offset)
int offset;
{
value_ptr arg1 = *arg1p;
+ struct type *type1 = check_typedef (VALUE_TYPE (arg1));
+ struct type *entry_type;
/* First, get the virtual function table pointer. That comes
with a strange type, so cast it to type `pointer to long' (which
should serve just fine as a function type). Then, index into
@@ -852,10 +856,13 @@ value_virtual_fn_field (arg1p, f, j, type, offset)
fcontext = TYPE_VPTR_BASETYPE (type);
context = lookup_pointer_type (fcontext);
/* Now context is a pointer to the basetype containing the vtbl. */
- if (TYPE_TARGET_TYPE (context) != VALUE_TYPE (arg1))
- arg1 = value_ind (value_cast (context, value_addr (arg1)));
+ if (TYPE_TARGET_TYPE (context) != type1)
+ {
+ arg1 = value_ind (value_cast (context, value_addr (arg1)));
+ type1 = check_typedef (VALUE_TYPE (arg1));
+ }
- context = VALUE_TYPE (arg1);
+ context = type1;
/* Now context is the basetype containing the vtbl. */
/* This type may have been defined before its virtual function table
@@ -875,8 +882,9 @@ value_virtual_fn_field (arg1p, f, j, type, offset)
time, e.g. if the user has set a conditional breakpoint calling
a virtual function. */
entry = value_subscript (vtbl, vi);
+ entry_type = check_typedef (VALUE_TYPE (entry));
- if (TYPE_CODE (VALUE_TYPE (entry)) == TYPE_CODE_STRUCT)
+ if (TYPE_CODE (entry_type) == TYPE_CODE_STRUCT)
{
/* Move the `this' pointer according to the virtual function table. */
VALUE_OFFSET (arg1) += value_as_long (value_field (entry, 0));
@@ -889,7 +897,7 @@ value_virtual_fn_field (arg1p, f, j, type, offset)
vfn = value_field (entry, 2);
}
- else if (TYPE_CODE (VALUE_TYPE (entry)) == TYPE_CODE_PTR)
+ else if (TYPE_CODE (entry_type) == TYPE_CODE_PTR)
vfn = entry;
else
error ("I'm confused: virtual function table has bad type");
@@ -925,7 +933,7 @@ value_headof (in_arg, btype, dtype)
struct minimal_symbol *msymbol;
btype = TYPE_VPTR_BASETYPE (dtype);
- check_stub_type (btype);
+ CHECK_TYPEDEF (btype);
arg = in_arg;
if (btype != dtype)
arg = value_cast (lookup_pointer_type (btype), arg);
@@ -955,7 +963,7 @@ value_headof (in_arg, btype, dtype)
entry = value_subscript (vtbl, value_from_longest (builtin_type_int,
(LONGEST) i));
/* This won't work if we're using thunks. */
- if (TYPE_CODE (VALUE_TYPE (entry)) != TYPE_CODE_STRUCT)
+ if (TYPE_CODE (check_typedef (VALUE_TYPE (entry))) != TYPE_CODE_STRUCT)
break;
offset = longest_to_int (value_as_long (value_field (entry, 0)));
/* If we use '<=' we can handle single inheritance
@@ -1066,19 +1074,19 @@ vb_match (type, index, basetype)
}
/* Compute the offset of the baseclass which is
- the INDEXth baseclass of class TYPE, for a value ARG,
- wih extra offset of OFFSET.
- The result is the offste of the baseclass value relative
+ the INDEXth baseclass of class TYPE,
+ for value at VALADDR (in host) at ADDRESS (in target).
+ The result is the offset of the baseclass value relative
to (the address of)(ARG) + OFFSET.
-1 is returned on error. */
int
-baseclass_offset (type, index, arg, offset)
+baseclass_offset (type, index, valaddr, address)
struct type *type;
int index;
- value_ptr arg;
- int offset;
+ char *valaddr;
+ CORE_ADDR address;
{
struct type *basetype = TYPE_BASECLASS (type, index);
@@ -1096,22 +1104,16 @@ baseclass_offset (type, index, arg, offset)
{
CORE_ADDR addr
= unpack_pointer (TYPE_FIELD_TYPE (type, i),
- VALUE_CONTENTS (arg) + VALUE_OFFSET (arg)
- + offset
- + (TYPE_FIELD_BITPOS (type, i) / 8));
-
- if (VALUE_LVAL (arg) != lval_memory)
- return -1;
+ valaddr + (TYPE_FIELD_BITPOS (type, i) / 8));
- return addr -
- (LONGEST) (VALUE_ADDRESS (arg) + VALUE_OFFSET (arg) + offset);
+ return addr - (LONGEST) address;
}
}
/* Not in the fields, so try looking through the baseclasses. */
for (i = index+1; i < n_baseclasses; i++)
{
int boffset =
- baseclass_offset (type, i, arg, offset);
+ baseclass_offset (type, i, valaddr, address);
if (boffset)
return boffset;
}
@@ -1122,95 +1124,6 @@ baseclass_offset (type, index, arg, offset)
/* Baseclass is easily computed. */
return TYPE_BASECLASS_BITPOS (type, index) / 8;
}
-
-/* Compute the address of the baseclass which is
- the INDEXth baseclass of class TYPE. The TYPE base
- of the object is at VALADDR.
-
- If ERRP is non-NULL, set *ERRP to be the errno code of any error,
- or 0 if no error. In that case the return value is not the address
- of the baseclasss, but the address which could not be read
- successfully. */
-
-/* FIXME Fix remaining uses of baseclass_addr to use baseclass_offset */
-
-char *
-baseclass_addr (type, index, valaddr, valuep, errp)
- struct type *type;
- int index;
- char *valaddr;
- value_ptr *valuep;
- int *errp;
-{
- struct type *basetype = TYPE_BASECLASS (type, index);
-
- if (errp)
- *errp = 0;
-
- if (BASETYPE_VIA_VIRTUAL (type, index))
- {
- /* Must hunt for the pointer to this virtual baseclass. */
- register int i, len = TYPE_NFIELDS (type);
- register int n_baseclasses = TYPE_N_BASECLASSES (type);
-
- /* First look for the virtual baseclass pointer
- in the fields. */
- for (i = n_baseclasses; i < len; i++)
- {
- if (vb_match (type, i, basetype))
- {
- value_ptr val = allocate_value (basetype);
- CORE_ADDR addr;
- int status;
-
- addr
- = unpack_pointer (TYPE_FIELD_TYPE (type, i),
- valaddr + (TYPE_FIELD_BITPOS (type, i) / 8));
-
- status = target_read_memory (addr,
- VALUE_CONTENTS_RAW (val),
- TYPE_LENGTH (basetype));
- VALUE_LVAL (val) = lval_memory;
- VALUE_ADDRESS (val) = addr;
-
- if (status != 0)
- {
- if (valuep)
- *valuep = NULL;
- release_value (val);
- value_free (val);
- if (errp)
- *errp = status;
- return (char *)addr;
- }
- else
- {
- if (valuep)
- *valuep = val;
- return (char *) VALUE_CONTENTS (val);
- }
- }
- }
- /* Not in the fields, so try looking through the baseclasses. */
- for (i = index+1; i < n_baseclasses; i++)
- {
- char *baddr;
-
- baddr = baseclass_addr (type, i, valaddr, valuep, errp);
- if (baddr)
- return baddr;
- }
- /* Not found. */
- if (valuep)
- *valuep = 0;
- return 0;
- }
-
- /* Baseclass is easily computed. */
- if (valuep)
- *valuep = 0;
- return valaddr + TYPE_BASECLASS_BITPOS (type, index) / 8;
-}
/* Unpack a field FIELDNO of the specified TYPE, from the anonymous object at
VALADDR.
@@ -1321,11 +1234,17 @@ value_from_longest (type, num)
register LONGEST num;
{
register value_ptr val = allocate_value (type);
- register enum type_code code = TYPE_CODE (type);
- register int len = TYPE_LENGTH (type);
+ register enum type_code code;
+ register int len;
+ retry:
+ code = TYPE_CODE (type);
+ len = TYPE_LENGTH (type);
switch (code)
{
+ case TYPE_CODE_TYPEDEF:
+ type = check_typedef (type);
+ goto retry;
case TYPE_CODE_INT:
case TYPE_CODE_CHAR:
case TYPE_CODE_ENUM:
@@ -1353,8 +1272,9 @@ value_from_double (type, num)
double num;
{
register value_ptr val = allocate_value (type);
- register enum type_code code = TYPE_CODE (type);
- register int len = TYPE_LENGTH (type);
+ struct type *base_type = check_typedef (type);
+ register enum type_code code = TYPE_CODE (base_type);
+ register int len = TYPE_LENGTH (base_type);
if (code == TYPE_CODE_FLT)
{
@@ -1401,6 +1321,7 @@ value_being_returned (valtype, retbuf, struct_return)
#endif
val = allocate_value (valtype);
+ CHECK_TYPEDEF (valtype);
EXTRACT_RETURN_VALUE (valtype, retbuf, VALUE_CONTENTS_RAW (val));
return val;
@@ -1466,7 +1387,8 @@ void
set_return_value (val)
value_ptr val;
{
- register enum type_code code = TYPE_CODE (VALUE_TYPE (val));
+ struct type *type = check_typedef (VALUE_TYPE (val));
+ register enum type_code code = TYPE_CODE (type);
if (code == TYPE_CODE_ERROR)
error ("Function return type unknown.");
@@ -1475,7 +1397,7 @@ set_return_value (val)
|| code == TYPE_CODE_UNION) /* FIXME, implement struct return. */
error ("GDB does not support specifying a struct or union return value.");
- STORE_RETURN_VALUE (VALUE_TYPE (val), VALUE_CONTENTS (val));
+ STORE_RETURN_VALUE (type, VALUE_CONTENTS (val));
}
void