/* YACC grammar for Chill expressions, for GDB.
- Copyright (C) 1992 Free Software Foundation, Inc.
+ Copyright 1992, 1993 Free Software Foundation, Inc.
This file is part of GDB.
%{
-#include <stdio.h>
-#include <string.h>
#include "defs.h"
-#include "symtab.h"
-#include "gdbtypes.h"
-#include "frame.h"
+#include <ctype.h>
#include "expression.h"
#include "language.h"
#include "value.h"
#include "parser-defs.h"
-#include "bfd.h"
-#include "symfile.h"
-#include "objfiles.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 */
+
+/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
+ as well as gratuitiously global symbol names, so we can have multiple
+ yacc generated parsers in gdb. Note that these are only the variables
+ produced by yacc. If other parser generators (bison, byacc, etc) produce
+ additional global names that conflict at link time, then those parser
+ generators need to be fixed instead of adding those names to this list. */
-/* These MUST be included in any grammar file!!!! Please choose unique names!
- Note that this are a combined list of variables that can be produced
- by any one of bison, byacc, or yacc. */
#define yymaxdepth chill_maxdepth
#define yyparse chill_parse
#define yylex chill_lex
#define yypgo chill_pgo
#define yyact chill_act
#define yyexca chill_exca
-#define yyerrflag chill_errflag
-#define yynerrs chill_nerrs
+#define yyerrflag chill_errflag
+#define yynerrs chill_nerrs
#define yyps chill_ps
#define yypv chill_pv
#define yys chill_s
#define yy_yyv chill_yyv
#define yyval chill_val
#define yylloc chill_lloc
-#define yyss chill_yyss /* byacc */
-#define yyssp chill_yysp /* byacc */
-#define yyvs chill_yyvs /* byacc */
-#define yyvsp chill_yyvsp /* byacc */
+#define yyreds chill_reds /* With YYDEBUG defined */
+#define yytoks chill_toks /* With YYDEBUG defined */
-static int
-yylex PARAMS ((void));
-
-static void
-yyerror PARAMS ((char *));
+#ifndef YYDEBUG
+#define YYDEBUG 0 /* Default to no yydebug support */
+#endif
int
yyparse PARAMS ((void));
-/* #define YYDEBUG 1 */
+static int
+yylex PARAMS ((void));
+
+void
+yyerror PARAMS ((char *));
%}
int *ivec;
}
-%{
-static int parse_number PARAMS ((void));
-%}
-
-%token <voidval> FIXME
+%token <voidval> FIXME_01
+%token <voidval> FIXME_02
+%token <voidval> FIXME_03
+%token <voidval> FIXME_04
+%token <voidval> FIXME_05
+%token <voidval> FIXME_06
+%token <voidval> FIXME_07
+%token <voidval> FIXME_08
+%token <voidval> FIXME_09
+%token <voidval> FIXME_10
+%token <voidval> FIXME_11
+%token <voidval> FIXME_12
+%token <voidval> FIXME_13
+%token <voidval> FIXME_14
+%token <voidval> FIXME_15
+%token <voidval> FIXME_16
+%token <voidval> FIXME_17
+%token <voidval> FIXME_18
+%token <voidval> FIXME_19
+%token <voidval> FIXME_20
+%token <voidval> FIXME_21
+%token <voidval> FIXME_22
+%token <voidval> FIXME_24
+%token <voidval> FIXME_25
+%token <voidval> FIXME_26
+%token <voidval> FIXME_27
+%token <voidval> FIXME_28
+%token <voidval> FIXME_29
+%token <voidval> FIXME_30
%token <typed_val> INTEGER_LITERAL
%token <ulval> BOOLEAN_LITERAL
%token <typed_val> CHARACTER_LITERAL
+%token <dval> FLOAT_LITERAL
%token <ssym> GENERAL_PROCEDURE_NAME
%token <ssym> LOCATION_NAME
%token <voidval> SET_LITERAL
%token <voidval> EMPTINESS_LITERAL
-%token <voidval> CHARACTER_STRING_LITERAL
-%token <voidval> BIT_STRING_LITERAL
+%token <sval> CHARACTER_STRING_LITERAL
+%token <sval> BIT_STRING_LITERAL
+%token <tsym> TYPENAME
+%token <sval> FIELD_NAME
-%token <voidval> STRING
-%token <voidval> CONSTANT
%token <voidval> '.'
%token <voidval> ';'
%token <voidval> ':'
%token <voidval> NOT
%token <voidval> POINTER
%token <voidval> RECEIVE
-%token <voidval> SC
%token <voidval> '['
%token <voidval> ']'
%token <voidval> '('
%token <voidval> FI
%token <voidval> ELSIF
%token <voidval> ILLEGAL_TOKEN
+%token <voidval> NUM
+%token <voidval> PRED
+%token <voidval> SUCC
+%token <voidval> ABS
+%token <voidval> CARD
+%token <voidval> MAX_TOKEN
+%token <voidval> MIN_TOKEN
+%token <voidval> SIZE
+%token <voidval> UPPER
+%token <voidval> LOWER
+%token <voidval> LENGTH
+
+/* Tokens which are not Chill tokens used in expressions, but rather GDB
+ specific things that we recognize in the same context as Chill tokens
+ (register names for example). */
+
+%token <lval> GDB_REGNAME /* Machine register name */
+%token <lval> GDB_LAST /* Value history */
+%token <ivar> GDB_VARIABLE /* Convenience variable */
+%token <voidval> GDB_ASSIGNMENT /* Assign value to somewhere */
%type <voidval> location
%type <voidval> access_name
%type <voidval> expression_conversion
%type <voidval> value_procedure_call
%type <voidval> value_built_in_routine_call
+%type <voidval> chill_value_built_in_routine_call
%type <voidval> start_expression
%type <voidval> zero_adic_operator
%type <voidval> parenthesised_expression
%type <voidval> operand_4
%type <voidval> operand_5
%type <voidval> operand_6
-%type <voidval> integer_literal_expression
%type <voidval> synonym_name
%type <voidval> value_enumeration_name
%type <voidval> value_do_with_name
%type <voidval> lower_element
%type <voidval> upper_element
%type <voidval> first_element
-%type <voidval> structure_primitive_value
-%type <voidval> field_name
-%type <voidval> mode_name
+%type <voidval> mode_argument
+%type <voidval> upper_lower_argument
+%type <voidval> length_argument
+%type <voidval> array_mode_name
+%type <voidval> string_mode_name
+%type <voidval> variant_structure_mode_name
%type <voidval> boolean_expression
%type <voidval> case_selector_list
%type <voidval> subexpression
%type <voidval> case_label_specification
%type <voidval> buffer_location
+%type <voidval> single_assignment_action
+%type <tsym> mode_name
%%
/* Z.200, 5.3.1 */
+start : value { }
+ | mode_name
+ { write_exp_elt_opcode(OP_TYPE);
+ write_exp_elt_type($1.type);
+ write_exp_elt_opcode(OP_TYPE);}
+ ;
+
value : expression
{
$$ = 0; /* FIXME */
}
;
-undefined_value : FIXME
+undefined_value : FIXME_01
{
$$ = 0; /* FIXME */
}
/* Z.200, 4.2.1 */
location : access_name
+ | primitive_value POINTER
{
- $$ = 0; /* FIXME */
- }
- | FIXME
- {
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (UNOP_IND);
}
;
access_name : LOCATION_NAME
{
write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_block (NULL);
write_exp_elt_sym ($1.sym);
write_exp_elt_opcode (OP_VAR_VALUE);
}
- | FIXME
+ | GDB_LAST /* gdb specific */
+ {
+ write_exp_elt_opcode (OP_LAST);
+ write_exp_elt_longcst ($1);
+ write_exp_elt_opcode (OP_LAST);
+ }
+ | GDB_REGNAME /* gdb specific */
+ {
+ write_exp_elt_opcode (OP_REGISTER);
+ write_exp_elt_longcst ($1);
+ write_exp_elt_opcode (OP_REGISTER);
+ }
+ | GDB_VARIABLE /* gdb specific */
+ {
+ write_exp_elt_opcode (OP_INTERNALVAR);
+ write_exp_elt_intern ($1);
+ write_exp_elt_opcode (OP_INTERNALVAR);
+ }
+ | FIXME_03
{
$$ = 0; /* FIXME */
}
;
+/* Z.200, 4.2.8 */
+
+expression_list : expression
+ {
+ arglist_len = 1;
+ }
+ | expression_list ',' expression
+ {
+ arglist_len++;
+ }
+
/* Z.200, 5.2.1 */
primitive_value : location_contents
| GENERAL_PROCEDURE_NAME
{
write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_block (NULL);
write_exp_elt_sym ($1.sym);
write_exp_elt_opcode (OP_VAR_VALUE);
}
write_exp_elt_longcst ((LONGEST) ($1.val));
write_exp_elt_opcode (OP_LONG);
}
+ | FLOAT_LITERAL
+ {
+ write_exp_elt_opcode (OP_DOUBLE);
+ write_exp_elt_type (builtin_type_double);
+ write_exp_elt_dblcst ($1);
+ write_exp_elt_opcode (OP_DOUBLE);
+ }
| SET_LITERAL
{
$$ = 0; /* FIXME */
}
| CHARACTER_STRING_LITERAL
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (OP_STRING);
+ write_exp_string ($1);
+ write_exp_elt_opcode (OP_STRING);
}
| BIT_STRING_LITERAL
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (OP_BITSTRING);
+ write_exp_bitstring ($1);
+ write_exp_elt_opcode (OP_BITSTRING);
}
;
/* Z.200, 5.2.5 */
-tuple : FIXME
+tuple : FIXME_04
{
$$ = 0; /* FIXME */
}
/* Z.200, 5.2.8 */
-value_array_element: array_primitive_value '(' expression_list ')'
+value_array_element: array_primitive_value '('
+ /* This is to save the value of arglist_len
+ being accumulated for each dimension. */
+ { start_arglist (); }
+ expression_list ')'
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (MULTI_SUBSCRIPT);
+ write_exp_elt_longcst ((LONGEST) end_arglist ());
+ write_exp_elt_opcode (MULTI_SUBSCRIPT);
}
;
{
$$ = 0; /* FIXME */
}
- | array_primitive_value '(' first_element UP slice_size '('
+ | array_primitive_value '(' first_element UP slice_size ')'
{
$$ = 0; /* FIXME */
}
/* Z.200, 5.2.10 */
-value_structure_field: structure_primitive_value '.' field_name
- {
- $$ = 0; /* FIXME */
+value_structure_field: primitive_value FIELD_NAME
+ { write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_string ($2);
+ write_exp_elt_opcode (STRUCTOP_STRUCT);
}
;
/* Z.200, 5.2.11 */
-expression_conversion: mode_name '(' expression ')'
+expression_conversion: mode_name parenthesised_expression
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_type ($1.type);
+ write_exp_elt_opcode (UNOP_CAST);
}
;
/* Z.200, 5.2.12 */
-value_procedure_call: FIXME
+value_procedure_call: FIXME_05
{
$$ = 0; /* FIXME */
}
/* Z.200, 5.2.13 */
-value_built_in_routine_call: FIXME
+value_built_in_routine_call: chill_value_built_in_routine_call
{
$$ = 0; /* FIXME */
}
/* Z.200, 5.2.14 */
-start_expression: FIXME
+start_expression: FIXME_06
{
$$ = 0; /* FIXME */
} /* Not in GNU-Chill */
/* Z.200, 5.2.15 */
-zero_adic_operator: FIXME
+zero_adic_operator: FIXME_07
{
$$ = 0; /* FIXME */
}
{
$$ = 0; /* FIXME */
}
+ | single_assignment_action
+ {
+ $$ = 0; /* FIXME */
+ }
| conditional_expression
{
$$ = 0; /* FIXME */
}
| operand_2 IN operand_3
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (BINOP_IN);
}
;
}
| operand_3 SLASH_SLASH operand_4
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (BINOP_CONCAT);
}
;
}
| operand_4 MOD operand_5
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (BINOP_MOD);
}
| operand_4 REM operand_5
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (BINOP_REM);
}
;
{
write_exp_elt_opcode (UNOP_LOGICAL_NOT);
}
- | '(' integer_literal_expression ')' operand_6
+ | parenthesised_expression literal
+/* We require the string operand to be a literal, to avoid some
+ nasty parsing ambiguities. */
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (BINOP_CONCAT);
}
;
operand_6 : POINTER location
{
- $$ = 0; /* FIXME */
+ write_exp_elt_opcode (UNOP_ADDR);
}
| RECEIVE buffer_location
{
;
+/* Z.200, 6.2 */
+
+single_assignment_action :
+ location GDB_ASSIGNMENT value
+ {
+ write_exp_elt_opcode (BINOP_ASSIGN);
+ }
+ ;
+
+/* Z.200, 6.20.3 */
+
+chill_value_built_in_routine_call :
+ NUM '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | PRED '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | SUCC '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | ABS '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | CARD '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | MAX_TOKEN '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | MIN_TOKEN '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | SIZE '(' location ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | SIZE '(' mode_argument ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | UPPER '(' upper_lower_argument ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | LOWER '(' upper_lower_argument ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | LENGTH '(' length_argument ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ ;
+
+mode_argument : mode_name
+ {
+ $$ = 0; /* FIXME */
+ }
+ | array_mode_name '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | string_mode_name '(' expression ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ | variant_structure_mode_name '(' expression_list ')'
+ {
+ $$ = 0; /* FIXME */
+ }
+ ;
+
+mode_name : TYPENAME
+ ;
+
+upper_lower_argument : expression
+ {
+ $$ = 0; /* FIXME */
+ }
+ | mode_name
+ {
+ $$ = 0; /* FIXME */
+ }
+ ;
+
+length_argument : expression
+ {
+ $$ = 0; /* FIXME */
+ }
+ ;
+
/* Z.200, 12.4.3 */
-/* FIXME: For now we just accept only a single integer literal. */
-integer_literal_expression:
- INTEGER_LITERAL
+array_primitive_value : primitive_value
{
$$ = 0;
}
+ ;
+
/* Things which still need productions... */
-synonym_name : FIXME { $$ = 0; }
-value_enumeration_name : FIXME { $$ = 0; }
-value_do_with_name : FIXME { $$ = 0; }
-value_receive_name : FIXME { $$ = 0; }
-string_primitive_value : FIXME { $$ = 0; }
-start_element : FIXME { $$ = 0; }
-left_element : FIXME { $$ = 0; }
-right_element : FIXME { $$ = 0; }
-slice_size : FIXME { $$ = 0; }
-array_primitive_value : FIXME { $$ = 0; }
-expression_list : FIXME { $$ = 0; }
-lower_element : FIXME { $$ = 0; }
-upper_element : FIXME { $$ = 0; }
-first_element : FIXME { $$ = 0; }
-structure_primitive_value: FIXME { $$ = 0; }
-field_name : FIXME { $$ = 0; }
-mode_name : FIXME { $$ = 0; }
-boolean_expression : FIXME { $$ = 0; }
-case_selector_list : FIXME { $$ = 0; }
-subexpression : FIXME { $$ = 0; }
-case_label_specification: FIXME { $$ = 0; }
-buffer_location : FIXME { $$ = 0; }
+
+array_mode_name : FIXME_08 { $$ = 0; }
+string_mode_name : FIXME_09 { $$ = 0; }
+variant_structure_mode_name: FIXME_10 { $$ = 0; }
+synonym_name : FIXME_11 { $$ = 0; }
+value_enumeration_name : FIXME_12 { $$ = 0; }
+value_do_with_name : FIXME_13 { $$ = 0; }
+value_receive_name : FIXME_14 { $$ = 0; }
+string_primitive_value : FIXME_15 { $$ = 0; }
+start_element : FIXME_16 { $$ = 0; }
+left_element : FIXME_17 { $$ = 0; }
+right_element : FIXME_18 { $$ = 0; }
+slice_size : FIXME_19 { $$ = 0; }
+lower_element : FIXME_20 { $$ = 0; }
+upper_element : FIXME_21 { $$ = 0; }
+first_element : FIXME_22 { $$ = 0; }
+boolean_expression : FIXME_26 { $$ = 0; }
+case_selector_list : FIXME_27 { $$ = 0; }
+subexpression : FIXME_28 { $$ = 0; }
+case_label_specification: FIXME_29 { $$ = 0; }
+buffer_location : FIXME_30 { $$ = 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 *) malloc (tempbufsize);
+ }
+ else
+ {
+ tempbuf = (char *) realloc (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. */
if (isalpha (*tokptr))
{
+ char *result;
do {
tokptr++;
- } while (isalpha (*tokptr) || isdigit (*tokptr) || (*tokptr == '_'));
+ } while (isalnum (*tokptr) || (*tokptr == '_'));
yylval.sval.ptr = lexptr;
yylval.sval.length = tokptr - lexptr;
lexptr = tokptr;
- return (copy_name (yylval.sval));
+ result = copy_name (yylval.sval);
+ for (tokptr = result; *tokptr; tokptr++)
+ if (isupper (*tokptr))
+ *tokptr = tolower(*tokptr);
+ return result;
}
return (NULL);
}
char *tokptr = *tokptrptr;
int base = 0;
int ival = 0;
- int digits = 0;
- int temp;
int explicit_base = 0;
/* Look for an explicit base specifier, which is optional. */
}
}
+/* 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 int
+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 int
+match_string_literal ()
+{
+ char *tokptr = lexptr;
+
+ for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
+ {
+ CHECKBUF (1);
+ if (*tokptr == *lexptr)
+ {
+ if (*(tokptr + 1) == *lexptr)
+ {
+ tokptr++;
+ }
+ else
+ {
+ break;
+ }
+ }
+ tempbuf[tempbufindex++] = *tokptr;
+ }
+ 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
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.
+
+ Also note that the control sequence form is not in GNU Chill since it
+ is ambiguous with the string literal form using single quotes. I.E.
+ is '^(7)' a character literal or a string literal. In theory it it
+ possible to tell by context, but GNU Chill doesn't accept the control
+ sequence form, so neither do we (for now the code is disabled).
+
Returns CHARACTER_LITERAL if a match is found.
*/
if ((*tokptr == '^') && (*(tokptr + 1) == '('))
{
+#if 0 /* Disable, see note above. -fnf */
/* 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 ')'.
{
return (0);
}
+#else
+ return (0);
+#endif
}
else
{
return (0);
}
}
+ else
+ {
+ /* Not a character literal. */
+ return (0);
+ }
yylval.typed_val.val = ival;
yylval.typed_val.type = builtin_type_chill_char;
lexptr = tokptr;
}
}
-static void convert_float ()
+/* 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 int
+match_bitstring_literal ()
{
-#if 0
- extern double strtod ();
- double d;
- char tmp[256];
- char *p = yytext, *p1 = tmp;
- char c;
-
- while (c = *p++)
+ char *tokptr = lexptr;
+ int mask;
+ int bitoffset = 0;
+ int bitcount = 0;
+ int base;
+ int digit;
+
+ tempbufindex = 0;
+
+ /* Look for the required explicit base specifier. */
+
+ switch (*tokptr++)
{
- switch (c)
+ case 'b':
+ case 'B':
+ base = 2;
+ break;
+ case 'o':
+ case 'O':
+ base = 8;
+ break;
+ case 'h':
+ case 'H':
+ base = 16;
+ 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 = tolower (*tokptr);
+ tokptr++;
+ switch (digit)
{
- case '_':
+ 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 'E':
- case 'd':
- case 'D':
- *p1++ = 'e';
+ case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
+ digit -= 'a';
+ digit += 10;
break;
- default:
- *p1++ = c;
+ default:
+ return (0);
break;
}
+ if (digit >= base)
+ {
+ /* Found something not in domain for current base. */
+ return (0);
+ }
+ else
+ {
+ /* Extract bits from digit, starting with the msbit appropriate for
+ the current base, and packing them into the bitstring byte,
+ starting at the lsbit. */
+ for (mask = (base >> 1); mask > 0; mask >>= 1)
+ {
+ bitcount++;
+ CHECKBUF (1);
+ if (digit & mask)
+ {
+ tempbuf[tempbufindex] |= (1 << bitoffset);
+ }
+ bitoffset++;
+ if (bitoffset == HOST_CHAR_BIT)
+ {
+ bitoffset = 0;
+ tempbufindex++;
+ }
+ }
+ }
}
- *p1 = '\0';
- d = strtod (tmp, &p1);
- if (*p1)
+
+ /* Verify that we consumed everything up to the trailing single quote,
+ and that we found some bits (IE not just underbars). */
+
+ if (*tokptr++ != '\'')
{
- /* add error handling here */
- ;
+ return (0);
+ }
+ else
+ {
+ yylval.sval.ptr = tempbuf;
+ yylval.sval.length = bitcount;
+ lexptr = tokptr;
+ return (BIT_STRING_LITERAL);
}
- yylval.dval = d;
-#endif
}
-/* Take care of parsing a number (anything that starts with a digit).
- Set yylval and return the token type; update lexptr.
- LEN is the number of characters in it. */
+/* Recognize tokens that start with '$'. These include:
+
+ $regname A native register name or a "standard
+ register name".
+ Return token GDB_REGNAME.
+
+ $variable A convenience variable with a name chosen
+ by the user.
+ Return token GDB_VARIABLE.
+
+ $digits Value history with index <digits>, starting
+ from the first value which has index 1.
+ Return GDB_LAST.
+
+ $$digits Value history with index <digits> relative
+ to the last value. I.E. $$0 is the last
+ value, $$1 is the one previous to that, $$2
+ is the one previous to $$1, etc.
+ Return token GDB_LAST.
+
+ $ | $0 | $$0 The last value in the value history.
+ Return token GDB_LAST.
-/*** Needs some error checking for the float case ***/
+ $$ An abbreviation for the second to the last
+ value in the value history, I.E. $$1
+ Return token GDB_LAST.
+
+ Note that we currently assume that register names and convenience
+ variables follow the convention of starting with a letter or '_'.
+
+ */
static int
-parse_number ()
+match_dollar_tokens ()
{
+ char *tokptr;
+ int regno;
+ int namelength;
+ int negate;
+ int ival;
+
+ /* We will always have a successful match, even if it is just for
+ a single '$', the abbreviation for $$0. So advance lexptr. */
+
+ tokptr = ++lexptr;
+
+ if (*tokptr == '_' || isalpha (*tokptr))
+ {
+ /* Look for a match with a native register name, usually something
+ like "r0" for example. */
+
+ for (regno = 0; regno < NUM_REGS; regno++)
+ {
+ namelength = strlen (reg_names[regno]);
+ if (STREQN (tokptr, reg_names[regno], namelength)
+ && !isalnum (tokptr[namelength]))
+ {
+ yylval.lval = regno;
+ lexptr += namelength;
+ return (GDB_REGNAME);
+ }
+ }
+
+ /* Look for a match with a standard register name, usually something
+ like "pc", which gdb always recognizes as the program counter
+ regardless of what the native register name is. */
+
+ for (regno = 0; regno < num_std_regs; regno++)
+ {
+ namelength = strlen (std_regs[regno].name);
+ if (STREQN (tokptr, std_regs[regno].name, namelength)
+ && !isalnum (tokptr[namelength]))
+ {
+ yylval.lval = std_regs[regno].regnum;
+ lexptr += namelength;
+ return (GDB_REGNAME);
+ }
+ }
+
+ /* Attempt to match against a convenience variable. Note that
+ this will always succeed, because if no variable of that name
+ already exists, the lookup_internalvar will create one for us.
+ Also note that both lexptr and tokptr currently point to the
+ start of the input string we are trying to match, and that we
+ have already tested the first character for non-numeric, so we
+ don't have to treat it specially. */
+
+ while (*tokptr == '_' || isalnum (*tokptr))
+ {
+ tokptr++;
+ }
+ yylval.sval.ptr = lexptr;
+ yylval.sval.length = tokptr - lexptr;
+ yylval.ivar = lookup_internalvar (copy_name (yylval.sval));
+ lexptr = tokptr;
+ return (GDB_VARIABLE);
+ }
+
+ /* Since we didn't match against a register name or convenience
+ variable, our only choice left is a history value. */
+
+ if (*tokptr == '$')
+ {
+ negate = 1;
+ ival = 1;
+ tokptr++;
+ }
+ else
+ {
+ negate = 0;
+ ival = 0;
+ }
+
+ /* Attempt to decode more characters as an integer value giving
+ the index in the history list. If successful, the value will
+ overwrite ival (currently 0 or 1), and if not, ival will be
+ left alone, which is good since it is currently correct for
+ the '$' or '$$' case. */
+
+ decode_integer_literal (&ival, &tokptr);
+ yylval.lval = negate ? -ival : ival;
+ lexptr = tokptr;
+ return (GDB_LAST);
}
struct token
int token;
};
-const static struct token tokentab5[] =
-{
- { "ANDIF", ANDIF }
-};
-
-const static struct token tokentab4[] =
-{
- { "ORIF", ORIF }
-};
-
-const static struct token tokentab3[] =
+static const struct token idtokentab[] =
{
- { "NOT", NOT },
- { "XOR", LOGXOR },
- { "AND", LOGAND }
+ { "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 }
};
-const static struct token tokentab2[] =
+static const struct token tokentab2[] =
{
+ { ":=", GDB_ASSIGNMENT },
{ "//", SLASH_SLASH },
+ { "->", POINTER },
{ "/=", NOTEQUAL },
{ "<=", LEQ },
- { ">=", GTR },
- { "IN", IN },
- { "OR", LOGIOR }
+ { ">=", GTR }
};
/* Read one token, getting characters through lexptr. */
{
case '\0':
return (0);
- case '.':
+ case ',':
case '=':
- 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. */
+ 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':
- case '\'':
token = match_character_literal ();
if (token != 0)
{
return (token);
}
break;
+ case '$':
+ token = match_dollar_tokens ();
+ if (token != 0)
+ {
+ return (token);
+ }
+ break;
}
- /* See if it is a special token of length 5. */
- for (i = 0; i < sizeof (tokentab5) / sizeof (tokentab5[0]); i++)
- {
- if (strncmp (lexptr, tokentab5[i].operator, 5) == 0)
- {
- lexptr += 5;
- return (tokentab5[i].token);
- }
- }
- /* See if it is a special token of length 4. */
- for (i = 0; i < sizeof (tokentab4) / sizeof (tokentab4[0]); i++)
- {
- if (strncmp (lexptr, tokentab4[i].operator, 4) == 0)
- {
- lexptr += 4;
- return (tokentab4[i].token);
- }
- }
- /* See if it is a special token of length 3. */
- for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
- {
- if (strncmp (lexptr, tokentab3[i].operator, 3) == 0)
- {
- lexptr += 3;
- return (tokentab3[i].token);
- }
- }
/* See if it is a special token of length 2. */
for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
{
- if (strncmp (lexptr, tokentab2[i].operator, 2) == 0)
+ if (STREQN (lexptr, tokentab2[i].operator, 2))
{
lexptr += 2;
return (tokentab2[i].token);
would already have found it. */
switch (*lexptr)
{
+ case '-':
+ case ':':
case '/':
case '<':
case '>':
return (*lexptr++);
}
- /* Look for other special tokens. */
- if (strncmp (lexptr, "TRUE", 4) == 0) /* FIXME: What about lowercase? */
+ /* 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)
{
- yylval.ulval = 1;
- lexptr += 4;
- return (BOOLEAN_LITERAL);
+ return (token);
}
- if (strncmp (lexptr, "FALSE", 5) == 0) /* FIXME: What about lowercase? */
+ token = match_bitstring_literal ();
+ if (token != 0)
{
- yylval.ulval = 0;
- lexptr += 5;
- return (BOOLEAN_LITERAL);
+ return (token);
}
token = match_integer_literal ();
if (token != 0)
we can't classify what sort of name it is. */
simplename = match_simple_name_string ();
+
if (simplename != NULL)
{
+ /* 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 (simplename, expression_context_block,
VAR_NAMESPACE, (int *) NULL,
(struct symtab **) NULL);
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.", simplename);
+ break;
}
}
else if (!have_full_symbols () && !have_partial_symbols ())
}
}
+ /* Catch single character tokens which are not part of some
+ longer token. */
+
+ switch (*lexptr)
+ {
+ case '.': /* Not float for example. */
+ lexptr++;
+ while (isspace (*lexptr)) lexptr++;
+ simplename = match_simple_name_string ();
+ if (!simplename)
+ return '.';
+ return FIELD_NAME;
+ }
+
return (ILLEGAL_TOKEN);
}
-static void
+void
yyerror (msg)
char *msg; /* unused */
{
- printf ("Parsing: %s\n", lexptr);
+ printf_unfiltered ("Parsing: %s\n", lexptr);
if (yychar < 256)
{
error ("Invalid syntax in expression near character '%c'.", yychar);
error ("Invalid syntax in expression");
}
}
-
-\f
-static void
-chill_printchar (c, stream)
- register int c;
- FILE *stream;
-{
- c &= 0xFF; /* Avoid sign bit follies */
-
- if (PRINT_LITERAL_FORM (c))
- {
- fprintf_filtered (stream, "'%c'", c);
- }
- else
- {
- fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
- }
-}
-
-/* Print the character string STRING, printing at most LENGTH characters.
- Printing stops early if the number hits print_max; repeat counts
- are printed as appropriate. Print ellipses at the end if we
- had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
- Note that gdb maintains the length of strings without counting the
- terminating null byte, while chill strings are typically written with
- an explicit null byte. So we always assume an implied null byte
- until gdb is able to maintain non-null terminated strings as well
- as null terminated strings (FIXME).
- */
-
-static void
-chill_printstr (stream, string, length, force_ellipses)
- FILE *stream;
- char *string;
- unsigned int length;
- int force_ellipses;
-{
- register unsigned int i;
- unsigned int things_printed = 0;
- int in_literal_form = 0;
- int in_control_form = 0;
- int need_slashslash = 0;
- unsigned int c;
- extern int repeat_count_threshold;
- extern int print_max;
-
- if (length == 0)
- {
- chill_printchar ('\0', stream);
- return;
- }
-
- for (i = 0; i < length && things_printed < print_max; ++i)
- {
- /* Position of the character we are examining
- to see whether it is repeated. */
- unsigned int rep1;
- /* Number of repetitions we have detected so far. */
- unsigned int reps;
-
- QUIT;
-
- if (need_slashslash)
- {
- fputs_filtered ("//", stream);
- need_slashslash = 0;
- }
-
- rep1 = i + 1;
- reps = 1;
- while (rep1 < length && string[rep1] == string[i])
- {
- ++rep1;
- ++reps;
- }
-
- c = string[i];
- if (reps > repeat_count_threshold)
- {
- if (in_control_form || in_literal_form)
- {
- fputs_filtered ("'//", stream);
- in_control_form = in_literal_form = 0;
- }
- chill_printchar (c, stream);
- fprintf_filtered (stream, "<repeats %u times>", reps);
- i = rep1 - 1;
- things_printed += repeat_count_threshold;
- need_slashslash = 1;
- }
- else
- {
- if (PRINT_LITERAL_FORM (c))
- {
- if (!in_literal_form)
- {
- if (in_control_form)
- {
- fputs_filtered ("'//", stream);
- in_control_form = 0;
- }
- fputs_filtered ("'", stream);
- in_literal_form = 1;
- }
- fprintf_filtered (stream, "%c", c);
- }
- else
- {
- if (!in_control_form)
- {
- if (in_literal_form)
- {
- fputs_filtered ("'//", stream);
- in_literal_form = 0;
- }
- fputs_filtered ("c'", stream);
- in_control_form = 1;
- }
- fprintf_filtered (stream, "%.2x", c);
- }
- ++things_printed;
- }
- }
-
- /* Terminate the quotes if necessary. */
- if (in_literal_form || in_control_form)
- {
- fputs_filtered ("'", stream);
- }
- if (force_ellipses || (i < length))
- {
- fputs_filtered ("...", stream);
- }
-}
-
-\f
-/* Table of operators and their precedences for printing expressions. */
-
-const static struct op_print chill_op_print_tab[] = {
- {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
- {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
- {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
- {"MOD", BINOP_REM, PREC_MUL, 0},
- {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
- {"=", BINOP_EQUAL, PREC_EQUAL, 0},
- {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
- {"<=", BINOP_LEQ, PREC_ORDER, 0},
- {">=", BINOP_GEQ, PREC_ORDER, 0},
- {">", BINOP_GTR, PREC_ORDER, 0},
- {"<", BINOP_LESS, PREC_ORDER, 0},
- {"+", BINOP_ADD, PREC_ADD, 0},
- {"-", BINOP_SUB, PREC_ADD, 0},
- {"*", BINOP_MUL, PREC_MUL, 0},
- {"/", BINOP_DIV, PREC_MUL, 0},
- {"-", UNOP_NEG, PREC_PREFIX, 0},
- {NULL, 0, 0, 0}
-};
-
-\f
-/* The built-in types of Chill. */
-
-struct type *builtin_type_chill_bool;
-struct type *builtin_type_chill_char;
-struct type *builtin_type_chill_long;
-struct type *builtin_type_chill_ulong;
-struct type *builtin_type_chill_real;
-
-struct type ** const (chill_builtin_types[]) =
-{
- &builtin_type_chill_bool,
- &builtin_type_chill_char,
- &builtin_type_chill_long,
- &builtin_type_chill_ulong,
- &builtin_type_chill_real,
- 0
-};
-
-const struct language_defn chill_language_defn = {
- "chill",
- language_chill,
- chill_builtin_types,
- range_check_on,
- type_check_on,
- chill_parse, /* parser */
- chill_error, /* parser error function */
- chill_printchar, /* print a character constant */
- chill_printstr, /* function to print a string constant */
- &BUILTIN_TYPE_LONGEST, /* longest signed integral type */
- &BUILTIN_TYPE_UNSIGNED_LONGEST,/* longest unsigned integral type */
- &builtin_type_chill_real, /* longest floating point type */
- {"", "B'", "", ""}, /* Binary format info */
- {"O'%o", "O'", "o", ""}, /* Octal format info */
- {"D'%d", "D'", "d", ""}, /* Decimal format info */
- {"H'%x", "H'", "x", ""}, /* Hex format info */
- chill_op_print_tab, /* expression operators for printing */
- LANG_MAGIC
-};
-
-/* Initialization for Chill */
-
-void
-_initialize_chill_exp ()
-{
- builtin_type_chill_bool =
- init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "BOOL", (struct objfile *) NULL);
- builtin_type_chill_char =
- init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "CHAR", (struct objfile *) NULL);
- builtin_type_chill_long =
- init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
- 0,
- "LONG", (struct objfile *) NULL);
- builtin_type_chill_ulong =
- init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "ULONG", (struct objfile *) NULL);
- builtin_type_chill_real =
- init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
- 0,
- "LONG_REAL", (struct objfile *) NULL);
-
- add_language (&chill_language_defn);
-}