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,
19 Boston, MA 02111-1307, USA. */
21 /* Parse a Chill expression from text in a string,
22 and return the result as a struct expression pointer.
23 That structure contains arithmetic operations in reverse polish,
24 with constants represented by operations that are followed by special data.
25 See expression.h for the details of the format.
26 What is important here is that it can be built up sequentially
27 during the process of parsing; the lower levels of the tree always
28 come first in the result.
30 Note that the language accepted by this parser is more liberal
31 than the one accepted by an actual Chill compiler. For example, the
32 language rule that a simple name string can not be one of the reserved
33 simple name strings is not enforced (e.g "case" is not treated as a
34 reserved name). Another example is that Chill is a strongly typed
35 language, and certain expressions that violate the type constraints
36 may still be evaluated if gdb can do so in a meaningful manner, while
37 such expressions would be rejected by the compiler. The reason for
38 this more liberal behavior is the philosophy that the debugger
39 is intended to be a tool that is used by the programmer when things
40 go wrong, and as such, it should provide as few artificial barriers
41 to it's use as possible. If it can do something meaningful, even
42 something that violates language contraints that are enforced by the
43 compiler, it should do so without complaint.
48 #include "gdb_string.h"
50 #include "expression.h"
53 #include "parser-defs.h"
55 #include "bfd.h" /* Required by objfiles.h. */
56 #include "symfile.h" /* Required by objfiles.h. */
57 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
60 #define INLINE __inline__
86 /* '\001' ... '\xff' come first. */
93 GENERAL_PROCEDURE_NAME
,
96 CHARACTER_STRING_LITERAL
,
99 DOT_FIELD_NAME
, /* '.' followed by <field name> */
142 /* Forward declarations. */
144 static void write_lower_upper_value (enum exp_opcode
, struct type
*);
145 static enum ch_terminal
match_bitstring_literal (void);
146 static enum ch_terminal
match_integer_literal (void);
147 static enum ch_terminal
match_character_literal (void);
148 static enum ch_terminal
match_string_literal (void);
149 static enum ch_terminal
match_float_literal (void);
150 static enum ch_terminal
match_float_literal (void);
151 static int decode_integer_literal (LONGEST
*, char **);
152 static int decode_integer_value (int, char **, LONGEST
*);
153 static char *match_simple_name_string (void);
154 static void growbuf_by_size (int);
155 static void parse_untyped_expr (void);
156 static void parse_if_expression (void);
157 static void parse_else_alternative (void);
158 static void parse_then_alternative (void);
159 static void parse_expr (void);
160 static void parse_operand0 (void);
161 static void parse_operand1 (void);
162 static void parse_operand2 (void);
163 static void parse_operand3 (void);
164 static void parse_operand4 (void);
165 static void parse_operand5 (void);
166 static void parse_operand6 (void);
167 static void parse_primval (void);
168 static void parse_tuple (struct type
*);
169 static void parse_opt_element_list (struct type
*);
170 static void parse_tuple_element (struct type
*);
171 static void parse_named_record_element (void);
172 static void parse_call (void);
173 static struct type
*parse_mode_or_normal_call (void);
175 static struct type
*parse_mode_call (void);
177 static void parse_unary_call (void);
178 static int parse_opt_untyped_expr (void);
179 static void parse_case_label (void);
180 static int expect (enum ch_terminal
, char *);
181 static void parse_expr (void);
182 static void parse_primval (void);
183 static void parse_untyped_expr (void);
184 static int parse_opt_untyped_expr (void);
185 static void parse_if_expression_body (void);
186 static enum ch_terminal
ch_lex (void);
187 INLINE
static enum ch_terminal
PEEK_TOKEN (void);
188 static enum ch_terminal
peek_token_ (int);
189 static void forward_token_ (void);
190 static void require (enum ch_terminal
);
191 static int check_token (enum ch_terminal
);
193 #define MAX_LOOK_AHEAD 2
194 static enum ch_terminal terminal_buffer
[MAX_LOOK_AHEAD
+ 1] =
196 TOKEN_NOT_READ
, TOKEN_NOT_READ
, TOKEN_NOT_READ
};
197 static YYSTYPE yylval
;
198 static YYSTYPE val_buffer
[MAX_LOOK_AHEAD
+ 1];
200 /*int current_token, lookahead_token; */
202 INLINE
static enum ch_terminal
205 if (terminal_buffer
[0] == TOKEN_NOT_READ
)
207 terminal_buffer
[0] = ch_lex ();
208 val_buffer
[0] = yylval
;
210 return terminal_buffer
[0];
212 #define PEEK_LVAL() val_buffer[0]
213 #define PEEK_TOKEN1() peek_token_(1)
214 #define PEEK_TOKEN2() peek_token_(2)
215 static enum ch_terminal
219 if (i
> MAX_LOOK_AHEAD
)
220 internal_error ("ch-exp.c - too much lookahead");
221 if (terminal_buffer
[i
] == TOKEN_NOT_READ
)
223 terminal_buffer
[i
] = ch_lex ();
224 val_buffer
[i
] = yylval
;
226 return terminal_buffer
[i
];
232 pushback_token (code
, node
)
233 enum ch_terminal code
;
237 if (terminal_buffer
[MAX_LOOK_AHEAD
] != TOKEN_NOT_READ
)
238 internal_error ("ch-exp.c - cannot pushback token");
239 for (i
= MAX_LOOK_AHEAD
; i
> 0; i
--)
241 terminal_buffer
[i
] = terminal_buffer
[i
- 1];
242 val_buffer
[i
] = val_buffer
[i
- 1];
244 terminal_buffer
[0] = code
;
245 val_buffer
[0] = node
;
254 for (i
= 0; i
< MAX_LOOK_AHEAD
; i
++)
256 terminal_buffer
[i
] = terminal_buffer
[i
+ 1];
257 val_buffer
[i
] = val_buffer
[i
+ 1];
259 terminal_buffer
[MAX_LOOK_AHEAD
] = TOKEN_NOT_READ
;
261 #define FORWARD_TOKEN() forward_token_()
263 /* Skip the next token.
264 if it isn't TOKEN, the parser is broken. */
268 enum ch_terminal token
;
270 if (PEEK_TOKEN () != token
)
272 internal_error ("ch-exp.c - expected token %d", (int) token
);
279 enum ch_terminal token
;
281 if (PEEK_TOKEN () != token
)
287 /* return 0 if expected token was not found,
291 expect (token
, message
)
292 enum ch_terminal token
;
295 if (PEEK_TOKEN () != token
)
299 else if (token
< 256)
300 error ("syntax error - expected a '%c' here \"%s\"", token
, lexptr
);
302 error ("syntax error");
312 parse_opt_name_string (allow_all
)
313 int allow_all
; /* 1 if ALL is allowed as a postfix */
315 int token
= PEEK_TOKEN ();
319 if (token
== ALL
&& allow_all
)
330 token
= PEEK_TOKEN ();
334 token
= PEEK_TOKEN ();
335 if (token
== ALL
&& allow_all
)
336 return get_identifier3 (IDENTIFIER_POINTER (name
), "!", "*");
340 error ("'%s!' is not followed by an identifier",
341 IDENTIFIER_POINTER (name
));
344 name
= get_identifier3 (IDENTIFIER_POINTER (name
),
345 "!", IDENTIFIER_POINTER (PEEK_LVAL ()));
350 parse_simple_name_string ()
352 int token
= PEEK_TOKEN ();
356 error ("expected a name here");
357 return error_mark_node
;
367 tree name
= parse_opt_name_string (0);
371 error ("expected a name string here");
372 return error_mark_node
;
375 /* Matches: <name_string>
376 Returns if pass 1: the identifier.
377 Returns if pass 2: a decl or value for identifier. */
382 tree name
= parse_name_string ();
383 if (pass
== 1 || ignoring
)
387 tree decl
= lookup_name (name
);
388 if (decl
== NULL_TREE
)
390 error ("`%s' undeclared", IDENTIFIER_POINTER (name
));
391 return error_mark_node
;
393 else if (TREE_CODE (TREE_TYPE (decl
)) == ERROR_MARK
)
394 return error_mark_node
;
395 else if (TREE_CODE (decl
) == CONST_DECL
)
396 return DECL_INITIAL (decl
);
397 else if (TREE_CODE (TREE_TYPE (decl
)) == REFERENCE_TYPE
)
398 return convert_from_reference (decl
);
407 pushback_paren_expr (expr
)
410 if (pass
== 1 && !ignoring
)
411 expr
= build1 (PAREN_EXPR
, NULL_TREE
, expr
);
412 pushback_token (EXPR
, expr
);
416 /* Matches: <case label> */
421 if (check_token (ELSE
))
422 error ("ELSE in tuples labels not implemented");
423 /* Does not handle the case of a mode name. FIXME */
425 if (check_token (':'))
428 write_exp_elt_opcode (BINOP_RANGE
);
433 parse_opt_untyped_expr ()
435 switch (PEEK_TOKEN ())
442 parse_untyped_expr ();
456 /* Parse NAME '(' MODENAME ')'. */
466 if (PEEK_TOKEN () != TYPENAME
)
467 error ("expect MODENAME here `%s'", lexptr
);
468 type
= PEEK_LVAL ().tsym
.type
;
477 parse_mode_or_normal_call ()
482 if (PEEK_TOKEN () == TYPENAME
)
484 type
= PEEK_LVAL ().tsym
.type
;
496 /* Parse something that looks like a function call.
497 Assume we have parsed the function, and are at the '('. */
504 /* This is to save the value of arglist_len
505 being accumulated for each dimension. */
507 if (parse_opt_untyped_expr ())
509 int tok
= PEEK_TOKEN ();
511 if (tok
== UP
|| tok
== ':')
515 expect (')', "expected ')' to terminate slice");
517 write_exp_elt_opcode (tok
== UP
? TERNOP_SLICE_COUNT
521 while (check_token (','))
523 parse_untyped_expr ();
530 arg_count
= end_arglist ();
531 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
532 write_exp_elt_longcst (arg_count
);
533 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
537 parse_named_record_element ()
542 label
= PEEK_LVAL ().sval
;
543 sprintf (buf
, "expected a field name here `%s'", lexptr
);
544 expect (DOT_FIELD_NAME
, buf
);
545 if (check_token (','))
546 parse_named_record_element ();
547 else if (check_token (':'))
550 error ("syntax error near `%s' in named record tuple element", lexptr
);
551 write_exp_elt_opcode (OP_LABELED
);
552 write_exp_string (label
);
553 write_exp_elt_opcode (OP_LABELED
);
556 /* Returns one or more TREE_LIST nodes, in reverse order. */
559 parse_tuple_element (type
)
562 if (PEEK_TOKEN () == DOT_FIELD_NAME
)
564 /* Parse a labelled structure tuple. */
565 parse_named_record_element ();
569 if (check_token ('('))
571 if (check_token ('*'))
573 expect (')', "missing ')' after '*' case label list");
576 if (TYPE_CODE (type
) == TYPE_CODE_ARRAY
)
578 /* do this as a range from low to high */
579 struct type
*range_type
= TYPE_FIELD_TYPE (type
, 0);
580 LONGEST low_bound
, high_bound
;
581 if (get_discrete_bounds (range_type
, &low_bound
, &high_bound
) < 0)
582 error ("cannot determine bounds for (*)");
584 write_exp_elt_opcode (OP_LONG
);
585 write_exp_elt_type (range_type
);
586 write_exp_elt_longcst (low_bound
);
587 write_exp_elt_opcode (OP_LONG
);
589 write_exp_elt_opcode (OP_LONG
);
590 write_exp_elt_type (range_type
);
591 write_exp_elt_longcst (high_bound
);
592 write_exp_elt_opcode (OP_LONG
);
593 write_exp_elt_opcode (BINOP_RANGE
);
596 error ("(*) in invalid context");
599 error ("(*) only possible with modename in front of tuple (mode[..])");
604 while (check_token (','))
607 write_exp_elt_opcode (BINOP_COMMA
);
613 parse_untyped_expr ();
614 if (check_token (':'))
616 /* A powerset range or a labeled Array. */
617 parse_untyped_expr ();
618 write_exp_elt_opcode (BINOP_RANGE
);
622 /* Matches: a COMMA-separated list of tuple elements.
623 Returns a list (of TREE_LIST nodes). */
625 parse_opt_element_list (type
)
629 if (PEEK_TOKEN () == ']')
633 parse_tuple_element (type
);
635 if (PEEK_TOKEN () == ']')
637 if (!check_token (','))
638 error ("bad syntax in tuple");
642 /* Parses: '[' elements ']'
643 If modename is non-NULL it prefixed the tuple. */
651 type
= check_typedef (mode
);
656 parse_opt_element_list (type
);
657 expect (']', "missing ']' after tuple");
658 write_exp_elt_opcode (OP_ARRAY
);
659 write_exp_elt_longcst ((LONGEST
) 0);
660 write_exp_elt_longcst ((LONGEST
) end_arglist () - 1);
661 write_exp_elt_opcode (OP_ARRAY
);
664 if (TYPE_CODE (type
) != TYPE_CODE_ARRAY
665 && TYPE_CODE (type
) != TYPE_CODE_STRUCT
666 && TYPE_CODE (type
) != TYPE_CODE_SET
)
667 error ("invalid tuple mode");
668 write_exp_elt_opcode (UNOP_CAST
);
669 write_exp_elt_type (mode
);
670 write_exp_elt_opcode (UNOP_CAST
);
680 switch (PEEK_TOKEN ())
682 case INTEGER_LITERAL
:
683 case CHARACTER_LITERAL
:
684 write_exp_elt_opcode (OP_LONG
);
685 write_exp_elt_type (PEEK_LVAL ().typed_val
.type
);
686 write_exp_elt_longcst (PEEK_LVAL ().typed_val
.val
);
687 write_exp_elt_opcode (OP_LONG
);
690 case BOOLEAN_LITERAL
:
691 write_exp_elt_opcode (OP_BOOL
);
692 write_exp_elt_longcst ((LONGEST
) PEEK_LVAL ().ulval
);
693 write_exp_elt_opcode (OP_BOOL
);
697 write_exp_elt_opcode (OP_DOUBLE
);
698 write_exp_elt_type (builtin_type_double
);
699 write_exp_elt_dblcst (PEEK_LVAL ().dval
);
700 write_exp_elt_opcode (OP_DOUBLE
);
703 case EMPTINESS_LITERAL
:
704 write_exp_elt_opcode (OP_LONG
);
705 write_exp_elt_type (lookup_pointer_type (builtin_type_void
));
706 write_exp_elt_longcst (0);
707 write_exp_elt_opcode (OP_LONG
);
710 case CHARACTER_STRING_LITERAL
:
711 write_exp_elt_opcode (OP_STRING
);
712 write_exp_string (PEEK_LVAL ().sval
);
713 write_exp_elt_opcode (OP_STRING
);
716 case BIT_STRING_LITERAL
:
717 write_exp_elt_opcode (OP_BITSTRING
);
718 write_exp_bitstring (PEEK_LVAL ().sval
);
719 write_exp_elt_opcode (OP_BITSTRING
);
724 /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
725 which casts to an artificial array. */
728 if (PEEK_TOKEN () != TYPENAME
)
729 error ("missing MODENAME after ARRAY()");
730 type
= PEEK_LVAL ().tsym
.type
;
734 expect (')', "missing right parenthesis");
735 type
= create_array_type ((struct type
*) NULL
, type
,
736 create_range_type ((struct type
*) NULL
,
737 builtin_type_int
, 0, 0));
738 TYPE_ARRAY_UPPER_BOUND_TYPE (type
) = BOUND_CANNOT_BE_DETERMINED
;
739 write_exp_elt_opcode (UNOP_CAST
);
740 write_exp_elt_type (type
);
741 write_exp_elt_opcode (UNOP_CAST
);
753 expect (')', "missing right parenthesis");
758 case GENERAL_PROCEDURE_NAME
:
760 write_exp_elt_opcode (OP_VAR_VALUE
);
761 write_exp_elt_block (NULL
);
762 write_exp_elt_sym (PEEK_LVAL ().ssym
.sym
);
763 write_exp_elt_opcode (OP_VAR_VALUE
);
766 case GDB_VARIABLE
: /* gdb specific */
771 write_exp_elt_opcode (UNOP_CAST
);
772 write_exp_elt_type (builtin_type_int
);
773 write_exp_elt_opcode (UNOP_CAST
);
777 write_exp_elt_opcode (UNOP_CARD
);
781 write_exp_elt_opcode (UNOP_CHMAX
);
785 write_exp_elt_opcode (UNOP_CHMIN
);
789 goto unimplemented_unary_builtin
;
792 goto unimplemented_unary_builtin
;
795 goto unimplemented_unary_builtin
;
796 unimplemented_unary_builtin
:
798 error ("not implemented: %s builtin function", op_name
);
802 write_exp_elt_opcode (UNOP_ADDR
);
805 type
= parse_mode_or_normal_call ();
808 write_exp_elt_opcode (OP_LONG
);
809 write_exp_elt_type (builtin_type_int
);
810 CHECK_TYPEDEF (type
);
811 write_exp_elt_longcst ((LONGEST
) TYPE_LENGTH (type
));
812 write_exp_elt_opcode (OP_LONG
);
815 write_exp_elt_opcode (UNOP_SIZEOF
);
824 type
= parse_mode_or_normal_call ();
825 write_lower_upper_value (op
, type
);
829 write_exp_elt_opcode (UNOP_LENGTH
);
832 type
= PEEK_LVAL ().tsym
.type
;
834 switch (PEEK_TOKEN ())
842 expect (')', "missing right parenthesis");
843 write_exp_elt_opcode (UNOP_CAST
);
844 write_exp_elt_type (type
);
845 write_exp_elt_opcode (UNOP_CAST
);
848 error ("typename in invalid context");
853 error ("invalid expression syntax at `%s'", lexptr
);
857 switch (PEEK_TOKEN ())
860 write_exp_elt_opcode (STRUCTOP_STRUCT
);
861 write_exp_string (PEEK_LVAL ().sval
);
862 write_exp_elt_opcode (STRUCTOP_STRUCT
);
867 if (PEEK_TOKEN () == TYPENAME
)
869 type
= PEEK_LVAL ().tsym
.type
;
870 write_exp_elt_opcode (UNOP_CAST
);
871 write_exp_elt_type (lookup_pointer_type (type
));
872 write_exp_elt_opcode (UNOP_CAST
);
875 write_exp_elt_opcode (UNOP_IND
);
880 case CHARACTER_STRING_LITERAL
:
881 case CHARACTER_LITERAL
:
882 case BIT_STRING_LITERAL
:
883 /* Handle string repetition. (See comment in parse_operand5.) */
885 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
886 write_exp_elt_longcst (1);
887 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
891 case INTEGER_LITERAL
:
892 case BOOLEAN_LITERAL
:
894 case GENERAL_PROCEDURE_NAME
:
896 case EMPTINESS_LITERAL
:
947 if (check_token (RECEIVE
))
950 error ("not implemented: RECEIVE expression");
952 else if (check_token (POINTER
))
955 write_exp_elt_opcode (UNOP_ADDR
);
965 /* We are supposed to be looking for a <string repetition operator>,
966 but in general we can't distinguish that from a parenthesized
967 expression. This is especially difficult if we allow the
968 string operand to be a constant expression (as requested by
969 some users), and not just a string literal.
970 Consider: LPRN expr RPRN LPRN expr RPRN
971 Is that a function call or string repetition?
972 Instead, we handle string repetition in parse_primval,
973 and build_generalized_call. */
974 switch (PEEK_TOKEN ())
977 op
= UNOP_LOGICAL_NOT
;
989 write_exp_elt_opcode (op
);
999 switch (PEEK_TOKEN ())
1018 write_exp_elt_opcode (op
);
1029 switch (PEEK_TOKEN ())
1045 write_exp_elt_opcode (op
);
1056 if (check_token (IN
))
1059 write_exp_elt_opcode (BINOP_IN
);
1063 switch (PEEK_TOKEN ())
1081 op
= BINOP_NOTEQUAL
;
1088 write_exp_elt_opcode (op
);
1100 switch (PEEK_TOKEN ())
1103 op
= BINOP_BITWISE_AND
;
1106 op
= BINOP_LOGICAL_AND
;
1113 write_exp_elt_opcode (op
);
1124 switch (PEEK_TOKEN ())
1127 op
= BINOP_BITWISE_IOR
;
1130 op
= BINOP_BITWISE_XOR
;
1133 op
= BINOP_LOGICAL_OR
;
1140 write_exp_elt_opcode (op
);
1148 if (check_token (GDB_ASSIGNMENT
))
1151 write_exp_elt_opcode (BINOP_ASSIGN
);
1156 parse_then_alternative ()
1158 expect (THEN
, "missing 'THEN' in 'IF' expression");
1163 parse_else_alternative ()
1165 if (check_token (ELSIF
))
1166 parse_if_expression_body ();
1167 else if (check_token (ELSE
))
1170 error ("missing ELSE/ELSIF in IF expression");
1173 /* Matches: <boolean expression> <then alternative> <else alternative> */
1176 parse_if_expression_body ()
1179 parse_then_alternative ();
1180 parse_else_alternative ();
1181 write_exp_elt_opcode (TERNOP_COND
);
1185 parse_if_expression ()
1188 parse_if_expression_body ();
1189 expect (FI
, "missing 'FI' at end of conditional expression");
1192 /* An <untyped_expr> is a superset of <expr>. It also includes
1193 <conditional expressions> and untyped <tuples>, whose types
1194 are not given by their constituents. Hence, these are only
1195 allowed in certain contexts that expect a certain type.
1196 You should call convert() to fix up the <untyped_expr>. */
1199 parse_untyped_expr ()
1201 switch (PEEK_TOKEN ())
1204 parse_if_expression ();
1207 error ("not implemented: CASE expression");
1209 switch (PEEK_TOKEN1 ())
1217 parse_untyped_expr ();
1218 expect (')', "missing ')'");
1231 terminal_buffer
[0] = TOKEN_NOT_READ
;
1232 if (PEEK_TOKEN () == TYPENAME
&& PEEK_TOKEN1 () == END_TOKEN
)
1234 write_exp_elt_opcode (OP_TYPE
);
1235 write_exp_elt_type (PEEK_LVAL ().tsym
.type
);
1236 write_exp_elt_opcode (OP_TYPE
);
1241 if (terminal_buffer
[0] != END_TOKEN
)
1243 if (comma_terminates
&& terminal_buffer
[0] == ',')
1244 lexptr
--; /* Put the comma back. */
1246 error ("Junk after end of expression.");
1252 /* Implementation of a dynamically expandable buffer for processing input
1253 characters acquired through lexptr and building a value to return in
1256 static char *tempbuf
; /* Current buffer contents */
1257 static int tempbufsize
; /* Size of allocated buffer */
1258 static int tempbufindex
; /* Current index into buffer */
1260 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1262 #define CHECKBUF(size) \
1264 if (tempbufindex + (size) >= tempbufsize) \
1266 growbuf_by_size (size); \
1270 /* Grow the static temp buffer if necessary, including allocating the first one
1274 growbuf_by_size (count
)
1279 growby
= max (count
, GROWBY_MIN_SIZE
);
1280 tempbufsize
+= growby
;
1281 if (tempbuf
== NULL
)
1283 tempbuf
= (char *) xmalloc (tempbufsize
);
1287 tempbuf
= (char *) xrealloc (tempbuf
, tempbufsize
);
1291 /* Try to consume a simple name string token. If successful, returns
1292 a pointer to a nullbyte terminated copy of the name that can be used
1293 in symbol table lookups. If not successful, returns NULL. */
1296 match_simple_name_string ()
1298 char *tokptr
= lexptr
;
1300 if (isalpha (*tokptr
) || *tokptr
== '_')
1307 while (isalnum (*tokptr
) || (*tokptr
== '_'));
1308 yylval
.sval
.ptr
= lexptr
;
1309 yylval
.sval
.length
= tokptr
- lexptr
;
1311 result
= copy_name (yylval
.sval
);
1317 /* Start looking for a value composed of valid digits as set by the base
1318 in use. Note that '_' characters are valid anywhere, in any quantity,
1319 and are simply ignored. Since we must find at least one valid digit,
1320 or reject this token as an integer literal, we keep track of how many
1321 digits we have encountered. */
1324 decode_integer_value (base
, tokptrptr
, ivalptr
)
1329 char *tokptr
= *tokptrptr
;
1333 while (*tokptr
!= '\0')
1337 temp
= tolower (temp
);
1376 /* Found something not in domain for current base. */
1377 tokptr
--; /* Unconsume what gave us indigestion. */
1382 /* If we didn't find any digits, then we don't have a valid integer
1383 value, so reject the entire token. Otherwise, update the lexical
1384 scan pointer, and return non-zero for success. */
1392 *tokptrptr
= tokptr
;
1398 decode_integer_literal (valptr
, tokptrptr
)
1402 char *tokptr
= *tokptrptr
;
1405 int explicit_base
= 0;
1407 /* Look for an explicit base specifier, which is optional. */
1440 /* If we found an explicit base ensure that the character after the
1441 explicit base is a single quote. */
1443 if (explicit_base
&& (*tokptr
++ != '\''))
1448 /* Attempt to decode whatever follows as an integer value in the
1449 indicated base, updating the token pointer in the process and
1450 computing the value into ival. Also, if we have an explicit
1451 base, then the next character must not be a single quote, or we
1452 have a bitstring literal, so reject the entire token in this case.
1453 Otherwise, update the lexical scan pointer, and return non-zero
1456 if (!decode_integer_value (base
, &tokptr
, &ival
))
1460 else if (explicit_base
&& (*tokptr
== '\''))
1467 *tokptrptr
= tokptr
;
1472 /* If it wasn't for the fact that floating point values can contain '_'
1473 characters, we could just let strtod do all the hard work by letting it
1474 try to consume as much of the current token buffer as possible and
1475 find a legal conversion. Unfortunately we need to filter out the '_'
1476 characters before calling strtod, which we do by copying the other
1477 legal chars to a local buffer to be converted. However since we also
1478 need to keep track of where the last unconsumed character in the input
1479 buffer is, we have transfer only as many characters as may compose a
1480 legal floating point value. */
1482 static enum ch_terminal
1483 match_float_literal ()
1485 char *tokptr
= lexptr
;
1489 extern double strtod ();
1491 /* Make local buffer in which to build the string to convert. This is
1492 required because underscores are valid in chill floating point numbers
1493 but not in the string passed to strtod to convert. The string will be
1494 no longer than our input string. */
1496 copy
= buf
= (char *) alloca (strlen (tokptr
) + 1);
1498 /* Transfer all leading digits to the conversion buffer, discarding any
1501 while (isdigit (*tokptr
) || *tokptr
== '_')
1510 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1511 of whether we found any leading digits, and we simply accept it and
1512 continue on to look for the fractional part and/or exponent. One of
1513 [eEdD] is legal only if we have seen digits, and means that there
1514 is no fractional part. If we find neither of these, then this is
1515 not a floating point number, so return failure. */
1520 /* Accept and then look for fractional part and/or exponent. */
1533 goto collect_exponent
;
1541 /* We found a '.', copy any fractional digits to the conversion buffer, up
1542 to the first nondigit, non-underscore character. */
1544 while (isdigit (*tokptr
) || *tokptr
== '_')
1553 /* Look for an exponent, which must start with one of [eEdD]. If none
1554 is found, jump directly to trying to convert what we have collected
1571 /* Accept an optional '-' or '+' following one of [eEdD]. */
1574 if (*tokptr
== '+' || *tokptr
== '-')
1576 *copy
++ = *tokptr
++;
1579 /* Now copy an exponent into the conversion buffer. Note that at the
1580 moment underscores are *not* allowed in exponents. */
1582 while (isdigit (*tokptr
))
1584 *copy
++ = *tokptr
++;
1587 /* If we transfered any chars to the conversion buffer, try to interpret its
1588 contents as a floating point value. If any characters remain, then we
1589 must not have a valid floating point string. */
1595 dval
= strtod (buf
, ©
);
1600 return (FLOAT_LITERAL
);
1606 /* Recognize a string literal. A string literal is a sequence
1607 of characters enclosed in matching single or double quotes, except that
1608 a single character inside single quotes is a character literal, which
1609 we reject as a string literal. To embed the terminator character inside
1610 a string, it is simply doubled (I.E. "this""is""one""string") */
1612 static enum ch_terminal
1613 match_string_literal ()
1615 char *tokptr
= lexptr
;
1619 for (tempbufindex
= 0, tokptr
++; *tokptr
!= '\0'; tokptr
++)
1625 /* skip possible whitespaces */
1626 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1634 else if (*tokptr
!= ',')
1635 error ("Invalid control sequence");
1637 /* skip possible whitespaces */
1638 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1640 if (!decode_integer_literal (&ival
, &tokptr
))
1641 error ("Invalid control sequence");
1644 else if (*tokptr
== *lexptr
)
1646 if (*(tokptr
+ 1) == *lexptr
)
1655 else if (*tokptr
== '^')
1657 if (*(tokptr
+ 1) == '(')
1661 if (!decode_integer_literal (&ival
, &tokptr
))
1662 error ("Invalid control sequence");
1665 else if (*(tokptr
+ 1) == '^')
1668 error ("Invalid control sequence");
1672 tempbuf
[tempbufindex
++] = ival
;
1675 error ("Invalid control sequence");
1677 if (*tokptr
== '\0' /* no terminator */
1678 || (tempbufindex
== 1 && *tokptr
== '\'')) /* char literal */
1684 tempbuf
[tempbufindex
] = '\0';
1685 yylval
.sval
.ptr
= tempbuf
;
1686 yylval
.sval
.length
= tempbufindex
;
1688 return (CHARACTER_STRING_LITERAL
);
1692 /* Recognize a character literal. A character literal is single character
1693 or a control sequence, enclosed in single quotes. A control sequence
1694 is a comma separated list of one or more integer literals, enclosed
1695 in parenthesis and introduced with a circumflex character.
1697 EX: 'a' '^(7)' '^(7,8)'
1699 As a GNU chill extension, the syntax C'xx' is also recognized as a
1700 character literal, where xx is a hex value for the character.
1702 Note that more than a single character, enclosed in single quotes, is
1705 Returns CHARACTER_LITERAL if a match is found.
1708 static enum ch_terminal
1709 match_character_literal ()
1711 char *tokptr
= lexptr
;
1714 if ((*tokptr
== 'c' || *tokptr
== 'C') && (*(tokptr
+ 1) == '\''))
1716 /* We have a GNU chill extension form, so skip the leading "C'",
1717 decode the hex value, and then ensure that we have a trailing
1718 single quote character. */
1720 if (!decode_integer_value (16, &tokptr
, &ival
) || (*tokptr
!= '\''))
1726 else if (*tokptr
== '\'')
1730 /* Determine which form we have, either a control sequence or the
1731 single character form. */
1735 if (*(tokptr
+ 1) == '(')
1737 /* Match and decode a control sequence. Return zero if we don't
1738 find a valid integer literal, or if the next unconsumed character
1739 after the integer literal is not the trailing ')'. */
1741 if (!decode_integer_literal (&ival
, &tokptr
) || (*tokptr
++ != ')'))
1746 else if (*(tokptr
+ 1) == '^')
1753 error ("Invalid control sequence");
1755 else if (*tokptr
== '\'')
1757 /* this must be duplicated */
1766 /* The trailing quote has not yet been consumed. If we don't find
1767 it, then we have no match. */
1769 if (*tokptr
++ != '\'')
1776 /* Not a character literal. */
1779 yylval
.typed_val
.val
= ival
;
1780 yylval
.typed_val
.type
= builtin_type_chill_char
;
1782 return (CHARACTER_LITERAL
);
1785 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1786 Note that according to 5.2.4.2, a single "_" is also a valid integer
1787 literal, however GNU-chill requires there to be at least one "digit"
1788 in any integer literal. */
1790 static enum ch_terminal
1791 match_integer_literal ()
1793 char *tokptr
= lexptr
;
1796 if (!decode_integer_literal (&ival
, &tokptr
))
1802 yylval
.typed_val
.val
= ival
;
1803 #if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1804 if (ival
> (LONGEST
) 2147483647U || ival
< -(LONGEST
) 2147483648U)
1805 yylval
.typed_val
.type
= builtin_type_long_long
;
1808 yylval
.typed_val
.type
= builtin_type_int
;
1810 return (INTEGER_LITERAL
);
1814 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1815 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1816 literal, however GNU-chill requires there to be at least one "digit"
1817 in any bit-string literal. */
1819 static enum ch_terminal
1820 match_bitstring_literal ()
1822 register char *tokptr
= lexptr
;
1832 /* Look for the required explicit base specifier. */
1853 /* Ensure that the character after the explicit base is a single quote. */
1855 if (*tokptr
++ != '\'')
1860 while (*tokptr
!= '\0' && *tokptr
!= '\'')
1863 if (isupper (digit
))
1864 digit
= tolower (digit
);
1892 /* this is not a bitstring literal, probably an integer */
1895 if (digit
>= 1 << bits_per_char
)
1897 /* Found something not in domain for current base. */
1898 error ("Too-large digit in bitstring or integer.");
1902 /* Extract bits from digit, packing them into the bitstring byte. */
1903 int k
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? bits_per_char
- 1 : 0;
1904 for (; TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
>= 0 : k
< bits_per_char
;
1905 TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
-- : k
++)
1908 if (digit
& (1 << k
))
1910 tempbuf
[tempbufindex
] |=
1911 (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1912 ? (1 << (HOST_CHAR_BIT
- 1 - bitoffset
))
1916 if (bitoffset
== HOST_CHAR_BIT
)
1921 tempbuf
[tempbufindex
] = 0;
1927 /* Verify that we consumed everything up to the trailing single quote,
1928 and that we found some bits (IE not just underbars). */
1930 if (*tokptr
++ != '\'')
1936 yylval
.sval
.ptr
= tempbuf
;
1937 yylval
.sval
.length
= bitcount
;
1939 return (BIT_STRING_LITERAL
);
1949 static const struct token idtokentab
[] =
1973 {"addr", ADDR_TOKEN
},
1974 {"null", EMPTINESS_LITERAL
}
1977 static const struct token tokentab2
[] =
1979 {":=", GDB_ASSIGNMENT
},
1980 {"//", SLASH_SLASH
},
1987 /* Read one token, getting characters through lexptr. */
1988 /* This is where we will check to make sure that the language and the
1989 operators used are compatible. */
1991 static enum ch_terminal
1995 enum ch_terminal token
;
1999 /* Skip over any leading whitespace. */
2000 while (isspace (*lexptr
))
2004 /* Look for special single character cases which can't be the first
2005 character of some other multicharacter token. */
2022 /* Look for characters which start a particular kind of multicharacter
2023 token, such as a character literal, register name, convenience
2024 variable name, string literal, etc. */
2029 /* First try to match a string literal, which is any
2030 sequence of characters enclosed in matching single or double
2031 quotes, except that a single character inside single quotes
2032 is a character literal, so we have to catch that case also. */
2033 token
= match_string_literal ();
2038 if (*lexptr
== '\'')
2040 token
= match_character_literal ();
2049 token
= match_character_literal ();
2056 yylval
.sval
.ptr
= lexptr
;
2061 while (isalnum (*lexptr
) || *lexptr
== '_' || *lexptr
== '$');
2062 yylval
.sval
.length
= lexptr
- yylval
.sval
.ptr
;
2063 write_dollar_variable (yylval
.sval
);
2064 return GDB_VARIABLE
;
2067 /* See if it is a special token of length 2. */
2068 for (i
= 0; i
< sizeof (tokentab2
) / sizeof (tokentab2
[0]); i
++)
2070 if (STREQN (lexptr
, tokentab2
[i
].operator, 2))
2073 return (tokentab2
[i
].token
);
2076 /* Look for single character cases which which could be the first
2077 character of some other multicharacter token, but aren't, or we
2078 would already have found it. */
2088 /* Look for a float literal before looking for an integer literal, so
2089 we match as much of the input stream as possible. */
2090 token
= match_float_literal ();
2095 token
= match_bitstring_literal ();
2100 token
= match_integer_literal ();
2106 /* Try to match a simple name string, and if a match is found, then
2107 further classify what sort of name it is and return an appropriate
2108 token. Note that attempting to match a simple name string consumes
2109 the token from lexptr, so we can't back out if we later find that
2110 we can't classify what sort of name it is. */
2112 inputname
= match_simple_name_string ();
2114 if (inputname
!= NULL
)
2116 char *simplename
= (char *) alloca (strlen (inputname
) + 1);
2118 char *dptr
= simplename
, *sptr
= inputname
;
2119 for (; *sptr
; sptr
++)
2120 *dptr
++ = isupper (*sptr
) ? tolower (*sptr
) : *sptr
;
2123 /* See if it is a reserved identifier. */
2124 for (i
= 0; i
< sizeof (idtokentab
) / sizeof (idtokentab
[0]); i
++)
2126 if (STREQ (simplename
, idtokentab
[i
].operator))
2128 return (idtokentab
[i
].token
);
2132 /* Look for other special tokens. */
2133 if (STREQ (simplename
, "true"))
2136 return (BOOLEAN_LITERAL
);
2138 if (STREQ (simplename
, "false"))
2141 return (BOOLEAN_LITERAL
);
2144 sym
= lookup_symbol (inputname
, expression_context_block
,
2145 VAR_NAMESPACE
, (int *) NULL
,
2146 (struct symtab
**) NULL
);
2147 if (sym
== NULL
&& strcmp (inputname
, simplename
) != 0)
2149 sym
= lookup_symbol (simplename
, expression_context_block
,
2150 VAR_NAMESPACE
, (int *) NULL
,
2151 (struct symtab
**) NULL
);
2155 yylval
.ssym
.stoken
.ptr
= NULL
;
2156 yylval
.ssym
.stoken
.length
= 0;
2157 yylval
.ssym
.sym
= sym
;
2158 yylval
.ssym
.is_a_field_of_this
= 0; /* FIXME, C++'ism */
2159 switch (SYMBOL_CLASS (sym
))
2162 /* Found a procedure name. */
2163 return (GENERAL_PROCEDURE_NAME
);
2165 /* Found a global or local static variable. */
2166 return (LOCATION_NAME
);
2171 case LOC_REGPARM_ADDR
:
2175 case LOC_BASEREG_ARG
:
2176 if (innermost_block
== NULL
2177 || contained_in (block_found
, innermost_block
))
2179 innermost_block
= block_found
;
2181 return (LOCATION_NAME
);
2185 return (LOCATION_NAME
);
2188 yylval
.tsym
.type
= SYMBOL_TYPE (sym
);
2191 case LOC_CONST_BYTES
:
2192 case LOC_OPTIMIZED_OUT
:
2193 error ("Symbol \"%s\" names no location.", inputname
);
2196 internal_error ("unhandled SYMBOL_CLASS in ch_lex()");
2200 else if (!have_full_symbols () && !have_partial_symbols ())
2202 error ("No symbol table is loaded. Use the \"file\" command.");
2206 error ("No symbol \"%s\" in current context.", inputname
);
2210 /* Catch single character tokens which are not part of some
2215 case '.': /* Not float for example. */
2217 while (isspace (*lexptr
))
2219 inputname
= match_simple_name_string ();
2222 return DOT_FIELD_NAME
;
2225 return (ILLEGAL_TOKEN
);
2229 write_lower_upper_value (opcode
, type
)
2230 enum exp_opcode opcode
; /* Either UNOP_LOWER or UNOP_UPPER */
2234 write_exp_elt_opcode (opcode
);
2237 struct type
*result_type
;
2238 LONGEST val
= type_lower_upper (opcode
, type
, &result_type
);
2239 write_exp_elt_opcode (OP_LONG
);
2240 write_exp_elt_type (result_type
);
2241 write_exp_elt_longcst (val
);
2242 write_exp_elt_opcode (OP_LONG
);