2144 lines
49 KiB
C
2144 lines
49 KiB
C
/* 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 */
|
|
|
|
typedef union
|
|
|
|
{
|
|
LONGEST lval;
|
|
unsigned LONGEST 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,
|
|
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 parse_expr ();
|
|
static void parse_primval ();
|
|
static void parse_untyped_expr ();
|
|
static int parse_opt_untyped_expr ();
|
|
static void parse_if_expression_body PARAMS((void));
|
|
static void write_lower_upper_value PARAMS ((enum exp_opcode, struct type *));
|
|
static enum ch_terminal ch_lex ();
|
|
static void calculate_array_length PARAMS ((struct type *));
|
|
|
|
#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;*/
|
|
|
|
#ifdef __GNUC__
|
|
__inline__
|
|
#endif
|
|
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. */
|
|
|
|
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();
|
|
}
|
|
|
|
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.
|
|
*/
|
|
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 ')'. */
|
|
|
|
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;
|
|
}
|
|
|
|
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;
|
|
|
|
label = PEEK_LVAL ().sval;
|
|
expect (FIELD_NAME, "expected a field name here `%s'", lexptr);
|
|
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 nore TREE_LIST nodes, in reverse order. */
|
|
|
|
static void
|
|
parse_tuple_element ()
|
|
{
|
|
if (PEEK_TOKEN () == FIELD_NAME)
|
|
{
|
|
/* Parse a labelled structure tuple. */
|
|
parse_named_record_element ();
|
|
return;
|
|
}
|
|
|
|
if (check_token ('('))
|
|
{
|
|
if (check_token ('*'))
|
|
{
|
|
expect (')', "missing ')' after '*' case label list");
|
|
error ("(*) not implemented in case label list");
|
|
}
|
|
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 ()
|
|
{
|
|
arglist_len = 0;
|
|
if (PEEK_TOKEN () == ']')
|
|
return;
|
|
for (;;)
|
|
{
|
|
parse_tuple_element ();
|
|
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;
|
|
{
|
|
require ('[');
|
|
start_arglist ();
|
|
parse_opt_element_list ();
|
|
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 (mode)
|
|
{
|
|
struct type *type = check_typedef (mode);
|
|
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:
|
|
{
|
|
struct type *type;
|
|
|
|
/* FIXME: look at calculate_array_length */
|
|
type = PEEK_LVAL().ssym.sym->type;
|
|
if (type && TYPE_CODE (type) == TYPE_CODE_ARRAY &&
|
|
TYPE_LENGTH (type) == 0)
|
|
calculate_array_length (type);
|
|
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 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 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
|
|
{
|
|
extern LONGEST type_lower_upper ();
|
|
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);
|
|
}
|
|
}
|
|
|
|
/* In certain cases it could happen, that an array type doesn't
|
|
have a length (this have to do with seizing). The reason is
|
|
shown in the following stabs:
|
|
|
|
.stabs "m_x:Tt81=s36i:1,0,32;ar:82=ar80;0;1;83=xsm_struct:,32,256;;",128,0,25,0
|
|
|
|
.stabs "m_struct:Tt83=s16f1:9,0,16;f2:85=*84,32,32;f3:84,64,64;;",128,0,10,0
|
|
|
|
When processing t81, the array ar80 doesn't have a length, cause
|
|
struct m_struct is specified extern at thse moment. Afterwards m_struct
|
|
gets specified and updated, but not the surrounding type.
|
|
|
|
So we walk through array's till we find a type with a length and
|
|
calculate the array length.
|
|
|
|
FIXME: Where may this happen too ?
|
|
*/
|
|
|
|
static void
|
|
calculate_array_length (type)
|
|
struct type *type;
|
|
{
|
|
struct type *target_type;
|
|
struct type *range_type;
|
|
LONGEST lower_bound, upper_bound;
|
|
|
|
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
|
|
/* not an array, stop processing */
|
|
return;
|
|
|
|
target_type = TYPE_TARGET_TYPE (type);
|
|
range_type = TYPE_FIELD_TYPE (type, 0);
|
|
lower_bound = TYPE_FIELD_BITPOS (range_type, 0);
|
|
upper_bound = TYPE_FIELD_BITPOS (range_type, 1);
|
|
|
|
if (TYPE_LENGTH (target_type) == 0 &&
|
|
TYPE_CODE (target_type) == TYPE_CODE_ARRAY)
|
|
/* we've got another array */
|
|
calculate_array_length (target_type);
|
|
|
|
TYPE_LENGTH (type) = (upper_bound - lower_bound + 1) * TYPE_LENGTH (target_type);
|
|
}
|
|
|
|
void
|
|
chill_error (msg)
|
|
char *msg;
|
|
{
|
|
/* Never used. */
|
|
}
|