diff options
| -rw-r--r-- | gdb/ChangeLog | 28 | ||||
| -rw-r--r-- | gdb/Makefile.in | 47 | ||||
| -rw-r--r-- | gdb/c-lang.c | 8 | ||||
| -rw-r--r-- | gdb/c-lang.h | 48 | ||||
| -rw-r--r-- | gdb/c-typeprint.c | 12 | ||||
| -rw-r--r-- | gdb/c-valprint.c | 57 | ||||
| -rw-r--r-- | gdb/ch-exp.c | 1974 | ||||
| -rw-r--r-- | gdb/ch-exp.y | 1664 | ||||
| -rw-r--r-- | gdb/ch-valprint.c | 22 | ||||
| -rw-r--r-- | gdb/cp-valprint.c | 87 | ||||
| -rw-r--r-- | gdb/stabsread.c | 110 | ||||
| -rw-r--r-- | gdb/valops.c | 332 | ||||
| -rw-r--r-- | gdb/values.c | 164 |
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, ©); + 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, ©); - 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 |