This is the mail archive of the gdb@sourceware.cygnus.com mailing list for the GDB project. See the GDB home page for more information.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
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