diff options
Diffstat (limited to 'gdb/ch-exp.c')
| -rw-r--r-- | gdb/ch-exp.c | 2169 |
1 files changed, 2169 insertions, 0 deletions
diff --git a/gdb/ch-exp.c b/gdb/ch-exp.c new file mode 100644 index 0000000..45436a3 --- /dev/null +++ b/gdb/ch-exp.c @@ -0,0 +1,2169 @@ +/* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*- + Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc. + +This file is part of GDB. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +/* Parse a Chill expression from text in a string, + and return the result as a struct expression pointer. + That structure contains arithmetic operations in reverse polish, + with constants represented by operations that are followed by special data. + See expression.h for the details of the format. + What is important here is that it can be built up sequentially + during the process of parsing; the lower levels of the tree always + come first in the result. + + Note that 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 PARAMS ((enum exp_opcode, struct type *)); +static enum ch_terminal match_bitstring_literal PARAMS ((void)); +static enum ch_terminal match_integer_literal PARAMS ((void)); +static enum ch_terminal match_character_literal PARAMS ((void)); +static enum ch_terminal match_string_literal PARAMS ((void)); +static enum ch_terminal match_float_literal PARAMS ((void)); +static enum ch_terminal match_float_literal PARAMS ((void)); +static int decode_integer_literal PARAMS ((LONGEST *, char **)); +static int decode_integer_value PARAMS ((int, char **, LONGEST *)); +static char *match_simple_name_string PARAMS ((void)); +static void growbuf_by_size PARAMS ((int)); +static void parse_untyped_expr PARAMS ((void)); +static void parse_if_expression PARAMS ((void)); +static void parse_else_alternative PARAMS ((void)); +static void parse_then_alternative PARAMS ((void)); +static void parse_expr PARAMS ((void)); +static void parse_operand0 PARAMS ((void)); +static void parse_operand1 PARAMS ((void)); +static void parse_operand2 PARAMS ((void)); +static void parse_operand3 PARAMS ((void)); +static void parse_operand4 PARAMS ((void)); +static void parse_operand5 PARAMS ((void)); +static void parse_operand6 PARAMS ((void)); +static void parse_primval PARAMS ((void)); +static void parse_tuple PARAMS ((struct type *)); +static void parse_opt_element_list PARAMS ((struct type *)); +static void parse_tuple_element PARAMS ((struct type *)); +static void parse_named_record_element PARAMS ((void)); +static void parse_call PARAMS ((void)); +static struct type *parse_mode_or_normal_call PARAMS ((void)); +#if 0 +static struct type *parse_mode_call PARAMS ((void)); +#endif +static void parse_unary_call PARAMS ((void)); +static int parse_opt_untyped_expr PARAMS ((void)); +static void parse_case_label PARAMS ((void)); +static int expect PARAMS ((enum ch_terminal, char *)); +static void parse_expr PARAMS ((void)); +static void parse_primval PARAMS ((void)); +static void parse_untyped_expr PARAMS ((void)); +static int parse_opt_untyped_expr PARAMS ((void)); +static void parse_if_expression_body PARAMS((void)); +static enum ch_terminal ch_lex PARAMS ((void)); +INLINE static enum ch_terminal PEEK_TOKEN PARAMS ((void)); +static enum ch_terminal peek_token_ PARAMS ((int)); +static void forward_token_ PARAMS ((void)); +static void require PARAMS ((enum ch_terminal)); +static int check_token PARAMS ((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() +{ + if (terminal_buffer[0] == TOKEN_NOT_READ) + { + terminal_buffer[0] = ch_lex (); + val_buffer[0] = yylval; + } + return terminal_buffer[0]; +} +#define PEEK_LVAL() val_buffer[0] +#define PEEK_TOKEN1() peek_token_(1) +#define PEEK_TOKEN2() peek_token_(2) +static enum ch_terminal +peek_token_ (i) + int i; +{ + if (i > MAX_LOOK_AHEAD) + fatal ("internal error - too much lookahead"); + if (terminal_buffer[i] == TOKEN_NOT_READ) + { + terminal_buffer[i] = ch_lex (); + val_buffer[i] = yylval; + } + return terminal_buffer[i]; +} + +#if 0 + +static void +pushback_token (code, node) + enum ch_terminal code; + YYSTYPE node; +{ + int i; + if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ) + fatal ("internal error - cannot pushback token"); + for (i = MAX_LOOK_AHEAD; i > 0; i--) + { + terminal_buffer[i] = terminal_buffer[i - 1]; + val_buffer[i] = val_buffer[i - 1]; + } + terminal_buffer[0] = code; + val_buffer[0] = node; +} + +#endif + +static void +forward_token_() +{ + int i; + for (i = 0; i < MAX_LOOK_AHEAD; i++) + { + terminal_buffer[i] = terminal_buffer[i+1]; + val_buffer[i] = val_buffer[i+1]; + } + terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ; +} +#define FORWARD_TOKEN() forward_token_() + +/* Skip the next token. + if it isn't TOKEN, the parser is broken. */ + +static void +require(token) + enum ch_terminal token; +{ + if (PEEK_TOKEN() != token) + { + char buf[80]; + sprintf (buf, "internal parser error - expected token %d", (int)token); + fatal(buf); + } + FORWARD_TOKEN(); +} + +static int +check_token (token) + enum ch_terminal token; +{ + if (PEEK_TOKEN() != token) + return 0; + FORWARD_TOKEN (); + return 1; +} + +/* return 0 if expected token was not found, + else return 1. +*/ +static int +expect (token, message) + enum ch_terminal token; + char *message; +{ + if (PEEK_TOKEN() != token) + { + if (message) + error (message); + else if (token < 256) + error ("syntax error - expected a '%c' here \"%s\"", token, lexptr); + else + error ("syntax error"); + return 0; + } + else + FORWARD_TOKEN(); + return 1; +} + +#if 0 +static tree +parse_opt_name_string (allow_all) + int allow_all; /* 1 if ALL is allowed as a postfix */ +{ + int token = PEEK_TOKEN(); + tree name; + if (token != NAME) + { + if (token == ALL && allow_all) + { + FORWARD_TOKEN (); + return ALL_POSTFIX; + } + return NULL_TREE; + } + name = PEEK_LVAL(); + for (;;) + { + FORWARD_TOKEN (); + token = PEEK_TOKEN(); + if (token != '!') + return name; + FORWARD_TOKEN(); + token = PEEK_TOKEN(); + if (token == ALL && allow_all) + return get_identifier3(IDENTIFIER_POINTER (name), "!", "*"); + if (token != NAME) + { + if (pass == 1) + error ("'%s!' is not followed by an identifier", + IDENTIFIER_POINTER (name)); + return name; + } + name = get_identifier3(IDENTIFIER_POINTER(name), + "!", IDENTIFIER_POINTER(PEEK_LVAL())); + } +} + +static tree +parse_simple_name_string () +{ + int token = PEEK_TOKEN(); + tree name; + if (token != NAME) + { + error ("expected a name here"); + return error_mark_node; + } + name = PEEK_LVAL (); + FORWARD_TOKEN (); + return name; +} + +static tree +parse_name_string () +{ + tree name = parse_opt_name_string (0); + if (name) + return name; + if (pass == 1) + error ("expected a name string here"); + return error_mark_node; +} + +/* Matches: <name_string> + Returns if pass 1: the identifier. + Returns if pass 2: a decl or value for identifier. */ + +static tree +parse_name () +{ + tree name = parse_name_string (); + if (pass == 1 || ignoring) + return name; + else + { + tree decl = lookup_name (name); + if (decl == NULL_TREE) + { + error ("`%s' undeclared", IDENTIFIER_POINTER (name)); + return error_mark_node; + } + else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK) + return error_mark_node; + else if (TREE_CODE (decl) == CONST_DECL) + return DECL_INITIAL (decl); + else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE) + return convert_from_reference (decl); + else + return decl; + } +} +#endif + +#if 0 +static void +pushback_paren_expr (expr) + tree expr; +{ + if (pass == 1 && !ignoring) + expr = build1 (PAREN_EXPR, NULL_TREE, expr); + pushback_token (EXPR, expr); +} +#endif + +/* Matches: <case label> */ + +static void +parse_case_label () +{ + if (check_token (ELSE)) + error ("ELSE in tuples labels not implemented"); + /* Does not handle the case of a mode name. FIXME */ + parse_expr (); + if (check_token (':')) + { + parse_expr (); + write_exp_elt_opcode (BINOP_RANGE); + } +} + +static int +parse_opt_untyped_expr () +{ + switch (PEEK_TOKEN ()) + { + case ',': + case ':': + case ')': + return 0; + default: + parse_untyped_expr (); + return 1; + } +} + +static void +parse_unary_call () +{ + FORWARD_TOKEN (); + expect ('(', NULL); + parse_expr (); + expect (')', NULL); +} + +/* Parse NAME '(' MODENAME ')'. */ + +#if 0 + +static struct type * +parse_mode_call () +{ + struct type *type; + FORWARD_TOKEN (); + expect ('(', NULL); + if (PEEK_TOKEN () != TYPENAME) + error ("expect MODENAME here `%s'", lexptr); + type = PEEK_LVAL().tsym.type; + FORWARD_TOKEN (); + expect (')', NULL); + return type; +} + +#endif + +static struct type * +parse_mode_or_normal_call () +{ + struct type *type; + FORWARD_TOKEN (); + expect ('(', NULL); + if (PEEK_TOKEN () == TYPENAME) + { + type = PEEK_LVAL().tsym.type; + FORWARD_TOKEN (); + } + else + { + parse_expr (); + type = NULL; + } + expect (')', NULL); + return type; +} + +/* Parse something that looks like a function call. + Assume we have parsed the function, and are at the '('. */ + +static void +parse_call () +{ + int arg_count; + require ('('); + /* This is to save the value of arglist_len + being accumulated for each dimension. */ + start_arglist (); + if (parse_opt_untyped_expr ()) + { + int tok = PEEK_TOKEN (); + arglist_len = 1; + if (tok == UP || tok == ':') + { + FORWARD_TOKEN (); + parse_expr (); + expect (')', "expected ')' to terminate slice"); + end_arglist (); + write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT + : TERNOP_SLICE); + return; + } + while (check_token (',')) + { + parse_untyped_expr (); + arglist_len++; + } + } + else + arglist_len = 0; + expect (')', 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 () +{ + 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 (type) + 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 (type) + 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 (mode) + 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 () +{ + 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 () +{ + if (check_token (RECEIVE)) + { + parse_primval (); + error ("not implemented: RECEIVE expression"); + } + else if (check_token (POINTER)) + { + parse_primval (); + write_exp_elt_opcode (UNOP_ADDR); + } + else + parse_primval(); +} + +static void +parse_operand5() +{ + enum exp_opcode op; + /* We are supposed to be looking for a <string repetition operator>, + but in general we can't distinguish that from a parenthesized + expression. This is especially difficult if we allow the + string operand to be a constant expression (as requested by + some users), and not just a string literal. + Consider: LPRN expr RPRN LPRN expr RPRN + Is that a function call or string repetition? + Instead, we handle string repetition in parse_primval, + and build_generalized_call. */ + switch (PEEK_TOKEN()) + { + case NOT: op = UNOP_LOGICAL_NOT; break; + case '-': op = UNOP_NEG; break; + default: + op = OP_NULL; + } + if (op != OP_NULL) + FORWARD_TOKEN(); + parse_operand6(); + if (op != OP_NULL) + write_exp_elt_opcode (op); +} + +static void +parse_operand4 () +{ + enum exp_opcode op; + parse_operand5(); + for (;;) + { + switch (PEEK_TOKEN()) + { + case '*': op = BINOP_MUL; break; + case '/': op = BINOP_DIV; break; + case MOD: op = BINOP_MOD; break; + case REM: op = BINOP_REM; break; + default: + return; + } + FORWARD_TOKEN(); + parse_operand5(); + write_exp_elt_opcode (op); + } +} + +static void +parse_operand3 () +{ + enum exp_opcode op; + parse_operand4 (); + for (;;) + { + switch (PEEK_TOKEN()) + { + case '+': op = BINOP_ADD; break; + case '-': op = BINOP_SUB; break; + case SLASH_SLASH: op = BINOP_CONCAT; break; + default: + return; + } + FORWARD_TOKEN(); + parse_operand4(); + write_exp_elt_opcode (op); + } +} + +static void +parse_operand2 () +{ + enum exp_opcode op; + parse_operand3 (); + for (;;) + { + if (check_token (IN)) + { + parse_operand3(); + write_exp_elt_opcode (BINOP_IN); + } + else + { + switch (PEEK_TOKEN()) + { + case '>': op = BINOP_GTR; break; + case GEQ: op = BINOP_GEQ; break; + case '<': op = BINOP_LESS; break; + case LEQ: op = BINOP_LEQ; break; + case '=': op = BINOP_EQUAL; break; + case NOTEQUAL: op = BINOP_NOTEQUAL; break; + default: + return; + } + FORWARD_TOKEN(); + parse_operand3(); + write_exp_elt_opcode (op); + } + } +} + +static void +parse_operand1 () +{ + enum exp_opcode op; + parse_operand2 (); + for (;;) + { + switch (PEEK_TOKEN()) + { + case LOGAND: op = BINOP_BITWISE_AND; break; + case ANDIF: op = BINOP_LOGICAL_AND; break; + default: + return; + } + FORWARD_TOKEN(); + parse_operand2(); + write_exp_elt_opcode (op); + } +} + +static void +parse_operand0 () +{ + enum exp_opcode op; + parse_operand1(); + for (;;) + { + switch (PEEK_TOKEN()) + { + case LOGIOR: op = BINOP_BITWISE_IOR; break; + case LOGXOR: op = BINOP_BITWISE_XOR; break; + case ORIF: op = BINOP_LOGICAL_OR; break; + default: + return; + } + FORWARD_TOKEN(); + parse_operand1(); + write_exp_elt_opcode (op); + } +} + +static void +parse_expr () +{ + parse_operand0 (); + if (check_token (GDB_ASSIGNMENT)) + { + parse_expr (); + write_exp_elt_opcode (BINOP_ASSIGN); + } +} + +static void +parse_then_alternative () +{ + expect (THEN, "missing 'THEN' in 'IF' expression"); + parse_expr (); +} + +static void +parse_else_alternative () +{ + if (check_token (ELSIF)) + parse_if_expression_body (); + else if (check_token (ELSE)) + parse_expr (); + else + error ("missing ELSE/ELSIF in IF expression"); +} + +/* Matches: <boolean expression> <then alternative> <else alternative> */ + +static void +parse_if_expression_body () +{ + parse_expr (); + parse_then_alternative (); + parse_else_alternative (); + write_exp_elt_opcode (TERNOP_COND); +} + +static void +parse_if_expression () +{ + require (IF); + parse_if_expression_body (); + expect (FI, "missing 'FI' at end of conditional expression"); +} + +/* An <untyped_expr> is a superset of <expr>. It also includes + <conditional expressions> and untyped <tuples>, whose types + are not given by their constituents. Hence, these are only + allowed in certain contexts that expect a certain type. + You should call convert() to fix up the <untyped_expr>. */ + +static void +parse_untyped_expr () +{ + switch (PEEK_TOKEN()) + { + case IF: + parse_if_expression (); + return; + case CASE: + error ("not implemented: CASE expression"); + case '(': + switch (PEEK_TOKEN1()) + { + case IF: + case CASE: + goto skip_lprn; + case '[': + skip_lprn: + FORWARD_TOKEN (); + parse_untyped_expr (); + expect (')', "missing ')'"); + return; + default: ; + /* fall through */ + } + default: + parse_operand0 (); + } +} + +int +chill_parse () +{ + terminal_buffer[0] = TOKEN_NOT_READ; + if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN) + { + write_exp_elt_opcode(OP_TYPE); + write_exp_elt_type(PEEK_LVAL ().tsym.type); + write_exp_elt_opcode(OP_TYPE); + FORWARD_TOKEN (); + } + else + parse_expr (); + if (terminal_buffer[0] != END_TOKEN) + { + if (comma_terminates && terminal_buffer[0] == ',') + lexptr--; /* Put the comma back. */ + else + error ("Junk after end of expression."); + } + return 0; +} + + +/* Implementation of a dynamically expandable buffer for processing input + characters acquired through lexptr and building a value to return in + yylval. */ + +static char *tempbuf; /* Current buffer contents */ +static int tempbufsize; /* Size of allocated buffer */ +static int tempbufindex; /* Current index into buffer */ + +#define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */ + +#define CHECKBUF(size) \ + do { \ + if (tempbufindex + (size) >= tempbufsize) \ + { \ + growbuf_by_size (size); \ + } \ + } while (0); + +/* Grow the static temp buffer if necessary, including allocating the first one + on demand. */ + +static void +growbuf_by_size (count) + int count; +{ + int growby; + + growby = max (count, GROWBY_MIN_SIZE); + tempbufsize += growby; + if (tempbuf == NULL) + { + tempbuf = (char *) 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 () +{ + char *tokptr = lexptr; + + if (isalpha (*tokptr) || *tokptr == '_') + { + char *result; + do { + tokptr++; + } while (isalnum (*tokptr) || (*tokptr == '_')); + yylval.sval.ptr = lexptr; + yylval.sval.length = tokptr - lexptr; + lexptr = tokptr; + result = copy_name (yylval.sval); + return result; + } + return (NULL); +} + +/* Start looking for a value composed of valid digits as set by the base + in use. Note that '_' characters are valid anywhere, in any quantity, + and are simply ignored. Since we must find at least one valid digit, + or reject this token as an integer literal, we keep track of how many + digits we have encountered. */ + +static int +decode_integer_value (base, tokptrptr, ivalptr) + int base; + char **tokptrptr; + LONGEST *ivalptr; +{ + char *tokptr = *tokptrptr; + int temp; + int digits = 0; + + while (*tokptr != '\0') + { + temp = *tokptr; + if (isupper (temp)) + temp = tolower (temp); + tokptr++; + switch (temp) + { + case '_': + continue; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + temp -= '0'; + break; + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + temp -= 'a'; + temp += 10; + break; + default: + temp = base; + break; + } + if (temp < base) + { + digits++; + *ivalptr *= base; + *ivalptr += temp; + } + else + { + /* Found something not in domain for current base. */ + tokptr--; /* Unconsume what gave us indigestion. */ + break; + } + } + + /* If we didn't find any digits, then we don't have a valid integer + value, so reject the entire token. Otherwise, update the lexical + scan pointer, and return non-zero for success. */ + + if (digits == 0) + { + return (0); + } + else + { + *tokptrptr = tokptr; + return (1); + } +} + +static int +decode_integer_literal (valptr, tokptrptr) + LONGEST *valptr; + char **tokptrptr; +{ + char *tokptr = *tokptrptr; + int base = 0; + LONGEST ival = 0; + int explicit_base = 0; + + /* Look for an explicit base specifier, which is optional. */ + + switch (*tokptr) + { + case 'd': + case 'D': + explicit_base++; + base = 10; + tokptr++; + break; + case 'b': + case 'B': + explicit_base++; + base = 2; + tokptr++; + break; + case 'h': + case 'H': + explicit_base++; + base = 16; + tokptr++; + break; + case 'o': + case 'O': + explicit_base++; + base = 8; + tokptr++; + break; + default: + base = 10; + break; + } + + /* If we found an explicit base ensure that the character after the + explicit base is a single quote. */ + + if (explicit_base && (*tokptr++ != '\'')) + { + return (0); + } + + /* Attempt to decode whatever follows as an integer value in the + indicated base, updating the token pointer in the process and + computing the value into ival. Also, if we have an explicit + base, then the next character must not be a single quote, or we + have a bitstring literal, so reject the entire token in this case. + Otherwise, update the lexical scan pointer, and return non-zero + for success. */ + + if (!decode_integer_value (base, &tokptr, &ival)) + { + return (0); + } + else if (explicit_base && (*tokptr == '\'')) + { + return (0); + } + else + { + *valptr = ival; + *tokptrptr = tokptr; + return (1); + } +} + +/* If it wasn't for the fact that floating point values can contain '_' + characters, we could just let strtod do all the hard work by letting it + try to consume as much of the current token buffer as possible and + find a legal conversion. Unfortunately we need to filter out the '_' + characters before calling strtod, which we do by copying the other + legal chars to a local buffer to be converted. However since we also + need to keep track of where the last unconsumed character in the input + buffer is, we have transfer only as many characters as may compose a + legal floating point value. */ + +static enum ch_terminal +match_float_literal () +{ + char *tokptr = lexptr; + char *buf; + char *copy; + double dval; + extern double strtod (); + + /* Make local buffer in which to build the string to convert. This is + required because underscores are valid in chill floating point numbers + but not in the string passed to strtod to convert. The string will be + no longer than our input string. */ + + copy = buf = (char *) alloca (strlen (tokptr) + 1); + + /* Transfer all leading digits to the conversion buffer, discarding any + underscores. */ + + while (isdigit (*tokptr) || *tokptr == '_') + { + if (*tokptr != '_') + { + *copy++ = *tokptr; + } + tokptr++; + } + + /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless + of whether we found any leading digits, and we simply accept it and + continue on to look for the fractional part and/or exponent. One of + [eEdD] is legal only if we have seen digits, and means that there + is no fractional part. If we find neither of these, then this is + not a floating point number, so return failure. */ + + switch (*tokptr++) + { + case '.': + /* Accept and then look for fractional part and/or exponent. */ + *copy++ = '.'; + break; + + case 'e': + case 'E': + case 'd': + case 'D': + if (copy == buf) + { + return (0); + } + *copy++ = 'e'; + goto collect_exponent; + break; + + default: + return (0); + break; + } + + /* We found a '.', copy any fractional digits to the conversion buffer, up + to the first nondigit, non-underscore character. */ + + while (isdigit (*tokptr) || *tokptr == '_') + { + if (*tokptr != '_') + { + *copy++ = *tokptr; + } + tokptr++; + } + + /* Look for an exponent, which must start with one of [eEdD]. If none + is found, jump directly to trying to convert what we have collected + so far. */ + + switch (*tokptr) + { + case 'e': + case 'E': + case 'd': + case 'D': + *copy++ = 'e'; + tokptr++; + break; + default: + goto convert_float; + break; + } + + /* Accept an optional '-' or '+' following one of [eEdD]. */ + + collect_exponent: + if (*tokptr == '+' || *tokptr == '-') + { + *copy++ = *tokptr++; + } + + /* Now copy an exponent into the conversion buffer. Note that at the + moment underscores are *not* allowed in exponents. */ + + while (isdigit (*tokptr)) + { + *copy++ = *tokptr++; + } + + /* If we transfered any chars to the conversion buffer, try to interpret its + contents as a floating point value. If any characters remain, then we + must not have a valid floating point string. */ + + convert_float: + *copy = '\0'; + if (copy != buf) + { + dval = strtod (buf, ©); + if (*copy == '\0') + { + yylval.dval = dval; + lexptr = tokptr; + return (FLOAT_LITERAL); + } + } + return (0); +} + +/* Recognize a string literal. A string literal is a sequence + of characters enclosed in matching single or double quotes, except that + a single character inside single quotes is a character literal, which + we reject as a string literal. To embed the terminator character inside + a string, it is simply doubled (I.E. "this""is""one""string") */ + +static enum ch_terminal +match_string_literal () +{ + char *tokptr = lexptr; + 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 () +{ + 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 () +{ + 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) && defined(__STDC__) + 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 () +{ + 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 == BIG_ENDIAN ? bits_per_char - 1 : 0; + for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char; + TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++) + { + bitcount++; + if (digit & (1 << k)) + { + tempbuf[tempbufindex] |= + (TARGET_BYTE_ORDER == BIG_ENDIAN) + ? (1 << (HOST_CHAR_BIT - 1 - bitoffset)) + : (1 << bitoffset); + } + bitoffset++; + if (bitoffset == HOST_CHAR_BIT) + { + bitoffset = 0; + tempbufindex++; + CHECKBUF(1); + tempbuf[tempbufindex] = 0; + } + } + } + } + + /* Verify that we consumed everything up to the trailing single quote, + and that we found some bits (IE not just underbars). */ + + if (*tokptr++ != '\'') + { + return (0); + } + else + { + yylval.sval.ptr = tempbuf; + yylval.sval.length = bitcount; + lexptr = tokptr; + return (BIT_STRING_LITERAL); + } +} + +struct token +{ + char *operator; + int token; +}; + +static const struct token idtokentab[] = +{ + { "array", ARRAY }, + { "length", LENGTH }, + { "lower", LOWER }, + { "upper", UPPER }, + { "andif", ANDIF }, + { "pred", PRED }, + { "succ", SUCC }, + { "card", CARD }, + { "size", SIZE }, + { "orif", ORIF }, + { "num", NUM }, + { "abs", ABS }, + { "max", MAX_TOKEN }, + { "min", MIN_TOKEN }, + { "mod", MOD }, + { "rem", REM }, + { "not", NOT }, + { "xor", LOGXOR }, + { "and", LOGAND }, + { "in", IN }, + { "or", LOGIOR }, + { "up", UP }, + { "addr", ADDR_TOKEN }, + { "null", EMPTINESS_LITERAL } +}; + +static const struct token tokentab2[] = +{ + { ":=", GDB_ASSIGNMENT }, + { "//", SLASH_SLASH }, + { "->", POINTER }, + { "/=", NOTEQUAL }, + { "<=", LEQ }, + { ">=", GEQ } +}; + +/* Read one token, getting characters through lexptr. */ +/* This is where we will check to make sure that the language and the + operators used are compatible. */ + +static enum ch_terminal +ch_lex () +{ + unsigned int i; + enum ch_terminal token; + char *inputname; + struct symbol *sym; + + /* Skip over any leading whitespace. */ + while (isspace (*lexptr)) + { + lexptr++; + } + /* Look for special single character cases which can't be the first + character of some other multicharacter token. */ + switch (*lexptr) + { + case '\0': + return END_TOKEN; + case ',': + case '=': + case ';': + case '!': + case '+': + case '*': + case '(': + case ')': + case '[': + case ']': + return (*lexptr++); + } + /* Look for characters which start a particular kind of multicharacter + token, such as a character literal, register name, convenience + variable name, string literal, etc. */ + switch (*lexptr) + { + case '\'': + case '\"': + /* First try to match a string literal, which is any + sequence of characters enclosed in matching single or double + quotes, except that a single character inside single quotes + is a character literal, so we have to catch that case also. */ + token = match_string_literal (); + if (token != 0) + { + return (token); + } + if (*lexptr == '\'') + { + token = match_character_literal (); + if (token != 0) + { + return (token); + } + } + break; + case 'C': + case 'c': + token = match_character_literal (); + if (token != 0) + { + return (token); + } + break; + case '$': + yylval.sval.ptr = lexptr; + do { + lexptr++; + } while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$'); + yylval.sval.length = lexptr - yylval.sval.ptr; + write_dollar_variable (yylval.sval); + return GDB_VARIABLE; + break; + } + /* See if it is a special token of length 2. */ + for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++) + { + if (STREQN (lexptr, tokentab2[i].operator, 2)) + { + lexptr += 2; + return (tokentab2[i].token); + } + } + /* Look for single character cases which which could be the first + character of some other multicharacter token, but aren't, or we + would already have found it. */ + switch (*lexptr) + { + case '-': + case ':': + case '/': + case '<': + case '>': + return (*lexptr++); + } + /* Look for a float literal before looking for an integer literal, so + we match as much of the input stream as possible. */ + token = match_float_literal (); + if (token != 0) + { + return (token); + } + token = match_bitstring_literal (); + if (token != 0) + { + return (token); + } + token = match_integer_literal (); + if (token != 0) + { + return (token); + } + + /* Try to match a simple name string, and if a match is found, then + further classify what sort of name it is and return an appropriate + token. Note that attempting to match a simple name string consumes + the token from lexptr, so we can't back out if we later find that + we can't classify what sort of name it is. */ + + inputname = match_simple_name_string (); + + if (inputname != NULL) + { + char *simplename = (char*) alloca (strlen (inputname) + 1); + + char *dptr = simplename, *sptr = inputname; + for (; *sptr; sptr++) + *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr; + *dptr = '\0'; + + /* See if it is a reserved identifier. */ + for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++) + { + if (STREQ (simplename, idtokentab[i].operator)) + { + return (idtokentab[i].token); + } + } + + /* Look for other special tokens. */ + if (STREQ (simplename, "true")) + { + yylval.ulval = 1; + return (BOOLEAN_LITERAL); + } + if (STREQ (simplename, "false")) + { + yylval.ulval = 0; + return (BOOLEAN_LITERAL); + } + + sym = lookup_symbol (inputname, expression_context_block, + VAR_NAMESPACE, (int *) NULL, + (struct symtab **) NULL); + if (sym == NULL && strcmp (inputname, simplename) != 0) + { + sym = lookup_symbol (simplename, expression_context_block, + VAR_NAMESPACE, (int *) NULL, + (struct symtab **) NULL); + } + if (sym != NULL) + { + yylval.ssym.stoken.ptr = NULL; + yylval.ssym.stoken.length = 0; + yylval.ssym.sym = sym; + yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */ + switch (SYMBOL_CLASS (sym)) + { + case LOC_BLOCK: + /* Found a procedure name. */ + return (GENERAL_PROCEDURE_NAME); + case LOC_STATIC: + /* Found a global or local static variable. */ + return (LOCATION_NAME); + case LOC_REGISTER: + case LOC_ARG: + case LOC_REF_ARG: + case LOC_REGPARM: + case LOC_REGPARM_ADDR: + case LOC_LOCAL: + case LOC_LOCAL_ARG: + case LOC_BASEREG: + case LOC_BASEREG_ARG: + if (innermost_block == NULL + || contained_in (block_found, innermost_block)) + { + innermost_block = block_found; + } + return (LOCATION_NAME); + break; + case LOC_CONST: + case LOC_LABEL: + return (LOCATION_NAME); + break; + case LOC_TYPEDEF: + yylval.tsym.type = SYMBOL_TYPE (sym); + return TYPENAME; + case LOC_UNDEF: + case LOC_CONST_BYTES: + case LOC_OPTIMIZED_OUT: + error ("Symbol \"%s\" names no location.", inputname); + break; + case LOC_UNRESOLVED: + error ("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 (opcode, type) + 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 (msg) + char *msg; +{ + /* Never used. */ +} |