GNAT support for GDB patch from Paul Hilfinger
Jason Molenda
jsm@cygnus.com
Wed Jan 28 18:27:00 GMT 1998
This was sent to me by Vincent Renardi, the Debian maintainer of GDB.
Stan says that he has pinged Paul Hilfinger for a copyright assignment,
but has yet to hear anything back. I'll try to ask him again, but this
clearly won't be in time for 4.17.
J
-------------------------------------------------------------------
diff -c -r -N gdb-4.16/gdb/ChangeLog gdb/ChangeLog
*** gdb-4.16/gdb/ChangeLog Tue Apr 23 00:34:43 1996
--- gdb-4.16.orig/gdb/ChangeLog Thu Mar 27 00:34:42 1997
***************
*** 1,3 ****
--- 1,8 ----
+ Thu Mar 27 00:33:01 1997 Paul Hilfinger <hilfingr@nile.gnat.com>
+
+ * config/sparc/tm-sun4sol2.h: Undefine SUN_FIXED_LBRAC_BUG (meaning
+ that the bug IS fixed).
+
Mon Apr 22 20:17:01 1996 Fred Fish <fnf@cygnus.com>
* Makefile.in (VERSION): Bump version number to 4.16
diff -c -r -N gdb-4.16/gdb/Makefile.in gdb/Makefile.in
*** gdb-4.16/gdb/Makefile.in Tue Apr 23 00:43:08 1996
--- gdb-4.16.orig/gdb/Makefile.in Thu Mar 27 11:12:51 1997
***************
*** 17,22 ****
--- 17,24 ----
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ # Modified for GNAT by P. N. Hilfinger
+
prefix = @prefix@
exec_prefix = @exec_prefix@
***************
*** 70,75 ****
--- 72,82 ----
YACC=@YACC@
+ # If you wish to be able to rebuild ada-lex.c from ada-lex.l, FLEX must
+ # be defined to the name for invoking flex. Don't define it if FLEX is
+ # not present.
+ FLEX = flex
+
# where to find makeinfo, preferably one designed for texinfo-2
MAKEINFO=makeinfo
***************
*** 147,153 ****
#PROFILE_CFLAGS = -pg
# CFLAGS is specifically reserved for setting from the command line
! # when running make. I.E. "make CFLAGS=-Wmissing-prototypes".
CFLAGS = -g
# Need to pass this to testsuite for "make check". Probably should be
--- 154,160 ----
#PROFILE_CFLAGS = -pg
# CFLAGS is specifically reserved for setting from the command line
! # when running make. E.G. "make CFLAGS=-Wmissing-prototypes".
CFLAGS = -g
# Need to pass this to testsuite for "make check". Probably should be
***************
*** 192,198 ****
ADD_FILES = $(REGEX) $(XM_ADD_FILES) $(TM_ADD_FILES) $(NAT_ADD_FILES)
ADD_DEPS = $(REGEX1) $(XM_ADD_FILES) $(TM_ADD_FILES) $(NAT_ADD_FILES)
! VERSION = 4.16
DIST=gdb
LINT=/usr/5bin/lint
--- 199,205 ----
ADD_FILES = $(REGEX) $(XM_ADD_FILES) $(TM_ADD_FILES) $(NAT_ADD_FILES)
ADD_DEPS = $(REGEX1) $(XM_ADD_FILES) $(TM_ADD_FILES) $(NAT_ADD_FILES)
! VERSION = 4.16.gnat.1.12
DIST=gdb
LINT=/usr/5bin/lint
***************
*** 330,336 ****
# Links made at configuration time should not be specified here, since
# SFILES is used in building the distribution archive.
! SFILES = bcache.c blockframe.c breakpoint.c buildsym.c callback.c c-exp.y \
c-lang.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 \
--- 337,344 ----
# Links made at configuration time should not be specified here, since
# SFILES is used in building the distribution archive.
! SFILES = ada-exp.y ada-lang.c ada-typeprint.c ada-valprint.c \
! bcache.c blockframe.c breakpoint.c buildsym.c callback.c c-exp.y \
c-lang.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 \
***************
*** 403,410 ****
gdb-stabs.h $(inferior_h) language.h minimon.h monitor.h \
objfiles.h parser-defs.h partial-stab.h serial.h signals.h solib.h \
symfile.h stabsread.h target.h terminal.h typeprint.h xcoffsolib.h \
! c-lang.h ch-lang.h f-lang.h m2-lang.h \
! complaints.h valprint.h \
29k-share/udi/udiids.h 29k-share/udi_soc nindy-share/b.out.h \
nindy-share/block_io.h nindy-share/coff.h \
nindy-share/env.h nindy-share/stop.h \
--- 411,418 ----
gdb-stabs.h $(inferior_h) language.h minimon.h monitor.h \
objfiles.h parser-defs.h partial-stab.h serial.h signals.h solib.h \
symfile.h stabsread.h target.h terminal.h typeprint.h xcoffsolib.h \
! ada-lang.h c-lang.h ch-lang.h f-lang.h m2-lang.h \
! complaints.h valprint.h \
29k-share/udi/udiids.h 29k-share/udi_soc nindy-share/b.out.h \
nindy-share/block_io.h nindy-share/coff.h \
nindy-share/env.h nindy-share/stop.h \
***************
*** 449,454 ****
--- 457,463 ----
exec.o bcache.o objfiles.o minsyms.o maint.o demangle.o \
dbxread.o coffread.o elfread.o \
dwarfread.o mipsread.o stabsread.o corefile.o \
+ ada-lang.o ada-typeprint.o ada-valprint.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 \
***************
*** 468,475 ****
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
! YYOBJ = c-exp.tab.o f-exp.tab.o m2-exp.tab.o
# Things which need to be built when making a distribution.
--- 477,484 ----
SUBDIRS = doc testsuite nlm
# For now, shortcut the "configure GDB for fewer languages" stuff.
! YYFILES = ada-exp.tab.c c-exp.tab.c f-exp.tab.c m2-exp.tab.c
! YYOBJ = ada-exp.tab.o c-exp.tab.o f-exp.tab.o m2-exp.tab.o
# Things which need to be built when making a distribution.
***************
*** 709,715 ****
@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
rm -f TAGS $(INFOFILES)
rm -f nm.h tm.h xm.h config.status
rm -f y.output yacc.acts yacc.tmp
--- 718,724 ----
@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 ada-exp.tab.c 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
***************
*** 818,825 ****
-rm y.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 f-exp.tab.c c-exp.tab.c
lint: $(LINTFILES)
$(LINT) $(INCLUDE_CFLAGS) $(LINTFLAGS) $(LINTFILES) \
--- 827,867 ----
-rm y.tab.c
mv m2-exp.new ./m2-exp.tab.c
+ # ada-exp.tab.c is generated in objdir from ada-exp.y if it doesn't exist
+ # in srcdir, then compiled in objdir to ada-exp.tab.o.
+ # Remove bogus decls for malloc/realloc/free which conflict with everything
+ # else.
+ ada-exp.tab.o: ada-exp.tab.c ada-lex.c
+ # the dependency here on m2-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.
+ ada-exp.tab.c: ada-exp.y m2-exp.tab.c
+ $(YACC) $(YFLAGS) $(srcdir)/ada-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 > ada-exp.new
+ -rm y.tab.c
+ mv ada-exp.new ./ada-exp.tab.c
+
+ ada-lex.c: ada-lex.l
+ @if [ "$(FLEX)" ]; then \
+ echo $(FLEX) -Isit ada-lex.l ">" ada-lex.c; \
+ $(FLEX) -Isit ada-lex.l > ada-lex.c; \
+ elif [ ! -f ada-lex.c ]; then \
+ echo "ada-lex.c missing and flex not available."; \
+ false; \
+ else \
+ echo "Warning: ada-lex.c older than ada-lex.l and flex not available."; \
+ fi
+
+
+
# These files are updated atomically, so make never has to remove them
! .PRECIOUS: ada-exp.tab.c m2-exp.tab.c f-exp.tab.c c-exp.tab.c
lint: $(LINTFILES)
$(LINT) $(INCLUDE_CFLAGS) $(LINTFLAGS) $(LINTFILES) \
***************
*** 966,971 ****
--- 1008,1024 ----
a68v-nat.o: a68v-nat.c $(defs_h) $(gdbcore_h) $(inferior_h)
+ ada-lang.o: ada-lang.c ada-lang.h c-lang.h $(defs_h) $(expression_h) \
+ $(gdbtypes_h) $(inferior_h) language.h parser-defs.h $(symtab_h) \
+ symfile.h objfiles.h
+
+ ada-typeprint.o: ada-typeprint.c ada-lang.h $(defs_h) $(expression_h) \
+ $(gdbcmd_h) $(gdbcore_h) $(gdbtypes_h) language.h $(symtab_h) \
+ target.h typeprint.h $(value_h)
+
+ ada-valprint.o: ada-valprint.c $(defs_h) $(expression_h) $(gdbtypes_h) \
+ language.h $(symtab_h) valprint.h $(value_h) c-lang.h ada-lang.h
+
alpha-nat.o: alpha-nat.c $(defs_h) $(gdbcore_h) $(inferior_h) target.h
alpha-tdep.o: alpha-tdep.c $(defs_h) $(gdbcmd_h) $(gdbcore_h) \
***************
*** 1085,1091 ****
eval.o: eval.c $(bfd_h) $(defs_h) $(expression_h) $(frame_h) \
$(gdbtypes_h) language.h $(symtab_h) target.h $(value_h) \
! gdb_string.h
exec.o: exec.c $(defs_h) $(gdbcmd_h) $(gdbcore_h) $(inferior_h) \
target.h language.h gdb_string.h
--- 1138,1144 ----
eval.o: eval.c $(bfd_h) $(defs_h) $(expression_h) $(frame_h) \
$(gdbtypes_h) language.h $(symtab_h) target.h $(value_h) \
! gdb_string.h ada-lang.h
exec.o: exec.c $(defs_h) $(gdbcmd_h) $(gdbcore_h) $(inferior_h) \
target.h language.h gdb_string.h
***************
*** 1280,1286 ****
parse.o: parse.c $(command_h) $(defs_h) $(expression_h) $(frame_h) \
$(gdbtypes_h) language.h parser-defs.h $(symtab_h) $(value_h) \
! gdb_string.h
ppcbug-rom.o: ppcbug-rom.c monitor.h $(bfd_h) $(wait_h) $(defs_h) $(gdbcmd_h) \
$(inferior_h) target.h serial.h terminal.h
--- 1333,1339 ----
parse.o: parse.c $(command_h) $(defs_h) $(expression_h) $(frame_h) \
$(gdbtypes_h) language.h parser-defs.h $(symtab_h) $(value_h) \
! gdb_string.h ada-lang.h
ppcbug-rom.o: ppcbug-rom.c monitor.h $(bfd_h) $(wait_h) $(defs_h) $(gdbcmd_h) \
$(inferior_h) target.h serial.h terminal.h
***************
*** 1449,1455 ****
symtab.o: symtab.c call-cmds.h $(defs_h) $(expression_h) $(frame_h) \
$(gdbcmd_h) $(gdbcore_h) $(gdbtypes_h) language.h objfiles.h \
gnu-regex.h symfile.h $(symtab_h) target.h $(value_h) \
! gdb_string.h
tahoe-tdep.o: tahoe-tdep.c $(OP_INCLUDE)/tahoe.h $(defs_h) \
$(symtab_h)
--- 1502,1508 ----
symtab.o: symtab.c call-cmds.h $(defs_h) $(expression_h) $(frame_h) \
$(gdbcmd_h) $(gdbcore_h) $(gdbtypes_h) language.h objfiles.h \
gnu-regex.h symfile.h $(symtab_h) target.h $(value_h) \
! gdb_string.h ada-lang.h
tahoe-tdep.o: tahoe-tdep.c $(OP_INCLUDE)/tahoe.h $(defs_h) \
$(symtab_h)
***************
*** 1480,1486 ****
gdb_string.h
valops.o: valops.c $(defs_h) $(gdbcore_h) $(inferior_h) target.h \
! gdb_string.h
valprint.o: valprint.c $(defs_h) $(expression_h) $(gdbcmd_h) \
$(gdbcore_h) $(gdbtypes_h) language.h $(symtab_h) target.h \
--- 1533,1539 ----
gdb_string.h
valops.o: valops.c $(defs_h) $(gdbcore_h) $(inferior_h) target.h \
! gdb_string.h ada-lang.h
valprint.o: valprint.c $(defs_h) $(expression_h) $(gdbcmd_h) \
$(gdbcore_h) $(gdbtypes_h) language.h $(symtab_h) target.h \
***************
*** 1519,1524 ****
--- 1572,1582 ----
z8k-tdep.o: z8k-tdep.c $(bfd_h) $(dis-asm_h) $(defs_h) $(frame_h) \
$(gdbcmd_h) $(gdbtypes_h) $(symtab_h)
+
+ ada-exp.tab.o: ada-exp.tab.c ada-lex.c ada-lang.h \
+ $(defs_h) $(expression_h) \
+ $(gdbtypes_h) language.h parser-defs.h $(symtab_h) $(value_h) \
+ $(bfd_h) objfiles.h symfile.h
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) \
diff -c -r -N gdb-4.16/gdb/ada-exp.tab.c gdb/ada-exp.tab.c
*** gdb-4.16/gdb/ada-exp.tab.c
--- gdb-4.16.orig/gdb/ada-exp.tab.c Sun Mar 23 18:26:32 1997
***************
*** 0 ****
--- 1,1894 ----
+
+ /* A Bison parser, made from ./ada-exp.y with Bison version GNU Bison version 1.24
+ */
+
+ #define YYBISON 1 /* Identify Bison output. */
+
+ #define INT 258
+ #define NULL_PTR 259
+ #define FLOAT 260
+ #define STRING 261
+ #define NAME 262
+ #define BLOCKNAME 263
+ #define TYPENAME 264
+ #define DOT_LITERAL_NAME 265
+ #define COLONCOLON 266
+ #define ERROR 267
+ #define ALL 268
+ #define LAST 269
+ #define REGNAME 270
+ #define INTERNAL_VARIABLE 271
+ #define ASSIGN 272
+ #define _AND_ 273
+ #define OR 274
+ #define XOR 275
+ #define THEN 276
+ #define ELSE 277
+ #define NOTEQUAL 278
+ #define LEQ 279
+ #define GEQ 280
+ #define IN 281
+ #define DOTDOT 282
+ #define UNARY 283
+ #define MOD 284
+ #define REM 285
+ #define STARSTAR 286
+ #define ABS 287
+ #define NOT 288
+ #define TICK_ACCESS 289
+ #define TICK_FIRST 290
+ #define TICK_LAST 291
+ #define TICK_RANGE 292
+ #define ARROW 293
+ #define NEW 294
+
+ #line 38 "./ada-exp.y"
+
+
+ #include "defs.h"
+ #include <string.h>
+ #include <ctype.h>
+ #include "expression.h"
+ #include "value.h"
+ #include "parser-defs.h"
+ #include "language.h"
+ #include "ada-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. */
+
+ /* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
+ options. I presume we are maintaining it to accommodate systems
+ without BISON? (PNH) */
+
+ #define yymaxdepth ada_maxdepth
+ #define yyparse _ada_parse /* ada_parse calls this after initialization */
+ #define yylex ada_lex
+ #define yyerror ada_error
+ #define yylval ada_lval
+ #define yychar ada_char
+ #define yydebug ada_debug
+ #define yypact ada_pact
+ #define yyr1 ada_r1
+ #define yyr2 ada_r2
+ #define yydef ada_def
+ #define yychk ada_chk
+ #define yypgo ada_pgo
+ #define yyact ada_act
+ #define yyexca ada_exca
+ #define yyerrflag ada_errflag
+ #define yynerrs ada_nerrs
+ #define yyps ada_ps
+ #define yypv ada_pv
+ #define yys ada_s
+ #define yy_yys ada_yys
+ #define yystate ada_state
+ #define yytmp ada_tmp
+ #define yyv ada_v
+ #define yy_yyv ada_yyv
+ #define yyval ada_val
+ #define yylloc ada_lloc
+ #define yyreds ada_reds /* With YYDEBUG defined */
+ #define yytoks ada_toks /* With YYDEBUG defined */
+
+ #ifndef YYDEBUG
+ #define YYDEBUG 0 /* Default to no yydebug support */
+ #endif
+
+ int
+ yyparse PARAMS ((void));
+
+ static int
+ yylex PARAMS ((void));
+
+ void
+ yyerror PARAMS ((char *));
+
+ static struct stoken
+ downcase_token PARAMS ((struct stoken));
+
+ static char*
+ save_downcase_string PARAMS ((const char*, int));
+
+ static struct stoken
+ string_to_operator PARAMS ((struct stoken));
+
+ #line 121 "./ada-exp.y"
+
+
+ /* A struct ada_name is a pair of strings, one a concatenation of identifiers
+ separated by '.'s with the capitalization originally specified by
+ the user, and the other the same string mapped to lower case,
+ except for those identifiers specified as `literal', as in x.'abC'. */
+
+ struct ada_name {
+ struct stoken original;
+ struct stoken lookup_form;
+ };
+
+ static struct ada_name NULL_NAME = { {"", 0}, {"", 0} };
+
+ static struct ada_name
+ name_cons PARAMS ((struct ada_name, struct stoken, int));
+
+ static void
+ write_var PARAMS ((struct block*, struct ada_name));
+
+ static void
+ write_var_from_name PARAMS ((struct block*, struct stoken, struct stoken));
+
+
+ #line 146 "./ada-exp.y"
+ typedef union
+ {
+ LONGEST lval;
+ 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 ada_name name;
+ } YYSTYPE;
+
+ #ifndef YYLTYPE
+ typedef
+ struct yyltype
+ {
+ int timestamp;
+ int first_line;
+ int first_column;
+ int last_line;
+ int last_column;
+ char *text;
+ }
+ yyltype;
+
+ #define YYLTYPE yyltype
+ #endif
+
+ #include <stdio.h>
+
+ #ifndef __cplusplus
+ #ifndef __STDC__
+ #define const
+ #endif
+ #endif
+
+
+
+ #define YYFINAL 161
+ #define YYFLAG -32768
+ #define YYNTBASE 58
+
+ #define YYTRANSLATE(x) ((unsigned)(x) <= 294 ? yytranslate[x] : 71)
+
+ static const char yytranslate[] = { 0,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 34, 2, 48,
+ 53, 36, 32, 54, 33, 47, 37, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 52, 25,
+ 23, 26, 2, 31, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 49, 2, 57, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 55, 2, 56, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
+ 2, 2, 2, 2, 2, 1, 2, 3, 4, 5,
+ 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 24, 27, 28,
+ 29, 30, 35, 38, 39, 40, 41, 42, 43, 44,
+ 45, 46, 50, 51
+ };
+
+ #if YYDEBUG != 0
+ static const short yyprhs[] = { 0,
+ 0, 2, 4, 6, 8, 12, 16, 20, 23, 26,
+ 29, 32, 36, 39, 44, 45, 51, 52, 54, 58,
+ 62, 68, 73, 77, 81, 85, 89, 93, 97, 101,
+ 105, 109, 113, 117, 121, 125, 131, 137, 141, 148,
+ 155, 160, 164, 168, 172, 176, 181, 185, 190, 194,
+ 197, 201, 205, 206, 210, 212, 214, 216, 218, 220,
+ 222, 224, 227, 229, 233, 236, 241, 246, 249, 253,
+ 255, 259, 262, 266, 270, 273, 277, 279, 282, 284,
+ 286, 288, 290, 292, 294, 297, 300
+ };
+
+ static const short yyrhs[] = { 60,
+ 0, 59, 0, 67, 0, 61, 0, 60, 52, 61,
+ 0, 61, 17, 61, 0, 61, 47, 13, 0, 33,
+ 61, 0, 32, 61, 0, 42, 61, 0, 41, 61,
+ 0, 61, 47, 69, 0, 61, 10, 0, 61, 48,
+ 63, 53, 0, 0, 6, 48, 62, 63, 53, 0,
+ 0, 61, 0, 69, 50, 61, 0, 63, 54, 61,
+ 0, 63, 54, 69, 50, 61, 0, 55, 67, 56,
+ 61, 0, 48, 60, 53, 0, 61, 40, 61, 0,
+ 61, 36, 61, 0, 61, 37, 61, 0, 61, 39,
+ 61, 0, 61, 38, 61, 0, 61, 31, 61, 0,
+ 61, 32, 61, 0, 61, 34, 61, 0, 61, 33,
+ 61, 0, 61, 23, 61, 0, 61, 24, 61, 0,
+ 61, 27, 61, 0, 61, 29, 61, 30, 61, 0,
+ 61, 29, 61, 46, 64, 0, 61, 29, 67, 0,
+ 61, 42, 29, 61, 30, 61, 0, 61, 42, 29,
+ 61, 46, 64, 0, 61, 42, 29, 67, 0, 61,
+ 28, 61, 0, 61, 25, 61, 0, 61, 26, 61,
+ 0, 61, 18, 61, 0, 61, 18, 21, 61, 0,
+ 61, 19, 61, 0, 61, 19, 22, 61, 0, 61,
+ 20, 61, 0, 61, 43, 0, 61, 44, 64, 0,
+ 61, 45, 64, 0, 0, 48, 3, 53, 0, 3,
+ 0, 5, 0, 4, 0, 14, 0, 15, 0, 16,
+ 0, 6, 0, 51, 67, 0, 66, 0, 66, 47,
+ 13, 0, 65, 66, 0, 65, 66, 47, 13, 0,
+ 67, 48, 61, 53, 0, 8, 11, 0, 65, 69,
+ 11, 0, 70, 0, 66, 47, 69, 0, 66, 10,
+ 0, 66, 47, 6, 0, 9, 47, 69, 0, 9,
+ 10, 0, 9, 47, 6, 0, 68, 0, 67, 43,
+ 0, 9, 0, 7, 0, 8, 0, 9, 0, 7,
+ 0, 8, 0, 36, 61, 0, 34, 61, 0, 61,
+ 49, 61, 57, 0
+ };
+
+ #endif
+
+ #if YYDEBUG != 0
+ static const short yyrline[] = { 0,
+ 221, 222, 225, 232, 233, 238, 242, 246, 250, 254,
+ 258, 262, 266, 272, 277, 282, 290, 293, 295, 297,
+ 299, 303, 310, 316, 320, 324, 328, 332, 336, 340,
+ 344, 348, 352, 356, 360, 364, 366, 370, 374, 377,
+ 382, 389, 393, 397, 401, 405, 409, 413, 417, 421,
+ 425, 430, 437, 439, 443, 450, 457, 463, 469, 475,
+ 481, 507, 512, 516, 523, 527, 533, 539, 558, 576,
+ 580, 582, 584, 586, 589, 592, 598, 599, 603, 606,
+ 607, 608, 611, 613, 619, 621, 623
+ };
+
+ static const char * const yytname[] = { "$","error","$undefined.","INT","NULL_PTR",
+ "FLOAT","STRING","NAME","BLOCKNAME","TYPENAME","DOT_LITERAL_NAME","COLONCOLON",
+ "ERROR","ALL","LAST","REGNAME","INTERNAL_VARIABLE","ASSIGN","_AND_","OR","XOR",
+ "THEN","ELSE","'='","NOTEQUAL","'<'","'>'","LEQ","GEQ","IN","DOTDOT","'@'","'+'",
+ "'-'","'&'","UNARY","'*'","'/'","MOD","REM","STARSTAR","ABS","NOT","TICK_ACCESS",
+ "TICK_FIRST","TICK_LAST","TICK_RANGE","'.'","'('","'['","ARROW","NEW","';'",
+ "')'","','","'{'","'}'","']'","start","type_exp","exp1","exp","@1","arglist",
+ "tick_arglist","block","variable","type","typename","name","name_not_typename",
+ ""
+ };
+ #endif
+
+ static const short yyr1[] = { 0,
+ 58, 58, 59, 60, 60, 61, 61, 61, 61, 61,
+ 61, 61, 61, 61, 62, 61, 63, 63, 63, 63,
+ 63, 61, 61, 61, 61, 61, 61, 61, 61, 61,
+ 61, 61, 61, 61, 61, 61, 61, 61, 61, 61,
+ 61, 61, 61, 61, 61, 61, 61, 61, 61, 61,
+ 61, 61, 64, 64, 61, 61, 61, 61, 61, 61,
+ 61, 61, 61, 61, 61, 61, 61, 65, 65, 66,
+ 66, 66, 66, 66, 66, 66, 67, 67, 68, 69,
+ 69, 69, 70, 70, 61, 61, 61
+ };
+
+ static const short yyr2[] = { 0,
+ 1, 1, 1, 1, 3, 3, 3, 2, 2, 2,
+ 2, 3, 2, 4, 0, 5, 0, 1, 3, 3,
+ 5, 4, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 5, 5, 3, 6, 6,
+ 4, 3, 3, 3, 3, 4, 3, 4, 3, 2,
+ 3, 3, 0, 3, 1, 1, 1, 1, 1, 1,
+ 1, 2, 1, 3, 2, 4, 4, 2, 3, 1,
+ 3, 2, 3, 3, 2, 3, 1, 2, 1, 1,
+ 1, 1, 1, 1, 2, 2, 4
+ };
+
+ static const short yydefact[] = { 0,
+ 55, 57, 56, 61, 83, 84, 79, 58, 59, 60,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 2,
+ 1, 4, 0, 63, 3, 77, 70, 15, 68, 75,
+ 0, 9, 0, 8, 86, 85, 11, 10, 0, 79,
+ 62, 0, 0, 13, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 50, 53, 53, 0, 17,
+ 0, 83, 84, 82, 65, 0, 72, 0, 78, 0,
+ 17, 76, 80, 81, 82, 74, 23, 0, 5, 6,
+ 0, 45, 0, 47, 49, 33, 34, 43, 44, 35,
+ 42, 0, 38, 29, 30, 32, 31, 25, 26, 28,
+ 27, 24, 0, 0, 51, 52, 7, 12, 84, 79,
+ 18, 0, 0, 0, 0, 69, 73, 64, 71, 0,
+ 0, 22, 46, 48, 0, 53, 0, 41, 0, 14,
+ 0, 0, 87, 66, 67, 16, 36, 37, 0, 53,
+ 54, 20, 0, 19, 39, 40, 0, 21, 0, 0,
+ 0
+ };
+
+ static const short yydefgoto[] = { 159,
+ 20, 21, 22, 81, 122, 115, 23, 24, 33, 26,
+ 123, 27
+ };
+
+ static const short yypact[] = { 206,
+ -32768,-32768,-32768, -25,-32768, 60, 9,-32768,-32768,-32768,
+ 206, 206, 206, 206, 206, 206, 206, 19, 19,-32768,
+ -21, 454, 120, 10, -22,-32768,-32768,-32768,-32768,-32768,
+ 157, 134, -22, 134, 17, 17, 134, 134, -38,-32768,
+ 30, -34, 206,-32768, 206, 100, 153, 206, 206, 206,
+ 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
+ 206, 206, 206, 206, 45,-32768, 28, 28, 104, 259,
+ 206, 18, 70, 9, 20, 80,-32768, 4,-32768, 206,
+ 259,-32768,-32768,-32768,-32768,-32768,-32768, 206, 454, 490,
+ 206, 521, 206, 521, 521, 541, 541, 541, 541, 541,
+ 541, 374, -22, 561, 134, 134, 134, 52, 52, 52,
+ 52, 52, 206, 90,-32768,-32768,-32768,-32768, 22, 8,
+ 454, 25, 48, 298, 77,-32768,-32768,-32768,-32768, 334,
+ 34, 17, 521, 521, 206, 28, 414, -22, 65,-32768,
+ 259, 206,-32768,-32768,-32768,-32768, 541,-32768, 206, 28,
+ -32768, 454, 72, 454, 541,-32768, 206, 454, 123, 125,
+ -32768
+ };
+
+ static const short yypgoto[] = {-32768,
+ -32768, 103, -11,-32768, 54, -61,-32768, 114, 6,-32768,
+ -15,-32768
+ };
+
+
+ #define YYLAST 610
+
+
+ static const short yytable[] = { 32,
+ 34, 35, 36, 37, 38, 25, 116, 76, 79, 127,
+ 83, 84, 85, 43, 87, 86, 128, 30, 30, 77,
+ 79, 88, 28, 41, 42, 80, 44, 40, -80, 77,
+ 43, 89, 29, 90, 92, 94, 95, 96, 97, 98,
+ 99, 100, 101, 102, 104, 105, 106, 107, 108, 109,
+ 110, 111, 112, 118, 31, 31, 78, -82, 121, 124,
+ 103, 44, 129, 69, 70, 71, 125, -80, 130, 121,
+ 29, -81, 79, 113, 148, 114, 132, 140, 141, 133,
+ -81, 134, 127, 83, 84, 85, 146, 141, 156, 144,
+ 126, 64, 139, 65, 66, 67, 68, 142, 69, 70,
+ 71, 137, 1, 2, 3, 4, 5, 6, 7, 129,
+ 83, 84, 85, 8, 9, 10, 117, 151, 138, 39,
+ 91, 157, 160, 147, 161, 153, 72, 73, 74, 152,
+ 154, 11, 12, 13, 131, 14, 75, 155, 0, 0,
+ 15, 16, 0, 44, 0, 158, 0, 17, 0, 0,
+ 18, 0, 0, 0, 19, 1, 2, 3, 4, 5,
+ 6, 7, 82, 83, 84, 85, 8, 9, 10, 60,
+ 61, 62, 63, 64, 93, 65, 66, 67, 68, 0,
+ 69, 70, 71, 0, 11, 12, 13, 0, 14, 0,
+ 0, 0, 0, 15, 16, 0, 0, 0, 0, 0,
+ 17, 0, 0, 18, 0, 0, 0, 19, 1, 2,
+ 3, 4, 5, 6, 7, 0, 0, 0, 0, 8,
+ 9, 10, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 11, 12, 13,
+ 0, 14, 0, 0, 0, 0, 15, 16, 0, 0,
+ 0, 0, 0, 17, 0, 0, 18, 0, 0, 0,
+ 19, 1, 2, 3, 4, 72, 119, 120, 0, 0,
+ 0, 0, 8, 9, 10, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 11, 12, 13, 0, 14, 0, 0, 0, 0, 15,
+ 16, 0, 0, 0, 0, 0, 17, 44, 0, 18,
+ 0, 0, 0, 19, 45, 46, 47, 48, 0, 0,
+ 49, 50, 51, 52, 53, 54, 55, 0, 56, 57,
+ 58, 59, 0, 60, 61, 62, 63, 64, 0, 65,
+ 66, 67, 68, 44, 69, 70, 71, 0, 0, 0,
+ 45, 46, 47, 48, 143, 0, 49, 50, 51, 52,
+ 53, 54, 55, 0, 56, 57, 58, 59, 0, 60,
+ 61, 62, 63, 64, 0, 65, 66, 67, 68, 0,
+ 69, 70, 71, 44, 0, 0, 145, 0, 0, 0,
+ 45, 46, 47, 48, 0, 0, 49, 50, 51, 52,
+ 53, 54, 55, 135, 56, 57, 58, 59, 0, 60,
+ 61, 62, 63, 64, 0, 65, 66, 67, 68, 136,
+ 69, 70, 71, 44, 0, 0, 0, 0, 0, 0,
+ 45, 46, 47, 48, 0, 0, 49, 50, 51, 52,
+ 53, 54, 55, 149, 56, 57, 58, 59, 0, 60,
+ 61, 62, 63, 64, 0, 65, 66, 67, 68, 150,
+ 69, 70, 71, 44, 0, 0, 0, 0, 0, 0,
+ 45, 46, 47, 48, 0, 0, 49, 50, 51, 52,
+ 53, 54, 55, 0, 56, 57, 58, 59, 0, 60,
+ 61, 62, 63, 64, 0, 65, 66, 67, 68, 44,
+ 69, 70, 71, 0, 0, 0,-32768, 46, 47, 48,
+ 0, 0, 49, 50, 51, 52, 53, 54, 55, 0,
+ 56, 57, 58, 59, 0, 60, 61, 62, 63, 64,
+ 44, 65, 66, 67, 68, 0, 69, 70, 71, 0,
+ 0, 0, 0, 49, 50, 51, 52, 53, 54, 55,
+ 44, 56, 57, 58, 59, 0, 60, 61, 62, 63,
+ 64, 0, 65, 66, 67, 68, 0, 69, 70, 71,
+ 44, 56, 57, 58, 59, 0, 60, 61, 62, 63,
+ 64, 0, 65, 66, 67, 68, 0, 69, 70, 71,
+ 0, 0, 57, 58, 59, 0, 60, 61, 62, 63,
+ 64, 0, 65, 66, 67, 68, 0, 69, 70, 71
+ };
+
+ static const short yycheck[] = { 11,
+ 12, 13, 14, 15, 16, 0, 68, 23, 43, 6,
+ 7, 8, 9, 52, 53, 31, 13, 10, 10, 10,
+ 43, 56, 48, 18, 19, 48, 10, 9, 11, 10,
+ 52, 43, 11, 45, 46, 47, 48, 49, 50, 51,
+ 52, 53, 54, 55, 56, 57, 58, 59, 60, 61,
+ 62, 63, 64, 69, 47, 47, 47, 50, 70, 71,
+ 55, 10, 78, 47, 48, 49, 47, 50, 80, 81,
+ 11, 50, 43, 29, 136, 48, 88, 53, 54, 91,
+ 11, 93, 6, 7, 8, 9, 53, 54, 150, 13,
+ 11, 40, 3, 42, 43, 44, 45, 50, 47, 48,
+ 49, 113, 3, 4, 5, 6, 7, 8, 9, 125,
+ 7, 8, 9, 14, 15, 16, 13, 53, 113, 17,
+ 21, 50, 0, 135, 0, 141, 7, 8, 9, 141,
+ 142, 32, 33, 34, 81, 36, 23, 149, -1, -1,
+ 41, 42, -1, 10, -1, 157, -1, 48, -1, -1,
+ 51, -1, -1, -1, 55, 3, 4, 5, 6, 7,
+ 8, 9, 6, 7, 8, 9, 14, 15, 16, 36,
+ 37, 38, 39, 40, 22, 42, 43, 44, 45, -1,
+ 47, 48, 49, -1, 32, 33, 34, -1, 36, -1,
+ -1, -1, -1, 41, 42, -1, -1, -1, -1, -1,
+ 48, -1, -1, 51, -1, -1, -1, 55, 3, 4,
+ 5, 6, 7, 8, 9, -1, -1, -1, -1, 14,
+ 15, 16, -1, -1, -1, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, 32, 33, 34,
+ -1, 36, -1, -1, -1, -1, 41, 42, -1, -1,
+ -1, -1, -1, 48, -1, -1, 51, -1, -1, -1,
+ 55, 3, 4, 5, 6, 7, 8, 9, -1, -1,
+ -1, -1, 14, 15, 16, -1, -1, -1, -1, -1,
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
+ 32, 33, 34, -1, 36, -1, -1, -1, -1, 41,
+ 42, -1, -1, -1, -1, -1, 48, 10, -1, 51,
+ -1, -1, -1, 55, 17, 18, 19, 20, -1, -1,
+ 23, 24, 25, 26, 27, 28, 29, -1, 31, 32,
+ 33, 34, -1, 36, 37, 38, 39, 40, -1, 42,
+ 43, 44, 45, 10, 47, 48, 49, -1, -1, -1,
+ 17, 18, 19, 20, 57, -1, 23, 24, 25, 26,
+ 27, 28, 29, -1, 31, 32, 33, 34, -1, 36,
+ 37, 38, 39, 40, -1, 42, 43, 44, 45, -1,
+ 47, 48, 49, 10, -1, -1, 53, -1, -1, -1,
+ 17, 18, 19, 20, -1, -1, 23, 24, 25, 26,
+ 27, 28, 29, 30, 31, 32, 33, 34, -1, 36,
+ 37, 38, 39, 40, -1, 42, 43, 44, 45, 46,
+ 47, 48, 49, 10, -1, -1, -1, -1, -1, -1,
+ 17, 18, 19, 20, -1, -1, 23, 24, 25, 26,
+ 27, 28, 29, 30, 31, 32, 33, 34, -1, 36,
+ 37, 38, 39, 40, -1, 42, 43, 44, 45, 46,
+ 47, 48, 49, 10, -1, -1, -1, -1, -1, -1,
+ 17, 18, 19, 20, -1, -1, 23, 24, 25, 26,
+ 27, 28, 29, -1, 31, 32, 33, 34, -1, 36,
+ 37, 38, 39, 40, -1, 42, 43, 44, 45, 10,
+ 47, 48, 49, -1, -1, -1, 17, 18, 19, 20,
+ -1, -1, 23, 24, 25, 26, 27, 28, 29, -1,
+ 31, 32, 33, 34, -1, 36, 37, 38, 39, 40,
+ 10, 42, 43, 44, 45, -1, 47, 48, 49, -1,
+ -1, -1, -1, 23, 24, 25, 26, 27, 28, 29,
+ 10, 31, 32, 33, 34, -1, 36, 37, 38, 39,
+ 40, -1, 42, 43, 44, 45, -1, 47, 48, 49,
+ 10, 31, 32, 33, 34, -1, 36, 37, 38, 39,
+ 40, -1, 42, 43, 44, 45, -1, 47, 48, 49,
+ -1, -1, 32, 33, 34, -1, 36, 37, 38, 39,
+ 40, -1, 42, 43, 44, 45, -1, 47, 48, 49
+ };
+ /* -*-C-*- Note some compilers choke on comments on `#line' lines. */
+ #line 3 "/usr/local/share/bison.simple"
+
+ /* Skeleton output parser for bison,
+ Copyright (C) 1984, 1989, 1990 Free Software Foundation, Inc.
+
+ 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, 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ /* As a special exception, when this file is copied by Bison into a
+ Bison output file, you may use that output file without restriction.
+ This special exception was added by the Free Software Foundation
+ in version 1.24 of Bison. */
+
+ #ifndef alloca
+ #ifdef __GNUC__
+ #define alloca __builtin_alloca
+ #else /* not GNU C. */
+ #if (!defined (__STDC__) && defined (sparc)) || defined (__sparc__) || defined (__sparc) || defined (__sgi)
+ #include <alloca.h>
+ #else /* not sparc */
+ #if defined (MSDOS) && !defined (__TURBOC__)
+ #else /* not MSDOS, or __TURBOC__ */
+ #if defined(_AIX)
+ #pragma alloca
+ #else /* not MSDOS, __TURBOC__, or _AIX */
+ #ifdef __hpux
+ #ifdef __cplusplus
+ extern "C" {
+ void *alloca (unsigned int);
+ };
+ #else /* not __cplusplus */
+ void *alloca ();
+ #endif /* not __cplusplus */
+ #endif /* __hpux */
+ #endif /* not _AIX */
+ #endif /* not MSDOS, or __TURBOC__ */
+ #endif /* not sparc. */
+ #endif /* not GNU C. */
+ #endif /* alloca not defined. */
+
+ /* This is the parser code that is written into each bison parser
+ when the %semantic_parser declaration is not specified in the grammar.
+ It was written by Richard Stallman by simplifying the hairy parser
+ used when %semantic_parser is specified. */
+
+ /* Note: there must be only one dollar sign in this file.
+ It is replaced by the list of actions, each action
+ as one case of the switch. */
+
+ #define yyerrok (yyerrstatus = 0)
+ #define yyclearin (yychar = YYEMPTY)
+ #define YYEMPTY -2
+ #define YYEOF 0
+ #define YYACCEPT return(0)
+ #define YYABORT return(1)
+ #define YYERROR goto yyerrlab1
+ /* Like YYERROR except do call yyerror.
+ This remains here temporarily to ease the
+ transition to the new meaning of YYERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+ #define YYFAIL goto yyerrlab
+ #define YYRECOVERING() (!!yyerrstatus)
+ #define YYBACKUP(token, value) \
+ do \
+ if (yychar == YYEMPTY && yylen == 1) \
+ { yychar = (token), yylval = (value); \
+ yychar1 = YYTRANSLATE (yychar); \
+ YYPOPSTACK; \
+ goto yybackup; \
+ } \
+ else \
+ { yyerror ("syntax error: cannot back up"); YYERROR; } \
+ while (0)
+
+ #define YYTERROR 1
+ #define YYERRCODE 256
+
+ #ifndef YYPURE
+ #define YYLEX yylex()
+ #endif
+
+ #ifdef YYPURE
+ #ifdef YYLSP_NEEDED
+ #ifdef YYLEX_PARAM
+ #define YYLEX yylex(&yylval, &yylloc, YYLEX_PARAM)
+ #else
+ #define YYLEX yylex(&yylval, &yylloc)
+ #endif
+ #else /* not YYLSP_NEEDED */
+ #ifdef YYLEX_PARAM
+ #define YYLEX yylex(&yylval, YYLEX_PARAM)
+ #else
+ #define YYLEX yylex(&yylval)
+ #endif
+ #endif /* not YYLSP_NEEDED */
+ #endif
+
+ /* If nonreentrant, generate the variables here */
+
+ #ifndef YYPURE
+
+ int yychar; /* the lookahead symbol */
+ YYSTYPE yylval; /* the semantic value of the */
+ /* lookahead symbol */
+
+ #ifdef YYLSP_NEEDED
+ YYLTYPE yylloc; /* location data for the lookahead */
+ /* symbol */
+ #endif
+
+ int yynerrs; /* number of parse errors so far */
+ #endif /* not YYPURE */
+
+ #if YYDEBUG != 0
+ int yydebug; /* nonzero means print parse trace */
+ /* Since this is uninitialized, it does not stop multiple parsers
+ from coexisting. */
+ #endif
+
+ /* YYINITDEPTH indicates the initial size of the parser's stacks */
+
+ #ifndef YYINITDEPTH
+ #define YYINITDEPTH 200
+ #endif
+
+ /* YYMAXDEPTH is the maximum size the stacks can grow to
+ (effective only if the built-in stack extension method is used). */
+
+ #if YYMAXDEPTH == 0
+ #undef YYMAXDEPTH
+ #endif
+
+ #ifndef YYMAXDEPTH
+ #define YYMAXDEPTH 10000
+ #endif
+
+ /* Prevent warning if -Wstrict-prototypes. */
+ #ifdef __GNUC__
+ int yyparse (void);
+ #endif
+
+ #if __GNUC__ > 1 /* GNU C and GNU C++ define this. */
+ #define __yy_memcpy(FROM,TO,COUNT) __builtin_memcpy(TO,FROM,COUNT)
+ #else /* not GNU C or C++ */
+ #ifndef __cplusplus
+
+ /* This is the most reliable way to avoid incompatibilities
+ in available built-in functions on various systems. */
+ static void
+ __yy_memcpy (from, to, count)
+ char *from;
+ char *to;
+ int count;
+ {
+ register char *f = from;
+ register char *t = to;
+ register int i = count;
+
+ while (i-- > 0)
+ *t++ = *f++;
+ }
+
+ #else /* __cplusplus */
+
+ /* This is the most reliable way to avoid incompatibilities
+ in available built-in functions on various systems. */
+ static void
+ __yy_memcpy (char *from, char *to, int count)
+ {
+ register char *f = from;
+ register char *t = to;
+ register int i = count;
+
+ while (i-- > 0)
+ *t++ = *f++;
+ }
+
+ #endif
+ #endif
+
+ #line 192 "/usr/local/share/bison.simple"
+
+ /* The user can define YYPARSE_PARAM as the name of an argument to be passed
+ into yyparse. The argument should have type void *.
+ It should actually point to an object.
+ Grammar actions can access the variable by casting it
+ to the proper pointer type. */
+
+ #ifdef YYPARSE_PARAM
+ #define YYPARSE_PARAM_DECL void *YYPARSE_PARAM;
+ #else
+ #define YYPARSE_PARAM
+ #define YYPARSE_PARAM_DECL
+ #endif
+
+ int
+ yyparse(YYPARSE_PARAM)
+ YYPARSE_PARAM_DECL
+ {
+ register int yystate;
+ register int yyn;
+ register short *yyssp;
+ register YYSTYPE *yyvsp;
+ int yyerrstatus; /* number of tokens to shift before error messages enabled */
+ int yychar1 = 0; /* lookahead token as an internal (translated) token number */
+
+ short yyssa[YYINITDEPTH]; /* the state stack */
+ YYSTYPE yyvsa[YYINITDEPTH]; /* the semantic value stack */
+
+ short *yyss = yyssa; /* refer to the stacks thru separate pointers */
+ YYSTYPE *yyvs = yyvsa; /* to allow yyoverflow to xreallocate them elsewhere */
+
+ #ifdef YYLSP_NEEDED
+ YYLTYPE yylsa[YYINITDEPTH]; /* the location stack */
+ YYLTYPE *yyls = yylsa;
+ YYLTYPE *yylsp;
+
+ #define YYPOPSTACK (yyvsp--, yyssp--, yylsp--)
+ #else
+ #define YYPOPSTACK (yyvsp--, yyssp--)
+ #endif
+
+ int yystacksize = YYINITDEPTH;
+
+ #ifdef YYPURE
+ int yychar;
+ YYSTYPE yylval;
+ int yynerrs;
+ #ifdef YYLSP_NEEDED
+ YYLTYPE yylloc;
+ #endif
+ #endif
+
+ YYSTYPE yyval; /* the variable used to return */
+ /* semantic values from the action */
+ /* routines */
+
+ int yylen;
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Starting parse\n");
+ #endif
+
+ yystate = 0;
+ yyerrstatus = 0;
+ yynerrs = 0;
+ yychar = YYEMPTY; /* Cause a token to be read. */
+
+ /* Initialize stack pointers.
+ Waste one element of value and location stack
+ so that they stay on the same level as the state stack.
+ The wasted elements are never initialized. */
+
+ yyssp = yyss - 1;
+ yyvsp = yyvs;
+ #ifdef YYLSP_NEEDED
+ yylsp = yyls;
+ #endif
+
+ /* Push a new state, which is found in yystate . */
+ /* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks. */
+ yynewstate:
+
+ *++yyssp = yystate;
+
+ if (yyssp >= yyss + yystacksize - 1)
+ {
+ /* Give user a chance to xreallocate the stack */
+ /* Use copies of these so that the &'s don't force the real ones into memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ short *yyss1 = yyss;
+ #ifdef YYLSP_NEEDED
+ YYLTYPE *yyls1 = yyls;
+ #endif
+
+ /* Get the current used size of the three stacks, in elements. */
+ int size = yyssp - yyss + 1;
+
+ #ifdef yyoverflow
+ /* Each stack pointer address is followed by the size of
+ the data in use in that stack, in bytes. */
+ #ifdef YYLSP_NEEDED
+ /* This used to be a conditional around just the two extra args,
+ but that might be undefined if yyoverflow is a macro. */
+ yyoverflow("parser stack overflow",
+ &yyss1, size * sizeof (*yyssp),
+ &yyvs1, size * sizeof (*yyvsp),
+ &yyls1, size * sizeof (*yylsp),
+ &yystacksize);
+ #else
+ yyoverflow("parser stack overflow",
+ &yyss1, size * sizeof (*yyssp),
+ &yyvs1, size * sizeof (*yyvsp),
+ &yystacksize);
+ #endif
+
+ yyss = yyss1; yyvs = yyvs1;
+ #ifdef YYLSP_NEEDED
+ yyls = yyls1;
+ #endif
+ #else /* no yyoverflow */
+ /* Extend the stack our own way. */
+ if (yystacksize >= YYMAXDEPTH)
+ {
+ yyerror("parser stack overflow");
+ return 2;
+ }
+ yystacksize *= 2;
+ if (yystacksize > YYMAXDEPTH)
+ yystacksize = YYMAXDEPTH;
+ yyss = (short *) alloca (yystacksize * sizeof (*yyssp));
+ __yy_memcpy ((char *)yyss1, (char *)yyss, size * sizeof (*yyssp));
+ yyvs = (YYSTYPE *) alloca (yystacksize * sizeof (*yyvsp));
+ __yy_memcpy ((char *)yyvs1, (char *)yyvs, size * sizeof (*yyvsp));
+ #ifdef YYLSP_NEEDED
+ yyls = (YYLTYPE *) alloca (yystacksize * sizeof (*yylsp));
+ __yy_memcpy ((char *)yyls1, (char *)yyls, size * sizeof (*yylsp));
+ #endif
+ #endif /* no yyoverflow */
+
+ yyssp = yyss + size - 1;
+ yyvsp = yyvs + size - 1;
+ #ifdef YYLSP_NEEDED
+ yylsp = yyls + size - 1;
+ #endif
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Stack size increased to %d\n", yystacksize);
+ #endif
+
+ if (yyssp >= yyss + yystacksize - 1)
+ YYABORT;
+ }
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Entering state %d\n", yystate);
+ #endif
+
+ goto yybackup;
+ yybackup:
+
+ /* Do appropriate processing given the current state. */
+ /* Read a lookahead token if we need one and don't already have one. */
+ /* yyresume: */
+
+ /* First try to decide what to do without reference to lookahead token. */
+
+ yyn = yypact[yystate];
+ if (yyn == YYFLAG)
+ goto yydefault;
+
+ /* Not known => get a lookahead token if don't already have one. */
+
+ /* yychar is either YYEMPTY or YYEOF
+ or a valid token in external form. */
+
+ if (yychar == YYEMPTY)
+ {
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Reading a token: ");
+ #endif
+ yychar = YYLEX;
+ }
+
+ /* Convert token to internal form (in yychar1) for indexing tables with */
+
+ if (yychar <= 0) /* This means end of input. */
+ {
+ yychar1 = 0;
+ yychar = YYEOF; /* Don't call YYLEX any more */
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Now at end of input.\n");
+ #endif
+ }
+ else
+ {
+ yychar1 = YYTRANSLATE(yychar);
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ {
+ fprintf (stderr, "Next token is %d (%s", yychar, yytname[yychar1]);
+ /* Give the individual parser a way to print the precise meaning
+ of a token, for further debugging info. */
+ #ifdef YYPRINT
+ YYPRINT (stderr, yychar, yylval);
+ #endif
+ fprintf (stderr, ")\n");
+ }
+ #endif
+ }
+
+ yyn += yychar1;
+ if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != yychar1)
+ goto yydefault;
+
+ yyn = yytable[yyn];
+
+ /* yyn is what to do for this token type in this state.
+ Negative => reduce, -yyn is rule number.
+ Positive => shift, yyn is new state.
+ New state is final state => don't bother to shift,
+ just return success.
+ 0, or most negative number => error. */
+
+ if (yyn < 0)
+ {
+ if (yyn == YYFLAG)
+ goto yyerrlab;
+ yyn = -yyn;
+ goto yyreduce;
+ }
+ else if (yyn == 0)
+ goto yyerrlab;
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ /* Shift the lookahead token. */
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Shifting token %d (%s), ", yychar, yytname[yychar1]);
+ #endif
+
+ /* Discard the token being shifted unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
+
+ *++yyvsp = yylval;
+ #ifdef YYLSP_NEEDED
+ *++yylsp = yylloc;
+ #endif
+
+ /* count tokens shifted since error; after three, turn off error status. */
+ if (yyerrstatus) yyerrstatus--;
+
+ yystate = yyn;
+ goto yynewstate;
+
+ /* Do the default action for the current state. */
+ yydefault:
+
+ yyn = yydefact[yystate];
+ if (yyn == 0)
+ goto yyerrlab;
+
+ /* Do a reduction. yyn is the number of a rule to reduce with. */
+ yyreduce:
+ yylen = yyr2[yyn];
+ if (yylen > 0)
+ yyval = yyvsp[1-yylen]; /* implement default value of the action */
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ {
+ int i;
+
+ fprintf (stderr, "Reducing via rule %d (line %d), ",
+ yyn, yyrline[yyn]);
+
+ /* Print the symbols being reduced, and their result. */
+ for (i = yyprhs[yyn]; yyrhs[i] > 0; i++)
+ fprintf (stderr, "%s ", yytname[yyrhs[i]]);
+ fprintf (stderr, " -> %s\n", yytname[yyr1[yyn]]);
+ }
+ #endif
+
+
+ switch (yyn) {
+
+ case 3:
+ #line 226 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_TYPE);
+ write_exp_elt_type (yyvsp[0].tval);
+ write_exp_elt_opcode (OP_TYPE);;
+ break;}
+ case 5:
+ #line 234 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_COMMA); ;
+ break;}
+ case 6:
+ #line 239 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_ASSIGN); ;
+ break;}
+ case 7:
+ #line 243 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_IND); ;
+ break;}
+ case 8:
+ #line 247 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_NEG); ;
+ break;}
+ case 9:
+ #line 251 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_PLUS); ;
+ break;}
+ case 10:
+ #line 255 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_LOGICAL_NOT); ;
+ break;}
+ case 11:
+ #line 259 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_ABS); ;
+ break;}
+ case 12:
+ #line 263 "./ada-exp.y"
+ { write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (downcase_token (yyvsp[0].sval));
+ write_exp_elt_opcode (STRUCTOP_STRUCT); ;
+ break;}
+ case 13:
+ #line 267 "./ada-exp.y"
+ { write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (yyvsp[0].sval);
+ write_exp_elt_opcode (STRUCTOP_STRUCT); ;
+ break;}
+ case 14:
+ #line 273 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ write_exp_elt_longcst (yyvsp[-1].lval);
+ write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ ;
+ break;}
+ case 15:
+ #line 278 "./ada-exp.y"
+ { write_var (expression_context_block,
+ name_cons (NULL_NAME,
+ string_to_operator (yyvsp[-1].sval), 1));
+ ;
+ break;}
+ case 16:
+ #line 283 "./ada-exp.y"
+ {
+ write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ write_exp_elt_longcst (yyvsp[-1].lval);
+ write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ ;
+ break;}
+ case 17:
+ #line 290 "./ada-exp.y"
+ { yyval.lval = 0; ;
+ break;}
+ case 18:
+ #line 294 "./ada-exp.y"
+ { yyval.lval = 1; ;
+ break;}
+ case 19:
+ #line 296 "./ada-exp.y"
+ { yyval.lval = 1; ;
+ break;}
+ case 20:
+ #line 298 "./ada-exp.y"
+ { yyval.lval = yyvsp[-2].lval + 1; ;
+ break;}
+ case 21:
+ #line 300 "./ada-exp.y"
+ { yyval.lval = yyvsp[-4].lval + 1; ;
+ break;}
+ case 22:
+ #line 305 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_MEMVAL);
+ write_exp_elt_type (yyvsp[-2].tval);
+ write_exp_elt_opcode (UNOP_MEMVAL); ;
+ break;}
+ case 23:
+ #line 311 "./ada-exp.y"
+ { ;
+ break;}
+ case 24:
+ #line 317 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_EXP); ;
+ break;}
+ case 25:
+ #line 321 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_MUL); ;
+ break;}
+ case 26:
+ #line 325 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_DIV); ;
+ break;}
+ case 27:
+ #line 329 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_REM); ;
+ break;}
+ case 28:
+ #line 333 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_MOD); ;
+ break;}
+ case 29:
+ #line 337 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_REPEAT); ;
+ break;}
+ case 30:
+ #line 341 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_ADD); ;
+ break;}
+ case 31:
+ #line 345 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_CONCAT); ;
+ break;}
+ case 32:
+ #line 349 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_SUB); ;
+ break;}
+ case 33:
+ #line 353 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_EQUAL); ;
+ break;}
+ case 34:
+ #line 357 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_NOTEQUAL); ;
+ break;}
+ case 35:
+ #line 361 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_LEQ); ;
+ break;}
+ case 36:
+ #line 365 "./ada-exp.y"
+ { write_exp_elt_opcode (TERNOP_MBR); ;
+ break;}
+ case 37:
+ #line 367 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_MBR);
+ write_exp_elt_longcst ((LONGEST) yyvsp[0].lval);
+ write_exp_elt_opcode (BINOP_MBR); ;
+ break;}
+ case 38:
+ #line 371 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_MBR);
+ write_exp_elt_type (yyvsp[0].tval);
+ write_exp_elt_opcode (UNOP_MBR); ;
+ break;}
+ case 39:
+ #line 375 "./ada-exp.y"
+ { write_exp_elt_opcode (TERNOP_MBR);
+ write_exp_elt_opcode (UNOP_LOGICAL_NOT); ;
+ break;}
+ case 40:
+ #line 378 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_MBR);
+ write_exp_elt_longcst ((LONGEST) yyvsp[0].lval);
+ write_exp_elt_opcode (BINOP_MBR);
+ write_exp_elt_opcode (UNOP_LOGICAL_NOT); ;
+ break;}
+ case 41:
+ #line 383 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_MBR);
+ write_exp_elt_type (yyvsp[0].tval);
+ write_exp_elt_opcode (UNOP_MBR);
+ write_exp_elt_opcode (UNOP_LOGICAL_NOT); ;
+ break;}
+ case 42:
+ #line 390 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_GEQ); ;
+ break;}
+ case 43:
+ #line 394 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_LESS); ;
+ break;}
+ case 44:
+ #line 398 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_GTR); ;
+ break;}
+ case 45:
+ #line 402 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_BITWISE_AND); ;
+ break;}
+ case 46:
+ #line 406 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_LOGICAL_AND); ;
+ break;}
+ case 47:
+ #line 410 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_BITWISE_IOR); ;
+ break;}
+ case 48:
+ #line 414 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_LOGICAL_OR); ;
+ break;}
+ case 49:
+ #line 418 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_BITWISE_XOR); ;
+ break;}
+ case 50:
+ #line 422 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_ADDR); ;
+ break;}
+ case 51:
+ #line 426 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_LWB);
+ write_exp_elt_longcst (yyvsp[0].lval);
+ write_exp_elt_opcode (OP_LWB);
+ ;
+ break;}
+ case 52:
+ #line 431 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_UPB);
+ write_exp_elt_longcst (yyvsp[0].lval);
+ write_exp_elt_opcode (OP_UPB);
+ ;
+ break;}
+ case 53:
+ #line 438 "./ada-exp.y"
+ { yyval.lval = 1; ;
+ break;}
+ case 54:
+ #line 440 "./ada-exp.y"
+ { yyval.lval = yyvsp[-1].typed_val.val; ;
+ break;}
+ case 55:
+ #line 444 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (yyvsp[0].typed_val.type);
+ write_exp_elt_longcst ((LONGEST)(yyvsp[0].typed_val.val));
+ write_exp_elt_opcode (OP_LONG); ;
+ break;}
+ case 56:
+ #line 451 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_DOUBLE);
+ write_exp_elt_type (builtin_type_double);
+ write_exp_elt_dblcst (yyvsp[0].dval);
+ write_exp_elt_opcode (OP_DOUBLE); ;
+ break;}
+ case 57:
+ #line 458 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_int);
+ write_exp_elt_longcst ((LONGEST)(0));
+ write_exp_elt_opcode (OP_LONG); ;
+ break;}
+ case 58:
+ #line 464 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_LAST);
+ write_exp_elt_longcst ((LONGEST) yyvsp[0].lval);
+ write_exp_elt_opcode (OP_LAST); ;
+ break;}
+ case 59:
+ #line 470 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_REGISTER);
+ write_exp_elt_longcst ((LONGEST) yyvsp[0].lval);
+ write_exp_elt_opcode (OP_REGISTER); ;
+ break;}
+ case 60:
+ #line 476 "./ada-exp.y"
+ { write_exp_elt_opcode (OP_INTERNALVAR);
+ write_exp_elt_intern (yyvsp[0].ivar);
+ write_exp_elt_opcode (OP_INTERNALVAR); ;
+ break;}
+ case 61:
+ #line 482 "./ada-exp.y"
+ { /* Ada strings are converted into array constants
+ a lower bound of 1. Thus, the array upper bound
+ is the string length. */
+ char *sp = yyvsp[0].sval.ptr; int count;
+ if (yyvsp[0].sval.length == 0)
+ { /* One dummy character for the type */
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_char);
+ write_exp_elt_longcst ((LONGEST)(0));
+ write_exp_elt_opcode (OP_LONG);
+ }
+ for (count = yyvsp[0].sval.length; count > 0; count -= 1)
+ {
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_char);
+ write_exp_elt_longcst ((LONGEST)(*sp));
+ sp += 1;
+ write_exp_elt_opcode (OP_LONG);
+ }
+ write_exp_elt_opcode (OP_ARRAY);
+ write_exp_elt_longcst ((LONGEST) 1);
+ write_exp_elt_longcst ((LONGEST) (yyvsp[0].sval.length));
+ write_exp_elt_opcode (OP_ARRAY); ;
+ break;}
+ case 62:
+ #line 508 "./ada-exp.y"
+ { error ("NEW not implemented."); ;
+ break;}
+ case 63:
+ #line 513 "./ada-exp.y"
+ { write_var (expression_context_block, yyvsp[0].name); ;
+ break;}
+ case 64:
+ #line 517 "./ada-exp.y"
+ { write_var (expression_context_block, yyvsp[-2].name);
+ write_exp_elt_opcode (UNOP_IND);
+ ;
+ break;}
+ case 65:
+ #line 524 "./ada-exp.y"
+ { write_var (yyvsp[-1].bval, yyvsp[0].name); ;
+ break;}
+ case 66:
+ #line 528 "./ada-exp.y"
+ { write_var (yyvsp[-3].bval, yyvsp[-2].name);
+ write_exp_elt_opcode (UNOP_IND);
+ ;
+ break;}
+ case 67:
+ #line 534 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type (yyvsp[-3].tval);
+ write_exp_elt_opcode (UNOP_CAST); ;
+ break;}
+ case 68:
+ #line 540 "./ada-exp.y"
+ {
+ if (yyvsp[-1].ssym.sym != 0)
+ yyval.bval = SYMBOL_BLOCK_VALUE (yyvsp[-1].ssym.sym);
+ else
+ {
+ struct symtab *tem =
+ lookup_symtab (save_downcase_string
+ (yyvsp[-1].ssym.stoken.ptr,
+ yyvsp[-1].ssym.stoken.length));
+ if (tem)
+ yyval.bval = BLOCKVECTOR_BLOCK
+ (BLOCKVECTOR (tem), STATIC_BLOCK);
+ else
+ error ("No file or function \"%s\".",
+ copy_name (yyvsp[-1].ssym.stoken));
+ }
+ ;
+ break;}
+ case 69:
+ #line 559 "./ada-exp.y"
+ { struct symbol** syms;
+ struct block** blocks;
+ int nsyms;
+ nsyms = ada_lookup_symbol_list (copy_name (yyvsp[-1].sval), yyvsp[-2].bval,
+ VAR_NAMESPACE,
+ &syms,
+ &blocks);
+ if (nsyms == 0 || SYMBOL_CLASS (syms[0]) != LOC_BLOCK)
+ error ("No function \"%s\" in specified context.",
+ copy_name (yyvsp[-1].sval));
+ else if (nsyms > 1)
+ warning ("Function name \"%s\" ambiguous here",
+ copy_name (yyvsp[-1].sval));
+ yyval.bval = SYMBOL_BLOCK_VALUE (syms[0]); ;
+ break;}
+ case 70:
+ #line 577 "./ada-exp.y"
+ { yyval.name = name_cons (NULL_NAME, yyvsp[0].sval, 0); ;
+ break;}
+ case 71:
+ #line 581 "./ada-exp.y"
+ { yyval.name = name_cons (yyvsp[-2].name, yyvsp[0].sval, 0); ;
+ break;}
+ case 72:
+ #line 583 "./ada-exp.y"
+ { yyval.name = name_cons (yyvsp[-1].name, yyvsp[0].sval, 1); ;
+ break;}
+ case 73:
+ #line 585 "./ada-exp.y"
+ { yyval.name = name_cons (yyvsp[-2].name, string_to_operator (yyvsp[0].sval), 1); ;
+ break;}
+ case 74:
+ #line 587 "./ada-exp.y"
+ { yyval.name = name_cons (name_cons (NULL_NAME, yyvsp[-2].tsym.stoken, 0),
+ yyvsp[0].sval, 0); ;
+ break;}
+ case 75:
+ #line 590 "./ada-exp.y"
+ { yyval.name = name_cons (name_cons (NULL_NAME, yyvsp[-1].tsym.stoken, 0),
+ yyvsp[0].sval, 1); ;
+ break;}
+ case 76:
+ #line 593 "./ada-exp.y"
+ { yyval.name = name_cons (name_cons (NULL_NAME, yyvsp[-2].tsym.stoken, 0),
+ string_to_operator (yyvsp[0].sval),
+ 1); ;
+ break;}
+ case 77:
+ #line 598 "./ada-exp.y"
+ { yyval.tval = yyvsp[0].tsym.type; ;
+ break;}
+ case 78:
+ #line 600 "./ada-exp.y"
+ { yyval.tval = lookup_pointer_type (yyvsp[-1].tval); ;
+ break;}
+ case 80:
+ #line 606 "./ada-exp.y"
+ { yyval.sval = yyvsp[0].ssym.stoken; ;
+ break;}
+ case 81:
+ #line 607 "./ada-exp.y"
+ { yyval.sval = yyvsp[0].ssym.stoken; ;
+ break;}
+ case 82:
+ #line 608 "./ada-exp.y"
+ { yyval.sval = yyvsp[0].tsym.stoken; ;
+ break;}
+ case 83:
+ #line 612 "./ada-exp.y"
+ { yyval.sval = yyvsp[0].ssym.stoken; ;
+ break;}
+ case 84:
+ #line 613 "./ada-exp.y"
+ { yyval.sval = yyvsp[0].ssym.stoken; ;
+ break;}
+ case 85:
+ #line 620 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_IND); ;
+ break;}
+ case 86:
+ #line 622 "./ada-exp.y"
+ { write_exp_elt_opcode (UNOP_ADDR); ;
+ break;}
+ case 87:
+ #line 624 "./ada-exp.y"
+ { write_exp_elt_opcode (BINOP_SUBSCRIPT); ;
+ break;}
+ }
+ /* the action file gets copied in in place of this dollarsign */
+ #line 487 "/usr/local/share/bison.simple"
+
+ yyvsp -= yylen;
+ yyssp -= yylen;
+ #ifdef YYLSP_NEEDED
+ yylsp -= yylen;
+ #endif
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ {
+ short *ssp1 = yyss - 1;
+ fprintf (stderr, "state stack now");
+ while (ssp1 != yyssp)
+ fprintf (stderr, " %d", *++ssp1);
+ fprintf (stderr, "\n");
+ }
+ #endif
+
+ *++yyvsp = yyval;
+
+ #ifdef YYLSP_NEEDED
+ yylsp++;
+ if (yylen == 0)
+ {
+ yylsp->first_line = yylloc.first_line;
+ yylsp->first_column = yylloc.first_column;
+ yylsp->last_line = (yylsp-1)->last_line;
+ yylsp->last_column = (yylsp-1)->last_column;
+ yylsp->text = 0;
+ }
+ else
+ {
+ yylsp->last_line = (yylsp+yylen-1)->last_line;
+ yylsp->last_column = (yylsp+yylen-1)->last_column;
+ }
+ #endif
+
+ /* Now "shift" the result of the reduction.
+ Determine what state that goes to,
+ based on the state we popped back to
+ and the rule number reduced by. */
+
+ yyn = yyr1[yyn];
+
+ yystate = yypgoto[yyn - YYNTBASE] + *yyssp;
+ if (yystate >= 0 && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+ yystate = yytable[yystate];
+ else
+ yystate = yydefgoto[yyn - YYNTBASE];
+
+ goto yynewstate;
+
+ yyerrlab: /* here on detecting error */
+
+ if (! yyerrstatus)
+ /* If not already recovering from an error, report this error. */
+ {
+ ++yynerrs;
+
+ #ifdef YYERROR_VERBOSE
+ yyn = yypact[yystate];
+
+ if (yyn > YYFLAG && yyn < YYLAST)
+ {
+ int size = 0;
+ char *msg;
+ int x, count;
+
+ count = 0;
+ /* Start X at -yyn if nec to avoid negative indexes in yycheck. */
+ for (x = (yyn < 0 ? -yyn : 0);
+ x < (sizeof(yytname) / sizeof(char *)); x++)
+ if (yycheck[x + yyn] == x)
+ size += strlen(yytname[x]) + 15, count++;
+ msg = (char *) xmalloc(size + 15);
+ if (msg != 0)
+ {
+ strcpy(msg, "parse error");
+
+ if (count < 5)
+ {
+ count = 0;
+ for (x = (yyn < 0 ? -yyn : 0);
+ x < (sizeof(yytname) / sizeof(char *)); x++)
+ if (yycheck[x + yyn] == x)
+ {
+ strcat(msg, count == 0 ? ", expecting `" : " or `");
+ strcat(msg, yytname[x]);
+ strcat(msg, "'");
+ count++;
+ }
+ }
+ yyerror(msg);
+ free(msg);
+ }
+ else
+ yyerror ("parse error; also virtual memory exceeded");
+ }
+ else
+ #endif /* YYERROR_VERBOSE */
+ yyerror("parse error");
+ }
+
+ goto yyerrlab1;
+ yyerrlab1: /* here on error raised explicitly by an action */
+
+ if (yyerrstatus == 3)
+ {
+ /* if just tried and failed to reuse lookahead token after an error, discard it. */
+
+ /* return failure if at end of input */
+ if (yychar == YYEOF)
+ YYABORT;
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Discarding token %d (%s).\n", yychar, yytname[yychar1]);
+ #endif
+
+ yychar = YYEMPTY;
+ }
+
+ /* Else will try to reuse lookahead token
+ after shifting the error token. */
+
+ yyerrstatus = 3; /* Each real token shifted decrements this */
+
+ goto yyerrhandle;
+
+ yyerrdefault: /* current state does not do anything special for the error token. */
+
+ #if 0
+ /* This is wrong; only states that explicitly want error tokens
+ should shift them. */
+ yyn = yydefact[yystate]; /* If its default is to accept any token, ok. Otherwise pop it.*/
+ if (yyn) goto yydefault;
+ #endif
+
+ yyerrpop: /* pop the current state because it cannot handle the error token */
+
+ if (yyssp == yyss) YYABORT;
+ yyvsp--;
+ yystate = *--yyssp;
+ #ifdef YYLSP_NEEDED
+ yylsp--;
+ #endif
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ {
+ short *ssp1 = yyss - 1;
+ fprintf (stderr, "Error: state stack now");
+ while (ssp1 != yyssp)
+ fprintf (stderr, " %d", *++ssp1);
+ fprintf (stderr, "\n");
+ }
+ #endif
+
+ yyerrhandle:
+
+ yyn = yypact[yystate];
+ if (yyn == YYFLAG)
+ goto yyerrdefault;
+
+ yyn += YYTERROR;
+ if (yyn < 0 || yyn > YYLAST || yycheck[yyn] != YYTERROR)
+ goto yyerrdefault;
+
+ yyn = yytable[yyn];
+ if (yyn < 0)
+ {
+ if (yyn == YYFLAG)
+ goto yyerrpop;
+ yyn = -yyn;
+ goto yyreduce;
+ }
+ else if (yyn == 0)
+ goto yyerrpop;
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ #if YYDEBUG != 0
+ if (yydebug)
+ fprintf(stderr, "Shifting error token, ");
+ #endif
+
+ *++yyvsp = yylval;
+ #ifdef YYLSP_NEEDED
+ *++yylsp = yylloc;
+ #endif
+
+ yystate = yyn;
+ goto yynewstate;
+ }
+ #line 627 "./ada-exp.y"
+
+
+ /* yylex defined in ada-lex.c: Reads one token, getting characters */
+ /* through lexptr. */
+
+ /* Remap normal flex interface names (yylex) as well as gratuitiously */
+ /* global symbol names, so we can have multiple flex-generated parsers */
+ /* in gdb. */
+
+ /* (See note above on previous definitions for YACC.) */
+
+ #define yy_create_buffer ada_yy_create_buffer
+ #define yy_delete_buffer ada_yy_delete_buffer
+ #define yy_init_buffer ada_yy_init_buffer
+ #define yy_load_buffer_state ada_yy_load_buffer_state
+ #define yy_switch_to_buffer ada_yy_switch_to_buffer
+ #define yyrestart ada_yyrestart
+ #define yytext ada_yytext
+ #define yywrap ada_yywrap
+
+ /* The following kludge was found necessary to prevent conflicts between */
+ /* defs.h and non-standard stdlib.h files. */
+ #define qsort __qsort__dummy
+ #include "ada-lex.c"
+
+ int
+ ada_parse ()
+ {
+ yyrestart (yyin); /* (Re-)initialize lexer. */
+ return _ada_parse ();
+ }
+
+ void
+ yyerror (msg)
+ char *msg;
+ {
+ error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
+ }
+
+ /* Append NAME to PREFIX. Unless IS_LITERAL is non-zero, the
+ lookup_form of the result is folded to lower-case. All resulting
+ strings are cleaned up after parsing and name resolution. */
+
+ static struct ada_name
+ name_cons (prefix, name, is_literal)
+ struct ada_name prefix;
+ struct stoken name;
+ int is_literal;
+ {
+ int len0 = prefix.original.length;
+ int lenr = len0 + name.length + (len0 > 0);
+ struct ada_name result;
+
+ result.original.ptr = (char*) xmalloc (lenr + 1);
+ result.lookup_form.ptr = (char*) xmalloc (lenr + 1);
+ result.original.length = result.lookup_form.length = lenr;
+ add_name_string_cleanup (result.original.ptr);
+ add_name_string_cleanup (result.lookup_form.ptr);
+
+ strcpy (result.original.ptr, prefix.original.ptr);
+ if (len0 > 0)
+ {
+ strcpy (result.original.ptr+len0, ".");
+ strncpy (result.original.ptr+len0+1, name.ptr, name.length);
+ }
+ else
+ strncpy (result.original.ptr, name.ptr, name.length);
+ result.original.ptr[lenr] = '\000';
+
+ strcpy (result.lookup_form.ptr, result.original.ptr);
+ if (! is_literal)
+ {
+ int k;
+ for (k = lenr - name.length; result.lookup_form.ptr[k] != '\000'; k += 1)
+ result.lookup_form.ptr[k] = tolower (result.lookup_form.ptr[k]);
+ }
+
+ return result;
+ }
+
+ /* The operator name corresponding to operator symbol STRING (adds
+ quotes and maps to lower-case). Destroys the previous contents of
+ the array pointed to by STRING.ptr. Error if STRING does not match
+ a valid Ada operator. Assumes that STRING.ptr points to a
+ null-terminated string and that, if STRING is a valid operator
+ symbol, the array pointed to by STRING.ptr contains at least
+ STRING.length+3 characters. */
+
+ static struct stoken
+ string_to_operator (string)
+ struct stoken string;
+ {
+ int i;
+
+ for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
+ {
+ if (string.length == strlen (ada_opname_table[i].demangled)-2
+ && strncasecmp (string.ptr, ada_opname_table[i].demangled+1,
+ string.length) == 0)
+ {
+ strncpy (string.ptr, ada_opname_table[i].demangled,
+ string.length+2);
+ string.length += 2;
+ return string;
+ }
+ }
+ error ("Invalid operator symbol `%s'", string.ptr);
+ }
+
+ /* Emit expression to access an instance of NAME[0..LEN-1]. If BLK is
+ non-null, starts search in context BLK. Use ERROR_NAME for error
+ messages. */
+
+ static void
+ write_var_from_name (blk, name, error_name)
+ struct block* blk;
+ struct stoken name, error_name;
+ {
+ struct symbol** syms;
+ struct block** blocks;
+ struct stoken prefix;
+
+ if (ada_lookup_symbol_list (copy_name (name), blk, VAR_NAMESPACE,
+ &syms, &blocks) == 0)
+ {
+ /* Before giving up on NAME, try for a minimal symbol that has no
+ matching full symbol. */
+ struct minimal_symbol* msymbol =
+ ada_lookup_minimal_symbol (copy_name (name));
+ if (msymbol != NULL)
+ {
+ write_exp_msymbol (msymbol,
+ lookup_function_type (builtin_type_int),
+ builtin_type_int);
+ return;
+ }
+ }
+ else
+ {
+ /* One or more matches: record name and starting block for later
+ resolution by ada_resolve (even when unambiguous, since that
+ is harmless and simplifies the procedure). */
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ write_exp_elt_block (blk);
+ write_exp_elt_name (copy_name (name));
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ return;
+ }
+
+ prefix = name;
+ for (prefix.length -= 1;
+ prefix.length > 0 && prefix.ptr[prefix.length] != '.';
+ prefix.length -= 1)
+ { }
+
+ if (prefix.length == 0)
+ {
+ if (!have_full_symbols () && !have_partial_symbols ())
+ error ("No symbol table is loaded. Use the \"file\" command.");
+ else if (blk != NULL)
+ error ("No definition of \"%s\" in specified context.",
+ copy_name (error_name));
+ else
+ error ("No definition of \"%s\" in current context.",
+ copy_name (error_name));
+ }
+ else
+ {
+ struct stoken suffix; /* The last component of NAME. */
+ suffix.length = name.length - prefix.length - 1;
+ suffix.ptr = name.ptr + prefix.length + 1;
+
+ /* Check the prefix. If it is unambiguous and names a function
+ (actually, a "block"), we check to see if name without the prefix is
+ a local in that function. If it is undefined, we
+ try to treat this as a structure access. It doesn't catch
+ all cases of selecting local variables of functions---so sue me. */
+
+ if (ada_lookup_symbol_list (copy_name (prefix), blk, VAR_NAMESPACE,
+ &syms, &blocks) == 1
+ && SYMBOL_CLASS (syms[0]) == LOC_BLOCK)
+ {
+ struct block* prefix_block = blocks[0];
+ int nsyms =
+ ada_lookup_symbol_list (copy_name (suffix), blk,
+ VAR_NAMESPACE, &syms, &blocks);
+ int k;
+
+ for (k = 0; k < nsyms; k += 1)
+ if (contained_in (blocks[k], prefix_block))
+ {
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ write_exp_elt_block (blocks[k]);
+ write_exp_elt_name (copy_name (suffix));
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ return;
+ }
+ }
+
+
+ /* Treat as structure access. */
+
+ write_var_from_name (blk, prefix, error_name);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (suffix);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ }
+ }
+
+ /* Generate expression for BLK :: NAME or NAME (when BLK == NULL). */
+
+ static void
+ write_var (blk, name)
+ struct block* blk;
+ struct ada_name name;
+ {
+ write_var_from_name (blk, name.lookup_form, name.original);
+ }
+
+
+ /* Return a token that is the same as TOK, but with its name in lower
+ case. */
+
+ static struct stoken
+ downcase_token (tok)
+ struct stoken tok;
+ {
+ tok.ptr = save_downcase_string (tok.ptr, tok.length);
+ return tok;
+ }
+
+ /* Return S[0..LEN-1], terminated by a null byte, with upper-case
+ letters mapped to lower case. The string is added to the name
+ cleanup list, released at the end of parsing. */
+
+ static char*
+ save_downcase_string (s, len)
+ const char s[];
+ int len;
+ {
+ int i;
+ char* new_name = savestring (s, len);
+ add_name_string_cleanup (new_name);
+
+ for (i = 0; i < len; i += 1)
+ new_name[i] = tolower (s[i]);
+ return new_name;
+ }
+
diff -c -r -N gdb-4.16/gdb/ada-exp.y gdb/ada-exp.y
*** gdb-4.16/gdb/ada-exp.y
--- gdb-4.16.orig/gdb/ada-exp.y Sun Mar 23 16:56:35 1997
***************
*** 0 ****
--- 1,875 ----
+ /* YACC parser for Ada expressions, for GDB.
+ Copyright (C) 1986, 1989, 1990, 1991, 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ /* Parse an Ada 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. */
+
+ %{
+
+ #include "defs.h"
+ #include <string.h>
+ #include <ctype.h>
+ #include "expression.h"
+ #include "value.h"
+ #include "parser-defs.h"
+ #include "language.h"
+ #include "ada-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. */
+
+ /* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
+ options. I presume we are maintaining it to accommodate systems
+ without BISON? (PNH) */
+
+ #define yymaxdepth ada_maxdepth
+ #define yyparse _ada_parse /* ada_parse calls this after initialization */
+ #define yylex ada_lex
+ #define yyerror ada_error
+ #define yylval ada_lval
+ #define yychar ada_char
+ #define yydebug ada_debug
+ #define yypact ada_pact
+ #define yyr1 ada_r1
+ #define yyr2 ada_r2
+ #define yydef ada_def
+ #define yychk ada_chk
+ #define yypgo ada_pgo
+ #define yyact ada_act
+ #define yyexca ada_exca
+ #define yyerrflag ada_errflag
+ #define yynerrs ada_nerrs
+ #define yyps ada_ps
+ #define yypv ada_pv
+ #define yys ada_s
+ #define yy_yys ada_yys
+ #define yystate ada_state
+ #define yytmp ada_tmp
+ #define yyv ada_v
+ #define yy_yyv ada_yyv
+ #define yyval ada_val
+ #define yylloc ada_lloc
+ #define yyreds ada_reds /* With YYDEBUG defined */
+ #define yytoks ada_toks /* With YYDEBUG defined */
+
+ #ifndef YYDEBUG
+ #define YYDEBUG 0 /* Default to no yydebug support */
+ #endif
+
+ int
+ yyparse PARAMS ((void));
+
+ static int
+ yylex PARAMS ((void));
+
+ void
+ yyerror PARAMS ((char *));
+
+ static struct stoken
+ downcase_token PARAMS ((struct stoken));
+
+ static char*
+ save_downcase_string PARAMS ((const char*, int));
+
+ static struct stoken
+ string_to_operator PARAMS ((struct stoken));
+
+ %}
+
+ /* 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. */
+
+ %{
+
+ /* A struct ada_name is a pair of strings, one a concatenation of identifiers
+ separated by '.'s with the capitalization originally specified by
+ the user, and the other the same string mapped to lower case,
+ except for those identifiers specified as `literal', as in x.'abC'. */
+
+ struct ada_name {
+ struct stoken original;
+ struct stoken lookup_form;
+ };
+
+ static struct ada_name NULL_NAME = { {"", 0}, {"", 0} };
+
+ static struct ada_name
+ name_cons PARAMS ((struct ada_name, struct stoken, int));
+
+ static void
+ write_var PARAMS ((struct block*, struct ada_name));
+
+ static void
+ write_var_from_name PARAMS ((struct block*, struct stoken, struct stoken));
+
+ %}
+
+ %union
+ {
+ LONGEST lval;
+ 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 ada_name name;
+ }
+
+ %type <voidval> exp exp1 type_exp start
+ %type <tval> type
+ %type <name> variable
+
+ %token <typed_val> INT NULL_PTR
+ %token <dval> FLOAT
+
+ /* Both NAME and TYPENAME tokens represent symbols in the input,
+ and both convey their data as strings.
+ But a TYPENAME is a string that happens to be defined as a typedef
+ or builtin type name (such as int or char)
+ and a NAME is any other symbol.
+ Contexts where this distinction is not important can use the
+ nonterminal "name", which matches either NAME or TYPENAME. */
+
+ %token <sval> STRING
+ %token <ssym> NAME BLOCKNAME
+ %token <tsym> TYPENAME
+ %token <sval> DOT_LITERAL_NAME
+ %type <sval> name name_not_typename
+ %type <tsym> typename
+ %type <bval> block
+ %type <lval> arglist tick_arglist
+
+ %token COLONCOLON
+ %token ERROR
+ %token ALL
+
+ /* Special type cases, put in to allow the parser to distinguish different
+ legal basetypes. */
+ %token <lval> LAST REGNAME
+
+ %token <ivar> INTERNAL_VARIABLE
+
+ %nonassoc ASSIGN
+ %left _AND_ OR XOR THEN ELSE
+ %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
+ %left '@'
+ %left '+' '-' '&'
+ %left UNARY
+ %left '*' '/' MOD REM
+ %right STARSTAR ABS NOT
+ /* The following are right-associative only so that reductions at this
+ precedence have lower precedence than '.' and '('. The syntax still
+ forces a.b.c, e.g., to be LEFT-associated. */
+ %right TICK_ACCESS TICK_FIRST TICK_LAST TICK_RANGE
+ %right '.' '(' '[' DOT_LITERAL_NAME
+ %left COLONCOLON
+
+ %token ARROW NEW
+
+
+ %%
+
+ start : exp1
+ | type_exp
+ ;
+
+ type_exp: type
+ { write_exp_elt_opcode (OP_TYPE);
+ write_exp_elt_type ($1);
+ write_exp_elt_opcode (OP_TYPE);}
+ ;
+
+ /* Expressions, including the sequencing operator. */
+ exp1 : exp
+ | exp1 ';' exp
+ { write_exp_elt_opcode (BINOP_COMMA); }
+ ;
+
+ /* Expressions, not including the sequencing operator. */
+ exp : exp ASSIGN exp /* Extension for convenience */
+ { write_exp_elt_opcode (BINOP_ASSIGN); }
+ ;
+
+ exp : exp '.' ALL
+ { write_exp_elt_opcode (UNOP_IND); }
+ ;
+
+ exp : '-' exp %prec UNARY
+ { write_exp_elt_opcode (UNOP_NEG); }
+ ;
+
+ exp : '+' exp %prec UNARY
+ { write_exp_elt_opcode (UNOP_PLUS); }
+ ;
+
+ exp : NOT exp %prec UNARY
+ { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+ ;
+
+ exp : ABS exp %prec UNARY
+ { write_exp_elt_opcode (UNOP_ABS); }
+ ;
+
+ exp : exp '.' name
+ { write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (downcase_token ($3));
+ write_exp_elt_opcode (STRUCTOP_STRUCT); }
+ | exp DOT_LITERAL_NAME
+ { write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string ($2);
+ write_exp_elt_opcode (STRUCTOP_STRUCT); }
+ ;
+
+ exp : exp '(' arglist ')' %prec ARROW
+ { write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ write_exp_elt_longcst ($3);
+ write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ }
+ | STRING '('
+ { write_var (expression_context_block,
+ name_cons (NULL_NAME,
+ string_to_operator ($1), 1));
+ }
+ arglist ')'
+ {
+ write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ write_exp_elt_longcst ($4);
+ write_exp_elt_opcode (OP_FUNCALL_OR_MULTI_SUBSCRIPT);
+ }
+ ;
+
+ arglist : { $$ = 0; }
+ ;
+
+ arglist : exp
+ { $$ = 1; }
+ | name ARROW exp
+ { $$ = 1; }
+ | arglist ',' exp
+ { $$ = $1 + 1; }
+ | arglist ',' name ARROW exp
+ { $$ = $1 + 1; }
+ ;
+
+ exp : '{' type '}' exp %prec '.'
+ /* GDB extension */
+ { write_exp_elt_opcode (UNOP_MEMVAL);
+ write_exp_elt_type ($2);
+ write_exp_elt_opcode (UNOP_MEMVAL); }
+ ;
+
+ exp : '(' exp1 ')'
+ { }
+ ;
+
+ /* Binary operators in order of decreasing precedence. */
+
+ exp : exp STARSTAR exp
+ { write_exp_elt_opcode (BINOP_EXP); }
+ ;
+
+ exp : exp '*' exp
+ { write_exp_elt_opcode (BINOP_MUL); }
+ ;
+
+ exp : exp '/' exp
+ { write_exp_elt_opcode (BINOP_DIV); }
+ ;
+
+ exp : exp REM exp /* May need to be fixed to give correct Ada REM */
+ { write_exp_elt_opcode (BINOP_REM); }
+ ;
+
+ exp : exp MOD exp
+ { write_exp_elt_opcode (BINOP_MOD); }
+ ;
+
+ exp : exp '@' exp /* GDB extension */
+ { write_exp_elt_opcode (BINOP_REPEAT); }
+ ;
+
+ exp : exp '+' exp
+ { write_exp_elt_opcode (BINOP_ADD); }
+ ;
+
+ exp : exp '&' exp
+ { write_exp_elt_opcode (BINOP_CONCAT); }
+ ;
+
+ exp : exp '-' exp
+ { write_exp_elt_opcode (BINOP_SUB); }
+ ;
+
+ exp : exp '=' exp
+ { write_exp_elt_opcode (BINOP_EQUAL); }
+ ;
+
+ exp : exp NOTEQUAL exp
+ { write_exp_elt_opcode (BINOP_NOTEQUAL); }
+ ;
+
+ exp : exp LEQ exp
+ { write_exp_elt_opcode (BINOP_LEQ); }
+ ;
+
+ exp : exp IN exp DOTDOT exp
+ { write_exp_elt_opcode (TERNOP_MBR); }
+ | exp IN exp TICK_RANGE tick_arglist
+ { write_exp_elt_opcode (BINOP_MBR);
+ write_exp_elt_longcst ((LONGEST) $5);
+ write_exp_elt_opcode (BINOP_MBR); }
+ | exp IN type
+ { write_exp_elt_opcode (UNOP_MBR);
+ write_exp_elt_type ($3);
+ write_exp_elt_opcode (UNOP_MBR); }
+ | exp NOT IN exp DOTDOT exp
+ { write_exp_elt_opcode (TERNOP_MBR);
+ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+ | exp NOT IN exp TICK_RANGE tick_arglist
+ { write_exp_elt_opcode (BINOP_MBR);
+ write_exp_elt_longcst ((LONGEST) $6);
+ write_exp_elt_opcode (BINOP_MBR);
+ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+ | exp NOT IN type
+ { write_exp_elt_opcode (UNOP_MBR);
+ write_exp_elt_type ($4);
+ write_exp_elt_opcode (UNOP_MBR);
+ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+ ;
+
+ exp : exp GEQ exp
+ { write_exp_elt_opcode (BINOP_GEQ); }
+ ;
+
+ exp : exp '<' exp
+ { write_exp_elt_opcode (BINOP_LESS); }
+ ;
+
+ exp : exp '>' exp
+ { write_exp_elt_opcode (BINOP_GTR); }
+ ;
+
+ exp : exp _AND_ exp /* Fix for Ada elementwise AND. */
+ { write_exp_elt_opcode (BINOP_BITWISE_AND); }
+ ;
+
+ exp : exp _AND_ THEN exp %prec _AND_
+ { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
+ ;
+
+ exp : exp OR exp /* Fix for Ada elementwise OR */
+ { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
+ ;
+
+ exp : exp OR ELSE exp
+ { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
+ ;
+
+ exp : exp XOR exp /* Fix for Ada elementwise XOR */
+ { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
+ ;
+
+ exp : exp TICK_ACCESS
+ { write_exp_elt_opcode (UNOP_ADDR); }
+ ;
+
+ exp : exp TICK_FIRST tick_arglist
+ { write_exp_elt_opcode (OP_LWB);
+ write_exp_elt_longcst ($3);
+ write_exp_elt_opcode (OP_LWB);
+ }
+ | exp TICK_LAST tick_arglist
+ { write_exp_elt_opcode (OP_UPB);
+ write_exp_elt_longcst ($3);
+ write_exp_elt_opcode (OP_UPB);
+ }
+ ;
+
+ tick_arglist : %prec '('
+ { $$ = 1; }
+ | '(' INT ')'
+ { $$ = $2.val; }
+ ;
+
+ exp : INT
+ { 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); }
+ ;
+
+ exp : FLOAT
+ { write_exp_elt_opcode (OP_DOUBLE);
+ write_exp_elt_type (builtin_type_double);
+ write_exp_elt_dblcst ($1);
+ write_exp_elt_opcode (OP_DOUBLE); }
+ ;
+
+ exp : NULL_PTR
+ { write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_int);
+ write_exp_elt_longcst ((LONGEST)(0));
+ write_exp_elt_opcode (OP_LONG); }
+
+ exp : LAST
+ { write_exp_elt_opcode (OP_LAST);
+ write_exp_elt_longcst ((LONGEST) $1);
+ write_exp_elt_opcode (OP_LAST); }
+ ;
+
+ exp : REGNAME /* GDB extension */
+ { write_exp_elt_opcode (OP_REGISTER);
+ write_exp_elt_longcst ((LONGEST) $1);
+ write_exp_elt_opcode (OP_REGISTER); }
+ ;
+
+ exp : INTERNAL_VARIABLE /* GDB extension */
+ { write_exp_elt_opcode (OP_INTERNALVAR);
+ write_exp_elt_intern ($1);
+ write_exp_elt_opcode (OP_INTERNALVAR); }
+ ;
+
+ exp : STRING %prec '('
+ { /* Ada strings are converted into array constants
+ a lower bound of 1. Thus, the array upper bound
+ is the string length. */
+ char *sp = $1.ptr; int count;
+ if ($1.length == 0)
+ { /* One dummy character for the type */
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_char);
+ write_exp_elt_longcst ((LONGEST)(0));
+ write_exp_elt_opcode (OP_LONG);
+ }
+ for (count = $1.length; count > 0; count -= 1)
+ {
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (builtin_type_char);
+ write_exp_elt_longcst ((LONGEST)(*sp));
+ sp += 1;
+ write_exp_elt_opcode (OP_LONG);
+ }
+ write_exp_elt_opcode (OP_ARRAY);
+ write_exp_elt_longcst ((LONGEST) 1);
+ write_exp_elt_longcst ((LONGEST) ($1.length));
+ write_exp_elt_opcode (OP_ARRAY); }
+ ;
+
+ exp : NEW type %prec TICK_ACCESS
+ { error ("NEW not implemented."); }
+ ;
+
+
+ exp : variable %prec '.'
+ { write_var (expression_context_block, $1); }
+ ;
+
+ exp : variable '.' ALL
+ { write_var (expression_context_block, $1);
+ write_exp_elt_opcode (UNOP_IND);
+ }
+ ;
+
+
+ exp : block variable %prec '.' /* GDB extension */
+ { write_var ($1, $2); }
+ ;
+
+ exp : block variable '.' ALL /* GDB extension */
+ { write_var ($1, $2);
+ write_exp_elt_opcode (UNOP_IND);
+ }
+ ;
+
+ exp : type '(' exp ')'
+ { write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type ($1);
+ write_exp_elt_opcode (UNOP_CAST); }
+ ;
+
+ block : BLOCKNAME COLONCOLON /* GDB extension */
+ {
+ if ($1.sym != 0)
+ $$ = SYMBOL_BLOCK_VALUE ($1.sym);
+ else
+ {
+ struct symtab *tem =
+ lookup_symtab (save_downcase_string
+ ($1.stoken.ptr,
+ $1.stoken.length));
+ if (tem)
+ $$ = BLOCKVECTOR_BLOCK
+ (BLOCKVECTOR (tem), STATIC_BLOCK);
+ else
+ error ("No file or function \"%s\".",
+ copy_name ($1.stoken));
+ }
+ }
+
+ | block name COLONCOLON /* GDB extension */
+ { struct symbol** syms;
+ struct block** blocks;
+ int nsyms;
+ nsyms = ada_lookup_symbol_list (copy_name ($2), $1,
+ VAR_NAMESPACE,
+ &syms,
+ &blocks);
+ if (nsyms == 0 || SYMBOL_CLASS (syms[0]) != LOC_BLOCK)
+ error ("No function \"%s\" in specified context.",
+ copy_name ($2));
+ else if (nsyms > 1)
+ warning ("Function name \"%s\" ambiguous here",
+ copy_name ($2));
+ $$ = SYMBOL_BLOCK_VALUE (syms[0]); }
+ ;
+
+
+ variable: name_not_typename
+ { $$ = name_cons (NULL_NAME, $1, 0); }
+ ;
+
+ variable: variable '.' name
+ { $$ = name_cons ($1, $3, 0); }
+ | variable DOT_LITERAL_NAME
+ { $$ = name_cons ($1, $2, 1); }
+ | variable '.' STRING
+ { $$ = name_cons ($1, string_to_operator ($3), 1); }
+ | TYPENAME '.' name
+ { $$ = name_cons (name_cons (NULL_NAME, $1.stoken, 0),
+ $3, 0); }
+ | TYPENAME DOT_LITERAL_NAME
+ { $$ = name_cons (name_cons (NULL_NAME, $1.stoken, 0),
+ $2, 1); }
+ | TYPENAME '.' STRING
+ { $$ = name_cons (name_cons (NULL_NAME, $1.stoken, 0),
+ string_to_operator ($3),
+ 1); }
+ ;
+
+ type : typename { $$ = $1.type; }
+ | type TICK_ACCESS
+ { $$ = lookup_pointer_type ($1); }
+ ;
+
+ typename: TYPENAME %prec '.'
+ ;
+
+ name : NAME { $$ = $1.stoken; }
+ | BLOCKNAME { $$ = $1.stoken; }
+ | TYPENAME { $$ = $1.stoken; }
+ ;
+
+ name_not_typename :
+ NAME { $$ = $1.stoken; }
+ | BLOCKNAME { $$ = $1.stoken; }
+ ;
+
+ /* Some extensions borrowed from C, for the benefit of those who find they
+ can't get used to Ada notation in GDB. */
+
+ exp : '*' exp %prec '.'
+ { write_exp_elt_opcode (UNOP_IND); }
+ | '&' exp %prec '.'
+ { write_exp_elt_opcode (UNOP_ADDR); }
+ | exp '[' exp ']'
+ { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
+ ;
+
+ %%
+
+ /* yylex defined in ada-lex.c: Reads one token, getting characters */
+ /* through lexptr. */
+
+ /* Remap normal flex interface names (yylex) as well as gratuitiously */
+ /* global symbol names, so we can have multiple flex-generated parsers */
+ /* in gdb. */
+
+ /* (See note above on previous definitions for YACC.) */
+
+ #define yy_create_buffer ada_yy_create_buffer
+ #define yy_delete_buffer ada_yy_delete_buffer
+ #define yy_init_buffer ada_yy_init_buffer
+ #define yy_load_buffer_state ada_yy_load_buffer_state
+ #define yy_switch_to_buffer ada_yy_switch_to_buffer
+ #define yyrestart ada_yyrestart
+ #define yytext ada_yytext
+ #define yywrap ada_yywrap
+
+ /* The following kludge was found necessary to prevent conflicts between */
+ /* defs.h and non-standard stdlib.h files. */
+ #define qsort __qsort__dummy
+ #include "ada-lex.c"
+
+ int
+ ada_parse ()
+ {
+ yyrestart (yyin); /* (Re-)initialize lexer. */
+ return _ada_parse ();
+ }
+
+ void
+ yyerror (msg)
+ char *msg;
+ {
+ error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
+ }
+
+ /* Append NAME to PREFIX. Unless IS_LITERAL is non-zero, the
+ lookup_form of the result is folded to lower-case. All resulting
+ strings are cleaned up after parsing and name resolution. */
+
+ static struct ada_name
+ name_cons (prefix, name, is_literal)
+ struct ada_name prefix;
+ struct stoken name;
+ int is_literal;
+ {
+ int len0 = prefix.original.length;
+ int lenr = len0 + name.length + (len0 > 0);
+ struct ada_name result;
+
+ result.original.ptr = (char*) malloc (lenr + 1);
+ result.lookup_form.ptr = (char*) malloc (lenr + 1);
+ result.original.length = result.lookup_form.length = lenr;
+ add_name_string_cleanup (result.original.ptr);
+ add_name_string_cleanup (result.lookup_form.ptr);
+
+ strcpy (result.original.ptr, prefix.original.ptr);
+ if (len0 > 0)
+ {
+ strcpy (result.original.ptr+len0, ".");
+ strncpy (result.original.ptr+len0+1, name.ptr, name.length);
+ }
+ else
+ strncpy (result.original.ptr, name.ptr, name.length);
+ result.original.ptr[lenr] = '\000';
+
+ strcpy (result.lookup_form.ptr, result.original.ptr);
+ if (! is_literal)
+ {
+ int k;
+ for (k = lenr - name.length; result.lookup_form.ptr[k] != '\000'; k += 1)
+ result.lookup_form.ptr[k] = tolower (result.lookup_form.ptr[k]);
+ }
+
+ return result;
+ }
+
+ /* The operator name corresponding to operator symbol STRING (adds
+ quotes and maps to lower-case). Destroys the previous contents of
+ the array pointed to by STRING.ptr. Error if STRING does not match
+ a valid Ada operator. Assumes that STRING.ptr points to a
+ null-terminated string and that, if STRING is a valid operator
+ symbol, the array pointed to by STRING.ptr contains at least
+ STRING.length+3 characters. */
+
+ static struct stoken
+ string_to_operator (string)
+ struct stoken string;
+ {
+ int i;
+
+ for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
+ {
+ if (string.length == strlen (ada_opname_table[i].demangled)-2
+ && strncasecmp (string.ptr, ada_opname_table[i].demangled+1,
+ string.length) == 0)
+ {
+ strncpy (string.ptr, ada_opname_table[i].demangled,
+ string.length+2);
+ string.length += 2;
+ return string;
+ }
+ }
+ error ("Invalid operator symbol `%s'", string.ptr);
+ }
+
+ /* Emit expression to access an instance of NAME[0..LEN-1]. If BLK is
+ non-null, starts search in context BLK. Use ERROR_NAME for error
+ messages. */
+
+ static void
+ write_var_from_name (blk, name, error_name)
+ struct block* blk;
+ struct stoken name, error_name;
+ {
+ struct symbol** syms;
+ struct block** blocks;
+ struct stoken prefix;
+
+ if (ada_lookup_symbol_list (copy_name (name), blk, VAR_NAMESPACE,
+ &syms, &blocks) == 0)
+ {
+ /* Before giving up on NAME, try for a minimal symbol that has no
+ matching full symbol. */
+ struct minimal_symbol* msymbol =
+ ada_lookup_minimal_symbol (copy_name (name));
+ if (msymbol != NULL)
+ {
+ write_exp_msymbol (msymbol,
+ lookup_function_type (builtin_type_int),
+ builtin_type_int);
+ return;
+ }
+ }
+ else
+ {
+ /* One or more matches: record name and starting block for later
+ resolution by ada_resolve (even when unambiguous, since that
+ is harmless and simplifies the procedure). */
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ write_exp_elt_block (blk);
+ write_exp_elt_name (copy_name (name));
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ return;
+ }
+
+ prefix = name;
+ for (prefix.length -= 1;
+ prefix.length > 0 && prefix.ptr[prefix.length] != '.';
+ prefix.length -= 1)
+ { }
+
+ if (prefix.length == 0)
+ {
+ if (!have_full_symbols () && !have_partial_symbols ())
+ error ("No symbol table is loaded. Use the \"file\" command.");
+ else if (blk != NULL)
+ error ("No definition of \"%s\" in specified context.",
+ copy_name (error_name));
+ else
+ error ("No definition of \"%s\" in current context.",
+ copy_name (error_name));
+ }
+ else
+ {
+ struct stoken suffix; /* The last component of NAME. */
+ suffix.length = name.length - prefix.length - 1;
+ suffix.ptr = name.ptr + prefix.length + 1;
+
+ /* Check the prefix. If it is unambiguous and names a function
+ (actually, a "block"), we check to see if name without the prefix is
+ a local in that function. If it is undefined, we
+ try to treat this as a structure access. It doesn't catch
+ all cases of selecting local variables of functions---so sue me. */
+
+ if (ada_lookup_symbol_list (copy_name (prefix), blk, VAR_NAMESPACE,
+ &syms, &blocks) == 1
+ && SYMBOL_CLASS (syms[0]) == LOC_BLOCK)
+ {
+ struct block* prefix_block = blocks[0];
+ int nsyms =
+ ada_lookup_symbol_list (copy_name (suffix), blk,
+ VAR_NAMESPACE, &syms, &blocks);
+ int k;
+
+ for (k = 0; k < nsyms; k += 1)
+ if (contained_in (blocks[k], prefix_block))
+ {
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ write_exp_elt_block (blocks[k]);
+ write_exp_elt_name (copy_name (suffix));
+ write_exp_elt_opcode (OP_UNRESOLVED_VALUE);
+ return;
+ }
+ }
+
+
+ /* Treat as structure access. */
+
+ write_var_from_name (blk, prefix, error_name);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string (suffix);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
+ }
+ }
+
+ /* Generate expression for BLK :: NAME or NAME (when BLK == NULL). */
+
+ static void
+ write_var (blk, name)
+ struct block* blk;
+ struct ada_name name;
+ {
+ write_var_from_name (blk, name.lookup_form, name.original);
+ }
+
+
+ /* Return a token that is the same as TOK, but with its name in lower
+ case. */
+
+ static struct stoken
+ downcase_token (tok)
+ struct stoken tok;
+ {
+ tok.ptr = save_downcase_string (tok.ptr, tok.length);
+ return tok;
+ }
+
+ /* Return S[0..LEN-1], terminated by a null byte, with upper-case
+ letters mapped to lower case. The string is added to the name
+ cleanup list, released at the end of parsing. */
+
+ static char*
+ save_downcase_string (s, len)
+ const char s[];
+ int len;
+ {
+ int i;
+ char* new_name = savestring (s, len);
+ add_name_string_cleanup (new_name);
+
+ for (i = 0; i < len; i += 1)
+ new_name[i] = tolower (s[i]);
+ return new_name;
+ }
+
diff -c -r -N gdb-4.16/gdb/ada-lang.c gdb/ada-lang.c
*** gdb-4.16/gdb/ada-lang.c
--- gdb-4.16.orig/gdb/ada-lang.c Sun Mar 23 16:58:13 1997
***************
*** 0 ****
--- 1,2872 ----
+ /* C language support routines for GDB, the GNU debugger. 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ /* NOTE: For the moment, there is a good deal of stuff here that ought to be
+ elsewhere (e.g., in symtab.c, eval.c, or values.c). For the
+ moment, I am putting them here while I am developing the Ada stuff
+ in order to keep it together, with the intention of integrating it
+ all into the proper places in GDB when it becomes part of the
+ mainstream. */
+
+ #include <string.h>
+ #include <ctype.h>
+ #include "demangle.h"
+ #include "defs.h"
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "expression.h"
+ #include "parser-defs.h"
+ #include "language.h"
+ #include "c-lang.h"
+ #include "inferior.h"
+ #include "symfile.h"
+ #include "objfiles.h"
+ #include "ada-lang.h"
+
+ struct cleanup* unresolved_names;
+
+ static void
+ emit_char PARAMS ((int, GDB_FILE *, int));
+
+ static void
+ ada_printchar PARAMS ((int, GDB_FILE *));
+
+ static void
+ ada_printstr PARAMS ((GDB_FILE *, char *, unsigned int, int));
+
+ static struct type *
+ ada_create_fundamental_type PARAMS ((struct objfile *, int));
+
+ static void
+ modify_general_field PARAMS ((char *, LONGEST, int, int));
+
+ static struct type*
+ desc_base_type PARAMS ((struct type*));
+
+ static struct type*
+ desc_bounds_type PARAMS ((struct type*));
+
+ static value_ptr
+ desc_bounds PARAMS ((value_ptr));
+
+ static int
+ desc_bounds_bitpos PARAMS ((struct type*));
+
+ static int
+ desc_bounds_bitsize PARAMS ((struct type*));
+
+ static struct type*
+ desc_data_type PARAMS ((struct type*));
+
+ static value_ptr
+ desc_data PARAMS ((value_ptr));
+
+ static int
+ desc_data_bitpos PARAMS ((struct type*));
+
+ static int
+ desc_data_bitsize PARAMS ((struct type*));
+
+ static value_ptr
+ desc_one_bound PARAMS ((value_ptr, int, int));
+
+ static int
+ desc_bound_bitpos PARAMS ((struct type*, int, int));
+
+ static int
+ desc_bound_bitsize PARAMS ((struct type*, int, int));
+
+ static struct type*
+ desc_index_type PARAMS ((struct type*, int));
+
+ static int
+ desc_arity PARAMS ((struct type*));
+
+ static int
+ ada_type_match PARAMS ((struct type*, struct type*, int));
+
+ static int
+ ada_args_match PARAMS ((struct symbol*, value_ptr*, int));
+
+ static value_ptr
+ place_on_stack PARAMS ((value_ptr, CORE_ADDR*));
+
+ static value_ptr
+ convert_actual PARAMS ((value_ptr, struct type*, CORE_ADDR*));
+
+ static value_ptr
+ make_array_descriptor PARAMS ((struct type*, value_ptr, CORE_ADDR*));
+
+ static void
+ ada_add_block_symbols PARAMS ((struct block*, const char*, namespace_enum));
+
+ static void
+ fill_in_ada_prototype PARAMS ((struct symbol*));
+
+ static int
+ is_nonfunction PARAMS ((struct symbol**, int));
+
+ static void
+ add_defn_to_vec PARAMS ((struct symbol*, struct block*));
+
+ static struct partial_symbol *
+ ada_lookup_partial_symbol PARAMS ((struct partial_symtab*, const char*, int,
+ namespace_enum namespace));
+
+ static struct symtab*
+ symtab_for_sym PARAMS ((struct symbol*));
+
+ static int
+ ada_msymbol_matches_name PARAMS ((struct minimal_symbol*, const char*));
+
+ static value_ptr
+ ada_resolve_subexp PARAMS ((struct expression**, int*, int));
+
+ static void
+ replace_operator_with_call PARAMS ((struct expression**, int, int, int,
+ struct symbol*, struct block*));
+
+ static int
+ possible_user_operator_p PARAMS ((enum exp_opcode, value_ptr*));
+
+ static const char*
+ ada_op_name PARAMS ((enum exp_opcode));
+
+ static int
+ numeric_type_p PARAMS ((struct type*));
+
+ static int
+ integer_type_p PARAMS ((struct type*));
+
+ static int
+ scalar_type_p PARAMS ((struct type*));
+
+ static int
+ nearest_to_line PARAMS ((struct symtabs_and_lines, int));
+
+ static char*
+ extended_canonical_line_spec PARAMS ((struct symtab_and_line, const char*));
+
+
+ /* Table of Ada operators and their GNAT-mangled names. Last entry is pair
+ of NULLs. */
+
+ const struct ada_opname_map ada_opname_table[] =
+ {
+ { "Oadd", "\"+\"", BINOP_ADD },
+ { "Osubtract", "\"-\"", BINOP_SUB },
+ { "Omultiply", "\"*\"", BINOP_MUL },
+ { "Odivide", "\"/\"", BINOP_DIV },
+ { "Omod", "\"mod\"", BINOP_MOD },
+ { "Orem", "\"rem\"", BINOP_REM },
+ { "Oexpon", "\"**\"", BINOP_EXP },
+ { "Olt", "\"<\"", BINOP_LESS },
+ { "Ole", "\"<=\"", BINOP_LEQ },
+ { "Ogt", "\">\"", BINOP_GTR },
+ { "Oge", "\">=\"", BINOP_GEQ },
+ { "Oeq", "\"=\"", BINOP_EQUAL },
+ { "One", "\"/=\"", BINOP_NOTEQUAL },
+ { "Oand", "\"and\"", BINOP_BITWISE_AND },
+ { "Oor", "\"or\"", BINOP_BITWISE_IOR },
+ { "Oxor", "\"xor\"", BINOP_BITWISE_XOR },
+ { "Oconcat", "\"&\"", BINOP_CONCAT },
+ { "Oabs", "\"abs\"", UNOP_ABS },
+ { "Onot", "\"not\"", UNOP_LOGICAL_NOT },
+ { "Oadd", "\"+\"", UNOP_PLUS },
+ { "Osubtract", "\"-\"", UNOP_NEG },
+ { NULL, NULL }
+ };
+
+
+ /* Given a guess, LANG, as to the initial language, return an updated */
+ /* guess, assuming that the partial symbol table containing `main' is */
+ /* MAIN_PST. */
+ enum language
+ ada_update_initial_language (lang, main_pst)
+ enum language lang;
+ struct partial_symtab* main_pst;
+ {
+ if (main_pst != NULL && main_pst -> filename != NULL
+ && STREQ (main_pst -> filename + strlen (main_pst -> filename) - 2, ".c")
+ && STREQN (main_pst -> filename, "b_", 2))
+ {
+ char* main_name =
+ (char*) alloca (strlen (main_pst -> filename + 2) + sizeof("_ada_"));
+ strcpy (main_name, "_ada_");
+ strcat (main_name, main_pst -> filename + 2);
+ main_name[strlen (main_name) - 2] = '\000';
+
+ if (lookup_minimal_symbol (main_name, (const char*) NULL,
+ (struct objfile*) NULL) != NULL)
+ return language_ada;
+ }
+
+ return lang;
+ }
+
+
+
+ /* Print the character C on STREAM as part of the contents of a literal
+ string whose delimiter is QUOTER. Note that that format for printing
+ characters and strings is language specific. */
+
+ static void
+ emit_char (c, stream, quoter)
+ int c;
+ GDB_FILE *stream;
+ int quoter;
+ {
+
+ c &= 0xFF; /* Avoid sign bit follies */
+
+ if (PRINT_LITERAL_FORM (c))
+ {
+ if (c == '\\' || c == quoter)
+ {
+ fputs_filtered ("\\", stream);
+ }
+ fprintf_filtered (stream, "%c", c);
+ }
+ else
+ {
+ switch (c)
+ {
+ case '\n':
+ fputs_filtered ("\\n", stream);
+ break;
+ case '\b':
+ fputs_filtered ("\\b", stream);
+ break;
+ case '\t':
+ fputs_filtered ("\\t", stream);
+ break;
+ case '\f':
+ fputs_filtered ("\\f", stream);
+ break;
+ case '\r':
+ fputs_filtered ("\\r", stream);
+ break;
+ case '\033':
+ fputs_filtered ("\\e", stream);
+ break;
+ case '\007':
+ fputs_filtered ("\\a", stream);
+ break;
+ default:
+ fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
+ break;
+ }
+ }
+ }
+
+
+ static void
+ ada_printchar (c, stream)
+ int c;
+ GDB_FILE *stream;
+ {
+ fputs_filtered ("'", stream);
+ emit_char (c, stream, '\'');
+ fputs_filtered ("'", stream);
+ }
+
+ /* Print the character string STRING, printing at most LENGTH characters.
+ Printing stops early if the number hits print_max; repeat counts
+ are printed as appropriate. Print ellipses at the end if we
+ had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
+
+ static void
+ ada_printstr (stream, string, length, force_ellipses)
+ GDB_FILE *stream;
+ char *string;
+ unsigned int length;
+ int force_ellipses;
+ {
+ unsigned int i;
+ unsigned int things_printed = 0;
+ int in_quotes = 0;
+ int need_comma = 0;
+ extern int inspect_it;
+ extern int repeat_count_threshold;
+ extern int print_max;
+
+ /* If the string was not truncated due to `set print elements', and
+ the last byte of it is a null, we don't print that, in traditional C
+ style. */
+ if ((!force_ellipses) && length > 0 && string[length-1] == '\0')
+ length--;
+
+ if (length == 0)
+ {
+ fputs_filtered ("\"\"", stream);
+ return;
+ }
+
+ for (i = 0; i < length && things_printed < print_max; ++i)
+ {
+ /* Position of the character we are examining
+ to see whether it is repeated. */
+ unsigned int rep1;
+ /* Number of repetitions we have detected so far. */
+ unsigned int reps;
+
+ QUIT;
+
+ if (need_comma)
+ {
+ fputs_filtered (", ", stream);
+ need_comma = 0;
+ }
+
+ rep1 = i + 1;
+ reps = 1;
+ while (rep1 < length && string[rep1] == string[i])
+ {
+ ++rep1;
+ ++reps;
+ }
+
+ if (reps > repeat_count_threshold)
+ {
+ if (in_quotes)
+ {
+ if (inspect_it)
+ fputs_filtered ("\\\", ", stream);
+ else
+ fputs_filtered ("\", ", stream);
+ in_quotes = 0;
+ }
+ ada_printchar (string[i], stream);
+ fprintf_filtered (stream, " <repeats %u times>", reps);
+ i = rep1 - 1;
+ things_printed += repeat_count_threshold;
+ need_comma = 1;
+ }
+ else
+ {
+ if (!in_quotes)
+ {
+ if (inspect_it)
+ fputs_filtered ("\\\"", stream);
+ else
+ fputs_filtered ("\"", stream);
+ in_quotes = 1;
+ }
+ emit_char (string[i], stream, '"');
+ ++things_printed;
+ }
+ }
+
+ /* Terminate the quotes if necessary. */
+ if (in_quotes)
+ {
+ if (inspect_it)
+ fputs_filtered ("\\\"", stream);
+ else
+ fputs_filtered ("\"", stream);
+ }
+
+ if (force_ellipses || i < length)
+ fputs_filtered ("...", stream);
+ }
+
+ /* Create a fundamental Ada type using default reasonable for the current
+ target machine.
+
+ Some object/debugging file formats (DWARF version 1, COFF, etc) do not
+ define fundamental types such as "int" or "double". Others (stabs or
+ DWARF version 2, etc) do define fundamental types. For the formats which
+ don't provide fundamental types, gdb can create such types using this
+ function.
+
+ FIXME: Some compilers distinguish explicitly signed integral types
+ (signed short, signed int, signed long) from "regular" integral types
+ (short, int, long) in the debugging information. There is some dis-
+ agreement as to how useful this feature is. In particular, gcc does
+ not support this. Also, only some debugging formats allow the
+ distinction to be passed on to a debugger. For now, we always just
+ use "short", "int", or "long" as the type name, for both the implicit
+ and explicitly signed types. This also makes life easier for the
+ gdb test suite since we don't have to account for the differences
+ in output depending upon what the compiler and debugging format
+ support. We will probably have to re-examine the issue when gdb
+ starts taking it's fundamental type information directly from the
+ debugging information supplied by the compiler. fnf@cygnus.com */
+
+ static struct type *
+ ada_create_fundamental_type (objfile, typeid)
+ struct objfile *objfile;
+ int typeid;
+ {
+ struct type *type = NULL;
+
+ switch (typeid)
+ {
+ default:
+ /* FIXME: For now, if we are asked to produce a type not in this
+ language, create the equivalent of a C integer type with the
+ name "<?type?>". When all the dust settles from the type
+ reconstruction work, this should probably become an error. */
+ type = init_type (TYPE_CODE_INT,
+ TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 0, "<?type?>", objfile);
+ warning ("internal error: no Ada fundamental type %d", typeid);
+ break;
+ case FT_VOID:
+ type = init_type (TYPE_CODE_VOID,
+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 0, "void", objfile);
+ break;
+ case FT_CHAR:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 0, "character", objfile);
+ break;
+ case FT_SIGNED_CHAR:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 0, "signed char", objfile);
+ break;
+ case FT_UNSIGNED_CHAR:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
+ break;
+ case FT_SHORT:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ 0, "short_integer", objfile);
+ break;
+ case FT_SIGNED_SHORT:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ 0, "short_integer", objfile);
+ break;
+ case FT_UNSIGNED_SHORT:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
+ break;
+ case FT_INTEGER:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 0, "integer", objfile);
+ break;
+ case FT_SIGNED_INTEGER:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 0, "integer", objfile); /* FIXME -fnf */
+ break;
+ case FT_UNSIGNED_INTEGER:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_INT_BIT / TARGET_CHAR_BIT,
+ TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
+ break;
+ case FT_LONG:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ 0, "long_integer", objfile);
+ break;
+ case FT_SIGNED_LONG:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ 0, "long_integer", objfile);
+ break;
+ case FT_UNSIGNED_LONG:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
+ break;
+ case FT_LONG_LONG:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ 0, "long_long_integer", objfile);
+ break;
+ case FT_SIGNED_LONG_LONG:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ 0, "long_long_integer", objfile);
+ break;
+ case FT_UNSIGNED_LONG_LONG:
+ type = init_type (TYPE_CODE_INT,
+ TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
+ break;
+ case FT_FLOAT:
+ type = init_type (TYPE_CODE_FLT,
+ TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
+ 0, "float", objfile);
+ break;
+ case FT_DBL_PREC_FLOAT:
+ type = init_type (TYPE_CODE_FLT,
+ TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
+ 0, "long_float", objfile);
+ break;
+ case FT_EXT_PREC_FLOAT:
+ type = init_type (TYPE_CODE_FLT,
+ TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
+ 0, "long_long_float", objfile);
+ break;
+ }
+ return (type);
+ }
+
+ /* Demangle:
+ 1. Discard final __{DIGIT}+ or ${DIGIT}+
+ 2. Convert other instances of embedded "__" to `.'.
+ 3. Discard leading _ada_.
+ 4. Convert operator names to the appropriate quoted symbols.
+ It is up to the user to free the resulting string.
+ */
+
+ char *
+ ada_demangle (mangled)
+ const char* mangled;
+ {
+ int i, j;
+ int len0;
+ char* demangled;
+ int at_start_name;
+ int changed;
+
+ changed = 0;
+
+ if (STREQN (mangled, "_ada_", 5))
+ {
+ mangled += 5;
+ changed = 1;
+ }
+
+ len0 = strlen (mangled);
+
+ /* Make demangled big enough for possible expansion by operator name. */
+ demangled = xmalloc (2*len0);
+
+ if (isdigit (mangled[len0 - 1])) {
+ for (i = len0-2; i >= 0 && isdigit (mangled[i]); i -= 1)
+ ;
+ if (i > 1 && mangled[i] == '_' && mangled[i-1] == '_')
+ {
+ len0 = i - 1;
+ changed = 1;
+ }
+ else if (mangled[i] == '$')
+ {
+ len0 = i;
+ changed = 1;
+ }
+ }
+
+ for (i = 0, j = 0; i < len0 && ! isalpha (mangled[i]); i += 1, j += 1)
+ demangled[j] = mangled[i];
+
+ at_start_name = 1;
+ while (i < len0)
+ {
+ if (at_start_name && mangled[i] == 'O')
+ {
+ int k;
+ for (k = 0; ada_opname_table[k].mangled != NULL; k += 1)
+ {
+ int op_len = strlen (ada_opname_table[k].mangled);
+ if (STREQN (ada_opname_table[k].mangled+1, mangled+i+1, op_len-1)
+ && ! isalnum (mangled[i + op_len]))
+ {
+ strcpy (demangled + j, ada_opname_table[k].demangled);
+ at_start_name = 0;
+ changed = 1;
+ i += op_len;
+ j += strlen (ada_opname_table[k].demangled);
+ break;
+ }
+ }
+ if (ada_opname_table[k].mangled != NULL)
+ continue;
+ }
+ at_start_name = 0;
+
+ if (i < len0-2 && mangled[i] == '_' && mangled[i+1] == '_')
+ {
+ demangled[j] = '.';
+ changed = at_start_name = 1;
+ i += 2; j += 1;
+ }
+ else
+ {
+ demangled[j] = mangled[i];
+ i += 1; j += 1;
+ }
+ }
+ demangled[j] = '\000';
+
+ if (! changed)
+ {
+ free (demangled);
+ return NULL;
+ }
+
+ return demangled;
+ }
+
+ /* Returns non-zero iff sym_name matches name ignoring case, or if a
+ suffix of sym_name that immediately follows a '.' matches name,
+ ignoring case. Also returns 0 if either argument is NULL. */
+
+ int
+ ada_match_name (sym_name, name)
+ const char* sym_name;
+ const char* name;
+ {
+ if (sym_name == NULL || name == NULL)
+ return 0;
+ else
+ {
+ int len_sym = strlen (sym_name);
+ int len_name = strlen (name);
+
+ return ((len_name == len_sym
+ || (len_name < len_sym-1
+ && sym_name[len_sym-len_name-1] == '.'))
+ && strcasecmp (name, sym_name + len_sym - len_name) == 0);
+ }
+ }
+
+
+
+
+ /* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of
+ array descriptors. */
+
+ static char* bound_name[] = {
+ "LB0", "UB0", "LB1", "UB1", "LB2", "UB2", "LB3", "UB3",
+ "LB4", "UB4", "LB5", "UB5", "LB6", "UB6", "LB7", "UB7"
+ };
+
+ /* Maximum number of array dimensions we are prepared to handle. */
+
+ #define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char*)))
+
+ /* Like modify_field, but allows bitpos > wordlength. */
+
+ static void
+ modify_general_field (addr, fieldval, bitpos, bitsize)
+ char *addr;
+ LONGEST fieldval;
+ int bitpos, bitsize;
+ {
+ modify_field (addr + sizeof (LONGEST) * bitpos / (8 * sizeof (LONGEST)),
+ fieldval, bitpos % (8 * sizeof (LONGEST)),
+ bitsize);
+ }
+
+
+ /* The desc_* routines return primitive portions of array descriptors
+ (fat pointers). */
+
+ /* The descriptor or array type, if any, indicated by TYPE; removes
+ level of indirection, if needed. */
+
+ static struct type*
+ desc_base_type (type)
+ struct type* type;
+ {
+ if (type != NULL && TYPE_CODE (type) == TYPE_CODE_PTR)
+ return TYPE_TARGET_TYPE (type);
+ else
+ return type;
+ }
+
+ /* If TYPE is the type of an array descriptor (fat pointer) or a
+ /* pointer to one, the type of its bounds data; otherwise, NULL. */
+
+ static struct type*
+ desc_bounds_type (type)
+ struct type* type;
+ {
+ struct type* r;
+
+ type = desc_base_type (type);
+
+ if (type != NULL && TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+ r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
+ if (r != NULL)
+ return TYPE_TARGET_TYPE (r);
+ }
+ return NULL;
+ }
+
+ /* If ARR is an array descriptor (fat pointer), a pointer to its
+ bounds data. Otherwise NULL. */
+
+ static value_ptr
+ desc_bounds (arr)
+ value_ptr arr;
+ {
+ if (desc_bounds_type (VALUE_TYPE (arr)) != NULL)
+ return value_struct_elt (&arr, NULL, "P_BOUNDS", NULL,
+ "Bad GNAT array descriptor");
+ return NULL;
+ }
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit */
+ /* position of the field containing the address of the bounds data. */
+
+ static int
+ desc_bounds_bitpos (type)
+ struct type* type;
+ {
+ return TYPE_FIELD_BITPOS (desc_base_type (type), 1);
+ }
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit */
+ /* size of the field containing the address of the bounds data. */
+
+ static int
+ desc_bounds_bitsize (type)
+ struct type* type;
+ {
+ type = desc_base_type (type);
+
+ if (TYPE_FIELD_BITSIZE (type, 1) > 0)
+ return TYPE_FIELD_BITSIZE (type, 1);
+ else
+ return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1));
+ }
+
+
+ /* If TYPE is the type of an array descriptor (fat pointer) or a
+ pointer to one, the type of its array data (a
+ pointer-to-array-with-no-bounds type); otherwise, NULL. Use
+ ada_type_of_array to get an array type with bounds data. */
+
+ static struct type*
+ desc_data_type (type)
+ struct type* type;
+ {
+ type = desc_base_type (type);
+
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ return lookup_struct_elt_type (type, "P_ARRAY", 1);
+ else
+ return NULL;
+ }
+
+ /* If ARR is an array descriptor (fat pointer), a pointer to its array
+ data. */
+
+ static value_ptr
+ desc_data (arr)
+ value_ptr arr;
+ {
+ if (desc_data_type (VALUE_TYPE (arr)) != NULL)
+ return value_struct_elt (&arr, NULL, "P_ARRAY", NULL,
+ "Bad GNAT array descriptor");
+ return NULL;
+ }
+
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit */
+ /* position of the field containing the address of the data. */
+
+ static int
+ desc_data_bitpos (type)
+ struct type* type;
+ {
+ return TYPE_FIELD_BITPOS (desc_base_type (type), 0);
+ }
+
+ /* If TYPE is the type of an array-descriptor (fat pointer), the bit */
+ /* size of the field containing the address of the data. */
+
+ static int
+ desc_data_bitsize (type)
+ struct type* type;
+ {
+ type = desc_base_type (type);
+
+ if (TYPE_FIELD_BITSIZE (type, 0) > 0)
+ return TYPE_FIELD_BITSIZE (type, 0);
+ else
+ return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
+ }
+
+
+ /* If BOUNDS is an array-bounds structure (or pointer to one), return
+ the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
+ bound, if WHICH is 1. The first bound is I=1. */
+
+ static value_ptr
+ desc_one_bound (bounds, i, which)
+ value_ptr bounds;
+ int i;
+ int which;
+ {
+ return value_struct_elt (&bounds, NULL, bound_name[2*i+which-2], NULL,
+ "Bad GNAT array descriptor bounds");
+ }
+
+ /* If BOUNDS is an array-bounds structure type, return the bit position
+ of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
+ bound, if WHICH is 1. The first bound is I=1. */
+
+ static int
+ desc_bound_bitpos (type, i, which)
+ struct type* type;
+ int i;
+ int which;
+ {
+ return TYPE_FIELD_BITPOS (desc_base_type (type), 2*i+which-2);
+ }
+
+ /* If BOUNDS is an array-bounds structure type, return the bit field size
+ of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
+ bound, if WHICH is 1. The first bound is I=1. */
+
+ static int
+ desc_bound_bitsize (type, i, which)
+ struct type* type;
+ int i;
+ int which;
+ {
+ type = desc_base_type (type);
+
+ if (TYPE_FIELD_BITSIZE (type, 2*i+which-2) > 0)
+ return TYPE_FIELD_BITSIZE (type, 2*i+which-2);
+ else
+ return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 2*i+which-2));
+ }
+
+ /* If TYPE is the type of an array-bounds structure, the type of its */
+ /* Ith bound (numbering from 1). Otherwise, NULL. */
+
+ static struct type*
+ desc_index_type (type, i)
+ struct type* type;
+ int i;
+ {
+ type = desc_base_type (type);
+
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ return lookup_struct_elt_type (type, bound_name[2*i-2], 1);
+ else
+ return NULL;
+ }
+
+ /* The number of index positions in the array-bounds type TYPE. 0 */
+ /* if TYPE is NULL. */
+
+ static int
+ desc_arity (type)
+ struct type* type;
+ {
+ type = desc_base_type (type);
+
+ if (type != NULL)
+ return TYPE_NFIELDS (type) / 2;
+ return 0;
+ }
+
+
+ /* Non-zero iff type is a simple array type (or pointer to one). */
+
+ int
+ ada_is_simple_array (type)
+ struct type* type;
+ {
+ return (TYPE_CODE (type) == TYPE_CODE_ARRAY
+ || (TYPE_CODE (type) == TYPE_CODE_PTR
+ && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY));
+ }
+
+ /* Non-zero iff type belongs to a GNAT array descriptor. */
+
+ int
+ ada_is_array_descriptor (type)
+ struct type* type;
+ {
+ return (desc_bounds_type (type) != NULL && desc_data_type (type) != NULL);
+ }
+
+ /* If ARR has a record type in the form of a standard GNAT array descriptor,
+ returns the type of the array data described---specifically, a
+ pointer-to-array type. If BOUNDS is non-zero, the bounds data are filled
+ in from the descriptor; otherwise, they are left unspecified. The
+ result is simply the type of ARR if ARR is not a descriptor. The
+ result is good until next cleanup. */
+
+ struct type*
+ ada_type_of_array (arr, bounds)
+ value_ptr arr;
+ int bounds;
+ {
+ if (! ada_is_array_descriptor (VALUE_TYPE (arr)))
+ return VALUE_TYPE (arr);
+
+ if (! bounds)
+ return TYPE_TARGET_TYPE (desc_data_type (VALUE_TYPE (arr)));
+ else
+ {
+ struct type* elt_type;
+ int arity;
+ struct type* range;
+ struct type* array_type;
+ struct type* array_ptr_type;
+ value_ptr descriptor, temp, low, high;
+
+ elt_type = ada_array_element_type (VALUE_TYPE (arr));
+ arity = ada_array_arity (VALUE_TYPE (arr));
+
+ if (elt_type == NULL || arity == 0)
+ return VALUE_TYPE (arr);
+
+ descriptor = desc_bounds (arr);
+ while (arity > 0) {
+ low = desc_one_bound (descriptor, arity, 0);
+ high = desc_one_bound (descriptor, arity, 1);
+ arity -= 1;
+ range = alloc_type (NULL);
+ array_type = alloc_type (NULL);
+ make_cleanup (free, range);
+ make_cleanup (free, array_type);
+
+ create_range_type (range, VALUE_TYPE (low),
+ (int) value_as_long (low),
+ (int) value_as_long (high));
+ elt_type = create_array_type (array_type, elt_type, range);
+ }
+
+ array_ptr_type = alloc_type (NULL);
+ make_cleanup (free, array_ptr_type);
+ return make_pointer_type (elt_type, &array_ptr_type);
+ }
+ }
+
+ /* If ARR has a record type in the form of a standard GNAT array descriptor,
+ returns a value_ptr to a pointer to the array data described, cast as
+ a pointer-to-array type with the appropriate bounds. The resulting
+ value is good to next cleanup. Simply returns ARR if it is not of
+ the right form. */
+
+ value_ptr
+ ada_coerce_to_simple_array_ptr (arr)
+ value_ptr arr;
+ {
+ if (ada_is_array_descriptor (VALUE_TYPE (arr)))
+ return value_cast (ada_type_of_array (arr, 1), desc_data (arr));
+ else
+ return arr;
+ }
+
+ /* If ARR has a record type in the form of a standard GNAT array descriptor,
+ returns a (pointer to) the array data described, cast as an array type
+ with the appropriate bounds. The resulting value is good to next
+ cleanup. Simply returns ARR if it is not of the right form. */
+
+ value_ptr
+ ada_coerce_to_simple_array (arr)
+ value_ptr arr;
+ {
+ if (ada_is_array_descriptor (VALUE_TYPE (arr)))
+ return value_ind (ada_coerce_to_simple_array_ptr (arr));
+ else
+ return arr;
+ }
+
+ /* The value of the element of array ARR at the ARITY indices given in IND.
+ ARR may be either a simple array, GNAT array descriptor, or pointer
+ thereto. */
+
+ value_ptr
+ ada_value_subscript (arr, arity, ind)
+ value_ptr arr;
+ int arity;
+ value_ptr* ind;
+ {
+ int k;
+ value_ptr elt;
+
+ elt = ada_coerce_to_simple_array (arr);
+ for (k = 0; k < arity; k += 1)
+ {
+ if (TYPE_CODE (VALUE_TYPE (elt)) != TYPE_CODE_ARRAY)
+ error("too many subscripts (%d expected)", k);
+ elt = value_subscript (elt, ind[k]);
+ }
+ return elt;
+ }
+
+ /* If type is a record type in the form of a standard GNAT array
+ descriptor, returns the number of dimensions for type. If arr is a
+ simple array, returns the number of "array of"s that prefix its
+ type designation. Otherwise, returns 0. */
+
+ int
+ ada_array_arity (type)
+ struct type* type;
+ {
+ int arity;
+
+ type = desc_base_type (type);
+
+ arity = 0;
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ return desc_arity (desc_bounds_type (type));
+ else
+ while (TYPE_CODE (type) == TYPE_CODE_ARRAY)
+ {
+ arity += 1;
+ type = TYPE_TARGET_TYPE (type);
+ }
+
+ return arity;
+ }
+
+ /* If type is a record type in the form of a standard GNAT array
+ descriptor, returns the element type for type. If it is a simple
+ array, returns the ultimate element type (after stripping all
+ "array of" prefixes), otherwise returns NULL. */
+
+ struct type*
+ ada_array_element_type (type)
+ struct type* type;
+ {
+ type = desc_base_type (type);
+
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+ int k;
+ struct type* p_array_type;
+
+ p_array_type = desc_data_type (type);
+
+ k = ada_array_arity (type);
+ if (k == 0)
+ return NULL;
+
+ /* Initially p_array_type = (*elt_type)[]...(k times)...[] */
+ while (k >= 0 && p_array_type != NULL)
+ {
+ p_array_type = TYPE_TARGET_TYPE (p_array_type);
+ k -= 1;
+ }
+ return p_array_type;
+ }
+ else if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
+ {
+ while (TYPE_CODE (type) == TYPE_CODE_ARRAY)
+ type = TYPE_TARGET_TYPE (type);
+ return type;
+ }
+
+ return NULL;
+ }
+
+ /* The type of nth index in arrays of given type (n numbering from 1). Does
+ not examine memory. */
+
+ struct type*
+ ada_index_type (type, n)
+ struct type* type;
+ int n;
+ {
+ type = desc_base_type (type);
+
+ if (n > ada_array_arity (type))
+ return NULL;
+
+ if (ada_is_simple_array (type))
+ {
+ int i;
+
+ for (i = 1; i < n; i += 1)
+ type = TYPE_TARGET_TYPE (type);
+
+ return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
+ }
+ else
+ return desc_index_type (desc_bounds_type (type), n);
+ }
+
+ /* Given that arr is an array value, returns the lower bound of the
+ nth index (numbering from 1) if which is 0, and the upper bound if
+ which is 1. */
+
+ value_ptr
+ ada_array_bound (arr, n, which)
+ value_ptr arr;
+ int n;
+ int which;
+ {
+ if (ada_is_simple_array (VALUE_TYPE (arr)))
+ {
+ struct type* type;
+ struct type* range_type;
+ struct type* index_type;
+
+ if (TYPE_CODE (VALUE_TYPE (arr)) == TYPE_CODE_PTR)
+ type = TYPE_TARGET_TYPE (VALUE_TYPE (arr));
+ else
+ type = VALUE_TYPE (arr);
+ while (n > 1)
+ {
+ type = TYPE_TARGET_TYPE (type);
+ n -= 1;
+ }
+
+ range_type = TYPE_FIELD_TYPE (type, 0);
+ index_type = TYPE_TARGET_TYPE (range_type);
+ if (TYPE_CODE (index_type) == TYPE_CODE_UNDEF)
+ index_type = builtin_type_long;
+ return
+ value_from_longest (index_type,
+ (LONGEST) TYPE_FIELD_BITPOS (range_type, which));
+ }
+ else
+ return desc_one_bound (desc_bounds (arr), n, which);
+ }
+
+
+ /* Name resolution */
+
+ /* The "demangled" name for the user-definable Ada operator corresponding
+ to op. */
+
+ static const char*
+ ada_op_name (op)
+ enum exp_opcode op;
+ {
+ int i;
+
+ for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
+ {
+ if (ada_opname_table[i].op == op)
+ return ada_opname_table[i].demangled;
+ }
+ error ("Could not find operator name for opcode");
+ }
+
+
+ /* Same as evaluate_type (*EXP), but resolves ambiguous symbol
+ references (OP_UNRESOLVED_VALUES) and converts operators that are
+ user-defined into appropriate function calls. The variable
+ unresolved_names contains a list of character strings referenced by
+ expout that should be freed. May change (expand) *EXP. */
+
+ void
+ ada_resolve (expp)
+ struct expression** expp;
+ {
+ int pc;
+ pc = 0;
+ ada_resolve_subexp (expp, &pc, 1);
+ }
+
+ /* Resolve the operator of the subexpression expression beginning at
+ position *POS of *EXP. "Resolving" consists of replacing
+ OP_UNRESOLVED_VALUE with an appropriate OP_VAR_VALUE, replacing
+ built-in operators with function calls to user-defined operators,
+ where appropriate, and (when DEPROCEDURE_P is non-zero), converting
+ function-valued variables into parameterless calls. May expand EXP. */
+
+ static value_ptr
+ ada_resolve_subexp (expp, pos, deprocedure_p)
+ struct expression** expp;
+ int *pos;
+ int deprocedure_p;
+ {
+ int pc = *pos;
+ int i;
+ struct expression* exp; /* Convenience: == *expp */
+ enum exp_opcode op = (*expp)->elts[pc].opcode;
+ value_ptr* argvec; /* Vector of operand types (alloca'ed). */
+ int nargs; /* Number of operands */
+
+ nargs = 0;
+ exp = *expp;
+
+ /* Pass one: resolve operands, saving their types and updating *pos. */
+ switch (op)
+ {
+ case OP_VAR_VALUE:
+ case OP_UNRESOLVED_VALUE:
+ *pos += 4;
+ break;
+
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
+ nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
+ if (exp->elts[pc+3].opcode == OP_UNRESOLVED_VALUE)
+ {
+ *pos += 7;
+
+ argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 1));
+ for (i = 0; i < nargs-1; i += 1)
+ argvec[i] = ada_resolve_subexp (expp, pos, 1);
+ argvec[i] = NULL;
+ }
+ else
+ {
+ *pos += 3;
+ ada_resolve_subexp (expp, pos, 0);
+ for (i = 1; i < nargs; i += 1)
+ ada_resolve_subexp (expp, pos, 1);
+ }
+ exp = *expp;
+ break;
+
+ case UNOP_ADDR:
+ nargs = 1;
+ *pos += 1;
+ ada_resolve_subexp (expp, pos, 0);
+ exp = *expp;
+ break;
+
+ default:
+ switch (op)
+ {
+ default:
+ error ("Unexpected operator during name resolution");
+ case UNOP_CAST:
+ case UNOP_ADDR:
+ case UNOP_MBR:
+ nargs = 1;
+ *pos += 3;
+ break;
+
+ case BINOP_ADD:
+ case BINOP_SUB:
+ case BINOP_MUL:
+ case BINOP_DIV:
+ case BINOP_REM:
+ case BINOP_MOD:
+ case BINOP_EXP:
+ case BINOP_CONCAT:
+ case BINOP_LOGICAL_AND:
+ case BINOP_LOGICAL_OR:
+ case BINOP_BITWISE_AND:
+ case BINOP_BITWISE_IOR:
+ case BINOP_BITWISE_XOR:
+
+ case BINOP_EQUAL:
+ case BINOP_NOTEQUAL:
+ case BINOP_LESS:
+ case BINOP_GTR:
+ case BINOP_LEQ:
+ case BINOP_GEQ:
+
+ case BINOP_REPEAT:
+ case BINOP_SUBSCRIPT:
+ case BINOP_ASSIGN:
+ case BINOP_COMMA:
+ nargs = 2;
+ *pos += 1;
+ break;
+
+ case UNOP_NEG:
+ case UNOP_PLUS:
+ case UNOP_LOGICAL_NOT:
+ case UNOP_ABS:
+ case UNOP_IND:
+ nargs = 1;
+ *pos += 1;
+ break;
+
+ case OP_LONG:
+ case OP_DOUBLE:
+ case OP_VAR_VALUE:
+ *pos += 4;
+ break;
+
+ case OP_TYPE:
+ case OP_BOOL:
+ case OP_LAST:
+ case OP_REGISTER:
+ case OP_INTERNALVAR:
+ *pos += 3;
+ break;
+
+ case UNOP_MEMVAL:
+ case OP_LWB:
+ case OP_UPB:
+ *pos += 3;
+ nargs = 1;
+ break;
+
+ case STRUCTOP_STRUCT:
+ case STRUCTOP_PTR:
+ nargs = 1;
+ *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
+ break;
+
+ case OP_ARRAY:
+ *pos += 4;
+ nargs = longest_to_int (exp->elts[pc + 2].longconst) + 1;
+ nargs -= longest_to_int (exp->elts[pc + 1].longconst);
+ /* A null array contains one dummy element to give the type. */
+ if (nargs == 0)
+ nargs = 1;
+ break;
+
+ case TERNOP_MBR:
+ *pos += 1;
+ nargs = 3;
+ break;
+
+ case BINOP_MBR:
+ *pos += 3;
+ nargs = 2;
+ break;
+ }
+
+ argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 1));
+ for (i = 0; i < nargs; i += 1)
+ argvec[i] = ada_resolve_subexp (expp, pos, 1);
+ argvec[i] = NULL;
+ exp = *expp;
+ break;
+ }
+
+ /* Pass two: perform any resolution on principal operator. */
+ switch (op)
+ {
+ default:
+ break;
+
+ case OP_UNRESOLVED_VALUE:
+ {
+ struct symbol** candidate_syms;
+ struct block** candidate_blocks;
+ int n_candidates;
+
+ n_candidates = ada_lookup_symbol_list (exp->elts[pc + 2].name,
+ exp->elts[pc + 1].block,
+ VAR_NAMESPACE,
+ &candidate_syms,
+ &candidate_blocks);
+
+ if (n_candidates == 0)
+ error ("No definition found for %s", exp->elts[pc + 2].name);
+ else if (n_candidates == 1)
+ i = 0;
+ else if (deprocedure_p
+ && ! is_nonfunction (candidate_syms, n_candidates))
+ {
+ i = ada_resolve_function (candidate_syms, candidate_blocks,
+ n_candidates, NULL, 0,
+ exp->elts[pc + 2].name);
+ if (i < 0)
+ error ("Could not find a match for %s", exp->elts[pc + 2].name);
+ }
+ else
+ {
+ printf_filtered ("Multiple matches for %s\n",
+ exp->elts[pc+2].name);
+ user_select_syms (candidate_syms, candidate_blocks,
+ n_candidates, 1);
+ i = 0;
+ }
+
+ exp->elts[pc].opcode = exp->elts[pc + 3].opcode = OP_VAR_VALUE;
+ exp->elts[pc + 1].block = candidate_blocks[i];
+ exp->elts[pc + 2].symbol = candidate_syms[i];
+ if (innermost_block == NULL ||
+ contained_in (candidate_blocks[i], innermost_block))
+ innermost_block = candidate_blocks[i];
+ }
+ /* FALL THROUGH */
+
+ case OP_VAR_VALUE:
+ if (deprocedure_p &&
+ TYPE_CODE (SYMBOL_TYPE (exp->elts[pc+2].symbol)) == TYPE_CODE_FUNC)
+ replace_operator_with_call (expp, pc, 0, 0,
+ exp->elts[pc+2].symbol,
+ exp->elts[pc+1].block);
+ break;
+
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
+ {
+ if (exp->elts[pc+3].opcode == OP_UNRESOLVED_VALUE)
+ {
+ struct symbol** candidate_syms;
+ struct block** candidate_blocks;
+ int n_candidates;
+
+ n_candidates = ada_lookup_symbol_list (exp->elts[pc + 5].name,
+ exp->elts[pc + 4].block,
+ VAR_NAMESPACE,
+ &candidate_syms,
+ &candidate_blocks);
+ if (n_candidates == 1)
+ i = 0;
+ else
+ {
+ i = ada_resolve_function (candidate_syms, candidate_blocks,
+ n_candidates, argvec, nargs-1,
+ exp->elts[pc + 5].name);
+ if (i < 0)
+ error ("Could not find a match for %s",
+ exp->elts[pc + 5].name);
+ }
+
+ exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE;
+ exp->elts[pc + 4].block = candidate_blocks[i];
+ exp->elts[pc + 5].symbol = candidate_syms[i];
+ if (innermost_block == NULL ||
+ contained_in (candidate_blocks[i], innermost_block))
+ innermost_block = candidate_blocks[i];
+ }
+ }
+ break;
+ case BINOP_ADD:
+ case BINOP_SUB:
+ case BINOP_MUL:
+ case BINOP_DIV:
+ case BINOP_REM:
+ case BINOP_MOD:
+ case BINOP_CONCAT:
+ case BINOP_BITWISE_AND:
+ case BINOP_BITWISE_IOR:
+ case BINOP_BITWISE_XOR:
+ case BINOP_EQUAL:
+ case BINOP_NOTEQUAL:
+ case BINOP_LESS:
+ case BINOP_GTR:
+ case BINOP_LEQ:
+ case BINOP_GEQ:
+ case BINOP_EXP:
+ case UNOP_NEG:
+ case UNOP_PLUS:
+ case UNOP_LOGICAL_NOT:
+ case UNOP_ABS:
+ if (possible_user_operator_p (op, argvec))
+ {
+ struct symbol** candidate_syms;
+ struct block** candidate_blocks;
+ int n_candidates;
+
+ n_candidates = ada_lookup_symbol_list (ada_op_name (op),
+ (struct block*) NULL,
+ VAR_NAMESPACE,
+ &candidate_syms,
+ &candidate_blocks);
+ i = ada_resolve_function (candidate_syms, candidate_blocks,
+ n_candidates, argvec, nargs,
+ ada_op_name (op));
+ if (i < 0)
+ break;
+
+ replace_operator_with_call (expp, pc, nargs, 1,
+ candidate_syms[i], candidate_blocks[i]);
+ exp = *expp;
+ }
+ break;
+ }
+
+ *pos = pc;
+ return evaluate_subexp_type (exp, pos);
+ }
+
+ /* Return non-zero if formal type FTYPE matches actual type ATYPE. If
+ MAY_DEREF is non-zero, the formal may be a pointer and the actual
+ a non-pointer. */
+ /* The term "match" here is rather loose. The match is heuristic and
+ liberal. */
+
+ static int
+ ada_type_match (ftype, atype, may_deref)
+ struct type* ftype;
+ struct type* atype;
+ int may_deref;
+ {
+ if (TYPE_CODE (ftype) == TYPE_CODE_VOID
+ || TYPE_CODE (atype) == TYPE_CODE_VOID)
+ return 1;
+
+ switch (TYPE_CODE (ftype))
+ {
+ default:
+ return 1;
+ case TYPE_CODE_PTR:
+ if (TYPE_CODE (atype) == TYPE_CODE_PTR)
+ return ada_type_match (TYPE_TARGET_TYPE (ftype),
+ TYPE_TARGET_TYPE (atype), 0);
+ else return (may_deref &&
+ ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
+ case TYPE_CODE_INT:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_RANGE:
+ switch (TYPE_CODE (atype))
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_RANGE:
+ return 1;
+ default:
+ return 0;
+ }
+
+ case TYPE_CODE_ARRAY:
+ return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
+ || ada_is_array_descriptor (atype));
+
+ case TYPE_CODE_STRUCT:
+ if (ada_is_array_descriptor (ftype))
+ return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
+ || ada_is_array_descriptor (atype));
+ else
+ return (TYPE_CODE (atype) == TYPE_CODE_STRUCT
+ && ! ada_is_array_descriptor (atype));
+
+ case TYPE_CODE_UNION:
+ case TYPE_CODE_FLT:
+ return (TYPE_CODE (atype) == TYPE_CODE (ftype));
+ }
+ }
+
+ /* Return non-zero if the formals of FUNC "sufficiently match" the
+ vector of actual argument types ACTUALS of size N_ACTUALS. FUNC
+ may also be an enumeral, in which case it is treated as a 0-
+ argument function. */
+
+ static int
+ ada_args_match (func, actuals, n_actuals)
+ struct symbol* func;
+ value_ptr* actuals;
+ int n_actuals;
+ {
+ int i;
+ struct type* func_type = SYMBOL_TYPE (func);
+
+ if (SYMBOL_CLASS (func) == LOC_CONST &&
+ TYPE_CODE (func_type) == TYPE_CODE_ENUM)
+ return (n_actuals == 0);
+ else if (func_type == NULL || TYPE_CODE (func_type) != TYPE_CODE_FUNC)
+ return 0;
+
+ if (TYPE_NFIELDS (func_type) != n_actuals)
+ return 0;
+
+ for (i = 0; i < n_actuals; i += 1)
+ {
+ struct type* ftype = TYPE_FIELD_TYPE (func_type, i);
+ struct type* atype = VALUE_TYPE (actuals[i]);
+
+ if (! ada_type_match (TYPE_FIELD_TYPE (func_type, i),
+ VALUE_TYPE (actuals[i]), 1))
+ return 0;
+ }
+ return 1;
+ }
+
+ /* Return the index in SYMS[0..NSYMS-1] of symbol for the
+ function (if any) that matches the types of the NARGS arguments in
+ ARGS. Asks the user if there is more than one. Returns -1
+ if there is no such symbol or none is selected. NAME is used
+ solely for messages. May re-arrange and modify SYMS in
+ the process; the index returned is for the modified vector. BLOCKS
+ is modified in parallel to SYMS. */
+
+ int
+ ada_resolve_function (syms, blocks, nsyms, args, nargs, name)
+ struct symbol* syms[];
+ struct block* blocks[];
+ value_ptr* args;
+ int nsyms, nargs;
+ const char* name;
+ {
+ int k;
+ int m; /* Number of hits */
+
+ m = 0;
+ for (k = 0; k < nsyms; k += 1)
+ {
+ struct type* type = SYMBOL_TYPE (syms[k]);
+
+ if (ada_args_match (syms[k], args, nargs))
+ {
+ syms[m] = syms[k];
+ if (blocks != NULL)
+ blocks[m] = blocks[k];
+ m += 1;
+ }
+ }
+
+ if (m == 0)
+ return -1;
+ else if (m > 1)
+ {
+ printf_filtered ("Multiple matches for %s\n", name);
+ user_select_syms (syms, blocks, m, 1);
+ return 0;
+ }
+ return 0;
+ }
+
+ /* Given a list of NSYMS symbols in SYMS and corresponding blocks in */
+ /* BLOCKS, select up to MAX_RESULTS>0 by asking the user (if */
+ /* necessary), returning the number selected, and setting the first */
+ /* elements of SYMS and BLOCKS to the selected symbols and */
+ /* corresponding blocks. Error if no symbols selected. BLOCKS may */
+ /* be NULL, in which case it is ignored. */
+
+ /* NOTE: Adapted from decode_line_2 in symtab.c, with which it ought
+ to be re-integrated one of these days. */
+
+ int
+ user_select_syms (syms, blocks, nsyms, max_results)
+ struct symbol* syms[];
+ struct block* blocks[];
+ int nsyms;
+ int max_results;
+ {
+ int i;
+ int num;
+ int first_choice;
+ char* args;
+ const char* prompt;
+ int* chosen;
+ int n_chosen;
+
+ if (max_results < 1)
+ error ("Request to select 0 symbols!");
+ if (nsyms <= 1)
+ return nsyms;
+
+ printf_unfiltered("[0] cancel\n");
+ first_choice = (max_results == 1) ? 1 : 2;
+ if (max_results > 1)
+ printf_unfiltered("[1] all\n");
+
+ for (i = 0; i < nsyms; i += 1)
+ {
+ if (syms[i] == NULL)
+ continue;
+
+ if (SYMBOL_CLASS (syms[i]) == LOC_BLOCK)
+ {
+ struct symtab_and_line sal = find_function_start_sal (syms[i], 1);
+ printf_unfiltered ("[%d] %s at %s:%d\n",
+ i + first_choice,
+ SYMBOL_SOURCE_NAME (syms[i]),
+ sal.symtab->filename, sal.line);
+ continue;
+ }
+ else
+ {
+ int is_enumeral =
+ (SYMBOL_CLASS (syms[i]) == LOC_CONST
+ && SYMBOL_TYPE (syms[i]) != NULL
+ && TYPE_CODE (SYMBOL_TYPE (syms[i])) == TYPE_CODE_ENUM);
+ struct symtab* symtab = symtab_for_sym (syms[i]);
+
+ if (SYMBOL_LINE (syms[i]) != 0 && symtab != NULL)
+ printf_unfiltered ("[%d] %s at %s:%d\n",
+ i + first_choice,
+ SYMBOL_SOURCE_NAME (syms[i]),
+ symtab->filename, SYMBOL_LINE (syms[i]));
+ else if (symtab != NULL)
+ printf_unfiltered (is_enumeral
+ ? "[%d] %s in %s (enumeral)\n"
+ : "[%d] %s at %s:?\n",
+ i + first_choice,
+ SYMBOL_SOURCE_NAME (syms[i]),
+ symtab->filename);
+ else
+ printf_unfiltered (is_enumeral
+ ? "[%d] %s (enumeral)\n"
+ : "[%d] %s at ?\n",
+ i + first_choice, SYMBOL_SOURCE_NAME (syms[i]));
+ }
+ }
+
+ prompt = getenv ("PS2");
+ if (prompt == NULL)
+ prompt = ">";
+
+ printf_unfiltered ("%s ", prompt);
+ gdb_flush (gdb_stdout);
+
+ args = command_line_input ((char *) NULL, 0, "overload-choice");
+
+ if (args == NULL)
+ error_no_arg ("one or more choice numbers");
+
+ chosen = (int*) alloca (sizeof(int) * nsyms);
+ n_chosen = 0;
+
+ /* Set chosen[0 .. n_chosen-1] to the users' choices in ascending
+ order, as given in args. Choices are validated. */
+ while (1)
+ {
+ char* args2;
+ int choice, j;
+
+ while (isspace (*args))
+ args += 1;
+ if (*args == '\0' && n_chosen == 0)
+ error_no_arg ("one or more choice numbers");
+ else if (*args == '\0')
+ break;
+
+ choice = strtol (args, &args2, 10);
+ if (args == args2 || choice < 0 || choice > nsyms + first_choice - 1)
+ error ("Argument must be choice number");
+ args = args2;
+
+ if (choice == 0)
+ error ("cancelled");
+
+ if (choice < first_choice)
+ {
+ n_chosen = nsyms;
+ for (j = 0; j < nsyms; j += 1)
+ chosen[j] = j;
+ break;
+ }
+ choice -= first_choice;
+
+ for (j = n_chosen-1; j >= 0 && choice < chosen[j]; j -= 1)
+ {}
+
+ if (j < 0 || choice != chosen[j])
+ {
+ int k;
+ for (k = n_chosen-1; k > j; k -= 1)
+ chosen[k+1] = chosen[k];
+ chosen[j+1] = choice;
+ n_chosen += 1;
+ }
+ }
+
+ if (n_chosen > max_results)
+ error ("Select no more than %d of the above", max_results);
+
+ for (i = 0; i < n_chosen; i += 1)
+ {
+ syms[i] = syms[chosen[i]];
+ if (blocks != NULL)
+ blocks[i] = blocks[chosen[i]];
+ }
+
+ return n_chosen;
+ }
+
+ /* Replace the operator of length OPLEN at position PC in *EXPP with a call
+ /* on the function identified by SYM and BLOCK, and taking NARGS */
+ /* arguments. Update *EXPP as needed to hold more space. */
+
+ static void
+ replace_operator_with_call (expp, pc, nargs, oplen, sym, block)
+ struct expression** expp;
+ int pc, nargs, oplen;
+ struct symbol* sym;
+ struct block* block;
+ {
+ /* A new expression, with 6 more elements (3 for funcall, 4 for function
+ symbol, -oplen for operator being replaced). */
+ struct expression* newexp = (struct expression*)
+ xmalloc (sizeof (struct expression)
+ + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
+ struct expression* exp = *expp;
+
+ newexp->nelts = exp->nelts + 7 - oplen;
+ newexp->language_defn = exp->language_defn;
+ memcpy (newexp->elts, exp->elts, EXP_ELEM_TO_BYTES (pc));
+ memcpy (newexp->elts + pc + 7, exp->elts + pc + oplen,
+ EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
+
+ newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode
+ = OP_FUNCALL_OR_MULTI_SUBSCRIPT;
+ newexp->elts[pc + 1].longconst = (LONGEST) nargs;
+
+ newexp->elts[pc + 3].opcode = newexp->elts[pc + 6].opcode = OP_VAR_VALUE;
+ newexp->elts[pc + 4].block = block;
+ newexp->elts[pc + 5].symbol = sym;
+
+ *expp = newexp;
+ free (exp);
+ }
+
+ /* Type-class predicates */
+
+ /* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type), or */
+ /* FLOAT.) */
+
+ static int
+ numeric_type_p (type)
+ struct type* type;
+ {
+ if (type == NULL)
+ return 0;
+ else {
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_FLT:
+ return 1;
+ case TYPE_CODE_RANGE:
+ return (type == TYPE_TARGET_TYPE (type)
+ || numeric_type_p (TYPE_TARGET_TYPE (type)));
+ default:
+ return 0;
+ }
+ }
+ }
+
+ /* True iff TYPE is integral (an INT or RANGE of INTs). */
+
+ static int
+ integer_type_p (type)
+ struct type* type;
+ {
+ if (type == NULL)
+ return 0;
+ else {
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_INT:
+ return 1;
+ case TYPE_CODE_RANGE:
+ return (type == TYPE_TARGET_TYPE (type)
+ || integer_type_p (TYPE_TARGET_TYPE (type)));
+ default:
+ return 0;
+ }
+ }
+ }
+
+ /* True iff TYPE is scalar (INT, RANGE, FLOAT, ENUM). */
+
+ static int
+ scalar_type_p (type)
+ struct type* type;
+ {
+ if (type == NULL)
+ return 0;
+ else {
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_INT:
+ case TYPE_CODE_RANGE:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_FLT:
+ return 1;
+ default:
+ return 0;
+ }
+ }
+ }
+
+ /* Returns non-zero if OP with operatands in the vector ARGS could be
+ a user-defined function. Errs on the side of pre-defined operators
+ (i.e., result 0). */
+
+ static int
+ possible_user_operator_p (op, args)
+ enum exp_opcode op;
+ value_ptr args[];
+ {
+ struct type* type0 = VALUE_TYPE (args[0]);
+ struct type* type1 =
+ (args[1] == NULL) ? NULL : VALUE_TYPE (args[1]);
+
+ switch (op)
+ {
+ default:
+ return 0;
+
+ case BINOP_ADD:
+ case BINOP_SUB:
+ case BINOP_MUL:
+ case BINOP_DIV:
+ return (! (numeric_type_p (type0) && numeric_type_p (type1)));
+
+ case BINOP_REM:
+ case BINOP_MOD:
+ case BINOP_BITWISE_AND:
+ case BINOP_BITWISE_IOR:
+ case BINOP_BITWISE_XOR:
+ return (! (integer_type_p (type0) && integer_type_p (type1)));
+
+ case BINOP_EQUAL:
+ case BINOP_NOTEQUAL:
+ case BINOP_LESS:
+ case BINOP_GTR:
+ case BINOP_LEQ:
+ case BINOP_GEQ:
+ return (! (scalar_type_p (type0) && scalar_type_p (type1)));
+
+ case BINOP_CONCAT:
+ return ((TYPE_CODE (type0) != TYPE_CODE_ARRAY &&
+ (TYPE_CODE (type0) != TYPE_CODE_PTR ||
+ TYPE_CODE (TYPE_TARGET_TYPE (type0)) != TYPE_CODE_ARRAY))
+ || (TYPE_CODE (type1) != TYPE_CODE_ARRAY &&
+ (TYPE_CODE (type1) != TYPE_CODE_PTR ||
+ TYPE_CODE (TYPE_TARGET_TYPE (type1)) != TYPE_CODE_ARRAY)));
+
+ case BINOP_EXP:
+ return (! (numeric_type_p (type0) && integer_type_p (type1)));
+
+ case UNOP_NEG:
+ case UNOP_PLUS:
+ case UNOP_LOGICAL_NOT:
+ case UNOP_ABS:
+ return (! numeric_type_p (type0));
+
+ }
+ }
+
+
+
+
+
+ /* Copy VAL onto the stack, using and updating *SP as the stack
+ pointer. Return VAL as an lvalue. */
+
+ static value_ptr
+ place_on_stack (val, sp)
+ value_ptr val;
+ CORE_ADDR* sp;
+ {
+ CORE_ADDR old_sp = *sp;
+
+ #ifdef STACK_ALIGN
+ *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
+ STACK_ALIGN (TYPE_LENGTH (VALUE_TYPE (val))));
+ #else
+ *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
+ TYPE_LENGTH (VALUE_TYPE (val)));
+ #endif
+
+ VALUE_LVAL (val) = lval_memory;
+ #if 1 INNER_THAN 2
+ VALUE_ADDRESS (val) = *sp;
+ #else
+ VALUE_ADDRESS (val) = old_sp;
+ #endif
+
+ return val;
+ }
+
+ /* Return the value ACTUAL, converted to be an appropriate value for a
+ formal of type FORMAL_TYPE. Use *SP as a stack pointer for
+ allocating any necessary descriptors (fat pointers), or copies of
+ values not residing in memory, updating it as needed. */
+
+ static value_ptr
+ convert_actual (actual, formal_type, sp)
+ value_ptr actual;
+ struct type* formal_type;
+ CORE_ADDR* sp;
+ {
+ struct type* actual_type = VALUE_TYPE (actual);
+ struct type* formal_target =
+ TYPE_CODE (formal_type) == TYPE_CODE_PTR
+ ? TYPE_TARGET_TYPE (formal_type) : formal_type;
+ struct type* actual_target =
+ TYPE_CODE (actual_type) == TYPE_CODE_PTR
+ ? TYPE_TARGET_TYPE (actual_type) : actual_type;
+
+ if (ada_is_array_descriptor (formal_target)
+ && TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
+ return make_array_descriptor (formal_type, actual, sp);
+ else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR)
+ {
+ if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
+ && ada_is_array_descriptor (actual_target))
+ return desc_data (actual);
+ else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR)
+ {
+ if (VALUE_LVAL (actual) != lval_memory)
+ {
+ value_ptr val = allocate_value (actual_type);
+ memcpy ((char*) VALUE_CONTENTS_RAW (val),
+ (char*) VALUE_CONTENTS (actual),
+ TYPE_LENGTH (actual_type));
+ actual = place_on_stack (val, sp);
+ }
+ return value_addr (actual);
+ }
+ }
+ else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
+ return value_ind (actual);
+
+ return actual;
+ }
+
+
+ /* Push a descriptor of type TYPE for array value ARR on the stack at
+ *SP, updating *SP to reflect the new descriptor. Return either
+ an lvalue representing the new descriptor, or (if TYPE is a pointer-
+ to-descriptor type rather than a descriptor type), a value_ptr
+ representing a pointer to this descriptor. */
+
+ static value_ptr
+ make_array_descriptor (type, arr, sp)
+ struct type* type;
+ value_ptr arr;
+ CORE_ADDR* sp;
+ {
+ struct type* bounds_type = desc_bounds_type (type);
+ struct type* desc_type = desc_base_type (type);
+ value_ptr descriptor = allocate_value (desc_type);
+ value_ptr bounds = allocate_value (bounds_type);
+ CORE_ADDR bounds_addr;
+ int i;
+
+ for (i = ada_array_arity (VALUE_TYPE (arr)); i > 0; i -= 1)
+ {
+ modify_general_field (VALUE_CONTENTS (bounds),
+ value_as_long (ada_array_bound (arr, i, 0)),
+ desc_bound_bitpos (bounds_type, i, 0),
+ desc_bound_bitsize (bounds_type, i, 0));
+ modify_general_field (VALUE_CONTENTS (bounds),
+ value_as_long (ada_array_bound (arr, i, 1)),
+ desc_bound_bitpos (bounds_type, i, 1),
+ desc_bound_bitsize (bounds_type, i, 1));
+ }
+
+ bounds = place_on_stack (bounds, sp);
+
+ modify_general_field (VALUE_CONTENTS (descriptor),
+ value_as_pointer (arr),
+ desc_data_bitpos (desc_type),
+ desc_data_bitsize (desc_type));
+ modify_general_field (VALUE_CONTENTS (descriptor),
+ VALUE_ADDRESS (bounds),
+ desc_bounds_bitpos (desc_type),
+ desc_bounds_bitsize (desc_type));
+
+ descriptor = place_on_stack (descriptor, sp);
+
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ return value_addr (descriptor);
+ else
+ return descriptor;
+ }
+
+
+ /* Assuming a dummy frame has been established on the target, perform any
+ conversions needed for calling function FUNC on the NARGS actual
+ parameters in ARGS, other than standard C conversions. Does
+ nothing if FUNC does not have Ada-style prototype data, or if NARGS
+ does not match the number of arguments expected. Use *SP as a
+ stack pointer for additional data that must be pushed, updating its
+ value as needed. */
+
+ void
+ ada_convert_actuals (func, nargs, args, sp)
+ value_ptr func;
+ int nargs;
+ value_ptr args[];
+ CORE_ADDR* sp;
+ {
+ int i;
+
+ if (TYPE_NFIELDS (VALUE_TYPE (func)) == 0
+ || nargs != TYPE_NFIELDS (VALUE_TYPE (func)))
+ return;
+
+ for (i = 0; i < nargs; i += 1)
+ args[i] =
+ convert_actual (args[i], TYPE_FIELD_TYPE (VALUE_TYPE (func), i), sp);
+ }
+
+
+
+ /* The vectors of symbols and blocks ultimately returned from */
+ /* ada_lookup_symbol_list. */
+
+ /* Current size of defn_symbols and defn_blocks */
+ static int defn_vector_size = 0;
+
+ /* Current number of symbols found. */
+ static ndefns = 0;
+
+ static struct symbol** defn_symbols = NULL;
+ static struct block** defn_blocks = NULL;
+
+ /* Non-zero iff there is at least one non-function/non-enumeral symbol */
+ /* in SYMS[0..N-1]. We treat enumerals as functions, since they */
+ /* contend in overloading in the same way. */
+ static int
+ is_nonfunction (syms, n)
+ struct symbol* syms[];
+ int n;
+ {
+ int i;
+
+ for (i = 0; i < n; i += 1)
+ if (TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_FUNC
+ && TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_ENUM)
+ return 1;
+
+ return 0;
+ }
+
+ /* Append SYM to the end of defn_symbols, and BLOCK to the end of */
+ /* defn_blocks, updating ndefns, and expanding defn_symbols and */
+ /* defn_blocks as needed. */
+
+ static void
+ add_defn_to_vec (sym, block)
+ struct symbol* sym;
+ struct block* block;
+ {
+ int i;
+ for (i = 0; i < ndefns; i += 1)
+ if (sym == defn_symbols[i])
+ return;
+
+ if (defn_vector_size <= ndefns+1)
+ {
+ if (defn_vector_size > 0)
+ defn_vector_size *= 2;
+ else
+ defn_vector_size = 8;
+ defn_symbols = (struct symbol**)
+ xrealloc (defn_symbols, defn_vector_size * sizeof (defn_symbols[0]));
+ defn_blocks = (struct block**)
+ xrealloc (defn_blocks, defn_vector_size * sizeof (defn_blocks[0]));
+ }
+
+ defn_symbols[ndefns] = sym;
+ defn_blocks[ndefns] = block;
+ ndefns += 1;
+ }
+
+ /* Look, in partial_symtab PST, for symbol NAME. Check the global
+ symbols if GLOBAL, the static symbols if not */
+
+ static struct partial_symbol *
+ ada_lookup_partial_symbol (pst, name, global, namespace)
+ struct partial_symtab *pst;
+ const char *name;
+ int global;
+ namespace_enum namespace;
+ {
+ struct partial_symbol **start, **psym;
+ struct partial_symbol *top, *bottom, *center;
+ int length = (global ? pst->n_global_syms : pst->n_static_syms);
+
+ if (length == 0)
+ {
+ return (NULL);
+ }
+
+ start = (global ?
+ pst->objfile->global_psymbols.list + pst->globals_offset :
+ pst->objfile->static_psymbols.list + pst->statics_offset );
+
+ for (psym = start; psym < start + length; psym++)
+ {
+ if (namespace == SYMBOL_NAMESPACE (*psym))
+ {
+ /* Beginning in GDB 4.14, partial symbol tables appear not
+ to contain demangled names. I don't know why. */
+ if (SYMBOL_LANGUAGE (*psym) == language_ada
+ && SYMBOL_DEMANGLED_NAME (*psym) == NULL)
+ SYMBOL_INIT_DEMANGLED_NAME (*psym, &pst->objfile->psymbol_obstack);
+
+ if (SYMBOL_MATCHES_NAME (*psym, name))
+ {
+ return (*psym);
+ }
+ }
+ }
+
+ return (NULL);
+ }
+
+ /* Find a symbol table (global or static) containing symbol SYM, or */
+ /* NULL if none. */
+
+ static struct symtab*
+ symtab_for_sym (sym)
+ struct symbol* sym;
+ {
+ struct symtab* s;
+ struct objfile *objfile;
+ struct block *b;
+ int i;
+
+ ALL_SYMTABS (objfile, s)
+ {
+ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
+ for (i = 0; i < BLOCK_NSYMS (b); i += 1)
+ if (sym == BLOCK_SYM (b, i))
+ return s;
+ b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
+ for (i = 0; i < BLOCK_NSYMS (b); i += 1)
+ if (sym == BLOCK_SYM (b, i))
+ return s;
+ }
+
+ return NULL;
+ }
+
+ /* Return non-zero if the SYMBOL_NAME of MSYMBOL, demangled according
+ to GNAT conventions, is a match for NAME. (A minimal symbol's name
+ can be incorrectly demangled due to aliasing between C++ and GNAT
+ mangling conventions.) */
+
+ static int
+ ada_msymbol_matches_name (msymbol, name)
+ struct minimal_symbol* msymbol;
+ const char* name;
+ {
+ if (SYMBOL_LANGUAGE (msymbol) == language_cplus)
+ {
+ char* ada_demangling = ada_demangle (SYMBOL_NAME (msymbol));
+
+ if (ada_demangling != NULL)
+ {
+ int result = ada_match_name (ada_demangling, name);
+
+ free (ada_demangling);
+ return result;
+ }
+ }
+
+ return ada_match_name (SYMBOL_SOURCE_NAME (msymbol), name);
+ }
+
+ /* Return a minimal symbol matching NAME according to Ada demangling
+ rules. Returns NULL if there is no such minimal symbol. */
+
+ struct minimal_symbol*
+ ada_lookup_minimal_symbol (name)
+ const char* name;
+ {
+ struct objfile* objfile;
+ struct minimal_symbol* msymbol;
+
+ ALL_MSYMBOLS (objfile, msymbol)
+ {
+ if (ada_msymbol_matches_name (msymbol, name)
+ && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
+ return msymbol;
+ }
+
+ return NULL;
+ }
+
+ /* Find symbols in NAMESPACE matching NAME, in BLOCK and enclosing
+ scope and in global scopes, returning the number of matches. Sets
+ *SYMS to point to a vector of matching symbols, with *BLOCKS
+ pointing to the vector of corresponding blocks in which those
+ symbols reside. These two vectors are transient---good only to the
+ next call of ada_lookup_symbol_list. Any non-function/non-enumeral symbol
+ match within the nest of blocks whose innermost member is BLOCK,
+ is the outermost match returned (no other matches in that or
+ enclosing blocks is returned). If there are any matches in or
+ surrounding BLOCK, then these alone are returned. */
+
+ /* It seems to me that we ought be able to integrate this with */
+ /* make_symbol_completion_list somehow by generalizing the latter. */
+ /* For now, though, we keep this (semi-redundantly) separate. */
+
+ int
+ ada_lookup_symbol_list (name, block, namespace, syms, blocks)
+ const char *name;
+ struct block *block;
+ namespace_enum namespace;
+ struct symbol*** syms;
+ struct block*** blocks;
+ {
+ struct symbol *sym;
+ struct symtab *s;
+ struct partial_symtab *ps;
+ struct blockvector *bv;
+ struct objfile *objfile;
+ struct block *b;
+ struct minimal_symbol *msymbol;
+
+ int n_nonfuncs;
+
+ ndefns = 0;
+
+ /* Search specified block and its superiors. */
+
+ while (block != 0)
+ {
+ ada_add_block_symbols (block, name, namespace);
+
+ /* If we found a non-function match, assume that's the one. */
+ if (is_nonfunction (defn_symbols, ndefns))
+ goto done;
+
+ block = BLOCK_SUPERBLOCK (block);
+ }
+
+ /* If we found ANY matches in the specified BLOCK, we're done. */
+
+ if (ndefns > 0)
+ goto done;
+
+
+ /* Now add symbols from all global blocks: symbol tables, minimal symbol
+ tables, and psymtab's */
+
+ ALL_SYMTABS (objfile, s)
+ {
+ bv = BLOCKVECTOR (s);
+ block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
+ ada_add_block_symbols (block, name, namespace);
+ }
+
+ if (namespace == VAR_NAMESPACE)
+ {
+ ALL_MSYMBOLS (objfile, msymbol)
+ {
+ if (ada_msymbol_matches_name (msymbol, name))
+ {
+ switch (MSYMBOL_TYPE (msymbol))
+ {
+ case mst_solib_trampoline:
+ break;
+ default:
+ s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol));
+ if (s != NULL)
+ {
+ int old_ndefns = ndefns;
+ bv = BLOCKVECTOR (s);
+ block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
+ ada_add_block_symbols (block,
+ SYMBOL_NAME (msymbol),
+ namespace);
+ if (ndefns == old_ndefns)
+ {
+ block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
+ ada_add_block_symbols (block,
+ SYMBOL_NAME (msymbol),
+ namespace);
+ }
+ }
+ }
+ }
+ }
+ }
+
+ ALL_PSYMTABS (objfile, ps)
+ {
+ if (!ps->readin && ada_lookup_partial_symbol (ps, name, 1, namespace))
+ {
+ s = PSYMTAB_TO_SYMTAB(ps);
+ bv = BLOCKVECTOR (s);
+ block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
+ ada_add_block_symbols (block, name, namespace);
+ }
+ }
+
+ /* Now add symbols from all per-file blocks if we've gotten no hits.
+ (Not strictly correct, but perhaps better than an error).
+ Do the symtabs first, then check the psymtabs */
+
+ if (ndefns == 0)
+ {
+
+ ALL_SYMTABS (objfile, s)
+ {
+ bv = BLOCKVECTOR (s);
+ block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
+ ada_add_block_symbols (block, name, namespace);
+ }
+
+ ALL_PSYMTABS (objfile, ps)
+ {
+ if (!ps->readin
+ && ada_lookup_partial_symbol (ps, name, 0, namespace))
+ {
+ s = PSYMTAB_TO_SYMTAB(ps);
+ bv = BLOCKVECTOR (s);
+ block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
+ ada_add_block_symbols (block, name, namespace);
+ }
+ }
+ }
+
+
+ done:
+ *syms = defn_symbols;
+ *blocks = defn_blocks;
+ return ndefns;
+ }
+
+ /* Add symbols from BLOCK matching identifier NAME in NAMESPACE to
+ vector *BLKSYMS, updating *BLKSYMS (if necessary), *SZ (the size of
+ the vector *BLKSYMS), and *NBLKSYMS (the number of symbols
+ currently stored in *BLKSYMS). */
+
+ static void
+ ada_add_block_symbols (block, name, namespace)
+ struct block* block;
+ const char* name;
+ namespace_enum namespace;
+ {
+ int i;
+ /* A matching argument symbol, if any. */
+ struct symbol *arg_sym;
+ /* Set true when we find a matching non-argument symbol */
+ int found_sym;
+
+ arg_sym = NULL; found_sym = 0;
+ for (i = 0; i < BLOCK_NSYMS (block); i += 1)
+ {
+ struct symbol *sym = BLOCK_SYM (block, i);
+
+ if (SYMBOL_NAMESPACE (sym) == namespace &&
+ SYMBOL_MATCHES_NAME (sym, name))
+ {
+ switch (SYMBOL_CLASS (sym))
+ {
+ case LOC_ARG:
+ case LOC_LOCAL_ARG:
+ case LOC_REF_ARG:
+ case LOC_REGPARM:
+ case LOC_REGPARM_ADDR:
+ case LOC_BASEREG_ARG:
+ arg_sym = sym;
+ break;
+ default:
+ found_sym = 1;
+ fill_in_ada_prototype (sym);
+ add_defn_to_vec (sym, block);
+ break;
+ }
+ }
+ }
+
+ if (! found_sym && arg_sym != NULL)
+ {
+ fill_in_ada_prototype (arg_sym);
+ add_defn_to_vec (arg_sym, block);
+ }
+ }
+
+
+
+ /* Assuming that SYM is the symbol for a function, fill in its type
+ with prototype information, if it is not already there.
+
+ Why is there provision in struct type for BOTH an array of argument
+ types (TYPE_ARG_TYPES) and for an array of typed fields, whose
+ comment suggests it may also represent argument types? I presume
+ this is some attempt to save space. The problem is that argument
+ names in Ada are significant. Therefore, for Ada we use the
+ (apparently older) TYPE_FIELD_* stuff to store argument types. */
+
+
+ static void
+ fill_in_ada_prototype (func)
+ struct symbol* func;
+ {
+ struct block* b;
+ int nargs, nsyms;
+ int i;
+ struct type* ftype;
+ struct type* rtype;
+ int max_fields;
+
+ if (func == NULL
+ || TYPE_CODE (SYMBOL_TYPE (func)) != TYPE_CODE_FUNC
+ || TYPE_FIELDS (SYMBOL_TYPE (func)) != NULL)
+ return;
+
+ /* We make each function type unique, so that each may have its own */
+ /* parameter types. This particular way of doing so wastes space: */
+ /* it would be nicer to build the argument types while the original */
+ /* function type is being built (FIXME). */
+ rtype = TYPE_TARGET_TYPE (SYMBOL_TYPE (func));
+ ftype = alloc_type (TYPE_OBJFILE (SYMBOL_TYPE (func)));
+ make_function_type (rtype, &ftype);
+ SYMBOL_TYPE (func) = ftype;
+
+ b = SYMBOL_BLOCK_VALUE (func);
+ nsyms = BLOCK_NSYMS (b);
+
+ nargs = 0;
+ max_fields = 8;
+ TYPE_FIELDS (ftype) =
+ (struct field*) xmalloc (sizeof (struct field) * max_fields);
+ for (i = 0; i < nsyms; i += 1)
+ {
+ struct symbol *sym = BLOCK_SYM (b, i);
+
+ if (nargs >= max_fields)
+ {
+ max_fields *= 2;
+ TYPE_FIELDS (ftype) = (struct field*)
+ xrealloc (TYPE_FIELDS (ftype), sizeof (struct field) * max_fields);
+ }
+
+ switch (SYMBOL_CLASS (sym))
+ {
+ case LOC_REF_ARG:
+ case LOC_REGPARM_ADDR:
+ TYPE_FIELD_BITPOS (ftype, nargs) = nargs;
+ TYPE_FIELD_BITSIZE (ftype, nargs) = 0;
+ TYPE_FIELD_TYPE (ftype, nargs) =
+ lookup_pointer_type (SYMBOL_TYPE (sym));
+ TYPE_FIELD_NAME (ftype, nargs) = SYMBOL_NAME (sym);
+ nargs += 1;
+
+ break;
+
+ case LOC_ARG:
+ case LOC_REGPARM:
+ case LOC_LOCAL_ARG:
+ case LOC_BASEREG_ARG:
+ TYPE_FIELD_BITPOS (ftype, nargs) = nargs;
+ TYPE_FIELD_BITSIZE (ftype, nargs) = 0;
+ TYPE_FIELD_TYPE (ftype, nargs) = SYMBOL_TYPE (sym);
+ TYPE_FIELD_NAME (ftype, nargs) = SYMBOL_NAME (sym);
+ nargs += 1;
+
+ break;
+
+ default:
+ break;
+ }
+ }
+
+ /* Re-allocate fields vector; if there are no fields, make the */
+ /* fields pointer non-null anyway, to mark that this function type */
+ /* has been filled in. */
+
+ TYPE_NFIELDS (ftype) = nargs;
+ if (nargs == 0)
+ {
+ static struct field dummy_field = {0, 0, 0, 0};
+ free (TYPE_FIELDS (ftype));
+ TYPE_FIELDS (ftype) = &dummy_field;
+ }
+ else
+ {
+ struct field* fields =
+ (struct field*) TYPE_ALLOC (ftype, nargs * sizeof (struct field));
+ memcpy ((char*) fields,
+ (char*) TYPE_FIELDS (ftype),
+ nargs * sizeof (struct field));
+ free (TYPE_FIELDS (ftype));
+ TYPE_FIELDS (ftype) = fields;
+ }
+ }
+
+
+ /* Breakpoint-related */
+
+ /* Return all symbol table/line pairs of functions matching NAME'
+ starting in BLOCK (plus all global blocks if BLOCK == NULL or NAME
+ is not found in BLOCK), after selection by the user, if needed.
+ NAME' is a "canonical function name" consisting of NAME if
+ PREFERRED_LINE is -1, or NAME:PREFERRED_LINE otherwise. Returns
+ with 0 elements if no matching non-minimal symbols to NAME found.
+ FUNFIRSTLINE is non-zero if we desire the first line of real code
+ in each function. If CANONICAL is non-NULL, *CANONICAL is set to
+ an array of pointers to canonical function names (see above)
+ corresponding to the entries in the returned value. Error if user
+ cancels the selection. */
+
+ struct symtabs_and_lines
+ ada_finish_decode_line_1 (name, preferred_line, funfirstline, block, canonical)
+ const char* name;
+ int preferred_line;
+ int funfirstline;
+ struct block* block;
+ char*** canonical;
+ {
+ struct symbol** symbols;
+ struct block** blocks;
+ int n_matches, i;
+ struct symtabs_and_lines selected;
+ struct cleanup* old_chain = make_cleanup (null_cleanup, NULL);
+
+ n_matches = ada_lookup_symbol_list (name, block, VAR_NAMESPACE,
+ &symbols, &blocks);
+ if (n_matches == 0)
+ {
+ selected.nelts = 0;
+ return selected;
+ }
+
+ if (preferred_line >= 0)
+ selected.nelts = n_matches;
+ else
+ {
+ selected.nelts = user_select_syms (symbols, blocks, n_matches, n_matches);
+ }
+
+ selected.sals = (struct symtab_and_line*)
+ xmalloc (sizeof (struct symtab_and_line) * selected.nelts);
+ memset (selected.sals, 0, selected.nelts * sizeof (selected.sals[i]));
+ make_cleanup (free, selected.sals);
+
+ i = 0;
+ while (i < selected.nelts)
+ {
+ if (SYMBOL_CLASS (symbols[i]) == LOC_BLOCK)
+ selected.sals[i] = find_function_start_sal (symbols[i], funfirstline);
+ else if (SYMBOL_LINE (symbols[i]) != 0)
+ {
+ selected.sals[i].symtab = symtab_for_sym (symbols[i]);
+ selected.sals[i].line = SYMBOL_LINE (symbols[i]);
+ }
+ else if (preferred_line >= 0)
+ {
+ /* Ignore this choice */
+ symbols[i] = symbols[selected.nelts-1];
+ blocks[i] = blocks[selected.nelts-1];
+ selected.nelts -= 1;
+ continue;
+ }
+ else
+ error ("Line number not known for symbol \"%s\"", name);
+ i += 1;
+ }
+
+ if (preferred_line >= 0)
+ {
+ selected.nelts = 1;
+ selected.sals[0] =
+ selected.sals[nearest_to_line (selected, preferred_line)];
+ }
+
+ if (canonical != NULL && (preferred_line >= 0 || n_matches > 1))
+ {
+ *canonical = (char**) xmalloc (sizeof(char*) * selected.nelts);
+ for (i = 0; i < selected.nelts; i += 1)
+ (*canonical)[i] =
+ extended_canonical_line_spec (selected.sals[i],
+ SYMBOL_SOURCE_NAME (symbols[i]));
+ }
+
+ discard_cleanups (old_chain);
+ return selected;
+ }
+
+ /* The index of the symtab_and_line in SYMS_AND_LINES that is closest
+ to PREFERRED_LINE, with ties broken in favor of lower PC. */
+
+ static int
+ nearest_to_line (syms_and_lines, preferred_line)
+ struct symtabs_and_lines syms_and_lines;
+ int preferred_line;
+ {
+ int i, r;
+ r = 0;
+ for (i = 1; i < syms_and_lines.nelts; i += 1)
+ {
+ if (abs (syms_and_lines.sals[r].line - preferred_line) >
+ abs (syms_and_lines.sals[i].line - preferred_line)
+ || (abs (syms_and_lines.sals[r].line - preferred_line) ==
+ abs (syms_and_lines.sals[i].line - preferred_line)
+ && syms_and_lines.sals[r].pc > syms_and_lines.sals[i].pc))
+ r = i;
+ }
+ return r;
+ }
+
+ /* A canonical line specification of the form FILE:NAME:LINENUM for
+ symbol table and line data SAL. NULL if insufficient
+ information. The caller is responsible for releasing any space
+ allocated. */
+
+ static char*
+ extended_canonical_line_spec (sal, name)
+ struct symtab_and_line sal;
+ const char* name;
+ {
+ char* r;
+
+ if (sal.symtab == NULL || sal.symtab->filename == NULL ||
+ sal.line <= 0)
+ return NULL;
+
+ r = (char*) xmalloc (strlen (name) + strlen (sal.symtab->filename)
+ + sizeof(sal.line)*3 + 3);
+ sprintf (r, "%s:'%s':%d", sal.symtab->filename, name, sal.line);
+ return r;
+ }
+
+
+
+ /* Table mapping opcodes into strings for printing operators
+ and precedences of the operators. */
+
+ static const struct op_print ada_op_print_tab[] =
+ {
+ {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
+ {"or else", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
+ {"and then", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
+ {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
+ {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
+ {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
+ {"=", BINOP_EQUAL, PREC_EQUAL, 0},
+ {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
+ {"<=", BINOP_LEQ, PREC_ORDER, 0},
+ {">=", BINOP_GEQ, PREC_ORDER, 0},
+ {">", BINOP_GTR, PREC_ORDER, 0},
+ {"<", BINOP_LESS, PREC_ORDER, 0},
+ {">>", BINOP_RSH, PREC_SHIFT, 0},
+ {"<<", BINOP_LSH, PREC_SHIFT, 0},
+ {"+", BINOP_ADD, PREC_ADD, 0},
+ {"-", BINOP_SUB, PREC_ADD, 0},
+ {"&", BINOP_CONCAT, PREC_ADD, 0},
+ {"*", BINOP_MUL, PREC_MUL, 0},
+ {"/", BINOP_DIV, PREC_MUL, 0},
+ {"rem", BINOP_REM, PREC_MUL, 0},
+ {"mod", BINOP_MOD, PREC_MUL, 0},
+ {"**", BINOP_EXP, PREC_REPEAT, 0 },
+ {"@", BINOP_REPEAT, PREC_REPEAT, 0},
+ {"-", UNOP_NEG, PREC_PREFIX, 0},
+ {"+", UNOP_PLUS, PREC_PREFIX, 0},
+ {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
+ {"not", UNOP_COMPLEMENT, PREC_PREFIX, 0},
+ {"*", UNOP_IND, PREC_PREFIX, 0}, /* FIXME: postfix .ALL */
+ {"&", UNOP_ADDR, PREC_PREFIX, 0}, /* FIXME: postfix 'ACCESS */
+ {NULL, 0, 0, 0}
+ };
+
+
+ struct type* builtin_type_ada_int;
+ struct type* builtin_type_ada_short;
+ struct type* builtin_type_ada_long;
+ struct type* builtin_type_ada_long_long;
+ struct type* builtin_type_ada_char;
+ struct type* builtin_type_ada_float;
+ struct type* builtin_type_ada_double;
+ struct type* builtin_type_ada_long_double;
+ struct type* builtin_type_ada_natural;
+ struct type* builtin_type_ada_positive;
+
+ struct type ** const (ada_builtin_types[]) =
+ {
+
+ &builtin_type_ada_int,
+ &builtin_type_ada_long,
+ &builtin_type_ada_short,
+ &builtin_type_ada_char,
+ &builtin_type_ada_float,
+ &builtin_type_ada_double,
+ &builtin_type_ada_long_long,
+ &builtin_type_ada_long_double,
+ &builtin_type_ada_natural,
+ &builtin_type_ada_positive,
+
+ /* The following types are carried over from C for convenience. */
+ &builtin_type_int,
+ &builtin_type_long,
+ &builtin_type_short,
+ &builtin_type_char,
+ &builtin_type_float,
+ &builtin_type_double,
+ &builtin_type_long_long,
+ &builtin_type_void,
+ &builtin_type_signed_char,
+ &builtin_type_unsigned_char,
+ &builtin_type_unsigned_short,
+ &builtin_type_unsigned_int,
+ &builtin_type_unsigned_long,
+ &builtin_type_unsigned_long_long,
+ &builtin_type_long_double,
+ &builtin_type_complex,
+ &builtin_type_double_complex,
+ 0
+ };
+
+ const struct language_defn ada_language_defn = {
+ "ada", /* Language name */
+ language_ada,
+ ada_builtin_types,
+ range_check_off,
+ type_check_off,
+ ada_parse,
+ ada_error,
+ evaluate_subexp_standard,
+ ada_printchar, /* Print a character constant */
+ ada_printstr, /* Function to print string constant */
+ ada_create_fundamental_type, /* Create fundamental type in this language */
+ ada_print_type, /* Print a type using appropriate syntax */
+ ada_val_print, /* Print a value using appropriate syntax */
+ ada_value_print, /* Print a top-level value */
+ {"", "", "", ""}, /* Binary format info */
+ #if 0
+ {"8#%lo#", "8#", "o", "#"}, /* Octal format info */
+ {"%ld", "", "d", ""}, /* Decimal format info */
+ {"16#%lx#", "16#", "x", "#"}, /* Hex format info */
+ #else
+ /* Copied from c-lang.c. */
+ {"0%lo", "0", "o", ""}, /* Octal format info */
+ {"%ld", "", "d", ""}, /* Decimal format info */
+ {"0x%lx", "0x", "x", ""}, /* Hex format info */
+ #endif
+ ada_op_print_tab, /* expression operators for printing */
+ 1, /* c-style arrays (FIXME?) */
+ 0, /* String lower bound (FIXME?) */
+ &builtin_type_char,
+ LANG_MAGIC
+ };
+
+ void
+ _initialize_ada_language ()
+ {
+ builtin_type_ada_int =
+ init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 0,
+ "integer", (struct objfile *) NULL);
+ builtin_type_ada_long =
+ init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
+ 0,
+ "long_integer", (struct objfile *) NULL);
+ builtin_type_ada_short =
+ init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+ 0,
+ "short_integer", (struct objfile *) NULL);
+ builtin_type_ada_char =
+ init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+ 0,
+ "character", (struct objfile *) NULL);
+ builtin_type_ada_float =
+ init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
+ 0,
+ "float", (struct objfile *) NULL);
+ builtin_type_ada_double =
+ init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
+ 0,
+ "long_float", (struct objfile *) NULL);
+ builtin_type_ada_long_long =
+ init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+ 0,
+ "long_long_integer", (struct objfile *) NULL);
+ builtin_type_ada_long_double =
+ init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
+ 0,
+ "long_long_float", (struct objfile *) NULL);
+ builtin_type_ada_natural =
+ init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 0,
+ "natural", (struct objfile *) NULL);
+ builtin_type_ada_positive =
+ init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
+ 0,
+ "positive", (struct objfile *) NULL);
+
+ add_language (&ada_language_defn);
+ }
diff -c -r -N gdb-4.16/gdb/ada-lang.h gdb/ada-lang.h
*** gdb-4.16/gdb/ada-lang.h
--- gdb-4.16.orig/gdb/ada-lang.h Sun Mar 23 16:56:37 1997
***************
*** 0 ****
--- 1,189 ----
+ /* C language support definitions for GDB, the GNU debugger.
+ Copyright 1992 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ #ifdef __STDC__ /* Forward decls for prototypes */
+ struct value;
+ #endif
+
+ #if !defined (ADA_LANG_H)
+ #define ADA_LANG_H 1
+
+ #include "value.h"
+ #include "gdbtypes.h"
+
+ /* Chain of cleanups for arguments of OP_UNRESOLVED_VALUE names. Created in
+ yyparse and freed in ada_resolve. */
+ extern struct cleanup* unresolved_names;
+
+ /* Corresponding mangled/demangled names and opcodes for Ada user-definable
+ operators. */
+ struct ada_opname_map {
+ const char* mangled;
+ const char* demangled;
+ enum exp_opcode op;
+ };
+
+ /* Table of Ada operators in mangled and demangled forms. */
+ /* Defined in ada-lang.c */
+ extern const struct ada_opname_map ada_opname_table[];
+
+ /* Discriminated types */
+
+ /* A dynamic type (type code TYPE_CODE_DYNAMIC) is a structure or array type
+ whose instances have structures that depend on run-time quantities,
+ including local or static variables and other fields of the instance.
+ For example, a record might contain a field that supplies the upper bound
+ of another field of the record that has an array type. As another
+ example, the upper bound of an array might depend on a local
+ variable.
+
+ For such a type, the macro TYPE_DYNAMIC_TEMPLATE yields a struct or
+ array type indicating the fields of actual instances. Typically,
+ some of the array types in this type have bounds that will
+ eventually be overridden. The size of the TYPE_DYNAMIC_TYPE is
+ therefore meaningless.
+
+ The macro TYPE_DYNAMIC_NFIELDS gives the number of quantities in the
+ dynamic type that are to be overridden with dynamic information.
+ For each k, 0 <= k < TYPE_DYNAMIC_NFIELDS(T), the macros
+ TYPE_DYNAMIC_FIELD(T,k) gives the identifier (see below) of the kth quantity
+ in type TYPE_DYNAMIC_TEMPLATE(T) that is supplied by run-time data,
+ and TYPE_DYNAMIC_SOURCE(T, k) identifies the source of this data.
+
+ TYPE_DYNAMIC_SOURCE(T, k) is a C string. It may have the form
+ "*.NAME", in which case NAME must be the name of a field in
+ TYPE_DYNAMIC_TEMPLATE(T) that that is at a fixed location in all
+ objects of type T. Other values of TYPE_DYNAMIC_SOURCE(T, k)
+ denote variables resolved in the context of the object possessing
+ type T.
+
+ TYPE_DYNAMIC_FIELD(T, k) is a C string. It has the form
+ F1.F2...Fn, denoting a "field" of TYPE_DYNAMIC_TEMPLATE(T) that is
+ overridden in each instance of the type. Here, the term "field"
+ refers both to ordinary fields (members) of a struct, but also to a
+ set of notional fields of array objects and union objects.
+ Specifically, array objects are treated as if they have fields LB0,
+ UB0, LB1, UB1, etc., corresponding to bounds: LB0..UB0 for the
+ first bound, LB1..UB1 for the second, etc. Union types are treated
+ as if they had a field TAG indicating which branch of the union
+ currently applied (see further below). If any of the Fi in
+ TYPE_DYNAMIC_FIELD(T, k) denote a field with a pointer type, it is
+ the pointed-to object that is referred to.
+
+ Fields of TYPE_DYNAMIC_TEMPLATE(T) that have union types may
+ be "tagged" by dynamic quantities, as described above. Such union
+ objects should have member names that encode ranges of integers
+ (FIXME: Fill this in). If U is the (union) type of such a field,
+ then union_field_selected_by(U, m) gives the ordinal number of the
+ field of U indicated by the integer tag value m.
+
+ No value_ptr should ever have a TYPE_CODE_DYNAMIC code. Instead,
+ whenever a value is formed by fetching a variable of a dynamic
+ type, T, or dereferencing a T*, a new type is constructed on the
+ fly from the value being fetched that is a modified instance of
+ TYPE_DYNAMIC_TEMPLATE(T). */
+
+
+ #define TYPE_DYNAMIC_TEMPLATE(thistype) TYPE_TARGET_TYPE(thistype)
+ #define TYPE_DYNAMIC_FIELD(thistype,k) TYPE_FIELD(thistype, 2*(k)).name
+ #define TYPE_DYNAMIC_SOURCE(thistype,k) TYPE_FIELD(thistype, 2*(k)+1).name
+
+ extern int
+ ada_parse PARAMS ((void)); /* Defined in ada-exp.y */
+
+ extern void
+ ada_error PARAMS ((char *)); /* Defined in ada-exp.y */
+
+ extern void /* Defined in ada-typeprint.c */
+ ada_print_type PARAMS ((struct type*, char*, GDB_FILE*, int, int));
+
+ extern int
+ ada_val_print PARAMS ((struct type*, char*, CORE_ADDR, GDB_FILE*, int, int,
+ int, enum val_prettyprint));
+
+ extern int
+ ada_value_print PARAMS ((struct value*, GDB_FILE*, int, enum val_prettyprint));
+
+
+ /* Defined in ada-lang.c */
+
+
+ extern void
+ ada_convert_actuals PARAMS ((value_ptr, int, value_ptr*, CORE_ADDR*));
+
+ extern value_ptr
+ ada_value_subscript PARAMS ((value_ptr, int, value_ptr*));
+
+ extern struct type*
+ ada_array_element_type PARAMS ((struct type*));
+
+ extern int
+ ada_array_arity PARAMS ((struct type*));
+
+ struct type*
+ ada_type_of_array PARAMS ((value_ptr, int));
+
+ extern value_ptr
+ ada_coerce_to_simple_array PARAMS ((value_ptr));
+
+ extern value_ptr
+ ada_coerce_to_simple_array_ptr PARAMS ((value_ptr));
+
+ extern int
+ ada_is_simple_array PARAMS ((struct type*));
+
+ extern int
+ ada_is_array_descriptor PARAMS ((struct type*));
+
+ extern struct type*
+ ada_index_type PARAMS ((struct type*, int));
+
+ extern value_ptr
+ ada_array_bound PARAMS ((value_ptr, int, int));
+
+ extern int
+ ada_lookup_symbol_list PARAMS ((const char*, struct block*, namespace_enum,
+ struct symbol***, struct block***));
+
+ extern struct minimal_symbol*
+ ada_lookup_minimal_symbol PARAMS ((const char*));
+
+ extern void
+ ada_resolve PARAMS ((struct expression**));
+
+ extern int
+ ada_resolve_function PARAMS ((struct symbol**, struct block**, int,
+ value_ptr*, int, const char*));
+
+ extern void
+ ada_fill_in_ada_prototype PARAMS ((struct symbol*));
+
+ extern int
+ user_select_syms PARAMS ((struct symbol**, struct block**, int, int));
+
+ extern struct symtabs_and_lines
+ ada_finish_decode_line_1 PARAMS ((const char*, int, int,
+ struct block*, char***));
+
+ /* In eval.c */
+ extern value_ptr
+ evaluate_subexp_type PARAMS ((struct expression*, int*));
+
+ #endif
+
diff -c -r -N gdb-4.16/gdb/ada-lex.c gdb/ada-lex.c
*** gdb-4.16/gdb/ada-lex.c
--- gdb-4.16.orig/gdb/ada-lex.c Tue Mar 25 16:31:36 1997
***************
*** 0 ****
--- 1,2273 ----
+ /* A lexical scanner generated by flex */
+
+ /* Scanner skeleton version:
+ * $Header: /usr5/users/hilfingr/gdb/ada-gdb/ada-gdb-4.14/gdb/ada-src/RCS/ada-lex.c,v 1.1 1995/11/29 11:03:43 hilfingr Exp $
+ */
+
+ #define FLEX_SCANNER
+ #define YY_FLEX_MAJOR_VERSION 2
+ #define YY_FLEX_MINOR_VERSION 5
+
+ #include <stdio.h>
+
+
+ /* cfront 1.2 defines "c_plusplus" instead of "__cplusplus" */
+ #ifdef c_plusplus
+ #ifndef __cplusplus
+ #define __cplusplus
+ #endif
+ #endif
+
+
+ #ifdef __cplusplus
+
+ #include <stdlib.h>
+ #include <unistd.h>
+
+ /* Use prototypes in function declarations. */
+ #define YY_USE_PROTOS
+
+ /* The "const" storage-class-modifier is valid. */
+ #define YY_USE_CONST
+
+ #else /* ! __cplusplus */
+
+ #if __STDC__
+
+ #define YY_USE_PROTOS
+ #define YY_USE_CONST
+
+ #endif /* __STDC__ */
+ #endif /* ! __cplusplus */
+
+ #ifdef __TURBOC__
+ #pragma warn -rch
+ #pragma warn -use
+ #include <io.h>
+ #include <stdlib.h>
+ #define YY_USE_CONST
+ #define YY_USE_PROTOS
+ #endif
+
+ #ifdef YY_USE_CONST
+ #define yyconst const
+ #else
+ #define yyconst
+ #endif
+
+
+ #ifdef YY_USE_PROTOS
+ #define YY_PROTO(proto) proto
+ #else
+ #define YY_PROTO(proto) ()
+ #endif
+
+ /* Returned upon end-of-file. */
+ #define YY_NULL 0
+
+ /* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+ #define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+ /* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+ #define BEGIN yy_start = 1 + 2 *
+
+ /* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+ #define YY_START ((yy_start - 1) / 2)
+ #define YYSTATE YY_START
+
+ /* Action number for EOF rule of a given start state. */
+ #define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+ /* Special action meaning "start processing a new file". */
+ #define YY_NEW_FILE yyrestart( yyin )
+
+ #define YY_END_OF_BUFFER_CHAR 0
+
+ /* Size of default input buffer. */
+ #define YY_BUF_SIZE 16384
+
+ typedef struct yy_buffer_state *YY_BUFFER_STATE;
+
+ extern int yyleng;
+ extern FILE *yyin, *yyout;
+
+ #define EOB_ACT_CONTINUE_SCAN 0
+ #define EOB_ACT_END_OF_FILE 1
+ #define EOB_ACT_LAST_MATCH 2
+
+ /* The funky do-while in the following #define is used to turn the definition
+ * int a single C statement (which needs a semi-colon terminator). This
+ * avoids problems with code like:
+ *
+ * if ( condition_holds )
+ * yyless( 5 );
+ * else
+ * do_something_else();
+ *
+ * Prior to using the do-while the compiler would get upset at the
+ * "else" because it interpreted the "if" statement as being all
+ * done when it reached the ';' after the yyless() call.
+ */
+
+ /* Return all but the first 'n' matched characters back to the input stream. */
+
+ #define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ *yy_cp = yy_hold_char; \
+ yy_c_buf_p = yy_cp = yy_bp + n - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+
+ #define unput(c) yyunput( c, yytext_ptr )
+
+ /* The following is because we cannot portably get our hands on size_t
+ * (without autoconf's help, which isn't available because we want
+ * flex-generated scanners to compile on their own).
+ */
+ typedef unsigned int yy_size_t;
+
+
+ struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ yy_size_t yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+ #define YY_BUFFER_NEW 0
+ #define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+ #define YY_BUFFER_EOF_PENDING 2
+ };
+
+ static YY_BUFFER_STATE yy_current_buffer = 0;
+
+ /* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ */
+ #define YY_CURRENT_BUFFER yy_current_buffer
+
+
+ /* yy_hold_char holds the character lost when yytext is formed. */
+ static char yy_hold_char;
+
+ static int yy_n_chars; /* number of characters read into yy_ch_buf */
+
+
+ int yyleng;
+
+ /* Points to current character in buffer. */
+ static char *yy_c_buf_p = (char *) 0;
+ static int yy_init = 1; /* whether we need to initialize */
+ static int yy_start = 0; /* start state number */
+
+ /* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+ static int yy_did_buffer_switch_on_eof;
+
+ void yyrestart YY_PROTO(( FILE *input_file ));
+
+ void yy_switch_to_buffer YY_PROTO(( YY_BUFFER_STATE new_buffer ));
+ void yy_load_buffer_state YY_PROTO(( void ));
+ YY_BUFFER_STATE yy_create_buffer YY_PROTO(( FILE *file, int size ));
+ void yy_delete_buffer YY_PROTO(( YY_BUFFER_STATE b ));
+ void yy_init_buffer YY_PROTO(( YY_BUFFER_STATE b, FILE *file ));
+ void yy_flush_buffer YY_PROTO(( YY_BUFFER_STATE b ));
+ #define YY_FLUSH_BUFFER yy_flush_buffer( yy_current_buffer )
+
+ YY_BUFFER_STATE yy_scan_buffer YY_PROTO(( char *base, yy_size_t size ));
+ YY_BUFFER_STATE yy_scan_string YY_PROTO(( yyconst char *str ));
+ YY_BUFFER_STATE yy_scan_bytes YY_PROTO(( yyconst char *bytes, int len ));
+
+ static void *yy_flex_alloc YY_PROTO(( yy_size_t ));
+ static void *yy_flex_realloc YY_PROTO(( void *, yy_size_t ));
+ static void yy_flex_free YY_PROTO(( void * ));
+
+ #define yy_new_buffer yy_create_buffer
+
+ #define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! yy_current_buffer ) \
+ yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
+ yy_current_buffer->yy_is_interactive = is_interactive; \
+ }
+
+ #define yy_set_bol(at_bol) \
+ { \
+ if ( ! yy_current_buffer ) \
+ yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE ); \
+ yy_current_buffer->yy_at_bol = at_bol; \
+ }
+
+ #define YY_AT_BOL() (yy_current_buffer->yy_at_bol)
+
+
+ #define YY_USES_REJECT
+ typedef unsigned char YY_CHAR;
+ FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+ typedef int yy_state_type;
+ extern char *yytext;
+ #define yytext_ptr yytext
+
+ static yy_state_type yy_get_previous_state YY_PROTO(( void ));
+ static yy_state_type yy_try_NUL_trans YY_PROTO(( yy_state_type current_state ));
+ static int yy_get_next_buffer YY_PROTO(( void ));
+ static void yy_fatal_error YY_PROTO(( yyconst char msg[] ));
+
+ /* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+ #define YY_DO_BEFORE_ACTION \
+ yytext_ptr = yy_bp; \
+ yyleng = (int) (yy_cp - yy_bp); \
+ yy_hold_char = *yy_cp; \
+ *yy_cp = '\0'; \
+ yy_c_buf_p = yy_cp;
+
+ #define YY_NUM_RULES 55
+ #define YY_END_OF_BUFFER 56
+ static yyconst short int yy_acclist[204] =
+ { 0,
+ 56, 54, 55, 1, 54, 55, 1, 55, 54, 55,
+ 51, 54, 55, 41, 54, 55, 41, 54, 55, 43,
+ 54, 55, 44, 54, 55, 41, 54, 55, 42, 54,
+ 55, 41, 54, 55, 41, 54, 55, 41, 54, 55,
+ 4, 54, 55, 4, 54, 55, 41, 54, 55, 41,
+ 54, 55, 41, 54, 55, 41, 54, 55, 48, 54,
+ 55, 45, 54, 55, 45, 54, 55, 45, 54, 55,
+ 45, 54, 55, 45, 54, 55, 45, 54, 55, 45,
+ 54, 55, 45, 54, 55, 45, 54, 55, 45, 54,
+ 55, 14, 49, 53, 52, 53, 53, 33, 33, 33,
+
+ 33, 33, 36, 2, 35, 38, 4, 47, 37, 39,
+ 34, 40, 45, 45, 45, 45, 45, 15, 45, 20,
+ 45, 45, 45, 45, 45, 25, 45, 45, 45, 45,
+ 50, 53,16430, 33, 33, 33, 33, 33, 13,16430,
+ 13, 33, 33, 33, 33, 33, 2, 9, 3, 7,
+ 16, 45, 17, 45, 18, 45, 45, 21, 45, 22,
+ 45, 23, 45, 45, 26, 45, 45, 28, 45, 33,
+ 33, 33, 33, 12, 6, 9, 3, 19, 45, 24,
+ 45, 27, 45, 8238, 33, 33, 31, 33, 33, 33,
+ 30, 33, 32, 33, 5, 11, 8, 29, 33, 5,
+
+ 8, 10, 10
+ } ;
+
+ static yyconst short int yy_accept[154] =
+ { 0,
+ 1, 1, 1, 2, 4, 7, 9, 11, 14, 17,
+ 20, 23, 26, 29, 32, 35, 38, 41, 44, 47,
+ 50, 53, 56, 59, 62, 65, 68, 71, 74, 77,
+ 80, 83, 86, 89, 92, 92, 93, 95, 97, 98,
+ 98, 98, 98, 98, 98, 99, 100, 101, 102, 103,
+ 104, 105, 105, 105, 106, 107, 107, 107, 108, 108,
+ 108, 109, 110, 111, 112, 113, 114, 115, 116, 117,
+ 118, 120, 122, 123, 124, 125, 126, 128, 129, 130,
+ 131, 133, 134, 135, 136, 137, 138, 139, 141, 142,
+ 143, 144, 145, 146, 147, 148, 148, 148, 149, 149,
+
+ 150, 151, 153, 155, 157, 158, 160, 162, 164, 165,
+ 167, 168, 170, 170, 170, 171, 172, 173, 174, 175,
+ 176, 176, 176, 177, 177, 178, 180, 182, 184, 185,
+ 186, 187, 189, 190, 190, 190, 190, 191, 193, 195,
+ 195, 196, 197, 197, 198, 200, 201, 201, 202, 202,
+ 203, 204, 204
+ } ;
+
+ static yyconst int yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 4, 5, 6, 7, 8, 5, 9, 10, 11,
+ 12, 13, 14, 15, 16, 17, 18, 19, 20, 20,
+ 20, 20, 20, 20, 20, 20, 20, 21, 9, 22,
+ 23, 24, 5, 25, 27, 28, 29, 30, 31, 32,
+ 33, 34, 35, 36, 36, 37, 38, 39, 40, 36,
+ 36, 41, 42, 43, 44, 36, 45, 46, 36, 36,
+ 9, 5, 9, 5, 26, 5, 27, 28, 29, 30,
+
+ 31, 32, 33, 34, 35, 36, 36, 37, 38, 39,
+ 40, 36, 36, 41, 42, 43, 44, 36, 45, 46,
+ 36, 36, 25, 9, 25, 5, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+ static yyconst int yy_meta[47] =
+ { 0,
+ 1, 1, 2, 3, 3, 3, 4, 5, 3, 6,
+ 3, 3, 3, 3, 3, 3, 7, 3, 8, 8,
+ 3, 3, 3, 3, 3, 9, 8, 8, 8, 8,
+ 8, 8, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10
+ } ;
+
+ static yyconst short int yy_base[164] =
+ { 0,
+ 0, 0, 433, 434, 434, 434, 426, 39, 434, 59,
+ 434, 434, 418, 434, 414, 104, 406, 115, 111, 27,
+ 405, 403, 403, 434, 0, 87, 388, 17, 384, 79,
+ 382, 391, 387, 380, 413, 434, 32, 34, 0, 408,
+ 161, 407, 406, 405, 207, 385, 378, 385, 384, 434,
+ 0, 141, 0, 434, 434, 0, 92, 247, 119, 0,
+ 434, 434, 434, 434, 434, 0, 368, 372, 378, 365,
+ 0, 0, 376, 358, 359, 364, 0, 358, 364, 348,
+ 97, 253, 365, 119, 115, 126, 130, 256, 434, 347,
+ 251, 117, 110, 252, 0, 346, 142, 250, 135, 263,
+
+ 0, 0, 0, 0, 314, 0, 0, 0, 307, 0,
+ 304, 0, 282, 320, 261, 253, 255, 269, 434, 306,
+ 0, 280, 274, 41, 287, 0, 0, 0, 434, 262,
+ 258, 316, 265, 295, 305, 291, 278, 298, 289, 297,
+ 299, 259, 153, 302, 146, 304, 313, 312, 314, 316,
+ 320, 434, 344, 350, 353, 363, 373, 383, 139, 105,
+ 390, 101, 396
+ } ;
+
+ static yyconst short int yy_def[164] =
+ { 0,
+ 152, 1, 152, 152, 152, 152, 153, 154, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 155, 155, 155, 155, 155, 155,
+ 155, 155, 155, 155, 153, 152, 154, 154, 154, 156,
+ 152, 41, 156, 152, 152, 45, 45, 45, 45, 152,
+ 157, 152, 158, 152, 152, 159, 152, 152, 152, 160,
+ 152, 152, 152, 152, 152, 155, 155, 155, 155, 155,
+ 155, 155, 155, 155, 155, 155, 155, 155, 155, 155,
+ 154, 152, 45, 45, 45, 45, 45, 152, 152, 45,
+ 45, 45, 45, 45, 157, 158, 161, 152, 152, 152,
+
+ 160, 155, 155, 155, 155, 155, 155, 155, 155, 155,
+ 155, 155, 152, 152, 45, 45, 45, 45, 152, 152,
+ 162, 161, 152, 152, 152, 155, 155, 155, 152, 45,
+ 45, 45, 45, 152, 163, 152, 45, 45, 45, 152,
+ 152, 152, 163, 152, 45, 152, 152, 152, 152, 152,
+ 152, 0, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152
+ } ;
+
+ static yyconst short int yy_nxt[481] =
+ { 0,
+ 4, 5, 6, 5, 4, 7, 4, 8, 9, 10,
+ 11, 12, 13, 9, 14, 15, 16, 17, 18, 19,
+ 20, 21, 22, 23, 24, 25, 26, 25, 25, 25,
+ 27, 25, 25, 25, 28, 25, 25, 29, 30, 31,
+ 32, 25, 33, 25, 25, 34, 37, 61, 71, 62,
+ 81, 81, 38, 38, 136, 72, 136, 38, 38, 40,
+ 41, 41, 42, 43, 43, 43, 43, 43, 44, 43,
+ 43, 43, 43, 43, 43, 43, 43, 43, 43, 43,
+ 43, 43, 43, 43, 45, 46, 45, 45, 45, 45,
+ 47, 45, 45, 45, 45, 48, 45, 45, 45, 49,
+
+ 45, 45, 45, 45, 45, 52, 52, 52, 135, 74,
+ 98, 98, 101, 53, 67, 81, 81, 56, 75, 82,
+ 54, 56, 76, 68, 82, 69, 82, 57, 82, 58,
+ 58, 57, 99, 58, 58, 82, 58, 100, 100, 82,
+ 58, 59, 52, 52, 52, 59, 97, 91, 120, 92,
+ 53, 117, 93, 100, 100, 82, 94, 116, 121, 142,
+ 60, 40, 41, 41, 41, 40, 40, 40, 40, 40,
+ 82, 40, 40, 40, 40, 40, 40, 40, 40, 40,
+ 40, 40, 40, 40, 40, 40, 83, 84, 83, 83,
+ 83, 83, 85, 83, 83, 83, 83, 86, 83, 83,
+
+ 83, 87, 83, 83, 83, 83, 83, 40, 40, 40,
+ 40, 40, 40, 40, 40, 40, 88, 40, 40, 40,
+ 40, 40, 40, 40, 40, 90, 90, 40, 40, 40,
+ 40, 40, 90, 90, 90, 90, 90, 90, 90, 90,
+ 90, 90, 90, 90, 90, 90, 90, 90, 90, 90,
+ 90, 90, 90, 56, 113, 113, 113, 113, 113, 113,
+ 82, 82, 82, 57, 82, 58, 58, 82, 123, 123,
+ 82, 82, 58, 114, 82, 123, 114, 59, 82, 115,
+ 124, 125, 125, 113, 113, 113, 120, 82, 125, 147,
+ 118, 130, 123, 123, 131, 139, 121, 132, 82, 123,
+
+ 138, 133, 114, 137, 124, 125, 125, 82, 140, 144,
+ 144, 142, 125, 141, 141, 141, 141, 146, 146, 145,
+ 148, 148, 146, 146, 146, 82, 149, 148, 149, 146,
+ 148, 148, 150, 150, 151, 151, 134, 148, 151, 151,
+ 129, 151, 128, 127, 126, 151, 35, 35, 35, 35,
+ 35, 35, 35, 35, 39, 119, 82, 39, 39, 39,
+ 66, 66, 66, 40, 40, 40, 40, 40, 40, 40,
+ 40, 40, 40, 95, 82, 95, 95, 95, 95, 95,
+ 95, 95, 95, 96, 96, 96, 96, 96, 112, 96,
+ 96, 96, 96, 122, 111, 110, 122, 122, 122, 143,
+
+ 109, 108, 107, 143, 143, 106, 105, 104, 103, 102,
+ 94, 93, 92, 91, 89, 88, 88, 82, 36, 80,
+ 79, 78, 77, 73, 70, 65, 64, 63, 55, 51,
+ 50, 36, 152, 3, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152
+ } ;
+
+ static yyconst short int yy_chk[481] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 8, 20, 28, 20,
+ 37, 37, 38, 38, 124, 28, 124, 8, 8, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+
+ 10, 10, 10, 10, 10, 16, 16, 16, 162, 30,
+ 57, 57, 160, 16, 26, 81, 81, 19, 30, 93,
+ 16, 18, 30, 26, 85, 26, 92, 19, 84, 19,
+ 19, 18, 59, 18, 18, 86, 19, 59, 59, 87,
+ 18, 19, 52, 52, 52, 18, 159, 84, 97, 85,
+ 52, 93, 86, 99, 99, 145, 87, 92, 97, 143,
+ 18, 41, 41, 41, 41, 41, 41, 41, 41, 41,
+ 41, 41, 41, 41, 41, 41, 41, 41, 41, 41,
+ 41, 41, 41, 41, 41, 41, 41, 41, 41, 41,
+ 41, 41, 41, 41, 41, 41, 41, 41, 41, 41,
+
+ 41, 41, 41, 41, 41, 41, 41, 45, 45, 45,
+ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+ 45, 45, 45, 45, 45, 45, 45, 45, 45, 45,
+ 45, 45, 45, 58, 82, 82, 82, 88, 88, 88,
+ 91, 94, 116, 58, 117, 58, 58, 131, 98, 98,
+ 115, 130, 58, 82, 133, 98, 88, 58, 118, 91,
+ 98, 100, 100, 113, 113, 113, 122, 137, 100, 142,
+ 94, 115, 123, 123, 116, 133, 122, 117, 139, 123,
+
+ 131, 118, 113, 130, 123, 125, 125, 138, 134, 136,
+ 136, 135, 125, 134, 134, 140, 140, 141, 141, 137,
+ 144, 144, 146, 146, 141, 132, 147, 144, 147, 146,
+ 148, 148, 149, 149, 150, 150, 120, 148, 151, 151,
+ 114, 150, 111, 109, 105, 151, 153, 153, 153, 153,
+ 153, 153, 153, 153, 154, 96, 90, 154, 154, 154,
+ 155, 155, 155, 156, 156, 156, 156, 156, 156, 156,
+ 156, 156, 156, 157, 83, 157, 157, 157, 157, 157,
+ 157, 157, 157, 158, 158, 158, 158, 158, 80, 158,
+ 158, 158, 158, 161, 79, 78, 161, 161, 161, 163,
+
+ 76, 75, 74, 163, 163, 73, 70, 69, 68, 67,
+ 49, 48, 47, 46, 44, 43, 42, 40, 35, 34,
+ 33, 32, 31, 29, 27, 23, 22, 21, 17, 15,
+ 13, 7, 3, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152,
+ 152, 152, 152, 152, 152, 152, 152, 152, 152, 152
+ } ;
+
+ static yy_state_type yy_state_buf[YY_BUF_SIZE + 2], *yy_state_ptr;
+ static char *yy_full_match;
+ static int yy_lp;
+ static int yy_looking_for_trail_begin = 0;
+ static int yy_full_lp;
+ static int *yy_full_state;
+ #define YY_TRAILING_MASK 0x2000
+ #define YY_TRAILING_HEAD_MASK 0x4000
+ #define REJECT \
+ { \
+ *yy_cp = yy_hold_char; /* undo effects of setting up yytext */ \
+ yy_cp = yy_full_match; /* restore poss. backed-over text */ \
+ yy_lp = yy_full_lp; /* restore orig. accepting pos. */ \
+ yy_state_ptr = yy_full_state; /* restore orig. state */ \
+ yy_current_state = *yy_state_ptr; /* restore curr. state */ \
+ ++yy_lp; \
+ goto find_rule; \
+ }
+ #define yymore() yymore_used_but_not_detected
+ #define YY_MORE_ADJ 0
+ char *yytext;
+ #line 1 "ada-lex.l"
+ #define INITIAL 0
+ /* FLEX lexer for Ada expressions, for GDB.
+ Copyright (C) 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+ /*----------------------------------------------------------------------*/
+ /* The converted version of this file is to be included in ada-exp.y, */
+ /* the Ada parser for gdb. The function yylex obtains characters from */
+ /* the global pointer lexptr. It returns a syntactic category for */
+ /* each successive token and places a semantic value into yylval */
+ /* (ada-lval), defined by the parser. */
+ /* Run flex with (at least) the -i option (case-insensitive), and the -I */
+ /* option (interactive---no unnecessary lookahead). */
+ #line 47 "ada-lex.l"
+ #define NUMERAL_WIDTH 256
+
+ /* Temporary staging for numeric literals. */
+ static char numbuf[NUMERAL_WIDTH];
+
+ static void canonicalizeNumeral PARAMS ((char* s1, const char*));
+ static int processInt PARAMS ((const char*, const char*, const char*));
+ static int processReal PARAMS ((const char*));
+ static int processId PARAMS ((const char*, int));
+ static int digitval PARAMS ((char));
+
+ #undef YY_DECL
+ #define YY_DECL static int yylex PARAMS (( void ))
+
+ #undef YY_INPUT
+ #define YY_INPUT(BUF, RESULT, MAX_SIZE) \
+ if ( *lexptr == '\000' ) \
+ (RESULT) = YY_NULL; \
+ else \
+ { \
+ *(BUF) = *lexptr; \
+ (RESULT) = 1; \
+ lexptr += 1; \
+ }
+
+ static char *tempbuf = NULL;
+ static int tempbufsize = 0;
+
+ static void
+ resize_tempbuf PARAMS ((unsigned int));
+
+
+ /* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+ #ifndef YY_SKIP_YYWRAP
+ #ifdef __cplusplus
+ extern "C" int yywrap YY_PROTO(( void ));
+ #else
+ extern int yywrap YY_PROTO(( void ));
+ #endif
+ #endif
+
+ #ifndef YY_NO_UNPUT
+ static void yyunput YY_PROTO(( int c, char *buf_ptr ));
+ #endif
+
+ #ifndef yytext_ptr
+ static void yy_flex_strncpy YY_PROTO(( char *, yyconst char *, int ));
+ #endif
+
+ #ifndef YY_NO_INPUT
+ #ifdef __cplusplus
+ static int yyinput YY_PROTO(( void ));
+ #else
+ static int input YY_PROTO(( void ));
+ #endif
+ #endif
+
+ #if YY_STACK_USED
+ static int yy_start_stack_ptr = 0;
+ static int yy_start_stack_depth = 0;
+ static int *yy_start_stack = 0;
+ #ifndef YY_NO_PUSH_STATE
+ static void yy_push_state YY_PROTO(( int new_state ));
+ #endif
+ #ifndef YY_NO_POP_STATE
+ static void yy_pop_state YY_PROTO(( void ));
+ #endif
+ #ifndef YY_NO_TOP_STATE
+ static int yy_top_state YY_PROTO(( void ));
+ #endif
+
+ #else
+ #define YY_NO_PUSH_STATE 1
+ #define YY_NO_POP_STATE 1
+ #define YY_NO_TOP_STATE 1
+ #endif
+
+ #ifdef YY_MALLOC_DECL
+ YY_MALLOC_DECL
+ #else
+ #if __STDC__
+ #ifndef __cplusplus
+ #include <stdlib.h>
+ #endif
+ #else
+ /* Just try to get by without declaring the routines. This will fail
+ * miserably on non-ANSI systems for which sizeof(size_t) != sizeof(int)
+ * or sizeof(void*) != sizeof(int).
+ */
+ #endif
+ #endif
+
+ /* Amount of stuff to slurp up with each read. */
+ #ifndef YY_READ_BUF_SIZE
+ #define YY_READ_BUF_SIZE 8192
+ #endif
+
+ /* Copy whatever the last rule matched to the standard output. */
+
+ #ifndef ECHO
+ /* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+ #define ECHO (void) fwrite( yytext, yyleng, 1, yyout )
+ #endif
+
+ /* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+ #ifndef YY_INPUT
+ #define YY_INPUT(buf,result,max_size) \
+ if ( yy_current_buffer->yy_is_interactive ) \
+ { \
+ int c = '*', n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else if ( ((result = fread( buf, 1, max_size, yyin )) == 0) \
+ && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" );
+ #endif
+
+ /* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+ #ifndef yyterminate
+ #define yyterminate() return YY_NULL
+ #endif
+
+ /* Number of entries by which start-condition stack grows. */
+ #ifndef YY_START_STACK_INCR
+ #define YY_START_STACK_INCR 25
+ #endif
+
+ /* Report a fatal error. */
+ #ifndef YY_FATAL_ERROR
+ #define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+ #endif
+
+ /* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+ #ifndef YY_DECL
+ #define YY_DECL int yylex YY_PROTO(( void ))
+ #endif
+
+ /* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+ #ifndef YY_USER_ACTION
+ #define YY_USER_ACTION
+ #endif
+
+ /* Code executed at the end of each rule. */
+ #ifndef YY_BREAK
+ #define YY_BREAK break;
+ #endif
+
+ #define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+ YY_DECL
+ {
+ register yy_state_type yy_current_state;
+ register char *yy_cp, *yy_bp;
+ register int yy_act;
+
+ #line 80 "ada-lex.l"
+
+
+
+ if ( yy_init )
+ {
+ yy_init = 0;
+
+ #ifdef YY_USER_INIT
+ YY_USER_INIT;
+ #endif
+
+ if ( ! yy_start )
+ yy_start = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! yy_current_buffer )
+ yy_current_buffer =
+ yy_create_buffer( yyin, YY_BUF_SIZE );
+
+ yy_load_buffer_state();
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = yy_c_buf_p;
+
+ /* Support of yytext. */
+ *yy_cp = yy_hold_char;
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = yy_start;
+ yy_state_ptr = yy_state_buf;
+ *yy_state_ptr++ = yy_current_state;
+ yy_match:
+ do
+ {
+ register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 153 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *yy_state_ptr++ = yy_current_state;
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 434 );
+
+ yy_find_action:
+ yy_current_state = *--yy_state_ptr;
+ yy_lp = yy_accept[yy_current_state];
+ find_rule: /* we branch to this label when backing up */
+ for ( ; ; ) /* until we find what rule we matched */
+ {
+ if ( yy_lp && yy_lp < yy_accept[yy_current_state + 1] )
+ {
+ yy_act = yy_acclist[yy_lp];
+ if ( yy_act & YY_TRAILING_HEAD_MASK ||
+ yy_looking_for_trail_begin )
+ {
+ if ( yy_act == yy_looking_for_trail_begin )
+ {
+ yy_looking_for_trail_begin = 0;
+ yy_act &= ~YY_TRAILING_HEAD_MASK;
+ break;
+ }
+ }
+ else if ( yy_act & YY_TRAILING_MASK )
+ {
+ yy_looking_for_trail_begin = yy_act & ~YY_TRAILING_MASK;
+ yy_looking_for_trail_begin |= YY_TRAILING_HEAD_MASK;
+ }
+ else
+ {
+ yy_full_match = yy_cp;
+ yy_full_state = yy_state_ptr;
+ yy_full_lp = yy_lp;
+ break;
+ }
+ ++yy_lp;
+ goto find_rule;
+ }
+ --yy_cp;
+ yy_current_state = *--yy_state_ptr;
+ yy_lp = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+
+ do_action: /* This label is used only to access EOF actions. */
+
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+ case 1:
+ YY_RULE_SETUP
+ #line 82 "ada-lex.l"
+ { }
+ YY_BREAK
+ case 2:
+ YY_RULE_SETUP
+ #line 84 "ada-lex.l"
+ { yyterminate(); }
+ YY_BREAK
+ case 3:
+ YY_RULE_SETUP
+ #line 86 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (NULL, numbuf, strrchr(numbuf, 'e')+1);
+ }
+ YY_BREAK
+ case 4:
+ YY_RULE_SETUP
+ #line 91 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (NULL, numbuf, NULL);
+ }
+ YY_BREAK
+ case 5:
+ YY_RULE_SETUP
+ #line 96 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (numbuf,
+ strchr (numbuf, '#') + 1,
+ strrchr(numbuf, '#') + 1);
+ }
+ YY_BREAK
+ case 6:
+ YY_RULE_SETUP
+ #line 103 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (numbuf, strchr (numbuf, '#') + 1, NULL);
+ }
+ YY_BREAK
+ case 7:
+ YY_RULE_SETUP
+ #line 108 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext+2);
+ return processInt ("16#", numbuf, NULL);
+ }
+ YY_BREAK
+ case 8:
+ YY_RULE_SETUP
+ #line 114 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext);
+ return processReal (numbuf);
+ }
+ YY_BREAK
+ case 9:
+ YY_RULE_SETUP
+ #line 119 "ada-lex.l"
+ {
+ canonicalizeNumeral (numbuf, yytext);
+ return processReal (numbuf);
+ }
+ YY_BREAK
+ case 10:
+ YY_RULE_SETUP
+ #line 124 "ada-lex.l"
+ {
+ error ("Based real literals not implemented yet.");
+ }
+ YY_BREAK
+ case 11:
+ YY_RULE_SETUP
+ #line 128 "ada-lex.l"
+ {
+ error ("Based real literals not implemented yet.");
+ }
+ YY_BREAK
+ case 12:
+ YY_RULE_SETUP
+ #line 132 "ada-lex.l"
+ {
+ char* name = strchr(yytext, '\'') + 1;
+ processId(name, yyleng-(name-yytext)-1);
+ yylval.sval = yylval.ssym.stoken;
+ return DOT_LITERAL_NAME;
+ }
+ YY_BREAK
+ case 13:
+ YY_RULE_SETUP
+ #line 140 "ada-lex.l"
+ {
+ yylval.typed_val.type = builtin_type_char;
+ yylval.typed_val.val = yytext[1];
+ return INT;
+ }
+ YY_BREAK
+ case 14:
+ YY_RULE_SETUP
+ #line 146 "ada-lex.l"
+ {
+ resize_tempbuf (yyleng-1);
+ strncpy(tempbuf, yytext+1, yyleng-2);
+ tempbuf[yyleng-2] = '\000';
+ yylval.sval.ptr = tempbuf;
+ yylval.sval.length = yyleng-2;
+ return STRING;
+ }
+ YY_BREAK
+ case 15:
+ YY_RULE_SETUP
+ #line 155 "ada-lex.l"
+ {
+ while (*lexptr != 'i' && *lexptr != 'I')
+ lexptr -= 1;
+ yyrestart(NULL);
+ return 0;
+ }
+ YY_BREAK
+ /* ADA KEYWORDS */
+ case 16:
+ YY_RULE_SETUP
+ #line 164 "ada-lex.l"
+ { return ABS; }
+ YY_BREAK
+ case 17:
+ YY_RULE_SETUP
+ #line 165 "ada-lex.l"
+ { return ALL; }
+ YY_BREAK
+ case 18:
+ YY_RULE_SETUP
+ #line 166 "ada-lex.l"
+ { return _AND_; }
+ YY_BREAK
+ case 19:
+ YY_RULE_SETUP
+ #line 167 "ada-lex.l"
+ { return ELSE; }
+ YY_BREAK
+ case 20:
+ YY_RULE_SETUP
+ #line 168 "ada-lex.l"
+ { return IN; }
+ YY_BREAK
+ case 21:
+ YY_RULE_SETUP
+ #line 169 "ada-lex.l"
+ { return MOD; }
+ YY_BREAK
+ case 22:
+ YY_RULE_SETUP
+ #line 170 "ada-lex.l"
+ { return NEW; }
+ YY_BREAK
+ case 23:
+ YY_RULE_SETUP
+ #line 171 "ada-lex.l"
+ { return NOT; }
+ YY_BREAK
+ case 24:
+ YY_RULE_SETUP
+ #line 172 "ada-lex.l"
+ { return NULL_PTR; }
+ YY_BREAK
+ case 25:
+ YY_RULE_SETUP
+ #line 173 "ada-lex.l"
+ { return OR; }
+ YY_BREAK
+ case 26:
+ YY_RULE_SETUP
+ #line 174 "ada-lex.l"
+ { return REM; }
+ YY_BREAK
+ case 27:
+ YY_RULE_SETUP
+ #line 175 "ada-lex.l"
+ { return THEN; }
+ YY_BREAK
+ case 28:
+ YY_RULE_SETUP
+ #line 176 "ada-lex.l"
+ { return XOR; }
+ YY_BREAK
+ /* ATTRIBUTES */
+ case 29:
+ YY_RULE_SETUP
+ #line 180 "ada-lex.l"
+ { return TICK_ACCESS; }
+ YY_BREAK
+ case 30:
+ YY_RULE_SETUP
+ #line 181 "ada-lex.l"
+ { return TICK_FIRST; }
+ YY_BREAK
+ case 31:
+ YY_RULE_SETUP
+ #line 182 "ada-lex.l"
+ { return TICK_LAST; }
+ YY_BREAK
+ case 32:
+ YY_RULE_SETUP
+ #line 183 "ada-lex.l"
+ { return TICK_RANGE; }
+ YY_BREAK
+ case 33:
+ YY_RULE_SETUP
+ #line 184 "ada-lex.l"
+ { error ("unrecognized attribute: `%s'", yytext+1); }
+ YY_BREAK
+ /* PUNCTUATION */
+ case 34:
+ YY_RULE_SETUP
+ #line 188 "ada-lex.l"
+ { return ARROW; }
+ YY_BREAK
+ case 35:
+ YY_RULE_SETUP
+ #line 189 "ada-lex.l"
+ { return DOTDOT; }
+ YY_BREAK
+ case 36:
+ YY_RULE_SETUP
+ #line 190 "ada-lex.l"
+ { return STARSTAR; }
+ YY_BREAK
+ case 37:
+ YY_RULE_SETUP
+ #line 191 "ada-lex.l"
+ { return ASSIGN; }
+ YY_BREAK
+ case 38:
+ YY_RULE_SETUP
+ #line 192 "ada-lex.l"
+ { return NOTEQUAL; }
+ YY_BREAK
+ case 39:
+ YY_RULE_SETUP
+ #line 193 "ada-lex.l"
+ { return LEQ; }
+ YY_BREAK
+ case 40:
+ YY_RULE_SETUP
+ #line 194 "ada-lex.l"
+ { return GEQ; }
+ YY_BREAK
+ case 41:
+ YY_RULE_SETUP
+ #line 196 "ada-lex.l"
+ { return yytext[0]; }
+ YY_BREAK
+ case 42:
+ YY_RULE_SETUP
+ #line 198 "ada-lex.l"
+ { if (paren_depth == 0 && comma_terminates)
+ {
+ lexptr -= 2;
+ yyrestart(NULL);
+ return 0;
+ }
+ else
+ return ',';
+ }
+ YY_BREAK
+ case 43:
+ YY_RULE_SETUP
+ #line 208 "ada-lex.l"
+ { paren_depth += 1; return '('; }
+ YY_BREAK
+ case 44:
+ YY_RULE_SETUP
+ #line 209 "ada-lex.l"
+ { if (paren_depth == 0)
+ {
+ lexptr -= 2;
+ yyrestart(NULL);
+ return 0;
+ }
+ else
+ {
+ paren_depth -= 1;
+ return ')';
+ }
+ }
+ YY_BREAK
+ case 45:
+ YY_RULE_SETUP
+ #line 222 "ada-lex.l"
+ { return processId(yytext, yyleng); }
+ YY_BREAK
+ /* GDB EXPRESSION CONSTRUCTS */
+ case 46:
+ YY_RULE_SETUP
+ #line 226 "ada-lex.l"
+ {
+ return processId(yytext+1, yyleng-2);
+ }
+ YY_BREAK
+ case 47:
+ YY_RULE_SETUP
+ #line 230 "ada-lex.l"
+ { return COLONCOLON; }
+ YY_BREAK
+ case 48:
+ YY_RULE_SETUP
+ #line 231 "ada-lex.l"
+ { return yytext[0]; }
+ YY_BREAK
+ case 49:
+ YY_RULE_SETUP
+ #line 233 "ada-lex.l"
+ { yylval.lval = -1; return LAST; }
+ YY_BREAK
+ case 50:
+ YY_RULE_SETUP
+ #line 234 "ada-lex.l"
+ { yylval.lval = -atoi(yytext+2); return LAST; }
+ YY_BREAK
+ case 51:
+ YY_RULE_SETUP
+ #line 235 "ada-lex.l"
+ { yylval.lval = 0; return LAST; }
+ YY_BREAK
+ case 52:
+ YY_RULE_SETUP
+ #line 236 "ada-lex.l"
+ { yylval.lval = atoi(yytext+1); return LAST; }
+ YY_BREAK
+ /* REGISTERS AND GDB CONVENIENCE VARIABLES */
+ case 53:
+ YY_RULE_SETUP
+ #line 241 "ada-lex.l"
+ {
+ int c;
+ for (c = 0; c < NUM_REGS; c++)
+ if (strcmp (yytext + 1, reg_names[c]) == 0)
+ {
+ yylval.lval = c;
+ return REGNAME;
+ }
+ for (c = 0; c < num_std_regs; c++)
+ if (strcmp (yytext+1, std_regs[c].name) == 0)
+ {
+ yylval.lval = std_regs[c].regnum;
+ return REGNAME;
+ }
+ yylval.sval.ptr = yytext;
+ yylval.sval.length = yyleng;
+ yylval.ivar =
+ lookup_internalvar (copy_name (yylval.sval) + 1);
+ return INTERNAL_VARIABLE;
+ }
+ YY_BREAK
+ /* CATCH-ALL ERROR CASE */
+ case 54:
+ YY_RULE_SETUP
+ #line 264 "ada-lex.l"
+ { error ("Invalid character '%s' in expression.", yytext); }
+ YY_BREAK
+ case 55:
+ YY_RULE_SETUP
+ #line 265 "ada-lex.l"
+ YY_FATAL_ERROR( "flex scanner jammed" );
+ YY_BREAK
+ case YY_STATE_EOF(INITIAL):
+ yyterminate();
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - yytext_ptr) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = yy_hold_char;
+
+ if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between yy_current_buffer and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ yy_n_chars = yy_current_buffer->yy_n_chars;
+ yy_current_buffer->yy_input_file = yyin;
+ yy_current_buffer->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( yy_c_buf_p <= &yy_current_buffer->yy_ch_buf[yy_n_chars] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ yy_c_buf_p = yytext_ptr + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state();
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = yytext_ptr + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++yy_c_buf_p;
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = yy_c_buf_p;
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer() )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ yy_did_buffer_switch_on_eof = 0;
+
+ if ( yywrap() )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ yy_c_buf_p = yytext_ptr + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! yy_did_buffer_switch_on_eof )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ yy_c_buf_p =
+ yytext_ptr + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state();
+
+ yy_cp = yy_c_buf_p;
+ yy_bp = yytext_ptr + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ yy_c_buf_p =
+ &yy_current_buffer->yy_ch_buf[yy_n_chars];
+
+ yy_current_state = yy_get_previous_state();
+
+ yy_cp = yy_c_buf_p;
+ yy_bp = yytext_ptr + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+ } /* end of yylex */
+
+
+ /* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+
+ static int yy_get_next_buffer()
+ {
+ register char *dest = yy_current_buffer->yy_ch_buf;
+ register char *source = yytext_ptr;
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( yy_c_buf_p > &yy_current_buffer->yy_ch_buf[yy_n_chars + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( yy_current_buffer->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( yy_c_buf_p - yytext_ptr - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a singled characater, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) (yy_c_buf_p - yytext_ptr) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( yy_current_buffer->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ yy_n_chars = 0;
+
+ else
+ {
+ int num_to_read =
+ yy_current_buffer->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+ #ifdef YY_USES_REJECT
+ YY_FATAL_ERROR(
+ "input buffer overflow, can't enlarge buffer because scanner uses REJECT" );
+ #else
+
+ /* just a shorter name for the current buffer */
+ YY_BUFFER_STATE b = yy_current_buffer;
+
+ int yy_c_buf_p_offset =
+ (int) (yy_c_buf_p - b->yy_ch_buf);
+
+ if ( b->yy_is_our_buffer )
+ {
+ int new_size = b->yy_buf_size * 2;
+
+ if ( new_size <= 0 )
+ b->yy_buf_size += b->yy_buf_size / 8;
+ else
+ b->yy_buf_size *= 2;
+
+ b->yy_ch_buf = (char *)
+ /* Include room in for 2 EOB chars. */
+ yy_flex_realloc( (void *) b->yy_ch_buf,
+ b->yy_buf_size + 2 );
+ }
+ else
+ /* Can't grow it, we don't own it. */
+ b->yy_ch_buf = 0;
+
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR(
+ "fatal error - scanner input buffer overflow" );
+
+ yy_c_buf_p = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+ num_to_read = yy_current_buffer->yy_buf_size -
+ number_to_move - 1;
+ #endif
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&yy_current_buffer->yy_ch_buf[number_to_move]),
+ yy_n_chars, num_to_read );
+ }
+
+ if ( yy_n_chars == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart( yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ yy_current_buffer->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ yy_n_chars += number_to_move;
+ yy_current_buffer->yy_ch_buf[yy_n_chars] = YY_END_OF_BUFFER_CHAR;
+ yy_current_buffer->yy_ch_buf[yy_n_chars + 1] = YY_END_OF_BUFFER_CHAR;
+
+ yytext_ptr = &yy_current_buffer->yy_ch_buf[0];
+
+ return ret_val;
+ }
+
+
+ /* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state()
+ {
+ register yy_state_type yy_current_state;
+ register char *yy_cp;
+
+ yy_current_state = yy_start;
+ yy_state_ptr = yy_state_buf;
+ *yy_state_ptr++ = yy_current_state;
+
+ for ( yy_cp = yytext_ptr + YY_MORE_ADJ; yy_cp < yy_c_buf_p; ++yy_cp )
+ {
+ register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 153 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *yy_state_ptr++ = yy_current_state;
+ }
+
+ return yy_current_state;
+ }
+
+
+ /* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+
+ #ifdef YY_USE_PROTOS
+ static yy_state_type yy_try_NUL_trans( yy_state_type yy_current_state )
+ #else
+ static yy_state_type yy_try_NUL_trans( yy_current_state )
+ yy_state_type yy_current_state;
+ #endif
+ {
+ register int yy_is_jam;
+
+ register YY_CHAR yy_c = 1;
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 153 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ *yy_state_ptr++ = yy_current_state;
+ yy_is_jam = (yy_current_state == 152);
+
+ return yy_is_jam ? 0 : yy_current_state;
+ }
+
+
+ #ifndef YY_NO_UNPUT
+ #ifdef YY_USE_PROTOS
+ static void yyunput( int c, register char *yy_bp )
+ #else
+ static void yyunput( c, yy_bp )
+ int c;
+ register char *yy_bp;
+ #endif
+ {
+ register char *yy_cp = yy_c_buf_p;
+
+ /* undo effects of setting up yytext */
+ *yy_cp = yy_hold_char;
+
+ if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register int number_to_move = yy_n_chars + 2;
+ register char *dest = &yy_current_buffer->yy_ch_buf[
+ yy_current_buffer->yy_buf_size + 2];
+ register char *source =
+ &yy_current_buffer->yy_ch_buf[number_to_move];
+
+ while ( source > yy_current_buffer->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ yy_n_chars = yy_current_buffer->yy_buf_size;
+
+ if ( yy_cp < yy_current_buffer->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+
+ yytext_ptr = yy_bp;
+ yy_hold_char = *yy_cp;
+ yy_c_buf_p = yy_cp;
+ }
+ #endif /* ifndef YY_NO_UNPUT */
+
+
+ #ifdef __cplusplus
+ static int yyinput()
+ #else
+ static int input()
+ #endif
+ {
+ int c;
+
+ *yy_c_buf_p = yy_hold_char;
+
+ if ( *yy_c_buf_p == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( yy_c_buf_p < &yy_current_buffer->yy_ch_buf[yy_n_chars] )
+ /* This was really a NUL. */
+ *yy_c_buf_p = '\0';
+
+ else
+ { /* need more input */
+ yytext_ptr = yy_c_buf_p;
+ ++yy_c_buf_p;
+
+ switch ( yy_get_next_buffer() )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap() )
+ {
+ yy_c_buf_p =
+ yytext_ptr + YY_MORE_ADJ;
+ return EOF;
+ }
+
+ if ( ! yy_did_buffer_switch_on_eof )
+ YY_NEW_FILE;
+ #ifdef __cplusplus
+ return yyinput();
+ #else
+ return input();
+ #endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ yy_c_buf_p = yytext_ptr + YY_MORE_ADJ;
+ break;
+
+ case EOB_ACT_LAST_MATCH:
+ #ifdef __cplusplus
+ YY_FATAL_ERROR(
+ "unexpected last match in yyinput()" );
+ #else
+ YY_FATAL_ERROR(
+ "unexpected last match in input()" );
+ #endif
+ }
+ }
+ }
+
+ c = *(unsigned char *) yy_c_buf_p; /* cast for 8-bit char's */
+ *yy_c_buf_p = '\0'; /* preserve yytext */
+ yy_hold_char = *++yy_c_buf_p;
+
+
+ return c;
+ }
+
+
+ #ifdef YY_USE_PROTOS
+ void yyrestart( FILE *input_file )
+ #else
+ void yyrestart( input_file )
+ FILE *input_file;
+ #endif
+ {
+ if ( ! yy_current_buffer )
+ yy_current_buffer = yy_create_buffer( yyin, YY_BUF_SIZE );
+
+ yy_init_buffer( yy_current_buffer, input_file );
+ yy_load_buffer_state();
+ }
+
+
+ #ifdef YY_USE_PROTOS
+ void yy_switch_to_buffer( YY_BUFFER_STATE new_buffer )
+ #else
+ void yy_switch_to_buffer( new_buffer )
+ YY_BUFFER_STATE new_buffer;
+ #endif
+ {
+ if ( yy_current_buffer == new_buffer )
+ return;
+
+ if ( yy_current_buffer )
+ {
+ /* Flush out information for old buffer. */
+ *yy_c_buf_p = yy_hold_char;
+ yy_current_buffer->yy_buf_pos = yy_c_buf_p;
+ yy_current_buffer->yy_n_chars = yy_n_chars;
+ }
+
+ yy_current_buffer = new_buffer;
+ yy_load_buffer_state();
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ yy_did_buffer_switch_on_eof = 1;
+ }
+
+
+ #ifdef YY_USE_PROTOS
+ void yy_load_buffer_state( void )
+ #else
+ void yy_load_buffer_state()
+ #endif
+ {
+ yy_n_chars = yy_current_buffer->yy_n_chars;
+ yytext_ptr = yy_c_buf_p = yy_current_buffer->yy_buf_pos;
+ yyin = yy_current_buffer->yy_input_file;
+ yy_hold_char = *yy_c_buf_p;
+ }
+
+
+ #ifdef YY_USE_PROTOS
+ YY_BUFFER_STATE yy_create_buffer( FILE *file, int size )
+ #else
+ YY_BUFFER_STATE yy_create_buffer( file, size )
+ FILE *file;
+ int size;
+ #endif
+ {
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yy_flex_alloc( b->yy_buf_size + 2 );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer( b, file );
+
+ return b;
+ }
+
+
+ #ifdef YY_USE_PROTOS
+ void yy_delete_buffer( YY_BUFFER_STATE b )
+ #else
+ void yy_delete_buffer( b )
+ YY_BUFFER_STATE b;
+ #endif
+ {
+ if ( ! b )
+ return;
+
+ if ( b == yy_current_buffer )
+ yy_current_buffer = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yy_flex_free( (void *) b->yy_ch_buf );
+
+ yy_flex_free( (void *) b );
+ }
+
+
+ #ifndef YY_ALWAYS_INTERACTIVE
+ #ifndef YY_NEVER_INTERACTIVE
+ extern int isatty YY_PROTO(( int ));
+ #endif
+ #endif
+
+ #ifdef YY_USE_PROTOS
+ void yy_init_buffer( YY_BUFFER_STATE b, FILE *file )
+ #else
+ void yy_init_buffer( b, file )
+ YY_BUFFER_STATE b;
+ FILE *file;
+ #endif
+
+
+ {
+ yy_flush_buffer( b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ #if YY_ALWAYS_INTERACTIVE
+ b->yy_is_interactive = 1;
+ #else
+ #if YY_NEVER_INTERACTIVE
+ b->yy_is_interactive = 0;
+ #else
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+ #endif
+ #endif
+ }
+
+
+ #ifdef YY_USE_PROTOS
+ void yy_flush_buffer( YY_BUFFER_STATE b )
+ #else
+ void yy_flush_buffer( b )
+ YY_BUFFER_STATE b;
+ #endif
+
+ {
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == yy_current_buffer )
+ yy_load_buffer_state();
+ }
+
+
+ #ifndef YY_NO_SCAN_BUFFER
+ #ifdef YY_USE_PROTOS
+ YY_BUFFER_STATE yy_scan_buffer( char *base, yy_size_t size )
+ #else
+ YY_BUFFER_STATE yy_scan_buffer( base, size )
+ char *base;
+ yy_size_t size;
+ #endif
+ {
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (YY_BUFFER_STATE) yy_flex_alloc( sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = 0;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer( b );
+
+ return b;
+ }
+ #endif
+
+
+ #ifndef YY_NO_SCAN_STRING
+ #ifdef YY_USE_PROTOS
+ YY_BUFFER_STATE yy_scan_string( yyconst char *str )
+ #else
+ YY_BUFFER_STATE yy_scan_string( str )
+ yyconst char *str;
+ #endif
+ {
+ int len;
+ for ( len = 0; str[len]; ++len )
+ ;
+
+ return yy_scan_bytes( str, len );
+ }
+ #endif
+
+
+ #ifndef YY_NO_SCAN_BYTES
+ #ifdef YY_USE_PROTOS
+ YY_BUFFER_STATE yy_scan_bytes( yyconst char *bytes, int len )
+ #else
+ YY_BUFFER_STATE yy_scan_bytes( bytes, len )
+ yyconst char *bytes;
+ int len;
+ #endif
+ {
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = len + 2;
+ buf = (char *) yy_flex_alloc( n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < len; ++i )
+ buf[i] = bytes[i];
+
+ buf[len] = buf[len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer( buf, n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+ }
+ #endif
+
+
+ #ifndef YY_NO_PUSH_STATE
+ #ifdef YY_USE_PROTOS
+ static void yy_push_state( int new_state )
+ #else
+ static void yy_push_state( new_state )
+ int new_state;
+ #endif
+ {
+ if ( yy_start_stack_ptr >= yy_start_stack_depth )
+ {
+ yy_size_t new_size;
+
+ yy_start_stack_depth += YY_START_STACK_INCR;
+ new_size = yy_start_stack_depth * sizeof( int );
+
+ if ( ! yy_start_stack )
+ yy_start_stack = (int *) yy_flex_alloc( new_size );
+
+ else
+ yy_start_stack = (int *) yy_flex_realloc(
+ (void *) yy_start_stack, new_size );
+
+ if ( ! yy_start_stack )
+ YY_FATAL_ERROR(
+ "out of memory expanding start-condition stack" );
+ }
+
+ yy_start_stack[yy_start_stack_ptr++] = YY_START;
+
+ BEGIN(new_state);
+ }
+ #endif
+
+
+ #ifndef YY_NO_POP_STATE
+ static void yy_pop_state()
+ {
+ if ( --yy_start_stack_ptr < 0 )
+ YY_FATAL_ERROR( "start-condition stack underflow" );
+
+ BEGIN(yy_start_stack[yy_start_stack_ptr]);
+ }
+ #endif
+
+
+ #ifndef YY_NO_TOP_STATE
+ static int yy_top_state()
+ {
+ return yy_start_stack[yy_start_stack_ptr - 1];
+ }
+ #endif
+
+ #ifndef YY_EXIT_FAILURE
+ #define YY_EXIT_FAILURE 2
+ #endif
+
+ #ifdef YY_USE_PROTOS
+ static void yy_fatal_error( yyconst char msg[] )
+ #else
+ static void yy_fatal_error( msg )
+ char msg[];
+ #endif
+ {
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+ }
+
+
+
+ /* Redefine yyless() so it works in section 3 code. */
+
+ #undef yyless
+ #define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ yytext[yyleng] = yy_hold_char; \
+ yy_c_buf_p = yytext + n - YY_MORE_ADJ; \
+ yy_hold_char = *yy_c_buf_p; \
+ *yy_c_buf_p = '\0'; \
+ yyleng = n; \
+ } \
+ while ( 0 )
+
+
+ /* Internal utility routines. */
+
+ #ifndef yytext_ptr
+ #ifdef YY_USE_PROTOS
+ static void yy_flex_strncpy( char *s1, yyconst char *s2, int n )
+ #else
+ static void yy_flex_strncpy( s1, s2, n )
+ char *s1;
+ yyconst char *s2;
+ int n;
+ #endif
+ {
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+ }
+ #endif
+
+
+ #ifdef YY_USE_PROTOS
+ static void *yy_flex_alloc( yy_size_t size )
+ #else
+ static void *yy_flex_alloc( size )
+ yy_size_t size;
+ #endif
+ {
+ return (void *) malloc( size );
+ }
+
+ #ifdef YY_USE_PROTOS
+ static void *yy_flex_realloc( void *ptr, yy_size_t size )
+ #else
+ static void *yy_flex_realloc( ptr, size )
+ void *ptr;
+ yy_size_t size;
+ #endif
+ {
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+ }
+
+ #ifdef YY_USE_PROTOS
+ static void yy_flex_free( void *ptr )
+ #else
+ static void yy_flex_free( ptr )
+ void *ptr;
+ #endif
+ {
+ free( ptr );
+ }
+
+ #if YY_MAIN
+ int main()
+ {
+ yylex();
+ return 0;
+ }
+ #endif
+ #line 265 "ada-lex.l"
+
+
+ /* Make sure that tempbuf points at an array at least N characters long. */
+
+ static void
+ resize_tempbuf (n)
+ unsigned int n;
+ {
+ if (tempbufsize < n)
+ {
+ tempbufsize = (n+63) & ~63;
+ tempbuf = (char*) xrealloc (tempbuf, tempbufsize);
+ }
+ }
+
+
+ /* Convert hex digit c into the corresponding int 0-15. */
+
+ static int
+ digitval(c)
+ char c;
+ {
+ if (isdigit(c))
+ return c - '0';
+ else
+ return tolower(c) - 'a' + 10;
+ }
+
+
+ /* Copy S2 to S1, removing all underscores, and downcasing all letters. */
+
+ static void
+ canonicalizeNumeral (s1,s2)
+ char* s1;
+ const char* s2;
+ {
+ for (; *s2 != '\000'; s2 += 1)
+ {
+ if (*s2 != '_')
+ {
+ *s1 = tolower(*s2);
+ s1 += 1;
+ }
+ }
+ s1[0] = '\000';
+ }
+
+ /* Interprets the prefix of NUM that consists of digits of the given BASE
+ as an integer of that BASE, with the string EXP as an exponent.
+ Puts value in *semval, and returns INT, if the string is valid. Causes
+ an error if the number. BASE, if NULL, defaults to "10", and EXP to "1".
+ The EXP does not contain a leading 'e' or 'E'. */
+
+ static int
+ processInt (base0, num0, exp0)
+ const char* num0;
+ const char* base0;
+ const char* exp0;
+ {
+ LONGEST result;
+ long exp;
+ int base;
+
+ char* trailer;
+
+ if (base0 == NULL)
+ base = 10;
+ else
+ {
+ base = strtol (base0, (char**) NULL, 10);
+ if (base < 2 || base > 16)
+ error ("Invalid base: %d.", base);
+ }
+
+ if (exp0 == NULL)
+ exp = 0;
+ else
+ exp = strtol(exp0, (char**) NULL, 10);
+
+ errno = 0;
+ result = strtoul (num0, &trailer, base);
+ if (isxdigit(*trailer))
+ error ("Invalid digit `%c' in based literal", *trailer);
+ if (errno == ERANGE)
+ error ("Integer literal out of range");
+
+ while (exp > 0)
+ {
+ if (result > (ULONG_MAX / base))
+ error ("Integer literal out of range");
+ result *= base;
+ exp -= 1;
+ }
+
+ yylval.typed_val.val = result;
+ yylval.typed_val.type = builtin_type_int;
+
+ return INT;
+ }
+
+ static int
+ processReal (num0)
+ const char* num0;
+ {
+ yylval.dval = atof (num0);
+ return FLOAT;
+ }
+
+ static int
+ processId (name0, len)
+ const char *name0;
+ int len;
+ {
+ struct symbol** syms;
+ struct block** blocks;
+ int nsyms;
+ char* name = savestring (name0, len);
+ char* lc_name = save_downcase_string (name0, len);
+ int i, k;
+
+ add_name_string_cleanup (name);
+
+ nsyms = ada_lookup_symbol_list (name, expression_context_block,
+ VAR_NAMESPACE, &syms, &blocks);
+
+
+ /* Call lookup_symtab, not lookup_partial_symtab, in case there are
+ no psymtabs (coff, xcoff, or some future change to blow away the
+ psymtabs once symbols are read). */
+ if ((nsyms == 1 && SYMBOL_CLASS (syms[0]) == LOC_BLOCK)
+ || lookup_symtab (name) != NULL
+ || lookup_symtab (lc_name) != NULL)
+ {
+ if (nsyms == 1)
+ yylval.ssym.sym = syms[0];
+ else
+ yylval.ssym.sym = NULL;
+ yylval.ssym.is_a_field_of_this = 0;
+ yylval.ssym.stoken.ptr = name;
+ yylval.ssym.stoken.length = len;
+ return BLOCKNAME;
+ }
+
+ /* Check for a type definition. */
+
+ /* Look for a symbol that doesn't denote void. This is (I think) a */
+ /* temporary kludge to get around problems in GNAT output. */
+ k = -1;
+ for (i = 0; i < nsyms; i += 1)
+ {
+ if (SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF &&
+ TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_VOID)
+ {
+ yylval.tsym.type = SYMBOL_TYPE (syms[i]);
+ yylval.tsym.stoken.ptr = name;
+ yylval.tsym.stoken.length = len;
+ return TYPENAME;
+ }
+ else if (SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF)
+ k = i;
+ }
+ if (k != -1)
+ error ("`%s' matches only void type name(s)", name);
+
+ yylval.tsym.type = lookup_primitive_typename (lc_name);
+ if (yylval.tsym.type != NULL)
+ {
+ yylval.tsym.stoken.ptr = name;
+ yylval.tsym.stoken.length = len;
+ return TYPENAME;
+ }
+
+ /* Any other kind of symbol */
+ yylval.ssym.sym = NULL;
+ yylval.tsym.stoken.ptr = name;
+ yylval.tsym.stoken.length = len;
+ yylval.ssym.is_a_field_of_this = 0;
+ return NAME;
+ }
+
+ int
+ yywrap()
+ {
+ return 1;
+ }
diff -c -r -N gdb-4.16/gdb/ada-lex.l gdb/ada-lex.l
*** gdb-4.16/gdb/ada-lex.l
--- gdb-4.16.orig/gdb/ada-lex.l Sun Mar 23 16:56:39 1997
***************
*** 0 ****
--- 1,449 ----
+ /* FLEX lexer for Ada expressions, for GDB.
+ Copyright (C) 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ /*----------------------------------------------------------------------*/
+
+ /* The converted version of this file is to be included in ada-exp.y, */
+ /* the Ada parser for gdb. The function yylex obtains characters from */
+ /* the global pointer lexptr. It returns a syntactic category for */
+ /* each successive token and places a semantic value into yylval */
+ /* (ada-lval), defined by the parser. */
+
+ /* Run flex with (at least) the -i option (case-insensitive), and the -I */
+ /* option (interactive---no unnecessary lookahead). */
+
+ DIG [0-9]
+ NUM10 ({DIG}({DIG}|_)*)
+ HEXDIG [0-9a-f]
+ NUM16 ({HEXDIG}({HEXDIG}|_)*)
+ OCTDIG [0-7]
+ LETTER [a-z_]
+ ID ({LETTER}({LETTER}|{DIG})*)
+ WHITE [ \t\n]
+ TICK ("'"{WHITE}*)
+ GRAPHIC [a-z0-9 #&'()*+,-./:;<>=_|!$%?@\[\]\\^`{}~]
+
+ EXP (e[+-]{NUM10})
+ POSEXP (e"+"?{NUM10})
+
+ %{
+ #define NUMERAL_WIDTH 256
+
+ /* Temporary staging for numeric literals. */
+ static char numbuf[NUMERAL_WIDTH];
+
+ static void canonicalizeNumeral PARAMS ((char* s1, const char*));
+ static int processInt PARAMS ((const char*, const char*, const char*));
+ static int processReal PARAMS ((const char*));
+ static int processId PARAMS ((const char*, int));
+ static int digitval PARAMS ((char));
+
+ #undef YY_DECL
+ #define YY_DECL static int yylex PARAMS (( void ))
+
+ #undef YY_INPUT
+ #define YY_INPUT(BUF, RESULT, MAX_SIZE) \
+ if ( *lexptr == '\000' ) \
+ (RESULT) = YY_NULL; \
+ else \
+ { \
+ *(BUF) = *lexptr; \
+ (RESULT) = 1; \
+ lexptr += 1; \
+ }
+
+ static char *tempbuf = NULL;
+ static int tempbufsize = 0;
+
+ static void
+ resize_tempbuf PARAMS ((unsigned int));
+
+ %}
+
+ %%
+
+ {WHITE} { }
+
+ "--".* { yyterminate(); }
+
+ {NUM10}{POSEXP} {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (NULL, numbuf, strrchr(numbuf, 'e')+1);
+ }
+
+ {NUM10} {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (NULL, numbuf, NULL);
+ }
+
+ {NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#"{POSEXP} {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (numbuf,
+ strchr (numbuf, '#') + 1,
+ strrchr(numbuf, '#') + 1);
+ }
+
+ {NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#" {
+ canonicalizeNumeral (numbuf, yytext);
+ return processInt (numbuf, strchr (numbuf, '#') + 1, NULL);
+ }
+
+ "0x"{HEXDIG}+ {
+ canonicalizeNumeral (numbuf, yytext+2);
+ return processInt ("16#", numbuf, NULL);
+ }
+
+
+ {NUM10}"."{NUM10}{EXP} {
+ canonicalizeNumeral (numbuf, yytext);
+ return processReal (numbuf);
+ }
+
+ {NUM10}"."{NUM10} {
+ canonicalizeNumeral (numbuf, yytext);
+ return processReal (numbuf);
+ }
+
+ {NUM10}"#"{NUM16}"."{NUM16}"#"{EXP} {
+ error ("Based real literals not implemented yet.");
+ }
+
+ {NUM10}"#"{NUM16}"."{NUM16}"#" {
+ error ("Based real literals not implemented yet.");
+ }
+
+ "."{WHITE}*"'"[^']+"'" {
+ char* name = strchr(yytext, '\'') + 1;
+ processId(name, yyleng-(name-yytext)-1);
+ yylval.sval = yylval.ssym.stoken;
+ return DOT_LITERAL_NAME;
+ }
+
+
+ "'"({GRAPHIC}|\")"'" {
+ yylval.typed_val.type = builtin_type_char;
+ yylval.typed_val.val = yytext[1];
+ return INT;
+ }
+
+ \"{GRAPHIC}*\" {
+ resize_tempbuf (yyleng-1);
+ strncpy(tempbuf, yytext+1, yyleng-2);
+ tempbuf[yyleng-2] = '\000';
+ yylval.sval.ptr = tempbuf;
+ yylval.sval.length = yyleng-2;
+ return STRING;
+ }
+
+ if {
+ while (*lexptr != 'i' && *lexptr != 'I')
+ lexptr -= 1;
+ yyrestart(NULL);
+ return 0;
+ }
+
+ /* ADA KEYWORDS */
+
+ abs { return ABS; }
+ all { return ALL; }
+ and { return _AND_; }
+ else { return ELSE; }
+ in { return IN; }
+ mod { return MOD; }
+ new { return NEW; }
+ not { return NOT; }
+ null { return NULL_PTR; }
+ or { return OR; }
+ rem { return REM; }
+ then { return THEN; }
+ xor { return XOR; }
+
+ /* ATTRIBUTES */
+
+ {TICK}access { return TICK_ACCESS; }
+ {TICK}first { return TICK_FIRST; }
+ {TICK}last { return TICK_LAST; }
+ {TICK}range { return TICK_RANGE; }
+ {TICK}{ID} { error ("unrecognized attribute: `%s'", yytext+1); }
+
+ /* PUNCTUATION */
+
+ "=>" { return ARROW; }
+ ".." { return DOTDOT; }
+ "**" { return STARSTAR; }
+ ":=" { return ASSIGN; }
+ "/=" { return NOTEQUAL; }
+ "<=" { return LEQ; }
+ ">=" { return GEQ; }
+
+ [-&'*+./:<>=|;\[\]] { return yytext[0]; }
+
+ "," { if (paren_depth == 0 && comma_terminates)
+ {
+ lexptr -= 2;
+ yyrestart(NULL);
+ return 0;
+ }
+ else
+ return ',';
+ }
+
+ "(" { paren_depth += 1; return '('; }
+ ")" { if (paren_depth == 0)
+ {
+ lexptr -= 2;
+ yyrestart(NULL);
+ return 0;
+ }
+ else
+ {
+ paren_depth -= 1;
+ return ')';
+ }
+ }
+
+ {ID} { return processId(yytext, yyleng); }
+
+ /* GDB EXPRESSION CONSTRUCTS */
+
+ "'"[^']+"'"/{WHITE}*:: {
+ return processId(yytext+1, yyleng-2);
+ }
+
+ "::" { return COLONCOLON; }
+ [{}@] { return yytext[0]; }
+
+ "$$" { yylval.lval = -1; return LAST; }
+ "$$"{DIG}+ { yylval.lval = -atoi(yytext+2); return LAST; }
+ "$" { yylval.lval = 0; return LAST; }
+ "$"{DIG}+ { yylval.lval = atoi(yytext+1); return LAST; }
+
+
+ /* REGISTERS AND GDB CONVENIENCE VARIABLES */
+
+ "$"({LETTER}|{DIG}|"$")+ {
+ int c;
+ for (c = 0; c < NUM_REGS; c++)
+ if (strcmp (yytext + 1, reg_names[c]) == 0)
+ {
+ yylval.lval = c;
+ return REGNAME;
+ }
+ for (c = 0; c < num_std_regs; c++)
+ if (strcmp (yytext+1, std_regs[c].name) == 0)
+ {
+ yylval.lval = std_regs[c].regnum;
+ return REGNAME;
+ }
+ yylval.sval.ptr = yytext;
+ yylval.sval.length = yyleng;
+ yylval.ivar =
+ lookup_internalvar (copy_name (yylval.sval) + 1);
+ return INTERNAL_VARIABLE;
+ }
+
+ /* CATCH-ALL ERROR CASE */
+
+ . { error ("Invalid character '%s' in expression.", yytext); }
+ %%
+
+ /* Make sure that tempbuf points at an array at least N characters long. */
+
+ static void
+ resize_tempbuf (n)
+ unsigned int n;
+ {
+ if (tempbufsize < n)
+ {
+ tempbufsize = (n+63) & ~63;
+ tempbuf = (char*) xrealloc (tempbuf, tempbufsize);
+ }
+ }
+
+
+ /* Convert hex digit c into the corresponding int 0-15. */
+
+ static int
+ digitval(c)
+ char c;
+ {
+ if (isdigit(c))
+ return c - '0';
+ else
+ return tolower(c) - 'a' + 10;
+ }
+
+
+ /* Copy S2 to S1, removing all underscores, and downcasing all letters. */
+
+ static void
+ canonicalizeNumeral (s1,s2)
+ char* s1;
+ const char* s2;
+ {
+ for (; *s2 != '\000'; s2 += 1)
+ {
+ if (*s2 != '_')
+ {
+ *s1 = tolower(*s2);
+ s1 += 1;
+ }
+ }
+ s1[0] = '\000';
+ }
+
+ /* Interprets the prefix of NUM that consists of digits of the given BASE
+ as an integer of that BASE, with the string EXP as an exponent.
+ Puts value in *semval, and returns INT, if the string is valid. Causes
+ an error if the number. BASE, if NULL, defaults to "10", and EXP to "1".
+ The EXP does not contain a leading 'e' or 'E'. */
+
+ static int
+ processInt (base0, num0, exp0)
+ const char* num0;
+ const char* base0;
+ const char* exp0;
+ {
+ LONGEST result;
+ long exp;
+ int base;
+
+ char* trailer;
+
+ if (base0 == NULL)
+ base = 10;
+ else
+ {
+ base = strtol (base0, (char**) NULL, 10);
+ if (base < 2 || base > 16)
+ error ("Invalid base: %d.", base);
+ }
+
+ if (exp0 == NULL)
+ exp = 0;
+ else
+ exp = strtol(exp0, (char**) NULL, 10);
+
+ errno = 0;
+ result = strtoul (num0, &trailer, base);
+ if (isxdigit(*trailer))
+ error ("Invalid digit `%c' in based literal", *trailer);
+ if (errno == ERANGE)
+ error ("Integer literal out of range");
+
+ while (exp > 0)
+ {
+ if (result > (ULONG_MAX / base))
+ error ("Integer literal out of range");
+ result *= base;
+ exp -= 1;
+ }
+
+ yylval.typed_val.val = result;
+ yylval.typed_val.type = builtin_type_int;
+
+ return INT;
+ }
+
+ static int
+ processReal (num0)
+ const char* num0;
+ {
+ yylval.dval = atof (num0);
+ return FLOAT;
+ }
+
+ static int
+ processId (name0, len)
+ const char *name0;
+ int len;
+ {
+ struct symbol** syms;
+ struct block** blocks;
+ int nsyms;
+ char* name = savestring (name0, len);
+ char* lc_name = save_downcase_string (name0, len);
+ int i, k;
+
+ add_name_string_cleanup (name);
+
+ nsyms = ada_lookup_symbol_list (name, expression_context_block,
+ VAR_NAMESPACE, &syms, &blocks);
+
+
+ /* Call lookup_symtab, not lookup_partial_symtab, in case there are
+ no psymtabs (coff, xcoff, or some future change to blow away the
+ psymtabs once symbols are read). */
+ if ((nsyms == 1 && SYMBOL_CLASS (syms[0]) == LOC_BLOCK)
+ || lookup_symtab (name) != NULL
+ || lookup_symtab (lc_name) != NULL)
+ {
+ if (nsyms == 1)
+ yylval.ssym.sym = syms[0];
+ else
+ yylval.ssym.sym = NULL;
+ yylval.ssym.is_a_field_of_this = 0;
+ yylval.ssym.stoken.ptr = name;
+ yylval.ssym.stoken.length = len;
+ return BLOCKNAME;
+ }
+
+ /* Check for a type definition. */
+
+ /* Look for a symbol that doesn't denote void. This is (I think) a */
+ /* temporary kludge to get around problems in GNAT output. */
+ k = -1;
+ for (i = 0; i < nsyms; i += 1)
+ {
+ if (SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF &&
+ TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_VOID)
+ {
+ yylval.tsym.type = SYMBOL_TYPE (syms[i]);
+ yylval.tsym.stoken.ptr = name;
+ yylval.tsym.stoken.length = len;
+ return TYPENAME;
+ }
+ else if (SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF)
+ k = i;
+ }
+ if (k != -1)
+ error ("`%s' matches only void type name(s)", name);
+
+ yylval.tsym.type = lookup_primitive_typename (lc_name);
+ if (yylval.tsym.type != NULL)
+ {
+ yylval.tsym.stoken.ptr = name;
+ yylval.tsym.stoken.length = len;
+ return TYPENAME;
+ }
+
+ /* Any other kind of symbol */
+ yylval.ssym.sym = NULL;
+ yylval.tsym.stoken.ptr = name;
+ yylval.tsym.stoken.length = len;
+ yylval.ssym.is_a_field_of_this = 0;
+ return NAME;
+ }
+
+ int
+ yywrap()
+ {
+ return 1;
+ }
diff -c -r -N gdb-4.16/gdb/ada-typeprint.c gdb/ada-typeprint.c
*** gdb-4.16/gdb/ada-typeprint.c
--- gdb-4.16.orig/gdb/ada-typeprint.c Sun Mar 23 16:56:40 1997
***************
*** 0 ****
--- 1,600 ----
+ /* Support for printing C and C++ types for GDB, the GNU debugger.
+ Copyright 1986, 1988, 1989, 1991 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ #include "defs.h"
+ #include "obstack.h"
+ #include "bfd.h" /* Binary File Description */
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "expression.h"
+ #include "value.h"
+ #include "gdbcore.h"
+ #include "target.h"
+ #include "command.h"
+ #include "gdbcmd.h"
+ #include "language.h"
+ #include "demangle.h"
+ #include "c-lang.h"
+ #include "typeprint.h"
+
+ #include <string.h>
+ #include <errno.h>
+
+ /* This file is mostly taken from c-typeprint.c, and is gradually
+ being migrated to Ada. */
+
+ static void
+ ada_type_print_args PARAMS ((struct type *, GDB_FILE *));
+
+ static void
+ ada_type_print_varspec_suffix PARAMS ((struct type *, GDB_FILE *, int, int, int));
+
+ static void
+ ada_type_print_derivation_info PARAMS ((GDB_FILE *, struct type *));
+
+ void
+ ada_type_print_varspec_prefix PARAMS ((struct type *, GDB_FILE *, int, int));
+
+ void
+ ada_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.
+ NEW is the new name for a type TYPE. */
+
+ void
+ ada_typedef_print (type, new, stream)
+ struct type *type;
+ struct symbol *new;
+ GDB_FILE *stream;
+ {
+ fprintf_filtered (stream, "type ");
+ if(!TYPE_NAME (SYMBOL_TYPE(new)) ||
+ !STREQ (TYPE_NAME(SYMBOL_TYPE(new)), SYMBOL_NAME(new)))
+ fprintf_filtered (stream, "%s is ", SYMBOL_SOURCE_NAME(new));
+ else
+ fprintf_filtered (stream, "<builtin> is ");
+ type_print (type,"",stream,0);
+ fprintf_filtered (stream, ";\n");
+ }
+
+
+ /* LEVEL is the depth to indent lines by. */
+
+ void
+ ada_print_type (type, varstring, stream, show, level)
+ struct type *type;
+ char *varstring;
+ GDB_FILE *stream;
+ int show;
+ int level;
+ {
+ enum type_code code;
+ int demangled_args;
+
+ if (ada_is_array_descriptor (type) && TYPE_NAME (type) != NULL)
+ {
+ fprintf_filtered (stream, "%s *", TYPE_NAME (type));
+ return;
+ }
+
+ ada_type_print_base (type, stream, show, level);
+ code = TYPE_CODE (type);
+ if ((varstring != NULL && *varstring != '\0')
+ ||
+ /* Need a space if going to print stars or brackets;
+ but not if we will print just a type name. */
+ ((show > 0 || TYPE_NAME (type) == 0)
+ &&
+ (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
+ || code == TYPE_CODE_ARRAY
+ || code == TYPE_CODE_MEMBER
+ || code == TYPE_CODE_REF)))
+ fputs_filtered (" ", stream);
+ ada_type_print_varspec_prefix (type, stream, show, 0);
+
+ fputs_filtered (varstring, stream);
+
+ /* For demangled function names, we have the arglist as part of the name,
+ so don't print an additional pair of ()'s */
+
+ demangled_args = varstring[strlen(varstring) - 1] == ')';
+ ada_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
+
+ }
+
+ /* If TYPE is a derived type, then print out derivation information.
+ Print only the actual base classes of this type, not the base classes
+ of the base classes. I.E. for the derivation hierarchy:
+
+ class A { int a; };
+ class B : public A {int b; };
+ class C : public B {int c; };
+
+ Print the type of class C as:
+
+ class C : public B {
+ int c;
+ }
+
+ Not as the following (like gdb used to), which is not legal C++ syntax for
+ derived types and may be confused with the multiple inheritance form:
+
+ class C : public B : public A {
+ int c;
+ }
+
+ In general, gdb should try to print the types as closely as possible to
+ the form that they appear in the source code. */
+
+ static void
+ ada_type_print_derivation_info (stream, type)
+ GDB_FILE *stream;
+ struct type *type;
+ {
+ char *name;
+ int i;
+
+ for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
+ {
+ fputs_filtered (i == 0 ? ": " : ", ", stream);
+ fprintf_filtered (stream, "%s%s ",
+ BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
+ BASETYPE_VIA_VIRTUAL(type, i) ? " virtual" : "");
+ name = type_name_no_tag (TYPE_BASECLASS (type, i));
+ fprintf_filtered (stream, "%s", name ? name : "(null)");
+ }
+ if (i > 0)
+ {
+ fputs_filtered (" ", stream);
+ }
+ }
+
+ /* Print any asterisks or open-parentheses needed before the
+ variable name (to describe its type).
+
+ On outermost call, pass 0 for PASSED_A_PTR.
+ On outermost call, SHOW > 0 means should ignore
+ any typename for TYPE and show its details.
+ SHOW is always zero on recursive calls. */
+
+ void
+ ada_type_print_varspec_prefix (type, stream, show, passed_a_ptr)
+ struct type *type;
+ GDB_FILE *stream;
+ int show;
+ int passed_a_ptr;
+ {
+ char *name;
+ if (type == 0)
+ return;
+
+ if (TYPE_NAME (type) && show <= 0)
+ return;
+
+ QUIT;
+
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_PTR:
+ ada_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
+ fprintf_filtered (stream, "*");
+ break;
+
+ case TYPE_CODE_MEMBER:
+ if (passed_a_ptr)
+ fprintf_filtered (stream, "(");
+ ada_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
+ fprintf_filtered (stream, " ");
+ name = type_name_no_tag (TYPE_DOMAIN_TYPE (type));
+ if (name)
+ fputs_filtered (name, stream);
+ else
+ ada_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
+ fprintf_filtered (stream, "::");
+ break;
+
+ case TYPE_CODE_METHOD:
+ if (passed_a_ptr)
+ fprintf_unfiltered (stream, "(");
+ ada_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
+ if (passed_a_ptr)
+ {
+ fprintf_filtered (stream, " ");
+ ada_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr);
+ fprintf_filtered (stream, "::");
+ }
+ break;
+
+ case TYPE_CODE_REF:
+ ada_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
+ fprintf_filtered (stream, "&");
+ break;
+
+ case TYPE_CODE_FUNC:
+ ada_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
+ if (passed_a_ptr)
+ fprintf_filtered (stream, "(");
+ break;
+
+ case TYPE_CODE_ARRAY:
+ ada_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
+ if (passed_a_ptr)
+ fprintf_filtered (stream, "(");
+ break;
+
+ case TYPE_CODE_UNDEF:
+ case TYPE_CODE_STRUCT:
+ case TYPE_CODE_UNION:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_INT:
+ case TYPE_CODE_FLT:
+ case TYPE_CODE_VOID:
+ case TYPE_CODE_ERROR:
+ case TYPE_CODE_CHAR:
+ case TYPE_CODE_BOOL:
+ case TYPE_CODE_SET:
+ case TYPE_CODE_RANGE:
+ case TYPE_CODE_STRING:
+ case TYPE_CODE_BITSTRING:
+ /* These types need no prefix. They are listed here so that
+ gcc -Wall will reveal any types that haven't been handled. */
+ break;
+ }
+ }
+
+ static void
+ ada_type_print_args (type, stream)
+ struct type *type;
+ GDB_FILE *stream;
+ {
+ int i;
+ struct type **args;
+
+ fprintf_filtered (stream, "(");
+ args = TYPE_ARG_TYPES (type);
+ if (args != NULL)
+ {
+ if (args[1] == NULL)
+ {
+ fprintf_filtered (stream, "...");
+ }
+ else
+ {
+ for (i = 1;
+ args[i] != NULL && args[i]->code != TYPE_CODE_VOID;
+ i++)
+ {
+ ada_print_type (args[i], "", stream, -1, 0);
+ if (args[i+1] == NULL)
+ {
+ fprintf_filtered (stream, "...");
+ }
+ else if (args[i+1]->code != TYPE_CODE_VOID)
+ {
+ fprintf_filtered (stream, ",");
+ wrap_here (" ");
+ }
+ }
+ }
+ }
+ fprintf_filtered (stream, ")");
+ }
+
+ /* Print any array sizes, function arguments or close parentheses
+ needed after the variable name (to describe its type).
+ Args work like ada_type_print_varspec_prefix. */
+
+ static void
+ ada_type_print_varspec_suffix (type, stream, show, passed_a_ptr, demangled_args)
+ struct type *type;
+ GDB_FILE *stream;
+ int show;
+ int passed_a_ptr;
+ int demangled_args;
+ {
+ if (type == 0)
+ return;
+
+ if (TYPE_NAME (type) && show <= 0)
+ return;
+
+ QUIT;
+
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_ARRAY:
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+
+ fprintf_filtered (stream, "[");
+ if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
+ fprintf_filtered (stream, "%d",
+ (TYPE_LENGTH (type)
+ / TYPE_LENGTH (TYPE_TARGET_TYPE (type))));
+ fprintf_filtered (stream, "]");
+
+ ada_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+ break;
+
+ case TYPE_CODE_MEMBER:
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+ ada_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+ break;
+
+ case TYPE_CODE_METHOD:
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+ ada_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
+ if (passed_a_ptr)
+ {
+ ada_type_print_args (type, stream);
+ }
+ break;
+
+ case TYPE_CODE_PTR:
+ case TYPE_CODE_REF:
+ ada_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0);
+ break;
+
+ case TYPE_CODE_FUNC:
+ if (passed_a_ptr)
+ fprintf_filtered (stream, ")");
+ if (!demangled_args)
+ fprintf_filtered (stream, "()");
+ ada_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
+ passed_a_ptr, 0);
+ break;
+
+ case TYPE_CODE_UNDEF:
+ case TYPE_CODE_STRUCT:
+ case TYPE_CODE_UNION:
+ case TYPE_CODE_ENUM:
+ case TYPE_CODE_INT:
+ case TYPE_CODE_FLT:
+ case TYPE_CODE_VOID:
+ case TYPE_CODE_ERROR:
+ case TYPE_CODE_CHAR:
+ case TYPE_CODE_BOOL:
+ case TYPE_CODE_SET:
+ case TYPE_CODE_RANGE:
+ case TYPE_CODE_STRING:
+ case TYPE_CODE_BITSTRING:
+ /* These types do not need a suffix. They are listed so that
+ gcc -Wall will report types that may not have been considered. */
+ break;
+ }
+ }
+
+ /* Print the name of the type (or the ultimate pointer target,
+ function value or array element), or the description of a
+ structure or union.
+
+ SHOW positive means print details about the type (e.g. enum values),
+ and print structure elements passing SHOW - 1 for show.
+ SHOW negative means just print the type name or struct tag if there is one.
+ If there is no name, print something sensible but concise like
+ "struct {...}".
+ SHOW zero means just print the type name or struct tag if there is one.
+ If there is no name, print something sensible but not as concise like
+ "struct {int x; int y;}".
+
+ LEVEL is the number of spaces to indent by.
+ We increase it for some recursive calls. */
+
+ void
+ ada_type_print_base (type, stream, show, level)
+ struct type *type;
+ GDB_FILE *stream;
+ int show;
+ int level;
+ {
+ int i;
+ int len;
+ int lastval;
+ char *mangled_name;
+ char *demangled_name;
+ enum {s_none, s_public, s_private, s_protected} section_type;
+ QUIT;
+
+ wrap_here (" ");
+ if (type == NULL)
+ {
+ fputs_filtered ("<type unknown>", stream);
+ return;
+ }
+
+ /* When SHOW is zero or less, and there is a valid type name, then always
+ just print the type name directly from the type. */
+ /* If we have "typedef struct foo {. . .} bar;" do we want to print it
+ as "struct foo" or as "bar"? Pick the latter, because C++ folk tend
+ to expect things like "class5 *foo" rather than "struct class5 *foo". */
+
+ if (show <= 0
+ && TYPE_NAME (type) != NULL)
+ {
+ fputs_filtered (TYPE_NAME (type), stream);
+ return;
+ }
+
+ CHECK_TYPEDEF (type);
+
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_ARRAY:
+ case TYPE_CODE_PTR:
+ case TYPE_CODE_MEMBER:
+ case TYPE_CODE_REF:
+ case TYPE_CODE_FUNC:
+ case TYPE_CODE_METHOD:
+ ada_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
+ break;
+
+ case TYPE_CODE_STRUCT:
+ fprintf_filtered (stream, "record ");
+ goto struct_union;
+
+ case TYPE_CODE_UNION:
+ fprintf_filtered (stream, "union ");
+
+ struct_union:
+ #if 0
+ if (TYPE_TAG_NAME (type) != NULL)
+ {
+ fputs_filtered (TYPE_TAG_NAME (type), stream);
+ if (show > 0)
+ fputs_filtered (" ", stream);
+ }
+ #endif
+ wrap_here (" ");
+ if (show < 0)
+ fprintf_filtered (stream, "{...}");
+ else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
+ {
+ ada_type_print_derivation_info (stream, type);
+
+ fprintf_filtered (stream, "{\n");
+ if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
+ {
+ if (TYPE_FLAGS (type) & TYPE_FLAG_STUB)
+ fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
+ else
+ fprintfi_filtered (level + 4, stream, "<no data fields>\n");
+ }
+
+ /* Start off with no specific section type, so we can print
+ one for the first field we find, and use that section type
+ thereafter until we find another type. */
+
+ section_type = s_none;
+
+ /* If there is a base class for this type,
+ do not print the field that it occupies. */
+
+ len = TYPE_NFIELDS (type);
+ for (i = TYPE_N_BASECLASSES (type); i < len; i++)
+ {
+ QUIT;
+ /* Don't print out virtual function table. */
+ if ((TYPE_FIELD_NAME (type, i))[5] == CPLUS_MARKER &&
+ !strncmp (TYPE_FIELD_NAME (type, i), "_vptr", 5))
+ continue;
+
+ /* If this is a C++ class we can print the various C++ section
+ labels. */
+
+ print_spaces_filtered (level + 4, stream);
+ ada_print_type (TYPE_FIELD_TYPE (type, i),
+ TYPE_FIELD_NAME (type, i),
+ stream, show - 1, level + 4);
+ if (!TYPE_FIELD_STATIC (type, i)
+ && TYPE_FIELD_PACKED (type, i))
+ {
+ /* It is a bitfield. This code does not attempt
+ to look at the bitpos and reconstruct filler,
+ unnamed fields. This would lead to misleading
+ results if the compiler does not put out fields
+ for such things (I don't know what it does). */
+ fprintf_filtered (stream, " : %d",
+ TYPE_FIELD_BITSIZE (type, i));
+ }
+ fprintf_filtered (stream, ";\n");
+ }
+
+ fprintfi_filtered (level, stream, "}");
+ }
+ break;
+
+ case TYPE_CODE_ENUM:
+ fprintf_filtered (stream, "enum ");
+ if (TYPE_TAG_NAME (type) != NULL)
+ {
+ fputs_filtered (TYPE_TAG_NAME (type), stream);
+ if (show > 0)
+ fputs_filtered (" ", stream);
+ }
+
+ wrap_here (" ");
+ if (show < 0)
+ {
+ /* If we just printed a tag name, no need to print anything else. */
+ if (TYPE_TAG_NAME (type) == NULL)
+ fprintf_filtered (stream, "{...}");
+ }
+ else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
+ {
+ fprintf_filtered (stream, "{");
+ len = TYPE_NFIELDS (type);
+ lastval = 0;
+ for (i = 0; i < len; i++)
+ {
+ QUIT;
+ if (i) fprintf_filtered (stream, ", ");
+ wrap_here (" ");
+ fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
+ if (lastval != TYPE_FIELD_BITPOS (type, i))
+ {
+ fprintf_filtered (stream, " = %d", TYPE_FIELD_BITPOS (type, i));
+ lastval = TYPE_FIELD_BITPOS (type, i);
+ }
+ lastval++;
+ }
+ fprintf_filtered (stream, "}");
+ }
+ break;
+
+ case TYPE_CODE_VOID:
+ fprintf_filtered (stream, "void");
+ break;
+
+ case TYPE_CODE_UNDEF:
+ fprintf_filtered (stream, "struct <unknown>");
+ break;
+
+ case TYPE_CODE_ERROR:
+ fprintf_filtered (stream, "<unknown type>");
+ break;
+
+ case TYPE_CODE_RANGE:
+ /* This should not occur */
+ fprintf_filtered (stream, "<range type>");
+ break;
+
+ default:
+ /* Handle types not explicitly handled by the other cases,
+ such as fundamental types. For these, just print whatever
+ the type name is, as recorded in the type itself. If there
+ is no type name, then complain. */
+ if (TYPE_NAME (type) != NULL)
+ {
+ fputs_filtered (TYPE_NAME (type), stream);
+ }
+ else
+ {
+ /* At least for dump_symtab, it is important that this not be
+ an error (). */
+ fprintf_filtered (stream, "<invalid type code %d>",
+ TYPE_CODE (type));
+ }
+ break;
+ }
+ }
+
diff -c -r -N gdb-4.16/gdb/ada-valprint.c gdb/ada-valprint.c
*** gdb-4.16/gdb/ada-valprint.c
--- gdb-4.16.orig/gdb/ada-valprint.c Sun Mar 23 16:56:40 1997
***************
*** 0 ****
--- 1,186 ----
+ /* Support for printing C values for GDB, the GNU debugger.
+ Copyright 1986, 1988, 1989, 1991, 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+ #include "defs.h"
+ #include "symtab.h"
+ #include "gdbtypes.h"
+ #include "expression.h"
+ #include "value.h"
+ #include "demangle.h"
+ #include "valprint.h"
+ #include "language.h"
+ #include "ada-lang.h"
+ #include "c-lang.h"
+
+
+
+
+ /* Print data of type TYPE located at VALADDR (within GDB), which came from
+ the inferior at address ADDRESS, onto stdio stream STREAM according to
+ FORMAT (a letter or 0 for natural format). The data at VALADDR is in
+ target byte order.
+
+ If the data are a string pointer, returns the number of string characters
+ printed.
+
+ If DEREF_REF is nonzero, then dereference references, otherwise just print
+ them like pointers.
+
+ The PRETTY parameter controls prettyprinting. */
+
+ int
+ ada_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
+ pretty)
+ struct type *type;
+ char *valaddr;
+ CORE_ADDR address;
+ GDB_FILE *stream;
+ int format;
+ int deref_ref;
+ int recurse;
+ enum val_prettyprint pretty;
+ {
+ unsigned int len;
+ struct type *elttype;
+ unsigned int eltlen;
+ LONGEST val;
+ CORE_ADDR addr;
+
+ switch (TYPE_CODE (type))
+ {
+ default:
+ break;
+
+ case TYPE_CODE_STRUCT:
+ if (ada_array_element_type (type) != NULL)
+ {
+ value_ptr val =
+ ada_coerce_to_simple_array_ptr (value_at_lazy (type, address));
+ return c_val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
+ VALUE_ADDRESS (val), stream, format,
+ deref_ref, recurse, pretty);
+ }
+ break;
+
+ case TYPE_CODE_ARRAY:
+ if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
+ {
+ elttype = TYPE_TARGET_TYPE (type);
+ eltlen = TYPE_LENGTH (elttype);
+ len = TYPE_LENGTH (type) / eltlen;
+ /* For an array of chars, print with string syntax. */
+ if (eltlen == 1
+ && TYPE_CODE (elttype) == TYPE_CODE_CHAR
+ && (format == 0 || format == 's'))
+ {
+ if (prettyprint_arrays)
+ {
+ print_spaces_filtered (2 + 2 * recurse, stream);
+ }
+ /* If requested, look for the first null char and only print
+ elements up to it. */
+ if (stop_print_at_null)
+ {
+ int temp_len;
+
+ /* Look for a NULL char. */
+ for (temp_len = 0;
+ valaddr[temp_len]
+ && temp_len < len && temp_len < print_max;
+ temp_len++);
+ len = temp_len;
+ }
+
+ LA_PRINT_STRING (stream, valaddr, len, 0);
+ gdb_flush (stream);
+ return len;
+ }
+ }
+ break;
+
+ }
+
+ return c_val_print (type, valaddr, address, stream, format,
+ deref_ref, recurse, pretty);
+ }
+
+ int
+ ada_value_print (val, stream, format, pretty)
+ value_ptr val;
+ GDB_FILE *stream;
+ int format;
+ enum val_prettyprint pretty;
+ {
+ /* A "repeated" value really contains several values in a row.
+ They are made by the @ operator.
+ Print such values as if they were arrays. */
+
+ #if 0
+ if (VALUE_REPEATED (val))
+ {
+ register unsigned int n = VALUE_REPETITIONS (val);
+ register unsigned int typelen = TYPE_LENGTH (VALUE_TYPE (val));
+ fprintf_filtered (stream, "{");
+ /* Print arrays of characters using string syntax. */
+ if (typelen == 1 && TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_INT
+ && format == 0)
+ LA_PRINT_STRING (stream, VALUE_CONTENTS (val), n, 0);
+ else
+ {
+ value_print_array_elements (val, stream, format, pretty);
+ }
+ fprintf_filtered (stream, "}");
+ return (n * typelen);
+ }
+ else
+ #endif
+ {
+ struct type *type = VALUE_TYPE (val);
+
+ /* If it is a pointer, indicate what it points to. */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR ||
+ TYPE_CODE (type) == TYPE_CODE_REF)
+ {
+ /* Hack: remove (char *) for char strings. Their
+ type is indicated by the quoted string anyway. */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR &&
+ TYPE_LENGTH (TYPE_TARGET_TYPE (type)) == sizeof(char) &&
+ TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_INT &&
+ !TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
+ {
+ /* Print nothing */
+ }
+ else
+ {
+ fprintf_filtered (stream, "(");
+ type_print (type, "", stream, -1);
+ fprintf_filtered (stream, ") ");
+ }
+ }
+ else if (ada_is_array_descriptor (type))
+ {
+ fprintf_filtered (stream, "(");
+ type_print (type, "", stream, -1);
+ fprintf_filtered (stream, ") ");
+ }
+ return (val_print (type, VALUE_CONTENTS (val),
+ VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
+ }
+ }
diff -c -r -N gdb-4.16/gdb/config/sparc/tm-sparc.h gdb/config/sparc/tm-sparc.h
*** gdb-4.16/gdb/config/sparc/tm-sparc.h Tue Mar 26 19:18:39 1996
--- gdb-4.16.orig/gdb/config/sparc/tm-sparc.h Sun Mar 23 16:56:41 1997
***************
*** 20,25 ****
--- 20,27 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#define TARGET_BYTE_ORDER BIG_ENDIAN
/* Floating point is IEEE compatible. */
***************
*** 248,253 ****
--- 250,259 ----
#define STORE_STRUCT_RETURN(ADDR, SP) \
{ target_write_memory ((SP)+(16*4), (char *)&(ADDR), 4); }
+
+ /* With GCC 2.6.1, always pass structures in memory. */
+
+ #define USE_STRUCT_CONVENTION(gcc_p, type) 1
/* Extract from an array REGBUF containing the (raw) register state
a function return value of type TYPE, and copy that, in virtual format,
diff -c -r -N gdb-4.16/gdb/config/sparc/tm-sun4sol2.h gdb/config/sparc/tm-sun4sol2.h
*** gdb-4.16/gdb/config/sparc/tm-sun4sol2.h Tue Aug 1 23:33:40 1995
--- gdb-4.16.orig/gdb/config/sparc/tm-sun4sol2.h Thu Mar 27 00:27:47 1997
***************
*** 71,73 ****
--- 71,76 ----
/* Enable handling of shared libraries for a.out executables. */
#define HANDLE_SVR4_EXEC_EMULATORS
+
+ /* The LBRAC bug is fixed. */
+ #undef SUN_FIXED_LBRAC_BUG
diff -c -r -N gdb-4.16/gdb/defs.h gdb/defs.h
*** gdb-4.16/gdb/defs.h Fri Apr 12 02:09:49 1996
--- gdb-4.16.orig/gdb/defs.h Sun Mar 23 16:56:42 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#ifndef DEFS_H
#define DEFS_H
***************
*** 128,134 ****
language_fortran, /* Fortran */
language_m2, /* Modula-2 */
language_asm, /* Assembly language */
! language_scm /* Scheme / Guile */
};
/* the cleanup list records things that have to be undone
--- 130,137 ----
language_fortran, /* Fortran */
language_m2, /* Modula-2 */
language_asm, /* Assembly language */
! language_scm, /* Scheme / Guile */
! language_ada
};
/* the cleanup list records things that have to be undone
***************
*** 204,209 ****
--- 207,220 ----
/* From ch-lang.c, for the moment. (FIXME) */
extern char *chill_demangle PARAMS ((const char *));
+
+ /* From ada-lang.c. For some reason, it shouldn't be (see
+ chill_demangle comment), but I have no idea what's wrong with this
+ location for ada_demangle. */
+
+ extern char *ada_demangle PARAMS ((const char*));
+
+ extern int ada_match_name PARAMS ((const char*, const char*));
/* From utils.c */
diff -c -r -N gdb-4.16/gdb/dwarfread.c gdb/dwarfread.c
*** gdb-4.16/gdb/dwarfread.c Sat Apr 6 04:10:09 1996
--- gdb-4.16.orig/gdb/dwarfread.c Sun Mar 23 16:58:14 1997
***************
*** 666,671 ****
--- 666,673 ----
cu_language = language_m2;
break;
case LANG_ADA83:
+ cu_language = language_ada;
+ break;
case LANG_COBOL74:
case LANG_COBOL85:
case LANG_FORTRAN77:
diff -c -r -N gdb-4.16/gdb/eval.c gdb/eval.c
*** gdb-4.16/gdb/eval.c Tue Apr 23 00:34:54 1996
--- gdb-4.16.orig/gdb/eval.c Sun Mar 23 16:56:43 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "gdb_string.h"
#include "symtab.h"
***************
*** 28,34 ****
#include "frame.h"
#include "demangle.h"
#include "language.h" /* For CAST_IS_CONVERSION */
! #include "f-lang.h" /* for array bound stuff */
/* Prototypes for local functions. */
--- 30,37 ----
#include "frame.h"
#include "demangle.h"
#include "language.h" /* For CAST_IS_CONVERSION */
! #include "f-lang.h" /* for array bound stuff */
! #include "ada-lang.h"
/* Prototypes for local functions. */
***************
*** 353,358 ****
--- 356,373 ----
return index;
}
+ /* Evaluate the subexpression of EXP starting at *POS as for
+ evaluate_type, updating *POS to point just past the evaluated
+ expression. */
+
+ value_ptr
+ evaluate_subexp_type (exp, pos)
+ struct expression* exp;
+ int* pos;
+ {
+ return evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
+ }
+
value_ptr
evaluate_subexp_standard (expect_type, exp, pos, noside)
struct type *expect_type;
***************
*** 362,369 ****
{
enum exp_opcode op;
int tem, tem2, tem3;
! register int pc, pc2 = 0, oldpos;
! register value_ptr arg1 = NULL, arg2 = NULL, arg3;
struct type *type;
int nargs;
value_ptr *argvec;
--- 377,384 ----
{
enum exp_opcode op;
int tem, tem2, tem3;
! int pc, pc2 = 0, oldpos;
! value_ptr arg1 = NULL, arg2 = NULL, arg3;
struct type *type;
int nargs;
value_ptr *argvec;
***************
*** 443,448 ****
--- 458,474 ----
return value_of_variable (exp->elts[pc + 2].symbol,
exp->elts[pc + 1].block);
+ case OP_UNRESOLVED_VALUE:
+ /* Only encountered when an unresolved symbol occurs in a
+ context other than a function call, in which case, it is
+ illegal. */
+ (*pos) += 3;
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ else
+ error ("Unexpected unresolved symbol, %s, during evaluation",
+ exp->elts[pc + 2].name);
+
case OP_LAST:
(*pos) += 2;
return
***************
*** 587,594 ****
return set;
}
! argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
! for (tem = 0; tem < nargs; tem++)
{
/* Ensure that array expressions are coerced into pointer objects. */
argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
--- 613,621 ----
return set;
}
! argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs + 1);
! for (tem = 0; tem == 0 || tem < nargs; tem += 1)
! /* At least one element gets inserted for the type */
{
/* Ensure that array expressions are coerced into pointer objects. */
argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
***************
*** 902,907 ****
--- 929,1099 ----
return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
+ (*pos) += 2;
+
+ /* Allocate arg vector, including space for the function to be
+ called in argvec[0] and a terminating NULL */
+ nargs = longest_to_int (exp->elts[pc + 1].longconst);
+ argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
+
+ if (exp->elts[*pos].opcode == OP_UNRESOLVED_VALUE)
+ error ("Unexpected unresolved symbol, %s, during evaluation",
+ exp->elts[pc + 5].name);
+ else
+ {
+ for (tem = 0; tem <= nargs; tem += 1)
+ argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ argvec[tem] = 0;
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ }
+
+ type = VALUE_TYPE (argvec[0]);
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ {
+ switch (TYPE_CODE (TYPE_TARGET_TYPE (type)))
+ {
+ case TYPE_CODE_FUNC:
+ type = TYPE_TARGET_TYPE (type);
+ break;
+ case TYPE_CODE_ARRAY:
+ case TYPE_CODE_STRUCT: /*FIX ME*/
+ if (noside != EVAL_AVOID_SIDE_EFFECTS)
+ argvec[0] = value_ind (argvec[0]);
+ type = TYPE_TARGET_TYPE (type);
+ break;
+ default:
+ error ("cannot subscript or call something of type `%s'",
+ TYPE_NAME (VALUE_TYPE (argvec[0])));
+ break;
+ }
+ }
+
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_FUNC:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return allocate_value (TYPE_TARGET_TYPE (type));
+ return call_function_by_hand (argvec[0], nargs, argvec + 1);
+ case TYPE_CODE_STRUCT:
+ {
+ int arity = ada_array_arity (type);
+ type = ada_array_element_type (type);
+ if (type == NULL)
+ error ("cannot subscript or call a record");
+ if (arity != nargs)
+ error ("wrong number of subscripts; expecting %d", arity);
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return allocate_value (type);
+ return ada_value_subscript (argvec[0], nargs, argvec+1);
+ }
+ case TYPE_CODE_ARRAY:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ type = ada_array_element_type (type);
+ if (type == NULL)
+ error ("element type of array unknown");
+ else
+ return allocate_value (type);
+ }
+ return ada_value_subscript (argvec[0], nargs, argvec+1);
+ default:
+ error ("Internal error in evaluate_subexp");
+ }
+
+ case UNOP_MBR:
+ (*pos) += 2;
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ type = exp->elts[pc + 1].type;
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+
+ switch (TYPE_CODE (type))
+ {
+ default:
+ warning ("Membership test incompletely implemented; always returns true");
+ return value_from_longest (builtin_type_int, (LONGEST) 1);
+
+ case TYPE_CODE_RANGE:
+ arg2 = value_from_longest (builtin_type_int,
+ (LONGEST) TYPE_LOW_BOUND (type));
+ arg3 = value_from_longest (builtin_type_int,
+ (LONGEST) TYPE_HIGH_BOUND (type));
+ return
+ value_from_longest (builtin_type_int,
+ (value_less (arg1,arg3)
+ || value_equal (arg1,arg3))
+ && (value_less (arg2,arg1)
+ || value_equal (arg2,arg1)));
+ }
+
+ case BINOP_MBR:
+ (*pos) += 2;
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (builtin_type_int, not_lval);
+
+ tem = longest_to_int (exp->elts[pc + 1].longconst);
+
+ if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
+ error ("invalid dimension number to '%s", "range");
+
+ arg3 = ada_array_bound (arg2, tem, 1);
+ arg2 = ada_array_bound (arg2, tem, 0);
+
+ return
+ value_from_longest (builtin_type_int,
+ (value_less (arg1,arg3)
+ || value_equal (arg1,arg3))
+ && (value_less (arg2,arg1)
+ || value_equal (arg2,arg1)));
+
+ case TERNOP_MBR:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+
+ return
+ value_from_longest (builtin_type_int,
+ (value_less (arg1,arg3)
+ || value_equal (arg1,arg3))
+ && (value_less (arg2,arg1)
+ || value_equal (arg2,arg1)));
+
+ case OP_LWB:
+ case OP_UPB:
+ (*pos) += 2;
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ tem = longest_to_int (exp->elts[pc + 1].longconst);
+
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+
+ if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
+ error ("invalid dimension number to '%s",
+ op == OP_LWB ? "first" : "last");
+
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ type = ada_index_type (VALUE_TYPE (arg1), tem);
+ if (type == NULL)
+ error ("attempt to take bound of something that is not an array");
+ return allocate_value (type);
+ }
+
+ return ada_array_bound (arg1, tem, op == OP_UPB);
+
case STRUCTOP_STRUCT:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
***************
*** 1026,1031 ****
--- 1218,1224 ----
case BINOP_DIV:
case BINOP_REM:
case BINOP_MOD:
+ case BINOP_EXP:
case BINOP_LSH:
case BINOP_RSH:
case BINOP_BITWISE_AND:
***************
*** 1039,1045 ****
return value_x_binop (arg1, arg2, op, OP_NULL);
else
if (noside == EVAL_AVOID_SIDE_EFFECTS
! && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
return value_zero (VALUE_TYPE (arg1), not_lval);
else
return value_binop (arg1, arg2, op);
--- 1232,1239 ----
return value_x_binop (arg1, arg2, op, OP_NULL);
else
if (noside == EVAL_AVOID_SIDE_EFFECTS
! && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD
! || BINOP_EXP))
return value_zero (VALUE_TYPE (arg1), not_lval);
else
return value_binop (arg1, arg2, op);
***************
*** 1383,1388 ****
--- 1577,1588 ----
else
return value_neg (arg1);
+ case UNOP_PLUS:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ return arg1;
+
case UNOP_COMPLEMENT:
/* C++: check for and handle destructor names. */
op = exp->elts[*pos].opcode;
***************
*** 1405,1410 ****
--- 1605,1619 ----
return value_from_longest (builtin_type_int,
(LONGEST) value_logical_not (arg1));
+ case UNOP_ABS:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ goto nosideret;
+ if (value_less (arg1, value_zero (VALUE_TYPE (arg1), not_lval)))
+ return value_neg (arg1);
+ else
+ return arg1;
+
case UNOP_IND:
if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
***************
*** 1424,1433 ****
else if (TYPE_CODE (type) == TYPE_CODE_INT)
/* GDB allows dereferencing an int. */
return value_zero (builtin_type_int, lval_memory);
else
error ("Attempt to take contents of a non-pointer value.");
}
! return value_ind (arg1);
case UNOP_ADDR:
/* C++: check for and handle pointer to members. */
--- 1633,1649 ----
else if (TYPE_CODE (type) == TYPE_CODE_INT)
/* GDB allows dereferencing an int. */
return value_zero (builtin_type_int, lval_memory);
+ else if (ada_is_array_descriptor (VALUE_TYPE (arg1)))
+ /* GDB allows dereferencing GNAT array descriptors. */
+ return value_at_lazy (ada_type_of_array (arg1, 0), 0);
else
error ("Attempt to take contents of a non-pointer value.");
}
! else if (ada_is_array_descriptor (VALUE_TYPE (arg1)))
! /* GDB allows dereferencing GNAT array descriptors. */
! return ada_coerce_to_simple_array (arg1);
! else
! return value_ind (arg1);
case UNOP_ADDR:
/* C++: check for and handle pointer to members. */
***************
*** 1631,1641 ****
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
! if (VALUE_LVAL (x) == lval_memory)
! return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
! not_lval);
! else
! error ("Attempt to take address of non-lval");
}
return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
}
--- 1847,1855 ----
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
! /* This COULD be an error, if x is not an lvalue. However, in */
! /* EVAL_AVOID_SIDE_EFFECTS mode, we will be lenient. */
! return value_zero (lookup_pointer_type (VALUE_TYPE (x)), not_lval);
}
return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
}
diff -c -r -N gdb-4.16/gdb/expprint.c gdb/expprint.c
*** gdb-4.16/gdb/expprint.c Tue Apr 23 00:34:55 1996
--- gdb-4.16.orig/gdb/expprint.c Sun Mar 23 16:56:44 1997
***************
*** 17,22 ****
--- 17,24 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
***************
*** 137,142 ****
--- 139,145 ----
return;
case OP_FUNCALL:
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
print_subexp (exp, pos, stream, PREC_SUFFIX);
***************
*** 157,162 ****
--- 160,203 ----
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
+ case UNOP_MBR:
+ (*pos) += 2;
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (" in ", stream);
+ LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0);
+ return;
+
+ case BINOP_MBR:
+ (*pos) += 2;
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (" in ", stream);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered ("'range", stream);
+ if (exp->elts[pc + 1].longconst > 1)
+ fprintf_filtered (stream, "(%d)", exp->elts[pc + 1].longconst);
+ return;
+
+ case TERNOP_MBR:
+ if (prec >= PREC_EQUAL)
+ fputs_filtered ("(", stream);
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fputs_filtered (" in ", stream);
+ print_subexp (exp, pos, stream, PREC_EQUAL);
+ fputs_filtered (" .. ", stream);
+ print_subexp (exp, pos, stream, PREC_EQUAL);
+ if (prec >= PREC_EQUAL)
+ fputs_filtered (")", stream);
+ return;
+
+ case OP_LWB:
+ case OP_UPB:
+ (*pos) += 2;
+ print_subexp (exp, pos, stream, PREC_SUFFIX);
+ fprintf_filtered (stream, "'%s(%d)",
+ opcode == OP_LWB ? "first" : "last",
+ longest_to_int (exp->elts[pc + 1].longconst));
+ return;
+
case OP_STRING:
nargs = longest_to_int (exp -> elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
***************
*** 177,187 ****
(*pos) += 3;
nargs = longest_to_int (exp->elts[pc + 2].longconst);
nargs -= longest_to_int (exp->elts[pc + 1].longconst);
! nargs++;
tem = 0;
if (exp->elts[pc + 4].opcode == OP_LONG
&& exp->elts[pc + 5].type == builtin_type_char
! && exp->language_defn->la_language == language_c)
{
/* Attempt to print C character arrays using string syntax.
Walk through the args, picking up one character from each
--- 218,231 ----
(*pos) += 3;
nargs = longest_to_int (exp->elts[pc + 2].longconst);
nargs -= longest_to_int (exp->elts[pc + 1].longconst);
! nargs += 1;
! if (nargs == 0) /* In a null array, there is a dummy element */
! (*pos) += 1;
tem = 0;
if (exp->elts[pc + 4].opcode == OP_LONG
&& exp->elts[pc + 5].type == builtin_type_char
! && (exp->language_defn->la_language == language_c
! || exp->language_defn->la_language == language_ada))
{
/* Attempt to print C character arrays using string syntax.
Walk through the args, picking up one character from each
***************
*** 572,577 ****
--- 616,628 ----
case OP_REGISTER: opcode_name = "OP_REGISTER"; break;
case OP_INTERNALVAR: opcode_name = "OP_INTERNALVAR"; break;
case OP_FUNCALL: opcode_name = "OP_FUNCALL"; break;
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
+ opcode_name = "OP_FUNCALL_OR_MULTI_SUBSCRIPT"; break;
+ case UNOP_MBR: opcode_name = "UNOP_MBR"; break;
+ case BINOP_MBR: opcode_name = "BINOP_MBR"; break;
+ case TERNOP_MBR: opcode_name = "TERNOP_MBR"; break;
+ case OP_LWB: opcode_name = "OP_LWB"; break;
+ case OP_UPB: opcode_name = "OP_UPB"; break;
case OP_STRING: opcode_name = "OP_STRING"; break;
case OP_BITSTRING: opcode_name = "OP_BITSTRING"; break;
case OP_ARRAY: opcode_name = "OP_ARRAY"; break;
diff -c -r -N gdb-4.16/gdb/expression.h gdb/expression.h
*** gdb-4.16/gdb/expression.h Tue Apr 23 00:34:55 1996
--- gdb-4.16.orig/gdb/expression.h Sun Mar 23 16:56:45 1997
***************
*** 17,22 ****
--- 17,24 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#if !defined (EXPRESSION_H)
#define EXPRESSION_H 1
***************
*** 79,84 ****
--- 81,90 ----
BINOP_MAX, /* >? */
BINOP_SCOPE, /* :: */
+ /* Ada: exp IN exp'RANGE(N). N is an immediate operand, surrounded by
+ BINOP_MBR before and after. */
+ BINOP_MBR,
+
/* STRUCTOP_MEMBER is used for pointer-to-member constructs.
X . * Y translates into X STRUCTOP_MEMBER Y. */
STRUCTOP_MEMBER,
***************
*** 128,133 ****
--- 134,142 ----
Return OP3 elements of OP1, starting with element OP2. */
TERNOP_SLICE_COUNT,
+ /* Ada: exp IN exp .. exp */
+ TERNOP_MBR,
+
/* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
The dimensionality is encoded in the operator, like the number of
function arguments in OP_FUNCALL, I.E. <OP><dimension><OP>.
***************
*** 155,160 ****
--- 164,181 ----
executing in that block; if the block is NULL use the selected frame. */
OP_VAR_VALUE,
+ /* OP_UNRESOLVED_VALUE takes a single struct block* and a char* in the
+ following exp_elements, followed by another OP_UNRESOLVED_VALUE. The
+ block indicates where to begin looking for matching symbols.
+ This is for use with overloaded names in GNAT, and must
+ be resolved into an OP_VAR_VALUE before evaluation in EVAL_NORMAL
+ mode. When evaluated in EVAL_AVOID_SIDE_EFFECTS mode, it is
+ resolved (if possible) to an OP_VAR_VALUE entry, with its block and
+ symbol entries replaced by the block and symbol from the resolving
+ entry. */
+
+ OP_UNRESOLVED_VALUE,
+
/* OP_LAST is followed by an integer in the next exp_element.
The integer is zero for the last value printed,
or it is the absolute number of a history element.
***************
*** 189,194 ****
--- 210,229 ----
literal. It is followed by exactly two args that are doubles. */
OP_COMPLEX,
+ /* GNAT operator: OP_FUNCALL_OR_MULTI_SUBSCRIPT has the same argument
+ format as OP_FUNCALL. It represents either a function call or an
+ array access, depending on the type of the subexpression in the
+ function position (the first one following). */
+ OP_FUNCALL_OR_MULTI_SUBSCRIPT,
+
+ /* GNAT upper and lower bound operators. Each is followed by an
+ integer in the next exp_element, which gives the index (1 to the
+ arity of the array). This is followed by a repetition of the
+ operator. The array whose index bound is desired is the
+ following expression. */
+ OP_LWB,
+ OP_UPB,
+
/* OP_STRING represents a string constant.
Its format is the same as that of a STRUCTOP, but the string
data is just made into a string constant when the operation
***************
*** 256,261 ****
--- 291,300 ----
OP_BOOL, /* Modula-2 builtin BOOLEAN type */
OP_M2_STRING, /* Modula-2 string constants */
+ /* Ada: exp IN type. The `type' argument is immediate, with UNOP_MBR before
+ and after it. */
+ UNOP_MBR,
+
/* STRUCTOP_... operate on a value from a following subexpression
by extracting a structure component specified by a string
that appears in the following exp_elements (as many as needed).
***************
*** 266,272 ****
The length of the string follows the opcode, followed by
BYTES_TO_EXP_ELEM(length) elements containing the data of the
string, followed by the length again and the opcode again. */
-
STRUCTOP_STRUCT,
STRUCTOP_PTR,
--- 305,310 ----
***************
*** 315,320 ****
--- 353,359 ----
struct type *type;
struct internalvar *internalvar;
struct block *block;
+ char* name;
};
struct expression
diff -c -r -N gdb-4.16/gdb/gdbtypes.c gdb/gdbtypes.c
*** gdb-4.16/gdb/gdbtypes.c Mon Jan 29 03:17:22 1996
--- gdb-4.16.orig/gdb/gdbtypes.c Sun Mar 23 16:56:46 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "gdb_string.h"
#include "bfd.h"
***************
*** 428,435 ****
if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
CHECK_TYPEDEF (element_type);
! TYPE_LENGTH (result_type) =
! TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
TYPE_NFIELDS (result_type) = 1;
TYPE_FIELDS (result_type) =
(struct field *) TYPE_ALLOC (result_type, sizeof (struct field));
--- 430,440 ----
if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
CHECK_TYPEDEF (element_type);
! if (high_bound < low_bound)
! TYPE_LENGTH (result_type) = 0;
! else
! TYPE_LENGTH (result_type) =
! TYPE_LENGTH (element_type) * (high_bound - low_bound + 1);
TYPE_NFIELDS (result_type) = 1;
TYPE_FIELDS (result_type) =
(struct field *) TYPE_ALLOC (result_type, sizeof (struct field));
diff -c -r -N gdb-4.16/gdb/language.c gdb/language.c
*** gdb-4.16/gdb/language.c Sat Mar 30 00:58:35 1996
--- gdb-4.16.orig/gdb/language.c Sun Mar 23 16:56:47 1997
***************
*** 27,32 ****
--- 27,34 ----
return data out of a "language-specific" struct pointer that is set
whenever the working language changes. That would be a lot faster. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include <ctype.h>
#include "gdb_string.h"
***************
*** 480,485 ****
--- 482,489 ----
break;
case language_chill:
error ("Missing Chill support in function binop_result_check.");/*FIXME*/
+ case language_ada:
+ error ("Missing Ada support in function binop_result_check.");/*FIXME*/
}
abort();
return (struct type *)0; /* For lint */
***************
*** 657,662 ****
--- 661,668 ----
return TYPE_CODE(type) != TYPE_CODE_INT ? 0 : 1;
case language_chill:
error ("Missing Chill support in function integral_type."); /*FIXME*/
+ case language_ada:
+ error ("Missing Ada support in function integral_type."); /*FIXME*/
default:
error ("Language not supported.");
}
***************
*** 692,697 ****
--- 698,704 ----
case language_c:
case language_cplus:
+ case language_ada:
return (TYPE_CODE(type) == TYPE_CODE_INT) &&
TYPE_LENGTH(type) == sizeof(char)
? 1 : 0;
***************
*** 716,721 ****
--- 723,732 ----
case language_cplus:
/* C does not have distinct string type. */
return (0);
+
+ case language_ada:
+ error ("Missing Ada test for strings."); /*FIXME*/
+
default:
return (0);
}
***************
*** 730,745 ****
if (TYPE_CODE (type) == TYPE_CODE_BOOL)
return 1;
switch(current_language->la_language)
! {
! case language_c:
! case language_cplus:
! /* Might be more cleanly handled by having a TYPE_CODE_INT_NOT_BOOL
! for CHILL and such languages, or a TYPE_CODE_INT_OR_BOOL for C. */
! if (TYPE_CODE (type) == TYPE_CODE_INT)
return 1;
! default:
! break;
! }
return 0;
}
--- 741,758 ----
if (TYPE_CODE (type) == TYPE_CODE_BOOL)
return 1;
switch(current_language->la_language)
! {
! case language_c:
! case language_cplus:
! case language_ada:
! /* Might be more cleanly handled by having a TYPE_CODE_INT_NOT_BOOL
! for CHILL and such languages, or a TYPE_CODE_INT_OR_BOOL for C. */
! if (TYPE_CODE (type) == TYPE_CODE_INT)
return 1;
!
! default:
! break;
! }
return 0;
}
***************
*** 780,785 ****
--- 793,800 ----
(TYPE_CODE(type) == TYPE_CODE_ARRAY);
case language_chill:
error ("Missing Chill support in function structured_type."); /*FIXME*/
+ case language_ada:
+ error ("Missing Ada support in function structured_type."); /*FIXME*/
default:
return (0);
}
***************
*** 1003,1008 ****
--- 1018,1025 ----
case language_chill:
error ("Missing Chill support in function binop_type_check.");/*FIXME*/
#endif
+ case language_ada:
+ error ("Missing Ada support in function binop_type_check.");/*FIXME*/
}
}
diff -c -r -N gdb-4.16/gdb/parse.c gdb/parse.c
*** gdb-4.16/gdb/parse.c Tue Apr 23 00:35:04 1996
--- gdb-4.16.orig/gdb/parse.c Sun Mar 23 16:56:48 1997
***************
*** 28,33 ****
--- 28,35 ----
during the process of parsing; the lower levels of the tree always
come first in the result. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "gdb_string.h"
#include "symtab.h"
***************
*** 38,43 ****
--- 40,47 ----
#include "command.h"
#include "language.h"
#include "parser-defs.h"
+ #include "ada-lang.h"
+
/* Global variables declared in parser-defs.h (and commented there). */
struct expression *expout;
***************
*** 65,70 ****
--- 69,80 ----
static void
prefixify_subexp PARAMS ((struct expression *, struct expression *, int, int));
+ static void
+ free_name_strings PARAMS ((void));
+
+ void
+ add_name_string_cleanup PARAMS ((char*));
+
/* Data structure for saving values of arglist_len for function calls whose
arguments contain other function calls. */
***************
*** 76,81 ****
--- 86,101 ----
static struct funcall *funcall_chain;
+ /* List of strings. */
+
+ struct name_list {
+ struct name_list* next;
+ char* name;
+ };
+
+ /* List of strings added by write_exp_elt_name. */
+ static struct name_list *temp_name_list;
+
/* Assign machine-independent names to certain registers
(unless overridden by the REGISTER_NAMES table) */
***************
*** 149,154 ****
--- 169,177 ----
}
}
+
+
+
/* This page contains the functions for adding data to the struct expression
being constructed. */
***************
*** 398,403 ****
--- 421,474 ----
}
write_exp_elt_opcode (UNOP_MEMVAL);
}
+
+ /* Add the appropriate element to append a pointer to a copy of the
+ contents of S to the end of the expression. Add new string to the
+ list of strings `name_string_list.' These strings are all
+ released after parsing and before expression evaluation. */
+
+ extern void write_exp_elt_name (expelt)
+ const char* expelt;
+ {
+ union exp_element tmp;
+
+ tmp.name = strsave (expelt);
+ add_name_string_cleanup (tmp.name);
+
+ write_exp_elt (tmp);
+ }
+
+ /* Add S to the list of strings that will eventually have to be
+ released after parsing and must also be released on error. */
+ void
+ add_name_string_cleanup (s)
+ char* s;
+ {
+ struct name_list* elt =
+ (struct name_list*) xmalloc (sizeof (struct name_list));
+
+ elt -> name = s;
+ elt -> next = temp_name_list;
+ temp_name_list = elt;
+ }
+
+ /* Free temp_name_list. */
+
+ static void
+ free_name_strings (void)
+ {
+ while (temp_name_list != NULL)
+ {
+ struct name_list* next = temp_name_list -> next;
+ free (temp_name_list->name);
+ free (temp_name_list);
+ temp_name_list = next;
+ }
+ temp_name_list = NULL;
+ }
+
+
+
/* Recognize tokens that start with '$'. These include:
***************
*** 550,555 ****
--- 621,627 ----
case OP_LONG:
case OP_DOUBLE:
case OP_VAR_VALUE:
+ case OP_UNRESOLVED_VALUE:
oplen = 4;
break;
***************
*** 568,577 ****
--- 640,657 ----
case OP_FUNCALL:
case OP_F77_UNDETERMINED_ARGLIST:
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
oplen = 3;
args = 1 + longest_to_int (expr->elts[endpos - 2].longconst);
break;
+ case OP_LWB:
+ case OP_UPB:
+ case UNOP_MBR:
+ oplen = 3;
+ args = 1;
+ break;
+
case UNOP_MAX:
case UNOP_MIN:
oplen = 3;
***************
*** 619,624 ****
--- 699,706 ----
oplen = 4;
args = longest_to_int (expr->elts[endpos - 2].longconst);
args -= longest_to_int (expr->elts[endpos - 3].longconst);
+ if (args == 0)
+ args = 1;
args += 1;
break;
***************
*** 625,630 ****
--- 707,713 ----
case TERNOP_COND:
case TERNOP_SLICE:
case TERNOP_SLICE_COUNT:
+ case TERNOP_MBR:
args = 3;
break;
***************
*** 635,640 ****
--- 718,724 ----
break;
case BINOP_ASSIGN_MODIFY:
+ case BINOP_MBR:
oplen = 3;
args = 2;
break;
***************
*** 690,695 ****
--- 774,780 ----
case OP_LONG:
case OP_DOUBLE:
case OP_VAR_VALUE:
+ case OP_UNRESOLVED_VALUE:
oplen = 4;
break;
***************
*** 708,717 ****
--- 793,809 ----
case OP_FUNCALL:
case OP_F77_UNDETERMINED_ARGLIST:
+ case OP_FUNCALL_OR_MULTI_SUBSCRIPT:
oplen = 3;
args = 1 + longest_to_int (inexpr->elts[inend - 2].longconst);
break;
+ case OP_LWB:
+ case OP_UPB:
+ oplen = 3;
+ args = 1;
+ break;
+
case UNOP_MIN:
case UNOP_MAX:
oplen = 3;
***************
*** 719,724 ****
--- 811,817 ----
case UNOP_CAST:
case UNOP_MEMVAL:
+ case UNOP_MBR:
oplen = 3;
args = 1;
break;
***************
*** 756,766 ****
case OP_ARRAY:
oplen = 4;
! args = longest_to_int (inexpr->elts[inend - 2].longconst);
args -= longest_to_int (inexpr->elts[inend - 3].longconst);
! args += 1;
break;
case TERNOP_COND:
case TERNOP_SLICE:
case TERNOP_SLICE_COUNT:
--- 849,862 ----
case OP_ARRAY:
oplen = 4;
! args = longest_to_int (inexpr->elts[inend - 2].longconst) + 1;
args -= longest_to_int (inexpr->elts[inend - 3].longconst);
! /* A null array contains one dummy element to give the type. */
! if (args == 0)
! args = 1;
break;
+ case TERNOP_MBR:
case TERNOP_COND:
case TERNOP_SLICE:
case TERNOP_SLICE_COUNT:
***************
*** 768,773 ****
--- 864,870 ----
break;
case BINOP_ASSIGN_MODIFY:
+ case BINOP_MBR:
oplen = 3;
args = 2;
break;
***************
*** 849,855 ****
error_no_arg ("expression to compute");
old_chain = make_cleanup (free_funcalls, 0);
! funcall_chain = 0;
expression_context_block = block ? block : get_selected_block ();
--- 946,954 ----
error_no_arg ("expression to compute");
old_chain = make_cleanup (free_funcalls, 0);
! funcall_chain = NULL;
! make_cleanup (free_name_strings, NULL);
! temp_name_list = NULL;
expression_context_block = block ? block : get_selected_block ();
***************
*** 864,879 ****
if (current_language->la_parser ())
current_language->la_error (NULL);
! discard_cleanups (old_chain);
!
! /* Record the actual number of expression elements, and then
! reallocate the expression memory so that we free up any
! excess elements. */
expout->nelts = expout_ptr;
- expout = (struct expression *)
- xrealloc ((char *) expout,
- sizeof (struct expression) + EXP_ELEM_TO_BYTES (expout_ptr));;
/* Convert expression from postfix form as generated by yacc
parser, to a prefix form. */
--- 963,971 ----
if (current_language->la_parser ())
current_language->la_error (NULL);
! /* Record the actual number of expression elements. */
expout->nelts = expout_ptr;
/* Convert expression from postfix form as generated by yacc
parser, to a prefix form. */
***************
*** 880,886 ****
--- 972,989 ----
DUMP_EXPRESSION (expout, gdb_stdout, "before conversion to prefix form");
prefixify_expression (expout);
+ if (current_language->la_language == language_ada)
+ ada_resolve (&expout);
DUMP_EXPRESSION (expout, gdb_stdout, "after conversion to prefix form");
+
+ free_name_strings ();
+ discard_cleanups (old_chain);
+
+ /* Reallocate the expression memory so that we free up any excess
+ elements. */
+ expout = (struct expression *)
+ xrealloc ((char *) expout,
+ sizeof (struct expression) + EXP_ELEM_TO_BYTES (expout->nelts));;
*stringptr = lexptr;
return expout;
diff -c -r -N gdb-4.16/gdb/parser-defs.h gdb/parser-defs.h
*** gdb-4.16/gdb/parser-defs.h Sat Mar 30 00:58:43 1996
--- gdb-4.16.orig/gdb/parser-defs.h Sun Mar 23 16:56:49 1997
***************
*** 19,24 ****
--- 19,26 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#if !defined (PARSER_DEFS_H)
#define PARSER_DEFS_H 1
***************
*** 87,92 ****
--- 89,96 ----
extern union type_stack_elt *type_stack;
extern int type_stack_depth, type_stack_size;
+ extern void add_name_string_cleanup PARAMS ((char*));
+
extern void write_exp_elt PARAMS ((union exp_element));
extern void write_exp_elt_opcode PARAMS ((enum exp_opcode));
***************
*** 109,114 ****
--- 113,120 ----
extern void write_exp_msymbol PARAMS ((struct minimal_symbol *,
struct type *, struct type *));
+
+ extern void write_exp_elt_name PARAMS ((const char*));
extern void write_dollar_variable PARAMS ((struct stoken str));
diff -c -r -N gdb-4.16/gdb/stabsread.c gdb/stabsread.c
*** gdb-4.16/gdb/stabsread.c Sat Mar 30 00:58:54 1996
--- gdb-4.16.orig/gdb/stabsread.c Sun Mar 23 16:56:50 1997
***************
*** 24,29 ****
--- 24,31 ----
COFF or ELF where the stabs data is placed in a special section.
Avoid placing any object file format specific code in this file. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "gdb_string.h"
#include "bfd.h"
diff -c -r -N gdb-4.16/gdb/symfile.c gdb/symfile.c
*** gdb-4.16/gdb/symfile.c Sat Apr 6 04:10:23 1996
--- gdb-4.16.orig/gdb/symfile.c Sun Mar 23 16:56:51 1997
***************
*** 19,24 ****
--- 19,26 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
***************
*** 787,792 ****
--- 789,795 ----
if (pst -> filename != NULL)
{
lang = deduce_language_from_filename (pst -> filename);
+ lang = ada_update_initial_language (lang, pst);
}
if (lang == language_unknown)
{
***************
*** 1321,1326 ****
--- 1324,1331 ----
return language_m2;
else if (STREQ (c, ".s") || STREQ (c, ".S"))
return language_asm;
+ else if (STREQ (c,".adb") || STREQ (c,".ads"))
+ return language_ada;
return language_unknown; /* default */
}
diff -c -r -N gdb-4.16/gdb/symtab.c gdb/symtab.c
*** gdb-4.16/gdb/symtab.c Fri Feb 16 17:14:38 1996
--- gdb-4.16.orig/gdb/symtab.c Sun Mar 23 16:56:53 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
***************
*** 33,38 ****
--- 35,41 ----
#include "expression.h"
#include "language.h"
#include "demangle.h"
+ #include "ada-lang.h"
#include "obstack.h"
***************
*** 1503,1512 ****
If the argument FUNFIRSTLINE is nonzero, we want the first line
of real code inside the function. */
! static struct symtab_and_line
! find_function_start_sal PARAMS ((struct symbol *sym, int));
!
! static struct symtab_and_line
find_function_start_sal (sym, funfirstline)
struct symbol *sym;
int funfirstline;
--- 1506,1512 ----
If the argument FUNFIRSTLINE is nonzero, we want the first line
of real code inside the function. */
! struct symtab_and_line
find_function_start_sal (sym, funfirstline)
struct symbol *sym;
int funfirstline;
***************
*** 1807,1815 ****
FILE:LINENUM -- that line in that file. PC returned is 0.
FUNCTION -- line number of openbrace of that function.
PC returned is the start of the function.
VARIABLE -- line number of definition of that variable.
PC returned is 0.
- FILE:FUNCTION -- likewise, but prefer functions in that file.
*EXPR -- line in which address EXPR appears.
FUNCTION may be an undebuggable function found in minimal symbol table.
--- 1807,1817 ----
FILE:LINENUM -- that line in that file. PC returned is 0.
FUNCTION -- line number of openbrace of that function.
PC returned is the start of the function.
+ FILE:FUNCTION -- likewise, but prefer functions in that file.
+ FILE:FUNCTION:LINENUM -- likewise, but prefer function whose open
+ brace is "near" line.
VARIABLE -- line number of definition of that variable.
PC returned is 0.
*EXPR -- line in which address EXPR appears.
FUNCTION may be an undebuggable function found in minimal symbol table.
***************
*** 1823,1832 ****
DEFAULT_LINE specifies the line number to use for relative
line numbers (that start with signs). Defaults to current_source_line.
If CANONICAL is non-NULL, store an array of strings containing the canonical
! line specs there if necessary. Currently overloaded member functions and
! line numbers or static functions without a filename yield a canonical
! line spec. The array and the line spec strings are allocated on the heap,
! it is the callers responsibility to free them.
Note that it is possible to return zero for the symtab
if no file is validly specified. Callers must check that.
--- 1825,1835 ----
DEFAULT_LINE specifies the line number to use for relative
line numbers (that start with signs). Defaults to current_source_line.
If CANONICAL is non-NULL, store an array of strings containing the canonical
! line specs there if necessary. Currently overloaded functions,
! overloaded member functions, and line numbers or static functions
! without a filename yield a canonical line spec. The array and the
! line spec strings are allocated on the heap; it is the caller's
! responsibility to free them.
Note that it is possible to return zero for the symtab
if no file is validly specified. Callers must check that.
***************
*** 1892,1897 ****
--- 1895,1901 ----
char *copy;
struct symbol *sym_class;
int i1;
+ int preferred_line;
int is_quoted, has_parens;
struct symbol **sym_arr;
struct type *t;
***************
*** 2215,2223 ****
{
p = pp+1;
}
! else
{
! p = skip_quoted(*argptr);
}
copy = (char *) alloca (p - *argptr + 1);
--- 2219,2239 ----
{
p = pp+1;
}
! else if (current_language->la_language == language_ada)
! {
! /* Ada names may contain '.'s. It is probably harmless to do this for
! all languages, but I'll leave to others to decide. */
! p = *argptr;
! while (1) {
! p = skip_quoted (p);
! if (*p != '.')
! break;
! p += 1;
! }
! }
! else
{
! p = skip_quoted (*argptr);
}
copy = (char *) alloca (p - *argptr + 1);
***************
*** 2257,2262 ****
--- 2273,2297 ----
build_canonical_line_spec (values.sals, NULL, canonical);
return values;
+ }
+
+ preferred_line = -1;
+ if ((*argptr)[0] == ':' && isdigit ((*argptr)[1]))
+ {
+ preferred_line = strtol (*argptr + 1, argptr, 10);
+ while (**argptr == ' ' || **argptr == '\t')
+ *argptr += 1;
+ }
+ if (current_language->la_language == language_ada)
+ {
+ values =
+ ada_finish_decode_line_1 (copy, preferred_line, funfirstline,
+ (s ? BLOCKVECTOR_BLOCK (BLOCKVECTOR (s),
+ STATIC_BLOCK)
+ : get_selected_block ()),
+ canonical);
+ if (values.nelts != 0)
+ return values;
}
diff -c -r -N gdb-4.16/gdb/symtab.h gdb/symtab.h
*** gdb-4.16/gdb/symtab.h Mon Feb 19 12:38:31 1996
--- gdb-4.16.orig/gdb/symtab.h Sun Mar 23 16:56:54 1997
***************
*** 17,22 ****
--- 17,24 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#if !defined (SYMTAB_H)
#define SYMTAB_H 1
***************
*** 92,97 ****
--- 94,103 ----
{
char *demangled_name;
} chill_specific;
+ struct ada_specific /* For Ada */
+ {
+ char *demangled_name;
+ } ada_specific;
} language_specific;
/* Record the source code language that applies to this symbol.
***************
*** 136,141 ****
--- 142,151 ----
{ \
SYMBOL_CHILL_DEMANGLED_NAME (symbol) = NULL; \
} \
+ else if (SYMBOL_LANGUAGE (symbol) == language_ada) \
+ { \
+ SYMBOL_ADA_DEMANGLED_NAME (symbol) = NULL; \
+ } \
else \
{ \
memset (&(symbol)->ginfo.language_specific, 0, \
***************
*** 190,195 ****
--- 200,223 ----
SYMBOL_CHILL_DEMANGLED_NAME (symbol) = NULL; \
} \
} \
+ if (demangled == NULL \
+ && (SYMBOL_LANGUAGE (symbol) == language_ada \
+ || SYMBOL_LANGUAGE (symbol) == language_auto)) \
+ { \
+ demangled = \
+ ada_demangle (SYMBOL_NAME (symbol)); \
+ if (demangled != NULL) \
+ { \
+ SYMBOL_LANGUAGE (symbol) = language_ada; \
+ SYMBOL_ADA_DEMANGLED_NAME (symbol) = \
+ obsavestring (demangled, strlen (demangled), (obstack)); \
+ free (demangled); \
+ } \
+ else \
+ { \
+ SYMBOL_ADA_DEMANGLED_NAME (symbol) = NULL; \
+ } \
+ } \
if (SYMBOL_LANGUAGE (symbol) == language_auto) \
{ \
SYMBOL_LANGUAGE (symbol) = language_unknown; \
***************
*** 204,219 ****
? SYMBOL_CPLUS_DEMANGLED_NAME (symbol) \
: (SYMBOL_LANGUAGE (symbol) == language_chill \
? SYMBOL_CHILL_DEMANGLED_NAME (symbol) \
! : NULL))
#define SYMBOL_CHILL_DEMANGLED_NAME(symbol) \
(symbol)->ginfo.language_specific.chill_specific.demangled_name
! /* Macro that returns the "natural source name" of a symbol. In C++ this is
! the "demangled" form of the name if demangle is on and the "mangled" form
! of the name if demangle is off. In other languages this is just the
! symbol name. The result should never be NULL. */
#define SYMBOL_SOURCE_NAME(symbol) \
(demangle && SYMBOL_DEMANGLED_NAME (symbol) != NULL \
? SYMBOL_DEMANGLED_NAME (symbol) \
--- 232,252 ----
? SYMBOL_CPLUS_DEMANGLED_NAME (symbol) \
: (SYMBOL_LANGUAGE (symbol) == language_chill \
? SYMBOL_CHILL_DEMANGLED_NAME (symbol) \
! : (SYMBOL_LANGUAGE (symbol) == language_ada \
! ? SYMBOL_ADA_DEMANGLED_NAME (symbol) \
! : NULL)))
#define SYMBOL_CHILL_DEMANGLED_NAME(symbol) \
(symbol)->ginfo.language_specific.chill_specific.demangled_name
! #define SYMBOL_ADA_DEMANGLED_NAME(symbol) \
! (symbol)->ginfo.language_specific.ada_specific.demangled_name
+ /* Macro that returns the "natural source name" of a symbol. In C++ or Ada
+ this is the "demangled" form of the name if demangle is on and
+ the "mangled" form of the name if demangle is off. In other languages
+ this is just the symbol name. The result should never be NULL. */
+
#define SYMBOL_SOURCE_NAME(symbol) \
(demangle && SYMBOL_DEMANGLED_NAME (symbol) != NULL \
? SYMBOL_DEMANGLED_NAME (symbol) \
***************
*** 240,246 ****
#define SYMBOL_MATCHES_NAME(symbol, name) \
(STREQ (SYMBOL_NAME (symbol), (name)) \
|| (SYMBOL_DEMANGLED_NAME (symbol) != NULL \
! && strcmp_iw (SYMBOL_DEMANGLED_NAME (symbol), (name)) == 0))
/* Macro that tests a symbol for an re-match against the last compiled regular
expression. First test the unencoded name, then look for and test a C++
--- 273,281 ----
#define SYMBOL_MATCHES_NAME(symbol, name) \
(STREQ (SYMBOL_NAME (symbol), (name)) \
|| (SYMBOL_DEMANGLED_NAME (symbol) != NULL \
! && strcmp_iw (SYMBOL_DEMANGLED_NAME (symbol), (name)) == 0) \
! || (SYMBOL_LANGUAGE (symbol) == language_ada \
! && ada_match_name (SYMBOL_SOURCE_NAME (symbol), (name))))
/* Macro that tests a symbol for an re-match against the last compiled regular
expression. First test the unencoded name, then look for and test a C++
***************
*** 1108,1113 ****
--- 1143,1155 ----
int nelts;
};
+ /* Given a function symbol SYM, find the symtab and line for the start
+ of the function. If the argument FUNFIRSTLINE is nonzero, we want the
+ first line of real code inside the function. */
+
+ extern struct symtab_and_line
+ find_function_start_sal PARAMS ((struct symbol *sym, int));
+
/* Given a pc value, return line number it is in. Second arg nonzero means
if pc is on the boundary use the previous statement's line number. */
***************
*** 1213,1218 ****
--- 1255,1268 ----
extern enum language
deduce_language_from_filename PARAMS ((char *));
+
+ /* ada-lang.c */
+
+ extern int
+ ada_match_name PARAMS ((const char*, const char*));
+
+ extern enum language
+ ada_update_initial_language PARAMS ((enum language, struct partial_symtab*));
/* symtab.c */
diff -c -r -N gdb-4.16/gdb/top.c gdb/top.c
*** gdb-4.16/gdb/top.c Sat Apr 13 00:51:43 1996
--- gdb-4.16.orig/gdb/top.c Sun Mar 23 16:56:56 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "gdbcmd.h"
#include "call-cmds.h"
***************
*** 1113,1120 ****
/* Set the instream to 0, indicating execution of a
user-defined function. */
! old_chain = make_cleanup (source_cleanup, instream);
instream = (FILE *) 0;
while (cmdlines)
{
ret = execute_control_command (cmdlines);
--- 1115,1123 ----
/* Set the instream to 0, indicating execution of a
user-defined function. */
! make_cleanup (source_cleanup, instream);
instream = (FILE *) 0;
+
while (cmdlines)
{
ret = execute_control_command (cmdlines);
***************
*** 1125,1130 ****
--- 1128,1134 ----
}
cmdlines = cmdlines->next;
}
+
do_cleanups (old_chain);
}
***************
*** 1154,1161 ****
if (*p)
{
char *arg;
- c = lookup_cmd (&p, cmdlist, "", 0, 1);
/* Pass null arg rather than an empty one. */
arg = *p ? p : 0;
--- 1158,1179 ----
if (*p)
{
char *arg;
+
+ if (current_language->la_language == language_ada)
+ {
+ c = lookup_cmd (&p, cmdlist, "", 1, 1);
+ if (c == NULL)
+ {
+ char* call_cmd = (char *) alloca (strlen(p) + 5);
+ strcpy (call_cmd, "call ");
+ strcat (call_cmd, p);
+ execute_command (call_cmd, from_tty);
+ return;
+ }
+ }
+ else
+ c = lookup_cmd (&p, cmdlist, "", 0, 1);
/* Pass null arg rather than an empty one. */
arg = *p ? p : 0;
diff -c -r -N gdb-4.16/gdb/utils.c gdb/utils.c
*** gdb-4.16/gdb/utils.c Tue Apr 23 00:35:13 1996
--- gdb-4.16.orig/gdb/utils.c Sun Mar 23 16:56:57 1997
***************
*** 17,22 ****
--- 17,24 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#if !defined(__GO32__) && !defined(__WIN32__) && !defined(MPW)
#include <sys/ioctl.h>
***************
*** 1788,1793 ****
--- 1790,1798 ----
break;
case language_chill:
demangled = chill_demangle (name);
+ break;
+ case language_ada:
+ demangled = ada_demangle (name);
break;
default:
demangled = NULL;
diff -c -r -N gdb-4.16/gdb/valarith.c gdb/valarith.c
*** gdb-4.16/gdb/valarith.c Sat Mar 30 00:59:03 1996
--- gdb-4.16.orig/gdb/valarith.c Sun Mar 23 16:56:57 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "value.h"
#include "symtab.h"
***************
*** 37,42 ****
--- 39,47 ----
static value_ptr value_subscripted_rvalue PARAMS ((value_ptr, value_ptr, int));
+ static struct type*
+ base_type PARAMS ((struct type*));
+
value_ptr
value_add (arg1, arg2)
***************
*** 54,61 ****
if ((TYPE_CODE (type1) == TYPE_CODE_PTR
|| TYPE_CODE (type2) == TYPE_CODE_PTR)
&&
! (TYPE_CODE (type1) == TYPE_CODE_INT
! || TYPE_CODE (type2) == TYPE_CODE_INT))
/* Exactly one argument is a pointer, and one is an integer. */
{
if (TYPE_CODE (type1) == TYPE_CODE_PTR)
--- 59,66 ----
if ((TYPE_CODE (type1) == TYPE_CODE_PTR
|| TYPE_CODE (type2) == TYPE_CODE_PTR)
&&
! (TYPE_CODE (base_type(type1)) == TYPE_CODE_INT
! || TYPE_CODE (base_type(type2)) == TYPE_CODE_INT))
/* Exactly one argument is a pointer, and one is an integer. */
{
if (TYPE_CODE (type1) == TYPE_CODE_PTR)
***************
*** 92,98 ****
if (TYPE_CODE (type1) == TYPE_CODE_PTR)
{
! if (TYPE_CODE (type2) == TYPE_CODE_INT)
{
/* pointer - integer. */
LONGEST sz = TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type1)));
--- 97,103 ----
if (TYPE_CODE (type1) == TYPE_CODE_PTR)
{
! if (TYPE_CODE (base_type(type2)) == TYPE_CODE_INT)
{
/* pointer - integer. */
LONGEST sz = TYPE_LENGTH (check_typedef (TYPE_TARGET_TYPE (type1)));
***************
*** 488,494 ****
to the second of the two concatenated values or the value to be
repeated. */
! if (TYPE_CODE (type2) == TYPE_CODE_INT)
{
struct type *tmp = type1;
type1 = tmp;
--- 493,499 ----
to the second of the two concatenated values or the value to be
repeated. */
! if (TYPE_CODE (base_type(type2)) == TYPE_CODE_INT)
{
struct type *tmp = type1;
type1 = tmp;
***************
*** 504,510 ****
/* Now process the input values. */
! if (TYPE_CODE (type1) == TYPE_CODE_INT)
{
/* We have a repeat count. Validate the second value and then
construct a value repeated that many times. */
--- 509,515 ----
/* Now process the input values. */
! if (TYPE_CODE (base_type(type1)) == TYPE_CODE_INT)
{
/* We have a repeat count. Validate the second value and then
construct a value repeated that many times. */
***************
*** 601,606 ****
--- 606,615 ----
Does not support addition and subtraction on pointers;
use value_add or value_sub if you want to handle those possibilities. */
+ /* FIXME: There are several references in here to current_language ->
+ la_language that ought to be references to the type of the current
+ expression. At the moment, that information is not passed in. */
+
value_ptr
value_binop (arg1, arg2, op)
value_ptr arg1, arg2;
***************
*** 629,635 ****
&& TYPE_CODE (type2) != TYPE_CODE_RANGE))
error ("Argument to arithmetic operation not a number or boolean.");
! if (TYPE_CODE (type1) == TYPE_CODE_FLT
||
TYPE_CODE (type2) == TYPE_CODE_FLT)
{
--- 638,708 ----
&& TYPE_CODE (type2) != TYPE_CODE_RANGE))
error ("Argument to arithmetic operation not a number or boolean.");
! if (op == BINOP_EXP)
! {
! LONGEST n;
! if (TYPE_CODE (base_type (VALUE_TYPE (arg2))) != TYPE_CODE_INT)
! error ("Must raise to integral powers");
! n = value_as_long (arg2);
!
! if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_FLT)
! {
! double v, v1;
!
! v1 = value_as_double (arg1);
! v = 1.0;
!
! if (n < 0)
! n = -n;
!
! while (n != 0)
! {
! if (n & 1L)
! v *= v1;
! n >>= 1;
! if (n != 0)
! v1 *= v1;
! }
!
! if (value_as_long (arg2) < 0)
! v = 1.0/v;
!
! val = allocate_value (builtin_type_double);
! store_floating (VALUE_CONTENTS_RAW (val),
! TYPE_LENGTH (VALUE_TYPE (val)),
! v);
! }
! else if (TYPE_CODE (base_type (VALUE_TYPE (arg1))) == TYPE_CODE_INT)
! {
! LONGEST v, v1;
!
! if (n < 0)
! error ("Must raise integers to non-negative powers.");
!
! v1 = value_as_double (arg1);
! v = 1;
!
! while (n = 0)
! {
! if (n & 1L)
! v *= v1;
! n >>= 1;
! if (n != 0)
! v1 *= v1;
! }
!
! val = allocate_value
! (sizeof (LONGEST) > TARGET_LONG_BIT / HOST_CHAR_BIT
! ? builtin_type_long_long
! : builtin_type_long);
! store_signed_integer (VALUE_CONTENTS_RAW (val),
! TYPE_LENGTH (VALUE_TYPE (val)),
! v);
! }
! else
! error ("Arguments to exponentiation must be FLOAT**INT or INT**INT.");
! }
! else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_FLT
||
TYPE_CODE (type2) == TYPE_CODE_FLT)
{
***************
*** 789,796 ****
case BINOP_MOD:
/* Knuth 1.2.4, integer only. Note that unlike the C '%' op,
v1 mod 0 has a defined value, v1. */
! /* Chill specifies that v2 must be > 0, so check for that. */
! if (current_language -> la_language == language_chill
&& value_as_long (arg2) <= 0)
{
error ("Second operand of MOD must be greater than zero.");
--- 862,870 ----
case BINOP_MOD:
/* Knuth 1.2.4, integer only. Note that unlike the C '%' op,
v1 mod 0 has a defined value, v1. */
! /* For Chill and Ada, check that v2 != 0 */
! if ((current_language -> la_language == language_chill
! || current_language -> la_language == language_ada)
&& value_as_long (arg2) <= 0)
{
error ("Second operand of MOD must be greater than zero.");
***************
*** 894,914 ****
case BINOP_DIV:
v = v1 / v2;
break;
case BINOP_REM:
v = v1 % v2;
break;
case BINOP_MOD:
/* Knuth 1.2.4, integer only. Note that unlike the C '%' op,
X mod 0 has a defined value, X. */
! /* Chill specifies that v2 must be > 0, so check for that. */
if (current_language -> la_language == language_chill
&& v2 <= 0)
{
error ("Second operand of MOD must be greater than zero.");
}
if (v2 == 0)
{
v = v1;
--- 968,1002 ----
case BINOP_DIV:
v = v1 / v2;
+ /* In Ada, integer division always truncates towards 0. */
+ if (! TRUNCATION_TOWARDS_ZERO
+ && current_language -> la_language == language_ada
+ && v1 * (v1%v2) < 0)
+ v += v > 0 ? -1 : 1;
break;
case BINOP_REM:
v = v1 % v2;
+ /* In Ada, REM has sign of v1. */
+ if (current_language -> la_language == language_ada
+ && v*v1 < 0)
+ v -= v2;
break;
case BINOP_MOD:
/* Knuth 1.2.4, integer only. Note that unlike the C '%' op,
X mod 0 has a defined value, X. */
! /* Chill requires that v2 > 0 and Ada that v2 != 0. */
if (current_language -> la_language == language_chill
&& v2 <= 0)
{
error ("Second operand of MOD must be greater than zero.");
}
+ else if (current_language -> la_language == language_ada
+ && v2 == 0)
+ {
+ error ("Second operand of MOD must not be zero.");
+ }
if (v2 == 0)
{
v = v1;
***************
*** 995,1000 ****
--- 1083,1105 ----
return val;
}
+ /* The identity on non-range types. For range types, the underlying */
+ /* non-range scalar type. */
+
+ static struct type*
+ base_type (type)
+ struct type* type;
+ {
+ while (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE)
+ {
+ if (type == TYPE_TARGET_TYPE (type)
+ || TYPE_TARGET_TYPE (type) == NULL)
+ return type;
+ type = TYPE_TARGET_TYPE (type);
+ }
+ return type;
+ }
+
/* Simulate the C operator ! -- return 1 if ARG1 contains zero. */
int
***************
*** 1042,1049 ****
type1 = check_typedef (VALUE_TYPE (arg1));
type2 = check_typedef (VALUE_TYPE (arg2));
! code1 = TYPE_CODE (type1);
! code2 = TYPE_CODE (type2);
if (code1 == TYPE_CODE_INT && code2 == TYPE_CODE_INT)
return longest_to_int (value_as_long (value_binop (arg1, arg2,
--- 1147,1154 ----
type1 = check_typedef (VALUE_TYPE (arg1));
type2 = check_typedef (VALUE_TYPE (arg2));
! code1 = TYPE_CODE (base_type(type1));
! code2 = TYPE_CODE (base_type(type2));
if (code1 == TYPE_CODE_INT && code2 == TYPE_CODE_INT)
return longest_to_int (value_as_long (value_binop (arg1, arg2,
***************
*** 1095,1102 ****
type1 = check_typedef (VALUE_TYPE (arg1));
type2 = check_typedef (VALUE_TYPE (arg2));
! code1 = TYPE_CODE (type1);
! code2 = TYPE_CODE (type2);
if (code1 == TYPE_CODE_INT && code2 == TYPE_CODE_INT)
return longest_to_int (value_as_long (value_binop (arg1, arg2,
--- 1200,1207 ----
type1 = check_typedef (VALUE_TYPE (arg1));
type2 = check_typedef (VALUE_TYPE (arg2));
! code1 = TYPE_CODE (base_type(type1));
! code2 = TYPE_CODE (base_type(type2));
if (code1 == TYPE_CODE_INT && code2 == TYPE_CODE_INT)
return longest_to_int (value_as_long (value_binop (arg1, arg2,
***************
*** 1132,1138 ****
COERCE_REF (arg1);
COERCE_ENUM (arg1);
! type = check_typedef (VALUE_TYPE (arg1));
if (TYPE_CODE (type) == TYPE_CODE_FLT)
return value_from_double (type, - value_as_double (arg1));
--- 1237,1243 ----
COERCE_REF (arg1);
COERCE_ENUM (arg1);
! type = base_type(check_typedef (VALUE_TYPE (arg1)));
if (TYPE_CODE (type) == TYPE_CODE_FLT)
return value_from_double (type, - value_as_double (arg1));
***************
*** 1151,1160 ****
COERCE_REF (arg1);
COERCE_ENUM (arg1);
! if (TYPE_CODE (check_typedef (VALUE_TYPE (arg1))) != TYPE_CODE_INT)
error ("Argument to complement operation not an integer.");
! return value_from_longest (VALUE_TYPE (arg1), ~ value_as_long (arg1));
}
/* The INDEX'th bit of SET value whose VALUE_TYPE is TYPE,
--- 1256,1265 ----
COERCE_REF (arg1);
COERCE_ENUM (arg1);
! if (TYPE_CODE (base_type(check_typedef (VALUE_TYPE (arg1)))) != TYPE_CODE_INT)
error ("Argument to complement operation not an integer.");
! return value_from_longest (base_type(VALUE_TYPE (arg1)), ~ value_as_long (arg1));
}
/* The INDEX'th bit of SET value whose VALUE_TYPE is TYPE,
diff -c -r -N gdb-4.16/gdb/valops.c gdb/valops.c
*** gdb-4.16/gdb/valops.c Sat Mar 30 00:59:06 1996
--- gdb-4.16.orig/gdb/valops.c Sun Mar 23 16:56:59 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
***************
*** 28,33 ****
--- 30,36 ----
#include "target.h"
#include "demangle.h"
#include "language.h"
+ #include "ada-lang.h" /* For ada_convert_actuals */
#include <errno.h>
#include "gdb_string.h"
***************
*** 1019,1026 ****
int nargs;
value_ptr *args;
{
! register CORE_ADDR sp;
! register int i;
CORE_ADDR start_sp;
/* CALL_DUMMY is an array of words (REGISTER_SIZE), but each word
is in host byte order. Before calling FIX_CALL_DUMMY, we byteswap it
--- 1022,1029 ----
int nargs;
value_ptr *args;
{
! CORE_ADDR sp;
! int i;
CORE_ADDR start_sp;
/* CALL_DUMMY is an array of words (REGISTER_SIZE), but each word
is in host byte order. Before calling FIX_CALL_DUMMY, we byteswap it
***************
*** 1050,1056 ****
they are saved on the stack in the inferior. */
PUSH_DUMMY_FRAME;
! old_sp = sp = read_sp ();
#if 1 INNER_THAN 2 /* Stack grows down */
sp -= sizeof dummy1;
--- 1053,1062 ----
they are saved on the stack in the inferior. */
PUSH_DUMMY_FRAME;
! sp = read_sp ();
! ada_convert_actuals (function, nargs, args, &sp);
!
! old_sp = sp;
#if 1 INNER_THAN 2 /* Stack grows down */
sp -= sizeof dummy1;
***************
*** 1347,1356 ****
the data into that space, and then setting up an array value.
The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
! populated from the values passed in ELEMVEC.
! The element type of the array is inherited from the type of the
! first element, and all elements must have the same size (though we
don't currently enforce any restriction on their types). */
value_ptr
--- 1353,1363 ----
the data into that space, and then setting up an array value.
The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
! populated from the values passed in ELEMVEC. There must always be at
! least one element in ELEMVEC, even if LOWBOUND > HIGHBOUND.
! The element type of the array is inherited from the type of
! ELEMVEC[0], and all elements must have the same size (though we
don't currently enforce any restriction on their types). */
value_ptr
***************
*** 1371,1377 ****
have the same size. */
nelem = highbound - lowbound + 1;
! if (nelem <= 0)
{
error ("bad array bounds (%d, %d)", lowbound, highbound);
}
--- 1378,1384 ----
have the same size. */
nelem = highbound - lowbound + 1;
! if (nelem < 0)
{
error ("bad array bounds (%d, %d)", lowbound, highbound);
}
diff -c -r -N gdb-4.16/gdb/values.c gdb/values.c
*** gdb-4.16/gdb/values.c Sat Mar 30 00:59:10 1996
--- gdb-4.16.orig/gdb/values.c Sun Mar 23 16:57:00 1997
***************
*** 18,23 ****
--- 18,25 ----
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ /* Modified for GNAT by P. N. Hilfinger */
+
#include "defs.h"
#include "gdb_string.h"
#include "symtab.h"
***************
*** 1298,1313 ****
int struct_return;
/*ARGSUSED*/
{
! register value_ptr val;
CORE_ADDR addr;
#if defined (EXTRACT_STRUCT_VALUE_ADDRESS)
/* If this is not defined, just use EXTRACT_RETURN_VALUE instead. */
if (struct_return) {
addr = EXTRACT_STRUCT_VALUE_ADDRESS (retbuf);
if (!addr)
error ("Function return value unknown");
! return value_at (valtype, addr);
}
#endif
--- 1300,1321 ----
int struct_return;
/*ARGSUSED*/
{
! value_ptr val;
CORE_ADDR addr;
#if defined (EXTRACT_STRUCT_VALUE_ADDRESS)
/* If this is not defined, just use EXTRACT_RETURN_VALUE instead. */
if (struct_return) {
+
addr = EXTRACT_STRUCT_VALUE_ADDRESS (retbuf);
if (!addr)
error ("Function return value unknown");
! val = value_at (valtype, addr);
! /* The memory location containing this value must be assumed to
! vanish, so make sure nobody is fooled into thinking this value
! is addressable. */
! VALUE_LVAL (val) = not_lval;
! return val;
}
#endif
More information about the Gdb-patches
mailing list