diff options
| author | Andrew Cagney <cagney@redhat.com> | 2002-08-01 17:18:35 +0000 |
|---|---|---|
| committer | Andrew Cagney <cagney@redhat.com> | 2002-08-01 17:18:35 +0000 |
| commit | db034ac5129e86e2dfccebe047f0ee50fd933ec9 (patch) | |
| tree | 48a20cc3afa78a03ab473f5894371ed6d636f01c | |
| parent | e2b28d048de97e7007086f4b50617060b6690d76 (diff) | |
| download | gdb-db034ac5129e86e2dfccebe047f0ee50fd933ec9.zip gdb-db034ac5129e86e2dfccebe047f0ee50fd933ec9.tar.gz gdb-db034ac5129e86e2dfccebe047f0ee50fd933ec9.tar.bz2 | |
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-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.
38 files changed, 4806 insertions, 4718 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 772ec18..236e969 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,66 @@ +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. diff --git a/gdb/Makefile.in b/gdb/Makefile.in index d6bdc0b..3bf498e 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -425,9 +425,6 @@ FLAGS_TO_PASS = \ "AR_FLAGS=$(AR_FLAGS)" \ "CC=$(CC)" \ "CFLAGS=$(CFLAGS)" \ - "CHILLFLAGS=$(CHILLFLAGS)" \ - "CHILL=$(CHILL)" \ - "CHILL_LIB=$(CHILL_LIB)" \ "CXX=$(CXX)" \ "CXXFLAGS=$(CXXFLAGS)" \ "DLLTOOL=$(DLLTOOL)" \ @@ -477,25 +474,25 @@ CXX_FOR_TARGET = ` \ 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. @@ -506,10 +503,6 @@ TARGET_FLAGS_TO_PASS = \ '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)" \ @@ -527,7 +520,7 @@ TARGET_FLAGS_TO_PASS = \ 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 \ @@ -697,7 +690,7 @@ HFILES_NO_SRCDIR = bcache.h buildsym.h call-cmds.h coff-solib.h defs.h \ 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 \ @@ -750,14 +743,14 @@ COMMON_OBS = version.o blockframe.o breakpoint.o findvar.o regcache.o \ 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 \ @@ -1212,7 +1205,7 @@ MAKEOVERRIDES= ## 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 \ @@ -1367,19 +1360,19 @@ f-typeprint.o: f-typeprint.c $(defs_h) $(gdb_obstack_h) $(bfd_h) $(symtab_h) \ 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) @@ -64,6 +64,10 @@ OS/9000 i[34]86-*-os9k 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 diff --git a/gdb/ch-exp.c b/gdb/ch-exp.c index e96a6f8..d588ec2 100644 --- a/gdb/ch-exp.c +++ b/gdb/ch-exp.c @@ -1,2233 +1,2233 @@ -/* 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 } diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c index b46dce0..50b446e 100644 --- a/gdb/ch-lang.c +++ b/gdb/ch-lang.c @@ -1,663 +1,663 @@ -/* 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); -} - - -/* 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} -}; - -/* 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 +// 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 +// 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 } diff --git a/gdb/ch-lang.h b/gdb/ch-lang.h index b55e2dd..d4e5356 100644 --- a/gdb/ch-lang.h +++ b/gdb/ch-lang.h @@ -1,41 +1,41 @@ -/* 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 **); diff --git a/gdb/ch-typeprint.c b/gdb/ch-typeprint.c index 2adba4c..32590f8 100644 --- a/gdb/ch-typeprint.c +++ b/gdb/ch-typeprint.c @@ -1,340 +1,340 @@ -/* 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 } diff --git a/gdb/ch-valprint.c b/gdb/ch-valprint.c index 405e86e..f2a35b3 100644 --- a/gdb/ch-valprint.c +++ b/gdb/ch-valprint.c @@ -1,605 +1,605 @@ -/* 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); - - -/* 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); -} - -/* 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, "]"); -} - -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 +// 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 +// 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 +// 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 } @@ -209,7 +209,7 @@ enum language 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 */ @@ -300,9 +300,9 @@ extern int inside_entry_file (CORE_ADDR addr); 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 */ diff --git a/gdb/doc/ChangeLog b/gdb/doc/ChangeLog index a6e1afe..5f1917c 100644 --- a/gdb/doc/ChangeLog +++ b/gdb/doc/ChangeLog @@ -1,3 +1,8 @@ +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". diff --git a/gdb/doc/gdb.texinfo b/gdb/doc/gdb.texinfo index 87b15a3..5c8922f 100644 --- a/gdb/doc/gdb.texinfo +++ b/gdb/doc/gdb.texinfo @@ -194,10 +194,12 @@ You can use @value{GDBN} to debug programs written in C and C++. 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 @@ -7114,10 +7116,10 @@ C@t{++} source file @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 @@ -7390,7 +7392,9 @@ being set automatically by @value{GDBN}. @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, @@ -7409,7 +7413,7 @@ language reference or tutorial. @menu * C:: C and C@t{++} * Modula-2:: Modula-2 -* Chill:: Chill +@c OBSOLETE * Chill:: Chill @end menu @node C @@ -8375,504 +8379,504 @@ address can be specified by an integral constant, the construct 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 diff --git a/gdb/doc/gdbint.texinfo b/gdb/doc/gdbint.texinfo index 0336015..433844a 100644 --- a/gdb/doc/gdbint.texinfo +++ b/gdb/doc/gdbint.texinfo @@ -1834,7 +1834,7 @@ The file @file{mdebugread.c} implements reading for this format. 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 diff --git a/gdb/doc/stabs.texinfo b/gdb/doc/stabs.texinfo index 52b88b4..6b4c3dc 100644 --- a/gdb/doc/stabs.texinfo +++ b/gdb/doc/stabs.texinfo @@ -1754,7 +1754,8 @@ Pascal set type. @var{type-information} must be a small type such as an 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} @@ -1955,7 +1956,8 @@ string. I don't know the difference. 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}). diff --git a/gdb/dwarfread.c b/gdb/dwarfread.c index dc72f87..9c4201d 100644 --- a/gdb/dwarfread.c +++ b/gdb/dwarfread.c @@ -186,9 +186,9 @@ typedef unsigned int DIE_REF; /* Reference to a DIE */ #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 @@ -621,9 +621,9 @@ set_cu_language (struct dieinfo *dip) 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; @@ -1822,8 +1822,8 @@ handle_producer (char *producer) 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 @@ -186,8 +186,8 @@ get_label (register struct expression *exp, int *pos) 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, @@ -325,13 +325,11 @@ 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, diff --git a/gdb/expprint.c b/gdb/expprint.c index 09e7db6..9f3f171 100644 --- a/gdb/expprint.c +++ b/gdb/expprint.c @@ -217,8 +217,9 @@ print_subexp (register struct expression *exp, register int *pos, } 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) @@ -227,7 +228,8 @@ print_subexp (register struct expression *exp, register int *pos, } print_subexp (exp, pos, stream, PREC_ABOVE_COMMA); } - fputs_filtered (is_chill ? "]" : "}", stream); + /* OBSOLETE fputs_filtered (is_chill ? "]" : "}", stream); */ + fputs_filtered ("}", stream); } return; @@ -235,15 +237,17 @@ print_subexp (register struct expression *exp, register int *pos, 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 diff --git a/gdb/expression.h b/gdb/expression.h index 0fbab03..34e002f 100644 --- a/gdb/expression.h +++ b/gdb/expression.h @@ -109,10 +109,11 @@ enum exp_opcode 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. */ @@ -121,12 +122,13 @@ enum exp_opcode /* 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,...]. @@ -251,7 +253,7 @@ enum exp_opcode 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 */ @@ -281,12 +283,15 @@ enum exp_opcode 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, diff --git a/gdb/gdbserver/Makefile.in b/gdb/gdbserver/Makefile.in index bc9256b..ae77ec9 100644 --- a/gdb/gdbserver/Makefile.in +++ b/gdb/gdbserver/Makefile.in @@ -230,7 +230,7 @@ MAKEOVERRIDES= ## 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 diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index 562481c..7db3f9a 100644 --- a/gdb/gdbtypes.c +++ b/gdb/gdbtypes.c @@ -1888,21 +1888,23 @@ is_integral_type (struct type *t) || (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. diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index 8221bce..b67c54f 100644 --- a/gdb/gdbtypes.h +++ b/gdb/gdbtypes.h @@ -101,13 +101,14 @@ enum type_code 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 @@ -994,13 +995,13 @@ extern struct type *builtin_type_m2_card; 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 */ @@ -1109,7 +1110,7 @@ extern struct type *create_string_type (struct type *, struct type *); 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 *); diff --git a/gdb/language.c b/gdb/language.c index 9cbb317..dc94ebd 100644 --- a/gdb/language.c +++ b/gdb/language.c @@ -567,8 +567,8 @@ binop_result_type (struct value *v1, struct value *v2) 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 */ @@ -791,8 +791,8 @@ integral_type (struct type *type) 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."); } @@ -821,7 +821,7 @@ character_type (struct type *type) 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; @@ -843,7 +843,7 @@ string_type (struct type *type) 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; @@ -868,8 +868,9 @@ boolean_type (struct type *type) { 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: @@ -915,8 +916,8 @@ structured_type (struct type *type) 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); } @@ -930,8 +931,10 @@ lang_bool_type (void) 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) @@ -1161,9 +1164,9 @@ binop_type_check (struct value *arg1, struct value *arg2, int op) } #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 } diff --git a/gdb/language.h b/gdb/language.h index 301fefd..67a8ff2 100644 --- a/gdb/language.h +++ b/gdb/language.h @@ -35,7 +35,7 @@ struct expression; /* #include "lang_def.h" */ #define _LANG_c #define _LANG_m2 -#define _LANG_chill +/* OBSOLETE #define _LANG_chill */ #define _LANG_fortran #define _LANG_pascal diff --git a/gdb/stabsread.c b/gdb/stabsread.c index 7e6647c..6011769 100644 --- a/gdb/stabsread.c +++ b/gdb/stabsread.c @@ -3739,8 +3739,9 @@ read_struct_fields (struct field_info *fip, char **pp, struct type *type, } 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; @@ -4889,9 +4890,11 @@ read_range_type (char **pp, int typenums[2], struct objfile *objfile) else if (self_subrange && n2 == 0 && n3 == 127) return init_type (TYPE_CODE_INT, 1, 0, NULL, objfile); - else if (current_symbol && SYMBOL_LANGUAGE (current_symbol) == language_chill - && !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) diff --git a/gdb/symfile.c b/gdb/symfile.c index 9e9435d..8d63484 100644 --- a/gdb/symfile.c +++ b/gdb/symfile.c @@ -1963,9 +1963,9 @@ init_filename_language_table (void) 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); @@ -2443,9 +2443,9 @@ add_psymbol_with_dem_name_to_list (char *name, int namelength, char *dem_name, 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. */ } diff --git a/gdb/symtab.c b/gdb/symtab.c index e712063..d39962e 100644 --- a/gdb/symtab.c +++ b/gdb/symtab.c @@ -438,24 +438,26 @@ symbol_init_demangled_name (struct general_symbol_info *gsymbol, 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 } diff --git a/gdb/symtab.h b/gdb/symtab.h index ebb1861..7f511f0 100644 --- a/gdb/symtab.h +++ b/gdb/symtab.h @@ -89,11 +89,13 @@ struct general_symbol_info 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; @@ -144,10 +146,10 @@ extern CORE_ADDR symbol_overlayed_address (CORE_ADDR, asection *); { \ 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, \ @@ -168,12 +170,12 @@ extern void symbol_init_demangled_name (struct general_symbol_info *symbol, (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 diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index 351844e..4eba1d1 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,13 @@ +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 diff --git a/gdb/testsuite/Makefile.in b/gdb/testsuite/Makefile.in index b936e39..f7f610a 100644 --- a/gdb/testsuite/Makefile.in +++ b/gdb/testsuite/Makefile.in @@ -67,10 +67,6 @@ TARGET_FLAGS_TO_PASS = \ '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)" \ diff --git a/gdb/testsuite/configure b/gdb/testsuite/configure index bdfc4cd..26d555e 100755 --- a/gdb/testsuite/configure +++ b/gdb/testsuite/configure @@ -32,7 +32,6 @@ program_suffix=NONE program_transform_name=s,x,x, silent= site= -sitefile= srcdir= target=NONE verbose= @@ -147,7 +146,6 @@ Configuration: --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 @@ -318,11 +316,6 @@ EOF -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=*) @@ -488,16 +481,12 @@ fi 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 @@ -586,7 +575,7 @@ else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } 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 @@ -607,7 +596,7 @@ host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` 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 @@ -625,7 +614,7 @@ target_os=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` 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 @@ -655,7 +644,6 @@ configdirs="gdb.arch \ gdb.c++ \ gdb.java \ gdb.disasm \ - gdb.chill \ gdb.mi \ gdb.threads \ gdb.trace" @@ -750,12 +738,12 @@ fi # 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() { @@ -766,7 +754,7 @@ 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 @@ -783,19 +771,19 @@ echo "$ac_t""$ac_cv_cygwin" 1>&6 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 @@ -814,7 +802,7 @@ test "$ac_cv_mingw32" = yes && MINGW32=yes 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 @@ -824,10 +812,10 @@ 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 diff --git a/gdb/testsuite/configure.in b/gdb/testsuite/configure.in index 48e50d8..ab37e6d 100644 --- a/gdb/testsuite/configure.in +++ b/gdb/testsuite/configure.in @@ -19,7 +19,6 @@ configdirs="gdb.arch \ gdb.c++ \ gdb.java \ gdb.disasm \ - gdb.chill \ gdb.mi \ gdb.threads \ gdb.trace" diff --git a/gdb/testsuite/gdb.fortran/exprs.exp b/gdb/testsuite/gdb.fortran/exprs.exp index cccc82a..6c9be34 100644 --- a/gdb/testsuite/gdb.fortran/exprs.exp +++ b/gdb/testsuite/gdb.fortran/exprs.exp @@ -17,7 +17,7 @@ # 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 diff --git a/gdb/testsuite/gdb.fortran/types.exp b/gdb/testsuite/gdb.fortran/types.exp index 13bec5d..175549c 100644 --- a/gdb/testsuite/gdb.fortran/types.exp +++ b/gdb/testsuite/gdb.fortran/types.exp @@ -17,7 +17,7 @@ # 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 diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 471d08e..0ccc1b6 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -27,17 +27,17 @@ 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; @@ -920,25 +920,25 @@ proc skip_cplus_tests {} { 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. diff --git a/gdb/typeprint.c b/gdb/typeprint.c index f974b7f..c4262d9 100644 --- a/gdb/typeprint.c +++ b/gdb/typeprint.c @@ -88,16 +88,16 @@ typedef_print (struct type *type, struct symbol *new, struct ui_file *stream) 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."); diff --git a/gdb/utils.c b/gdb/utils.c index 01b9dbc..0c46f79 100644 --- a/gdb/utils.c +++ b/gdb/utils.c @@ -2153,9 +2153,11 @@ fprintf_symbol_filtered (struct ui_file *stream, char *name, enum language lang, 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; diff --git a/gdb/valarith.c b/gdb/valarith.c index cc067cb..279528a 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -859,7 +859,7 @@ value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op) /* 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); @@ -946,12 +946,12 @@ value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op) 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; @@ -1070,12 +1070,12 @@ value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op) 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; @@ -1338,8 +1338,8 @@ value_neg (struct value *arg1) 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; diff --git a/gdb/valops.c b/gdb/valops.c index 2e60ec7..1d0039f 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -383,49 +383,49 @@ value_cast (struct type *type, struct value *arg2) 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), @@ -2074,20 +2074,22 @@ search_struct_field (char *name, struct value *arg1, int offset, /* 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)) @@ -3310,10 +3312,10 @@ value_slice (struct value *array, int lowbound, int length) 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. */ @@ -3369,8 +3371,8 @@ value_slice (struct value *array, int lowbound, int length) 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) diff --git a/gdb/value.h b/gdb/value.h index a596f5b..448c222 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -242,8 +242,8 @@ do { COERCE_REF(arg); \ 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. */ |