* NEWS: Menion that CHILL has been made obsolete.
* gdbtypes.c (chill_varying_type): Make chill references obsolete.
* gdbserver/Makefile.in: Ditto.
* stabsread.c (read_range_type): Ditto.
* gdbtypes.h: Ditto.
* language.c (binop_type_check): Ditto.
(binop_result_type): Ditto.
(integral_type): Ditto.
(character_type): Ditto.
(string_type): Ditto.
(boolean_type): Ditto.
(structured_type): Ditto.
(lang_bool_type): Ditto.
(binop_type_check): Ditto.
* language.h (_LANG_chill): Ditto.
* dwarfread.c (set_cu_language): Ditto.
* dwarfread.c (CHILL_PRODUCER): Ditto.
* dwarfread.c (handle_producer): Ditto.
* expression.h (enum exp_opcode): Ditto.
* eval.c: Ditto for comments.
* typeprint.c (typedef_print) [_LANG_chill]: Ditto.
* expprint.c (print_subexp): Ditto.
(print_subexp): Ditto.
* valops.c (value_cast): Ditto.
(search_struct_field): Ditto.
* value.h (COERCE_VARYING_ARRAY): Ditto.
* symfile.c (init_filename_language_table): Ditto.
(add_psymbol_with_dem_name_to_list): Ditto.
* valarith.c (value_binop): Ditto.
(value_neg): Ditto.
* valops.c (value_slice): Ditto.
* symtab.h (union language_specific): Ditto.
(SYMBOL_INIT_LANGUAGE_SPECIFIC): Ditto.
(SYMBOL_DEMANGLED_NAME): Ditto.
(SYMBOL_CHILL_DEMANGLED_NAME): Ditto.
* defs.h (enum language): Ditto.
* symtab.c (got_symtab): Ditto.
* utils.c (fprintf_symbol_filtered): Ditto.
* ch-typeprint.c: Make file obsolete.
* ch-valprint.c: Make file obsolete.
* ch-lang.h: Make file obsolete.
* ch-exp.c: Make file obsolete.
* ch-lang.c: Make file obsolete.
* Makefile.in (FLAGS_TO_PASS): Do not pass CHILL or CHILLFLAGS or
CHILL_LIB.
(TARGET_FLAGS_TO_PASS): Ditto.
(CHILLFLAGS): Obsolete.
(CHILL): Obsolete.
(CHILL_FOR_TARGET): Obsolete.
(CHILL_LIB): Obsolete.
(SFILES): Remove ch-exp.c, ch-lang.c, ch-typeprint.c and
ch-valprint.c.
(HFILES_NO_SRCDIR): Remove ch-lang.h.
(COMMON_OBS): Remove ch-valprint.o, ch-typeprint.o, ch-exp.o and
ch-lang.o.
(ch-exp.o, ch-lang.o, ch-typeprint.o, ch-valprint.o): Delete
targets.
2002-08-01 Andrew Cagney <cagney@redhat.com>
* stabs.texinfo, gdb.texinfo, gdbint.texinfo: Obsolete references
to CHILL.
2002-08-01 Andrew Cagney <cagney@redhat.com>
* Makefile.in (TARGET_FLAGS_TO_PASS): Remove CHILLFLAGS, CHILL,
CHILL_FOR_TARGET and CHILL_LIB.
* configure.in (configdirs): Remove gdb.chill.
* configure: Regenerate.
* lib/gdb.exp: Obsolete references to chill.
* gdb.fortran/types.exp: Ditto.
* gdb.fortran/exprs.exp: Ditto.
+2002-08-01 Andrew Cagney <cagney@redhat.com>
+
+ * NEWS: Menion that CHILL has been made obsolete.
+
+ * gdbtypes.c (chill_varying_type): Make chill references obsolete.
+ * gdbserver/Makefile.in: Ditto.
+ * stabsread.c (read_range_type): Ditto.
+ * gdbtypes.h: Ditto.
+ * language.c (binop_type_check): Ditto.
+ (binop_result_type): Ditto.
+ (integral_type): Ditto.
+ (character_type): Ditto.
+ (string_type): Ditto.
+ (boolean_type): Ditto.
+ (structured_type): Ditto.
+ (lang_bool_type): Ditto.
+ (binop_type_check): Ditto.
+ * language.h (_LANG_chill): Ditto.
+ * dwarfread.c (set_cu_language): Ditto.
+ * dwarfread.c (CHILL_PRODUCER): Ditto.
+ * dwarfread.c (handle_producer): Ditto.
+ * expression.h (enum exp_opcode): Ditto.
+ * eval.c: Ditto for comments.
+ * typeprint.c (typedef_print) [_LANG_chill]: Ditto.
+ * expprint.c (print_subexp): Ditto.
+ (print_subexp): Ditto.
+ * valops.c (value_cast): Ditto.
+ (search_struct_field): Ditto.
+ * value.h (COERCE_VARYING_ARRAY): Ditto.
+ * symfile.c (init_filename_language_table): Ditto.
+ (add_psymbol_with_dem_name_to_list): Ditto.
+ * valarith.c (value_binop): Ditto.
+ (value_neg): Ditto.
+ * valops.c (value_slice): Ditto.
+ * symtab.h (union language_specific): Ditto.
+ (SYMBOL_INIT_LANGUAGE_SPECIFIC): Ditto.
+ (SYMBOL_DEMANGLED_NAME): Ditto.
+ (SYMBOL_CHILL_DEMANGLED_NAME): Ditto.
+ * defs.h (enum language): Ditto.
+ * symtab.c (got_symtab): Ditto.
+ * utils.c (fprintf_symbol_filtered): Ditto.
+
+ * ch-typeprint.c: Make file obsolete.
+ * ch-valprint.c: Make file obsolete.
+ * ch-lang.h: Make file obsolete.
+ * ch-exp.c: Make file obsolete.
+ * ch-lang.c: Make file obsolete.
+
+ * Makefile.in (FLAGS_TO_PASS): Do not pass CHILL or CHILLFLAGS or
+ CHILL_LIB.
+ (TARGET_FLAGS_TO_PASS): Ditto.
+ (CHILLFLAGS): Obsolete.
+ (CHILL): Obsolete.
+ (CHILL_FOR_TARGET): Obsolete.
+ (CHILL_LIB): Obsolete.
+ (SFILES): Remove ch-exp.c, ch-lang.c, ch-typeprint.c and
+ ch-valprint.c.
+ (HFILES_NO_SRCDIR): Remove ch-lang.h.
+ (COMMON_OBS): Remove ch-valprint.o, ch-typeprint.o, ch-exp.o and
+ ch-lang.o.
+ (ch-exp.o, ch-lang.o, ch-typeprint.o, ch-valprint.o): Delete
+ targets.
+
2002-07-31 Joel Brobecker <brobecker@gnat.com>
* dwarf2read.c (set_cu_language): Add handler for LANG_Ada95.
"AR_FLAGS=$(AR_FLAGS)" \
"CC=$(CC)" \
"CFLAGS=$(CFLAGS)" \
- "CHILLFLAGS=$(CHILLFLAGS)" \
- "CHILL=$(CHILL)" \
- "CHILL_LIB=$(CHILL_LIB)" \
"CXX=$(CXX)" \
"CXXFLAGS=$(CXXFLAGS)" \
"DLLTOOL=$(DLLTOOL)" \
fi; \
fi`
-CHILLFLAGS = $(CFLAGS)
-CHILL = gcc
-CHILL_FOR_TARGET = ` \
- if [ -f $${rootme}/../gcc/Makefile ] ; then \
- echo $${rootme}/../gcc/xgcc -B$${rootme}/../gcc/ -L$${rootme}/../gcc/ch/runtime/; \
- else \
- if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
- echo $(CC); \
- else \
- t='$(program_transform_name)'; echo gcc | sed -e '' $$t; \
- fi; \
- fi`
-CHILL_LIB = ` \
- if [ -f $${rootme}/../gcc/ch/runtime/libchill.a ] ; then \
- echo $${rootme}/../gcc/ch/runtime/chillrt0.o \
- $${rootme}/../gcc/ch/runtime/libchill.a; \
- else \
- echo -lchill; \
- fi`
+# OBSOLETE CHILLFLAGS = $(CFLAGS)
+# OBSOLETE CHILL = gcc
+# OBSOLETE CHILL_FOR_TARGET = ` \
+# OBSOLETE if [ -f $${rootme}/../gcc/Makefile ] ; then \
+# OBSOLETE echo $${rootme}/../gcc/xgcc -B$${rootme}/../gcc/ -L$${rootme}/../gcc/ch/runtime/; \
+# OBSOLETE else \
+# OBSOLETE if [ "$(host_canonical)" = "$(target_canonical)" ] ; then \
+# OBSOLETE echo $(CC); \
+# OBSOLETE else \
+# OBSOLETE t='$(program_transform_name)'; echo gcc | sed -e '' $$t; \
+# OBSOLETE fi; \
+# OBSOLETE fi`
+# OBSOLETE CHILL_LIB = ` \
+# OBSOLETE if [ -f $${rootme}/../gcc/ch/runtime/libchill.a ] ; then \
+# OBSOLETE echo $${rootme}/../gcc/ch/runtime/chillrt0.o \
+# OBSOLETE $${rootme}/../gcc/ch/runtime/libchill.a; \
+# OBSOLETE else \
+# OBSOLETE echo -lchill; \
+# OBSOLETE fi`
# The use of $$(x_FOR_TARGET) reduces the command line length by not
# duplicating the lengthy definition.
'CC=$$(CC_FOR_TARGET)' \
"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
"CFLAGS=$(CFLAGS)" \
- "CHILLFLAGS=$(CHILLFLAGS)" \
- 'CHILL=$$(CHILL_FOR_TARGET)' \
- "CHILL_FOR_TARGET=$(CHILL_FOR_TARGET)" \
- "CHILL_LIB=$(CHILL_LIB)" \
'CXX=$$(CXX_FOR_TARGET)' \
"CXX_FOR_TARGET=$(CXX_FOR_TARGET)" \
"CXXFLAGS=$(CXXFLAGS)" \
SFILES = ax-general.c ax-gdb.c bcache.c blockframe.c breakpoint.c \
buildsym.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 \
+ coffread.c \
complaints.c completer.c corefile.c cp-valprint.c dbxread.c \
demangle.c dwarfread.c dwarf2read.c elfread.c environ.c eval.c \
event-loop.c event-top.c \
objfiles.h parser-defs.h serial.h solib.h \
symfile.h stabsread.h target.h terminal.h typeprint.h xcoffsolib.h \
macrotab.h macroexp.h macroscope.h \
- c-lang.h ch-lang.h f-lang.h \
+ c-lang.h f-lang.h \
jv-lang.h \
m2-lang.h p-lang.h \
complaints.h valprint.h \
exec.o bcache.o objfiles.o minsyms.o maint.o demangle.o \
dbxread.o coffread.o elfread.o \
dwarfread.o dwarf2read.o mipsread.o stabsread.o corefile.o \
- c-lang.o ch-exp.o ch-lang.o f-lang.o \
+ c-lang.o f-lang.o \
ui-out.o cli-out.o \
varobj.o wrapper.o \
jv-lang.o jv-valprint.o jv-typeprint.o \
m2-lang.o p-lang.o p-typeprint.o p-valprint.o \
scm-exp.o scm-lang.o scm-valprint.o complaints.o typeprint.o \
- c-typeprint.o ch-typeprint.o f-typeprint.o m2-typeprint.o \
- c-valprint.o cp-valprint.o ch-valprint.o f-valprint.o m2-valprint.o \
+ c-typeprint.o f-typeprint.o m2-typeprint.o \
+ c-valprint.o cp-valprint.o f-valprint.o m2-valprint.o \
nlmread.o serial.o mdebugread.o top.o utils.o \
ui-file.o \
frame.o doublest.o \
## This is ugly, but I don't want GNU make to put these variables in
## the environment. Older makes will see this as a set of targets
## with no dependencies and no actions.
-unexport CHILLFLAGS CHILL_LIB CHILL_FOR_TARGET :
+# OBSOLETE unexport CHILLFLAGS CHILL_LIB CHILL_FOR_TARGET :
ALLDEPFILES = a68v-nat.c \
aix-thread.c \
f-valprint.o: f-valprint.c $(defs_h) $(expression_h) $(gdbtypes_h) \
$(language_h) $(symtab_h) $(valprint_h) $(value_h) $(gdb_string_h)
-ch-exp.o: ch-exp.c ch-lang.h $(defs_h) $(language_h) $(parser_defs_h) \
- $(bfd_h) $(symfile_h) $(objfiles_h) $(value_h)
+# OBSOLETE ch-exp.o: ch-exp.c ch-lang.h $(defs_h) $(language_h) $(parser_defs_h) \
+# OBSOLETE $(bfd_h) $(symfile_h) $(objfiles_h) $(value_h)
-ch-lang.o: ch-lang.c ch-lang.h $(defs_h) $(expression_h) $(gdbtypes_h) \
- $(language_h) $(parser_defs_h) $(symtab_h)
+# OBSOLETE ch-lang.o: ch-lang.c ch-lang.h $(defs_h) $(expression_h) $(gdbtypes_h) \
+# OBSOLETE $(language_h) $(parser_defs_h) $(symtab_h)
-ch-typeprint.o: ch-typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) \
- $(symtab_h) $(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) \
- $(target_h) $(language_h) $(ch_lang_h) $(typeprint_h) $(gdb_string_h)
+# OBSOLETE ch-typeprint.o: ch-typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) \
+# OBSOLETE $(symtab_h) $(gdbtypes_h) $(expression_h) $(value_h) $(gdbcore_h) \
+# OBSOLETE $(target_h) $(language_h) $(ch_lang_h) $(typeprint_h) $(gdb_string_h)
-ch-valprint.o: ch-valprint.c $(defs_h) $(gdb_obstack_h) $(symtab_h) \
- $(gdbtypes_h) $(valprint_h) $(expression_h) $(value_h) $(language_h) \
- $(demangle_h) $(c_lang_h) $(typeprint_h) $(ch_lang_h) $(annotate_h)
+# OBSOLETE ch-valprint.o: ch-valprint.c $(defs_h) $(gdb_obstack_h) $(symtab_h) \
+# OBSOLETE $(gdbtypes_h) $(valprint_h) $(expression_h) $(value_h) $(language_h) \
+# OBSOLETE $(demangle_h) $(c_lang_h) $(typeprint_h) $(ch_lang_h) $(annotate_h)
coff-solib.o: coff-solib.c $(defs_h)
Fujitsu FR30 fr30-*-elf*
Motorola Delta 88000 running Sys V m88k-motorola-sysv or delta88
+* OBSOLETE languages
+
+CHILL, a Pascal like language used by telecommunications companies.
+
* REMOVED configurations and files
AMD 29k family via UDI a29k-amd-udi, udi29k
-/* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
- Copyright 1992, 1993, 1995, 1996, 1997, 1999, 2000, 2001
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
-/* Parse a Chill expression from text in a string,
- and return the result as a struct expression pointer.
- That structure contains arithmetic operations in reverse polish,
- with constants represented by operations that are followed by special data.
- See expression.h for the details of the format.
- What is important here is that it can be built up sequentially
- during the process of parsing; the lower levels of the tree always
- come first in the result.
-
- Note that the language accepted by this parser is more liberal
- than the one accepted by an actual Chill compiler. For example, the
- language rule that a simple name string can not be one of the reserved
- simple name strings is not enforced (e.g "case" is not treated as a
- reserved name). Another example is that Chill is a strongly typed
- language, and certain expressions that violate the type constraints
- may still be evaluated if gdb can do so in a meaningful manner, while
- such expressions would be rejected by the compiler. The reason for
- this more liberal behavior is the philosophy that the debugger
- is intended to be a tool that is used by the programmer when things
- go wrong, and as such, it should provide as few artificial barriers
- to it's use as possible. If it can do something meaningful, even
- something that violates language contraints that are enforced by the
- compiler, it should do so without complaint.
-
- */
-
-#include "defs.h"
-#include "gdb_string.h"
-#include <ctype.h>
-#include "expression.h"
-#include "language.h"
-#include "value.h"
-#include "parser-defs.h"
-#include "ch-lang.h"
-#include "bfd.h" /* Required by objfiles.h. */
-#include "symfile.h" /* Required by objfiles.h. */
-#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
-
-#ifdef __GNUC__
-#define INLINE __inline__
-#endif
-
-typedef union
-
- {
- LONGEST lval;
- ULONGEST ulval;
- struct
- {
- LONGEST val;
- struct type *type;
- }
- typed_val;
- double dval;
- struct symbol *sym;
- struct type *tval;
- struct stoken sval;
- struct ttype tsym;
- struct symtoken ssym;
- }
-YYSTYPE;
-
-enum ch_terminal
- {
- END_TOKEN = 0,
- /* '\001' ... '\xff' come first. */
- OPEN_PAREN = '(',
- TOKEN_NOT_READ = 999,
- INTEGER_LITERAL,
- BOOLEAN_LITERAL,
- CHARACTER_LITERAL,
- FLOAT_LITERAL,
- GENERAL_PROCEDURE_NAME,
- LOCATION_NAME,
- EMPTINESS_LITERAL,
- CHARACTER_STRING_LITERAL,
- BIT_STRING_LITERAL,
- TYPENAME,
- DOT_FIELD_NAME, /* '.' followed by <field name> */
- CASE,
- OF,
- ESAC,
- LOGIOR,
- ORIF,
- LOGXOR,
- LOGAND,
- ANDIF,
- NOTEQUAL,
- GEQ,
- LEQ,
- IN,
- SLASH_SLASH,
- MOD,
- REM,
- NOT,
- POINTER,
- RECEIVE,
- UP,
- IF,
- THEN,
- ELSE,
- FI,
- ELSIF,
- ILLEGAL_TOKEN,
- NUM,
- PRED,
- SUCC,
- ABS,
- CARD,
- MAX_TOKEN,
- MIN_TOKEN,
- ADDR_TOKEN,
- SIZE,
- UPPER,
- LOWER,
- LENGTH,
- ARRAY,
- GDB_VARIABLE,
- GDB_ASSIGNMENT
- };
-
-/* Forward declarations. */
-
-static void write_lower_upper_value (enum exp_opcode, struct type *);
-static enum ch_terminal match_bitstring_literal (void);
-static enum ch_terminal match_integer_literal (void);
-static enum ch_terminal match_character_literal (void);
-static enum ch_terminal match_string_literal (void);
-static enum ch_terminal match_float_literal (void);
-static int decode_integer_literal (LONGEST *, char **);
-static int decode_integer_value (int, char **, LONGEST *);
-static char *match_simple_name_string (void);
-static void growbuf_by_size (int);
-static void parse_case_label (void);
-static void parse_untyped_expr (void);
-static void parse_if_expression (void);
-static void parse_if_expression_body (void);
-static void parse_else_alternative (void);
-static void parse_then_alternative (void);
-static void parse_expr (void);
-static void parse_operand0 (void);
-static void parse_operand1 (void);
-static void parse_operand2 (void);
-static void parse_operand3 (void);
-static void parse_operand4 (void);
-static void parse_operand5 (void);
-static void parse_operand6 (void);
-static void parse_primval (void);
-static void parse_tuple (struct type *);
-static void parse_opt_element_list (struct type *);
-static void parse_tuple_element (struct type *);
-static void parse_named_record_element (void);
-static void parse_call (void);
-static struct type *parse_mode_or_normal_call (void);
-#if 0
-static struct type *parse_mode_call (void);
-#endif
-static void parse_unary_call (void);
-static int parse_opt_untyped_expr (void);
-static int expect (enum ch_terminal, char *);
-static enum ch_terminal ch_lex (void);
-INLINE static enum ch_terminal PEEK_TOKEN (void);
-static enum ch_terminal peek_token_ (int);
-static void forward_token_ (void);
-static void require (enum ch_terminal);
-static int check_token (enum ch_terminal);
-
-#define MAX_LOOK_AHEAD 2
-static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD + 1] =
-{
- TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
-static YYSTYPE yylval;
-static YYSTYPE val_buffer[MAX_LOOK_AHEAD + 1];
-
-/*int current_token, lookahead_token; */
-
-INLINE static enum ch_terminal
-PEEK_TOKEN (void)
-{
- if (terminal_buffer[0] == TOKEN_NOT_READ)
- {
- terminal_buffer[0] = ch_lex ();
- val_buffer[0] = yylval;
- }
- return terminal_buffer[0];
-}
-#define PEEK_LVAL() val_buffer[0]
-#define PEEK_TOKEN1() peek_token_(1)
-#define PEEK_TOKEN2() peek_token_(2)
-static enum ch_terminal
-peek_token_ (int i)
-{
- if (i > MAX_LOOK_AHEAD)
- internal_error (__FILE__, __LINE__,
- "too much lookahead");
- if (terminal_buffer[i] == TOKEN_NOT_READ)
- {
- terminal_buffer[i] = ch_lex ();
- val_buffer[i] = yylval;
- }
- return terminal_buffer[i];
-}
-
-#if 0
-
-static void
-pushback_token (enum ch_terminal code, YYSTYPE node)
-{
- int i;
- if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
- internal_error (__FILE__, __LINE__,
- "cannot pushback token");
- for (i = MAX_LOOK_AHEAD; i > 0; i--)
- {
- terminal_buffer[i] = terminal_buffer[i - 1];
- val_buffer[i] = val_buffer[i - 1];
- }
- terminal_buffer[0] = code;
- val_buffer[0] = node;
-}
-
-#endif
-
-static void
-forward_token_ (void)
-{
- int i;
- for (i = 0; i < MAX_LOOK_AHEAD; i++)
- {
- terminal_buffer[i] = terminal_buffer[i + 1];
- val_buffer[i] = val_buffer[i + 1];
- }
- terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
-}
-#define FORWARD_TOKEN() forward_token_()
-
-/* Skip the next token.
- if it isn't TOKEN, the parser is broken. */
-
-static void
-require (enum ch_terminal token)
-{
- if (PEEK_TOKEN () != token)
- {
- internal_error (__FILE__, __LINE__,
- "expected token %d", (int) token);
- }
- FORWARD_TOKEN ();
-}
-
-static int
-check_token (enum ch_terminal token)
-{
- if (PEEK_TOKEN () != token)
- return 0;
- FORWARD_TOKEN ();
- return 1;
-}
-
-/* return 0 if expected token was not found,
- else return 1.
- */
-static int
-expect (enum ch_terminal token, char *message)
-{
- if (PEEK_TOKEN () != token)
- {
- if (message)
- error (message);
- else if (token < 256)
- error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
- else
- error ("syntax error");
- return 0;
- }
- else
- FORWARD_TOKEN ();
- return 1;
-}
-
-#if 0
-/* Parse a name string. If ALLOW_ALL is 1, ALL is allowed as a postfix. */
-
-static tree
-parse_opt_name_string (int allow_all)
-{
- int token = PEEK_TOKEN ();
- tree name;
- if (token != NAME)
- {
- if (token == ALL && allow_all)
- {
- FORWARD_TOKEN ();
- return ALL_POSTFIX;
- }
- return NULL_TREE;
- }
- name = PEEK_LVAL ();
- for (;;)
- {
- FORWARD_TOKEN ();
- token = PEEK_TOKEN ();
- if (token != '!')
- return name;
- FORWARD_TOKEN ();
- token = PEEK_TOKEN ();
- if (token == ALL && allow_all)
- return get_identifier3 (IDENTIFIER_POINTER (name), "!", "*");
- if (token != NAME)
- {
- if (pass == 1)
- error ("'%s!' is not followed by an identifier",
- IDENTIFIER_POINTER (name));
- return name;
- }
- name = get_identifier3 (IDENTIFIER_POINTER (name),
- "!", IDENTIFIER_POINTER (PEEK_LVAL ()));
- }
-}
-
-static tree
-parse_simple_name_string (void)
-{
- int token = PEEK_TOKEN ();
- tree name;
- if (token != NAME)
- {
- error ("expected a name here");
- return error_mark_node;
- }
- name = PEEK_LVAL ();
- FORWARD_TOKEN ();
- return name;
-}
-
-static tree
-parse_name_string (void)
-{
- tree name = parse_opt_name_string (0);
- if (name)
- return name;
- if (pass == 1)
- error ("expected a name string here");
- return error_mark_node;
-}
-
-/* Matches: <name_string>
- Returns if pass 1: the identifier.
- Returns if pass 2: a decl or value for identifier. */
-
-static tree
-parse_name (void)
-{
- tree name = parse_name_string ();
- if (pass == 1 || ignoring)
- return name;
- else
- {
- tree decl = lookup_name (name);
- if (decl == NULL_TREE)
- {
- error ("`%s' undeclared", IDENTIFIER_POINTER (name));
- return error_mark_node;
- }
- else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
- return error_mark_node;
- else if (TREE_CODE (decl) == CONST_DECL)
- return DECL_INITIAL (decl);
- else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
- return convert_from_reference (decl);
- else
- return decl;
- }
-}
-#endif
-
-#if 0
-static void
-pushback_paren_expr (tree expr)
-{
- if (pass == 1 && !ignoring)
- expr = build1 (PAREN_EXPR, NULL_TREE, expr);
- pushback_token (EXPR, expr);
-}
-#endif
-
-/* Matches: <case label> */
-
-static void
-parse_case_label (void)
-{
- if (check_token (ELSE))
- error ("ELSE in tuples labels not implemented");
- /* Does not handle the case of a mode name. FIXME */
- parse_expr ();
- if (check_token (':'))
- {
- parse_expr ();
- write_exp_elt_opcode (BINOP_RANGE);
- }
-}
-
-static int
-parse_opt_untyped_expr (void)
-{
- switch (PEEK_TOKEN ())
- {
- case ',':
- case ':':
- case ')':
- return 0;
- default:
- parse_untyped_expr ();
- return 1;
- }
-}
-
-static void
-parse_unary_call (void)
-{
- FORWARD_TOKEN ();
- expect ('(', NULL);
- parse_expr ();
- expect (')', NULL);
-}
-
-/* Parse NAME '(' MODENAME ')'. */
-
-#if 0
-
-static struct type *
-parse_mode_call (void)
-{
- struct type *type;
- FORWARD_TOKEN ();
- expect ('(', NULL);
- if (PEEK_TOKEN () != TYPENAME)
- error ("expect MODENAME here `%s'", lexptr);
- type = PEEK_LVAL ().tsym.type;
- FORWARD_TOKEN ();
- expect (')', NULL);
- return type;
-}
-
-#endif
-
-static struct type *
-parse_mode_or_normal_call (void)
-{
- struct type *type;
- FORWARD_TOKEN ();
- expect ('(', NULL);
- if (PEEK_TOKEN () == TYPENAME)
- {
- type = PEEK_LVAL ().tsym.type;
- FORWARD_TOKEN ();
- }
- else
- {
- parse_expr ();
- type = NULL;
- }
- expect (')', NULL);
- return type;
-}
-
-/* Parse something that looks like a function call.
- Assume we have parsed the function, and are at the '('. */
-
-static void
-parse_call (void)
-{
- int arg_count;
- require ('(');
- /* This is to save the value of arglist_len
- being accumulated for each dimension. */
- start_arglist ();
- if (parse_opt_untyped_expr ())
- {
- int tok = PEEK_TOKEN ();
- arglist_len = 1;
- if (tok == UP || tok == ':')
- {
- FORWARD_TOKEN ();
- parse_expr ();
- expect (')', "expected ')' to terminate slice");
- end_arglist ();
- write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
- : TERNOP_SLICE);
- return;
- }
- while (check_token (','))
- {
- parse_untyped_expr ();
- arglist_len++;
- }
- }
- else
- arglist_len = 0;
- expect (')', NULL);
- arg_count = end_arglist ();
- write_exp_elt_opcode (MULTI_SUBSCRIPT);
- write_exp_elt_longcst (arg_count);
- write_exp_elt_opcode (MULTI_SUBSCRIPT);
-}
-
-static void
-parse_named_record_element (void)
-{
- struct stoken label;
- char buf[256];
-
- label = PEEK_LVAL ().sval;
- sprintf (buf, "expected a field name here `%s'", lexptr);
- expect (DOT_FIELD_NAME, buf);
- if (check_token (','))
- parse_named_record_element ();
- else if (check_token (':'))
- parse_expr ();
- else
- error ("syntax error near `%s' in named record tuple element", lexptr);
- write_exp_elt_opcode (OP_LABELED);
- write_exp_string (label);
- write_exp_elt_opcode (OP_LABELED);
-}
-
-/* Returns one or more TREE_LIST nodes, in reverse order. */
-
-static void
-parse_tuple_element (struct type *type)
-{
- if (PEEK_TOKEN () == DOT_FIELD_NAME)
- {
- /* Parse a labelled structure tuple. */
- parse_named_record_element ();
- return;
- }
-
- if (check_token ('('))
- {
- if (check_token ('*'))
- {
- expect (')', "missing ')' after '*' case label list");
- if (type)
- {
- if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
- {
- /* do this as a range from low to high */
- struct type *range_type = TYPE_FIELD_TYPE (type, 0);
- LONGEST low_bound, high_bound;
- if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
- error ("cannot determine bounds for (*)");
- /* lower bound */
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (range_type);
- write_exp_elt_longcst (low_bound);
- write_exp_elt_opcode (OP_LONG);
- /* upper bound */
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (range_type);
- write_exp_elt_longcst (high_bound);
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_opcode (BINOP_RANGE);
- }
- else
- error ("(*) in invalid context");
- }
- else
- error ("(*) only possible with modename in front of tuple (mode[..])");
- }
- else
- {
- parse_case_label ();
- while (check_token (','))
- {
- parse_case_label ();
- write_exp_elt_opcode (BINOP_COMMA);
- }
- expect (')', NULL);
- }
- }
- else
- parse_untyped_expr ();
- if (check_token (':'))
- {
- /* A powerset range or a labeled Array. */
- parse_untyped_expr ();
- write_exp_elt_opcode (BINOP_RANGE);
- }
-}
-
-/* Matches: a COMMA-separated list of tuple elements.
- Returns a list (of TREE_LIST nodes). */
-static void
-parse_opt_element_list (struct type *type)
-{
- arglist_len = 0;
- if (PEEK_TOKEN () == ']')
- return;
- for (;;)
- {
- parse_tuple_element (type);
- arglist_len++;
- if (PEEK_TOKEN () == ']')
- break;
- if (!check_token (','))
- error ("bad syntax in tuple");
- }
-}
-
-/* Parses: '[' elements ']'
- If modename is non-NULL it prefixed the tuple. */
-
-static void
-parse_tuple (struct type *mode)
-{
- struct type *type;
- if (mode)
- type = check_typedef (mode);
- else
- type = 0;
- require ('[');
- start_arglist ();
- parse_opt_element_list (type);
- expect (']', "missing ']' after tuple");
- write_exp_elt_opcode (OP_ARRAY);
- write_exp_elt_longcst ((LONGEST) 0);
- write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
- write_exp_elt_opcode (OP_ARRAY);
- if (type)
- {
- if (TYPE_CODE (type) != TYPE_CODE_ARRAY
- && TYPE_CODE (type) != TYPE_CODE_STRUCT
- && TYPE_CODE (type) != TYPE_CODE_SET)
- error ("invalid tuple mode");
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (mode);
- write_exp_elt_opcode (UNOP_CAST);
- }
-}
-
-static void
-parse_primval (void)
-{
- struct type *type;
- enum exp_opcode op;
- char *op_name;
- switch (PEEK_TOKEN ())
- {
- case INTEGER_LITERAL:
- case CHARACTER_LITERAL:
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (PEEK_LVAL ().typed_val.type);
- write_exp_elt_longcst (PEEK_LVAL ().typed_val.val);
- write_exp_elt_opcode (OP_LONG);
- FORWARD_TOKEN ();
- break;
- case BOOLEAN_LITERAL:
- write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
- write_exp_elt_opcode (OP_BOOL);
- FORWARD_TOKEN ();
- break;
- case FLOAT_LITERAL:
- write_exp_elt_opcode (OP_DOUBLE);
- write_exp_elt_type (builtin_type_double);
- write_exp_elt_dblcst (PEEK_LVAL ().dval);
- write_exp_elt_opcode (OP_DOUBLE);
- FORWARD_TOKEN ();
- break;
- case EMPTINESS_LITERAL:
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (lookup_pointer_type (builtin_type_void));
- write_exp_elt_longcst (0);
- write_exp_elt_opcode (OP_LONG);
- FORWARD_TOKEN ();
- break;
- case CHARACTER_STRING_LITERAL:
- write_exp_elt_opcode (OP_STRING);
- write_exp_string (PEEK_LVAL ().sval);
- write_exp_elt_opcode (OP_STRING);
- FORWARD_TOKEN ();
- break;
- case BIT_STRING_LITERAL:
- write_exp_elt_opcode (OP_BITSTRING);
- write_exp_bitstring (PEEK_LVAL ().sval);
- write_exp_elt_opcode (OP_BITSTRING);
- FORWARD_TOKEN ();
- break;
- case ARRAY:
- FORWARD_TOKEN ();
- /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
- which casts to an artificial array. */
- expect ('(', NULL);
- expect (')', NULL);
- if (PEEK_TOKEN () != TYPENAME)
- error ("missing MODENAME after ARRAY()");
- type = PEEK_LVAL ().tsym.type;
- FORWARD_TOKEN ();
- expect ('(', NULL);
- parse_expr ();
- expect (')', "missing right parenthesis");
- type = create_array_type ((struct type *) NULL, type,
- create_range_type ((struct type *) NULL,
- builtin_type_int, 0, 0));
- TYPE_ARRAY_UPPER_BOUND_TYPE (type) = BOUND_CANNOT_BE_DETERMINED;
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (type);
- write_exp_elt_opcode (UNOP_CAST);
- break;
-#if 0
- case CONST:
- case EXPR:
- val = PEEK_LVAL ();
- FORWARD_TOKEN ();
- break;
-#endif
- case '(':
- FORWARD_TOKEN ();
- parse_expr ();
- expect (')', "missing right parenthesis");
- break;
- case '[':
- parse_tuple (NULL);
- break;
- case GENERAL_PROCEDURE_NAME:
- case LOCATION_NAME:
- write_exp_elt_opcode (OP_VAR_VALUE);
- write_exp_elt_block (NULL);
- write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
- FORWARD_TOKEN ();
- break;
- case GDB_VARIABLE: /* gdb specific */
- FORWARD_TOKEN ();
- break;
- case NUM:
- parse_unary_call ();
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (builtin_type_int);
- write_exp_elt_opcode (UNOP_CAST);
- break;
- case CARD:
- parse_unary_call ();
- write_exp_elt_opcode (UNOP_CARD);
- break;
- case MAX_TOKEN:
- parse_unary_call ();
- write_exp_elt_opcode (UNOP_CHMAX);
- break;
- case MIN_TOKEN:
- parse_unary_call ();
- write_exp_elt_opcode (UNOP_CHMIN);
- break;
- case PRED:
- op_name = "PRED";
- goto unimplemented_unary_builtin;
- case SUCC:
- op_name = "SUCC";
- goto unimplemented_unary_builtin;
- case ABS:
- op_name = "ABS";
- goto unimplemented_unary_builtin;
- unimplemented_unary_builtin:
- parse_unary_call ();
- error ("not implemented: %s builtin function", op_name);
- break;
- case ADDR_TOKEN:
- parse_unary_call ();
- write_exp_elt_opcode (UNOP_ADDR);
- break;
- case SIZE:
- type = parse_mode_or_normal_call ();
- if (type)
- {
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (builtin_type_int);
- CHECK_TYPEDEF (type);
- write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
- write_exp_elt_opcode (OP_LONG);
- }
- else
- write_exp_elt_opcode (UNOP_SIZEOF);
- break;
- case LOWER:
- op = UNOP_LOWER;
- goto lower_upper;
- case UPPER:
- op = UNOP_UPPER;
- goto lower_upper;
- lower_upper:
- type = parse_mode_or_normal_call ();
- write_lower_upper_value (op, type);
- break;
- case LENGTH:
- parse_unary_call ();
- write_exp_elt_opcode (UNOP_LENGTH);
- break;
- case TYPENAME:
- type = PEEK_LVAL ().tsym.type;
- FORWARD_TOKEN ();
- switch (PEEK_TOKEN ())
- {
- case '[':
- parse_tuple (type);
- break;
- case '(':
- FORWARD_TOKEN ();
- parse_expr ();
- expect (')', "missing right parenthesis");
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (type);
- write_exp_elt_opcode (UNOP_CAST);
- break;
- default:
- error ("typename in invalid context");
- }
- break;
-
- default:
- error ("invalid expression syntax at `%s'", lexptr);
- }
- for (;;)
- {
- switch (PEEK_TOKEN ())
- {
- case DOT_FIELD_NAME:
- write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string (PEEK_LVAL ().sval);
- write_exp_elt_opcode (STRUCTOP_STRUCT);
- FORWARD_TOKEN ();
- continue;
- case POINTER:
- FORWARD_TOKEN ();
- if (PEEK_TOKEN () == TYPENAME)
- {
- type = PEEK_LVAL ().tsym.type;
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (lookup_pointer_type (type));
- write_exp_elt_opcode (UNOP_CAST);
- FORWARD_TOKEN ();
- }
- write_exp_elt_opcode (UNOP_IND);
- continue;
- case OPEN_PAREN:
- parse_call ();
- continue;
- case CHARACTER_STRING_LITERAL:
- case CHARACTER_LITERAL:
- case BIT_STRING_LITERAL:
- /* Handle string repetition. (See comment in parse_operand5.) */
- parse_primval ();
- write_exp_elt_opcode (MULTI_SUBSCRIPT);
- write_exp_elt_longcst (1);
- write_exp_elt_opcode (MULTI_SUBSCRIPT);
- continue;
- case END_TOKEN:
- case TOKEN_NOT_READ:
- case INTEGER_LITERAL:
- case BOOLEAN_LITERAL:
- case FLOAT_LITERAL:
- case GENERAL_PROCEDURE_NAME:
- case LOCATION_NAME:
- case EMPTINESS_LITERAL:
- case TYPENAME:
- case CASE:
- case OF:
- case ESAC:
- case LOGIOR:
- case ORIF:
- case LOGXOR:
- case LOGAND:
- case ANDIF:
- case NOTEQUAL:
- case GEQ:
- case LEQ:
- case IN:
- case SLASH_SLASH:
- case MOD:
- case REM:
- case NOT:
- case RECEIVE:
- case UP:
- case IF:
- case THEN:
- case ELSE:
- case FI:
- case ELSIF:
- case ILLEGAL_TOKEN:
- case NUM:
- case PRED:
- case SUCC:
- case ABS:
- case CARD:
- case MAX_TOKEN:
- case MIN_TOKEN:
- case ADDR_TOKEN:
- case SIZE:
- case UPPER:
- case LOWER:
- case LENGTH:
- case ARRAY:
- case GDB_VARIABLE:
- case GDB_ASSIGNMENT:
- break;
- }
- break;
- }
- return;
-}
-
-static void
-parse_operand6 (void)
-{
- if (check_token (RECEIVE))
- {
- parse_primval ();
- error ("not implemented: RECEIVE expression");
- }
- else if (check_token (POINTER))
- {
- parse_primval ();
- write_exp_elt_opcode (UNOP_ADDR);
- }
- else
- parse_primval ();
-}
-
-static void
-parse_operand5 (void)
-{
- enum exp_opcode op;
- /* We are supposed to be looking for a <string repetition operator>,
- but in general we can't distinguish that from a parenthesized
- expression. This is especially difficult if we allow the
- string operand to be a constant expression (as requested by
- some users), and not just a string literal.
- Consider: LPRN expr RPRN LPRN expr RPRN
- Is that a function call or string repetition?
- Instead, we handle string repetition in parse_primval,
- and build_generalized_call. */
- switch (PEEK_TOKEN ())
- {
- case NOT:
- op = UNOP_LOGICAL_NOT;
- break;
- case '-':
- op = UNOP_NEG;
- break;
- default:
- op = OP_NULL;
- }
- if (op != OP_NULL)
- FORWARD_TOKEN ();
- parse_operand6 ();
- if (op != OP_NULL)
- write_exp_elt_opcode (op);
-}
-
-static void
-parse_operand4 (void)
-{
- enum exp_opcode op;
- parse_operand5 ();
- for (;;)
- {
- switch (PEEK_TOKEN ())
- {
- case '*':
- op = BINOP_MUL;
- break;
- case '/':
- op = BINOP_DIV;
- break;
- case MOD:
- op = BINOP_MOD;
- break;
- case REM:
- op = BINOP_REM;
- break;
- default:
- return;
- }
- FORWARD_TOKEN ();
- parse_operand5 ();
- write_exp_elt_opcode (op);
- }
-}
-
-static void
-parse_operand3 (void)
-{
- enum exp_opcode op;
- parse_operand4 ();
- for (;;)
- {
- switch (PEEK_TOKEN ())
- {
- case '+':
- op = BINOP_ADD;
- break;
- case '-':
- op = BINOP_SUB;
- break;
- case SLASH_SLASH:
- op = BINOP_CONCAT;
- break;
- default:
- return;
- }
- FORWARD_TOKEN ();
- parse_operand4 ();
- write_exp_elt_opcode (op);
- }
-}
-
-static void
-parse_operand2 (void)
-{
- enum exp_opcode op;
- parse_operand3 ();
- for (;;)
- {
- if (check_token (IN))
- {
- parse_operand3 ();
- write_exp_elt_opcode (BINOP_IN);
- }
- else
- {
- switch (PEEK_TOKEN ())
- {
- case '>':
- op = BINOP_GTR;
- break;
- case GEQ:
- op = BINOP_GEQ;
- break;
- case '<':
- op = BINOP_LESS;
- break;
- case LEQ:
- op = BINOP_LEQ;
- break;
- case '=':
- op = BINOP_EQUAL;
- break;
- case NOTEQUAL:
- op = BINOP_NOTEQUAL;
- break;
- default:
- return;
- }
- FORWARD_TOKEN ();
- parse_operand3 ();
- write_exp_elt_opcode (op);
- }
- }
-}
-
-static void
-parse_operand1 (void)
-{
- enum exp_opcode op;
- parse_operand2 ();
- for (;;)
- {
- switch (PEEK_TOKEN ())
- {
- case LOGAND:
- op = BINOP_BITWISE_AND;
- break;
- case ANDIF:
- op = BINOP_LOGICAL_AND;
- break;
- default:
- return;
- }
- FORWARD_TOKEN ();
- parse_operand2 ();
- write_exp_elt_opcode (op);
- }
-}
-
-static void
-parse_operand0 (void)
-{
- enum exp_opcode op;
- parse_operand1 ();
- for (;;)
- {
- switch (PEEK_TOKEN ())
- {
- case LOGIOR:
- op = BINOP_BITWISE_IOR;
- break;
- case LOGXOR:
- op = BINOP_BITWISE_XOR;
- break;
- case ORIF:
- op = BINOP_LOGICAL_OR;
- break;
- default:
- return;
- }
- FORWARD_TOKEN ();
- parse_operand1 ();
- write_exp_elt_opcode (op);
- }
-}
-
-static void
-parse_expr (void)
-{
- parse_operand0 ();
- if (check_token (GDB_ASSIGNMENT))
- {
- parse_expr ();
- write_exp_elt_opcode (BINOP_ASSIGN);
- }
-}
-
-static void
-parse_then_alternative (void)
-{
- expect (THEN, "missing 'THEN' in 'IF' expression");
- parse_expr ();
-}
-
-static void
-parse_else_alternative (void)
-{
- if (check_token (ELSIF))
- parse_if_expression_body ();
- else if (check_token (ELSE))
- parse_expr ();
- else
- error ("missing ELSE/ELSIF in IF expression");
-}
-
-/* Matches: <boolean expression> <then alternative> <else alternative> */
-
-static void
-parse_if_expression_body (void)
-{
- parse_expr ();
- parse_then_alternative ();
- parse_else_alternative ();
- write_exp_elt_opcode (TERNOP_COND);
-}
-
-static void
-parse_if_expression (void)
-{
- require (IF);
- parse_if_expression_body ();
- expect (FI, "missing 'FI' at end of conditional expression");
-}
-
-/* An <untyped_expr> is a superset of <expr>. It also includes
- <conditional expressions> and untyped <tuples>, whose types
- are not given by their constituents. Hence, these are only
- allowed in certain contexts that expect a certain type.
- You should call convert() to fix up the <untyped_expr>. */
-
-static void
-parse_untyped_expr (void)
-{
- switch (PEEK_TOKEN ())
- {
- case IF:
- parse_if_expression ();
- return;
- case CASE:
- error ("not implemented: CASE expression");
- case '(':
- switch (PEEK_TOKEN1 ())
- {
- case IF:
- case CASE:
- goto skip_lprn;
- case '[':
- skip_lprn:
- FORWARD_TOKEN ();
- parse_untyped_expr ();
- expect (')', "missing ')'");
- return;
- default:;
- /* fall through */
- }
- default:
- parse_operand0 ();
- }
-}
-
-int
-chill_parse (void)
-{
- terminal_buffer[0] = TOKEN_NOT_READ;
- if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
- {
- write_exp_elt_opcode (OP_TYPE);
- write_exp_elt_type (PEEK_LVAL ().tsym.type);
- write_exp_elt_opcode (OP_TYPE);
- FORWARD_TOKEN ();
- }
- else
- parse_expr ();
- if (terminal_buffer[0] != END_TOKEN)
- {
- if (comma_terminates && terminal_buffer[0] == ',')
- lexptr--; /* Put the comma back. */
- else
- error ("Junk after end of expression.");
- }
- return 0;
-}
-
-
-/* Implementation of a dynamically expandable buffer for processing input
- characters acquired through lexptr and building a value to return in
- yylval. */
-
-static char *tempbuf; /* Current buffer contents */
-static int tempbufsize; /* Size of allocated buffer */
-static int tempbufindex; /* Current index into buffer */
-
-#define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
-
-#define CHECKBUF(size) \
- do { \
- if (tempbufindex + (size) >= tempbufsize) \
- { \
- growbuf_by_size (size); \
- } \
- } while (0);
-
-/* Grow the static temp buffer if necessary, including allocating the first one
- on demand. */
-
-static void
-growbuf_by_size (int count)
-{
- int growby;
-
- growby = max (count, GROWBY_MIN_SIZE);
- tempbufsize += growby;
- if (tempbuf == NULL)
- {
- tempbuf = (char *) xmalloc (tempbufsize);
- }
- else
- {
- tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
- }
-}
-
-/* Try to consume a simple name string token. If successful, returns
- a pointer to a nullbyte terminated copy of the name that can be used
- in symbol table lookups. If not successful, returns NULL. */
-
-static char *
-match_simple_name_string (void)
-{
- char *tokptr = lexptr;
-
- if (isalpha (*tokptr) || *tokptr == '_')
- {
- char *result;
- do
- {
- tokptr++;
- }
- while (isalnum (*tokptr) || (*tokptr == '_'));
- yylval.sval.ptr = lexptr;
- yylval.sval.length = tokptr - lexptr;
- lexptr = tokptr;
- result = copy_name (yylval.sval);
- return result;
- }
- return (NULL);
-}
-
-/* Start looking for a value composed of valid digits as set by the base
- in use. Note that '_' characters are valid anywhere, in any quantity,
- and are simply ignored. Since we must find at least one valid digit,
- or reject this token as an integer literal, we keep track of how many
- digits we have encountered. */
-
-static int
-decode_integer_value (int base, char **tokptrptr, LONGEST *ivalptr)
-{
- char *tokptr = *tokptrptr;
- int temp;
- int digits = 0;
-
- while (*tokptr != '\0')
- {
- temp = *tokptr;
- if (isupper (temp))
- temp = tolower (temp);
- tokptr++;
- switch (temp)
- {
- case '_':
- continue;
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- temp -= '0';
- break;
- case 'a':
- case 'b':
- case 'c':
- case 'd':
- case 'e':
- case 'f':
- temp -= 'a';
- temp += 10;
- break;
- default:
- temp = base;
- break;
- }
- if (temp < base)
- {
- digits++;
- *ivalptr *= base;
- *ivalptr += temp;
- }
- else
- {
- /* Found something not in domain for current base. */
- tokptr--; /* Unconsume what gave us indigestion. */
- break;
- }
- }
-
- /* If we didn't find any digits, then we don't have a valid integer
- value, so reject the entire token. Otherwise, update the lexical
- scan pointer, and return non-zero for success. */
-
- if (digits == 0)
- {
- return (0);
- }
- else
- {
- *tokptrptr = tokptr;
- return (1);
- }
-}
-
-static int
-decode_integer_literal (LONGEST *valptr, char **tokptrptr)
-{
- char *tokptr = *tokptrptr;
- int base = 0;
- LONGEST ival = 0;
- int explicit_base = 0;
-
- /* Look for an explicit base specifier, which is optional. */
-
- switch (*tokptr)
- {
- case 'd':
- case 'D':
- explicit_base++;
- base = 10;
- tokptr++;
- break;
- case 'b':
- case 'B':
- explicit_base++;
- base = 2;
- tokptr++;
- break;
- case 'h':
- case 'H':
- explicit_base++;
- base = 16;
- tokptr++;
- break;
- case 'o':
- case 'O':
- explicit_base++;
- base = 8;
- tokptr++;
- break;
- default:
- base = 10;
- break;
- }
-
- /* If we found an explicit base ensure that the character after the
- explicit base is a single quote. */
-
- if (explicit_base && (*tokptr++ != '\''))
- {
- return (0);
- }
-
- /* Attempt to decode whatever follows as an integer value in the
- indicated base, updating the token pointer in the process and
- computing the value into ival. Also, if we have an explicit
- base, then the next character must not be a single quote, or we
- have a bitstring literal, so reject the entire token in this case.
- Otherwise, update the lexical scan pointer, and return non-zero
- for success. */
-
- if (!decode_integer_value (base, &tokptr, &ival))
- {
- return (0);
- }
- else if (explicit_base && (*tokptr == '\''))
- {
- return (0);
- }
- else
- {
- *valptr = ival;
- *tokptrptr = tokptr;
- return (1);
- }
-}
-
-/* If it wasn't for the fact that floating point values can contain '_'
- characters, we could just let strtod do all the hard work by letting it
- try to consume as much of the current token buffer as possible and
- find a legal conversion. Unfortunately we need to filter out the '_'
- characters before calling strtod, which we do by copying the other
- legal chars to a local buffer to be converted. However since we also
- need to keep track of where the last unconsumed character in the input
- buffer is, we have transfer only as many characters as may compose a
- legal floating point value. */
-
-static enum ch_terminal
-match_float_literal (void)
-{
- char *tokptr = lexptr;
- char *buf;
- char *copy;
- double dval;
- extern double strtod ();
-
- /* Make local buffer in which to build the string to convert. This is
- required because underscores are valid in chill floating point numbers
- but not in the string passed to strtod to convert. The string will be
- no longer than our input string. */
-
- copy = buf = (char *) alloca (strlen (tokptr) + 1);
-
- /* Transfer all leading digits to the conversion buffer, discarding any
- underscores. */
-
- while (isdigit (*tokptr) || *tokptr == '_')
- {
- if (*tokptr != '_')
- {
- *copy++ = *tokptr;
- }
- tokptr++;
- }
-
- /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
- of whether we found any leading digits, and we simply accept it and
- continue on to look for the fractional part and/or exponent. One of
- [eEdD] is legal only if we have seen digits, and means that there
- is no fractional part. If we find neither of these, then this is
- not a floating point number, so return failure. */
-
- switch (*tokptr++)
- {
- case '.':
- /* Accept and then look for fractional part and/or exponent. */
- *copy++ = '.';
- break;
-
- case 'e':
- case 'E':
- case 'd':
- case 'D':
- if (copy == buf)
- {
- return (0);
- }
- *copy++ = 'e';
- goto collect_exponent;
- break;
-
- default:
- return (0);
- break;
- }
-
- /* We found a '.', copy any fractional digits to the conversion buffer, up
- to the first nondigit, non-underscore character. */
-
- while (isdigit (*tokptr) || *tokptr == '_')
- {
- if (*tokptr != '_')
- {
- *copy++ = *tokptr;
- }
- tokptr++;
- }
-
- /* Look for an exponent, which must start with one of [eEdD]. If none
- is found, jump directly to trying to convert what we have collected
- so far. */
-
- switch (*tokptr)
- {
- case 'e':
- case 'E':
- case 'd':
- case 'D':
- *copy++ = 'e';
- tokptr++;
- break;
- default:
- goto convert_float;
- break;
- }
-
- /* Accept an optional '-' or '+' following one of [eEdD]. */
-
-collect_exponent:
- if (*tokptr == '+' || *tokptr == '-')
- {
- *copy++ = *tokptr++;
- }
-
- /* Now copy an exponent into the conversion buffer. Note that at the
- moment underscores are *not* allowed in exponents. */
-
- while (isdigit (*tokptr))
- {
- *copy++ = *tokptr++;
- }
-
- /* If we transfered any chars to the conversion buffer, try to interpret its
- contents as a floating point value. If any characters remain, then we
- must not have a valid floating point string. */
-
-convert_float:
- *copy = '\0';
- if (copy != buf)
- {
- dval = strtod (buf, ©);
- if (*copy == '\0')
- {
- yylval.dval = dval;
- lexptr = tokptr;
- return (FLOAT_LITERAL);
- }
- }
- return (0);
-}
-
-/* Recognize a string literal. A string literal is a sequence
- of characters enclosed in matching single or double quotes, except that
- a single character inside single quotes is a character literal, which
- we reject as a string literal. To embed the terminator character inside
- a string, it is simply doubled (I.E. "this""is""one""string") */
-
-static enum ch_terminal
-match_string_literal (void)
-{
- char *tokptr = lexptr;
- int in_ctrlseq = 0;
- LONGEST ival;
-
- for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
- {
- CHECKBUF (1);
- tryagain:;
- if (in_ctrlseq)
- {
- /* skip possible whitespaces */
- while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
- tokptr++;
- if (*tokptr == ')')
- {
- in_ctrlseq = 0;
- tokptr++;
- goto tryagain;
- }
- else if (*tokptr != ',')
- error ("Invalid control sequence");
- tokptr++;
- /* skip possible whitespaces */
- while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
- tokptr++;
- if (!decode_integer_literal (&ival, &tokptr))
- error ("Invalid control sequence");
- tokptr--;
- }
- else if (*tokptr == *lexptr)
- {
- if (*(tokptr + 1) == *lexptr)
- {
- ival = *tokptr++;
- }
- else
- {
- break;
- }
- }
- else if (*tokptr == '^')
- {
- if (*(tokptr + 1) == '(')
- {
- in_ctrlseq = 1;
- tokptr += 2;
- if (!decode_integer_literal (&ival, &tokptr))
- error ("Invalid control sequence");
- tokptr--;
- }
- else if (*(tokptr + 1) == '^')
- ival = *tokptr++;
- else
- error ("Invalid control sequence");
- }
- else
- ival = *tokptr;
- tempbuf[tempbufindex++] = ival;
- }
- if (in_ctrlseq)
- error ("Invalid control sequence");
-
- if (*tokptr == '\0' /* no terminator */
- || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
- {
- return (0);
- }
- else
- {
- tempbuf[tempbufindex] = '\0';
- yylval.sval.ptr = tempbuf;
- yylval.sval.length = tempbufindex;
- lexptr = ++tokptr;
- return (CHARACTER_STRING_LITERAL);
- }
-}
-
-/* Recognize a character literal. A character literal is single character
- or a control sequence, enclosed in single quotes. A control sequence
- is a comma separated list of one or more integer literals, enclosed
- in parenthesis and introduced with a circumflex character.
-
- EX: 'a' '^(7)' '^(7,8)'
-
- As a GNU chill extension, the syntax C'xx' is also recognized as a
- character literal, where xx is a hex value for the character.
-
- Note that more than a single character, enclosed in single quotes, is
- a string literal.
-
- Returns CHARACTER_LITERAL if a match is found.
- */
-
-static enum ch_terminal
-match_character_literal (void)
-{
- char *tokptr = lexptr;
- LONGEST ival = 0;
-
- if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
- {
- /* We have a GNU chill extension form, so skip the leading "C'",
- decode the hex value, and then ensure that we have a trailing
- single quote character. */
- tokptr += 2;
- if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
- {
- return (0);
- }
- tokptr++;
- }
- else if (*tokptr == '\'')
- {
- tokptr++;
-
- /* Determine which form we have, either a control sequence or the
- single character form. */
-
- if (*tokptr == '^')
- {
- if (*(tokptr + 1) == '(')
- {
- /* Match and decode a control sequence. Return zero if we don't
- find a valid integer literal, or if the next unconsumed character
- after the integer literal is not the trailing ')'. */
- tokptr += 2;
- if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
- {
- return (0);
- }
- }
- else if (*(tokptr + 1) == '^')
- {
- ival = *tokptr;
- tokptr += 2;
- }
- else
- /* fail */
- error ("Invalid control sequence");
- }
- else if (*tokptr == '\'')
- {
- /* this must be duplicated */
- ival = *tokptr;
- tokptr += 2;
- }
- else
- {
- ival = *tokptr++;
- }
-
- /* The trailing quote has not yet been consumed. If we don't find
- it, then we have no match. */
-
- if (*tokptr++ != '\'')
- {
- return (0);
- }
- }
- else
- {
- /* Not a character literal. */
- return (0);
- }
- yylval.typed_val.val = ival;
- yylval.typed_val.type = builtin_type_chill_char;
- lexptr = tokptr;
- return (CHARACTER_LITERAL);
-}
-
-/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
- Note that according to 5.2.4.2, a single "_" is also a valid integer
- literal, however GNU-chill requires there to be at least one "digit"
- in any integer literal. */
-
-static enum ch_terminal
-match_integer_literal (void)
-{
- char *tokptr = lexptr;
- LONGEST ival;
-
- if (!decode_integer_literal (&ival, &tokptr))
- {
- return (0);
- }
- else
- {
- yylval.typed_val.val = ival;
-#if defined(CC_HAS_LONG_LONG)
- if (ival > (LONGEST) 2147483647U || ival < -(LONGEST) 2147483648U)
- yylval.typed_val.type = builtin_type_long_long;
- else
-#endif
- yylval.typed_val.type = builtin_type_int;
- lexptr = tokptr;
- return (INTEGER_LITERAL);
- }
-}
-
-/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
- Note that according to 5.2.4.8, a single "_" is also a valid bit-string
- literal, however GNU-chill requires there to be at least one "digit"
- in any bit-string literal. */
-
-static enum ch_terminal
-match_bitstring_literal (void)
-{
- register char *tokptr = lexptr;
- int bitoffset = 0;
- int bitcount = 0;
- int bits_per_char;
- int digit;
-
- tempbufindex = 0;
- CHECKBUF (1);
- tempbuf[0] = 0;
-
- /* Look for the required explicit base specifier. */
-
- switch (*tokptr++)
- {
- case 'b':
- case 'B':
- bits_per_char = 1;
- break;
- case 'o':
- case 'O':
- bits_per_char = 3;
- break;
- case 'h':
- case 'H':
- bits_per_char = 4;
- break;
- default:
- return (0);
- break;
- }
-
- /* Ensure that the character after the explicit base is a single quote. */
-
- if (*tokptr++ != '\'')
- {
- return (0);
- }
-
- while (*tokptr != '\0' && *tokptr != '\'')
- {
- digit = *tokptr;
- if (isupper (digit))
- digit = tolower (digit);
- tokptr++;
- switch (digit)
- {
- case '_':
- continue;
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- digit -= '0';
- break;
- case 'a':
- case 'b':
- case 'c':
- case 'd':
- case 'e':
- case 'f':
- digit -= 'a';
- digit += 10;
- break;
- default:
- /* this is not a bitstring literal, probably an integer */
- return 0;
- }
- if (digit >= 1 << bits_per_char)
- {
- /* Found something not in domain for current base. */
- error ("Too-large digit in bitstring or integer.");
- }
- else
- {
- /* Extract bits from digit, packing them into the bitstring byte. */
- int k = TARGET_BYTE_ORDER == BFD_ENDIAN_BIG ? bits_per_char - 1 : 0;
- for (; TARGET_BYTE_ORDER == BFD_ENDIAN_BIG ? k >= 0 : k < bits_per_char;
- TARGET_BYTE_ORDER == BFD_ENDIAN_BIG ? k-- : k++)
- {
- bitcount++;
- if (digit & (1 << k))
- {
- tempbuf[tempbufindex] |=
- (TARGET_BYTE_ORDER == BFD_ENDIAN_BIG)
- ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
- : (1 << bitoffset);
- }
- bitoffset++;
- if (bitoffset == HOST_CHAR_BIT)
- {
- bitoffset = 0;
- tempbufindex++;
- CHECKBUF (1);
- tempbuf[tempbufindex] = 0;
- }
- }
- }
- }
-
- /* Verify that we consumed everything up to the trailing single quote,
- and that we found some bits (IE not just underbars). */
-
- if (*tokptr++ != '\'')
- {
- return (0);
- }
- else
- {
- yylval.sval.ptr = tempbuf;
- yylval.sval.length = bitcount;
- lexptr = tokptr;
- return (BIT_STRING_LITERAL);
- }
-}
-
-struct token
-{
- char *operator;
- int token;
-};
-
-static const struct token idtokentab[] =
-{
- {"array", ARRAY},
- {"length", LENGTH},
- {"lower", LOWER},
- {"upper", UPPER},
- {"andif", ANDIF},
- {"pred", PRED},
- {"succ", SUCC},
- {"card", CARD},
- {"size", SIZE},
- {"orif", ORIF},
- {"num", NUM},
- {"abs", ABS},
- {"max", MAX_TOKEN},
- {"min", MIN_TOKEN},
- {"mod", MOD},
- {"rem", REM},
- {"not", NOT},
- {"xor", LOGXOR},
- {"and", LOGAND},
- {"in", IN},
- {"or", LOGIOR},
- {"up", UP},
- {"addr", ADDR_TOKEN},
- {"null", EMPTINESS_LITERAL}
-};
-
-static const struct token tokentab2[] =
-{
- {":=", GDB_ASSIGNMENT},
- {"//", SLASH_SLASH},
- {"->", POINTER},
- {"/=", NOTEQUAL},
- {"<=", LEQ},
- {">=", GEQ}
-};
-
-/* Read one token, getting characters through lexptr. */
-/* This is where we will check to make sure that the language and the
- operators used are compatible. */
-
-static enum ch_terminal
-ch_lex (void)
-{
- unsigned int i;
- enum ch_terminal token;
- char *inputname;
- struct symbol *sym;
-
- /* Skip over any leading whitespace. */
- while (isspace (*lexptr))
- {
- lexptr++;
- }
- /* Look for special single character cases which can't be the first
- character of some other multicharacter token. */
- switch (*lexptr)
- {
- case '\0':
- return END_TOKEN;
- case ',':
- case '=':
- case ';':
- case '!':
- case '+':
- case '*':
- case '(':
- case ')':
- case '[':
- case ']':
- return (*lexptr++);
- }
- /* Look for characters which start a particular kind of multicharacter
- token, such as a character literal, register name, convenience
- variable name, string literal, etc. */
- switch (*lexptr)
- {
- case '\'':
- case '\"':
- /* First try to match a string literal, which is any
- sequence of characters enclosed in matching single or double
- quotes, except that a single character inside single quotes
- is a character literal, so we have to catch that case also. */
- token = match_string_literal ();
- if (token != 0)
- {
- return (token);
- }
- if (*lexptr == '\'')
- {
- token = match_character_literal ();
- if (token != 0)
- {
- return (token);
- }
- }
- break;
- case 'C':
- case 'c':
- token = match_character_literal ();
- if (token != 0)
- {
- return (token);
- }
- break;
- case '$':
- yylval.sval.ptr = lexptr;
- do
- {
- lexptr++;
- }
- while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
- yylval.sval.length = lexptr - yylval.sval.ptr;
- write_dollar_variable (yylval.sval);
- return GDB_VARIABLE;
- break;
- }
- /* See if it is a special token of length 2. */
- for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
- {
- if (STREQN (lexptr, tokentab2[i].operator, 2))
- {
- lexptr += 2;
- return (tokentab2[i].token);
- }
- }
- /* Look for single character cases which which could be the first
- character of some other multicharacter token, but aren't, or we
- would already have found it. */
- switch (*lexptr)
- {
- case '-':
- case ':':
- case '/':
- case '<':
- case '>':
- return (*lexptr++);
- }
- /* Look for a float literal before looking for an integer literal, so
- we match as much of the input stream as possible. */
- token = match_float_literal ();
- if (token != 0)
- {
- return (token);
- }
- token = match_bitstring_literal ();
- if (token != 0)
- {
- return (token);
- }
- token = match_integer_literal ();
- if (token != 0)
- {
- return (token);
- }
-
- /* Try to match a simple name string, and if a match is found, then
- further classify what sort of name it is and return an appropriate
- token. Note that attempting to match a simple name string consumes
- the token from lexptr, so we can't back out if we later find that
- we can't classify what sort of name it is. */
-
- inputname = match_simple_name_string ();
-
- if (inputname != NULL)
- {
- char *simplename = (char *) alloca (strlen (inputname) + 1);
-
- char *dptr = simplename, *sptr = inputname;
- for (; *sptr; sptr++)
- *dptr++ = isupper (*sptr) ? tolower (*sptr) : *sptr;
- *dptr = '\0';
-
- /* See if it is a reserved identifier. */
- for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
- {
- if (STREQ (simplename, idtokentab[i].operator))
- {
- return (idtokentab[i].token);
- }
- }
-
- /* Look for other special tokens. */
- if (STREQ (simplename, "true"))
- {
- yylval.ulval = 1;
- return (BOOLEAN_LITERAL);
- }
- if (STREQ (simplename, "false"))
- {
- yylval.ulval = 0;
- return (BOOLEAN_LITERAL);
- }
-
- sym = lookup_symbol (inputname, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
- (struct symtab **) NULL);
- if (sym == NULL && strcmp (inputname, simplename) != 0)
- {
- sym = lookup_symbol (simplename, expression_context_block,
- VAR_NAMESPACE, (int *) NULL,
- (struct symtab **) NULL);
- }
- if (sym != NULL)
- {
- yylval.ssym.stoken.ptr = NULL;
- yylval.ssym.stoken.length = 0;
- yylval.ssym.sym = sym;
- yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_BLOCK:
- /* Found a procedure name. */
- return (GENERAL_PROCEDURE_NAME);
- case LOC_STATIC:
- /* Found a global or local static variable. */
- return (LOCATION_NAME);
- case LOC_REGISTER:
- case LOC_ARG:
- case LOC_REF_ARG:
- case LOC_REGPARM:
- case LOC_REGPARM_ADDR:
- case LOC_LOCAL:
- case LOC_LOCAL_ARG:
- case LOC_BASEREG:
- case LOC_BASEREG_ARG:
- if (innermost_block == NULL
- || contained_in (block_found, innermost_block))
- {
- innermost_block = block_found;
- }
- return (LOCATION_NAME);
- break;
- case LOC_CONST:
- case LOC_LABEL:
- return (LOCATION_NAME);
- break;
- case LOC_TYPEDEF:
- yylval.tsym.type = SYMBOL_TYPE (sym);
- return TYPENAME;
- case LOC_UNDEF:
- case LOC_CONST_BYTES:
- case LOC_OPTIMIZED_OUT:
- error ("Symbol \"%s\" names no location.", inputname);
- break;
- default:
- internal_error (__FILE__, __LINE__,
- "unhandled SYMBOL_CLASS in ch_lex()");
- break;
- }
- }
- else if (!have_full_symbols () && !have_partial_symbols ())
- {
- error ("No symbol table is loaded. Use the \"file\" command.");
- }
- else
- {
- error ("No symbol \"%s\" in current context.", inputname);
- }
- }
-
- /* Catch single character tokens which are not part of some
- longer token. */
-
- switch (*lexptr)
- {
- case '.': /* Not float for example. */
- lexptr++;
- while (isspace (*lexptr))
- lexptr++;
- inputname = match_simple_name_string ();
- if (!inputname)
- return '.';
- return DOT_FIELD_NAME;
- }
-
- return (ILLEGAL_TOKEN);
-}
-
-static void
-write_lower_upper_value (enum exp_opcode opcode, /* Either UNOP_LOWER or UNOP_UPPER */
- struct type *type)
-{
- if (type == NULL)
- write_exp_elt_opcode (opcode);
- else
- {
- struct type *result_type;
- LONGEST val = type_lower_upper (opcode, type, &result_type);
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (result_type);
- write_exp_elt_longcst (val);
- write_exp_elt_opcode (OP_LONG);
- }
-}
-
-void
-chill_error (char *msg)
-{
- /* Never used. */
-}
+// OBSOLETE /* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
+// OBSOLETE Copyright 1992, 1993, 1995, 1996, 1997, 1999, 2000, 2001
+// OBSOLETE Free Software Foundation, Inc.
+// OBSOLETE
+// OBSOLETE This file is part of GDB.
+// OBSOLETE
+// OBSOLETE This program is free software; you can redistribute it and/or modify
+// OBSOLETE it under the terms of the GNU General Public License as published by
+// OBSOLETE the Free Software Foundation; either version 2 of the License, or
+// OBSOLETE (at your option) any later version.
+// OBSOLETE
+// OBSOLETE This program is distributed in the hope that it will be useful,
+// OBSOLETE but WITHOUT ANY WARRANTY; without even the implied warranty of
+// OBSOLETE MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// OBSOLETE GNU General Public License for more details.
+// OBSOLETE
+// OBSOLETE You should have received a copy of the GNU General Public License
+// OBSOLETE along with this program; if not, write to the Free Software
+// OBSOLETE Foundation, Inc., 59 Temple Place - Suite 330,
+// OBSOLETE Boston, MA 02111-1307, USA. */
+// OBSOLETE
+// OBSOLETE /* Parse a Chill expression from text in a string,
+// OBSOLETE and return the result as a struct expression pointer.
+// OBSOLETE That structure contains arithmetic operations in reverse polish,
+// OBSOLETE with constants represented by operations that are followed by special data.
+// OBSOLETE See expression.h for the details of the format.
+// OBSOLETE What is important here is that it can be built up sequentially
+// OBSOLETE during the process of parsing; the lower levels of the tree always
+// OBSOLETE come first in the result.
+// OBSOLETE
+// OBSOLETE Note that the language accepted by this parser is more liberal
+// OBSOLETE than the one accepted by an actual Chill compiler. For example, the
+// OBSOLETE language rule that a simple name string can not be one of the reserved
+// OBSOLETE simple name strings is not enforced (e.g "case" is not treated as a
+// OBSOLETE reserved name). Another example is that Chill is a strongly typed
+// OBSOLETE language, and certain expressions that violate the type constraints
+// OBSOLETE may still be evaluated if gdb can do so in a meaningful manner, while
+// OBSOLETE such expressions would be rejected by the compiler. The reason for
+// OBSOLETE this more liberal behavior is the philosophy that the debugger
+// OBSOLETE is intended to be a tool that is used by the programmer when things
+// OBSOLETE go wrong, and as such, it should provide as few artificial barriers
+// OBSOLETE to it's use as possible. If it can do something meaningful, even
+// OBSOLETE something that violates language contraints that are enforced by the
+// OBSOLETE compiler, it should do so without complaint.
+// OBSOLETE
+// OBSOLETE */
+// OBSOLETE
+// OBSOLETE #include "defs.h"
+// OBSOLETE #include "gdb_string.h"
+// OBSOLETE #include <ctype.h>
+// OBSOLETE #include "expression.h"
+// OBSOLETE #include "language.h"
+// OBSOLETE #include "value.h"
+// OBSOLETE #include "parser-defs.h"
+// OBSOLETE #include "ch-lang.h"
+// OBSOLETE #include "bfd.h" /* Required by objfiles.h. */
+// OBSOLETE #include "symfile.h" /* Required by objfiles.h. */
+// OBSOLETE #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
+// OBSOLETE
+// OBSOLETE #ifdef __GNUC__
+// OBSOLETE #define INLINE __inline__
+// OBSOLETE #endif
+// OBSOLETE
+// OBSOLETE typedef union
+// OBSOLETE
+// OBSOLETE {
+// OBSOLETE LONGEST lval;
+// OBSOLETE ULONGEST ulval;
+// OBSOLETE struct
+// OBSOLETE {
+// OBSOLETE LONGEST val;
+// OBSOLETE struct type *type;
+// OBSOLETE }
+// OBSOLETE typed_val;
+// OBSOLETE double dval;
+// OBSOLETE struct symbol *sym;
+// OBSOLETE struct type *tval;
+// OBSOLETE struct stoken sval;
+// OBSOLETE struct ttype tsym;
+// OBSOLETE struct symtoken ssym;
+// OBSOLETE }
+// OBSOLETE YYSTYPE;
+// OBSOLETE
+// OBSOLETE enum ch_terminal
+// OBSOLETE {
+// OBSOLETE END_TOKEN = 0,
+// OBSOLETE /* '\001' ... '\xff' come first. */
+// OBSOLETE OPEN_PAREN = '(',
+// OBSOLETE TOKEN_NOT_READ = 999,
+// OBSOLETE INTEGER_LITERAL,
+// OBSOLETE BOOLEAN_LITERAL,
+// OBSOLETE CHARACTER_LITERAL,
+// OBSOLETE FLOAT_LITERAL,
+// OBSOLETE GENERAL_PROCEDURE_NAME,
+// OBSOLETE LOCATION_NAME,
+// OBSOLETE EMPTINESS_LITERAL,
+// OBSOLETE CHARACTER_STRING_LITERAL,
+// OBSOLETE BIT_STRING_LITERAL,
+// OBSOLETE TYPENAME,
+// OBSOLETE DOT_FIELD_NAME, /* '.' followed by <field name> */
+// OBSOLETE CASE,
+// OBSOLETE OF,
+// OBSOLETE ESAC,
+// OBSOLETE LOGIOR,
+// OBSOLETE ORIF,
+// OBSOLETE LOGXOR,
+// OBSOLETE LOGAND,
+// OBSOLETE ANDIF,
+// OBSOLETE NOTEQUAL,
+// OBSOLETE GEQ,
+// OBSOLETE LEQ,
+// OBSOLETE IN,
+// OBSOLETE SLASH_SLASH,
+// OBSOLETE MOD,
+// OBSOLETE REM,
+// OBSOLETE NOT,
+// OBSOLETE POINTER,
+// OBSOLETE RECEIVE,
+// OBSOLETE UP,
+// OBSOLETE IF,
+// OBSOLETE THEN,
+// OBSOLETE ELSE,
+// OBSOLETE FI,
+// OBSOLETE ELSIF,
+// OBSOLETE ILLEGAL_TOKEN,
+// OBSOLETE NUM,
+// OBSOLETE PRED,
+// OBSOLETE SUCC,
+// OBSOLETE ABS,
+// OBSOLETE CARD,
+// OBSOLETE MAX_TOKEN,
+// OBSOLETE MIN_TOKEN,
+// OBSOLETE ADDR_TOKEN,
+// OBSOLETE SIZE,
+// OBSOLETE UPPER,
+// OBSOLETE LOWER,
+// OBSOLETE LENGTH,
+// OBSOLETE ARRAY,
+// OBSOLETE GDB_VARIABLE,
+// OBSOLETE GDB_ASSIGNMENT
+// OBSOLETE };
+// OBSOLETE
+// OBSOLETE /* Forward declarations. */
+// OBSOLETE
+// OBSOLETE static void write_lower_upper_value (enum exp_opcode, struct type *);
+// OBSOLETE static enum ch_terminal match_bitstring_literal (void);
+// OBSOLETE static enum ch_terminal match_integer_literal (void);
+// OBSOLETE static enum ch_terminal match_character_literal (void);
+// OBSOLETE static enum ch_terminal match_string_literal (void);
+// OBSOLETE static enum ch_terminal match_float_literal (void);
+// OBSOLETE static int decode_integer_literal (LONGEST *, char **);
+// OBSOLETE static int decode_integer_value (int, char **, LONGEST *);
+// OBSOLETE static char *match_simple_name_string (void);
+// OBSOLETE static void growbuf_by_size (int);
+// OBSOLETE static void parse_case_label (void);
+// OBSOLETE static void parse_untyped_expr (void);
+// OBSOLETE static void parse_if_expression (void);
+// OBSOLETE static void parse_if_expression_body (void);
+// OBSOLETE static void parse_else_alternative (void);
+// OBSOLETE static void parse_then_alternative (void);
+// OBSOLETE static void parse_expr (void);
+// OBSOLETE static void parse_operand0 (void);
+// OBSOLETE static void parse_operand1 (void);
+// OBSOLETE static void parse_operand2 (void);
+// OBSOLETE static void parse_operand3 (void);
+// OBSOLETE static void parse_operand4 (void);
+// OBSOLETE static void parse_operand5 (void);
+// OBSOLETE static void parse_operand6 (void);
+// OBSOLETE static void parse_primval (void);
+// OBSOLETE static void parse_tuple (struct type *);
+// OBSOLETE static void parse_opt_element_list (struct type *);
+// OBSOLETE static void parse_tuple_element (struct type *);
+// OBSOLETE static void parse_named_record_element (void);
+// OBSOLETE static void parse_call (void);
+// OBSOLETE static struct type *parse_mode_or_normal_call (void);
+// OBSOLETE #if 0
+// OBSOLETE static struct type *parse_mode_call (void);
+// OBSOLETE #endif
+// OBSOLETE static void parse_unary_call (void);
+// OBSOLETE static int parse_opt_untyped_expr (void);
+// OBSOLETE static int expect (enum ch_terminal, char *);
+// OBSOLETE static enum ch_terminal ch_lex (void);
+// OBSOLETE INLINE static enum ch_terminal PEEK_TOKEN (void);
+// OBSOLETE static enum ch_terminal peek_token_ (int);
+// OBSOLETE static void forward_token_ (void);
+// OBSOLETE static void require (enum ch_terminal);
+// OBSOLETE static int check_token (enum ch_terminal);
+// OBSOLETE
+// OBSOLETE #define MAX_LOOK_AHEAD 2
+// OBSOLETE static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD + 1] =
+// OBSOLETE {
+// OBSOLETE TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
+// OBSOLETE static YYSTYPE yylval;
+// OBSOLETE static YYSTYPE val_buffer[MAX_LOOK_AHEAD + 1];
+// OBSOLETE
+// OBSOLETE /*int current_token, lookahead_token; */
+// OBSOLETE
+// OBSOLETE INLINE static enum ch_terminal
+// OBSOLETE PEEK_TOKEN (void)
+// OBSOLETE {
+// OBSOLETE if (terminal_buffer[0] == TOKEN_NOT_READ)
+// OBSOLETE {
+// OBSOLETE terminal_buffer[0] = ch_lex ();
+// OBSOLETE val_buffer[0] = yylval;
+// OBSOLETE }
+// OBSOLETE return terminal_buffer[0];
+// OBSOLETE }
+// OBSOLETE #define PEEK_LVAL() val_buffer[0]
+// OBSOLETE #define PEEK_TOKEN1() peek_token_(1)
+// OBSOLETE #define PEEK_TOKEN2() peek_token_(2)
+// OBSOLETE static enum ch_terminal
+// OBSOLETE peek_token_ (int i)
+// OBSOLETE {
+// OBSOLETE if (i > MAX_LOOK_AHEAD)
+// OBSOLETE internal_error (__FILE__, __LINE__,
+// OBSOLETE "too much lookahead");
+// OBSOLETE if (terminal_buffer[i] == TOKEN_NOT_READ)
+// OBSOLETE {
+// OBSOLETE terminal_buffer[i] = ch_lex ();
+// OBSOLETE val_buffer[i] = yylval;
+// OBSOLETE }
+// OBSOLETE return terminal_buffer[i];
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE #if 0
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE pushback_token (enum ch_terminal code, YYSTYPE node)
+// OBSOLETE {
+// OBSOLETE int i;
+// OBSOLETE if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
+// OBSOLETE internal_error (__FILE__, __LINE__,
+// OBSOLETE "cannot pushback token");
+// OBSOLETE for (i = MAX_LOOK_AHEAD; i > 0; i--)
+// OBSOLETE {
+// OBSOLETE terminal_buffer[i] = terminal_buffer[i - 1];
+// OBSOLETE val_buffer[i] = val_buffer[i - 1];
+// OBSOLETE }
+// OBSOLETE terminal_buffer[0] = code;
+// OBSOLETE val_buffer[0] = node;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE #endif
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE forward_token_ (void)
+// OBSOLETE {
+// OBSOLETE int i;
+// OBSOLETE for (i = 0; i < MAX_LOOK_AHEAD; i++)
+// OBSOLETE {
+// OBSOLETE terminal_buffer[i] = terminal_buffer[i + 1];
+// OBSOLETE val_buffer[i] = val_buffer[i + 1];
+// OBSOLETE }
+// OBSOLETE terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
+// OBSOLETE }
+// OBSOLETE #define FORWARD_TOKEN() forward_token_()
+// OBSOLETE
+// OBSOLETE /* Skip the next token.
+// OBSOLETE if it isn't TOKEN, the parser is broken. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE require (enum ch_terminal token)
+// OBSOLETE {
+// OBSOLETE if (PEEK_TOKEN () != token)
+// OBSOLETE {
+// OBSOLETE internal_error (__FILE__, __LINE__,
+// OBSOLETE "expected token %d", (int) token);
+// OBSOLETE }
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static int
+// OBSOLETE check_token (enum ch_terminal token)
+// OBSOLETE {
+// OBSOLETE if (PEEK_TOKEN () != token)
+// OBSOLETE return 0;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE return 1;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* return 0 if expected token was not found,
+// OBSOLETE else return 1.
+// OBSOLETE */
+// OBSOLETE static int
+// OBSOLETE expect (enum ch_terminal token, char *message)
+// OBSOLETE {
+// OBSOLETE if (PEEK_TOKEN () != token)
+// OBSOLETE {
+// OBSOLETE if (message)
+// OBSOLETE error (message);
+// OBSOLETE else if (token < 256)
+// OBSOLETE error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
+// OBSOLETE else
+// OBSOLETE error ("syntax error");
+// OBSOLETE return 0;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE return 1;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE #if 0
+// OBSOLETE /* Parse a name string. If ALLOW_ALL is 1, ALL is allowed as a postfix. */
+// OBSOLETE
+// OBSOLETE static tree
+// OBSOLETE parse_opt_name_string (int allow_all)
+// OBSOLETE {
+// OBSOLETE int token = PEEK_TOKEN ();
+// OBSOLETE tree name;
+// OBSOLETE if (token != NAME)
+// OBSOLETE {
+// OBSOLETE if (token == ALL && allow_all)
+// OBSOLETE {
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE return ALL_POSTFIX;
+// OBSOLETE }
+// OBSOLETE return NULL_TREE;
+// OBSOLETE }
+// OBSOLETE name = PEEK_LVAL ();
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE token = PEEK_TOKEN ();
+// OBSOLETE if (token != '!')
+// OBSOLETE return name;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE token = PEEK_TOKEN ();
+// OBSOLETE if (token == ALL && allow_all)
+// OBSOLETE return get_identifier3 (IDENTIFIER_POINTER (name), "!", "*");
+// OBSOLETE if (token != NAME)
+// OBSOLETE {
+// OBSOLETE if (pass == 1)
+// OBSOLETE error ("'%s!' is not followed by an identifier",
+// OBSOLETE IDENTIFIER_POINTER (name));
+// OBSOLETE return name;
+// OBSOLETE }
+// OBSOLETE name = get_identifier3 (IDENTIFIER_POINTER (name),
+// OBSOLETE "!", IDENTIFIER_POINTER (PEEK_LVAL ()));
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static tree
+// OBSOLETE parse_simple_name_string (void)
+// OBSOLETE {
+// OBSOLETE int token = PEEK_TOKEN ();
+// OBSOLETE tree name;
+// OBSOLETE if (token != NAME)
+// OBSOLETE {
+// OBSOLETE error ("expected a name here");
+// OBSOLETE return error_mark_node;
+// OBSOLETE }
+// OBSOLETE name = PEEK_LVAL ();
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE return name;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static tree
+// OBSOLETE parse_name_string (void)
+// OBSOLETE {
+// OBSOLETE tree name = parse_opt_name_string (0);
+// OBSOLETE if (name)
+// OBSOLETE return name;
+// OBSOLETE if (pass == 1)
+// OBSOLETE error ("expected a name string here");
+// OBSOLETE return error_mark_node;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Matches: <name_string>
+// OBSOLETE Returns if pass 1: the identifier.
+// OBSOLETE Returns if pass 2: a decl or value for identifier. */
+// OBSOLETE
+// OBSOLETE static tree
+// OBSOLETE parse_name (void)
+// OBSOLETE {
+// OBSOLETE tree name = parse_name_string ();
+// OBSOLETE if (pass == 1 || ignoring)
+// OBSOLETE return name;
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE tree decl = lookup_name (name);
+// OBSOLETE if (decl == NULL_TREE)
+// OBSOLETE {
+// OBSOLETE error ("`%s' undeclared", IDENTIFIER_POINTER (name));
+// OBSOLETE return error_mark_node;
+// OBSOLETE }
+// OBSOLETE else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
+// OBSOLETE return error_mark_node;
+// OBSOLETE else if (TREE_CODE (decl) == CONST_DECL)
+// OBSOLETE return DECL_INITIAL (decl);
+// OBSOLETE else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
+// OBSOLETE return convert_from_reference (decl);
+// OBSOLETE else
+// OBSOLETE return decl;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE #endif
+// OBSOLETE
+// OBSOLETE #if 0
+// OBSOLETE static void
+// OBSOLETE pushback_paren_expr (tree expr)
+// OBSOLETE {
+// OBSOLETE if (pass == 1 && !ignoring)
+// OBSOLETE expr = build1 (PAREN_EXPR, NULL_TREE, expr);
+// OBSOLETE pushback_token (EXPR, expr);
+// OBSOLETE }
+// OBSOLETE #endif
+// OBSOLETE
+// OBSOLETE /* Matches: <case label> */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_case_label (void)
+// OBSOLETE {
+// OBSOLETE if (check_token (ELSE))
+// OBSOLETE error ("ELSE in tuples labels not implemented");
+// OBSOLETE /* Does not handle the case of a mode name. FIXME */
+// OBSOLETE parse_expr ();
+// OBSOLETE if (check_token (':'))
+// OBSOLETE {
+// OBSOLETE parse_expr ();
+// OBSOLETE write_exp_elt_opcode (BINOP_RANGE);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static int
+// OBSOLETE parse_opt_untyped_expr (void)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case ',':
+// OBSOLETE case ':':
+// OBSOLETE case ')':
+// OBSOLETE return 0;
+// OBSOLETE default:
+// OBSOLETE parse_untyped_expr ();
+// OBSOLETE return 1;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_unary_call (void)
+// OBSOLETE {
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE expect ('(', NULL);
+// OBSOLETE parse_expr ();
+// OBSOLETE expect (')', NULL);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Parse NAME '(' MODENAME ')'. */
+// OBSOLETE
+// OBSOLETE #if 0
+// OBSOLETE
+// OBSOLETE static struct type *
+// OBSOLETE parse_mode_call (void)
+// OBSOLETE {
+// OBSOLETE struct type *type;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE expect ('(', NULL);
+// OBSOLETE if (PEEK_TOKEN () != TYPENAME)
+// OBSOLETE error ("expect MODENAME here `%s'", lexptr);
+// OBSOLETE type = PEEK_LVAL ().tsym.type;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE expect (')', NULL);
+// OBSOLETE return type;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE #endif
+// OBSOLETE
+// OBSOLETE static struct type *
+// OBSOLETE parse_mode_or_normal_call (void)
+// OBSOLETE {
+// OBSOLETE struct type *type;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE expect ('(', NULL);
+// OBSOLETE if (PEEK_TOKEN () == TYPENAME)
+// OBSOLETE {
+// OBSOLETE type = PEEK_LVAL ().tsym.type;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE parse_expr ();
+// OBSOLETE type = NULL;
+// OBSOLETE }
+// OBSOLETE expect (')', NULL);
+// OBSOLETE return type;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Parse something that looks like a function call.
+// OBSOLETE Assume we have parsed the function, and are at the '('. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_call (void)
+// OBSOLETE {
+// OBSOLETE int arg_count;
+// OBSOLETE require ('(');
+// OBSOLETE /* This is to save the value of arglist_len
+// OBSOLETE being accumulated for each dimension. */
+// OBSOLETE start_arglist ();
+// OBSOLETE if (parse_opt_untyped_expr ())
+// OBSOLETE {
+// OBSOLETE int tok = PEEK_TOKEN ();
+// OBSOLETE arglist_len = 1;
+// OBSOLETE if (tok == UP || tok == ':')
+// OBSOLETE {
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_expr ();
+// OBSOLETE expect (')', "expected ')' to terminate slice");
+// OBSOLETE end_arglist ();
+// OBSOLETE write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
+// OBSOLETE : TERNOP_SLICE);
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE while (check_token (','))
+// OBSOLETE {
+// OBSOLETE parse_untyped_expr ();
+// OBSOLETE arglist_len++;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE arglist_len = 0;
+// OBSOLETE expect (')', NULL);
+// OBSOLETE arg_count = end_arglist ();
+// OBSOLETE write_exp_elt_opcode (MULTI_SUBSCRIPT);
+// OBSOLETE write_exp_elt_longcst (arg_count);
+// OBSOLETE write_exp_elt_opcode (MULTI_SUBSCRIPT);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_named_record_element (void)
+// OBSOLETE {
+// OBSOLETE struct stoken label;
+// OBSOLETE char buf[256];
+// OBSOLETE
+// OBSOLETE label = PEEK_LVAL ().sval;
+// OBSOLETE sprintf (buf, "expected a field name here `%s'", lexptr);
+// OBSOLETE expect (DOT_FIELD_NAME, buf);
+// OBSOLETE if (check_token (','))
+// OBSOLETE parse_named_record_element ();
+// OBSOLETE else if (check_token (':'))
+// OBSOLETE parse_expr ();
+// OBSOLETE else
+// OBSOLETE error ("syntax error near `%s' in named record tuple element", lexptr);
+// OBSOLETE write_exp_elt_opcode (OP_LABELED);
+// OBSOLETE write_exp_string (label);
+// OBSOLETE write_exp_elt_opcode (OP_LABELED);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Returns one or more TREE_LIST nodes, in reverse order. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_tuple_element (struct type *type)
+// OBSOLETE {
+// OBSOLETE if (PEEK_TOKEN () == DOT_FIELD_NAME)
+// OBSOLETE {
+// OBSOLETE /* Parse a labelled structure tuple. */
+// OBSOLETE parse_named_record_element ();
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE if (check_token ('('))
+// OBSOLETE {
+// OBSOLETE if (check_token ('*'))
+// OBSOLETE {
+// OBSOLETE expect (')', "missing ')' after '*' case label list");
+// OBSOLETE if (type)
+// OBSOLETE {
+// OBSOLETE if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
+// OBSOLETE {
+// OBSOLETE /* do this as a range from low to high */
+// OBSOLETE struct type *range_type = TYPE_FIELD_TYPE (type, 0);
+// OBSOLETE LONGEST low_bound, high_bound;
+// OBSOLETE if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
+// OBSOLETE error ("cannot determine bounds for (*)");
+// OBSOLETE /* lower bound */
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_type (range_type);
+// OBSOLETE write_exp_elt_longcst (low_bound);
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE /* upper bound */
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_type (range_type);
+// OBSOLETE write_exp_elt_longcst (high_bound);
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_opcode (BINOP_RANGE);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE error ("(*) in invalid context");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE error ("(*) only possible with modename in front of tuple (mode[..])");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE parse_case_label ();
+// OBSOLETE while (check_token (','))
+// OBSOLETE {
+// OBSOLETE parse_case_label ();
+// OBSOLETE write_exp_elt_opcode (BINOP_COMMA);
+// OBSOLETE }
+// OBSOLETE expect (')', NULL);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE parse_untyped_expr ();
+// OBSOLETE if (check_token (':'))
+// OBSOLETE {
+// OBSOLETE /* A powerset range or a labeled Array. */
+// OBSOLETE parse_untyped_expr ();
+// OBSOLETE write_exp_elt_opcode (BINOP_RANGE);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Matches: a COMMA-separated list of tuple elements.
+// OBSOLETE Returns a list (of TREE_LIST nodes). */
+// OBSOLETE static void
+// OBSOLETE parse_opt_element_list (struct type *type)
+// OBSOLETE {
+// OBSOLETE arglist_len = 0;
+// OBSOLETE if (PEEK_TOKEN () == ']')
+// OBSOLETE return;
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE parse_tuple_element (type);
+// OBSOLETE arglist_len++;
+// OBSOLETE if (PEEK_TOKEN () == ']')
+// OBSOLETE break;
+// OBSOLETE if (!check_token (','))
+// OBSOLETE error ("bad syntax in tuple");
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Parses: '[' elements ']'
+// OBSOLETE If modename is non-NULL it prefixed the tuple. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_tuple (struct type *mode)
+// OBSOLETE {
+// OBSOLETE struct type *type;
+// OBSOLETE if (mode)
+// OBSOLETE type = check_typedef (mode);
+// OBSOLETE else
+// OBSOLETE type = 0;
+// OBSOLETE require ('[');
+// OBSOLETE start_arglist ();
+// OBSOLETE parse_opt_element_list (type);
+// OBSOLETE expect (']', "missing ']' after tuple");
+// OBSOLETE write_exp_elt_opcode (OP_ARRAY);
+// OBSOLETE write_exp_elt_longcst ((LONGEST) 0);
+// OBSOLETE write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
+// OBSOLETE write_exp_elt_opcode (OP_ARRAY);
+// OBSOLETE if (type)
+// OBSOLETE {
+// OBSOLETE if (TYPE_CODE (type) != TYPE_CODE_ARRAY
+// OBSOLETE && TYPE_CODE (type) != TYPE_CODE_STRUCT
+// OBSOLETE && TYPE_CODE (type) != TYPE_CODE_SET)
+// OBSOLETE error ("invalid tuple mode");
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE write_exp_elt_type (mode);
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_primval (void)
+// OBSOLETE {
+// OBSOLETE struct type *type;
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE char *op_name;
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case INTEGER_LITERAL:
+// OBSOLETE case CHARACTER_LITERAL:
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_type (PEEK_LVAL ().typed_val.type);
+// OBSOLETE write_exp_elt_longcst (PEEK_LVAL ().typed_val.val);
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case BOOLEAN_LITERAL:
+// OBSOLETE write_exp_elt_opcode (OP_BOOL);
+// OBSOLETE write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
+// OBSOLETE write_exp_elt_opcode (OP_BOOL);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case FLOAT_LITERAL:
+// OBSOLETE write_exp_elt_opcode (OP_DOUBLE);
+// OBSOLETE write_exp_elt_type (builtin_type_double);
+// OBSOLETE write_exp_elt_dblcst (PEEK_LVAL ().dval);
+// OBSOLETE write_exp_elt_opcode (OP_DOUBLE);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case EMPTINESS_LITERAL:
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_type (lookup_pointer_type (builtin_type_void));
+// OBSOLETE write_exp_elt_longcst (0);
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case CHARACTER_STRING_LITERAL:
+// OBSOLETE write_exp_elt_opcode (OP_STRING);
+// OBSOLETE write_exp_string (PEEK_LVAL ().sval);
+// OBSOLETE write_exp_elt_opcode (OP_STRING);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case BIT_STRING_LITERAL:
+// OBSOLETE write_exp_elt_opcode (OP_BITSTRING);
+// OBSOLETE write_exp_bitstring (PEEK_LVAL ().sval);
+// OBSOLETE write_exp_elt_opcode (OP_BITSTRING);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case ARRAY:
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
+// OBSOLETE which casts to an artificial array. */
+// OBSOLETE expect ('(', NULL);
+// OBSOLETE expect (')', NULL);
+// OBSOLETE if (PEEK_TOKEN () != TYPENAME)
+// OBSOLETE error ("missing MODENAME after ARRAY()");
+// OBSOLETE type = PEEK_LVAL ().tsym.type;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE expect ('(', NULL);
+// OBSOLETE parse_expr ();
+// OBSOLETE expect (')', "missing right parenthesis");
+// OBSOLETE type = create_array_type ((struct type *) NULL, type,
+// OBSOLETE create_range_type ((struct type *) NULL,
+// OBSOLETE builtin_type_int, 0, 0));
+// OBSOLETE TYPE_ARRAY_UPPER_BOUND_TYPE (type) = BOUND_CANNOT_BE_DETERMINED;
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE write_exp_elt_type (type);
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE break;
+// OBSOLETE #if 0
+// OBSOLETE case CONST:
+// OBSOLETE case EXPR:
+// OBSOLETE val = PEEK_LVAL ();
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE #endif
+// OBSOLETE case '(':
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_expr ();
+// OBSOLETE expect (')', "missing right parenthesis");
+// OBSOLETE break;
+// OBSOLETE case '[':
+// OBSOLETE parse_tuple (NULL);
+// OBSOLETE break;
+// OBSOLETE case GENERAL_PROCEDURE_NAME:
+// OBSOLETE case LOCATION_NAME:
+// OBSOLETE write_exp_elt_opcode (OP_VAR_VALUE);
+// OBSOLETE write_exp_elt_block (NULL);
+// OBSOLETE write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
+// OBSOLETE write_exp_elt_opcode (OP_VAR_VALUE);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case GDB_VARIABLE: /* gdb specific */
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE break;
+// OBSOLETE case NUM:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE write_exp_elt_type (builtin_type_int);
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE break;
+// OBSOLETE case CARD:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE write_exp_elt_opcode (UNOP_CARD);
+// OBSOLETE break;
+// OBSOLETE case MAX_TOKEN:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE write_exp_elt_opcode (UNOP_CHMAX);
+// OBSOLETE break;
+// OBSOLETE case MIN_TOKEN:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE write_exp_elt_opcode (UNOP_CHMIN);
+// OBSOLETE break;
+// OBSOLETE case PRED:
+// OBSOLETE op_name = "PRED";
+// OBSOLETE goto unimplemented_unary_builtin;
+// OBSOLETE case SUCC:
+// OBSOLETE op_name = "SUCC";
+// OBSOLETE goto unimplemented_unary_builtin;
+// OBSOLETE case ABS:
+// OBSOLETE op_name = "ABS";
+// OBSOLETE goto unimplemented_unary_builtin;
+// OBSOLETE unimplemented_unary_builtin:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE error ("not implemented: %s builtin function", op_name);
+// OBSOLETE break;
+// OBSOLETE case ADDR_TOKEN:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE write_exp_elt_opcode (UNOP_ADDR);
+// OBSOLETE break;
+// OBSOLETE case SIZE:
+// OBSOLETE type = parse_mode_or_normal_call ();
+// OBSOLETE if (type)
+// OBSOLETE {
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_type (builtin_type_int);
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE write_exp_elt_opcode (UNOP_SIZEOF);
+// OBSOLETE break;
+// OBSOLETE case LOWER:
+// OBSOLETE op = UNOP_LOWER;
+// OBSOLETE goto lower_upper;
+// OBSOLETE case UPPER:
+// OBSOLETE op = UNOP_UPPER;
+// OBSOLETE goto lower_upper;
+// OBSOLETE lower_upper:
+// OBSOLETE type = parse_mode_or_normal_call ();
+// OBSOLETE write_lower_upper_value (op, type);
+// OBSOLETE break;
+// OBSOLETE case LENGTH:
+// OBSOLETE parse_unary_call ();
+// OBSOLETE write_exp_elt_opcode (UNOP_LENGTH);
+// OBSOLETE break;
+// OBSOLETE case TYPENAME:
+// OBSOLETE type = PEEK_LVAL ().tsym.type;
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case '[':
+// OBSOLETE parse_tuple (type);
+// OBSOLETE break;
+// OBSOLETE case '(':
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_expr ();
+// OBSOLETE expect (')', "missing right parenthesis");
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE write_exp_elt_type (type);
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE error ("typename in invalid context");
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE default:
+// OBSOLETE error ("invalid expression syntax at `%s'", lexptr);
+// OBSOLETE }
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case DOT_FIELD_NAME:
+// OBSOLETE write_exp_elt_opcode (STRUCTOP_STRUCT);
+// OBSOLETE write_exp_string (PEEK_LVAL ().sval);
+// OBSOLETE write_exp_elt_opcode (STRUCTOP_STRUCT);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE continue;
+// OBSOLETE case POINTER:
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE if (PEEK_TOKEN () == TYPENAME)
+// OBSOLETE {
+// OBSOLETE type = PEEK_LVAL ().tsym.type;
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE write_exp_elt_type (lookup_pointer_type (type));
+// OBSOLETE write_exp_elt_opcode (UNOP_CAST);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE }
+// OBSOLETE write_exp_elt_opcode (UNOP_IND);
+// OBSOLETE continue;
+// OBSOLETE case OPEN_PAREN:
+// OBSOLETE parse_call ();
+// OBSOLETE continue;
+// OBSOLETE case CHARACTER_STRING_LITERAL:
+// OBSOLETE case CHARACTER_LITERAL:
+// OBSOLETE case BIT_STRING_LITERAL:
+// OBSOLETE /* Handle string repetition. (See comment in parse_operand5.) */
+// OBSOLETE parse_primval ();
+// OBSOLETE write_exp_elt_opcode (MULTI_SUBSCRIPT);
+// OBSOLETE write_exp_elt_longcst (1);
+// OBSOLETE write_exp_elt_opcode (MULTI_SUBSCRIPT);
+// OBSOLETE continue;
+// OBSOLETE case END_TOKEN:
+// OBSOLETE case TOKEN_NOT_READ:
+// OBSOLETE case INTEGER_LITERAL:
+// OBSOLETE case BOOLEAN_LITERAL:
+// OBSOLETE case FLOAT_LITERAL:
+// OBSOLETE case GENERAL_PROCEDURE_NAME:
+// OBSOLETE case LOCATION_NAME:
+// OBSOLETE case EMPTINESS_LITERAL:
+// OBSOLETE case TYPENAME:
+// OBSOLETE case CASE:
+// OBSOLETE case OF:
+// OBSOLETE case ESAC:
+// OBSOLETE case LOGIOR:
+// OBSOLETE case ORIF:
+// OBSOLETE case LOGXOR:
+// OBSOLETE case LOGAND:
+// OBSOLETE case ANDIF:
+// OBSOLETE case NOTEQUAL:
+// OBSOLETE case GEQ:
+// OBSOLETE case LEQ:
+// OBSOLETE case IN:
+// OBSOLETE case SLASH_SLASH:
+// OBSOLETE case MOD:
+// OBSOLETE case REM:
+// OBSOLETE case NOT:
+// OBSOLETE case RECEIVE:
+// OBSOLETE case UP:
+// OBSOLETE case IF:
+// OBSOLETE case THEN:
+// OBSOLETE case ELSE:
+// OBSOLETE case FI:
+// OBSOLETE case ELSIF:
+// OBSOLETE case ILLEGAL_TOKEN:
+// OBSOLETE case NUM:
+// OBSOLETE case PRED:
+// OBSOLETE case SUCC:
+// OBSOLETE case ABS:
+// OBSOLETE case CARD:
+// OBSOLETE case MAX_TOKEN:
+// OBSOLETE case MIN_TOKEN:
+// OBSOLETE case ADDR_TOKEN:
+// OBSOLETE case SIZE:
+// OBSOLETE case UPPER:
+// OBSOLETE case LOWER:
+// OBSOLETE case LENGTH:
+// OBSOLETE case ARRAY:
+// OBSOLETE case GDB_VARIABLE:
+// OBSOLETE case GDB_ASSIGNMENT:
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand6 (void)
+// OBSOLETE {
+// OBSOLETE if (check_token (RECEIVE))
+// OBSOLETE {
+// OBSOLETE parse_primval ();
+// OBSOLETE error ("not implemented: RECEIVE expression");
+// OBSOLETE }
+// OBSOLETE else if (check_token (POINTER))
+// OBSOLETE {
+// OBSOLETE parse_primval ();
+// OBSOLETE write_exp_elt_opcode (UNOP_ADDR);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE parse_primval ();
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand5 (void)
+// OBSOLETE {
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE /* We are supposed to be looking for a <string repetition operator>,
+// OBSOLETE but in general we can't distinguish that from a parenthesized
+// OBSOLETE expression. This is especially difficult if we allow the
+// OBSOLETE string operand to be a constant expression (as requested by
+// OBSOLETE some users), and not just a string literal.
+// OBSOLETE Consider: LPRN expr RPRN LPRN expr RPRN
+// OBSOLETE Is that a function call or string repetition?
+// OBSOLETE Instead, we handle string repetition in parse_primval,
+// OBSOLETE and build_generalized_call. */
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case NOT:
+// OBSOLETE op = UNOP_LOGICAL_NOT;
+// OBSOLETE break;
+// OBSOLETE case '-':
+// OBSOLETE op = UNOP_NEG;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE op = OP_NULL;
+// OBSOLETE }
+// OBSOLETE if (op != OP_NULL)
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_operand6 ();
+// OBSOLETE if (op != OP_NULL)
+// OBSOLETE write_exp_elt_opcode (op);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand4 (void)
+// OBSOLETE {
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE parse_operand5 ();
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case '*':
+// OBSOLETE op = BINOP_MUL;
+// OBSOLETE break;
+// OBSOLETE case '/':
+// OBSOLETE op = BINOP_DIV;
+// OBSOLETE break;
+// OBSOLETE case MOD:
+// OBSOLETE op = BINOP_MOD;
+// OBSOLETE break;
+// OBSOLETE case REM:
+// OBSOLETE op = BINOP_REM;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_operand5 ();
+// OBSOLETE write_exp_elt_opcode (op);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand3 (void)
+// OBSOLETE {
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE parse_operand4 ();
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case '+':
+// OBSOLETE op = BINOP_ADD;
+// OBSOLETE break;
+// OBSOLETE case '-':
+// OBSOLETE op = BINOP_SUB;
+// OBSOLETE break;
+// OBSOLETE case SLASH_SLASH:
+// OBSOLETE op = BINOP_CONCAT;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_operand4 ();
+// OBSOLETE write_exp_elt_opcode (op);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand2 (void)
+// OBSOLETE {
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE parse_operand3 ();
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE if (check_token (IN))
+// OBSOLETE {
+// OBSOLETE parse_operand3 ();
+// OBSOLETE write_exp_elt_opcode (BINOP_IN);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case '>':
+// OBSOLETE op = BINOP_GTR;
+// OBSOLETE break;
+// OBSOLETE case GEQ:
+// OBSOLETE op = BINOP_GEQ;
+// OBSOLETE break;
+// OBSOLETE case '<':
+// OBSOLETE op = BINOP_LESS;
+// OBSOLETE break;
+// OBSOLETE case LEQ:
+// OBSOLETE op = BINOP_LEQ;
+// OBSOLETE break;
+// OBSOLETE case '=':
+// OBSOLETE op = BINOP_EQUAL;
+// OBSOLETE break;
+// OBSOLETE case NOTEQUAL:
+// OBSOLETE op = BINOP_NOTEQUAL;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_operand3 ();
+// OBSOLETE write_exp_elt_opcode (op);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand1 (void)
+// OBSOLETE {
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE parse_operand2 ();
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case LOGAND:
+// OBSOLETE op = BINOP_BITWISE_AND;
+// OBSOLETE break;
+// OBSOLETE case ANDIF:
+// OBSOLETE op = BINOP_LOGICAL_AND;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_operand2 ();
+// OBSOLETE write_exp_elt_opcode (op);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_operand0 (void)
+// OBSOLETE {
+// OBSOLETE enum exp_opcode op;
+// OBSOLETE parse_operand1 ();
+// OBSOLETE for (;;)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case LOGIOR:
+// OBSOLETE op = BINOP_BITWISE_IOR;
+// OBSOLETE break;
+// OBSOLETE case LOGXOR:
+// OBSOLETE op = BINOP_BITWISE_XOR;
+// OBSOLETE break;
+// OBSOLETE case ORIF:
+// OBSOLETE op = BINOP_LOGICAL_OR;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_operand1 ();
+// OBSOLETE write_exp_elt_opcode (op);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_expr (void)
+// OBSOLETE {
+// OBSOLETE parse_operand0 ();
+// OBSOLETE if (check_token (GDB_ASSIGNMENT))
+// OBSOLETE {
+// OBSOLETE parse_expr ();
+// OBSOLETE write_exp_elt_opcode (BINOP_ASSIGN);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_then_alternative (void)
+// OBSOLETE {
+// OBSOLETE expect (THEN, "missing 'THEN' in 'IF' expression");
+// OBSOLETE parse_expr ();
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_else_alternative (void)
+// OBSOLETE {
+// OBSOLETE if (check_token (ELSIF))
+// OBSOLETE parse_if_expression_body ();
+// OBSOLETE else if (check_token (ELSE))
+// OBSOLETE parse_expr ();
+// OBSOLETE else
+// OBSOLETE error ("missing ELSE/ELSIF in IF expression");
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Matches: <boolean expression> <then alternative> <else alternative> */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_if_expression_body (void)
+// OBSOLETE {
+// OBSOLETE parse_expr ();
+// OBSOLETE parse_then_alternative ();
+// OBSOLETE parse_else_alternative ();
+// OBSOLETE write_exp_elt_opcode (TERNOP_COND);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_if_expression (void)
+// OBSOLETE {
+// OBSOLETE require (IF);
+// OBSOLETE parse_if_expression_body ();
+// OBSOLETE expect (FI, "missing 'FI' at end of conditional expression");
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* An <untyped_expr> is a superset of <expr>. It also includes
+// OBSOLETE <conditional expressions> and untyped <tuples>, whose types
+// OBSOLETE are not given by their constituents. Hence, these are only
+// OBSOLETE allowed in certain contexts that expect a certain type.
+// OBSOLETE You should call convert() to fix up the <untyped_expr>. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE parse_untyped_expr (void)
+// OBSOLETE {
+// OBSOLETE switch (PEEK_TOKEN ())
+// OBSOLETE {
+// OBSOLETE case IF:
+// OBSOLETE parse_if_expression ();
+// OBSOLETE return;
+// OBSOLETE case CASE:
+// OBSOLETE error ("not implemented: CASE expression");
+// OBSOLETE case '(':
+// OBSOLETE switch (PEEK_TOKEN1 ())
+// OBSOLETE {
+// OBSOLETE case IF:
+// OBSOLETE case CASE:
+// OBSOLETE goto skip_lprn;
+// OBSOLETE case '[':
+// OBSOLETE skip_lprn:
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE parse_untyped_expr ();
+// OBSOLETE expect (')', "missing ')'");
+// OBSOLETE return;
+// OBSOLETE default:;
+// OBSOLETE /* fall through */
+// OBSOLETE }
+// OBSOLETE default:
+// OBSOLETE parse_operand0 ();
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE int
+// OBSOLETE chill_parse (void)
+// OBSOLETE {
+// OBSOLETE terminal_buffer[0] = TOKEN_NOT_READ;
+// OBSOLETE if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
+// OBSOLETE {
+// OBSOLETE write_exp_elt_opcode (OP_TYPE);
+// OBSOLETE write_exp_elt_type (PEEK_LVAL ().tsym.type);
+// OBSOLETE write_exp_elt_opcode (OP_TYPE);
+// OBSOLETE FORWARD_TOKEN ();
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE parse_expr ();
+// OBSOLETE if (terminal_buffer[0] != END_TOKEN)
+// OBSOLETE {
+// OBSOLETE if (comma_terminates && terminal_buffer[0] == ',')
+// OBSOLETE lexptr--; /* Put the comma back. */
+// OBSOLETE else
+// OBSOLETE error ("Junk after end of expression.");
+// OBSOLETE }
+// OBSOLETE return 0;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE
+// OBSOLETE /* Implementation of a dynamically expandable buffer for processing input
+// OBSOLETE characters acquired through lexptr and building a value to return in
+// OBSOLETE yylval. */
+// OBSOLETE
+// OBSOLETE static char *tempbuf; /* Current buffer contents */
+// OBSOLETE static int tempbufsize; /* Size of allocated buffer */
+// OBSOLETE static int tempbufindex; /* Current index into buffer */
+// OBSOLETE
+// OBSOLETE #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
+// OBSOLETE
+// OBSOLETE #define CHECKBUF(size) \
+// OBSOLETE do { \
+// OBSOLETE if (tempbufindex + (size) >= tempbufsize) \
+// OBSOLETE { \
+// OBSOLETE growbuf_by_size (size); \
+// OBSOLETE } \
+// OBSOLETE } while (0);
+// OBSOLETE
+// OBSOLETE /* Grow the static temp buffer if necessary, including allocating the first one
+// OBSOLETE on demand. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE growbuf_by_size (int count)
+// OBSOLETE {
+// OBSOLETE int growby;
+// OBSOLETE
+// OBSOLETE growby = max (count, GROWBY_MIN_SIZE);
+// OBSOLETE tempbufsize += growby;
+// OBSOLETE if (tempbuf == NULL)
+// OBSOLETE {
+// OBSOLETE tempbuf = (char *) xmalloc (tempbufsize);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Try to consume a simple name string token. If successful, returns
+// OBSOLETE a pointer to a nullbyte terminated copy of the name that can be used
+// OBSOLETE in symbol table lookups. If not successful, returns NULL. */
+// OBSOLETE
+// OBSOLETE static char *
+// OBSOLETE match_simple_name_string (void)
+// OBSOLETE {
+// OBSOLETE char *tokptr = lexptr;
+// OBSOLETE
+// OBSOLETE if (isalpha (*tokptr) || *tokptr == '_')
+// OBSOLETE {
+// OBSOLETE char *result;
+// OBSOLETE do
+// OBSOLETE {
+// OBSOLETE tokptr++;
+// OBSOLETE }
+// OBSOLETE while (isalnum (*tokptr) || (*tokptr == '_'));
+// OBSOLETE yylval.sval.ptr = lexptr;
+// OBSOLETE yylval.sval.length = tokptr - lexptr;
+// OBSOLETE lexptr = tokptr;
+// OBSOLETE result = copy_name (yylval.sval);
+// OBSOLETE return result;
+// OBSOLETE }
+// OBSOLETE return (NULL);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Start looking for a value composed of valid digits as set by the base
+// OBSOLETE in use. Note that '_' characters are valid anywhere, in any quantity,
+// OBSOLETE and are simply ignored. Since we must find at least one valid digit,
+// OBSOLETE or reject this token as an integer literal, we keep track of how many
+// OBSOLETE digits we have encountered. */
+// OBSOLETE
+// OBSOLETE static int
+// OBSOLETE decode_integer_value (int base, char **tokptrptr, LONGEST *ivalptr)
+// OBSOLETE {
+// OBSOLETE char *tokptr = *tokptrptr;
+// OBSOLETE int temp;
+// OBSOLETE int digits = 0;
+// OBSOLETE
+// OBSOLETE while (*tokptr != '\0')
+// OBSOLETE {
+// OBSOLETE temp = *tokptr;
+// OBSOLETE if (isupper (temp))
+// OBSOLETE temp = tolower (temp);
+// OBSOLETE tokptr++;
+// OBSOLETE switch (temp)
+// OBSOLETE {
+// OBSOLETE case '_':
+// OBSOLETE continue;
+// OBSOLETE case '0':
+// OBSOLETE case '1':
+// OBSOLETE case '2':
+// OBSOLETE case '3':
+// OBSOLETE case '4':
+// OBSOLETE case '5':
+// OBSOLETE case '6':
+// OBSOLETE case '7':
+// OBSOLETE case '8':
+// OBSOLETE case '9':
+// OBSOLETE temp -= '0';
+// OBSOLETE break;
+// OBSOLETE case 'a':
+// OBSOLETE case 'b':
+// OBSOLETE case 'c':
+// OBSOLETE case 'd':
+// OBSOLETE case 'e':
+// OBSOLETE case 'f':
+// OBSOLETE temp -= 'a';
+// OBSOLETE temp += 10;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE temp = base;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE if (temp < base)
+// OBSOLETE {
+// OBSOLETE digits++;
+// OBSOLETE *ivalptr *= base;
+// OBSOLETE *ivalptr += temp;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE /* Found something not in domain for current base. */
+// OBSOLETE tokptr--; /* Unconsume what gave us indigestion. */
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* If we didn't find any digits, then we don't have a valid integer
+// OBSOLETE value, so reject the entire token. Otherwise, update the lexical
+// OBSOLETE scan pointer, and return non-zero for success. */
+// OBSOLETE
+// OBSOLETE if (digits == 0)
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE *tokptrptr = tokptr;
+// OBSOLETE return (1);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static int
+// OBSOLETE decode_integer_literal (LONGEST *valptr, char **tokptrptr)
+// OBSOLETE {
+// OBSOLETE char *tokptr = *tokptrptr;
+// OBSOLETE int base = 0;
+// OBSOLETE LONGEST ival = 0;
+// OBSOLETE int explicit_base = 0;
+// OBSOLETE
+// OBSOLETE /* Look for an explicit base specifier, which is optional. */
+// OBSOLETE
+// OBSOLETE switch (*tokptr)
+// OBSOLETE {
+// OBSOLETE case 'd':
+// OBSOLETE case 'D':
+// OBSOLETE explicit_base++;
+// OBSOLETE base = 10;
+// OBSOLETE tokptr++;
+// OBSOLETE break;
+// OBSOLETE case 'b':
+// OBSOLETE case 'B':
+// OBSOLETE explicit_base++;
+// OBSOLETE base = 2;
+// OBSOLETE tokptr++;
+// OBSOLETE break;
+// OBSOLETE case 'h':
+// OBSOLETE case 'H':
+// OBSOLETE explicit_base++;
+// OBSOLETE base = 16;
+// OBSOLETE tokptr++;
+// OBSOLETE break;
+// OBSOLETE case 'o':
+// OBSOLETE case 'O':
+// OBSOLETE explicit_base++;
+// OBSOLETE base = 8;
+// OBSOLETE tokptr++;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE base = 10;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* If we found an explicit base ensure that the character after the
+// OBSOLETE explicit base is a single quote. */
+// OBSOLETE
+// OBSOLETE if (explicit_base && (*tokptr++ != '\''))
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Attempt to decode whatever follows as an integer value in the
+// OBSOLETE indicated base, updating the token pointer in the process and
+// OBSOLETE computing the value into ival. Also, if we have an explicit
+// OBSOLETE base, then the next character must not be a single quote, or we
+// OBSOLETE have a bitstring literal, so reject the entire token in this case.
+// OBSOLETE Otherwise, update the lexical scan pointer, and return non-zero
+// OBSOLETE for success. */
+// OBSOLETE
+// OBSOLETE if (!decode_integer_value (base, &tokptr, &ival))
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE else if (explicit_base && (*tokptr == '\''))
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE *valptr = ival;
+// OBSOLETE *tokptrptr = tokptr;
+// OBSOLETE return (1);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* If it wasn't for the fact that floating point values can contain '_'
+// OBSOLETE characters, we could just let strtod do all the hard work by letting it
+// OBSOLETE try to consume as much of the current token buffer as possible and
+// OBSOLETE find a legal conversion. Unfortunately we need to filter out the '_'
+// OBSOLETE characters before calling strtod, which we do by copying the other
+// OBSOLETE legal chars to a local buffer to be converted. However since we also
+// OBSOLETE need to keep track of where the last unconsumed character in the input
+// OBSOLETE buffer is, we have transfer only as many characters as may compose a
+// OBSOLETE legal floating point value. */
+// OBSOLETE
+// OBSOLETE static enum ch_terminal
+// OBSOLETE match_float_literal (void)
+// OBSOLETE {
+// OBSOLETE char *tokptr = lexptr;
+// OBSOLETE char *buf;
+// OBSOLETE char *copy;
+// OBSOLETE double dval;
+// OBSOLETE extern double strtod ();
+// OBSOLETE
+// OBSOLETE /* Make local buffer in which to build the string to convert. This is
+// OBSOLETE required because underscores are valid in chill floating point numbers
+// OBSOLETE but not in the string passed to strtod to convert. The string will be
+// OBSOLETE no longer than our input string. */
+// OBSOLETE
+// OBSOLETE copy = buf = (char *) alloca (strlen (tokptr) + 1);
+// OBSOLETE
+// OBSOLETE /* Transfer all leading digits to the conversion buffer, discarding any
+// OBSOLETE underscores. */
+// OBSOLETE
+// OBSOLETE while (isdigit (*tokptr) || *tokptr == '_')
+// OBSOLETE {
+// OBSOLETE if (*tokptr != '_')
+// OBSOLETE {
+// OBSOLETE *copy++ = *tokptr;
+// OBSOLETE }
+// OBSOLETE tokptr++;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
+// OBSOLETE of whether we found any leading digits, and we simply accept it and
+// OBSOLETE continue on to look for the fractional part and/or exponent. One of
+// OBSOLETE [eEdD] is legal only if we have seen digits, and means that there
+// OBSOLETE is no fractional part. If we find neither of these, then this is
+// OBSOLETE not a floating point number, so return failure. */
+// OBSOLETE
+// OBSOLETE switch (*tokptr++)
+// OBSOLETE {
+// OBSOLETE case '.':
+// OBSOLETE /* Accept and then look for fractional part and/or exponent. */
+// OBSOLETE *copy++ = '.';
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case 'e':
+// OBSOLETE case 'E':
+// OBSOLETE case 'd':
+// OBSOLETE case 'D':
+// OBSOLETE if (copy == buf)
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE *copy++ = 'e';
+// OBSOLETE goto collect_exponent;
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE default:
+// OBSOLETE return (0);
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* We found a '.', copy any fractional digits to the conversion buffer, up
+// OBSOLETE to the first nondigit, non-underscore character. */
+// OBSOLETE
+// OBSOLETE while (isdigit (*tokptr) || *tokptr == '_')
+// OBSOLETE {
+// OBSOLETE if (*tokptr != '_')
+// OBSOLETE {
+// OBSOLETE *copy++ = *tokptr;
+// OBSOLETE }
+// OBSOLETE tokptr++;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Look for an exponent, which must start with one of [eEdD]. If none
+// OBSOLETE is found, jump directly to trying to convert what we have collected
+// OBSOLETE so far. */
+// OBSOLETE
+// OBSOLETE switch (*tokptr)
+// OBSOLETE {
+// OBSOLETE case 'e':
+// OBSOLETE case 'E':
+// OBSOLETE case 'd':
+// OBSOLETE case 'D':
+// OBSOLETE *copy++ = 'e';
+// OBSOLETE tokptr++;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE goto convert_float;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Accept an optional '-' or '+' following one of [eEdD]. */
+// OBSOLETE
+// OBSOLETE collect_exponent:
+// OBSOLETE if (*tokptr == '+' || *tokptr == '-')
+// OBSOLETE {
+// OBSOLETE *copy++ = *tokptr++;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Now copy an exponent into the conversion buffer. Note that at the
+// OBSOLETE moment underscores are *not* allowed in exponents. */
+// OBSOLETE
+// OBSOLETE while (isdigit (*tokptr))
+// OBSOLETE {
+// OBSOLETE *copy++ = *tokptr++;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* If we transfered any chars to the conversion buffer, try to interpret its
+// OBSOLETE contents as a floating point value. If any characters remain, then we
+// OBSOLETE must not have a valid floating point string. */
+// OBSOLETE
+// OBSOLETE convert_float:
+// OBSOLETE *copy = '\0';
+// OBSOLETE if (copy != buf)
+// OBSOLETE {
+// OBSOLETE dval = strtod (buf, ©);
+// OBSOLETE if (*copy == '\0')
+// OBSOLETE {
+// OBSOLETE yylval.dval = dval;
+// OBSOLETE lexptr = tokptr;
+// OBSOLETE return (FLOAT_LITERAL);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Recognize a string literal. A string literal is a sequence
+// OBSOLETE of characters enclosed in matching single or double quotes, except that
+// OBSOLETE a single character inside single quotes is a character literal, which
+// OBSOLETE we reject as a string literal. To embed the terminator character inside
+// OBSOLETE a string, it is simply doubled (I.E. "this""is""one""string") */
+// OBSOLETE
+// OBSOLETE static enum ch_terminal
+// OBSOLETE match_string_literal (void)
+// OBSOLETE {
+// OBSOLETE char *tokptr = lexptr;
+// OBSOLETE int in_ctrlseq = 0;
+// OBSOLETE LONGEST ival;
+// OBSOLETE
+// OBSOLETE for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
+// OBSOLETE {
+// OBSOLETE CHECKBUF (1);
+// OBSOLETE tryagain:;
+// OBSOLETE if (in_ctrlseq)
+// OBSOLETE {
+// OBSOLETE /* skip possible whitespaces */
+// OBSOLETE while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
+// OBSOLETE tokptr++;
+// OBSOLETE if (*tokptr == ')')
+// OBSOLETE {
+// OBSOLETE in_ctrlseq = 0;
+// OBSOLETE tokptr++;
+// OBSOLETE goto tryagain;
+// OBSOLETE }
+// OBSOLETE else if (*tokptr != ',')
+// OBSOLETE error ("Invalid control sequence");
+// OBSOLETE tokptr++;
+// OBSOLETE /* skip possible whitespaces */
+// OBSOLETE while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
+// OBSOLETE tokptr++;
+// OBSOLETE if (!decode_integer_literal (&ival, &tokptr))
+// OBSOLETE error ("Invalid control sequence");
+// OBSOLETE tokptr--;
+// OBSOLETE }
+// OBSOLETE else if (*tokptr == *lexptr)
+// OBSOLETE {
+// OBSOLETE if (*(tokptr + 1) == *lexptr)
+// OBSOLETE {
+// OBSOLETE ival = *tokptr++;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else if (*tokptr == '^')
+// OBSOLETE {
+// OBSOLETE if (*(tokptr + 1) == '(')
+// OBSOLETE {
+// OBSOLETE in_ctrlseq = 1;
+// OBSOLETE tokptr += 2;
+// OBSOLETE if (!decode_integer_literal (&ival, &tokptr))
+// OBSOLETE error ("Invalid control sequence");
+// OBSOLETE tokptr--;
+// OBSOLETE }
+// OBSOLETE else if (*(tokptr + 1) == '^')
+// OBSOLETE ival = *tokptr++;
+// OBSOLETE else
+// OBSOLETE error ("Invalid control sequence");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE ival = *tokptr;
+// OBSOLETE tempbuf[tempbufindex++] = ival;
+// OBSOLETE }
+// OBSOLETE if (in_ctrlseq)
+// OBSOLETE error ("Invalid control sequence");
+// OBSOLETE
+// OBSOLETE if (*tokptr == '\0' /* no terminator */
+// OBSOLETE || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE tempbuf[tempbufindex] = '\0';
+// OBSOLETE yylval.sval.ptr = tempbuf;
+// OBSOLETE yylval.sval.length = tempbufindex;
+// OBSOLETE lexptr = ++tokptr;
+// OBSOLETE return (CHARACTER_STRING_LITERAL);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Recognize a character literal. A character literal is single character
+// OBSOLETE or a control sequence, enclosed in single quotes. A control sequence
+// OBSOLETE is a comma separated list of one or more integer literals, enclosed
+// OBSOLETE in parenthesis and introduced with a circumflex character.
+// OBSOLETE
+// OBSOLETE EX: 'a' '^(7)' '^(7,8)'
+// OBSOLETE
+// OBSOLETE As a GNU chill extension, the syntax C'xx' is also recognized as a
+// OBSOLETE character literal, where xx is a hex value for the character.
+// OBSOLETE
+// OBSOLETE Note that more than a single character, enclosed in single quotes, is
+// OBSOLETE a string literal.
+// OBSOLETE
+// OBSOLETE Returns CHARACTER_LITERAL if a match is found.
+// OBSOLETE */
+// OBSOLETE
+// OBSOLETE static enum ch_terminal
+// OBSOLETE match_character_literal (void)
+// OBSOLETE {
+// OBSOLETE char *tokptr = lexptr;
+// OBSOLETE LONGEST ival = 0;
+// OBSOLETE
+// OBSOLETE if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
+// OBSOLETE {
+// OBSOLETE /* We have a GNU chill extension form, so skip the leading "C'",
+// OBSOLETE decode the hex value, and then ensure that we have a trailing
+// OBSOLETE single quote character. */
+// OBSOLETE tokptr += 2;
+// OBSOLETE if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE tokptr++;
+// OBSOLETE }
+// OBSOLETE else if (*tokptr == '\'')
+// OBSOLETE {
+// OBSOLETE tokptr++;
+// OBSOLETE
+// OBSOLETE /* Determine which form we have, either a control sequence or the
+// OBSOLETE single character form. */
+// OBSOLETE
+// OBSOLETE if (*tokptr == '^')
+// OBSOLETE {
+// OBSOLETE if (*(tokptr + 1) == '(')
+// OBSOLETE {
+// OBSOLETE /* Match and decode a control sequence. Return zero if we don't
+// OBSOLETE find a valid integer literal, or if the next unconsumed character
+// OBSOLETE after the integer literal is not the trailing ')'. */
+// OBSOLETE tokptr += 2;
+// OBSOLETE if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else if (*(tokptr + 1) == '^')
+// OBSOLETE {
+// OBSOLETE ival = *tokptr;
+// OBSOLETE tokptr += 2;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE /* fail */
+// OBSOLETE error ("Invalid control sequence");
+// OBSOLETE }
+// OBSOLETE else if (*tokptr == '\'')
+// OBSOLETE {
+// OBSOLETE /* this must be duplicated */
+// OBSOLETE ival = *tokptr;
+// OBSOLETE tokptr += 2;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE ival = *tokptr++;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* The trailing quote has not yet been consumed. If we don't find
+// OBSOLETE it, then we have no match. */
+// OBSOLETE
+// OBSOLETE if (*tokptr++ != '\'')
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE /* Not a character literal. */
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE yylval.typed_val.val = ival;
+// OBSOLETE yylval.typed_val.type = builtin_type_chill_char;
+// OBSOLETE lexptr = tokptr;
+// OBSOLETE return (CHARACTER_LITERAL);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
+// OBSOLETE Note that according to 5.2.4.2, a single "_" is also a valid integer
+// OBSOLETE literal, however GNU-chill requires there to be at least one "digit"
+// OBSOLETE in any integer literal. */
+// OBSOLETE
+// OBSOLETE static enum ch_terminal
+// OBSOLETE match_integer_literal (void)
+// OBSOLETE {
+// OBSOLETE char *tokptr = lexptr;
+// OBSOLETE LONGEST ival;
+// OBSOLETE
+// OBSOLETE if (!decode_integer_literal (&ival, &tokptr))
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE yylval.typed_val.val = ival;
+// OBSOLETE #if defined(CC_HAS_LONG_LONG)
+// OBSOLETE if (ival > (LONGEST) 2147483647U || ival < -(LONGEST) 2147483648U)
+// OBSOLETE yylval.typed_val.type = builtin_type_long_long;
+// OBSOLETE else
+// OBSOLETE #endif
+// OBSOLETE yylval.typed_val.type = builtin_type_int;
+// OBSOLETE lexptr = tokptr;
+// OBSOLETE return (INTEGER_LITERAL);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
+// OBSOLETE Note that according to 5.2.4.8, a single "_" is also a valid bit-string
+// OBSOLETE literal, however GNU-chill requires there to be at least one "digit"
+// OBSOLETE in any bit-string literal. */
+// OBSOLETE
+// OBSOLETE static enum ch_terminal
+// OBSOLETE match_bitstring_literal (void)
+// OBSOLETE {
+// OBSOLETE register char *tokptr = lexptr;
+// OBSOLETE int bitoffset = 0;
+// OBSOLETE int bitcount = 0;
+// OBSOLETE int bits_per_char;
+// OBSOLETE int digit;
+// OBSOLETE
+// OBSOLETE tempbufindex = 0;
+// OBSOLETE CHECKBUF (1);
+// OBSOLETE tempbuf[0] = 0;
+// OBSOLETE
+// OBSOLETE /* Look for the required explicit base specifier. */
+// OBSOLETE
+// OBSOLETE switch (*tokptr++)
+// OBSOLETE {
+// OBSOLETE case 'b':
+// OBSOLETE case 'B':
+// OBSOLETE bits_per_char = 1;
+// OBSOLETE break;
+// OBSOLETE case 'o':
+// OBSOLETE case 'O':
+// OBSOLETE bits_per_char = 3;
+// OBSOLETE break;
+// OBSOLETE case 'h':
+// OBSOLETE case 'H':
+// OBSOLETE bits_per_char = 4;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE return (0);
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Ensure that the character after the explicit base is a single quote. */
+// OBSOLETE
+// OBSOLETE if (*tokptr++ != '\'')
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE while (*tokptr != '\0' && *tokptr != '\'')
+// OBSOLETE {
+// OBSOLETE digit = *tokptr;
+// OBSOLETE if (isupper (digit))
+// OBSOLETE digit = tolower (digit);
+// OBSOLETE tokptr++;
+// OBSOLETE switch (digit)
+// OBSOLETE {
+// OBSOLETE case '_':
+// OBSOLETE continue;
+// OBSOLETE case '0':
+// OBSOLETE case '1':
+// OBSOLETE case '2':
+// OBSOLETE case '3':
+// OBSOLETE case '4':
+// OBSOLETE case '5':
+// OBSOLETE case '6':
+// OBSOLETE case '7':
+// OBSOLETE case '8':
+// OBSOLETE case '9':
+// OBSOLETE digit -= '0';
+// OBSOLETE break;
+// OBSOLETE case 'a':
+// OBSOLETE case 'b':
+// OBSOLETE case 'c':
+// OBSOLETE case 'd':
+// OBSOLETE case 'e':
+// OBSOLETE case 'f':
+// OBSOLETE digit -= 'a';
+// OBSOLETE digit += 10;
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE /* this is not a bitstring literal, probably an integer */
+// OBSOLETE return 0;
+// OBSOLETE }
+// OBSOLETE if (digit >= 1 << bits_per_char)
+// OBSOLETE {
+// OBSOLETE /* Found something not in domain for current base. */
+// OBSOLETE error ("Too-large digit in bitstring or integer.");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE /* Extract bits from digit, packing them into the bitstring byte. */
+// OBSOLETE int k = TARGET_BYTE_ORDER == BFD_ENDIAN_BIG ? bits_per_char - 1 : 0;
+// OBSOLETE for (; TARGET_BYTE_ORDER == BFD_ENDIAN_BIG ? k >= 0 : k < bits_per_char;
+// OBSOLETE TARGET_BYTE_ORDER == BFD_ENDIAN_BIG ? k-- : k++)
+// OBSOLETE {
+// OBSOLETE bitcount++;
+// OBSOLETE if (digit & (1 << k))
+// OBSOLETE {
+// OBSOLETE tempbuf[tempbufindex] |=
+// OBSOLETE (TARGET_BYTE_ORDER == BFD_ENDIAN_BIG)
+// OBSOLETE ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
+// OBSOLETE : (1 << bitoffset);
+// OBSOLETE }
+// OBSOLETE bitoffset++;
+// OBSOLETE if (bitoffset == HOST_CHAR_BIT)
+// OBSOLETE {
+// OBSOLETE bitoffset = 0;
+// OBSOLETE tempbufindex++;
+// OBSOLETE CHECKBUF (1);
+// OBSOLETE tempbuf[tempbufindex] = 0;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Verify that we consumed everything up to the trailing single quote,
+// OBSOLETE and that we found some bits (IE not just underbars). */
+// OBSOLETE
+// OBSOLETE if (*tokptr++ != '\'')
+// OBSOLETE {
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE yylval.sval.ptr = tempbuf;
+// OBSOLETE yylval.sval.length = bitcount;
+// OBSOLETE lexptr = tokptr;
+// OBSOLETE return (BIT_STRING_LITERAL);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE struct token
+// OBSOLETE {
+// OBSOLETE char *operator;
+// OBSOLETE int token;
+// OBSOLETE };
+// OBSOLETE
+// OBSOLETE static const struct token idtokentab[] =
+// OBSOLETE {
+// OBSOLETE {"array", ARRAY},
+// OBSOLETE {"length", LENGTH},
+// OBSOLETE {"lower", LOWER},
+// OBSOLETE {"upper", UPPER},
+// OBSOLETE {"andif", ANDIF},
+// OBSOLETE {"pred", PRED},
+// OBSOLETE {"succ", SUCC},
+// OBSOLETE {"card", CARD},
+// OBSOLETE {"size", SIZE},
+// OBSOLETE {"orif", ORIF},
+// OBSOLETE {"num", NUM},
+// OBSOLETE {"abs", ABS},
+// OBSOLETE {"max", MAX_TOKEN},
+// OBSOLETE {"min", MIN_TOKEN},
+// OBSOLETE {"mod", MOD},
+// OBSOLETE {"rem", REM},
+// OBSOLETE {"not", NOT},
+// OBSOLETE {"xor", LOGXOR},
+// OBSOLETE {"and", LOGAND},
+// OBSOLETE {"in", IN},
+// OBSOLETE {"or", LOGIOR},
+// OBSOLETE {"up", UP},
+// OBSOLETE {"addr", ADDR_TOKEN},
+// OBSOLETE {"null", EMPTINESS_LITERAL}
+// OBSOLETE };
+// OBSOLETE
+// OBSOLETE static const struct token tokentab2[] =
+// OBSOLETE {
+// OBSOLETE {":=", GDB_ASSIGNMENT},
+// OBSOLETE {"//", SLASH_SLASH},
+// OBSOLETE {"->", POINTER},
+// OBSOLETE {"/=", NOTEQUAL},
+// OBSOLETE {"<=", LEQ},
+// OBSOLETE {">=", GEQ}
+// OBSOLETE };
+// OBSOLETE
+// OBSOLETE /* Read one token, getting characters through lexptr. */
+// OBSOLETE /* This is where we will check to make sure that the language and the
+// OBSOLETE operators used are compatible. */
+// OBSOLETE
+// OBSOLETE static enum ch_terminal
+// OBSOLETE ch_lex (void)
+// OBSOLETE {
+// OBSOLETE unsigned int i;
+// OBSOLETE enum ch_terminal token;
+// OBSOLETE char *inputname;
+// OBSOLETE struct symbol *sym;
+// OBSOLETE
+// OBSOLETE /* Skip over any leading whitespace. */
+// OBSOLETE while (isspace (*lexptr))
+// OBSOLETE {
+// OBSOLETE lexptr++;
+// OBSOLETE }
+// OBSOLETE /* Look for special single character cases which can't be the first
+// OBSOLETE character of some other multicharacter token. */
+// OBSOLETE switch (*lexptr)
+// OBSOLETE {
+// OBSOLETE case '\0':
+// OBSOLETE return END_TOKEN;
+// OBSOLETE case ',':
+// OBSOLETE case '=':
+// OBSOLETE case ';':
+// OBSOLETE case '!':
+// OBSOLETE case '+':
+// OBSOLETE case '*':
+// OBSOLETE case '(':
+// OBSOLETE case ')':
+// OBSOLETE case '[':
+// OBSOLETE case ']':
+// OBSOLETE return (*lexptr++);
+// OBSOLETE }
+// OBSOLETE /* Look for characters which start a particular kind of multicharacter
+// OBSOLETE token, such as a character literal, register name, convenience
+// OBSOLETE variable name, string literal, etc. */
+// OBSOLETE switch (*lexptr)
+// OBSOLETE {
+// OBSOLETE case '\'':
+// OBSOLETE case '\"':
+// OBSOLETE /* First try to match a string literal, which is any
+// OBSOLETE sequence of characters enclosed in matching single or double
+// OBSOLETE quotes, except that a single character inside single quotes
+// OBSOLETE is a character literal, so we have to catch that case also. */
+// OBSOLETE token = match_string_literal ();
+// OBSOLETE if (token != 0)
+// OBSOLETE {
+// OBSOLETE return (token);
+// OBSOLETE }
+// OBSOLETE if (*lexptr == '\'')
+// OBSOLETE {
+// OBSOLETE token = match_character_literal ();
+// OBSOLETE if (token != 0)
+// OBSOLETE {
+// OBSOLETE return (token);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE case 'C':
+// OBSOLETE case 'c':
+// OBSOLETE token = match_character_literal ();
+// OBSOLETE if (token != 0)
+// OBSOLETE {
+// OBSOLETE return (token);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE case '$':
+// OBSOLETE yylval.sval.ptr = lexptr;
+// OBSOLETE do
+// OBSOLETE {
+// OBSOLETE lexptr++;
+// OBSOLETE }
+// OBSOLETE while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
+// OBSOLETE yylval.sval.length = lexptr - yylval.sval.ptr;
+// OBSOLETE write_dollar_variable (yylval.sval);
+// OBSOLETE return GDB_VARIABLE;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE /* See if it is a special token of length 2. */
+// OBSOLETE for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
+// OBSOLETE {
+// OBSOLETE if (STREQN (lexptr, tokentab2[i].operator, 2))
+// OBSOLETE {
+// OBSOLETE lexptr += 2;
+// OBSOLETE return (tokentab2[i].token);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE /* Look for single character cases which which could be the first
+// OBSOLETE character of some other multicharacter token, but aren't, or we
+// OBSOLETE would already have found it. */
+// OBSOLETE switch (*lexptr)
+// OBSOLETE {
+// OBSOLETE case '-':
+// OBSOLETE case ':':
+// OBSOLETE case '/':
+// OBSOLETE case '<':
+// OBSOLETE case '>':
+// OBSOLETE return (*lexptr++);
+// OBSOLETE }
+// OBSOLETE /* Look for a float literal before looking for an integer literal, so
+// OBSOLETE we match as much of the input stream as possible. */
+// OBSOLETE token = match_float_literal ();
+// OBSOLETE if (token != 0)
+// OBSOLETE {
+// OBSOLETE return (token);
+// OBSOLETE }
+// OBSOLETE token = match_bitstring_literal ();
+// OBSOLETE if (token != 0)
+// OBSOLETE {
+// OBSOLETE return (token);
+// OBSOLETE }
+// OBSOLETE token = match_integer_literal ();
+// OBSOLETE if (token != 0)
+// OBSOLETE {
+// OBSOLETE return (token);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Try to match a simple name string, and if a match is found, then
+// OBSOLETE further classify what sort of name it is and return an appropriate
+// OBSOLETE token. Note that attempting to match a simple name string consumes
+// OBSOLETE the token from lexptr, so we can't back out if we later find that
+// OBSOLETE we can't classify what sort of name it is. */
+// OBSOLETE
+// OBSOLETE inputname = match_simple_name_string ();
+// OBSOLETE
+// OBSOLETE if (inputname != NULL)
+// OBSOLETE {
+// OBSOLETE char *simplename = (char *) alloca (strlen (inputname) + 1);
+// OBSOLETE
+// OBSOLETE char *dptr = simplename, *sptr = inputname;
+// OBSOLETE for (; *sptr; sptr++)
+// OBSOLETE *dptr++ = isupper (*sptr) ? tolower (*sptr) : *sptr;
+// OBSOLETE *dptr = '\0';
+// OBSOLETE
+// OBSOLETE /* See if it is a reserved identifier. */
+// OBSOLETE for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
+// OBSOLETE {
+// OBSOLETE if (STREQ (simplename, idtokentab[i].operator))
+// OBSOLETE {
+// OBSOLETE return (idtokentab[i].token);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Look for other special tokens. */
+// OBSOLETE if (STREQ (simplename, "true"))
+// OBSOLETE {
+// OBSOLETE yylval.ulval = 1;
+// OBSOLETE return (BOOLEAN_LITERAL);
+// OBSOLETE }
+// OBSOLETE if (STREQ (simplename, "false"))
+// OBSOLETE {
+// OBSOLETE yylval.ulval = 0;
+// OBSOLETE return (BOOLEAN_LITERAL);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE sym = lookup_symbol (inputname, expression_context_block,
+// OBSOLETE VAR_NAMESPACE, (int *) NULL,
+// OBSOLETE (struct symtab **) NULL);
+// OBSOLETE if (sym == NULL && strcmp (inputname, simplename) != 0)
+// OBSOLETE {
+// OBSOLETE sym = lookup_symbol (simplename, expression_context_block,
+// OBSOLETE VAR_NAMESPACE, (int *) NULL,
+// OBSOLETE (struct symtab **) NULL);
+// OBSOLETE }
+// OBSOLETE if (sym != NULL)
+// OBSOLETE {
+// OBSOLETE yylval.ssym.stoken.ptr = NULL;
+// OBSOLETE yylval.ssym.stoken.length = 0;
+// OBSOLETE yylval.ssym.sym = sym;
+// OBSOLETE yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
+// OBSOLETE switch (SYMBOL_CLASS (sym))
+// OBSOLETE {
+// OBSOLETE case LOC_BLOCK:
+// OBSOLETE /* Found a procedure name. */
+// OBSOLETE return (GENERAL_PROCEDURE_NAME);
+// OBSOLETE case LOC_STATIC:
+// OBSOLETE /* Found a global or local static variable. */
+// OBSOLETE return (LOCATION_NAME);
+// OBSOLETE case LOC_REGISTER:
+// OBSOLETE case LOC_ARG:
+// OBSOLETE case LOC_REF_ARG:
+// OBSOLETE case LOC_REGPARM:
+// OBSOLETE case LOC_REGPARM_ADDR:
+// OBSOLETE case LOC_LOCAL:
+// OBSOLETE case LOC_LOCAL_ARG:
+// OBSOLETE case LOC_BASEREG:
+// OBSOLETE case LOC_BASEREG_ARG:
+// OBSOLETE if (innermost_block == NULL
+// OBSOLETE || contained_in (block_found, innermost_block))
+// OBSOLETE {
+// OBSOLETE innermost_block = block_found;
+// OBSOLETE }
+// OBSOLETE return (LOCATION_NAME);
+// OBSOLETE break;
+// OBSOLETE case LOC_CONST:
+// OBSOLETE case LOC_LABEL:
+// OBSOLETE return (LOCATION_NAME);
+// OBSOLETE break;
+// OBSOLETE case LOC_TYPEDEF:
+// OBSOLETE yylval.tsym.type = SYMBOL_TYPE (sym);
+// OBSOLETE return TYPENAME;
+// OBSOLETE case LOC_UNDEF:
+// OBSOLETE case LOC_CONST_BYTES:
+// OBSOLETE case LOC_OPTIMIZED_OUT:
+// OBSOLETE error ("Symbol \"%s\" names no location.", inputname);
+// OBSOLETE break;
+// OBSOLETE default:
+// OBSOLETE internal_error (__FILE__, __LINE__,
+// OBSOLETE "unhandled SYMBOL_CLASS in ch_lex()");
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else if (!have_full_symbols () && !have_partial_symbols ())
+// OBSOLETE {
+// OBSOLETE error ("No symbol table is loaded. Use the \"file\" command.");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE error ("No symbol \"%s\" in current context.", inputname);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Catch single character tokens which are not part of some
+// OBSOLETE longer token. */
+// OBSOLETE
+// OBSOLETE switch (*lexptr)
+// OBSOLETE {
+// OBSOLETE case '.': /* Not float for example. */
+// OBSOLETE lexptr++;
+// OBSOLETE while (isspace (*lexptr))
+// OBSOLETE lexptr++;
+// OBSOLETE inputname = match_simple_name_string ();
+// OBSOLETE if (!inputname)
+// OBSOLETE return '.';
+// OBSOLETE return DOT_FIELD_NAME;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE return (ILLEGAL_TOKEN);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE write_lower_upper_value (enum exp_opcode opcode, /* Either UNOP_LOWER or UNOP_UPPER */
+// OBSOLETE struct type *type)
+// OBSOLETE {
+// OBSOLETE if (type == NULL)
+// OBSOLETE write_exp_elt_opcode (opcode);
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE struct type *result_type;
+// OBSOLETE LONGEST val = type_lower_upper (opcode, type, &result_type);
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE write_exp_elt_type (result_type);
+// OBSOLETE write_exp_elt_longcst (val);
+// OBSOLETE write_exp_elt_opcode (OP_LONG);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE void
+// OBSOLETE chill_error (char *msg)
+// OBSOLETE {
+// OBSOLETE /* Never used. */
+// OBSOLETE }
-/* Chill language support routines for GDB, the GNU debugger.
- Copyright 1992, 1993, 1994, 1995, 1996, 2000, 2001, 2002
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
-#include "defs.h"
-#include "symtab.h"
-#include "gdbtypes.h"
-#include "value.h"
-#include "expression.h"
-#include "parser-defs.h"
-#include "language.h"
-#include "ch-lang.h"
-#include "valprint.h"
-
-extern void _initialize_chill_language (void);
-
-static struct value *evaluate_subexp_chill (struct type *, struct expression *,
- int *, enum noside);
-
-static struct value *value_chill_max_min (enum exp_opcode, struct value *);
-
-static struct value *value_chill_card (struct value *);
-
-static struct value *value_chill_length (struct value *);
-
-static struct type *chill_create_fundamental_type (struct objfile *, int);
-
-static void chill_printstr (struct ui_file * stream, char *string,
- unsigned int length, int width,
- int force_ellipses);
-
-static void chill_printchar (int, struct ui_file *);
-
-/* For now, Chill uses a simple mangling algorithm whereby you simply
- discard everything after the occurance of two successive CPLUS_MARKER
- characters to derive the demangled form. */
-
-char *
-chill_demangle (const char *mangled)
-{
- const char *joiner = NULL;
- char *demangled;
- const char *cp = mangled;
-
- while (*cp)
- {
- if (is_cplus_marker (*cp))
- {
- joiner = cp;
- break;
- }
- cp++;
- }
- if (joiner != NULL && *(joiner + 1) == *joiner)
- {
- demangled = savestring (mangled, joiner - mangled);
- }
- else
- {
- demangled = NULL;
- }
- return (demangled);
-}
-
-static void
-chill_printchar (register int c, struct ui_file *stream)
-{
- c &= 0xFF; /* Avoid sign bit follies */
-
- if (PRINT_LITERAL_FORM (c))
- {
- if (c == '\'' || c == '^')
- fprintf_filtered (stream, "'%c%c'", c, c);
- else
- fprintf_filtered (stream, "'%c'", c);
- }
- else
- {
- fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
- }
-}
-
-/* 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.
- Note that gdb maintains the length of strings without counting the
- terminating null byte, while chill strings are typically written with
- an explicit null byte. So we always assume an implied null byte
- until gdb is able to maintain non-null terminated strings as well
- as null terminated strings (FIXME).
- */
-
-static void
-chill_printstr (struct ui_file *stream, char *string, unsigned int length,
- int width, int force_ellipses)
-{
- register unsigned int i;
- unsigned int things_printed = 0;
- int in_literal_form = 0;
- int in_control_form = 0;
- int need_slashslash = 0;
- unsigned int c;
-
- 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_slashslash)
- {
- fputs_filtered ("//", stream);
- need_slashslash = 0;
- }
-
- rep1 = i + 1;
- reps = 1;
- while (rep1 < length && string[rep1] == string[i])
- {
- ++rep1;
- ++reps;
- }
-
- c = string[i];
- if (reps > repeat_count_threshold)
- {
- if (in_control_form || in_literal_form)
- {
- if (in_control_form)
- fputs_filtered (")", stream);
- fputs_filtered ("\"//", stream);
- in_control_form = in_literal_form = 0;
- }
- chill_printchar (c, stream);
- fprintf_filtered (stream, "<repeats %u times>", reps);
- i = rep1 - 1;
- things_printed += repeat_count_threshold;
- need_slashslash = 1;
- }
- else
- {
- if (!in_literal_form && !in_control_form)
- fputs_filtered ("\"", stream);
- if (PRINT_LITERAL_FORM (c))
- {
- if (!in_literal_form)
- {
- if (in_control_form)
- {
- fputs_filtered (")", stream);
- in_control_form = 0;
- }
- in_literal_form = 1;
- }
- fprintf_filtered (stream, "%c", c);
- if (c == '"' || c == '^')
- /* duplicate this one as must be done at input */
- fprintf_filtered (stream, "%c", c);
- }
- else
- {
- if (!in_control_form)
- {
- if (in_literal_form)
- {
- in_literal_form = 0;
- }
- fputs_filtered ("^(", stream);
- in_control_form = 1;
- }
- else
- fprintf_filtered (stream, ",");
- c = c & 0xff;
- fprintf_filtered (stream, "%u", (unsigned int) c);
- }
- ++things_printed;
- }
- }
-
- /* Terminate the quotes if necessary. */
- if (in_control_form)
- {
- fputs_filtered (")", stream);
- }
- if (in_literal_form || in_control_form)
- {
- fputs_filtered ("\"", stream);
- }
- if (force_ellipses || (i < length))
- {
- fputs_filtered ("...", stream);
- }
-}
-
-static struct type *
-chill_create_fundamental_type (struct objfile *objfile, int typeid)
-{
- register 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, 2, 0, "<?type?>", objfile);
- warning ("internal error: no chill fundamental type %d", typeid);
- break;
- case FT_VOID:
- /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
- typedefs, unrelated to anything directly in the code being compiled,
- that have some FT_VOID types. Just fake it for now. */
- type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
- break;
- case FT_BOOLEAN:
- type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
- break;
- case FT_CHAR:
- type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
- break;
- case FT_SIGNED_CHAR:
- type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
- break;
- case FT_UNSIGNED_CHAR:
- type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
- break;
- case FT_SHORT: /* Chill ints are 2 bytes */
- type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
- break;
- case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
- type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
- break;
- case FT_INTEGER: /* FIXME? */
- case FT_SIGNED_INTEGER: /* FIXME? */
- case FT_LONG: /* Chill longs are 4 bytes */
- case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
- type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
- break;
- case FT_UNSIGNED_INTEGER: /* FIXME? */
- case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
- type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
- break;
- case FT_FLOAT:
- type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
- break;
- case FT_DBL_PREC_FLOAT:
- type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
- break;
- }
- return (type);
-}
-\f
-
-/* Table of operators and their precedences for printing expressions. */
-
-static const struct op_print chill_op_print_tab[] =
-{
- {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
- {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
- {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
- {"MOD", BINOP_MOD, PREC_MUL, 0},
- {"REM", BINOP_REM, PREC_MUL, 0},
- {"SIZE", UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
- {"LOWER", UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
- {"UPPER", UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
- {"CARD", UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
- {"MAX", UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
- {"MIN", UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
- {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
- {"=", 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_ADD, PREC_ADD, 0},
- {"-", BINOP_SUB, PREC_ADD, 0},
- {"*", BINOP_MUL, PREC_MUL, 0},
- {"/", BINOP_DIV, PREC_MUL, 0},
- {"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
- {"-", UNOP_NEG, PREC_PREFIX, 0},
- {"->", UNOP_IND, PREC_SUFFIX, 1},
- {"->", UNOP_ADDR, PREC_PREFIX, 0},
- {":", BINOP_RANGE, PREC_ASSIGN, 0},
- {NULL, 0, 0, 0}
-};
-\f
-/* The built-in types of Chill. */
-
-struct type *builtin_type_chill_bool;
-struct type *builtin_type_chill_char;
-struct type *builtin_type_chill_long;
-struct type *builtin_type_chill_ulong;
-struct type *builtin_type_chill_real;
-
-struct type **const (chill_builtin_types[]) =
-{
- &builtin_type_chill_bool,
- &builtin_type_chill_char,
- &builtin_type_chill_long,
- &builtin_type_chill_ulong,
- &builtin_type_chill_real,
- 0
-};
-
-/* Calculate LOWER or UPPER of TYPE.
- Returns the result as an integer.
- *RESULT_TYPE is the appropriate type for the result. */
-
-LONGEST
-type_lower_upper (enum exp_opcode op, /* Either UNOP_LOWER or UNOP_UPPER */
- struct type *type, struct type **result_type)
-{
- LONGEST low, high;
- *result_type = type;
- CHECK_TYPEDEF (type);
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_STRUCT:
- *result_type = builtin_type_int;
- if (chill_varying_type (type))
- return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
- break;
- case TYPE_CODE_ARRAY:
- case TYPE_CODE_BITSTRING:
- case TYPE_CODE_STRING:
- type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
-
- /* ... fall through ... */
- case TYPE_CODE_RANGE:
- *result_type = TYPE_TARGET_TYPE (type);
- return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
-
- case TYPE_CODE_ENUM:
- case TYPE_CODE_BOOL:
- case TYPE_CODE_INT:
- case TYPE_CODE_CHAR:
- if (get_discrete_bounds (type, &low, &high) >= 0)
- {
- *result_type = type;
- return op == UNOP_LOWER ? low : high;
- }
- break;
- case TYPE_CODE_UNDEF:
- case TYPE_CODE_PTR:
- case TYPE_CODE_UNION:
- case TYPE_CODE_FUNC:
- case TYPE_CODE_FLT:
- case TYPE_CODE_VOID:
- case TYPE_CODE_SET:
- case TYPE_CODE_ERROR:
- case TYPE_CODE_MEMBER:
- case TYPE_CODE_METHOD:
- case TYPE_CODE_REF:
- case TYPE_CODE_COMPLEX:
- default:
- break;
- }
- error ("unknown mode for LOWER/UPPER builtin");
-}
-
-static struct value *
-value_chill_length (struct value *val)
-{
- LONGEST tmp;
- struct type *type = VALUE_TYPE (val);
- struct type *ttype;
- CHECK_TYPEDEF (type);
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_ARRAY:
- case TYPE_CODE_BITSTRING:
- case TYPE_CODE_STRING:
- tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
- - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
- break;
- case TYPE_CODE_STRUCT:
- if (chill_varying_type (type))
- {
- tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
- break;
- }
- /* ... else fall through ... */
- default:
- error ("bad argument to LENGTH builtin");
- }
- return value_from_longest (builtin_type_int, tmp);
-}
-
-static struct value *
-value_chill_card (struct value *val)
-{
- LONGEST tmp = 0;
- struct type *type = VALUE_TYPE (val);
- CHECK_TYPEDEF (type);
-
- if (TYPE_CODE (type) == TYPE_CODE_SET)
- {
- struct type *range_type = TYPE_INDEX_TYPE (type);
- LONGEST lower_bound, upper_bound;
- int i;
-
- get_discrete_bounds (range_type, &lower_bound, &upper_bound);
- for (i = lower_bound; i <= upper_bound; i++)
- if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
- tmp++;
- }
- else
- error ("bad argument to CARD builtin");
-
- return value_from_longest (builtin_type_int, tmp);
-}
-
-static struct value *
-value_chill_max_min (enum exp_opcode op, struct value *val)
-{
- LONGEST tmp = 0;
- struct type *type = VALUE_TYPE (val);
- struct type *elttype;
- CHECK_TYPEDEF (type);
-
- if (TYPE_CODE (type) == TYPE_CODE_SET)
- {
- LONGEST lower_bound, upper_bound;
- int i, empty = 1;
-
- elttype = TYPE_INDEX_TYPE (type);
- CHECK_TYPEDEF (elttype);
- get_discrete_bounds (elttype, &lower_bound, &upper_bound);
-
- if (op == UNOP_CHMAX)
- {
- for (i = upper_bound; i >= lower_bound; i--)
- {
- if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
- {
- tmp = i;
- empty = 0;
- break;
- }
- }
- }
- else
- {
- for (i = lower_bound; i <= upper_bound; i++)
- {
- if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
- {
- tmp = i;
- empty = 0;
- break;
- }
- }
- }
- if (empty)
- error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
- }
- else
- error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
-
- return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
- ? TYPE_TARGET_TYPE (elttype)
- : elttype,
- tmp);
-}
-
-static struct value *
-evaluate_subexp_chill (struct type *expect_type,
- register struct expression *exp, register int *pos,
- enum noside noside)
-{
- int pc = *pos;
- struct type *type;
- int tem, nargs;
- struct value *arg1;
- struct value **argvec;
- enum exp_opcode op = exp->elts[*pos].opcode;
- switch (op)
- {
- case MULTI_SUBSCRIPT:
- if (noside == EVAL_SKIP)
- break;
- (*pos) += 3;
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- type = check_typedef (VALUE_TYPE (arg1));
-
- if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
- {
- /* Looks like string repetition. */
- struct value *string = evaluate_subexp_with_coercion (exp, pos,
- noside);
- return value_concat (arg1, string);
- }
-
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_PTR:
- type = check_typedef (TYPE_TARGET_TYPE (type));
- if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
- error ("reference value used as function");
- /* ... fall through ... */
- case TYPE_CODE_FUNC:
- /* It's a function call. */
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- break;
-
- /* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL */
- argvec = (struct value **) alloca (sizeof (struct value *)
- * (nargs + 2));
- argvec[0] = arg1;
- tem = 1;
- for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
- {
- argvec[tem]
- = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
- exp, pos, noside);
- }
- for (; tem <= nargs; tem++)
- argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
- argvec[tem] = 0; /* signal end of arglist */
-
- return call_function_by_hand (argvec[0], nargs, argvec + 1);
- default:
- break;
- }
-
- while (nargs-- > 0)
- {
- struct value *index = evaluate_subexp_with_coercion (exp, pos,
- noside);
- arg1 = value_subscript (arg1, index);
- }
- return (arg1);
-
- case UNOP_LOWER:
- case UNOP_UPPER:
- (*pos)++;
- if (noside == EVAL_SKIP)
- {
- (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
- goto nosideret;
- }
- arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
- EVAL_AVOID_SIDE_EFFECTS);
- tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
- return value_from_longest (type, tem);
-
- case UNOP_LENGTH:
- (*pos)++;
- arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
- return value_chill_length (arg1);
-
- case UNOP_CARD:
- (*pos)++;
- arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
- return value_chill_card (arg1);
-
- case UNOP_CHMAX:
- case UNOP_CHMIN:
- (*pos)++;
- arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
- return value_chill_max_min (op, arg1);
-
- case BINOP_COMMA:
- error ("',' operator used in invalid context");
-
- default:
- break;
- }
-
- return evaluate_subexp_standard (expect_type, exp, pos, noside);
-nosideret:
- return value_from_longest (builtin_type_long, (LONGEST) 1);
-}
-
-const struct language_defn chill_language_defn =
-{
- "chill",
- language_chill,
- chill_builtin_types,
- range_check_on,
- type_check_on,
- case_sensitive_on,
- chill_parse, /* parser */
- chill_error, /* parser error function */
- evaluate_subexp_chill,
- chill_printchar, /* print a character constant */
- chill_printstr, /* function to print a string constant */
- NULL, /* Function to print a single char */
- chill_create_fundamental_type, /* Create fundamental type in this language */
- chill_print_type, /* Print a type using appropriate syntax */
- chill_val_print, /* Print a value using appropriate syntax */
- chill_value_print, /* Print a top-levl value */
- {"", "B'", "", ""}, /* Binary format info */
- {"O'%lo", "O'", "o", ""}, /* Octal format info */
- {"D'%ld", "D'", "d", ""}, /* Decimal format info */
- {"H'%lx", "H'", "x", ""}, /* Hex format info */
- chill_op_print_tab, /* expression operators for printing */
- 0, /* arrays are first-class (not c-style) */
- 0, /* String lower bound */
- &builtin_type_chill_char, /* Type of string elements */
- LANG_MAGIC
-};
-
-/* Initialization for Chill */
-
-void
-_initialize_chill_language (void)
-{
- builtin_type_chill_bool =
- init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "BOOL", (struct objfile *) NULL);
- builtin_type_chill_char =
- init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "CHAR", (struct objfile *) NULL);
- builtin_type_chill_long =
- init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
- 0,
- "LONG", (struct objfile *) NULL);
- builtin_type_chill_ulong =
- init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "ULONG", (struct objfile *) NULL);
- builtin_type_chill_real =
- init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
- 0,
- "LONG_REAL", (struct objfile *) NULL);
-
- add_language (&chill_language_defn);
-}
+// OBSOLETE /* Chill language support routines for GDB, the GNU debugger.
+// OBSOLETE Copyright 1992, 1993, 1994, 1995, 1996, 2000, 2001, 2002
+// OBSOLETE Free Software Foundation, Inc.
+// OBSOLETE
+// OBSOLETE This file is part of GDB.
+// OBSOLETE
+// OBSOLETE This program is free software; you can redistribute it and/or modify
+// OBSOLETE it under the terms of the GNU General Public License as published by
+// OBSOLETE the Free Software Foundation; either version 2 of the License, or
+// OBSOLETE (at your option) any later version.
+// OBSOLETE
+// OBSOLETE This program is distributed in the hope that it will be useful,
+// OBSOLETE but WITHOUT ANY WARRANTY; without even the implied warranty of
+// OBSOLETE MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// OBSOLETE GNU General Public License for more details.
+// OBSOLETE
+// OBSOLETE You should have received a copy of the GNU General Public License
+// OBSOLETE along with this program; if not, write to the Free Software
+// OBSOLETE Foundation, Inc., 59 Temple Place - Suite 330,
+// OBSOLETE Boston, MA 02111-1307, USA. */
+// OBSOLETE
+// OBSOLETE #include "defs.h"
+// OBSOLETE #include "symtab.h"
+// OBSOLETE #include "gdbtypes.h"
+// OBSOLETE #include "value.h"
+// OBSOLETE #include "expression.h"
+// OBSOLETE #include "parser-defs.h"
+// OBSOLETE #include "language.h"
+// OBSOLETE #include "ch-lang.h"
+// OBSOLETE #include "valprint.h"
+// OBSOLETE
+// OBSOLETE extern void _initialize_chill_language (void);
+// OBSOLETE
+// OBSOLETE static struct value *evaluate_subexp_chill (struct type *, struct expression *,
+// OBSOLETE int *, enum noside);
+// OBSOLETE
+// OBSOLETE static struct value *value_chill_max_min (enum exp_opcode, struct value *);
+// OBSOLETE
+// OBSOLETE static struct value *value_chill_card (struct value *);
+// OBSOLETE
+// OBSOLETE static struct value *value_chill_length (struct value *);
+// OBSOLETE
+// OBSOLETE static struct type *chill_create_fundamental_type (struct objfile *, int);
+// OBSOLETE
+// OBSOLETE static void chill_printstr (struct ui_file * stream, char *string,
+// OBSOLETE unsigned int length, int width,
+// OBSOLETE int force_ellipses);
+// OBSOLETE
+// OBSOLETE static void chill_printchar (int, struct ui_file *);
+// OBSOLETE
+// OBSOLETE /* For now, Chill uses a simple mangling algorithm whereby you simply
+// OBSOLETE discard everything after the occurance of two successive CPLUS_MARKER
+// OBSOLETE characters to derive the demangled form. */
+// OBSOLETE
+// OBSOLETE char *
+// OBSOLETE chill_demangle (const char *mangled)
+// OBSOLETE {
+// OBSOLETE const char *joiner = NULL;
+// OBSOLETE char *demangled;
+// OBSOLETE const char *cp = mangled;
+// OBSOLETE
+// OBSOLETE while (*cp)
+// OBSOLETE {
+// OBSOLETE if (is_cplus_marker (*cp))
+// OBSOLETE {
+// OBSOLETE joiner = cp;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE cp++;
+// OBSOLETE }
+// OBSOLETE if (joiner != NULL && *(joiner + 1) == *joiner)
+// OBSOLETE {
+// OBSOLETE demangled = savestring (mangled, joiner - mangled);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE demangled = NULL;
+// OBSOLETE }
+// OBSOLETE return (demangled);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE chill_printchar (register int c, struct ui_file *stream)
+// OBSOLETE {
+// OBSOLETE c &= 0xFF; /* Avoid sign bit follies */
+// OBSOLETE
+// OBSOLETE if (PRINT_LITERAL_FORM (c))
+// OBSOLETE {
+// OBSOLETE if (c == '\'' || c == '^')
+// OBSOLETE fprintf_filtered (stream, "'%c%c'", c, c);
+// OBSOLETE else
+// OBSOLETE fprintf_filtered (stream, "'%c'", c);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Print the character string STRING, printing at most LENGTH characters.
+// OBSOLETE Printing stops early if the number hits print_max; repeat counts
+// OBSOLETE are printed as appropriate. Print ellipses at the end if we
+// OBSOLETE had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
+// OBSOLETE Note that gdb maintains the length of strings without counting the
+// OBSOLETE terminating null byte, while chill strings are typically written with
+// OBSOLETE an explicit null byte. So we always assume an implied null byte
+// OBSOLETE until gdb is able to maintain non-null terminated strings as well
+// OBSOLETE as null terminated strings (FIXME).
+// OBSOLETE */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE chill_printstr (struct ui_file *stream, char *string, unsigned int length,
+// OBSOLETE int width, int force_ellipses)
+// OBSOLETE {
+// OBSOLETE register unsigned int i;
+// OBSOLETE unsigned int things_printed = 0;
+// OBSOLETE int in_literal_form = 0;
+// OBSOLETE int in_control_form = 0;
+// OBSOLETE int need_slashslash = 0;
+// OBSOLETE unsigned int c;
+// OBSOLETE
+// OBSOLETE if (length == 0)
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("\"\"", stream);
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE for (i = 0; i < length && things_printed < print_max; ++i)
+// OBSOLETE {
+// OBSOLETE /* Position of the character we are examining
+// OBSOLETE to see whether it is repeated. */
+// OBSOLETE unsigned int rep1;
+// OBSOLETE /* Number of repetitions we have detected so far. */
+// OBSOLETE unsigned int reps;
+// OBSOLETE
+// OBSOLETE QUIT;
+// OBSOLETE
+// OBSOLETE if (need_slashslash)
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("//", stream);
+// OBSOLETE need_slashslash = 0;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE rep1 = i + 1;
+// OBSOLETE reps = 1;
+// OBSOLETE while (rep1 < length && string[rep1] == string[i])
+// OBSOLETE {
+// OBSOLETE ++rep1;
+// OBSOLETE ++reps;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE c = string[i];
+// OBSOLETE if (reps > repeat_count_threshold)
+// OBSOLETE {
+// OBSOLETE if (in_control_form || in_literal_form)
+// OBSOLETE {
+// OBSOLETE if (in_control_form)
+// OBSOLETE fputs_filtered (")", stream);
+// OBSOLETE fputs_filtered ("\"//", stream);
+// OBSOLETE in_control_form = in_literal_form = 0;
+// OBSOLETE }
+// OBSOLETE chill_printchar (c, stream);
+// OBSOLETE fprintf_filtered (stream, "<repeats %u times>", reps);
+// OBSOLETE i = rep1 - 1;
+// OBSOLETE things_printed += repeat_count_threshold;
+// OBSOLETE need_slashslash = 1;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE if (!in_literal_form && !in_control_form)
+// OBSOLETE fputs_filtered ("\"", stream);
+// OBSOLETE if (PRINT_LITERAL_FORM (c))
+// OBSOLETE {
+// OBSOLETE if (!in_literal_form)
+// OBSOLETE {
+// OBSOLETE if (in_control_form)
+// OBSOLETE {
+// OBSOLETE fputs_filtered (")", stream);
+// OBSOLETE in_control_form = 0;
+// OBSOLETE }
+// OBSOLETE in_literal_form = 1;
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, "%c", c);
+// OBSOLETE if (c == '"' || c == '^')
+// OBSOLETE /* duplicate this one as must be done at input */
+// OBSOLETE fprintf_filtered (stream, "%c", c);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE if (!in_control_form)
+// OBSOLETE {
+// OBSOLETE if (in_literal_form)
+// OBSOLETE {
+// OBSOLETE in_literal_form = 0;
+// OBSOLETE }
+// OBSOLETE fputs_filtered ("^(", stream);
+// OBSOLETE in_control_form = 1;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE fprintf_filtered (stream, ",");
+// OBSOLETE c = c & 0xff;
+// OBSOLETE fprintf_filtered (stream, "%u", (unsigned int) c);
+// OBSOLETE }
+// OBSOLETE ++things_printed;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Terminate the quotes if necessary. */
+// OBSOLETE if (in_control_form)
+// OBSOLETE {
+// OBSOLETE fputs_filtered (")", stream);
+// OBSOLETE }
+// OBSOLETE if (in_literal_form || in_control_form)
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("\"", stream);
+// OBSOLETE }
+// OBSOLETE if (force_ellipses || (i < length))
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("...", stream);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static struct type *
+// OBSOLETE chill_create_fundamental_type (struct objfile *objfile, int typeid)
+// OBSOLETE {
+// OBSOLETE register struct type *type = NULL;
+// OBSOLETE
+// OBSOLETE switch (typeid)
+// OBSOLETE {
+// OBSOLETE default:
+// OBSOLETE /* FIXME: For now, if we are asked to produce a type not in this
+// OBSOLETE language, create the equivalent of a C integer type with the
+// OBSOLETE name "<?type?>". When all the dust settles from the type
+// OBSOLETE reconstruction work, this should probably become an error. */
+// OBSOLETE type = init_type (TYPE_CODE_INT, 2, 0, "<?type?>", objfile);
+// OBSOLETE warning ("internal error: no chill fundamental type %d", typeid);
+// OBSOLETE break;
+// OBSOLETE case FT_VOID:
+// OBSOLETE /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
+// OBSOLETE typedefs, unrelated to anything directly in the code being compiled,
+// OBSOLETE that have some FT_VOID types. Just fake it for now. */
+// OBSOLETE type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_BOOLEAN:
+// OBSOLETE type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_CHAR:
+// OBSOLETE type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_SIGNED_CHAR:
+// OBSOLETE type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_UNSIGNED_CHAR:
+// OBSOLETE type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_SHORT: /* Chill ints are 2 bytes */
+// OBSOLETE type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
+// OBSOLETE type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_INTEGER: /* FIXME? */
+// OBSOLETE case FT_SIGNED_INTEGER: /* FIXME? */
+// OBSOLETE case FT_LONG: /* Chill longs are 4 bytes */
+// OBSOLETE case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
+// OBSOLETE type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_UNSIGNED_INTEGER: /* FIXME? */
+// OBSOLETE case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
+// OBSOLETE type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_FLOAT:
+// OBSOLETE type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
+// OBSOLETE break;
+// OBSOLETE case FT_DBL_PREC_FLOAT:
+// OBSOLETE type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE return (type);
+// OBSOLETE }
+// OBSOLETE \f
+// OBSOLETE
+// OBSOLETE /* Table of operators and their precedences for printing expressions. */
+// OBSOLETE
+// OBSOLETE static const struct op_print chill_op_print_tab[] =
+// OBSOLETE {
+// OBSOLETE {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
+// OBSOLETE {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
+// OBSOLETE {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
+// OBSOLETE {"MOD", BINOP_MOD, PREC_MUL, 0},
+// OBSOLETE {"REM", BINOP_REM, PREC_MUL, 0},
+// OBSOLETE {"SIZE", UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
+// OBSOLETE {"LOWER", UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
+// OBSOLETE {"UPPER", UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
+// OBSOLETE {"CARD", UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
+// OBSOLETE {"MAX", UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
+// OBSOLETE {"MIN", UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
+// OBSOLETE {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
+// OBSOLETE {"=", BINOP_EQUAL, PREC_EQUAL, 0},
+// OBSOLETE {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
+// OBSOLETE {"<=", BINOP_LEQ, PREC_ORDER, 0},
+// OBSOLETE {">=", BINOP_GEQ, PREC_ORDER, 0},
+// OBSOLETE {">", BINOP_GTR, PREC_ORDER, 0},
+// OBSOLETE {"<", BINOP_LESS, PREC_ORDER, 0},
+// OBSOLETE {"+", BINOP_ADD, PREC_ADD, 0},
+// OBSOLETE {"-", BINOP_SUB, PREC_ADD, 0},
+// OBSOLETE {"*", BINOP_MUL, PREC_MUL, 0},
+// OBSOLETE {"/", BINOP_DIV, PREC_MUL, 0},
+// OBSOLETE {"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
+// OBSOLETE {"-", UNOP_NEG, PREC_PREFIX, 0},
+// OBSOLETE {"->", UNOP_IND, PREC_SUFFIX, 1},
+// OBSOLETE {"->", UNOP_ADDR, PREC_PREFIX, 0},
+// OBSOLETE {":", BINOP_RANGE, PREC_ASSIGN, 0},
+// OBSOLETE {NULL, 0, 0, 0}
+// OBSOLETE };
+// OBSOLETE \f
+// OBSOLETE /* The built-in types of Chill. */
+// OBSOLETE
+// OBSOLETE struct type *builtin_type_chill_bool;
+// OBSOLETE struct type *builtin_type_chill_char;
+// OBSOLETE struct type *builtin_type_chill_long;
+// OBSOLETE struct type *builtin_type_chill_ulong;
+// OBSOLETE struct type *builtin_type_chill_real;
+// OBSOLETE
+// OBSOLETE struct type **const (chill_builtin_types[]) =
+// OBSOLETE {
+// OBSOLETE &builtin_type_chill_bool,
+// OBSOLETE &builtin_type_chill_char,
+// OBSOLETE &builtin_type_chill_long,
+// OBSOLETE &builtin_type_chill_ulong,
+// OBSOLETE &builtin_type_chill_real,
+// OBSOLETE 0
+// OBSOLETE };
+// OBSOLETE
+// OBSOLETE /* Calculate LOWER or UPPER of TYPE.
+// OBSOLETE Returns the result as an integer.
+// OBSOLETE *RESULT_TYPE is the appropriate type for the result. */
+// OBSOLETE
+// OBSOLETE LONGEST
+// OBSOLETE type_lower_upper (enum exp_opcode op, /* Either UNOP_LOWER or UNOP_UPPER */
+// OBSOLETE struct type *type, struct type **result_type)
+// OBSOLETE {
+// OBSOLETE LONGEST low, high;
+// OBSOLETE *result_type = type;
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE switch (TYPE_CODE (type))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_STRUCT:
+// OBSOLETE *result_type = builtin_type_int;
+// OBSOLETE if (chill_varying_type (type))
+// OBSOLETE return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_ARRAY:
+// OBSOLETE case TYPE_CODE_BITSTRING:
+// OBSOLETE case TYPE_CODE_STRING:
+// OBSOLETE type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
+// OBSOLETE
+// OBSOLETE /* ... fall through ... */
+// OBSOLETE case TYPE_CODE_RANGE:
+// OBSOLETE *result_type = TYPE_TARGET_TYPE (type);
+// OBSOLETE return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_ENUM:
+// OBSOLETE case TYPE_CODE_BOOL:
+// OBSOLETE case TYPE_CODE_INT:
+// OBSOLETE case TYPE_CODE_CHAR:
+// OBSOLETE if (get_discrete_bounds (type, &low, &high) >= 0)
+// OBSOLETE {
+// OBSOLETE *result_type = type;
+// OBSOLETE return op == UNOP_LOWER ? low : high;
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_UNDEF:
+// OBSOLETE case TYPE_CODE_PTR:
+// OBSOLETE case TYPE_CODE_UNION:
+// OBSOLETE case TYPE_CODE_FUNC:
+// OBSOLETE case TYPE_CODE_FLT:
+// OBSOLETE case TYPE_CODE_VOID:
+// OBSOLETE case TYPE_CODE_SET:
+// OBSOLETE case TYPE_CODE_ERROR:
+// OBSOLETE case TYPE_CODE_MEMBER:
+// OBSOLETE case TYPE_CODE_METHOD:
+// OBSOLETE case TYPE_CODE_REF:
+// OBSOLETE case TYPE_CODE_COMPLEX:
+// OBSOLETE default:
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE error ("unknown mode for LOWER/UPPER builtin");
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static struct value *
+// OBSOLETE value_chill_length (struct value *val)
+// OBSOLETE {
+// OBSOLETE LONGEST tmp;
+// OBSOLETE struct type *type = VALUE_TYPE (val);
+// OBSOLETE struct type *ttype;
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE switch (TYPE_CODE (type))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_ARRAY:
+// OBSOLETE case TYPE_CODE_BITSTRING:
+// OBSOLETE case TYPE_CODE_STRING:
+// OBSOLETE tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
+// OBSOLETE - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_STRUCT:
+// OBSOLETE if (chill_varying_type (type))
+// OBSOLETE {
+// OBSOLETE tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE /* ... else fall through ... */
+// OBSOLETE default:
+// OBSOLETE error ("bad argument to LENGTH builtin");
+// OBSOLETE }
+// OBSOLETE return value_from_longest (builtin_type_int, tmp);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static struct value *
+// OBSOLETE value_chill_card (struct value *val)
+// OBSOLETE {
+// OBSOLETE LONGEST tmp = 0;
+// OBSOLETE struct type *type = VALUE_TYPE (val);
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE
+// OBSOLETE if (TYPE_CODE (type) == TYPE_CODE_SET)
+// OBSOLETE {
+// OBSOLETE struct type *range_type = TYPE_INDEX_TYPE (type);
+// OBSOLETE LONGEST lower_bound, upper_bound;
+// OBSOLETE int i;
+// OBSOLETE
+// OBSOLETE get_discrete_bounds (range_type, &lower_bound, &upper_bound);
+// OBSOLETE for (i = lower_bound; i <= upper_bound; i++)
+// OBSOLETE if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
+// OBSOLETE tmp++;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE error ("bad argument to CARD builtin");
+// OBSOLETE
+// OBSOLETE return value_from_longest (builtin_type_int, tmp);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static struct value *
+// OBSOLETE value_chill_max_min (enum exp_opcode op, struct value *val)
+// OBSOLETE {
+// OBSOLETE LONGEST tmp = 0;
+// OBSOLETE struct type *type = VALUE_TYPE (val);
+// OBSOLETE struct type *elttype;
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE
+// OBSOLETE if (TYPE_CODE (type) == TYPE_CODE_SET)
+// OBSOLETE {
+// OBSOLETE LONGEST lower_bound, upper_bound;
+// OBSOLETE int i, empty = 1;
+// OBSOLETE
+// OBSOLETE elttype = TYPE_INDEX_TYPE (type);
+// OBSOLETE CHECK_TYPEDEF (elttype);
+// OBSOLETE get_discrete_bounds (elttype, &lower_bound, &upper_bound);
+// OBSOLETE
+// OBSOLETE if (op == UNOP_CHMAX)
+// OBSOLETE {
+// OBSOLETE for (i = upper_bound; i >= lower_bound; i--)
+// OBSOLETE {
+// OBSOLETE if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
+// OBSOLETE {
+// OBSOLETE tmp = i;
+// OBSOLETE empty = 0;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE for (i = lower_bound; i <= upper_bound; i++)
+// OBSOLETE {
+// OBSOLETE if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
+// OBSOLETE {
+// OBSOLETE tmp = i;
+// OBSOLETE empty = 0;
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE if (empty)
+// OBSOLETE error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
+// OBSOLETE
+// OBSOLETE return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
+// OBSOLETE ? TYPE_TARGET_TYPE (elttype)
+// OBSOLETE : elttype,
+// OBSOLETE tmp);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE static struct value *
+// OBSOLETE evaluate_subexp_chill (struct type *expect_type,
+// OBSOLETE register struct expression *exp, register int *pos,
+// OBSOLETE enum noside noside)
+// OBSOLETE {
+// OBSOLETE int pc = *pos;
+// OBSOLETE struct type *type;
+// OBSOLETE int tem, nargs;
+// OBSOLETE struct value *arg1;
+// OBSOLETE struct value **argvec;
+// OBSOLETE enum exp_opcode op = exp->elts[*pos].opcode;
+// OBSOLETE switch (op)
+// OBSOLETE {
+// OBSOLETE case MULTI_SUBSCRIPT:
+// OBSOLETE if (noside == EVAL_SKIP)
+// OBSOLETE break;
+// OBSOLETE (*pos) += 3;
+// OBSOLETE nargs = longest_to_int (exp->elts[pc + 1].longconst);
+// OBSOLETE arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
+// OBSOLETE type = check_typedef (VALUE_TYPE (arg1));
+// OBSOLETE
+// OBSOLETE if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
+// OBSOLETE {
+// OBSOLETE /* Looks like string repetition. */
+// OBSOLETE struct value *string = evaluate_subexp_with_coercion (exp, pos,
+// OBSOLETE noside);
+// OBSOLETE return value_concat (arg1, string);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE switch (TYPE_CODE (type))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_PTR:
+// OBSOLETE type = check_typedef (TYPE_TARGET_TYPE (type));
+// OBSOLETE if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
+// OBSOLETE error ("reference value used as function");
+// OBSOLETE /* ... fall through ... */
+// OBSOLETE case TYPE_CODE_FUNC:
+// OBSOLETE /* It's a function call. */
+// OBSOLETE if (noside == EVAL_AVOID_SIDE_EFFECTS)
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE /* Allocate arg vector, including space for the function to be
+// OBSOLETE called in argvec[0] and a terminating NULL */
+// OBSOLETE argvec = (struct value **) alloca (sizeof (struct value *)
+// OBSOLETE * (nargs + 2));
+// OBSOLETE argvec[0] = arg1;
+// OBSOLETE tem = 1;
+// OBSOLETE for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
+// OBSOLETE {
+// OBSOLETE argvec[tem]
+// OBSOLETE = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
+// OBSOLETE exp, pos, noside);
+// OBSOLETE }
+// OBSOLETE for (; tem <= nargs; tem++)
+// OBSOLETE argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
+// OBSOLETE argvec[tem] = 0; /* signal end of arglist */
+// OBSOLETE
+// OBSOLETE return call_function_by_hand (argvec[0], nargs, argvec + 1);
+// OBSOLETE default:
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE while (nargs-- > 0)
+// OBSOLETE {
+// OBSOLETE struct value *index = evaluate_subexp_with_coercion (exp, pos,
+// OBSOLETE noside);
+// OBSOLETE arg1 = value_subscript (arg1, index);
+// OBSOLETE }
+// OBSOLETE return (arg1);
+// OBSOLETE
+// OBSOLETE case UNOP_LOWER:
+// OBSOLETE case UNOP_UPPER:
+// OBSOLETE (*pos)++;
+// OBSOLETE if (noside == EVAL_SKIP)
+// OBSOLETE {
+// OBSOLETE (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
+// OBSOLETE goto nosideret;
+// OBSOLETE }
+// OBSOLETE arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
+// OBSOLETE EVAL_AVOID_SIDE_EFFECTS);
+// OBSOLETE tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
+// OBSOLETE return value_from_longest (type, tem);
+// OBSOLETE
+// OBSOLETE case UNOP_LENGTH:
+// OBSOLETE (*pos)++;
+// OBSOLETE arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
+// OBSOLETE return value_chill_length (arg1);
+// OBSOLETE
+// OBSOLETE case UNOP_CARD:
+// OBSOLETE (*pos)++;
+// OBSOLETE arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
+// OBSOLETE return value_chill_card (arg1);
+// OBSOLETE
+// OBSOLETE case UNOP_CHMAX:
+// OBSOLETE case UNOP_CHMIN:
+// OBSOLETE (*pos)++;
+// OBSOLETE arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
+// OBSOLETE return value_chill_max_min (op, arg1);
+// OBSOLETE
+// OBSOLETE case BINOP_COMMA:
+// OBSOLETE error ("',' operator used in invalid context");
+// OBSOLETE
+// OBSOLETE default:
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE return evaluate_subexp_standard (expect_type, exp, pos, noside);
+// OBSOLETE nosideret:
+// OBSOLETE return value_from_longest (builtin_type_long, (LONGEST) 1);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE const struct language_defn chill_language_defn =
+// OBSOLETE {
+// OBSOLETE "chill",
+// OBSOLETE language_chill,
+// OBSOLETE chill_builtin_types,
+// OBSOLETE range_check_on,
+// OBSOLETE type_check_on,
+// OBSOLETE case_sensitive_on,
+// OBSOLETE chill_parse, /* parser */
+// OBSOLETE chill_error, /* parser error function */
+// OBSOLETE evaluate_subexp_chill,
+// OBSOLETE chill_printchar, /* print a character constant */
+// OBSOLETE chill_printstr, /* function to print a string constant */
+// OBSOLETE NULL, /* Function to print a single char */
+// OBSOLETE chill_create_fundamental_type, /* Create fundamental type in this language */
+// OBSOLETE chill_print_type, /* Print a type using appropriate syntax */
+// OBSOLETE chill_val_print, /* Print a value using appropriate syntax */
+// OBSOLETE chill_value_print, /* Print a top-levl value */
+// OBSOLETE {"", "B'", "", ""}, /* Binary format info */
+// OBSOLETE {"O'%lo", "O'", "o", ""}, /* Octal format info */
+// OBSOLETE {"D'%ld", "D'", "d", ""}, /* Decimal format info */
+// OBSOLETE {"H'%lx", "H'", "x", ""}, /* Hex format info */
+// OBSOLETE chill_op_print_tab, /* expression operators for printing */
+// OBSOLETE 0, /* arrays are first-class (not c-style) */
+// OBSOLETE 0, /* String lower bound */
+// OBSOLETE &builtin_type_chill_char, /* Type of string elements */
+// OBSOLETE LANG_MAGIC
+// OBSOLETE };
+// OBSOLETE
+// OBSOLETE /* Initialization for Chill */
+// OBSOLETE
+// OBSOLETE void
+// OBSOLETE _initialize_chill_language (void)
+// OBSOLETE {
+// OBSOLETE builtin_type_chill_bool =
+// OBSOLETE init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+// OBSOLETE TYPE_FLAG_UNSIGNED,
+// OBSOLETE "BOOL", (struct objfile *) NULL);
+// OBSOLETE builtin_type_chill_char =
+// OBSOLETE init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+// OBSOLETE TYPE_FLAG_UNSIGNED,
+// OBSOLETE "CHAR", (struct objfile *) NULL);
+// OBSOLETE builtin_type_chill_long =
+// OBSOLETE init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
+// OBSOLETE 0,
+// OBSOLETE "LONG", (struct objfile *) NULL);
+// OBSOLETE builtin_type_chill_ulong =
+// OBSOLETE init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
+// OBSOLETE TYPE_FLAG_UNSIGNED,
+// OBSOLETE "ULONG", (struct objfile *) NULL);
+// OBSOLETE builtin_type_chill_real =
+// OBSOLETE init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
+// OBSOLETE 0,
+// OBSOLETE "LONG_REAL", (struct objfile *) NULL);
+// OBSOLETE
+// OBSOLETE add_language (&chill_language_defn);
+// OBSOLETE }
-/* Chill language support definitions for GDB, the GNU debugger.
- Copyright 1992, 1994, 1996, 1998, 1999, 2000
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
-/* Forward decls for prototypes */
-struct value;
-
-extern int chill_parse (void); /* Defined in ch-exp.y */
-
-extern void chill_error (char *); /* Defined in ch-exp.y */
-
-/* Defined in ch-typeprint.c */
-extern void chill_print_type (struct type *, char *, struct ui_file *, int,
- int);
-
-extern int chill_val_print (struct type *, char *, int, CORE_ADDR,
- struct ui_file *, int, int, int,
- enum val_prettyprint);
-
-extern int chill_value_print (struct value *, struct ui_file *,
- int, enum val_prettyprint);
-
-extern LONGEST
-type_lower_upper (enum exp_opcode, struct type *, struct type **);
+// OBSOLETE /* Chill language support definitions for GDB, the GNU debugger.
+// OBSOLETE Copyright 1992, 1994, 1996, 1998, 1999, 2000
+// OBSOLETE Free Software Foundation, Inc.
+// OBSOLETE
+// OBSOLETE This file is part of GDB.
+// OBSOLETE
+// OBSOLETE This program is free software; you can redistribute it and/or modify
+// OBSOLETE it under the terms of the GNU General Public License as published by
+// OBSOLETE the Free Software Foundation; either version 2 of the License, or
+// OBSOLETE (at your option) any later version.
+// OBSOLETE
+// OBSOLETE This program is distributed in the hope that it will be useful,
+// OBSOLETE but WITHOUT ANY WARRANTY; without even the implied warranty of
+// OBSOLETE MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// OBSOLETE GNU General Public License for more details.
+// OBSOLETE
+// OBSOLETE You should have received a copy of the GNU General Public License
+// OBSOLETE along with this program; if not, write to the Free Software
+// OBSOLETE Foundation, Inc., 59 Temple Place - Suite 330,
+// OBSOLETE Boston, MA 02111-1307, USA. */
+// OBSOLETE
+// OBSOLETE /* Forward decls for prototypes */
+// OBSOLETE struct value;
+// OBSOLETE
+// OBSOLETE extern int chill_parse (void); /* Defined in ch-exp.y */
+// OBSOLETE
+// OBSOLETE extern void chill_error (char *); /* Defined in ch-exp.y */
+// OBSOLETE
+// OBSOLETE /* Defined in ch-typeprint.c */
+// OBSOLETE extern void chill_print_type (struct type *, char *, struct ui_file *, int,
+// OBSOLETE int);
+// OBSOLETE
+// OBSOLETE extern int chill_val_print (struct type *, char *, int, CORE_ADDR,
+// OBSOLETE struct ui_file *, int, int, int,
+// OBSOLETE enum val_prettyprint);
+// OBSOLETE
+// OBSOLETE extern int chill_value_print (struct value *, struct ui_file *,
+// OBSOLETE int, enum val_prettyprint);
+// OBSOLETE
+// OBSOLETE extern LONGEST
+// OBSOLETE type_lower_upper (enum exp_opcode, struct type *, struct type **);
-/* Support for printing Chill types for GDB, the GNU debugger.
- Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1995, 2000
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
-#include "defs.h"
-#include "gdb_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 "language.h"
-#include "ch-lang.h"
-#include "typeprint.h"
-
-#include "gdb_string.h"
-#include <errno.h>
-
-static void chill_type_print_base (struct type *, struct ui_file *, int, int);
-
-void
-chill_print_type (struct type *type, char *varstring, struct ui_file *stream,
- int show, int level)
-{
- if (varstring != NULL && *varstring != '\0')
- {
- fputs_filtered (varstring, stream);
- fputs_filtered (" ", stream);
- }
- chill_type_print_base (type, stream, show, level);
-}
-
-/* Print the name of the type (or the ultimate pointer target,
- function value or array element).
-
- SHOW nonzero means don't print this type as just its name;
- show its real definition even if it has a name.
- SHOW zero means print just typename or tag if there is one
- SHOW negative means abbreviate structure elements.
- SHOW is decremented for printing of structure elements.
-
- LEVEL is the depth to indent by.
- We increase it for some recursive calls. */
-
-static void
-chill_type_print_base (struct type *type, struct ui_file *stream, int show,
- int level)
-{
- register int len;
- register int i;
- struct type *index_type;
- struct type *range_type;
- LONGEST low_bound;
- LONGEST high_bound;
-
- 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 ((show <= 0) && (TYPE_NAME (type) != NULL))
- {
- fputs_filtered (TYPE_NAME (type), stream);
- return;
- }
-
- if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
- CHECK_TYPEDEF (type);
-
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_TYPEDEF:
- chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
- break;
- case TYPE_CODE_PTR:
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
- {
- fprintf_filtered (stream,
- TYPE_NAME (type) ? TYPE_NAME (type) : "PTR");
- break;
- }
- fprintf_filtered (stream, "REF ");
- chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
- break;
-
- case TYPE_CODE_BOOL:
- /* FIXME: we should probably just print the TYPE_NAME, in case
- anyone ever fixes the compiler to give us the real names
- in the presence of the chill equivalent of typedef (assuming
- there is one). */
- fprintf_filtered (stream,
- TYPE_NAME (type) ? TYPE_NAME (type) : "BOOL");
- break;
-
- case TYPE_CODE_ARRAY:
- fputs_filtered ("ARRAY (", stream);
- range_type = TYPE_FIELD_TYPE (type, 0);
- if (TYPE_CODE (range_type) != TYPE_CODE_RANGE)
- chill_print_type (range_type, "", stream, 0, level);
- else
- {
- index_type = TYPE_TARGET_TYPE (range_type);
- low_bound = TYPE_FIELD_BITPOS (range_type, 0);
- high_bound = TYPE_FIELD_BITPOS (range_type, 1);
- print_type_scalar (index_type, low_bound, stream);
- fputs_filtered (":", stream);
- print_type_scalar (index_type, high_bound, stream);
- }
- fputs_filtered (") ", stream);
- chill_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, level);
- break;
-
- case TYPE_CODE_BITSTRING:
- fprintf_filtered (stream, "BOOLS (%d)",
- TYPE_FIELD_BITPOS (TYPE_FIELD_TYPE (type, 0), 1) + 1);
- break;
-
- case TYPE_CODE_SET:
- fputs_filtered ("POWERSET ", stream);
- chill_print_type (TYPE_INDEX_TYPE (type), "", stream,
- show - 1, level);
- break;
-
- case TYPE_CODE_STRING:
- range_type = TYPE_FIELD_TYPE (type, 0);
- index_type = TYPE_TARGET_TYPE (range_type);
- high_bound = TYPE_FIELD_BITPOS (range_type, 1);
- fputs_filtered ("CHARS (", stream);
- print_type_scalar (index_type, high_bound + 1, stream);
- fputs_filtered (")", stream);
- break;
-
- case TYPE_CODE_MEMBER:
- fprintf_filtered (stream, "MEMBER ");
- chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
- break;
- case TYPE_CODE_REF:
- fprintf_filtered (stream, "/*LOC*/ ");
- chill_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
- break;
- case TYPE_CODE_FUNC:
- fprintf_filtered (stream, "PROC (");
- len = TYPE_NFIELDS (type);
- for (i = 0; i < len; i++)
- {
- struct type *param_type = TYPE_FIELD_TYPE (type, i);
- if (i > 0)
- {
- fputs_filtered (", ", stream);
- wrap_here (" ");
- }
- if (TYPE_CODE (param_type) == TYPE_CODE_REF)
- {
- chill_type_print_base (TYPE_TARGET_TYPE (param_type),
- stream, 0, level);
- fputs_filtered (" LOC", stream);
- }
- else
- chill_type_print_base (param_type, stream, show, level);
- }
- fprintf_filtered (stream, ")");
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
- {
- fputs_filtered (" RETURNS (", stream);
- chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
- fputs_filtered (")", stream);
- }
- break;
-
- case TYPE_CODE_STRUCT:
- if (chill_varying_type (type))
- {
- chill_type_print_base (TYPE_FIELD_TYPE (type, 1),
- stream, 0, level);
- fputs_filtered (" VARYING", stream);
- }
- else
- {
- fprintf_filtered (stream, "STRUCT ");
-
- fprintf_filtered (stream, "(\n");
- if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
- {
- if (TYPE_STUB (type))
- {
- fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
- }
- else
- {
- fprintfi_filtered (level + 4, stream, "<no data fields>\n");
- }
- }
- else
- {
- len = TYPE_NFIELDS (type);
- for (i = TYPE_N_BASECLASSES (type); i < len; i++)
- {
- struct type *field_type = TYPE_FIELD_TYPE (type, i);
- QUIT;
- print_spaces_filtered (level + 4, stream);
- if (TYPE_CODE (field_type) == TYPE_CODE_UNION)
- {
- int j; /* variant number */
- fputs_filtered ("CASE OF\n", stream);
- for (j = 0; j < TYPE_NFIELDS (field_type); j++)
- {
- int k; /* variant field index */
- struct type *variant_type
- = TYPE_FIELD_TYPE (field_type, j);
- int var_len = TYPE_NFIELDS (variant_type);
- print_spaces_filtered (level + 4, stream);
- if (strcmp (TYPE_FIELD_NAME (field_type, j),
- "else") == 0)
- fputs_filtered ("ELSE\n", stream);
- else
- fputs_filtered (":\n", stream);
- if (TYPE_CODE (variant_type) != TYPE_CODE_STRUCT)
- error ("variant record confusion");
- for (k = 0; k < var_len; k++)
- {
- print_spaces_filtered (level + 8, stream);
- chill_print_type (TYPE_FIELD_TYPE (variant_type, k),
- TYPE_FIELD_NAME (variant_type, k),
- stream, show - 1, level + 8);
- if (k < (var_len - 1))
- fputs_filtered (",", stream);
- fputs_filtered ("\n", stream);
- }
- }
- print_spaces_filtered (level + 4, stream);
- fputs_filtered ("ESAC", stream);
- }
- else
- chill_print_type (field_type,
- TYPE_FIELD_NAME (type, i),
- stream, show - 1, level + 4);
- if (i < (len - 1))
- {
- fputs_filtered (",", stream);
- }
- fputs_filtered ("\n", stream);
- }
- }
- fprintfi_filtered (level, stream, ")");
- }
- break;
-
- case TYPE_CODE_RANGE:
- {
- struct type *target = TYPE_TARGET_TYPE (type);
- if (target && TYPE_NAME (target))
- fputs_filtered (TYPE_NAME (target), stream);
- else
- fputs_filtered ("RANGE", stream);
- if (target == NULL)
- target = builtin_type_long;
- fputs_filtered (" (", stream);
- print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
- fputs_filtered (":", stream);
- print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
- fputs_filtered (")", stream);
- }
- break;
-
- case TYPE_CODE_ENUM:
- {
- register int lastval = 0;
- fprintf_filtered (stream, "SET (");
- len = TYPE_NFIELDS (type);
- 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:
- case TYPE_CODE_UNDEF:
- case TYPE_CODE_ERROR:
- case TYPE_CODE_UNION:
- case TYPE_CODE_METHOD:
- error ("missing language support in chill_type_print_base");
- 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
- {
- error ("Unrecognized type code (%d) in symbol table.",
- TYPE_CODE (type));
- }
- break;
- }
-}
+// OBSOLETE /* Support for printing Chill types for GDB, the GNU debugger.
+// OBSOLETE Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1995, 2000
+// OBSOLETE Free Software Foundation, Inc.
+// OBSOLETE
+// OBSOLETE This file is part of GDB.
+// OBSOLETE
+// OBSOLETE This program is free software; you can redistribute it and/or modify
+// OBSOLETE it under the terms of the GNU General Public License as published by
+// OBSOLETE the Free Software Foundation; either version 2 of the License, or
+// OBSOLETE (at your option) any later version.
+// OBSOLETE
+// OBSOLETE This program is distributed in the hope that it will be useful,
+// OBSOLETE but WITHOUT ANY WARRANTY; without even the implied warranty of
+// OBSOLETE MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// OBSOLETE GNU General Public License for more details.
+// OBSOLETE
+// OBSOLETE You should have received a copy of the GNU General Public License
+// OBSOLETE along with this program; if not, write to the Free Software
+// OBSOLETE Foundation, Inc., 59 Temple Place - Suite 330,
+// OBSOLETE Boston, MA 02111-1307, USA. */
+// OBSOLETE
+// OBSOLETE #include "defs.h"
+// OBSOLETE #include "gdb_obstack.h"
+// OBSOLETE #include "bfd.h" /* Binary File Description */
+// OBSOLETE #include "symtab.h"
+// OBSOLETE #include "gdbtypes.h"
+// OBSOLETE #include "expression.h"
+// OBSOLETE #include "value.h"
+// OBSOLETE #include "gdbcore.h"
+// OBSOLETE #include "target.h"
+// OBSOLETE #include "language.h"
+// OBSOLETE #include "ch-lang.h"
+// OBSOLETE #include "typeprint.h"
+// OBSOLETE
+// OBSOLETE #include "gdb_string.h"
+// OBSOLETE #include <errno.h>
+// OBSOLETE
+// OBSOLETE static void chill_type_print_base (struct type *, struct ui_file *, int, int);
+// OBSOLETE
+// OBSOLETE void
+// OBSOLETE chill_print_type (struct type *type, char *varstring, struct ui_file *stream,
+// OBSOLETE int show, int level)
+// OBSOLETE {
+// OBSOLETE if (varstring != NULL && *varstring != '\0')
+// OBSOLETE {
+// OBSOLETE fputs_filtered (varstring, stream);
+// OBSOLETE fputs_filtered (" ", stream);
+// OBSOLETE }
+// OBSOLETE chill_type_print_base (type, stream, show, level);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Print the name of the type (or the ultimate pointer target,
+// OBSOLETE function value or array element).
+// OBSOLETE
+// OBSOLETE SHOW nonzero means don't print this type as just its name;
+// OBSOLETE show its real definition even if it has a name.
+// OBSOLETE SHOW zero means print just typename or tag if there is one
+// OBSOLETE SHOW negative means abbreviate structure elements.
+// OBSOLETE SHOW is decremented for printing of structure elements.
+// OBSOLETE
+// OBSOLETE LEVEL is the depth to indent by.
+// OBSOLETE We increase it for some recursive calls. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE chill_type_print_base (struct type *type, struct ui_file *stream, int show,
+// OBSOLETE int level)
+// OBSOLETE {
+// OBSOLETE register int len;
+// OBSOLETE register int i;
+// OBSOLETE struct type *index_type;
+// OBSOLETE struct type *range_type;
+// OBSOLETE LONGEST low_bound;
+// OBSOLETE LONGEST high_bound;
+// OBSOLETE
+// OBSOLETE QUIT;
+// OBSOLETE
+// OBSOLETE wrap_here (" ");
+// OBSOLETE if (type == NULL)
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("<type unknown>", stream);
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* When SHOW is zero or less, and there is a valid type name, then always
+// OBSOLETE just print the type name directly from the type. */
+// OBSOLETE
+// OBSOLETE if ((show <= 0) && (TYPE_NAME (type) != NULL))
+// OBSOLETE {
+// OBSOLETE fputs_filtered (TYPE_NAME (type), stream);
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE
+// OBSOLETE switch (TYPE_CODE (type))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_TYPEDEF:
+// OBSOLETE chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_PTR:
+// OBSOLETE if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream,
+// OBSOLETE TYPE_NAME (type) ? TYPE_NAME (type) : "PTR");
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, "REF ");
+// OBSOLETE chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_BOOL:
+// OBSOLETE /* FIXME: we should probably just print the TYPE_NAME, in case
+// OBSOLETE anyone ever fixes the compiler to give us the real names
+// OBSOLETE in the presence of the chill equivalent of typedef (assuming
+// OBSOLETE there is one). */
+// OBSOLETE fprintf_filtered (stream,
+// OBSOLETE TYPE_NAME (type) ? TYPE_NAME (type) : "BOOL");
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_ARRAY:
+// OBSOLETE fputs_filtered ("ARRAY (", stream);
+// OBSOLETE range_type = TYPE_FIELD_TYPE (type, 0);
+// OBSOLETE if (TYPE_CODE (range_type) != TYPE_CODE_RANGE)
+// OBSOLETE chill_print_type (range_type, "", stream, 0, level);
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE index_type = TYPE_TARGET_TYPE (range_type);
+// OBSOLETE low_bound = TYPE_FIELD_BITPOS (range_type, 0);
+// OBSOLETE high_bound = TYPE_FIELD_BITPOS (range_type, 1);
+// OBSOLETE print_type_scalar (index_type, low_bound, stream);
+// OBSOLETE fputs_filtered (":", stream);
+// OBSOLETE print_type_scalar (index_type, high_bound, stream);
+// OBSOLETE }
+// OBSOLETE fputs_filtered (") ", stream);
+// OBSOLETE chill_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, level);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_BITSTRING:
+// OBSOLETE fprintf_filtered (stream, "BOOLS (%d)",
+// OBSOLETE TYPE_FIELD_BITPOS (TYPE_FIELD_TYPE (type, 0), 1) + 1);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_SET:
+// OBSOLETE fputs_filtered ("POWERSET ", stream);
+// OBSOLETE chill_print_type (TYPE_INDEX_TYPE (type), "", stream,
+// OBSOLETE show - 1, level);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_STRING:
+// OBSOLETE range_type = TYPE_FIELD_TYPE (type, 0);
+// OBSOLETE index_type = TYPE_TARGET_TYPE (range_type);
+// OBSOLETE high_bound = TYPE_FIELD_BITPOS (range_type, 1);
+// OBSOLETE fputs_filtered ("CHARS (", stream);
+// OBSOLETE print_type_scalar (index_type, high_bound + 1, stream);
+// OBSOLETE fputs_filtered (")", stream);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_MEMBER:
+// OBSOLETE fprintf_filtered (stream, "MEMBER ");
+// OBSOLETE chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_REF:
+// OBSOLETE fprintf_filtered (stream, "/*LOC*/ ");
+// OBSOLETE chill_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_FUNC:
+// OBSOLETE fprintf_filtered (stream, "PROC (");
+// OBSOLETE len = TYPE_NFIELDS (type);
+// OBSOLETE for (i = 0; i < len; i++)
+// OBSOLETE {
+// OBSOLETE struct type *param_type = TYPE_FIELD_TYPE (type, i);
+// OBSOLETE if (i > 0)
+// OBSOLETE {
+// OBSOLETE fputs_filtered (", ", stream);
+// OBSOLETE wrap_here (" ");
+// OBSOLETE }
+// OBSOLETE if (TYPE_CODE (param_type) == TYPE_CODE_REF)
+// OBSOLETE {
+// OBSOLETE chill_type_print_base (TYPE_TARGET_TYPE (param_type),
+// OBSOLETE stream, 0, level);
+// OBSOLETE fputs_filtered (" LOC", stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE chill_type_print_base (param_type, stream, show, level);
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, ")");
+// OBSOLETE if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
+// OBSOLETE {
+// OBSOLETE fputs_filtered (" RETURNS (", stream);
+// OBSOLETE chill_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
+// OBSOLETE fputs_filtered (")", stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_STRUCT:
+// OBSOLETE if (chill_varying_type (type))
+// OBSOLETE {
+// OBSOLETE chill_type_print_base (TYPE_FIELD_TYPE (type, 1),
+// OBSOLETE stream, 0, level);
+// OBSOLETE fputs_filtered (" VARYING", stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "STRUCT ");
+// OBSOLETE
+// OBSOLETE fprintf_filtered (stream, "(\n");
+// OBSOLETE if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
+// OBSOLETE {
+// OBSOLETE if (TYPE_STUB (type))
+// OBSOLETE {
+// OBSOLETE fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE fprintfi_filtered (level + 4, stream, "<no data fields>\n");
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE len = TYPE_NFIELDS (type);
+// OBSOLETE for (i = TYPE_N_BASECLASSES (type); i < len; i++)
+// OBSOLETE {
+// OBSOLETE struct type *field_type = TYPE_FIELD_TYPE (type, i);
+// OBSOLETE QUIT;
+// OBSOLETE print_spaces_filtered (level + 4, stream);
+// OBSOLETE if (TYPE_CODE (field_type) == TYPE_CODE_UNION)
+// OBSOLETE {
+// OBSOLETE int j; /* variant number */
+// OBSOLETE fputs_filtered ("CASE OF\n", stream);
+// OBSOLETE for (j = 0; j < TYPE_NFIELDS (field_type); j++)
+// OBSOLETE {
+// OBSOLETE int k; /* variant field index */
+// OBSOLETE struct type *variant_type
+// OBSOLETE = TYPE_FIELD_TYPE (field_type, j);
+// OBSOLETE int var_len = TYPE_NFIELDS (variant_type);
+// OBSOLETE print_spaces_filtered (level + 4, stream);
+// OBSOLETE if (strcmp (TYPE_FIELD_NAME (field_type, j),
+// OBSOLETE "else") == 0)
+// OBSOLETE fputs_filtered ("ELSE\n", stream);
+// OBSOLETE else
+// OBSOLETE fputs_filtered (":\n", stream);
+// OBSOLETE if (TYPE_CODE (variant_type) != TYPE_CODE_STRUCT)
+// OBSOLETE error ("variant record confusion");
+// OBSOLETE for (k = 0; k < var_len; k++)
+// OBSOLETE {
+// OBSOLETE print_spaces_filtered (level + 8, stream);
+// OBSOLETE chill_print_type (TYPE_FIELD_TYPE (variant_type, k),
+// OBSOLETE TYPE_FIELD_NAME (variant_type, k),
+// OBSOLETE stream, show - 1, level + 8);
+// OBSOLETE if (k < (var_len - 1))
+// OBSOLETE fputs_filtered (",", stream);
+// OBSOLETE fputs_filtered ("\n", stream);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE print_spaces_filtered (level + 4, stream);
+// OBSOLETE fputs_filtered ("ESAC", stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE chill_print_type (field_type,
+// OBSOLETE TYPE_FIELD_NAME (type, i),
+// OBSOLETE stream, show - 1, level + 4);
+// OBSOLETE if (i < (len - 1))
+// OBSOLETE {
+// OBSOLETE fputs_filtered (",", stream);
+// OBSOLETE }
+// OBSOLETE fputs_filtered ("\n", stream);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE fprintfi_filtered (level, stream, ")");
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_RANGE:
+// OBSOLETE {
+// OBSOLETE struct type *target = TYPE_TARGET_TYPE (type);
+// OBSOLETE if (target && TYPE_NAME (target))
+// OBSOLETE fputs_filtered (TYPE_NAME (target), stream);
+// OBSOLETE else
+// OBSOLETE fputs_filtered ("RANGE", stream);
+// OBSOLETE if (target == NULL)
+// OBSOLETE target = builtin_type_long;
+// OBSOLETE fputs_filtered (" (", stream);
+// OBSOLETE print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
+// OBSOLETE fputs_filtered (":", stream);
+// OBSOLETE print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
+// OBSOLETE fputs_filtered (")", stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_ENUM:
+// OBSOLETE {
+// OBSOLETE register int lastval = 0;
+// OBSOLETE fprintf_filtered (stream, "SET (");
+// OBSOLETE len = TYPE_NFIELDS (type);
+// OBSOLETE for (i = 0; i < len; i++)
+// OBSOLETE {
+// OBSOLETE QUIT;
+// OBSOLETE if (i)
+// OBSOLETE fprintf_filtered (stream, ", ");
+// OBSOLETE wrap_here (" ");
+// OBSOLETE fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
+// OBSOLETE if (lastval != TYPE_FIELD_BITPOS (type, i))
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, " = %d", TYPE_FIELD_BITPOS (type, i));
+// OBSOLETE lastval = TYPE_FIELD_BITPOS (type, i);
+// OBSOLETE }
+// OBSOLETE lastval++;
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, ")");
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_VOID:
+// OBSOLETE case TYPE_CODE_UNDEF:
+// OBSOLETE case TYPE_CODE_ERROR:
+// OBSOLETE case TYPE_CODE_UNION:
+// OBSOLETE case TYPE_CODE_METHOD:
+// OBSOLETE error ("missing language support in chill_type_print_base");
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE default:
+// OBSOLETE
+// OBSOLETE /* Handle types not explicitly handled by the other cases,
+// OBSOLETE such as fundamental types. For these, just print whatever
+// OBSOLETE the type name is, as recorded in the type itself. If there
+// OBSOLETE is no type name, then complain. */
+// OBSOLETE
+// OBSOLETE if (TYPE_NAME (type) != NULL)
+// OBSOLETE {
+// OBSOLETE fputs_filtered (TYPE_NAME (type), stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE error ("Unrecognized type code (%d) in symbol table.",
+// OBSOLETE TYPE_CODE (type));
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
-/* Support for printing Chill values for GDB, the GNU debugger.
- Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
- 1998, 2000, 2001
- Free Software Foundation, Inc.
-
- This file is part of GDB.
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
-#include "defs.h"
-#include "gdb_obstack.h"
-#include "symtab.h"
-#include "gdbtypes.h"
-#include "valprint.h"
-#include "expression.h"
-#include "value.h"
-#include "language.h"
-#include "demangle.h"
-#include "c-lang.h" /* For c_val_print */
-#include "typeprint.h"
-#include "ch-lang.h"
-#include "annotate.h"
-
-static void chill_print_value_fields (struct type *, char *,
- struct ui_file *, int, int,
- enum val_prettyprint, struct type **);
-
-static void chill_print_type_scalar (struct type *, LONGEST,
- struct ui_file *);
-
-static void chill_val_print_array_elements (struct type *, char *,
- CORE_ADDR, struct ui_file *,
- int, int, int,
- enum val_prettyprint);
-\f
-
-/* Print integral scalar data VAL, of type TYPE, onto stdio stream STREAM.
- Used to print data from type structures in a specified type. For example,
- array bounds may be characters or booleans in some languages, and this
- allows the ranges to be printed in their "natural" form rather than as
- decimal integer values. */
-
-static void
-chill_print_type_scalar (struct type *type, LONGEST val, struct ui_file *stream)
-{
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_RANGE:
- if (TYPE_TARGET_TYPE (type))
- {
- chill_print_type_scalar (TYPE_TARGET_TYPE (type), val, stream);
- return;
- }
- break;
- case TYPE_CODE_UNDEF:
- case TYPE_CODE_PTR:
- case TYPE_CODE_ARRAY:
- case TYPE_CODE_STRUCT:
- case TYPE_CODE_UNION:
- case TYPE_CODE_ENUM:
- case TYPE_CODE_FUNC:
- case TYPE_CODE_INT:
- case TYPE_CODE_FLT:
- case TYPE_CODE_VOID:
- case TYPE_CODE_SET:
- case TYPE_CODE_STRING:
- case TYPE_CODE_BITSTRING:
- case TYPE_CODE_ERROR:
- case TYPE_CODE_MEMBER:
- case TYPE_CODE_METHOD:
- case TYPE_CODE_REF:
- case TYPE_CODE_CHAR:
- case TYPE_CODE_BOOL:
- case TYPE_CODE_COMPLEX:
- case TYPE_CODE_TYPEDEF:
- default:
- break;
- }
- print_type_scalar (type, val, stream);
-}
-\f
-/* Print the elements of an array.
- Similar to val_print_array_elements, but prints
- element indexes (in Chill syntax). */
-
-static void
-chill_val_print_array_elements (struct type *type, char *valaddr,
- CORE_ADDR address, struct ui_file *stream,
- int format, int deref_ref, int recurse,
- enum val_prettyprint pretty)
-{
- unsigned int i = 0;
- unsigned int things_printed = 0;
- unsigned len;
- struct type *elttype;
- struct type *range_type = TYPE_FIELD_TYPE (type, 0);
- struct type *index_type = TYPE_TARGET_TYPE (range_type);
- unsigned eltlen;
- /* Position of the array element we are examining to see
- whether it is repeated. */
- unsigned int rep1;
- /* Number of repetitions we have detected so far. */
- unsigned int reps;
- LONGEST low_bound = TYPE_FIELD_BITPOS (range_type, 0);
-
- elttype = check_typedef (TYPE_TARGET_TYPE (type));
- eltlen = TYPE_LENGTH (elttype);
- len = TYPE_LENGTH (type) / eltlen;
-
- annotate_array_section_begin (i, elttype);
-
- for (; i < len && things_printed < print_max; i++)
- {
- if (i != 0)
- {
- if (prettyprint_arrays)
- {
- fprintf_filtered (stream, ",\n");
- print_spaces_filtered (2 + 2 * recurse, stream);
- }
- else
- {
- fprintf_filtered (stream, ", ");
- }
- }
- wrap_here (n_spaces (2 + 2 * recurse));
-
- rep1 = i + 1;
- reps = 1;
- while ((rep1 < len) &&
- !memcmp (valaddr + i * eltlen, valaddr + rep1 * eltlen, eltlen))
- {
- ++reps;
- ++rep1;
- }
-
- fputs_filtered ("(", stream);
- chill_print_type_scalar (index_type, low_bound + i, stream);
- if (reps > 1)
- {
- fputs_filtered (":", stream);
- chill_print_type_scalar (index_type, low_bound + i + reps - 1,
- stream);
- fputs_filtered ("): ", stream);
- val_print (elttype, valaddr + i * eltlen, 0, 0, stream, format,
- deref_ref, recurse + 1, pretty);
-
- i = rep1 - 1;
- things_printed += 1;
- }
- else
- {
- fputs_filtered ("): ", stream);
- val_print (elttype, valaddr + i * eltlen, 0, 0, stream, format,
- deref_ref, recurse + 1, pretty);
- annotate_elt ();
- things_printed++;
- }
- }
- annotate_array_section_end ();
- if (i < len)
- {
- fprintf_filtered (stream, "...");
- }
-}
-
-/* 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
-chill_val_print (struct type *type, char *valaddr, int embedded_offset,
- CORE_ADDR address, struct ui_file *stream, int format,
- int deref_ref, int recurse, enum val_prettyprint pretty)
-{
- LONGEST val;
- unsigned int i = 0; /* Number of characters printed. */
- struct type *elttype;
- CORE_ADDR addr;
-
- CHECK_TYPEDEF (type);
-
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_ARRAY:
- if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
- {
- if (prettyprint_arrays)
- {
- print_spaces_filtered (2 + 2 * recurse, stream);
- }
- fprintf_filtered (stream, "[");
- chill_val_print_array_elements (type, valaddr, address, stream,
- format, deref_ref, recurse, pretty);
- fprintf_filtered (stream, "]");
- }
- else
- {
- error ("unimplemented in chill_val_print; unspecified array length");
- }
- break;
-
- case TYPE_CODE_INT:
- format = format ? format : output_format;
- if (format)
- {
- print_scalar_formatted (valaddr, type, format, 0, stream);
- }
- else
- {
- val_print_type_code_int (type, valaddr, stream);
- }
- break;
-
- case TYPE_CODE_CHAR:
- format = format ? format : output_format;
- if (format)
- {
- print_scalar_formatted (valaddr, type, format, 0, stream);
- }
- else
- {
- LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
- stream);
- }
- break;
-
- case TYPE_CODE_FLT:
- if (format)
- {
- print_scalar_formatted (valaddr, type, format, 0, stream);
- }
- else
- {
- print_floating (valaddr, type, stream);
- }
- break;
-
- case TYPE_CODE_BOOL:
- format = format ? format : output_format;
- if (format)
- {
- print_scalar_formatted (valaddr, type, format, 0, stream);
- }
- else
- {
- /* FIXME: Why is this using builtin_type_chill_bool not type? */
- val = unpack_long (builtin_type_chill_bool, valaddr);
- fprintf_filtered (stream, val ? "TRUE" : "FALSE");
- }
- break;
-
- case TYPE_CODE_UNDEF:
- /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
- dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
- and no complete type for struct foo in that file. */
- fprintf_filtered (stream, "<incomplete type>");
- break;
-
- case TYPE_CODE_PTR:
- if (format && format != 's')
- {
- print_scalar_formatted (valaddr, type, format, 0, stream);
- break;
- }
- addr = unpack_pointer (type, valaddr);
- elttype = check_typedef (TYPE_TARGET_TYPE (type));
-
- /* We assume a NULL pointer is all zeros ... */
- if (addr == 0)
- {
- fputs_filtered ("NULL", stream);
- return 0;
- }
-
- if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
- {
- /* Try to print what function it points to. */
- print_address_demangle (addr, stream, demangle);
- /* Return value is irrelevant except for string pointers. */
- return (0);
- }
- if (addressprint && format != 's')
- {
- print_address_numeric (addr, 1, stream);
- }
-
- /* For a pointer to char or unsigned char, also print the string
- pointed to, unless pointer is null. */
- if (TYPE_LENGTH (elttype) == 1
- && TYPE_CODE (elttype) == TYPE_CODE_CHAR
- && (format == 0 || format == 's')
- && addr != 0
- && /* If print_max is UINT_MAX, the alloca below will fail.
- In that case don't try to print the string. */
- print_max < UINT_MAX)
- i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
-
- /* Return number of characters printed, plus one for the
- terminating null if we have "reached the end". */
- return (i + (print_max && i != print_max));
- break;
-
- case TYPE_CODE_STRING:
- i = TYPE_LENGTH (type);
- LA_PRINT_STRING (stream, valaddr, i, 1, 0);
- /* Return number of characters printed, plus one for the terminating
- null if we have "reached the end". */
- return (i + (print_max && i != print_max));
- break;
-
- case TYPE_CODE_BITSTRING:
- case TYPE_CODE_SET:
- elttype = TYPE_INDEX_TYPE (type);
- CHECK_TYPEDEF (elttype);
- if (TYPE_STUB (elttype))
- {
- fprintf_filtered (stream, "<incomplete type>");
- gdb_flush (stream);
- break;
- }
- {
- struct type *range = elttype;
- LONGEST low_bound, high_bound;
- int i;
- int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
- int need_comma = 0;
-
- if (is_bitstring)
- fputs_filtered ("B'", stream);
- else
- fputs_filtered ("[", stream);
-
- i = get_discrete_bounds (range, &low_bound, &high_bound);
- maybe_bad_bstring:
- if (i < 0)
- {
- fputs_filtered ("<error value>", stream);
- goto done;
- }
-
- for (i = low_bound; i <= high_bound; i++)
- {
- int element = value_bit_index (type, valaddr, i);
- if (element < 0)
- {
- i = element;
- goto maybe_bad_bstring;
- }
- if (is_bitstring)
- fprintf_filtered (stream, "%d", element);
- else if (element)
- {
- if (need_comma)
- fputs_filtered (", ", stream);
- chill_print_type_scalar (range, (LONGEST) i, stream);
- need_comma = 1;
-
- /* Look for a continuous range of true elements. */
- if (i + 1 <= high_bound && value_bit_index (type, valaddr, ++i))
- {
- int j = i; /* j is the upper bound so far of the range */
- fputs_filtered (":", stream);
- while (i + 1 <= high_bound
- && value_bit_index (type, valaddr, ++i))
- j = i;
- chill_print_type_scalar (range, (LONGEST) j, stream);
- }
- }
- }
- done:
- if (is_bitstring)
- fputs_filtered ("'", stream);
- else
- fputs_filtered ("]", stream);
- }
- break;
-
- case TYPE_CODE_STRUCT:
- if (chill_varying_type (type))
- {
- struct type *inner = check_typedef (TYPE_FIELD_TYPE (type, 1));
- long length = unpack_long (TYPE_FIELD_TYPE (type, 0), valaddr);
- char *data_addr = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
-
- switch (TYPE_CODE (inner))
- {
- case TYPE_CODE_STRING:
- if (length > TYPE_LENGTH (type) - 2)
- {
- fprintf_filtered (stream,
- "<dynamic length %ld > static length %d> *invalid*",
- length, TYPE_LENGTH (type));
-
- /* Don't print the string; doing so might produce a
- segfault. */
- return length;
- }
- LA_PRINT_STRING (stream, data_addr, length, 1, 0);
- return length;
- default:
- break;
- }
- }
- chill_print_value_fields (type, valaddr, stream, format, recurse, pretty,
- 0);
- break;
-
- case TYPE_CODE_REF:
- if (addressprint)
- {
- fprintf_filtered (stream, "LOC(");
- print_address_numeric
- (extract_address (valaddr, TARGET_PTR_BIT / HOST_CHAR_BIT),
- 1,
- stream);
- fprintf_filtered (stream, ")");
- if (deref_ref)
- fputs_filtered (": ", stream);
- }
- /* De-reference the reference. */
- if (deref_ref)
- {
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_UNDEF)
- {
- struct value *deref_val =
- value_at
- (TYPE_TARGET_TYPE (type),
- unpack_pointer (lookup_pointer_type (builtin_type_void),
- valaddr),
- NULL);
- val_print (VALUE_TYPE (deref_val),
- VALUE_CONTENTS (deref_val),
- 0,
- VALUE_ADDRESS (deref_val), stream, format,
- deref_ref, recurse + 1, pretty);
- }
- else
- fputs_filtered ("???", stream);
- }
- break;
-
- case TYPE_CODE_ENUM:
- c_val_print (type, valaddr, 0, address, stream, format,
- deref_ref, recurse, pretty);
- break;
-
- case TYPE_CODE_RANGE:
- if (TYPE_TARGET_TYPE (type))
- chill_val_print (TYPE_TARGET_TYPE (type), valaddr, 0, address, stream,
- format, deref_ref, recurse, pretty);
- break;
-
- case TYPE_CODE_MEMBER:
- case TYPE_CODE_UNION:
- case TYPE_CODE_FUNC:
- case TYPE_CODE_VOID:
- case TYPE_CODE_ERROR:
- default:
- /* Let's defer printing to the C printer, rather than
- print an error message. FIXME! */
- c_val_print (type, valaddr, 0, address, stream, format,
- deref_ref, recurse, pretty);
- }
- gdb_flush (stream);
- return (0);
-}
-
-/* Mutually recursive subroutines of cplus_print_value and c_val_print to
- print out a structure's fields: cp_print_value_fields and cplus_print_value.
-
- TYPE, VALADDR, STREAM, RECURSE, and PRETTY have the
- same meanings as in cplus_print_value and c_val_print.
-
- DONT_PRINT is an array of baseclass types that we
- should not print, or zero if called from top level. */
-
-static void
-chill_print_value_fields (struct type *type, char *valaddr,
- struct ui_file *stream, int format, int recurse,
- enum val_prettyprint pretty, struct type **dont_print)
-{
- int i, len;
- int fields_seen = 0;
-
- CHECK_TYPEDEF (type);
-
- fprintf_filtered (stream, "[");
- len = TYPE_NFIELDS (type);
- if (len == 0)
- {
- fprintf_filtered (stream, "<No data fields>");
- }
- else
- {
- for (i = 0; i < len; i++)
- {
- if (fields_seen)
- {
- fprintf_filtered (stream, ", ");
- }
- fields_seen = 1;
- if (pretty)
- {
- fprintf_filtered (stream, "\n");
- print_spaces_filtered (2 + 2 * recurse, stream);
- }
- else
- {
- wrap_here (n_spaces (2 + 2 * recurse));
- }
- fputs_filtered (".", stream);
- fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
- language_chill, DMGL_NO_OPTS);
- fputs_filtered (": ", stream);
- if (TYPE_FIELD_PACKED (type, i))
- {
- struct value *v;
-
- /* Bitfields require special handling, especially due to byte
- order problems. */
- v = value_from_longest (TYPE_FIELD_TYPE (type, i),
- unpack_field_as_long (type, valaddr, i));
-
- chill_val_print (TYPE_FIELD_TYPE (type, i), VALUE_CONTENTS (v), 0, 0,
- stream, format, 0, recurse + 1, pretty);
- }
- else
- {
- chill_val_print (TYPE_FIELD_TYPE (type, i),
- valaddr + TYPE_FIELD_BITPOS (type, i) / 8, 0,
- 0, stream, format, 0, recurse + 1, pretty);
- }
- }
- if (pretty)
- {
- fprintf_filtered (stream, "\n");
- print_spaces_filtered (2 * recurse, stream);
- }
- }
- fprintf_filtered (stream, "]");
-}
-\f
-int
-chill_value_print (struct value *val, struct ui_file *stream, int format,
- enum val_prettyprint pretty)
-{
- struct type *type = VALUE_TYPE (val);
- struct type *real_type = check_typedef (type);
-
- /* If it is a pointer, indicate what it points to.
-
- Print type also if it is a reference. */
-
- if (TYPE_CODE (real_type) == TYPE_CODE_PTR ||
- TYPE_CODE (real_type) == TYPE_CODE_REF)
- {
- char *valaddr = VALUE_CONTENTS (val);
- CORE_ADDR addr = unpack_pointer (type, valaddr);
- if (TYPE_CODE (type) != TYPE_CODE_PTR || addr != 0)
- {
- int i;
- char *name = TYPE_NAME (type);
- if (name)
- fputs_filtered (name, stream);
- else if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
- fputs_filtered ("PTR", stream);
- else
- {
- fprintf_filtered (stream, "(");
- type_print (type, "", stream, -1);
- fprintf_filtered (stream, ")");
- }
- fprintf_filtered (stream, "(");
- i = val_print (type, valaddr, 0, VALUE_ADDRESS (val),
- stream, format, 1, 0, pretty);
- fprintf_filtered (stream, ")");
- return i;
- }
- }
- return (val_print (type, VALUE_CONTENTS (val), 0,
- VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
-}
+// OBSOLETE /* Support for printing Chill values for GDB, the GNU debugger.
+// OBSOLETE Copyright 1986, 1988, 1989, 1991, 1992, 1993, 1994, 1995, 1996, 1997,
+// OBSOLETE 1998, 2000, 2001
+// OBSOLETE Free Software Foundation, Inc.
+// OBSOLETE
+// OBSOLETE This file is part of GDB.
+// OBSOLETE
+// OBSOLETE This program is free software; you can redistribute it and/or modify
+// OBSOLETE it under the terms of the GNU General Public License as published by
+// OBSOLETE the Free Software Foundation; either version 2 of the License, or
+// OBSOLETE (at your option) any later version.
+// OBSOLETE
+// OBSOLETE This program is distributed in the hope that it will be useful,
+// OBSOLETE but WITHOUT ANY WARRANTY; without even the implied warranty of
+// OBSOLETE MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// OBSOLETE GNU General Public License for more details.
+// OBSOLETE
+// OBSOLETE You should have received a copy of the GNU General Public License
+// OBSOLETE along with this program; if not, write to the Free Software
+// OBSOLETE Foundation, Inc., 59 Temple Place - Suite 330,
+// OBSOLETE Boston, MA 02111-1307, USA. */
+// OBSOLETE
+// OBSOLETE #include "defs.h"
+// OBSOLETE #include "gdb_obstack.h"
+// OBSOLETE #include "symtab.h"
+// OBSOLETE #include "gdbtypes.h"
+// OBSOLETE #include "valprint.h"
+// OBSOLETE #include "expression.h"
+// OBSOLETE #include "value.h"
+// OBSOLETE #include "language.h"
+// OBSOLETE #include "demangle.h"
+// OBSOLETE #include "c-lang.h" /* For c_val_print */
+// OBSOLETE #include "typeprint.h"
+// OBSOLETE #include "ch-lang.h"
+// OBSOLETE #include "annotate.h"
+// OBSOLETE
+// OBSOLETE static void chill_print_value_fields (struct type *, char *,
+// OBSOLETE struct ui_file *, int, int,
+// OBSOLETE enum val_prettyprint, struct type **);
+// OBSOLETE
+// OBSOLETE static void chill_print_type_scalar (struct type *, LONGEST,
+// OBSOLETE struct ui_file *);
+// OBSOLETE
+// OBSOLETE static void chill_val_print_array_elements (struct type *, char *,
+// OBSOLETE CORE_ADDR, struct ui_file *,
+// OBSOLETE int, int, int,
+// OBSOLETE enum val_prettyprint);
+// OBSOLETE \f
+// OBSOLETE
+// OBSOLETE /* Print integral scalar data VAL, of type TYPE, onto stdio stream STREAM.
+// OBSOLETE Used to print data from type structures in a specified type. For example,
+// OBSOLETE array bounds may be characters or booleans in some languages, and this
+// OBSOLETE allows the ranges to be printed in their "natural" form rather than as
+// OBSOLETE decimal integer values. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE chill_print_type_scalar (struct type *type, LONGEST val, struct ui_file *stream)
+// OBSOLETE {
+// OBSOLETE switch (TYPE_CODE (type))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_RANGE:
+// OBSOLETE if (TYPE_TARGET_TYPE (type))
+// OBSOLETE {
+// OBSOLETE chill_print_type_scalar (TYPE_TARGET_TYPE (type), val, stream);
+// OBSOLETE return;
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE case TYPE_CODE_UNDEF:
+// OBSOLETE case TYPE_CODE_PTR:
+// OBSOLETE case TYPE_CODE_ARRAY:
+// OBSOLETE case TYPE_CODE_STRUCT:
+// OBSOLETE case TYPE_CODE_UNION:
+// OBSOLETE case TYPE_CODE_ENUM:
+// OBSOLETE case TYPE_CODE_FUNC:
+// OBSOLETE case TYPE_CODE_INT:
+// OBSOLETE case TYPE_CODE_FLT:
+// OBSOLETE case TYPE_CODE_VOID:
+// OBSOLETE case TYPE_CODE_SET:
+// OBSOLETE case TYPE_CODE_STRING:
+// OBSOLETE case TYPE_CODE_BITSTRING:
+// OBSOLETE case TYPE_CODE_ERROR:
+// OBSOLETE case TYPE_CODE_MEMBER:
+// OBSOLETE case TYPE_CODE_METHOD:
+// OBSOLETE case TYPE_CODE_REF:
+// OBSOLETE case TYPE_CODE_CHAR:
+// OBSOLETE case TYPE_CODE_BOOL:
+// OBSOLETE case TYPE_CODE_COMPLEX:
+// OBSOLETE case TYPE_CODE_TYPEDEF:
+// OBSOLETE default:
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE print_type_scalar (type, val, stream);
+// OBSOLETE }
+// OBSOLETE \f
+// OBSOLETE /* Print the elements of an array.
+// OBSOLETE Similar to val_print_array_elements, but prints
+// OBSOLETE element indexes (in Chill syntax). */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE chill_val_print_array_elements (struct type *type, char *valaddr,
+// OBSOLETE CORE_ADDR address, struct ui_file *stream,
+// OBSOLETE int format, int deref_ref, int recurse,
+// OBSOLETE enum val_prettyprint pretty)
+// OBSOLETE {
+// OBSOLETE unsigned int i = 0;
+// OBSOLETE unsigned int things_printed = 0;
+// OBSOLETE unsigned len;
+// OBSOLETE struct type *elttype;
+// OBSOLETE struct type *range_type = TYPE_FIELD_TYPE (type, 0);
+// OBSOLETE struct type *index_type = TYPE_TARGET_TYPE (range_type);
+// OBSOLETE unsigned eltlen;
+// OBSOLETE /* Position of the array element we are examining to see
+// OBSOLETE whether it is repeated. */
+// OBSOLETE unsigned int rep1;
+// OBSOLETE /* Number of repetitions we have detected so far. */
+// OBSOLETE unsigned int reps;
+// OBSOLETE LONGEST low_bound = TYPE_FIELD_BITPOS (range_type, 0);
+// OBSOLETE
+// OBSOLETE elttype = check_typedef (TYPE_TARGET_TYPE (type));
+// OBSOLETE eltlen = TYPE_LENGTH (elttype);
+// OBSOLETE len = TYPE_LENGTH (type) / eltlen;
+// OBSOLETE
+// OBSOLETE annotate_array_section_begin (i, elttype);
+// OBSOLETE
+// OBSOLETE for (; i < len && things_printed < print_max; i++)
+// OBSOLETE {
+// OBSOLETE if (i != 0)
+// OBSOLETE {
+// OBSOLETE if (prettyprint_arrays)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, ",\n");
+// OBSOLETE print_spaces_filtered (2 + 2 * recurse, stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, ", ");
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE wrap_here (n_spaces (2 + 2 * recurse));
+// OBSOLETE
+// OBSOLETE rep1 = i + 1;
+// OBSOLETE reps = 1;
+// OBSOLETE while ((rep1 < len) &&
+// OBSOLETE !memcmp (valaddr + i * eltlen, valaddr + rep1 * eltlen, eltlen))
+// OBSOLETE {
+// OBSOLETE ++reps;
+// OBSOLETE ++rep1;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE fputs_filtered ("(", stream);
+// OBSOLETE chill_print_type_scalar (index_type, low_bound + i, stream);
+// OBSOLETE if (reps > 1)
+// OBSOLETE {
+// OBSOLETE fputs_filtered (":", stream);
+// OBSOLETE chill_print_type_scalar (index_type, low_bound + i + reps - 1,
+// OBSOLETE stream);
+// OBSOLETE fputs_filtered ("): ", stream);
+// OBSOLETE val_print (elttype, valaddr + i * eltlen, 0, 0, stream, format,
+// OBSOLETE deref_ref, recurse + 1, pretty);
+// OBSOLETE
+// OBSOLETE i = rep1 - 1;
+// OBSOLETE things_printed += 1;
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("): ", stream);
+// OBSOLETE val_print (elttype, valaddr + i * eltlen, 0, 0, stream, format,
+// OBSOLETE deref_ref, recurse + 1, pretty);
+// OBSOLETE annotate_elt ();
+// OBSOLETE things_printed++;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE annotate_array_section_end ();
+// OBSOLETE if (i < len)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "...");
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Print data of type TYPE located at VALADDR (within GDB), which came from
+// OBSOLETE the inferior at address ADDRESS, onto stdio stream STREAM according to
+// OBSOLETE FORMAT (a letter or 0 for natural format). The data at VALADDR is in
+// OBSOLETE target byte order.
+// OBSOLETE
+// OBSOLETE If the data are a string pointer, returns the number of string characters
+// OBSOLETE printed.
+// OBSOLETE
+// OBSOLETE If DEREF_REF is nonzero, then dereference references, otherwise just print
+// OBSOLETE them like pointers.
+// OBSOLETE
+// OBSOLETE The PRETTY parameter controls prettyprinting. */
+// OBSOLETE
+// OBSOLETE int
+// OBSOLETE chill_val_print (struct type *type, char *valaddr, int embedded_offset,
+// OBSOLETE CORE_ADDR address, struct ui_file *stream, int format,
+// OBSOLETE int deref_ref, int recurse, enum val_prettyprint pretty)
+// OBSOLETE {
+// OBSOLETE LONGEST val;
+// OBSOLETE unsigned int i = 0; /* Number of characters printed. */
+// OBSOLETE struct type *elttype;
+// OBSOLETE CORE_ADDR addr;
+// OBSOLETE
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE
+// OBSOLETE switch (TYPE_CODE (type))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_ARRAY:
+// OBSOLETE if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
+// OBSOLETE {
+// OBSOLETE if (prettyprint_arrays)
+// OBSOLETE {
+// OBSOLETE print_spaces_filtered (2 + 2 * recurse, stream);
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, "[");
+// OBSOLETE chill_val_print_array_elements (type, valaddr, address, stream,
+// OBSOLETE format, deref_ref, recurse, pretty);
+// OBSOLETE fprintf_filtered (stream, "]");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE error ("unimplemented in chill_val_print; unspecified array length");
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_INT:
+// OBSOLETE format = format ? format : output_format;
+// OBSOLETE if (format)
+// OBSOLETE {
+// OBSOLETE print_scalar_formatted (valaddr, type, format, 0, stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE val_print_type_code_int (type, valaddr, stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_CHAR:
+// OBSOLETE format = format ? format : output_format;
+// OBSOLETE if (format)
+// OBSOLETE {
+// OBSOLETE print_scalar_formatted (valaddr, type, format, 0, stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
+// OBSOLETE stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_FLT:
+// OBSOLETE if (format)
+// OBSOLETE {
+// OBSOLETE print_scalar_formatted (valaddr, type, format, 0, stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE print_floating (valaddr, type, stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_BOOL:
+// OBSOLETE format = format ? format : output_format;
+// OBSOLETE if (format)
+// OBSOLETE {
+// OBSOLETE print_scalar_formatted (valaddr, type, format, 0, stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE /* FIXME: Why is this using builtin_type_chill_bool not type? */
+// OBSOLETE val = unpack_long (builtin_type_chill_bool, valaddr);
+// OBSOLETE fprintf_filtered (stream, val ? "TRUE" : "FALSE");
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_UNDEF:
+// OBSOLETE /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
+// OBSOLETE dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
+// OBSOLETE and no complete type for struct foo in that file. */
+// OBSOLETE fprintf_filtered (stream, "<incomplete type>");
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_PTR:
+// OBSOLETE if (format && format != 's')
+// OBSOLETE {
+// OBSOLETE print_scalar_formatted (valaddr, type, format, 0, stream);
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE addr = unpack_pointer (type, valaddr);
+// OBSOLETE elttype = check_typedef (TYPE_TARGET_TYPE (type));
+// OBSOLETE
+// OBSOLETE /* We assume a NULL pointer is all zeros ... */
+// OBSOLETE if (addr == 0)
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("NULL", stream);
+// OBSOLETE return 0;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
+// OBSOLETE {
+// OBSOLETE /* Try to print what function it points to. */
+// OBSOLETE print_address_demangle (addr, stream, demangle);
+// OBSOLETE /* Return value is irrelevant except for string pointers. */
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE if (addressprint && format != 's')
+// OBSOLETE {
+// OBSOLETE print_address_numeric (addr, 1, stream);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* For a pointer to char or unsigned char, also print the string
+// OBSOLETE pointed to, unless pointer is null. */
+// OBSOLETE if (TYPE_LENGTH (elttype) == 1
+// OBSOLETE && TYPE_CODE (elttype) == TYPE_CODE_CHAR
+// OBSOLETE && (format == 0 || format == 's')
+// OBSOLETE && addr != 0
+// OBSOLETE && /* If print_max is UINT_MAX, the alloca below will fail.
+// OBSOLETE In that case don't try to print the string. */
+// OBSOLETE print_max < UINT_MAX)
+// OBSOLETE i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
+// OBSOLETE
+// OBSOLETE /* Return number of characters printed, plus one for the
+// OBSOLETE terminating null if we have "reached the end". */
+// OBSOLETE return (i + (print_max && i != print_max));
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_STRING:
+// OBSOLETE i = TYPE_LENGTH (type);
+// OBSOLETE LA_PRINT_STRING (stream, valaddr, i, 1, 0);
+// OBSOLETE /* Return number of characters printed, plus one for the terminating
+// OBSOLETE null if we have "reached the end". */
+// OBSOLETE return (i + (print_max && i != print_max));
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_BITSTRING:
+// OBSOLETE case TYPE_CODE_SET:
+// OBSOLETE elttype = TYPE_INDEX_TYPE (type);
+// OBSOLETE CHECK_TYPEDEF (elttype);
+// OBSOLETE if (TYPE_STUB (elttype))
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "<incomplete type>");
+// OBSOLETE gdb_flush (stream);
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE {
+// OBSOLETE struct type *range = elttype;
+// OBSOLETE LONGEST low_bound, high_bound;
+// OBSOLETE int i;
+// OBSOLETE int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
+// OBSOLETE int need_comma = 0;
+// OBSOLETE
+// OBSOLETE if (is_bitstring)
+// OBSOLETE fputs_filtered ("B'", stream);
+// OBSOLETE else
+// OBSOLETE fputs_filtered ("[", stream);
+// OBSOLETE
+// OBSOLETE i = get_discrete_bounds (range, &low_bound, &high_bound);
+// OBSOLETE maybe_bad_bstring:
+// OBSOLETE if (i < 0)
+// OBSOLETE {
+// OBSOLETE fputs_filtered ("<error value>", stream);
+// OBSOLETE goto done;
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE for (i = low_bound; i <= high_bound; i++)
+// OBSOLETE {
+// OBSOLETE int element = value_bit_index (type, valaddr, i);
+// OBSOLETE if (element < 0)
+// OBSOLETE {
+// OBSOLETE i = element;
+// OBSOLETE goto maybe_bad_bstring;
+// OBSOLETE }
+// OBSOLETE if (is_bitstring)
+// OBSOLETE fprintf_filtered (stream, "%d", element);
+// OBSOLETE else if (element)
+// OBSOLETE {
+// OBSOLETE if (need_comma)
+// OBSOLETE fputs_filtered (", ", stream);
+// OBSOLETE chill_print_type_scalar (range, (LONGEST) i, stream);
+// OBSOLETE need_comma = 1;
+// OBSOLETE
+// OBSOLETE /* Look for a continuous range of true elements. */
+// OBSOLETE if (i + 1 <= high_bound && value_bit_index (type, valaddr, ++i))
+// OBSOLETE {
+// OBSOLETE int j = i; /* j is the upper bound so far of the range */
+// OBSOLETE fputs_filtered (":", stream);
+// OBSOLETE while (i + 1 <= high_bound
+// OBSOLETE && value_bit_index (type, valaddr, ++i))
+// OBSOLETE j = i;
+// OBSOLETE chill_print_type_scalar (range, (LONGEST) j, stream);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE done:
+// OBSOLETE if (is_bitstring)
+// OBSOLETE fputs_filtered ("'", stream);
+// OBSOLETE else
+// OBSOLETE fputs_filtered ("]", stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_STRUCT:
+// OBSOLETE if (chill_varying_type (type))
+// OBSOLETE {
+// OBSOLETE struct type *inner = check_typedef (TYPE_FIELD_TYPE (type, 1));
+// OBSOLETE long length = unpack_long (TYPE_FIELD_TYPE (type, 0), valaddr);
+// OBSOLETE char *data_addr = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
+// OBSOLETE
+// OBSOLETE switch (TYPE_CODE (inner))
+// OBSOLETE {
+// OBSOLETE case TYPE_CODE_STRING:
+// OBSOLETE if (length > TYPE_LENGTH (type) - 2)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream,
+// OBSOLETE "<dynamic length %ld > static length %d> *invalid*",
+// OBSOLETE length, TYPE_LENGTH (type));
+// OBSOLETE
+// OBSOLETE /* Don't print the string; doing so might produce a
+// OBSOLETE segfault. */
+// OBSOLETE return length;
+// OBSOLETE }
+// OBSOLETE LA_PRINT_STRING (stream, data_addr, length, 1, 0);
+// OBSOLETE return length;
+// OBSOLETE default:
+// OBSOLETE break;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE chill_print_value_fields (type, valaddr, stream, format, recurse, pretty,
+// OBSOLETE 0);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_REF:
+// OBSOLETE if (addressprint)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "LOC(");
+// OBSOLETE print_address_numeric
+// OBSOLETE (extract_address (valaddr, TARGET_PTR_BIT / HOST_CHAR_BIT),
+// OBSOLETE 1,
+// OBSOLETE stream);
+// OBSOLETE fprintf_filtered (stream, ")");
+// OBSOLETE if (deref_ref)
+// OBSOLETE fputs_filtered (": ", stream);
+// OBSOLETE }
+// OBSOLETE /* De-reference the reference. */
+// OBSOLETE if (deref_ref)
+// OBSOLETE {
+// OBSOLETE if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_UNDEF)
+// OBSOLETE {
+// OBSOLETE struct value *deref_val =
+// OBSOLETE value_at
+// OBSOLETE (TYPE_TARGET_TYPE (type),
+// OBSOLETE unpack_pointer (lookup_pointer_type (builtin_type_void),
+// OBSOLETE valaddr),
+// OBSOLETE NULL);
+// OBSOLETE val_print (VALUE_TYPE (deref_val),
+// OBSOLETE VALUE_CONTENTS (deref_val),
+// OBSOLETE 0,
+// OBSOLETE VALUE_ADDRESS (deref_val), stream, format,
+// OBSOLETE deref_ref, recurse + 1, pretty);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE fputs_filtered ("???", stream);
+// OBSOLETE }
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_ENUM:
+// OBSOLETE c_val_print (type, valaddr, 0, address, stream, format,
+// OBSOLETE deref_ref, recurse, pretty);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_RANGE:
+// OBSOLETE if (TYPE_TARGET_TYPE (type))
+// OBSOLETE chill_val_print (TYPE_TARGET_TYPE (type), valaddr, 0, address, stream,
+// OBSOLETE format, deref_ref, recurse, pretty);
+// OBSOLETE break;
+// OBSOLETE
+// OBSOLETE case TYPE_CODE_MEMBER:
+// OBSOLETE case TYPE_CODE_UNION:
+// OBSOLETE case TYPE_CODE_FUNC:
+// OBSOLETE case TYPE_CODE_VOID:
+// OBSOLETE case TYPE_CODE_ERROR:
+// OBSOLETE default:
+// OBSOLETE /* Let's defer printing to the C printer, rather than
+// OBSOLETE print an error message. FIXME! */
+// OBSOLETE c_val_print (type, valaddr, 0, address, stream, format,
+// OBSOLETE deref_ref, recurse, pretty);
+// OBSOLETE }
+// OBSOLETE gdb_flush (stream);
+// OBSOLETE return (0);
+// OBSOLETE }
+// OBSOLETE
+// OBSOLETE /* Mutually recursive subroutines of cplus_print_value and c_val_print to
+// OBSOLETE print out a structure's fields: cp_print_value_fields and cplus_print_value.
+// OBSOLETE
+// OBSOLETE TYPE, VALADDR, STREAM, RECURSE, and PRETTY have the
+// OBSOLETE same meanings as in cplus_print_value and c_val_print.
+// OBSOLETE
+// OBSOLETE DONT_PRINT is an array of baseclass types that we
+// OBSOLETE should not print, or zero if called from top level. */
+// OBSOLETE
+// OBSOLETE static void
+// OBSOLETE chill_print_value_fields (struct type *type, char *valaddr,
+// OBSOLETE struct ui_file *stream, int format, int recurse,
+// OBSOLETE enum val_prettyprint pretty, struct type **dont_print)
+// OBSOLETE {
+// OBSOLETE int i, len;
+// OBSOLETE int fields_seen = 0;
+// OBSOLETE
+// OBSOLETE CHECK_TYPEDEF (type);
+// OBSOLETE
+// OBSOLETE fprintf_filtered (stream, "[");
+// OBSOLETE len = TYPE_NFIELDS (type);
+// OBSOLETE if (len == 0)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "<No data fields>");
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE for (i = 0; i < len; i++)
+// OBSOLETE {
+// OBSOLETE if (fields_seen)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, ", ");
+// OBSOLETE }
+// OBSOLETE fields_seen = 1;
+// OBSOLETE if (pretty)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "\n");
+// OBSOLETE print_spaces_filtered (2 + 2 * recurse, stream);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE wrap_here (n_spaces (2 + 2 * recurse));
+// OBSOLETE }
+// OBSOLETE fputs_filtered (".", stream);
+// OBSOLETE fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
+// OBSOLETE language_chill, DMGL_NO_OPTS);
+// OBSOLETE fputs_filtered (": ", stream);
+// OBSOLETE if (TYPE_FIELD_PACKED (type, i))
+// OBSOLETE {
+// OBSOLETE struct value *v;
+// OBSOLETE
+// OBSOLETE /* Bitfields require special handling, especially due to byte
+// OBSOLETE order problems. */
+// OBSOLETE v = value_from_longest (TYPE_FIELD_TYPE (type, i),
+// OBSOLETE unpack_field_as_long (type, valaddr, i));
+// OBSOLETE
+// OBSOLETE chill_val_print (TYPE_FIELD_TYPE (type, i), VALUE_CONTENTS (v), 0, 0,
+// OBSOLETE stream, format, 0, recurse + 1, pretty);
+// OBSOLETE }
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE chill_val_print (TYPE_FIELD_TYPE (type, i),
+// OBSOLETE valaddr + TYPE_FIELD_BITPOS (type, i) / 8, 0,
+// OBSOLETE 0, stream, format, 0, recurse + 1, pretty);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE if (pretty)
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "\n");
+// OBSOLETE print_spaces_filtered (2 * recurse, stream);
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, "]");
+// OBSOLETE }
+// OBSOLETE \f
+// OBSOLETE int
+// OBSOLETE chill_value_print (struct value *val, struct ui_file *stream, int format,
+// OBSOLETE enum val_prettyprint pretty)
+// OBSOLETE {
+// OBSOLETE struct type *type = VALUE_TYPE (val);
+// OBSOLETE struct type *real_type = check_typedef (type);
+// OBSOLETE
+// OBSOLETE /* If it is a pointer, indicate what it points to.
+// OBSOLETE
+// OBSOLETE Print type also if it is a reference. */
+// OBSOLETE
+// OBSOLETE if (TYPE_CODE (real_type) == TYPE_CODE_PTR ||
+// OBSOLETE TYPE_CODE (real_type) == TYPE_CODE_REF)
+// OBSOLETE {
+// OBSOLETE char *valaddr = VALUE_CONTENTS (val);
+// OBSOLETE CORE_ADDR addr = unpack_pointer (type, valaddr);
+// OBSOLETE if (TYPE_CODE (type) != TYPE_CODE_PTR || addr != 0)
+// OBSOLETE {
+// OBSOLETE int i;
+// OBSOLETE char *name = TYPE_NAME (type);
+// OBSOLETE if (name)
+// OBSOLETE fputs_filtered (name, stream);
+// OBSOLETE else if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
+// OBSOLETE fputs_filtered ("PTR", stream);
+// OBSOLETE else
+// OBSOLETE {
+// OBSOLETE fprintf_filtered (stream, "(");
+// OBSOLETE type_print (type, "", stream, -1);
+// OBSOLETE fprintf_filtered (stream, ")");
+// OBSOLETE }
+// OBSOLETE fprintf_filtered (stream, "(");
+// OBSOLETE i = val_print (type, valaddr, 0, VALUE_ADDRESS (val),
+// OBSOLETE stream, format, 1, 0, pretty);
+// OBSOLETE fprintf_filtered (stream, ")");
+// OBSOLETE return i;
+// OBSOLETE }
+// OBSOLETE }
+// OBSOLETE return (val_print (type, VALUE_CONTENTS (val), 0,
+// OBSOLETE VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
+// OBSOLETE }
language_c, /* C */
language_cplus, /* C++ */
language_java, /* Java */
- language_chill, /* Chill */
+ /* OBSOLETE language_chill, */ /* Chill */
language_fortran, /* Fortran */
language_m2, /* Modula-2 */
language_asm, /* Assembly language */
extern int inside_main_func (CORE_ADDR pc);
-/* From ch-lang.c, for the moment. (FIXME) */
+/* OBSOLETE From ch-lang.c, for the moment. (FIXME) */
-extern char *chill_demangle (const char *);
+/* OBSOLETE extern char *chill_demangle (const char *); */
/* From utils.c */
+2002-08-01 Andrew Cagney <cagney@redhat.com>
+
+ * stabs.texinfo, gdb.texinfo, gdbint.texinfo: Obsolete references
+ to CHILL.
+
2002-08-01 Andrew Cagney <ac131313@redhat.com>
* gdbint.texinfo (Coding): Revise section "Include Files".
For more information, see @ref{Support,,Supported languages}.
For more information, see @ref{C,,C and C++}.
-@cindex Chill
+@c OBSOLETE @cindex Chill
@cindex Modula-2
-Support for Modula-2 and Chill is partial. For information on Modula-2,
-see @ref{Modula-2,,Modula-2}. For information on Chill, see @ref{Chill}.
+Support for Modula-2
+@c OBSOLETE and Chill
+is partial. For information on Modula-2, see @ref{Modula-2,,Modula-2}.
+@c OBSOLETE For information on Chill, see @ref{Chill}.
@cindex Pascal
Debugging Pascal programs which use sets, subranges, file variables, or
@itemx .F
Fortran source file
-@item .ch
-@itemx .c186
-@itemx .c286
-CHILL source file
+@c OBSOLETE @item .ch
+@c OBSOLETE @itemx .c186
+@c OBSOLETE @itemx .c286
+@c OBSOLETE CHILL source file
@item .mod
Modula-2 source file
@node Support
@section Supported languages
-@value{GDBN} supports C, C@t{++}, Fortran, Java, Chill, assembly, and Modula-2.
+@value{GDBN} supports C, C@t{++}, Fortran, Java,
+@c OBSOLETE Chill,
+assembly, and Modula-2.
@c This is false ...
Some @value{GDBN} features may be used in expressions regardless of the
language you use: the @value{GDBN} @code{@@} and @code{::} operators,
@menu
* C:: C and C@t{++}
* Modula-2:: Modula-2
-* Chill:: Chill
+@c OBSOLETE * Chill:: Chill
@end menu
@node C
In @value{GDBN} scripts, the Modula-2 inequality operator @code{#} is
interpreted as the beginning of a comment. Use @code{<>} instead.
-@node Chill
-@subsection Chill
-
-The extensions made to @value{GDBN} to support Chill only support output
-from the @sc{gnu} Chill compiler. Other Chill compilers are not currently
-supported, and attempting to debug executables produced by them is most
-likely to give an error as @value{GDBN} reads in the executable's symbol
-table.
-
-@c This used to say "... following Chill related topics ...", but since
-@c menus are not shown in the printed manual, it would look awkward.
-This section covers the Chill related topics and the features
-of @value{GDBN} which support these topics.
-
-@menu
-* How modes are displayed:: How modes are displayed
-* Locations:: Locations and their accesses
-* Values and their Operations:: Values and their Operations
-* Chill type and range checks::
-* Chill defaults::
-@end menu
-
-@node How modes are displayed
-@subsubsection How modes are displayed
-
-The Chill Datatype- (Mode) support of @value{GDBN} is directly related
-with the functionality of the @sc{gnu} Chill compiler, and therefore deviates
-slightly from the standard specification of the Chill language. The
-provided modes are:
-
-@c FIXME: this @table's contents effectively disable @code by using @r
-@c on every @item. So why does it need @code?
-@table @code
-@item @r{@emph{Discrete modes:}}
-@itemize @bullet
-@item
-@emph{Integer Modes} which are predefined by @code{BYTE, UBYTE, INT,
-UINT, LONG, ULONG},
-@item
-@emph{Boolean Mode} which is predefined by @code{BOOL},
-@item
-@emph{Character Mode} which is predefined by @code{CHAR},
-@item
-@emph{Set Mode} which is displayed by the keyword @code{SET}.
-@smallexample
-(@value{GDBP}) ptype x
-type = SET (karli = 10, susi = 20, fritzi = 100)
-@end smallexample
-If the type is an unnumbered set the set element values are omitted.
-@item
-@emph{Range Mode} which is displayed by
-@smallexample
-@code{type = <basemode>(<lower bound> : <upper bound>)}
-@end smallexample
-where @code{<lower bound>, <upper bound>} can be of any discrete literal
-expression (e.g. set element names).
-@end itemize
-
-@item @r{@emph{Powerset Mode:}}
-A Powerset Mode is displayed by the keyword @code{POWERSET} followed by
-the member mode of the powerset. The member mode can be any discrete mode.
-@smallexample
-(@value{GDBP}) ptype x
-type = POWERSET SET (egon, hugo, otto)
-@end smallexample
-
-@item @r{@emph{Reference Modes:}}
-@itemize @bullet
-@item
-@emph{Bound Reference Mode} which is displayed by the keyword @code{REF}
-followed by the mode name to which the reference is bound.
-@item
-@emph{Free Reference Mode} which is displayed by the keyword @code{PTR}.
-@end itemize
-
-@item @r{@emph{Procedure mode}}
-The procedure mode is displayed by @code{type = PROC(<parameter list>)
-<return mode> EXCEPTIONS (<exception list>)}. The @code{<parameter
-list>} is a list of the parameter modes. @code{<return mode>} indicates
-the mode of the result of the procedure if any. The exceptionlist lists
-all possible exceptions which can be raised by the procedure.
-
-@ignore
-@item @r{@emph{Instance mode}}
-The instance mode is represented by a structure, which has a static
-type, and is therefore not really of interest.
-@end ignore
-
-@item @r{@emph{Synchronization Modes:}}
-@itemize @bullet
-@item
-@emph{Event Mode} which is displayed by
-@smallexample
-@code{EVENT (<event length>)}
-@end smallexample
-where @code{(<event length>)} is optional.
-@item
-@emph{Buffer Mode} which is displayed by
-@smallexample
-@code{BUFFER (<buffer length>)<buffer element mode>}
-@end smallexample
-where @code{(<buffer length>)} is optional.
-@end itemize
-
-@item @r{@emph{Timing Modes:}}
-@itemize @bullet
-@item
-@emph{Duration Mode} which is predefined by @code{DURATION}
-@item
-@emph{Absolute Time Mode} which is predefined by @code{TIME}
-@end itemize
-
-@item @r{@emph{Real Modes:}}
-Real Modes are predefined with @code{REAL} and @code{LONG_REAL}.
-
-@item @r{@emph{String Modes:}}
-@itemize @bullet
-@item
-@emph{Character String Mode} which is displayed by
-@smallexample
-@code{CHARS(<string length>)}
-@end smallexample
-followed by the keyword @code{VARYING} if the String Mode is a varying
-mode
-@item
-@emph{Bit String Mode} which is displayed by
-@smallexample
-@code{BOOLS(<string
-length>)}
-@end smallexample
-@end itemize
-
-@item @r{@emph{Array Mode:}}
-The Array Mode is displayed by the keyword @code{ARRAY(<range>)}
-followed by the element mode (which may in turn be an array mode).
-@smallexample
-(@value{GDBP}) ptype x
-type = ARRAY (1:42)
- ARRAY (1:20)
- SET (karli = 10, susi = 20, fritzi = 100)
-@end smallexample
-
-@item @r{@emph{Structure Mode}}
-The Structure mode is displayed by the keyword @code{STRUCT(<field
-list>)}. The @code{<field list>} consists of names and modes of fields
-of the structure. Variant structures have the keyword @code{CASE <field>
-OF <variant fields> ESAC} in their field list. Since the current version
-of the GNU Chill compiler doesn't implement tag processing (no runtime
-checks of variant fields, and therefore no debugging info), the output
-always displays all variant fields.
-@smallexample
-(@value{GDBP}) ptype str
-type = STRUCT (
- as x,
- bs x,
- CASE bs OF
- (karli):
- cs a
- (ott):
- ds x
- ESAC
-)
-@end smallexample
-@end table
-
-@node Locations
-@subsubsection Locations and their accesses
-
-A location in Chill is an object which can contain values.
-
-A value of a location is generally accessed by the (declared) name of
-the location. The output conforms to the specification of values in
-Chill programs. How values are specified
-is the topic of the next section, @ref{Values and their Operations}.
-
-The pseudo-location @code{RESULT} (or @code{result}) can be used to
-display or change the result of a currently-active procedure:
-
-@smallexample
-set result := EXPR
-@end smallexample
-
-@noindent
-This does the same as the Chill action @code{RESULT EXPR} (which
-is not available in @value{GDBN}).
-
-Values of reference mode locations are printed by @code{PTR(<hex
-value>)} in case of a free reference mode, and by @code{(REF <reference
-mode>) (<hex-value>)} in case of a bound reference. @code{<hex value>}
-represents the address where the reference points to. To access the
-value of the location referenced by the pointer, use the dereference
-operator @samp{->}.
-
-Values of procedure mode locations are displayed by
-@smallexample
-@code{@{ PROC
-(<argument modes> ) <return mode> @} <address> <name of procedure
-location>}
-@end smallexample
-@code{<argument modes>} is a list of modes according to the parameter
-specification of the procedure and @code{<address>} shows the address of
-the entry point.
-
-@ignore
-Locations of instance modes are displayed just like a structure with two
-fields specifying the @emph{process type} and the @emph{copy number} of
-the investigated instance location@footnote{This comes from the current
-implementation of instances. They are implemented as a structure (no
-na). The output should be something like @code{[<name of the process>;
-<instance number>]}.}. The field names are @code{__proc_type} and
-@code{__proc_copy}.
-
-Locations of synchronization modes are displayed like a structure with
-the field name @code{__event_data} in case of a event mode location, and
-like a structure with the field @code{__buffer_data} in case of a buffer
-mode location (refer to previous paragraph).
-
-Structure Mode locations are printed by @code{[.<field name>: <value>,
-...]}. The @code{<field name>} corresponds to the structure mode
-definition and the layout of @code{<value>} varies depending of the mode
-of the field. If the investigated structure mode location is of variant
-structure mode, the variant parts of the structure are enclosed in curled
-braces (@samp{@{@}}). Fields enclosed by @samp{@{,@}} are residing
-on the same memory location and represent the current values of the
-memory location in their specific modes. Since no tag processing is done
-all variants are displayed. A variant field is printed by
-@code{(<variant name>) = .<field name>: <value>}. (who implements the
-stuff ???)
-@smallexample
-(@value{GDBP}) print str1 $4 = [.as: 0, .bs: karli, .<TAG>: { (karli) =
-[.cs: []], (susi) = [.ds: susi]}]
-@end smallexample
-@end ignore
-
-Substructures of string mode-, array mode- or structure mode-values
-(e.g. array slices, fields of structure locations) are accessed using
-certain operations which are described in the next section, @ref{Values
-and their Operations}.
-
-A location value may be interpreted as having a different mode using the
-location conversion. This mode conversion is written as @code{<mode
-name>(<location>)}. The user has to consider that the sizes of the modes
-have to be equal otherwise an error occurs. Furthermore, no range
-checking of the location against the destination mode is performed, and
-therefore the result can be quite confusing.
-
-@smallexample
-(@value{GDBP}) print int (s(3 up 4)) XXX TO be filled in !! XXX
-@end smallexample
-
-@node Values and their Operations
-@subsubsection Values and their Operations
-
-Values are used to alter locations, to investigate complex structures in
-more detail or to filter relevant information out of a large amount of
-data. There are several (mode dependent) operations defined which enable
-such investigations. These operations are not only applicable to
-constant values but also to locations, which can become quite useful
-when debugging complex structures. During parsing the command line
-(e.g. evaluating an expression) @value{GDBN} treats location names as
-the values behind these locations.
-
-This section describes how values have to be specified and which
-operations are legal to be used with such values.
-
-@table @code
-@item Literal Values
-Literal values are specified in the same manner as in @sc{gnu} Chill programs.
-For detailed specification refer to the @sc{gnu} Chill implementation Manual
-chapter 1.5.
-@c FIXME: if the Chill Manual is a Texinfo documents, the above should
-@c be converted to a @ref.
-
-@ignore
-@itemize @bullet
-@item
-@emph{Integer Literals} are specified in the same manner as in Chill
-programs (refer to the Chill Standard z200/88 chpt 5.2.4.2)
-@item
-@emph{Boolean Literals} are defined by @code{TRUE} and @code{FALSE}.
-@item
-@emph{Character Literals} are defined by @code{'<character>'}. (e.g.
-@code{'M'})
-@item
-@emph{Set Literals} are defined by a name which was specified in a set
-mode. The value delivered by a Set Literal is the set value. This is
-comparable to an enumeration in C/C@t{++} language.
-@item
-@emph{Emptiness Literal} is predefined by @code{NULL}. The value of the
-emptiness literal delivers either the empty reference value, the empty
-procedure value or the empty instance value.
-
-@item
-@emph{Character String Literals} are defined by a sequence of characters
-enclosed in single- or double quotes. If a single- or double quote has
-to be part of the string literal it has to be stuffed (specified twice).
-@item
-@emph{Bitstring Literals} are specified in the same manner as in Chill
-programs (refer z200/88 chpt 5.2.4.8).
-@item
-@emph{Floating point literals} are specified in the same manner as in
-(gnu-)Chill programs (refer @sc{gnu} Chill implementation Manual chapter 1.5).
-@end itemize
-@end ignore
-
-@item Tuple Values
-A tuple is specified by @code{<mode name>[<tuple>]}, where @code{<mode
-name>} can be omitted if the mode of the tuple is unambiguous. This
-unambiguity is derived from the context of a evaluated expression.
-@code{<tuple>} can be one of the following:
-
-@itemize @bullet
-@item @emph{Powerset Tuple}
-@item @emph{Array Tuple}
-@item @emph{Structure Tuple}
-Powerset tuples, array tuples and structure tuples are specified in the
-same manner as in Chill programs refer to z200/88 chpt 5.2.5.
-@end itemize
-
-@item String Element Value
-A string element value is specified by
-@smallexample
-@code{<string value>(<index>)}
-@end smallexample
-where @code{<index>} is a integer expression. It delivers a character
-value which is equivalent to the character indexed by @code{<index>} in
-the string.
-
-@item String Slice Value
-A string slice value is specified by @code{<string value>(<slice
-spec>)}, where @code{<slice spec>} can be either a range of integer
-expressions or specified by @code{<start expr> up <size>}.
-@code{<size>} denotes the number of elements which the slice contains.
-The delivered value is a string value, which is part of the specified
-string.
-
-@item Array Element Values
-An array element value is specified by @code{<array value>(<expr>)} and
-delivers a array element value of the mode of the specified array.
-
-@item Array Slice Values
-An array slice is specified by @code{<array value>(<slice spec>)}, where
-@code{<slice spec>} can be either a range specified by expressions or by
-@code{<start expr> up <size>}. @code{<size>} denotes the number of
-arrayelements the slice contains. The delivered value is an array value
-which is part of the specified array.
-
-@item Structure Field Values
-A structure field value is derived by @code{<structure value>.<field
-name>}, where @code{<field name>} indicates the name of a field specified
-in the mode definition of the structure. The mode of the delivered value
-corresponds to this mode definition in the structure definition.
-
-@item Procedure Call Value
-The procedure call value is derived from the return value of the
-procedure@footnote{If a procedure call is used for instance in an
-expression, then this procedure is called with all its side
-effects. This can lead to confusing results if used carelessly.}.
-
-Values of duration mode locations are represented by @code{ULONG} literals.
-
-Values of time mode locations appear as
-@smallexample
-@code{TIME(<secs>:<nsecs>)}
-@end smallexample
-
-
-@ignore
-This is not implemented yet:
-@item Built-in Value
-@noindent
-The following built in functions are provided:
-
-@table @code
-@item @code{ADDR()}
-@item @code{NUM()}
-@item @code{PRED()}
-@item @code{SUCC()}
-@item @code{ABS()}
-@item @code{CARD()}
-@item @code{MAX()}
-@item @code{MIN()}
-@item @code{SIZE()}
-@item @code{UPPER()}
-@item @code{LOWER()}
-@item @code{LENGTH()}
-@item @code{SIN()}
-@item @code{COS()}
-@item @code{TAN()}
-@item @code{ARCSIN()}
-@item @code{ARCCOS()}
-@item @code{ARCTAN()}
-@item @code{EXP()}
-@item @code{LN()}
-@item @code{LOG()}
-@item @code{SQRT()}
-@end table
-
-For a detailed description refer to the GNU Chill implementation manual
-chapter 1.6.
-@end ignore
-
-@item Zero-adic Operator Value
-The zero-adic operator value is derived from the instance value for the
-current active process.
-
-@item Expression Values
-The value delivered by an expression is the result of the evaluation of
-the specified expression. If there are error conditions (mode
-incompatibility, etc.) the evaluation of expressions is aborted with a
-corresponding error message. Expressions may be parenthesised which
-causes the evaluation of this expression before any other expression
-which uses the result of the parenthesised expression. The following
-operators are supported by @value{GDBN}:
-
-@table @code
-@item @code{OR, ORIF, XOR}
-@itemx @code{AND, ANDIF}
-@itemx @code{NOT}
-Logical operators defined over operands of boolean mode.
-
-@item @code{=, /=}
-Equality and inequality operators defined over all modes.
-
-@item @code{>, >=}
-@itemx @code{<, <=}
-Relational operators defined over predefined modes.
-
-@item @code{+, -}
-@itemx @code{*, /, MOD, REM}
-Arithmetic operators defined over predefined modes.
-
-@item @code{-}
-Change sign operator.
-
-@item @code{//}
-String concatenation operator.
-
-@item @code{()}
-String repetition operator.
-
-@item @code{->}
-Referenced location operator which can be used either to take the
-address of a location (@code{->loc}), or to dereference a reference
-location (@code{loc->}).
-
-@item @code{OR, XOR}
-@itemx @code{AND}
-@itemx @code{NOT}
-Powerset and bitstring operators.
-
-@item @code{>, >=}
-@itemx @code{<, <=}
-Powerset inclusion operators.
-
-@item @code{IN}
-Membership operator.
-@end table
-@end table
-
-@node Chill type and range checks
-@subsubsection Chill type and range checks
-
-@value{GDBN} considers two Chill variables mode equivalent if the sizes
-of the two modes are equal. This rule applies recursively to more
-complex datatypes which means that complex modes are treated
-equivalent if all element modes (which also can be complex modes like
-structures, arrays, etc.) have the same size.
-
-Range checking is done on all mathematical operations, assignment, array
-index bounds and all built in procedures.
-
-Strong type checks are forced using the @value{GDBN} command @code{set
-check strong}. This enforces strong type and range checks on all
-operations where Chill constructs are used (expressions, built in
-functions, etc.) in respect to the semantics as defined in the z.200
-language specification.
-
-All checks can be disabled by the @value{GDBN} command @code{set check
-off}.
-
-@ignore
-@c Deviations from the Chill Standard Z200/88
-see last paragraph ?
-@end ignore
-
-@node Chill defaults
-@subsubsection Chill defaults
-
-If type and range checking are set automatically by @value{GDBN}, they
-both default to @code{on} whenever the working language changes to
-Chill. This happens regardless of whether you or @value{GDBN}
-selected the working language.
-
-If you allow @value{GDBN} to set the language automatically, then entering
-code compiled from a file whose name ends with @file{.ch} sets the
-working language to Chill. @xref{Automatically, ,Having @value{GDBN} set
-the language automatically}, for further details.
+@c OBSOLETE @node Chill
+@c OBSOLETE @subsection Chill
+@c OBSOLETE
+@c OBSOLETE The extensions made to @value{GDBN} to support Chill only support output
+@c OBSOLETE from the @sc{gnu} Chill compiler. Other Chill compilers are not currently
+@c OBSOLETE supported, and attempting to debug executables produced by them is most
+@c OBSOLETE likely to give an error as @value{GDBN} reads in the executable's symbol
+@c OBSOLETE table.
+@c OBSOLETE
+@c OBSOLETE @c This used to say "... following Chill related topics ...", but since
+@c OBSOLETE @c menus are not shown in the printed manual, it would look awkward.
+@c OBSOLETE This section covers the Chill related topics and the features
+@c OBSOLETE of @value{GDBN} which support these topics.
+@c OBSOLETE
+@c OBSOLETE @menu
+@c OBSOLETE * How modes are displayed:: How modes are displayed
+@c OBSOLETE * Locations:: Locations and their accesses
+@c OBSOLETE * Values and their Operations:: Values and their Operations
+@c OBSOLETE * Chill type and range checks::
+@c OBSOLETE * Chill defaults::
+@c OBSOLETE @end menu
+@c OBSOLETE
+@c OBSOLETE @node How modes are displayed
+@c OBSOLETE @subsubsection How modes are displayed
+@c OBSOLETE
+@c OBSOLETE The Chill Datatype- (Mode) support of @value{GDBN} is directly related
+@c OBSOLETE with the functionality of the @sc{gnu} Chill compiler, and therefore deviates
+@c OBSOLETE slightly from the standard specification of the Chill language. The
+@c OBSOLETE provided modes are:
+@c OBSOLETE
+@c OBSOLETE @c FIXME: this @table's contents effectively disable @code by using @r
+@c OBSOLETE @c on every @item. So why does it need @code?
+@c OBSOLETE @table @code
+@c OBSOLETE @item @r{@emph{Discrete modes:}}
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item
+@c OBSOLETE @emph{Integer Modes} which are predefined by @code{BYTE, UBYTE, INT,
+@c OBSOLETE UINT, LONG, ULONG},
+@c OBSOLETE @item
+@c OBSOLETE @emph{Boolean Mode} which is predefined by @code{BOOL},
+@c OBSOLETE @item
+@c OBSOLETE @emph{Character Mode} which is predefined by @code{CHAR},
+@c OBSOLETE @item
+@c OBSOLETE @emph{Set Mode} which is displayed by the keyword @code{SET}.
+@c OBSOLETE @smallexample
+@c OBSOLETE (@value{GDBP}) ptype x
+@c OBSOLETE type = SET (karli = 10, susi = 20, fritzi = 100)
+@c OBSOLETE @end smallexample
+@c OBSOLETE If the type is an unnumbered set the set element values are omitted.
+@c OBSOLETE @item
+@c OBSOLETE @emph{Range Mode} which is displayed by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{type = <basemode>(<lower bound> : <upper bound>)}
+@c OBSOLETE @end smallexample
+@c OBSOLETE where @code{<lower bound>, <upper bound>} can be of any discrete literal
+@c OBSOLETE expression (e.g. set element names).
+@c OBSOLETE @end itemize
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Powerset Mode:}}
+@c OBSOLETE A Powerset Mode is displayed by the keyword @code{POWERSET} followed by
+@c OBSOLETE the member mode of the powerset. The member mode can be any discrete mode.
+@c OBSOLETE @smallexample
+@c OBSOLETE (@value{GDBP}) ptype x
+@c OBSOLETE type = POWERSET SET (egon, hugo, otto)
+@c OBSOLETE @end smallexample
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Reference Modes:}}
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item
+@c OBSOLETE @emph{Bound Reference Mode} which is displayed by the keyword @code{REF}
+@c OBSOLETE followed by the mode name to which the reference is bound.
+@c OBSOLETE @item
+@c OBSOLETE @emph{Free Reference Mode} which is displayed by the keyword @code{PTR}.
+@c OBSOLETE @end itemize
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Procedure mode}}
+
@c OBSOLETE The procedure mode is displayed by @code{type = PROC(<parameter list>)
+
@c OBSOLETE <return mode> EXCEPTIONS (<exception list>)}. The @code{<parameter
+@c OBSOLETE list>} is a list of the parameter modes. @code{<return mode>} indicates
+@c OBSOLETE the mode of the result of the procedure if any. The exceptionlist lists
+@c OBSOLETE all possible exceptions which can be raised by the procedure.
+@c OBSOLETE
+@c OBSOLETE @ignore
+@c OBSOLETE @item @r{@emph{Instance mode}}
+@c OBSOLETE The instance mode is represented by a structure, which has a static
+@c OBSOLETE type, and is therefore not really of interest.
+@c OBSOLETE @end ignore
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Synchronization Modes:}}
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item
+@c OBSOLETE @emph{Event Mode} which is displayed by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{EVENT (<event length>)}
+@c OBSOLETE @end smallexample
+@c OBSOLETE where @code{(<event length>)} is optional.
+@c OBSOLETE @item
+@c OBSOLETE @emph{Buffer Mode} which is displayed by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{BUFFER (<buffer length>)<buffer element mode>}
+@c OBSOLETE @end smallexample
+@c OBSOLETE where @code{(<buffer length>)} is optional.
+@c OBSOLETE @end itemize
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Timing Modes:}}
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item
+@c OBSOLETE @emph{Duration Mode} which is predefined by @code{DURATION}
+@c OBSOLETE @item
+@c OBSOLETE @emph{Absolute Time Mode} which is predefined by @code{TIME}
+@c OBSOLETE @end itemize
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Real Modes:}}
+@c OBSOLETE Real Modes are predefined with @code{REAL} and @code{LONG_REAL}.
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{String Modes:}}
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item
+@c OBSOLETE @emph{Character String Mode} which is displayed by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{CHARS(<string length>)}
+@c OBSOLETE @end smallexample
+@c OBSOLETE followed by the keyword @code{VARYING} if the String Mode is a varying
+@c OBSOLETE mode
+@c OBSOLETE @item
+@c OBSOLETE @emph{Bit String Mode} which is displayed by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{BOOLS(<string
+@c OBSOLETE length>)}
+@c OBSOLETE @end smallexample
+@c OBSOLETE @end itemize
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Array Mode:}}
+@c OBSOLETE The Array Mode is displayed by the keyword @code{ARRAY(<range>)}
+@c OBSOLETE followed by the element mode (which may in turn be an array mode).
+@c OBSOLETE @smallexample
+@c OBSOLETE (@value{GDBP}) ptype x
+@c OBSOLETE type = ARRAY (1:42)
+@c OBSOLETE ARRAY (1:20)
+@c OBSOLETE SET (karli = 10, susi = 20, fritzi = 100)
+@c OBSOLETE @end smallexample
+@c OBSOLETE
+@c OBSOLETE @item @r{@emph{Structure Mode}}
+@c OBSOLETE The Structure mode is displayed by the keyword @code{STRUCT(<field
+@c OBSOLETE list>)}. The @code{<field list>} consists of names and modes of fields
+@c OBSOLETE of the structure. Variant structures have the keyword @code{CASE <field>
+@c OBSOLETE OF <variant fields> ESAC} in their field list. Since the current version
+@c OBSOLETE of the GNU Chill compiler doesn't implement tag processing (no runtime
+@c OBSOLETE checks of variant fields, and therefore no debugging info), the output
+@c OBSOLETE always displays all variant fields.
+@c OBSOLETE @smallexample
+@c OBSOLETE (@value{GDBP}) ptype str
+@c OBSOLETE type = STRUCT (
+@c OBSOLETE as x,
+@c OBSOLETE bs x,
+@c OBSOLETE CASE bs OF
+@c OBSOLETE (karli):
+@c OBSOLETE cs a
+@c OBSOLETE (ott):
+@c OBSOLETE ds x
+@c OBSOLETE ESAC
+@c OBSOLETE )
+@c OBSOLETE @end smallexample
+@c OBSOLETE @end table
+@c OBSOLETE
+@c OBSOLETE @node Locations
+@c OBSOLETE @subsubsection Locations and their accesses
+@c OBSOLETE
+@c OBSOLETE A location in Chill is an object which can contain values.
+@c OBSOLETE
+@c OBSOLETE A value of a location is generally accessed by the (declared) name of
+@c OBSOLETE the location. The output conforms to the specification of values in
+@c OBSOLETE Chill programs. How values are specified
+@c OBSOLETE is the topic of the next section, @ref{Values and their Operations}.
+@c OBSOLETE
+@c OBSOLETE The pseudo-location @code{RESULT} (or @code{result}) can be used to
+@c OBSOLETE display or change the result of a currently-active procedure:
+@c OBSOLETE
+@c OBSOLETE @smallexample
+@c OBSOLETE set result := EXPR
+@c OBSOLETE @end smallexample
+@c OBSOLETE
+@c OBSOLETE @noindent
+@c OBSOLETE This does the same as the Chill action @code{RESULT EXPR} (which
+@c OBSOLETE is not available in @value{GDBN}).
+@c OBSOLETE
+@c OBSOLETE Values of reference mode locations are printed by @code{PTR(<hex
+@c OBSOLETE value>)} in case of a free reference mode, and by @code{(REF <reference
+@c OBSOLETE mode>) (<hex-value>)} in case of a bound reference. @code{<hex value>}
+@c OBSOLETE represents the address where the reference points to. To access the
+@c OBSOLETE value of the location referenced by the pointer, use the dereference
+@c OBSOLETE operator @samp{->}.
+@c OBSOLETE
+@c OBSOLETE Values of procedure mode locations are displayed by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{@{ PROC
+
@c OBSOLETE (<argument modes> ) <return mode> @} <address> <name of procedure
+@c OBSOLETE location>}
+@c OBSOLETE @end smallexample
+@c
OBSOLETE @code{<argument modes>} is a list of modes according to the parameter
+
@c OBSOLETE specification of the procedure and @code{<address>} shows the address of
+@c OBSOLETE the entry point.
+@c OBSOLETE
+@c OBSOLETE @ignore
+@c OBSOLETE Locations of instance modes are displayed just like a structure with two
+@c OBSOLETE fields specifying the @emph{process type} and the @emph{copy number} of
+@c OBSOLETE the investigated instance location@footnote{This comes from the current
+@c OBSOLETE implementation of instances. They are implemented as a structure (no
+@c OBSOLETE na). The output should be something like @code{[<name of the process>;
+@c OBSOLETE <instance number>]}.}. The field names are @code{__proc_type} and
+@c OBSOLETE @code{__proc_copy}.
+@c OBSOLETE
+@c OBSOLETE Locations of synchronization modes are displayed like a structure with
+@c OBSOLETE the field name @code{__event_data} in case of a event mode location, and
+@c OBSOLETE like a structure with the field @code{__buffer_data} in case of a buffer
+@c OBSOLETE mode location (refer to previous paragraph).
+@c OBSOLETE
+@c OBSOLETE Structure Mode locations are printed by @code{[.<field name>: <value>,
+@c OBSOLETE ...]}. The @code{<field name>} corresponds to the structure mode
+@c OBSOLETE definition and the layout of @code{<value>} varies depending of the mode
+@c OBSOLETE of the field. If the investigated structure mode location is of variant
+@c OBSOLETE structure mode, the variant parts of the structure are enclosed in curled
+@c OBSOLETE braces (@samp{@{@}}). Fields enclosed by @samp{@{,@}} are residing
+@c OBSOLETE on the same memory location and represent the current values of the
+@c OBSOLETE memory location in their specific modes. Since no tag processing is done
+@c OBSOLETE all variants are displayed. A variant field is printed by
+@c OBSOLETE @code{(<variant name>) = .<field name>: <value>}. (who implements the
+@c OBSOLETE stuff ???)
+@c OBSOLETE @smallexample
+@c OBSOLETE (@value{GDBP}) print str1 $4 = [.as: 0, .bs: karli, .<TAG>: { (karli) =
+@c OBSOLETE [.cs: []], (susi) = [.ds: susi]}]
+@c OBSOLETE @end smallexample
+@c OBSOLETE @end ignore
+@c OBSOLETE
+@c OBSOLETE Substructures of string mode-, array mode- or structure mode-values
+@c OBSOLETE (e.g. array slices, fields of structure locations) are accessed using
+@c OBSOLETE certain operations which are described in the next section, @ref{Values
+@c OBSOLETE and their Operations}.
+@c OBSOLETE
+@c OBSOLETE A location value may be interpreted as having a different mode using the
+@c OBSOLETE location conversion. This mode conversion is written as @code{<mode
+@c OBSOLETE name>(<location>)}. The user has to consider that the sizes of the modes
+@c OBSOLETE have to be equal otherwise an error occurs. Furthermore, no range
+@c OBSOLETE checking of the location against the destination mode is performed, and
+@c OBSOLETE therefore the result can be quite confusing.
+@c OBSOLETE
+@c OBSOLETE @smallexample
+@c OBSOLETE (@value{GDBP}) print int (s(3 up 4)) XXX TO be filled in !! XXX
+@c OBSOLETE @end smallexample
+@c OBSOLETE
+@c OBSOLETE @node Values and their Operations
+@c OBSOLETE @subsubsection Values and their Operations
+@c OBSOLETE
+@c OBSOLETE Values are used to alter locations, to investigate complex structures in
+@c OBSOLETE more detail or to filter relevant information out of a large amount of
+@c OBSOLETE data. There are several (mode dependent) operations defined which enable
+@c OBSOLETE such investigations. These operations are not only applicable to
+@c OBSOLETE constant values but also to locations, which can become quite useful
+@c OBSOLETE when debugging complex structures. During parsing the command line
+@c OBSOLETE (e.g. evaluating an expression) @value{GDBN} treats location names as
+@c OBSOLETE the values behind these locations.
+@c OBSOLETE
+@c OBSOLETE This section describes how values have to be specified and which
+@c OBSOLETE operations are legal to be used with such values.
+@c OBSOLETE
+@c OBSOLETE @table @code
+@c OBSOLETE @item Literal Values
+@c OBSOLETE Literal values are specified in the same manner as in @sc{gnu} Chill programs.
+@c OBSOLETE For detailed specification refer to the @sc{gnu} Chill implementation Manual
+@c OBSOLETE chapter 1.5.
+@c OBSOLETE @c FIXME: if the Chill Manual is a Texinfo documents, the above should
+@c OBSOLETE @c be converted to a @ref.
+@c OBSOLETE
+@c OBSOLETE @ignore
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item
+@c OBSOLETE @emph{Integer Literals} are specified in the same manner as in Chill
+@c OBSOLETE programs (refer to the Chill Standard z200/88 chpt 5.2.4.2)
+@c OBSOLETE @item
+@c OBSOLETE @emph{Boolean Literals} are defined by @code{TRUE} and @code{FALSE}.
+@c OBSOLETE @item
+@c OBSOLETE @emph{Character Literals} are defined by @code{'<character>'}. (e.g.
+@c OBSOLETE @code{'M'})
+@c OBSOLETE @item
+@c OBSOLETE @emph{Set Literals} are defined by a name which was specified in a set
+@c OBSOLETE mode. The value delivered by a Set Literal is the set value. This is
+@c OBSOLETE comparable to an enumeration in C/C@t{++} language.
+@c OBSOLETE @item
+@c OBSOLETE @emph{Emptiness Literal} is predefined by @code{NULL}. The value of the
+@c OBSOLETE emptiness literal delivers either the empty reference value, the empty
+@c OBSOLETE procedure value or the empty instance value.
+@c OBSOLETE
+@c OBSOLETE @item
+@c OBSOLETE @emph{Character String Literals} are defined by a sequence of characters
+@c OBSOLETE enclosed in single- or double quotes. If a single- or double quote has
+@c OBSOLETE to be part of the string literal it has to be stuffed (specified twice).
+@c OBSOLETE @item
+@c OBSOLETE @emph{Bitstring Literals} are specified in the same manner as in Chill
+@c OBSOLETE programs (refer z200/88 chpt 5.2.4.8).
+@c OBSOLETE @item
+@c OBSOLETE @emph{Floating point literals} are specified in the same manner as in
+@c OBSOLETE (gnu-)Chill programs (refer @sc{gnu} Chill implementation Manual chapter 1.5).
+@c OBSOLETE @end itemize
+@c OBSOLETE @end ignore
+@c OBSOLETE
+@c OBSOLETE @item Tuple Values
+@c OBSOLETE A tuple is specified by @code{<mode name>[<tuple>]}, where @code{<mode
+@c OBSOLETE name>} can be omitted if the mode of the tuple is unambiguous. This
+@c OBSOLETE unambiguity is derived from the context of a evaluated expression.
+@c OBSOLETE @code{<tuple>} can be one of the following:
+@c OBSOLETE
+@c OBSOLETE @itemize @bullet
+@c OBSOLETE @item @emph{Powerset Tuple}
+@c OBSOLETE @item @emph{Array Tuple}
+@c OBSOLETE @item @emph{Structure Tuple}
+@c OBSOLETE Powerset tuples, array tuples and structure tuples are specified in the
+@c OBSOLETE same manner as in Chill programs refer to z200/88 chpt 5.2.5.
+@c OBSOLETE @end itemize
+@c OBSOLETE
+@c OBSOLETE @item String Element Value
+@c OBSOLETE A string element value is specified by
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{<string value>(<index>)}
+@c OBSOLETE @end smallexample
+@c OBSOLETE where @code{<index>} is a integer expression. It delivers a character
+@c OBSOLETE value which is equivalent to the character indexed by @code{<index>} in
+@c OBSOLETE the string.
+@c OBSOLETE
+@c OBSOLETE @item String Slice Value
+@c OBSOLETE A string slice value is specified by @code{<string value>(<slice
+@c OBSOLETE spec>)}, where @code{<slice spec>} can be either a range of integer
+@c OBSOLETE expressions or specified by @code{<start expr> up <size>}.
+@c OBSOLETE @code{<size>} denotes the number of elements which the slice contains.
+@c OBSOLETE The delivered value is a string value, which is part of the specified
+@c OBSOLETE string.
+@c OBSOLETE
+@c OBSOLETE @item Array Element Values
+
@c OBSOLETE An array element value is specified by @code{<array value>(<expr>)} and
+@c OBSOLETE delivers a array element value of the mode of the specified array.
+@c OBSOLETE
+@c OBSOLETE @item Array Slice Values
+
@c OBSOLETE An array slice is specified by @code{<array value>(<slice spec>)}, where
+@c OBSOLETE @code{<slice spec>} can be either a range specified by expressions or by
+@c OBSOLETE @code{<start expr> up <size>}. @code{<size>} denotes the number of
+@c OBSOLETE arrayelements the slice contains. The delivered value is an array value
+@c OBSOLETE which is part of the specified array.
+@c OBSOLETE
+@c OBSOLETE @item Structure Field Values
+@c OBSOLETE A structure field value is derived by @code{<structure value>.<field
+@c OBSOLETE name>}, where @code{<field name>} indicates the name of a field specified
+@c OBSOLETE in the mode definition of the structure. The mode of the delivered value
+@c OBSOLETE corresponds to this mode definition in the structure definition.
+@c OBSOLETE
+@c OBSOLETE @item Procedure Call Value
+@c OBSOLETE The procedure call value is derived from the return value of the
+@c OBSOLETE procedure@footnote{If a procedure call is used for instance in an
+@c OBSOLETE expression, then this procedure is called with all its side
+@c OBSOLETE effects. This can lead to confusing results if used carelessly.}.
+@c OBSOLETE
+@c OBSOLETE Values of duration mode locations are represented by @code{ULONG} literals.
+@c OBSOLETE
+@c OBSOLETE Values of time mode locations appear as
+@c OBSOLETE @smallexample
+@c OBSOLETE @code{TIME(<secs>:<nsecs>)}
+@c OBSOLETE @end smallexample
+@c OBSOLETE
+@c OBSOLETE
+@c OBSOLETE @ignore
+@c OBSOLETE This is not implemented yet:
+@c OBSOLETE @item Built-in Value
+@c OBSOLETE @noindent
+@c OBSOLETE The following built in functions are provided:
+@c OBSOLETE
+@c OBSOLETE @table @code
+@c OBSOLETE @item @code{ADDR()}
+@c OBSOLETE @item @code{NUM()}
+@c OBSOLETE @item @code{PRED()}
+@c OBSOLETE @item @code{SUCC()}
+@c OBSOLETE @item @code{ABS()}
+@c OBSOLETE @item @code{CARD()}
+@c OBSOLETE @item @code{MAX()}
+@c OBSOLETE @item @code{MIN()}
+@c OBSOLETE @item @code{SIZE()}
+@c OBSOLETE @item @code{UPPER()}
+@c OBSOLETE @item @code{LOWER()}
+@c OBSOLETE @item @code{LENGTH()}
+@c OBSOLETE @item @code{SIN()}
+@c OBSOLETE @item @code{COS()}
+@c OBSOLETE @item @code{TAN()}
+@c OBSOLETE @item @code{ARCSIN()}
+@c OBSOLETE @item @code{ARCCOS()}
+@c OBSOLETE @item @code{ARCTAN()}
+@c OBSOLETE @item @code{EXP()}
+@c OBSOLETE @item @code{LN()}
+@c OBSOLETE @item @code{LOG()}
+@c OBSOLETE @item @code{SQRT()}
+@c OBSOLETE @end table
+@c OBSOLETE
+@c OBSOLETE For a detailed description refer to the GNU Chill implementation manual
+@c OBSOLETE chapter 1.6.
+@c OBSOLETE @end ignore
+@c OBSOLETE
+@c OBSOLETE @item Zero-adic Operator Value
+@c OBSOLETE The zero-adic operator value is derived from the instance value for the
+@c OBSOLETE current active process.
+@c OBSOLETE
+@c OBSOLETE @item Expression Values
+@c OBSOLETE The value delivered by an expression is the result of the evaluation of
+@c OBSOLETE the specified expression. If there are error conditions (mode
+@c OBSOLETE incompatibility, etc.) the evaluation of expressions is aborted with a
+@c OBSOLETE corresponding error message. Expressions may be parenthesised which
+@c OBSOLETE causes the evaluation of this expression before any other expression
+@c OBSOLETE which uses the result of the parenthesised expression. The following
+@c OBSOLETE operators are supported by @value{GDBN}:
+@c OBSOLETE
+@c OBSOLETE @table @code
+@c OBSOLETE @item @code{OR, ORIF, XOR}
+@c OBSOLETE @itemx @code{AND, ANDIF}
+@c OBSOLETE @itemx @code{NOT}
+@c OBSOLETE Logical operators defined over operands of boolean mode.
+@c OBSOLETE
+@c OBSOLETE @item @code{=, /=}
+@c OBSOLETE Equality and inequality operators defined over all modes.
+@c OBSOLETE
+@c OBSOLETE @item @code{>, >=}
+@c OBSOLETE @itemx @code{<, <=}
+@c OBSOLETE Relational operators defined over predefined modes.
+@c OBSOLETE
+@c OBSOLETE @item @code{+, -}
+@c OBSOLETE @itemx @code{*, /, MOD, REM}
+@c OBSOLETE Arithmetic operators defined over predefined modes.
+@c OBSOLETE
+@c OBSOLETE @item @code{-}
+@c OBSOLETE Change sign operator.
+@c OBSOLETE
+@c OBSOLETE @item @code{//}
+@c OBSOLETE String concatenation operator.
+@c OBSOLETE
+@c OBSOLETE @item @code{()}
+@c OBSOLETE String repetition operator.
+@c OBSOLETE
+@c OBSOLETE @item @code{->}
+@c OBSOLETE Referenced location operator which can be used either to take the
+@c OBSOLETE address of a location (@code{->loc}), or to dereference a reference
+@c OBSOLETE location (@code{loc->}).
+@c OBSOLETE
+@c OBSOLETE @item @code{OR, XOR}
+@c OBSOLETE @itemx @code{AND}
+@c OBSOLETE @itemx @code{NOT}
+@c OBSOLETE Powerset and bitstring operators.
+@c OBSOLETE
+@c OBSOLETE @item @code{>, >=}
+@c OBSOLETE @itemx @code{<, <=}
+@c OBSOLETE Powerset inclusion operators.
+@c OBSOLETE
+@c OBSOLETE @item @code{IN}
+@c OBSOLETE Membership operator.
+@c OBSOLETE @end table
+@c OBSOLETE @end table
+@c OBSOLETE
+@c OBSOLETE @node Chill type and range checks
+@c OBSOLETE @subsubsection Chill type and range checks
+@c OBSOLETE
+@c OBSOLETE @value{GDBN} considers two Chill variables mode equivalent if the sizes
+@c OBSOLETE of the two modes are equal. This rule applies recursively to more
+@c OBSOLETE complex datatypes which means that complex modes are treated
+@c OBSOLETE equivalent if all element modes (which also can be complex modes like
+@c OBSOLETE structures, arrays, etc.) have the same size.
+@c OBSOLETE
+@c OBSOLETE Range checking is done on all mathematical operations, assignment, array
+@c OBSOLETE index bounds and all built in procedures.
+@c OBSOLETE
+@c OBSOLETE Strong type checks are forced using the @value{GDBN} command @code{set
+@c OBSOLETE check strong}. This enforces strong type and range checks on all
+@c OBSOLETE operations where Chill constructs are used (expressions, built in
+@c OBSOLETE functions, etc.) in respect to the semantics as defined in the z.200
+@c OBSOLETE language specification.
+@c OBSOLETE
+@c OBSOLETE All checks can be disabled by the @value{GDBN} command @code{set check
+@c OBSOLETE off}.
+@c OBSOLETE
+@c OBSOLETE @ignore
+@c OBSOLETE @c Deviations from the Chill Standard Z200/88
+@c OBSOLETE see last paragraph ?
+@c OBSOLETE @end ignore
+@c OBSOLETE
+@c OBSOLETE @node Chill defaults
+@c OBSOLETE @subsubsection Chill defaults
+@c OBSOLETE
+@c OBSOLETE If type and range checking are set automatically by @value{GDBN}, they
+@c OBSOLETE both default to @code{on} whenever the working language changes to
+@c OBSOLETE Chill. This happens regardless of whether you or @value{GDBN}
+@c OBSOLETE selected the working language.
+@c OBSOLETE
+@c OBSOLETE If you allow @value{GDBN} to set the language automatically, then entering
+@c OBSOLETE code compiled from a file whose name ends with @file{.ch} sets the
+@c OBSOLETE working language to Chill. @xref{Automatically, ,Having @value{GDBN} set
+@c OBSOLETE the language automatically}, for further details.
@node Symbols
@chapter Examining the Symbol Table
DWARF 1 is a debugging format that was originally designed to be
used with ELF in SVR4 systems.
-@c CHILL_PRODUCER
+@c OBSOLETE CHILL_PRODUCER
@c GCC_PRODUCER
@c GPLUS_PRODUCER
@c LCC_PRODUCER
enumeration or a subrange, and the type is a bitmask whose length is
specified by the number of elements in @var{type-information}.
-In CHILL, if it is a bitstring instead of a set, also use the @samp{S}
+In CHILL, @c OBSOLETE
+if it is a bitstring instead of a set, also use the @samp{S}
type attribute (@pxref{String Field}).
@item * @var{type-information}
Pascal Stringptr. What is this? This is an AIX feature.
@end table
-Languages, such as CHILL which have a string type which is basically
+Languages, such as CHILL @c OBSOLETE
+which have a string type which is basically
just an array of characters use the @samp{S} type attribute
(@pxref{String Field}).
#define LCC_PRODUCER "NCR C/C++"
#endif
-#ifndef CHILL_PRODUCER
-#define CHILL_PRODUCER "GNU Chill "
-#endif
+/* OBSOLETE #ifndef CHILL_PRODUCER */
+/* OBSOLETE #define CHILL_PRODUCER "GNU Chill " */
+/* OBSOLETE #endif */
/* Flags to target_to_host() that tell whether or not the data object is
expected to be signed. Used, for example, when fetching a signed
case LANG_C_PLUS_PLUS:
cu_language = language_cplus;
break;
- case LANG_CHILL:
- cu_language = language_chill;
- break;
+ /* OBSOLETE case LANG_CHILL: */
+ /* OBSOLETE cu_language = language_chill; */
+ /* OBSOLETE break; */
case LANG_MODULA2:
cu_language = language_m2;
break;
else
{
processing_gcc_compilation =
- STREQN (producer, GPLUS_PRODUCER, strlen (GPLUS_PRODUCER))
- || STREQN (producer, CHILL_PRODUCER, strlen (CHILL_PRODUCER));
+ STREQN (producer, GPLUS_PRODUCER, strlen (GPLUS_PRODUCER));
+ /* OBSOLETE || STREQN (producer, CHILL_PRODUCER, strlen (CHILL_PRODUCER)); */
}
/* Select a demangling style if we can identify the producer and if
return NULL;
}
-/* This function evaluates tuples (in Chill) or brace-initializers
- (in C/C++) for structure types. */
+/* This function evaluates tuples (in (OBSOLETE) Chill) or
+ brace-initializers (in C/C++) for structure types. */
static struct value *
evaluate_struct_tuple (struct value *struct_val,
return struct_val;
}
-/* Recursive helper function for setting elements of array tuples for Chill.
- The target is ARRAY (which has bounds LOW_BOUND to HIGH_BOUND);
- the element value is ELEMENT;
- EXP, POS and NOSIDE are as usual.
- Evaluates index expresions and sets the specified element(s) of
- ARRAY to ELEMENT.
- Returns last index value. */
+/* Recursive helper function for setting elements of array tuples for
+ (OBSOLETE) Chill. The target is ARRAY (which has bounds LOW_BOUND
+ to HIGH_BOUND); the element value is ELEMENT; EXP, POS and NOSIDE
+ are as usual. Evaluates index expresions and sets the specified
+ element(s) of ARRAY to ELEMENT. Returns last index value. */
static LONGEST
init_array_element (struct value *array, struct value *element,
}
else
{
- int is_chill = exp->language_defn->la_language == language_chill;
- fputs_filtered (is_chill ? " [" : " {", stream);
+ /* OBSOLETE int is_chill = exp->language_defn->la_language == language_chill; */
+ /* OBSOLETE fputs_filtered (is_chill ? " [" : " {", stream); */
+ fputs_filtered (" {", stream);
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
}
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
- fputs_filtered (is_chill ? "]" : "}", stream);
+ /* OBSOLETE fputs_filtered (is_chill ? "]" : "}", stream); */
+ fputs_filtered ("}", stream);
}
return;
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
- if (exp->language_defn->la_language == language_chill)
- {
- fputs_filtered (".", stream);
- fputs_filtered (&exp->elts[pc + 2].string, stream);
- fputs_filtered (exp->elts[*pos].opcode == OP_LABELED ? ", "
- : ": ",
- stream);
- }
- else
+#if 0
+ if (0 /* OBSOLETE exp->language_defn->la_language == language_chill */)
+ { /* OBSOLETE */
+ fputs_filtered (".", stream); /* OBSOLETE */
+ fputs_filtered (&exp->elts[pc + 2].string, stream); /* OBSOLETE */
+ fputs_filtered (exp->elts[*pos].opcode == OP_LABELED ? ", " /* OBSOLETE */
+ : ": ", /* OBSOLETE */
+ stream); /* OBSOLETE */
+ } /* OBSOLETE */
+ else /* OBSOLETE */
+#endif
{
/* Gcc support both these syntaxes. Unsure which is preferred. */
#if 1
the second operand with itself that many times. */
BINOP_CONCAT,
- /* For Chill and Pascal. */
+ /* For (OBSOLETE) Chill (OBSOLETE) and Pascal. */
BINOP_IN, /* Returns 1 iff ARG1 IN ARG2. */
- /* This is the "colon operator" used various places in Chill. */
+ /* This is the "colon operator" used various places in (OBSOLETE)
+ Chill (OBSOLETE). */
BINOP_RANGE,
/* This must be the highest BINOP_ value, for expprint.c. */
/* Operates on three values computed by following subexpressions. */
TERNOP_COND, /* ?: */
- /* A sub-string/sub-array. Chill syntax: OP1(OP2:OP3).
- Return elements OP2 through OP3 of OP1. */
+ /* A sub-string/sub-array. (OBSOLETE) Chill (OBSOLETE) syntax:
+ OP1(OP2:OP3). Return elements OP2 through OP3 of OP1. */
TERNOP_SLICE,
- /* A sub-string/sub-array. Chill syntax: OP1(OP2 UP OP3).
- Return OP3 elements of OP1, starting with element OP2. */
+ /* A sub-string/sub-array. (OBSOLETE) Chill (OBSOLETE) syntax:
+ OP1(OP2 UP OP3). Return OP3 elements of OP1, starting with
+ element OP2. */
TERNOP_SLICE_COUNT,
/* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
UNOP_ODD,
UNOP_TRUNC,
- /* Chill builtin functions. */
+ /* (OBSOLETE) Chill (OBSOLETE) builtin functions. */
UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH, UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN,
OP_BOOL, /* Modula-2 builtin BOOLEAN type */
a string, which, of course, is variable length. */
OP_SCOPE,
- /* Used to represent named structure field values in brace initializers
- (or tuples as they are called in Chill).
- The gcc C syntax is NAME:VALUE or .NAME=VALUE, the Chill syntax is
- .NAME:VALUE. Multiple labels (as in the Chill syntax
- .NAME1,.NAME2:VALUE) is represented as if it were
- .NAME1:(.NAME2:VALUE) (though that is not valid Chill syntax).
+ /* Used to represent named structure field values in brace
+ initializers (or tuples as they are called in (OBSOLETE) Chill
+ (OBSOLETE)).
+
+ The gcc C syntax is NAME:VALUE or .NAME=VALUE, the (OBSOLETE)
+ Chill (OBSOLETE) syntax is .NAME:VALUE. Multiple labels (as in
+ the (OBSOLETE) Chill (OBSOLETE) syntax .NAME1,.NAME2:VALUE) is
+ represented as if it were .NAME1:(.NAME2:VALUE) (though that is
+ not valid (OBSOLETE) Chill (OBSOLETE) syntax).
The NAME is represented as for STRUCTOP_STRUCT; VALUE follows. */
OP_LABELED,
## This is ugly, but I don't want GNU make to put these variables in
## the environment. Older makes will see this as a set of targets
## with no dependencies and no actions.
-unexport CHILLFLAGS CHILL_LIB CHILL_FOR_TARGET :
+# OBSOLETE unexport CHILLFLAGS CHILL_LIB CHILL_FOR_TARGET :
gdb_proc_service_h = $(srcdir)/../gdb_proc_service.h $(srcdir)/../gregset.h
regdat_sh = $(srcdir)/../regformats/regdat.sh
|| (TYPE_CODE (t) == TYPE_CODE_BOOL)));
}
-/* Chill varying string and arrays are represented as follows:
+/* (OBSOLETE) Chill (OBSOLETE) varying string and arrays are
+ represented as follows:
struct { int __var_length; ELEMENT_TYPE[MAX_SIZE] __var_data};
- Return true if TYPE is such a Chill varying type. */
-
-int
-chill_varying_type (struct type *type)
-{
- if (TYPE_CODE (type) != TYPE_CODE_STRUCT
- || TYPE_NFIELDS (type) != 2
- || strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0)
- return 0;
- return 1;
-}
+ Return true if TYPE is such a (OBSOLETE) Chill (OBSOLETE) varying
+ type. */
+
+/* OBSOLETE int */
+/* OBSOLETE chill_varying_type (struct type *type) */
+/* OBSOLETE { */
+/* OBSOLETE if (TYPE_CODE (type) != TYPE_CODE_STRUCT */
+/* OBSOLETE || TYPE_NFIELDS (type) != 2 */
+/* OBSOLETE || strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0) */
+/* OBSOLETE return 0; */
+/* OBSOLETE return 1; */
+/* OBSOLETE } */
/* Check whether BASE is an ancestor or base class or DCLASS
Return 1 if so, and 0 if not.
TYPE_CODE_RANGE, /* Range (integers within spec'd bounds) */
/* A string type which is like an array of character but prints
- differently (at least for CHILL). It does not contain a length
- field as Pascal strings (for many Pascals, anyway) do; if we want
- to deal with such strings, we should use a new type code. */
+ differently (at least for (OBSOLETE) CHILL (OBSOLETE)). It
+ does not contain a length field as Pascal strings (for many
+ Pascals, anyway) do; if we want to deal with such strings, we
+ should use a new type code. */
TYPE_CODE_STRING,
- /* String of bits; like TYPE_CODE_SET but prints differently (at least
- for CHILL). */
+ /* String of bits; like TYPE_CODE_SET but prints differently (at
+ least for (OBSOLETE) CHILL (OBSOLETE)). */
TYPE_CODE_BITSTRING,
/* Unknown type. The length field is valid if we were able to
extern struct type *builtin_type_m2_real;
extern struct type *builtin_type_m2_bool;
-/* Chill types */
+/* OBSOLETE Chill types */
-extern struct type *builtin_type_chill_bool;
-extern struct type *builtin_type_chill_char;
-extern struct type *builtin_type_chill_long;
-extern struct type *builtin_type_chill_ulong;
-extern struct type *builtin_type_chill_real;
+/* OBSOLETE extern struct type *builtin_type_chill_bool; */
+/* OBSOLETE extern struct type *builtin_type_chill_char; */
+/* OBSOLETE extern struct type *builtin_type_chill_long; */
+/* OBSOLETE extern struct type *builtin_type_chill_ulong; */
+/* OBSOLETE extern struct type *builtin_type_chill_real; */
/* Fortran (F77) types */
extern struct type *create_set_type (struct type *, struct type *);
-extern int chill_varying_type (struct type *);
+/* OBSOLETE extern int chill_varying_type (struct type *); */
extern struct type *lookup_unsigned_typename (char *);
not needed. */
return l1 > l2 ? VALUE_TYPE (v1) : VALUE_TYPE (v2);
break;
- case language_chill:
- error ("Missing Chill support in function binop_result_check."); /*FIXME */
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE error ("Missing Chill support in function binop_result_check."); */ /*FIXME */
}
internal_error (__FILE__, __LINE__, "failed internal consistency check");
return (struct type *) 0; /* For lint */
case language_m2:
case language_pascal:
return TYPE_CODE (type) != TYPE_CODE_INT ? 0 : 1;
- case language_chill:
- error ("Missing Chill support in function integral_type."); /*FIXME */
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE error ("Missing Chill support in function integral_type."); *//*FIXME */
default:
error ("Language not supported.");
}
CHECK_TYPEDEF (type);
switch (current_language->la_language)
{
- case language_chill:
+ /* OBSOLETE case language_chill: */
case language_m2:
case language_pascal:
return TYPE_CODE (type) != TYPE_CODE_CHAR ? 0 : 1;
CHECK_TYPEDEF (type);
switch (current_language->la_language)
{
- case language_chill:
+ /* OBSOLETE case language_chill: */
case language_m2:
case language_pascal:
return TYPE_CODE (type) != TYPE_CODE_STRING ? 0 : 1;
{
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. */
+ /* Might be more cleanly handled by having a
+ TYPE_CODE_INT_NOT_BOOL for (OBSOLETE) CHILL and such
+ languages, or a TYPE_CODE_INT_OR_BOOL for C. */
if (TYPE_CODE (type) == TYPE_CODE_INT)
return 1;
default:
return (TYPE_CODE (type) == TYPE_CODE_STRUCT) ||
(TYPE_CODE (type) == TYPE_CODE_SET) ||
(TYPE_CODE (type) == TYPE_CODE_ARRAY);
- case language_chill:
- error ("Missing Chill support in function structured_type."); /*FIXME */
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE error ("Missing Chill support in function structured_type."); *//*FIXME */
default:
return (0);
}
struct type *type;
switch (current_language->la_language)
{
- case language_chill:
- return builtin_type_chill_bool;
+#if 0
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE return builtin_type_chill_bool; */
+#endif
case language_fortran:
sym = lookup_symbol ("logical", NULL, VAR_NAMESPACE, NULL, NULL);
if (sym)
}
#endif
-#ifdef _LANG_chill
- case language_chill:
- error ("Missing Chill support in function binop_type_check."); /*FIXME */
+#ifdef _LANG_chill /* OBSOLETE */
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE error ("Missing Chill support in function binop_type_check."); *//*FIXME */
#endif
}
/* #include "lang_def.h" */
#define _LANG_c
#define _LANG_m2
-#define _LANG_chill
+/* OBSOLETE #define _LANG_chill */
#define _LANG_fortran
#define _LANG_pascal
}
if (p[0] == ':' && p[1] == ':')
{
- /* chill the list of fields: the last entry (at the head) is a
- partially constructed entry which we now scrub. */
+ /* (OBSOLETE) chill (OBSOLETE) the list of fields: the last
+ entry (at the head) is a partially constructed entry which we
+ now scrub. */
fip->list = fip->list->next;
}
return 1;
else if (self_subrange && n2 == 0 && n3 == 127)
return init_type (TYPE_CODE_INT, 1, 0, NULL, objfile);
- else if (current_symbol && SYMBOL_LANGUAGE (current_symbol) == language_chill
- && !self_subrange)
- goto handle_true_range;
+#if 0
+ /* OBSOLETE else if (current_symbol && SYMBOL_LANGUAGE (current_symbol) == language_chill */
+ /* OBSOLETE && !self_subrange) */
+ /* OBSOLETE goto handle_true_range; */
+#endif
/* We used to do this only for subrange of self or subrange of int. */
else if (n2 == 0)
add_filename_language (".c++", language_cplus);
add_filename_language (".java", language_java);
add_filename_language (".class", language_java);
- add_filename_language (".ch", language_chill);
- add_filename_language (".c186", language_chill);
- add_filename_language (".c286", language_chill);
+ /* OBSOLETE add_filename_language (".ch", language_chill); */
+ /* OBSOLETE add_filename_language (".c186", language_chill); */
+ /* OBSOLETE add_filename_language (".c286", language_chill); */
add_filename_language (".f", language_fortran);
add_filename_language (".F", language_fortran);
add_filename_language (".s", language_asm);
SYMBOL_CPLUS_DEMANGLED_NAME (&psymbol) =
bcache (buf, dem_namelength + 1, objfile->psymbol_cache);
break;
- case language_chill:
- SYMBOL_CHILL_DEMANGLED_NAME (&psymbol) =
- bcache (buf, dem_namelength + 1, objfile->psymbol_cache);
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE SYMBOL_CHILL_DEMANGLED_NAME (&psymbol) = */
+ /* OBSOLETE bcache (buf, dem_namelength + 1, objfile->psymbol_cache); */
/* FIXME What should be done for the default case? Ignoring for now. */
}
gsymbol->language_specific.cplus_specific.demangled_name = NULL;
}
}
- if (demangled == NULL
- && (gsymbol->language == language_chill
- || gsymbol->language == language_auto))
- {
- demangled =
- chill_demangle (gsymbol->name);
- if (demangled != NULL)
- {
- gsymbol->language = language_chill;
- gsymbol->language_specific.chill_specific.demangled_name =
- obsavestring (demangled, strlen (demangled), obstack);
- xfree (demangled);
- }
- else
- {
- gsymbol->language_specific.chill_specific.demangled_name = NULL;
- }
- }
+#if 0
+ /* OBSOLETE if (demangled == NULL */
+ /* OBSOLETE && (gsymbol->language == language_chill */
+ /* OBSOLETE || gsymbol->language == language_auto)) */
+ /* OBSOLETE { */
+ /* OBSOLETE demangled = */
+ /* OBSOLETE chill_demangle (gsymbol->name); */
+ /* OBSOLETE if (demangled != NULL) */
+ /* OBSOLETE { */
+ /* OBSOLETE gsymbol->language = language_chill; */
+ /* OBSOLETE gsymbol->language_specific.chill_specific.demangled_name = */
+ /* OBSOLETE obsavestring (demangled, strlen (demangled), obstack); */
+ /* OBSOLETE xfree (demangled); */
+ /* OBSOLETE } */
+ /* OBSOLETE else */
+ /* OBSOLETE { */
+ /* OBSOLETE gsymbol->language_specific.chill_specific.demangled_name = NULL; */
+ /* OBSOLETE } */
+ /* OBSOLETE } */
+#endif
}
char *demangled_name;
}
cplus_specific;
- struct chill_specific /* For Chill */
- {
- char *demangled_name;
- }
- chill_specific;
+#if 0
+ /* OBSOLETE struct chill_specific *//* For Chill */
+ /* OBSOLETE { */
+ /* OBSOLETE char *demangled_name; */
+ /* OBSOLETE } */
+ /* OBSOLETE chill_specific; */
+#endif
}
language_specific;
{ \
SYMBOL_CPLUS_DEMANGLED_NAME (symbol) = NULL; \
} \
- else if (SYMBOL_LANGUAGE (symbol) == language_chill) \
- { \
- SYMBOL_CHILL_DEMANGLED_NAME (symbol) = NULL; \
- } \
+ /* OBSOLETE else if (SYMBOL_LANGUAGE (symbol) == language_chill) */ \
+ /* OBSOLETE { */ \
+ /* OBSOLETE SYMBOL_CHILL_DEMANGLED_NAME (symbol) = NULL; */ \
+ /* OBSOLETE } */ \
else \
{ \
memset (&(symbol)->ginfo.language_specific, 0, \
(SYMBOL_LANGUAGE (symbol) == language_cplus \
|| SYMBOL_LANGUAGE (symbol) == language_java \
? SYMBOL_CPLUS_DEMANGLED_NAME (symbol) \
- : (SYMBOL_LANGUAGE (symbol) == language_chill \
- ? SYMBOL_CHILL_DEMANGLED_NAME (symbol) \
- : NULL))
+ : /* OBSOLETE (SYMBOL_LANGUAGE (symbol) == language_chill */ \
+ /* OBSOLETE ? SYMBOL_CHILL_DEMANGLED_NAME (symbol) */ \
+ NULL)
-#define SYMBOL_CHILL_DEMANGLED_NAME(symbol) \
- (symbol)->ginfo.language_specific.chill_specific.demangled_name
+/* OBSOLETE #define SYMBOL_CHILL_DEMANGLED_NAME(symbol) */
+/* OBSOLETE (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
+2002-08-01 Andrew Cagney <cagney@redhat.com>
+
+ * Makefile.in (TARGET_FLAGS_TO_PASS): Remove CHILLFLAGS, CHILL,
+ CHILL_FOR_TARGET and CHILL_LIB.
+ * configure.in (configdirs): Remove gdb.chill.
+ * configure: Regenerate.
+ * lib/gdb.exp: Obsolete references to chill.
+ * gdb.fortran/types.exp: Ditto.
+ * gdb.fortran/exprs.exp: Ditto.
+
2002-07-30 Kevin Buettner <kevinb@redhat.com>
* gdb.base/shlib-call.exp (additional_flags): Conditionally
'CC=$$(CC_FOR_TARGET)' \
"CC_FOR_TARGET=$(CC_FOR_TARGET)" \
"CFLAGS=$(TESTSUITE_CFLAGS)" \
- "CHILLFLAGS=$(CHILLFLAGS)" \
- 'CHILL=$$(CHILL_FOR_TARGET)' \
- "CHILL_FOR_TARGET=$(CHILL_FOR_TARGET)" \
- "CHILL_LIB=$(CHILL_LIB)" \
'CXX=$$(CXX_FOR_TARGET)' \
"CXX_FOR_TARGET=$(CXX_FOR_TARGET)" \
"CXXFLAGS=$(CXXFLAGS)" \
program_transform_name=s,x,x,
silent=
site=
-sitefile=
srcdir=
target=NONE
verbose=
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
- --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
- -site-file | --site-file | --site-fil | --site-fi | --site-f)
- ac_prev=sitefile ;;
- -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
- sitefile="$ac_optarg" ;;
-
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$sitefile"; then
- if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
fi
-else
- CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
fi
echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:590: checking host system type" >&5
+echo "configure:579: checking host system type" >&5
host_alias=$host
case "$host_alias" in
echo "$ac_t""$host" 1>&6
echo $ac_n "checking target system type""... $ac_c" 1>&6
-echo "configure:611: checking target system type" >&5
+echo "configure:600: checking target system type" >&5
target_alias=$target
case "$target_alias" in
echo "$ac_t""$target" 1>&6
echo $ac_n "checking build system type""... $ac_c" 1>&6
-echo "configure:629: checking build system type" >&5
+echo "configure:618: checking build system type" >&5
build_alias=$build
case "$build_alias" in
gdb.c++ \
gdb.java \
gdb.disasm \
- gdb.chill \
gdb.mi \
gdb.threads \
gdb.trace"
# End stuff to support --enable-shared
echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
-echo "configure:754: checking for Cygwin environment" >&5
+echo "configure:742: checking for Cygwin environment" >&5
if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 759 "configure"
+#line 747 "configure"
#include "confdefs.h"
int main() {
return __CYGWIN__;
; return 0; }
EOF
-if { (eval echo configure:770: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:758: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_cygwin=yes
else
CYGWIN=
test "$ac_cv_cygwin" = yes && CYGWIN=yes
echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
-echo "configure:787: checking for mingw32 environment" >&5
+echo "configure:775: checking for mingw32 environment" >&5
if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 792 "configure"
+#line 780 "configure"
#include "confdefs.h"
int main() {
return __MINGW32__;
; return 0; }
EOF
-if { (eval echo configure:799: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:787: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_mingw32=yes
else
echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
-echo "configure:818: checking for executable suffix" >&5
+echo "configure:806: checking for executable suffix" >&5
if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
rm -f conftest*
echo 'int main () { return 0; }' > conftest.$ac_ext
ac_cv_exeext=
- if { (eval echo configure:828: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+ if { (eval echo configure:816: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
for file in conftest.*; do
case $file in
- *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *.c | *.o | *.obj) ;;
*) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;;
esac
done
gdb.c++ \
gdb.java \
gdb.disasm \
- gdb.chill \
gdb.mi \
gdb.threads \
gdb.trace"
# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu
-# This file was adapted from Chill tests by Stan Shebs (shebs@cygnus.com).
+# This file was adapted from (OBSOLETE) Chill tests by Stan Shebs (shebs@cygnus.com).
if $tracelevel then {
strace $tracelevel
# Please email any bugs, comments, and/or additions to this file to:
# bug-gdb@prep.ai.mit.edu
-# This file was adapted from Chill tests by Stan Shebs (shebs@cygnus.com).
+# This file was adapted from (OBSOLETE) Chill tests by Stan Shebs (shebs@cygnus.com).
if $tracelevel then {
strace $tracelevel
load_lib libgloss.exp
global GDB
-global CHILL_LIB
-global CHILL_RT0
-
-if ![info exists CHILL_LIB] {
- set CHILL_LIB [findfile $base_dir/../../gcc/ch/runtime/libchill.a "$base_dir/../../gcc/ch/runtime/libchill.a" [transform -lchill]]
-}
-verbose "using CHILL_LIB = $CHILL_LIB" 2
-if ![info exists CHILL_RT0] {
- set CHILL_RT0 [findfile $base_dir/../../gcc/ch/runtime/chillrt0.o "$base_dir/../../gcc/ch/runtime/chillrt0.o" ""]
-}
-verbose "using CHILL_RT0 = $CHILL_RT0" 2
+# OBSOLETE global CHILL_LIB
+# OBSOLETE global CHILL_RT0
+
+# OBSOLETE if ![info exists CHILL_LIB] {
+# OBSOLETE set CHILL_LIB [findfile $base_dir/../../gcc/ch/runtime/libchill.a "$base_dir/../../gcc/ch/runtime/libchill.a" [transform -lchill]]
+# OBSOLETE }
+# OBSOLETE verbose "using CHILL_LIB = $CHILL_LIB" 2
+# OBSOLETE if ![info exists CHILL_RT0] {
+# OBSOLETE set CHILL_RT0 [findfile $base_dir/../../gcc/ch/runtime/chillrt0.o "$base_dir/../../gcc/ch/runtime/chillrt0.o" ""]
+# OBSOLETE }
+# OBSOLETE verbose "using CHILL_RT0 = $CHILL_RT0" 2
if [info exists TOOL_EXECUTABLE] {
set GDB $TOOL_EXECUTABLE;
return 0
}
-# * For crosses, the CHILL runtime doesn't build because it can't find
-# setjmp.h, stdio.h, etc.
-# * For AIX (as of 16 Mar 95), (a) there is no language code for
-# CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2
-# does not get along with AIX's too-clever linker.
-# * On Irix5, there is a bug whereby set of bool, etc., don't get
-# TYPE_LOW_BOUND for the bool right because force_to_range_type doesn't
-# work with stub types.
-# Lots of things seem to fail on the PA, and since it's not a supported
-# chill target at the moment, don't run the chill tests.
-
-proc skip_chill_tests {} {
- if ![info exists do_chill_tests] {
- return 1;
- }
- eval set skip_chill [expr ![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-irix5*"] || [istarget "*-*-irix6*"] || [istarget "alpha-*-osf*"] || [istarget "hppa*-*-*"]]
- verbose "Skip chill tests is $skip_chill"
- return $skip_chill
-}
+# OBSOLETE # * For crosses, the CHILL runtime doesn't build because it
+# OBSOLETE # can't find setjmp.h, stdio.h, etc.
+# OBSOLETE # * For AIX (as of 16 Mar 95), (a) there is no language code for
+# OBSOLETE # CHILL in output_epilog in gcc/config/rs6000/rs6000.c, (b) collect2
+# OBSOLETE # does not get along with AIX's too-clever linker.
+# OBSOLETE # * On Irix5, there is a bug whereby set of bool, etc., don't get
+# OBSOLETE # TYPE_LOW_BOUND for the bool right because force_to_range_type doesn't
+# OBSOLETE # work with stub types.
+# OBSOLETE # Lots of things seem to fail on the PA, and since it's not a supported
+# OBSOLETE # chill target at the moment, don't run the chill tests.
+
+# OBSOLETE proc skip_chill_tests {} {
+# OBSOLETE if ![info exists do_chill_tests] {
+# OBSOLETE return 1;
+# OBSOLETE }
+# OBSOLETE eval set skip_chill [expr ![isnative] || [istarget "*-*-aix*"] || [istarget "*-*-irix5*"] || [istarget "*-*-irix6*"] || [istarget "alpha-*-osf*"] || [istarget "hppa*-*-*"]]
+# OBSOLETE verbose "Skip chill tests is $skip_chill"
+# OBSOLETE return $skip_chill
+# OBSOLETE }
# Skip all the tests in the file if you are not on an hppa running
# hpux target.
type_print (type, "", stream, 0);
break;
#endif
-#ifdef _LANG_chill
- case language_chill:
- fprintf_filtered (stream, "SYNMODE ");
- if (!TYPE_NAME (SYMBOL_TYPE (new)) ||
- !STREQ (TYPE_NAME (SYMBOL_TYPE (new)), SYMBOL_NAME (new)))
- fprintf_filtered (stream, "%s = ", SYMBOL_SOURCE_NAME (new));
- else
- fprintf_filtered (stream, "<builtin> = ");
- type_print (type, "", stream, 0);
- break;
+#ifdef _LANG_chill /* OBSOLETE */
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE fprintf_filtered (stream, "SYNMODE "); */
+ /* OBSOLETE if (!TYPE_NAME (SYMBOL_TYPE (new)) || */
+ /* OBSOLETE !STREQ (TYPE_NAME (SYMBOL_TYPE (new)), SYMBOL_NAME (new))) */
+ /* OBSOLETE fprintf_filtered (stream, "%s = ", SYMBOL_SOURCE_NAME (new)); */
+ /* OBSOLETE else */
+ /* OBSOLETE fprintf_filtered (stream, "<builtin> = "); */
+ /* OBSOLETE type_print (type, "", stream, 0); */
+ /* OBSOLETE break; */
#endif
default:
error ("Language not supported.");
case language_java:
demangled = cplus_demangle (name, arg_mode | DMGL_JAVA);
break;
- case language_chill:
- demangled = chill_demangle (name);
- break;
+#if 0
+ /* OBSOLETE case language_chill: */
+ /* OBSOLETE demangled = chill_demangle (name); */
+ /* OBSOLETE break; */
+#endif
default:
demangled = NULL;
break;
/* Integral operations here. */
/* FIXME: Also mixed integral/booleans, with result an integer. */
/* FIXME: This implements ANSI C rules (also correct for C++).
- What about FORTRAN and chill? */
+ What about FORTRAN and (OBSOLETE) chill ? */
{
unsigned int promoted_len1 = TYPE_LENGTH (type1);
unsigned int promoted_len2 = TYPE_LENGTH (type2);
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.");
- }
+ /* OBSOLETE Chill specifies that v2 must be > 0, so check for that. */
+ /* OBSOLETE if (current_language->la_language == language_chill */
+ /* OBSOLETE && value_as_long (arg2) <= 0) */
+ /* OBSOLETE { */
+ /* OBSOLETE error ("Second operand of MOD must be greater than zero."); */
+ /* OBSOLETE } */
if (v2 == 0)
{
v = v1;
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.");
- }
+ /* OBSOLETE Chill specifies that v2 must be > 0, so check for that. */
+ /* OBSOLETE if (current_language->la_language == language_chill */
+ /* OBSOLETE && v2 <= 0) */
+ /* OBSOLETE { */
+ /* OBSOLETE error ("Second operand of MOD must be greater than zero."); */
+ /* OBSOLETE } */
if (v2 == 0)
{
v = v1;
return value_from_double (result_type, -value_as_double (arg1));
else if (TYPE_CODE (type) == TYPE_CODE_INT || TYPE_CODE (type) == TYPE_CODE_BOOL)
{
- /* Perform integral promotion for ANSI C/C++.
- FIXME: What about FORTRAN and chill ? */
+ /* Perform integral promotion for ANSI C/C++. FIXME: What about
+ FORTRAN and (OBSOLETE) chill ? */
if (TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
result_type = builtin_type_int;
VALUE_POINTED_TO_OFFSET (arg2) = 0; /* pai: chk_val */
return arg2;
}
- else if (chill_varying_type (type))
- {
- struct type *range1, *range2, *eltype1, *eltype2;
- struct value *val;
- int count1, count2;
- LONGEST low_bound, high_bound;
- char *valaddr, *valaddr_data;
- /* For lint warning about eltype2 possibly uninitialized: */
- eltype2 = NULL;
- if (code2 == TYPE_CODE_BITSTRING)
- error ("not implemented: converting bitstring to varying type");
- if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
- || (eltype1 = check_typedef (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1))),
- eltype2 = check_typedef (TYPE_TARGET_TYPE (type2)),
- (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
- /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
- error ("Invalid conversion to varying type");
- range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
- range2 = TYPE_FIELD_TYPE (type2, 0);
- if (get_discrete_bounds (range1, &low_bound, &high_bound) < 0)
- count1 = -1;
- else
- count1 = high_bound - low_bound + 1;
- if (get_discrete_bounds (range2, &low_bound, &high_bound) < 0)
- count1 = -1, count2 = 0; /* To force error before */
- else
- count2 = high_bound - low_bound + 1;
- if (count2 > count1)
- error ("target varying type is too small");
- val = allocate_value (type);
- valaddr = VALUE_CONTENTS_RAW (val);
- valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
- /* Set val's __var_length field to count2. */
- store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
- count2);
- /* Set the __var_data field to count2 elements copied from arg2. */
- memcpy (valaddr_data, VALUE_CONTENTS (arg2),
- count2 * TYPE_LENGTH (eltype2));
- /* Zero the rest of the __var_data field of val. */
- memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
- (count1 - count2) * TYPE_LENGTH (eltype2));
- return val;
- }
+ /* OBSOLETE else if (chill_varying_type (type)) */
+ /* OBSOLETE { */
+ /* OBSOLETE struct type *range1, *range2, *eltype1, *eltype2; */
+ /* OBSOLETE struct value *val; */
+ /* OBSOLETE int count1, count2; */
+ /* OBSOLETE LONGEST low_bound, high_bound; */
+ /* OBSOLETE char *valaddr, *valaddr_data; */
+ /* OBSOLETE *//* For lint warning about eltype2 possibly uninitialized: */
+ /* OBSOLETE eltype2 = NULL; */
+ /* OBSOLETE if (code2 == TYPE_CODE_BITSTRING) */
+ /* OBSOLETE error ("not implemented: converting bitstring to varying type"); */
+ /* OBSOLETE if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING) */
+ /* OBSOLETE || (eltype1 = check_typedef (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1))), */
+ /* OBSOLETE eltype2 = check_typedef (TYPE_TARGET_TYPE (type2)), */
+ /* OBSOLETE (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2) */
+ /* OBSOLETE *//*|| TYPE_CODE (eltype1) != TYPE_CODE (eltype2) *//* ))) */
+ /* OBSOLETE error ("Invalid conversion to varying type"); */
+ /* OBSOLETE range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0); */
+ /* OBSOLETE range2 = TYPE_FIELD_TYPE (type2, 0); */
+ /* OBSOLETE if (get_discrete_bounds (range1, &low_bound, &high_bound) < 0) */
+ /* OBSOLETE count1 = -1; */
+ /* OBSOLETE else */
+ /* OBSOLETE count1 = high_bound - low_bound + 1; */
+ /* OBSOLETE if (get_discrete_bounds (range2, &low_bound, &high_bound) < 0) */
+ /* OBSOLETE count1 = -1, count2 = 0; *//* To force error before */
+ /* OBSOLETE else */
+ /* OBSOLETE count2 = high_bound - low_bound + 1; */
+ /* OBSOLETE if (count2 > count1) */
+ /* OBSOLETE error ("target varying type is too small"); */
+ /* OBSOLETE val = allocate_value (type); */
+ /* OBSOLETE valaddr = VALUE_CONTENTS_RAW (val); */
+ /* OBSOLETE valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8; */
+ /* OBSOLETE *//* Set val's __var_length field to count2. */
+ /* OBSOLETE store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)), */
+ /* OBSOLETE count2); */
+ /* OBSOLETE *//* Set the __var_data field to count2 elements copied from arg2. */
+ /* OBSOLETE memcpy (valaddr_data, VALUE_CONTENTS (arg2), */
+ /* OBSOLETE count2 * TYPE_LENGTH (eltype2)); */
+ /* OBSOLETE *//* Zero the rest of the __var_data field of val. */
+ /* OBSOLETE memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0', */
+ /* OBSOLETE (count1 - count2) * TYPE_LENGTH (eltype2)); */
+ /* OBSOLETE return val; */
+ /* OBSOLETE } */
else if (VALUE_LVAL (arg2) == lval_memory)
{
return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2),
/* Look for a match through the fields of an anonymous union,
or anonymous struct. C++ provides anonymous unions.
- In the GNU Chill implementation of variant record types,
- each <alternative field> has an (anonymous) union type,
- each member of the union represents a <variant alternative>.
- Each <variant alternative> is represented as a struct,
- with a member for each <variant field>. */
+ In the GNU Chill (OBSOLETE) implementation of
+ variant record types, each <alternative field> has
+ an (anonymous) union type, each member of the union
+ represents a <variant alternative>. Each <variant
+ alternative> is represented as a struct, with a
+ member for each <variant field>. */
struct value *v;
int new_offset = offset;
- /* This is pretty gross. In G++, the offset in an anonymous
- union is relative to the beginning of the enclosing struct.
- In the GNU Chill implementation of variant records,
- the bitpos is zero in an anonymous union field, so we
- have to add the offset of the union here. */
+ /* This is pretty gross. In G++, the offset in an
+ anonymous union is relative to the beginning of the
+ enclosing struct. In the GNU Chill (OBSOLETE)
+ implementation of variant records, the bitpos is
+ zero in an anonymous union field, so we have to add
+ the offset of the union here. */
if (TYPE_CODE (field_type) == TYPE_CODE_STRUCT
|| (TYPE_NFIELDS (field_type) > 0
&& TYPE_FIELD_BITPOS (field_type, 0) == 0))
if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
error ("slice from bad array or bitstring");
if (lowbound < lowerbound || length < 0
- || lowbound + length - 1 > upperbound
- /* Chill allows zero-length strings but not arrays. */
- || (current_language->la_language == language_chill
- && length == 0 && TYPE_CODE (array_type) == TYPE_CODE_ARRAY))
+ || lowbound + length - 1 > upperbound)
+ /* OBSOLETE Chill allows zero-length strings but not arrays. */
+ /* OBSOLETE || (current_language->la_language == language_chill */
+ /* OBSOLETE && length == 0 && TYPE_CODE (array_type) == TYPE_CODE_ARRAY)) */
error ("slice out of range");
/* FIXME-type-allocation: need a way to free this type when we are
done with it. */
return slice;
}
-/* Assuming chill_varying_type (VARRAY) is true, return an equivalent
- value as a fixed-length array. */
+/* Assuming OBSOLETE chill_varying_type (VARRAY) is true, return an
+ equivalent value as a fixed-length array. */
struct value *
varying_to_slice (struct value *varray)
do { COERCE_ARRAY(arg); COERCE_ENUM(arg); } while (0)
#define COERCE_VARYING_ARRAY(arg, real_arg_type) \
-{ if (chill_varying_type (real_arg_type)) \
- arg = varying_to_slice (arg), real_arg_type = VALUE_TYPE (arg); }
+/* OBSOLETE { if (chill_varying_type (real_arg_type)) */ \
+/* OBSOLETE arg = varying_to_slice (arg), real_arg_type = VALUE_TYPE (arg); } */
/* If ARG is an enum, convert it to an integer. */
projects / external / binutils.git / commitdiff