1 /* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
2 Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
4 This file is part of GDB.
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
20 /* Parse a Chill expression from text in a string,
21 and return the result as a struct expression pointer.
22 That structure contains arithmetic operations in reverse polish,
23 with constants represented by operations that are followed by special data.
24 See expression.h for the details of the format.
25 What is important here is that it can be built up sequentially
26 during the process of parsing; the lower levels of the tree always
27 come first in the result.
29 Note that the language accepted by this parser is more liberal
30 than the one accepted by an actual Chill compiler. For example, the
31 language rule that a simple name string can not be one of the reserved
32 simple name strings is not enforced (e.g "case" is not treated as a
33 reserved name). Another example is that Chill is a strongly typed
34 language, and certain expressions that violate the type constraints
35 may still be evaluated if gdb can do so in a meaningful manner, while
36 such expressions would be rejected by the compiler. The reason for
37 this more liberal behavior is the philosophy that the debugger
38 is intended to be a tool that is used by the programmer when things
39 go wrong, and as such, it should provide as few artificial barriers
40 to it's use as possible. If it can do something meaningful, even
41 something that violates language contraints that are enforced by the
42 compiler, it should do so without complaint.
49 #include "expression.h"
52 #include "parser-defs.h"
54 #include "bfd.h" /* Required by objfiles.h. */
55 #include "symfile.h" /* Required by objfiles.h. */
56 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
62 unsigned LONGEST ulval
;
77 /* '\001' ... '\xff' come first. */
83 GENERAL_PROCEDURE_NAME
,
86 CHARACTER_STRING_LITERAL
,
132 /* Forward declarations. */
133 static void parse_expr ();
134 static void parse_primval ();
135 static void parse_untyped_expr ();
136 static int parse_opt_untyped_expr ();
137 static void parse_if_expression_body
PARAMS((void));
138 static void write_lower_upper_value
PARAMS ((enum exp_opcode
, struct type
*));
139 static enum ch_terminal
ch_lex ();
141 #define MAX_LOOK_AHEAD 2
142 static enum ch_terminal terminal_buffer
[MAX_LOOK_AHEAD
+1] = {
143 TOKEN_NOT_READ
, TOKEN_NOT_READ
, TOKEN_NOT_READ
};
144 static YYSTYPE yylval
;
145 static YYSTYPE val_buffer
[MAX_LOOK_AHEAD
+1];
147 /*int current_token, lookahead_token;*/
152 static enum ch_terminal
155 if (terminal_buffer
[0] == TOKEN_NOT_READ
)
157 terminal_buffer
[0] = ch_lex ();
158 val_buffer
[0] = yylval
;
160 return terminal_buffer
[0];
162 #define PEEK_LVAL() val_buffer[0]
163 #define PEEK_TOKEN1() peek_token_(1)
164 #define PEEK_TOKEN2() peek_token_(2)
165 static enum ch_terminal
169 if (i
> MAX_LOOK_AHEAD
)
170 fatal ("internal error - too much lookahead");
171 if (terminal_buffer
[i
] == TOKEN_NOT_READ
)
173 terminal_buffer
[i
] = ch_lex ();
174 val_buffer
[i
] = yylval
;
176 return terminal_buffer
[i
];
180 pushback_token (code
, node
)
181 enum ch_terminal code
;
185 if (terminal_buffer
[MAX_LOOK_AHEAD
] != TOKEN_NOT_READ
)
186 fatal ("internal error - cannot pushback token");
187 for (i
= MAX_LOOK_AHEAD
; i
> 0; i
--)
189 terminal_buffer
[i
] = terminal_buffer
[i
- 1];
190 val_buffer
[i
] = val_buffer
[i
- 1];
192 terminal_buffer
[0] = code
;
193 val_buffer
[0] = node
;
200 for (i
= 0; i
< MAX_LOOK_AHEAD
; i
++)
202 terminal_buffer
[i
] = terminal_buffer
[i
+1];
203 val_buffer
[i
] = val_buffer
[i
+1];
205 terminal_buffer
[MAX_LOOK_AHEAD
] = TOKEN_NOT_READ
;
207 #define FORWARD_TOKEN() forward_token_()
209 /* Skip the next token.
210 if it isn't TOKEN, the parser is broken. */
214 enum ch_terminal token
;
216 if (PEEK_TOKEN() != token
)
219 sprintf (buf
, "internal parser error - expected token %d", (int)token
);
227 enum ch_terminal token
;
229 if (PEEK_TOKEN() != token
)
235 /* return 0 if expected token was not found,
239 expect(token
, message
)
240 enum ch_terminal token
;
243 if (PEEK_TOKEN() != token
)
247 else if (token
< 256)
248 error ("syntax error - expected a '%c' here \"%s\"", token
, lexptr
);
250 error ("syntax error");
260 parse_opt_name_string (allow_all
)
261 int allow_all
; /* 1 if ALL is allowed as a postfix */
263 int token
= PEEK_TOKEN();
267 if (token
== ALL
&& allow_all
)
278 token
= PEEK_TOKEN();
282 token
= PEEK_TOKEN();
283 if (token
== ALL
&& allow_all
)
284 return get_identifier3(IDENTIFIER_POINTER (name
), "!", "*");
288 error ("'%s!' is not followed by an identifier",
289 IDENTIFIER_POINTER (name
));
292 name
= get_identifier3(IDENTIFIER_POINTER(name
),
293 "!", IDENTIFIER_POINTER(PEEK_LVAL()));
298 parse_simple_name_string ()
300 int token
= PEEK_TOKEN();
304 error ("expected a name here");
305 return error_mark_node
;
315 tree name
= parse_opt_name_string (0);
319 error ("expected a name string here");
320 return error_mark_node
;
323 /* Matches: <name_string>
324 Returns if pass 1: the identifier.
325 Returns if pass 2: a decl or value for identifier. */
330 tree name
= parse_name_string ();
331 if (pass
== 1 || ignoring
)
335 tree decl
= lookup_name (name
);
336 if (decl
== NULL_TREE
)
338 error ("`%s' undeclared", IDENTIFIER_POINTER (name
));
339 return error_mark_node
;
341 else if (TREE_CODE (TREE_TYPE (decl
)) == ERROR_MARK
)
342 return error_mark_node
;
343 else if (TREE_CODE (decl
) == CONST_DECL
)
344 return DECL_INITIAL (decl
);
345 else if (TREE_CODE (TREE_TYPE (decl
)) == REFERENCE_TYPE
)
346 return convert_from_reference (decl
);
355 pushback_paren_expr (expr
)
358 if (pass
== 1 && !ignoring
)
359 expr
= build1 (PAREN_EXPR
, NULL_TREE
, expr
);
360 pushback_token (EXPR
, expr
);
364 /* Matches: <case label> */
369 if (check_token (ELSE
))
370 error ("ELSE in tuples labels not implemented");
371 /* Does not handle the case of a mode name. FIXME */
373 if (check_token (':'))
376 write_exp_elt_opcode (BINOP_RANGE
);
381 parse_opt_untyped_expr ()
383 switch (PEEK_TOKEN ())
390 parse_untyped_expr ();
404 /* Parse NAME '(' MODENAME ')'. */
412 if (PEEK_TOKEN () != TYPENAME
)
413 error ("expect MODENAME here `%s'", lexptr
);
414 type
= PEEK_LVAL().tsym
.type
;
421 parse_mode_or_normal_call ()
426 if (PEEK_TOKEN () == TYPENAME
)
428 type
= PEEK_LVAL().tsym
.type
;
440 /* Parse something that looks like a function call.
441 Assume we have parsed the function, and are at the '('. */
448 /* This is to save the value of arglist_len
449 being accumulated for each dimension. */
451 if (parse_opt_untyped_expr ())
453 int tok
= PEEK_TOKEN ();
455 if (tok
== UP
|| tok
== ':')
459 expect (')', "expected ')' to terminate slice");
461 write_exp_elt_opcode (tok
== UP
? TERNOP_SLICE_COUNT
465 while (check_token (','))
467 parse_untyped_expr ();
474 arg_count
= end_arglist ();
475 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
476 write_exp_elt_longcst (arg_count
);
477 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
481 parse_named_record_element ()
485 label
= PEEK_LVAL ().sval
;
486 expect (FIELD_NAME
, "expected a field name here `%s'", lexptr
);
487 if (check_token (','))
488 parse_named_record_element ();
489 else if (check_token (':'))
492 error ("syntax error near `%s' in named record tuple element", lexptr
);
493 write_exp_elt_opcode (OP_LABELED
);
494 write_exp_string (label
);
495 write_exp_elt_opcode (OP_LABELED
);
498 /* Returns one or nore TREE_LIST nodes, in reverse order. */
501 parse_tuple_element ()
503 if (PEEK_TOKEN () == FIELD_NAME
)
505 /* Parse a labelled structure tuple. */
506 parse_named_record_element ();
510 if (check_token ('('))
512 if (check_token ('*'))
514 expect (')', "missing ')' after '*' case label list");
515 error ("(*) not implemented in case label list");
520 while (check_token (','))
523 write_exp_elt_opcode (BINOP_COMMA
);
529 parse_untyped_expr ();
530 if (check_token (':'))
532 /* A powerset range or a labeled Array. */
533 parse_untyped_expr ();
534 write_exp_elt_opcode (BINOP_RANGE
);
538 /* Matches: a COMMA-separated list of tuple elements.
539 Returns a list (of TREE_LIST nodes). */
541 parse_opt_element_list ()
544 if (PEEK_TOKEN () == ']')
548 parse_tuple_element ();
550 if (PEEK_TOKEN () == ']')
552 if (!check_token (','))
553 error ("bad syntax in tuple");
557 /* Parses: '[' elements ']'
558 If modename is non-NULL it prefixed the tuple. */
566 parse_opt_element_list ();
567 expect (']', "missing ']' after tuple");
568 write_exp_elt_opcode (OP_ARRAY
);
569 write_exp_elt_longcst ((LONGEST
) 0);
570 write_exp_elt_longcst ((LONGEST
) end_arglist () - 1);
571 write_exp_elt_opcode (OP_ARRAY
);
574 struct type
*type
= check_typedef (mode
);
575 if (TYPE_CODE (type
) != TYPE_CODE_ARRAY
576 && TYPE_CODE (type
) != TYPE_CODE_STRUCT
577 && TYPE_CODE (type
) != TYPE_CODE_SET
)
578 error ("invalid tuple mode");
579 write_exp_elt_opcode (UNOP_CAST
);
580 write_exp_elt_type (mode
);
581 write_exp_elt_opcode (UNOP_CAST
);
591 switch (PEEK_TOKEN ())
593 case INTEGER_LITERAL
:
594 case CHARACTER_LITERAL
:
595 write_exp_elt_opcode (OP_LONG
);
596 write_exp_elt_type (PEEK_LVAL ().typed_val
.type
);
597 write_exp_elt_longcst (PEEK_LVAL ().typed_val
.val
);
598 write_exp_elt_opcode (OP_LONG
);
601 case BOOLEAN_LITERAL
:
602 write_exp_elt_opcode (OP_BOOL
);
603 write_exp_elt_longcst ((LONGEST
) PEEK_LVAL ().ulval
);
604 write_exp_elt_opcode (OP_BOOL
);
608 write_exp_elt_opcode (OP_DOUBLE
);
609 write_exp_elt_type (builtin_type_double
);
610 write_exp_elt_dblcst (PEEK_LVAL ().dval
);
611 write_exp_elt_opcode (OP_DOUBLE
);
614 case EMPTINESS_LITERAL
:
615 write_exp_elt_opcode (OP_LONG
);
616 write_exp_elt_type (lookup_pointer_type (builtin_type_void
));
617 write_exp_elt_longcst (0);
618 write_exp_elt_opcode (OP_LONG
);
621 case CHARACTER_STRING_LITERAL
:
622 write_exp_elt_opcode (OP_STRING
);
623 write_exp_string (PEEK_LVAL ().sval
);
624 write_exp_elt_opcode (OP_STRING
);
627 case BIT_STRING_LITERAL
:
628 write_exp_elt_opcode (OP_BITSTRING
);
629 write_exp_bitstring (PEEK_LVAL ().sval
);
630 write_exp_elt_opcode (OP_BITSTRING
);
635 /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
636 which casts to an artificial array. */
639 if (PEEK_TOKEN () != TYPENAME
)
640 error ("missing MODENAME after ARRAY()");
641 type
= PEEK_LVAL().tsym
.type
;
645 expect (')', "missing right parenthesis");
646 type
= create_array_type ((struct type
*) NULL
, type
,
647 create_range_type ((struct type
*) NULL
,
648 builtin_type_int
, 0, 0));
649 TYPE_ARRAY_UPPER_BOUND_TYPE(type
) = BOUND_CANNOT_BE_DETERMINED
;
650 write_exp_elt_opcode (UNOP_CAST
);
651 write_exp_elt_type (type
);
652 write_exp_elt_opcode (UNOP_CAST
);
664 expect (')', "missing right parenthesis");
669 case GENERAL_PROCEDURE_NAME
:
671 write_exp_elt_opcode (OP_VAR_VALUE
);
672 write_exp_elt_block (NULL
);
673 write_exp_elt_sym (PEEK_LVAL ().ssym
.sym
);
674 write_exp_elt_opcode (OP_VAR_VALUE
);
677 case GDB_VARIABLE
: /* gdb specific */
682 write_exp_elt_opcode (UNOP_CAST
);
683 write_exp_elt_type (builtin_type_int
);
684 write_exp_elt_opcode (UNOP_CAST
);
688 write_exp_elt_opcode (UNOP_CARD
);
692 write_exp_elt_opcode (UNOP_CHMAX
);
696 write_exp_elt_opcode (UNOP_CHMIN
);
698 case PRED
: op_name
= "PRED"; goto unimplemented_unary_builtin
;
699 case SUCC
: op_name
= "SUCC"; goto unimplemented_unary_builtin
;
700 case ABS
: op_name
= "ABS"; goto unimplemented_unary_builtin
;
701 unimplemented_unary_builtin
:
703 error ("not implemented: %s builtin function", op_name
);
707 write_exp_elt_opcode (UNOP_ADDR
);
710 type
= parse_mode_or_normal_call ();
712 { write_exp_elt_opcode (OP_LONG
);
713 write_exp_elt_type (builtin_type_int
);
714 CHECK_TYPEDEF (type
);
715 write_exp_elt_longcst ((LONGEST
) TYPE_LENGTH (type
));
716 write_exp_elt_opcode (OP_LONG
);
719 write_exp_elt_opcode (UNOP_SIZEOF
);
728 type
= parse_mode_or_normal_call ();
729 write_lower_upper_value (op
, type
);
733 write_exp_elt_opcode (UNOP_LENGTH
);
736 type
= PEEK_LVAL ().tsym
.type
;
738 switch (PEEK_TOKEN())
746 expect (')', "missing right parenthesis");
747 write_exp_elt_opcode (UNOP_CAST
);
748 write_exp_elt_type (type
);
749 write_exp_elt_opcode (UNOP_CAST
);
752 error ("typename in invalid context");
757 error ("invalid expression syntax at `%s'", lexptr
);
761 switch (PEEK_TOKEN ())
764 write_exp_elt_opcode (STRUCTOP_STRUCT
);
765 write_exp_string (PEEK_LVAL ().sval
);
766 write_exp_elt_opcode (STRUCTOP_STRUCT
);
771 if (PEEK_TOKEN () == TYPENAME
)
773 type
= PEEK_LVAL ().tsym
.type
;
774 write_exp_elt_opcode (UNOP_CAST
);
775 write_exp_elt_type (lookup_pointer_type (type
));
776 write_exp_elt_opcode (UNOP_CAST
);
779 write_exp_elt_opcode (UNOP_IND
);
784 case CHARACTER_STRING_LITERAL
:
785 case CHARACTER_LITERAL
:
786 case BIT_STRING_LITERAL
:
787 /* Handle string repetition. (See comment in parse_operand5.) */
789 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
790 write_exp_elt_longcst (1);
791 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
802 if (check_token (RECEIVE
))
805 error ("not implemented: RECEIVE expression");
807 else if (check_token (POINTER
))
810 write_exp_elt_opcode (UNOP_ADDR
);
820 /* We are supposed to be looking for a <string repetition operator>,
821 but in general we can't distinguish that from a parenthesized
822 expression. This is especially difficult if we allow the
823 string operand to be a constant expression (as requested by
824 some users), and not just a string literal.
825 Consider: LPRN expr RPRN LPRN expr RPRN
826 Is that a function call or string repetition?
827 Instead, we handle string repetition in parse_primval,
828 and build_generalized_call. */
829 switch (PEEK_TOKEN())
831 case NOT
: op
= UNOP_LOGICAL_NOT
; break;
832 case '-': op
= UNOP_NEG
; break;
840 write_exp_elt_opcode (op
);
850 switch (PEEK_TOKEN())
852 case '*': op
= BINOP_MUL
; break;
853 case '/': op
= BINOP_DIV
; break;
854 case MOD
: op
= BINOP_MOD
; break;
855 case REM
: op
= BINOP_REM
; break;
861 write_exp_elt_opcode (op
);
872 switch (PEEK_TOKEN())
874 case '+': op
= BINOP_ADD
; break;
875 case '-': op
= BINOP_SUB
; break;
876 case SLASH_SLASH
: op
= BINOP_CONCAT
; break;
882 write_exp_elt_opcode (op
);
893 if (check_token (IN
))
896 write_exp_elt_opcode (BINOP_IN
);
900 switch (PEEK_TOKEN())
902 case '>': op
= BINOP_GTR
; break;
903 case GEQ
: op
= BINOP_GEQ
; break;
904 case '<': op
= BINOP_LESS
; break;
905 case LEQ
: op
= BINOP_LEQ
; break;
906 case '=': op
= BINOP_EQUAL
; break;
907 case NOTEQUAL
: op
= BINOP_NOTEQUAL
; break;
913 write_exp_elt_opcode (op
);
925 switch (PEEK_TOKEN())
927 case LOGAND
: op
= BINOP_BITWISE_AND
; break;
928 case ANDIF
: op
= BINOP_LOGICAL_AND
; break;
934 write_exp_elt_opcode (op
);
945 switch (PEEK_TOKEN())
947 case LOGIOR
: op
= BINOP_BITWISE_IOR
; break;
948 case LOGXOR
: op
= BINOP_BITWISE_XOR
; break;
949 case ORIF
: op
= BINOP_LOGICAL_OR
; break;
955 write_exp_elt_opcode (op
);
963 if (check_token (GDB_ASSIGNMENT
))
966 write_exp_elt_opcode (BINOP_ASSIGN
);
971 parse_then_alternative ()
973 expect (THEN
, "missing 'THEN' in 'IF' expression");
978 parse_else_alternative ()
980 if (check_token (ELSIF
))
981 parse_if_expression_body ();
982 else if (check_token (ELSE
))
985 error ("missing ELSE/ELSIF in IF expression");
988 /* Matches: <boolean expression> <then alternative> <else alternative> */
991 parse_if_expression_body ()
994 parse_then_alternative ();
995 parse_else_alternative ();
996 write_exp_elt_opcode (TERNOP_COND
);
1000 parse_if_expression ()
1003 parse_if_expression_body ();
1004 expect (FI
, "missing 'FI' at end of conditional expression");
1007 /* An <untyped_expr> is a superset of <expr>. It also includes
1008 <conditional expressions> and untyped <tuples>, whose types
1009 are not given by their constituents. Hence, these are only
1010 allowed in certain contexts that expect a certain type.
1011 You should call convert() to fix up the <untyped_expr>. */
1014 parse_untyped_expr ()
1016 switch (PEEK_TOKEN())
1019 parse_if_expression ();
1022 error ("not implemented: CASE expression");
1024 switch (PEEK_TOKEN1())
1032 parse_untyped_expr ();
1033 expect (')', "missing ')'");
1046 terminal_buffer
[0] = TOKEN_NOT_READ
;
1047 if (PEEK_TOKEN () == TYPENAME
&& PEEK_TOKEN1 () == END_TOKEN
)
1049 write_exp_elt_opcode(OP_TYPE
);
1050 write_exp_elt_type(PEEK_LVAL ().tsym
.type
);
1051 write_exp_elt_opcode(OP_TYPE
);
1056 if (terminal_buffer
[0] != END_TOKEN
)
1058 if (comma_terminates
&& terminal_buffer
[0] == ',')
1059 lexptr
--; /* Put the comma back. */
1061 error ("Junk after end of expression.");
1067 /* Implementation of a dynamically expandable buffer for processing input
1068 characters acquired through lexptr and building a value to return in
1071 static char *tempbuf
; /* Current buffer contents */
1072 static int tempbufsize
; /* Size of allocated buffer */
1073 static int tempbufindex
; /* Current index into buffer */
1075 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1077 #define CHECKBUF(size) \
1079 if (tempbufindex + (size) >= tempbufsize) \
1081 growbuf_by_size (size); \
1085 /* Grow the static temp buffer if necessary, including allocating the first one
1089 growbuf_by_size (count
)
1094 growby
= max (count
, GROWBY_MIN_SIZE
);
1095 tempbufsize
+= growby
;
1096 if (tempbuf
== NULL
)
1098 tempbuf
= (char *) xmalloc (tempbufsize
);
1102 tempbuf
= (char *) xrealloc (tempbuf
, tempbufsize
);
1106 /* Try to consume a simple name string token. If successful, returns
1107 a pointer to a nullbyte terminated copy of the name that can be used
1108 in symbol table lookups. If not successful, returns NULL. */
1111 match_simple_name_string ()
1113 char *tokptr
= lexptr
;
1115 if (isalpha (*tokptr
) || *tokptr
== '_')
1120 } while (isalnum (*tokptr
) || (*tokptr
== '_'));
1121 yylval
.sval
.ptr
= lexptr
;
1122 yylval
.sval
.length
= tokptr
- lexptr
;
1124 result
= copy_name (yylval
.sval
);
1130 /* Start looking for a value composed of valid digits as set by the base
1131 in use. Note that '_' characters are valid anywhere, in any quantity,
1132 and are simply ignored. Since we must find at least one valid digit,
1133 or reject this token as an integer literal, we keep track of how many
1134 digits we have encountered. */
1137 decode_integer_value (base
, tokptrptr
, ivalptr
)
1142 char *tokptr
= *tokptrptr
;
1146 while (*tokptr
!= '\0')
1150 temp
= tolower (temp
);
1156 case '0': case '1': case '2': case '3': case '4':
1157 case '5': case '6': case '7': case '8': case '9':
1160 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1176 /* Found something not in domain for current base. */
1177 tokptr
--; /* Unconsume what gave us indigestion. */
1182 /* If we didn't find any digits, then we don't have a valid integer
1183 value, so reject the entire token. Otherwise, update the lexical
1184 scan pointer, and return non-zero for success. */
1192 *tokptrptr
= tokptr
;
1198 decode_integer_literal (valptr
, tokptrptr
)
1202 char *tokptr
= *tokptrptr
;
1205 int explicit_base
= 0;
1207 /* Look for an explicit base specifier, which is optional. */
1240 /* If we found an explicit base ensure that the character after the
1241 explicit base is a single quote. */
1243 if (explicit_base
&& (*tokptr
++ != '\''))
1248 /* Attempt to decode whatever follows as an integer value in the
1249 indicated base, updating the token pointer in the process and
1250 computing the value into ival. Also, if we have an explicit
1251 base, then the next character must not be a single quote, or we
1252 have a bitstring literal, so reject the entire token in this case.
1253 Otherwise, update the lexical scan pointer, and return non-zero
1256 if (!decode_integer_value (base
, &tokptr
, &ival
))
1260 else if (explicit_base
&& (*tokptr
== '\''))
1267 *tokptrptr
= tokptr
;
1272 /* If it wasn't for the fact that floating point values can contain '_'
1273 characters, we could just let strtod do all the hard work by letting it
1274 try to consume as much of the current token buffer as possible and
1275 find a legal conversion. Unfortunately we need to filter out the '_'
1276 characters before calling strtod, which we do by copying the other
1277 legal chars to a local buffer to be converted. However since we also
1278 need to keep track of where the last unconsumed character in the input
1279 buffer is, we have transfer only as many characters as may compose a
1280 legal floating point value. */
1282 static enum ch_terminal
1283 match_float_literal ()
1285 char *tokptr
= lexptr
;
1289 extern double strtod ();
1291 /* Make local buffer in which to build the string to convert. This is
1292 required because underscores are valid in chill floating point numbers
1293 but not in the string passed to strtod to convert. The string will be
1294 no longer than our input string. */
1296 copy
= buf
= (char *) alloca (strlen (tokptr
) + 1);
1298 /* Transfer all leading digits to the conversion buffer, discarding any
1301 while (isdigit (*tokptr
) || *tokptr
== '_')
1310 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1311 of whether we found any leading digits, and we simply accept it and
1312 continue on to look for the fractional part and/or exponent. One of
1313 [eEdD] is legal only if we have seen digits, and means that there
1314 is no fractional part. If we find neither of these, then this is
1315 not a floating point number, so return failure. */
1320 /* Accept and then look for fractional part and/or exponent. */
1333 goto collect_exponent
;
1341 /* We found a '.', copy any fractional digits to the conversion buffer, up
1342 to the first nondigit, non-underscore character. */
1344 while (isdigit (*tokptr
) || *tokptr
== '_')
1353 /* Look for an exponent, which must start with one of [eEdD]. If none
1354 is found, jump directly to trying to convert what we have collected
1371 /* Accept an optional '-' or '+' following one of [eEdD]. */
1374 if (*tokptr
== '+' || *tokptr
== '-')
1376 *copy
++ = *tokptr
++;
1379 /* Now copy an exponent into the conversion buffer. Note that at the
1380 moment underscores are *not* allowed in exponents. */
1382 while (isdigit (*tokptr
))
1384 *copy
++ = *tokptr
++;
1387 /* If we transfered any chars to the conversion buffer, try to interpret its
1388 contents as a floating point value. If any characters remain, then we
1389 must not have a valid floating point string. */
1395 dval
= strtod (buf
, ©
);
1400 return (FLOAT_LITERAL
);
1406 /* Recognize a string literal. A string literal is a sequence
1407 of characters enclosed in matching single or double quotes, except that
1408 a single character inside single quotes is a character literal, which
1409 we reject as a string literal. To embed the terminator character inside
1410 a string, it is simply doubled (I.E. "this""is""one""string") */
1412 static enum ch_terminal
1413 match_string_literal ()
1415 char *tokptr
= lexptr
;
1419 for (tempbufindex
= 0, tokptr
++; *tokptr
!= '\0'; tokptr
++)
1425 /* skip possible whitespaces */
1426 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1434 else if (*tokptr
!= ',')
1435 error ("Invalid control sequence");
1437 /* skip possible whitespaces */
1438 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1440 if (!decode_integer_literal (&ival
, &tokptr
))
1441 error ("Invalid control sequence");
1444 else if (*tokptr
== *lexptr
)
1446 if (*(tokptr
+ 1) == *lexptr
)
1455 else if (*tokptr
== '^')
1457 if (*(tokptr
+ 1) == '(')
1461 if (!decode_integer_literal (&ival
, &tokptr
))
1462 error ("Invalid control sequence");
1465 else if (*(tokptr
+ 1) == '^')
1468 error ("Invalid control sequence");
1472 tempbuf
[tempbufindex
++] = ival
;
1475 error ("Invalid control sequence");
1477 if (*tokptr
== '\0' /* no terminator */
1478 || (tempbufindex
== 1 && *tokptr
== '\'')) /* char literal */
1484 tempbuf
[tempbufindex
] = '\0';
1485 yylval
.sval
.ptr
= tempbuf
;
1486 yylval
.sval
.length
= tempbufindex
;
1488 return (CHARACTER_STRING_LITERAL
);
1492 /* Recognize a character literal. A character literal is single character
1493 or a control sequence, enclosed in single quotes. A control sequence
1494 is a comma separated list of one or more integer literals, enclosed
1495 in parenthesis and introduced with a circumflex character.
1497 EX: 'a' '^(7)' '^(7,8)'
1499 As a GNU chill extension, the syntax C'xx' is also recognized as a
1500 character literal, where xx is a hex value for the character.
1502 Note that more than a single character, enclosed in single quotes, is
1505 Returns CHARACTER_LITERAL if a match is found.
1508 static enum ch_terminal
1509 match_character_literal ()
1511 char *tokptr
= lexptr
;
1514 if ((*tokptr
== 'c' || *tokptr
== 'C') && (*(tokptr
+ 1) == '\''))
1516 /* We have a GNU chill extension form, so skip the leading "C'",
1517 decode the hex value, and then ensure that we have a trailing
1518 single quote character. */
1520 if (!decode_integer_value (16, &tokptr
, &ival
) || (*tokptr
!= '\''))
1526 else if (*tokptr
== '\'')
1530 /* Determine which form we have, either a control sequence or the
1531 single character form. */
1535 if (*(tokptr
+ 1) == '(')
1537 /* Match and decode a control sequence. Return zero if we don't
1538 find a valid integer literal, or if the next unconsumed character
1539 after the integer literal is not the trailing ')'. */
1541 if (!decode_integer_literal (&ival
, &tokptr
) || (*tokptr
++ != ')'))
1546 else if (*(tokptr
+ 1) == '^')
1553 error ("Invalid control sequence");
1555 else if (*tokptr
== '\'')
1557 /* this must be duplicated */
1566 /* The trailing quote has not yet been consumed. If we don't find
1567 it, then we have no match. */
1569 if (*tokptr
++ != '\'')
1576 /* Not a character literal. */
1579 yylval
.typed_val
.val
= ival
;
1580 yylval
.typed_val
.type
= builtin_type_chill_char
;
1582 return (CHARACTER_LITERAL
);
1585 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1586 Note that according to 5.2.4.2, a single "_" is also a valid integer
1587 literal, however GNU-chill requires there to be at least one "digit"
1588 in any integer literal. */
1590 static enum ch_terminal
1591 match_integer_literal ()
1593 char *tokptr
= lexptr
;
1596 if (!decode_integer_literal (&ival
, &tokptr
))
1602 yylval
.typed_val
.val
= ival
;
1603 #if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1604 if (ival
> (LONGEST
)2147483647U || ival
< -(LONGEST
)2147483648U)
1605 yylval
.typed_val
.type
= builtin_type_long_long
;
1608 yylval
.typed_val
.type
= builtin_type_int
;
1610 return (INTEGER_LITERAL
);
1614 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1615 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1616 literal, however GNU-chill requires there to be at least one "digit"
1617 in any bit-string literal. */
1619 static enum ch_terminal
1620 match_bitstring_literal ()
1622 register char *tokptr
= lexptr
;
1632 /* Look for the required explicit base specifier. */
1653 /* Ensure that the character after the explicit base is a single quote. */
1655 if (*tokptr
++ != '\'')
1660 while (*tokptr
!= '\0' && *tokptr
!= '\'')
1663 if (isupper (digit
))
1664 digit
= tolower (digit
);
1670 case '0': case '1': case '2': case '3': case '4':
1671 case '5': case '6': case '7': case '8': case '9':
1674 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1679 /* this is not a bitstring literal, probably an integer */
1682 if (digit
>= 1 << bits_per_char
)
1684 /* Found something not in domain for current base. */
1685 error ("Too-large digit in bitstring or integer.");
1689 /* Extract bits from digit, packing them into the bitstring byte. */
1690 int k
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? bits_per_char
- 1 : 0;
1691 for (; TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
>= 0 : k
< bits_per_char
;
1692 TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
-- : k
++)
1695 if (digit
& (1 << k
))
1697 tempbuf
[tempbufindex
] |=
1698 (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1699 ? (1 << (HOST_CHAR_BIT
- 1 - bitoffset
))
1703 if (bitoffset
== HOST_CHAR_BIT
)
1708 tempbuf
[tempbufindex
] = 0;
1714 /* Verify that we consumed everything up to the trailing single quote,
1715 and that we found some bits (IE not just underbars). */
1717 if (*tokptr
++ != '\'')
1723 yylval
.sval
.ptr
= tempbuf
;
1724 yylval
.sval
.length
= bitcount
;
1726 return (BIT_STRING_LITERAL
);
1736 static const struct token idtokentab
[] =
1739 { "length", LENGTH
},
1750 { "max", MAX_TOKEN
},
1751 { "min", MIN_TOKEN
},
1760 { "addr", ADDR_TOKEN
},
1761 { "null", EMPTINESS_LITERAL
}
1764 static const struct token tokentab2
[] =
1766 { ":=", GDB_ASSIGNMENT
},
1767 { "//", SLASH_SLASH
},
1774 /* Read one token, getting characters through lexptr. */
1775 /* This is where we will check to make sure that the language and the
1776 operators used are compatible. */
1778 static enum ch_terminal
1782 enum ch_terminal token
;
1786 /* Skip over any leading whitespace. */
1787 while (isspace (*lexptr
))
1791 /* Look for special single character cases which can't be the first
1792 character of some other multicharacter token. */
1809 /* Look for characters which start a particular kind of multicharacter
1810 token, such as a character literal, register name, convenience
1811 variable name, string literal, etc. */
1816 /* First try to match a string literal, which is any
1817 sequence of characters enclosed in matching single or double
1818 quotes, except that a single character inside single quotes
1819 is a character literal, so we have to catch that case also. */
1820 token
= match_string_literal ();
1825 if (*lexptr
== '\'')
1827 token
= match_character_literal ();
1836 token
= match_character_literal ();
1843 yylval
.sval
.ptr
= lexptr
;
1846 } while (isalnum (*lexptr
) || *lexptr
== '_' || *lexptr
== '$');
1847 yylval
.sval
.length
= lexptr
- yylval
.sval
.ptr
;
1848 write_dollar_variable (yylval
.sval
);
1849 return GDB_VARIABLE
;
1852 /* See if it is a special token of length 2. */
1853 for (i
= 0; i
< sizeof (tokentab2
) / sizeof (tokentab2
[0]); i
++)
1855 if (STREQN (lexptr
, tokentab2
[i
].operator, 2))
1858 return (tokentab2
[i
].token
);
1861 /* Look for single character cases which which could be the first
1862 character of some other multicharacter token, but aren't, or we
1863 would already have found it. */
1873 /* Look for a float literal before looking for an integer literal, so
1874 we match as much of the input stream as possible. */
1875 token
= match_float_literal ();
1880 token
= match_bitstring_literal ();
1885 token
= match_integer_literal ();
1891 /* Try to match a simple name string, and if a match is found, then
1892 further classify what sort of name it is and return an appropriate
1893 token. Note that attempting to match a simple name string consumes
1894 the token from lexptr, so we can't back out if we later find that
1895 we can't classify what sort of name it is. */
1897 inputname
= match_simple_name_string ();
1899 if (inputname
!= NULL
)
1901 char *simplename
= (char*) alloca (strlen (inputname
) + 1);
1903 char *dptr
= simplename
, *sptr
= inputname
;
1904 for (; *sptr
; sptr
++)
1905 *dptr
++ = isupper (*sptr
) ? tolower(*sptr
) : *sptr
;
1908 /* See if it is a reserved identifier. */
1909 for (i
= 0; i
< sizeof (idtokentab
) / sizeof (idtokentab
[0]); i
++)
1911 if (STREQ (simplename
, idtokentab
[i
].operator))
1913 return (idtokentab
[i
].token
);
1917 /* Look for other special tokens. */
1918 if (STREQ (simplename
, "true"))
1921 return (BOOLEAN_LITERAL
);
1923 if (STREQ (simplename
, "false"))
1926 return (BOOLEAN_LITERAL
);
1929 sym
= lookup_symbol (inputname
, expression_context_block
,
1930 VAR_NAMESPACE
, (int *) NULL
,
1931 (struct symtab
**) NULL
);
1932 if (sym
== NULL
&& strcmp (inputname
, simplename
) != 0)
1934 sym
= lookup_symbol (simplename
, expression_context_block
,
1935 VAR_NAMESPACE
, (int *) NULL
,
1936 (struct symtab
**) NULL
);
1940 yylval
.ssym
.stoken
.ptr
= NULL
;
1941 yylval
.ssym
.stoken
.length
= 0;
1942 yylval
.ssym
.sym
= sym
;
1943 yylval
.ssym
.is_a_field_of_this
= 0; /* FIXME, C++'ism */
1944 switch (SYMBOL_CLASS (sym
))
1947 /* Found a procedure name. */
1948 return (GENERAL_PROCEDURE_NAME
);
1950 /* Found a global or local static variable. */
1951 return (LOCATION_NAME
);
1956 case LOC_REGPARM_ADDR
:
1960 case LOC_BASEREG_ARG
:
1961 if (innermost_block
== NULL
1962 || contained_in (block_found
, innermost_block
))
1964 innermost_block
= block_found
;
1966 return (LOCATION_NAME
);
1970 return (LOCATION_NAME
);
1973 yylval
.tsym
.type
= SYMBOL_TYPE (sym
);
1976 case LOC_CONST_BYTES
:
1977 case LOC_OPTIMIZED_OUT
:
1978 error ("Symbol \"%s\" names no location.", inputname
);
1982 else if (!have_full_symbols () && !have_partial_symbols ())
1984 error ("No symbol table is loaded. Use the \"file\" command.");
1988 error ("No symbol \"%s\" in current context.", inputname
);
1992 /* Catch single character tokens which are not part of some
1997 case '.': /* Not float for example. */
1999 while (isspace (*lexptr
)) lexptr
++;
2000 inputname
= match_simple_name_string ();
2006 return (ILLEGAL_TOKEN
);
2010 write_lower_upper_value (opcode
, type
)
2011 enum exp_opcode opcode
; /* Either UNOP_LOWER or UNOP_UPPER */
2015 write_exp_elt_opcode (opcode
);
2018 extern LONGEST
type_lower_upper ();
2019 struct type
*result_type
;
2020 LONGEST val
= type_lower_upper (opcode
, type
, &result_type
);
2021 write_exp_elt_opcode (OP_LONG
);
2022 write_exp_elt_type (result_type
);
2023 write_exp_elt_longcst (val
);
2024 write_exp_elt_opcode (OP_LONG
);