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.
47 #include "gdb_string.h"
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. */
84 GENERAL_PROCEDURE_NAME
,
87 CHARACTER_STRING_LITERAL
,
133 /* Forward declarations. */
134 static void parse_expr ();
135 static void parse_primval ();
136 static void parse_untyped_expr ();
137 static int parse_opt_untyped_expr ();
138 static void parse_if_expression_body
PARAMS((void));
139 static void write_lower_upper_value
PARAMS ((enum exp_opcode
, struct type
*));
140 static enum ch_terminal
ch_lex ();
142 #define MAX_LOOK_AHEAD 2
143 static enum ch_terminal terminal_buffer
[MAX_LOOK_AHEAD
+1] = {
144 TOKEN_NOT_READ
, TOKEN_NOT_READ
, TOKEN_NOT_READ
};
145 static YYSTYPE yylval
;
146 static YYSTYPE val_buffer
[MAX_LOOK_AHEAD
+1];
148 /*int current_token, lookahead_token;*/
153 static enum ch_terminal
156 if (terminal_buffer
[0] == TOKEN_NOT_READ
)
158 terminal_buffer
[0] = ch_lex ();
159 val_buffer
[0] = yylval
;
161 return terminal_buffer
[0];
163 #define PEEK_LVAL() val_buffer[0]
164 #define PEEK_TOKEN1() peek_token_(1)
165 #define PEEK_TOKEN2() peek_token_(2)
166 static enum ch_terminal
170 if (i
> MAX_LOOK_AHEAD
)
171 fatal ("internal error - too much lookahead");
172 if (terminal_buffer
[i
] == TOKEN_NOT_READ
)
174 terminal_buffer
[i
] = ch_lex ();
175 val_buffer
[i
] = yylval
;
177 return terminal_buffer
[i
];
183 pushback_token (code
, node
)
184 enum ch_terminal code
;
188 if (terminal_buffer
[MAX_LOOK_AHEAD
] != TOKEN_NOT_READ
)
189 fatal ("internal error - cannot pushback token");
190 for (i
= MAX_LOOK_AHEAD
; i
> 0; i
--)
192 terminal_buffer
[i
] = terminal_buffer
[i
- 1];
193 val_buffer
[i
] = val_buffer
[i
- 1];
195 terminal_buffer
[0] = code
;
196 val_buffer
[0] = node
;
205 for (i
= 0; i
< MAX_LOOK_AHEAD
; i
++)
207 terminal_buffer
[i
] = terminal_buffer
[i
+1];
208 val_buffer
[i
] = val_buffer
[i
+1];
210 terminal_buffer
[MAX_LOOK_AHEAD
] = TOKEN_NOT_READ
;
212 #define FORWARD_TOKEN() forward_token_()
214 /* Skip the next token.
215 if it isn't TOKEN, the parser is broken. */
219 enum ch_terminal token
;
221 if (PEEK_TOKEN() != token
)
224 sprintf (buf
, "internal parser error - expected token %d", (int)token
);
232 enum ch_terminal token
;
234 if (PEEK_TOKEN() != token
)
240 /* return 0 if expected token was not found,
244 expect(token
, message
)
245 enum ch_terminal token
;
248 if (PEEK_TOKEN() != token
)
252 else if (token
< 256)
253 error ("syntax error - expected a '%c' here \"%s\"", token
, lexptr
);
255 error ("syntax error");
265 parse_opt_name_string (allow_all
)
266 int allow_all
; /* 1 if ALL is allowed as a postfix */
268 int token
= PEEK_TOKEN();
272 if (token
== ALL
&& allow_all
)
283 token
= PEEK_TOKEN();
287 token
= PEEK_TOKEN();
288 if (token
== ALL
&& allow_all
)
289 return get_identifier3(IDENTIFIER_POINTER (name
), "!", "*");
293 error ("'%s!' is not followed by an identifier",
294 IDENTIFIER_POINTER (name
));
297 name
= get_identifier3(IDENTIFIER_POINTER(name
),
298 "!", IDENTIFIER_POINTER(PEEK_LVAL()));
303 parse_simple_name_string ()
305 int token
= PEEK_TOKEN();
309 error ("expected a name here");
310 return error_mark_node
;
320 tree name
= parse_opt_name_string (0);
324 error ("expected a name string here");
325 return error_mark_node
;
328 /* Matches: <name_string>
329 Returns if pass 1: the identifier.
330 Returns if pass 2: a decl or value for identifier. */
335 tree name
= parse_name_string ();
336 if (pass
== 1 || ignoring
)
340 tree decl
= lookup_name (name
);
341 if (decl
== NULL_TREE
)
343 error ("`%s' undeclared", IDENTIFIER_POINTER (name
));
344 return error_mark_node
;
346 else if (TREE_CODE (TREE_TYPE (decl
)) == ERROR_MARK
)
347 return error_mark_node
;
348 else if (TREE_CODE (decl
) == CONST_DECL
)
349 return DECL_INITIAL (decl
);
350 else if (TREE_CODE (TREE_TYPE (decl
)) == REFERENCE_TYPE
)
351 return convert_from_reference (decl
);
360 pushback_paren_expr (expr
)
363 if (pass
== 1 && !ignoring
)
364 expr
= build1 (PAREN_EXPR
, NULL_TREE
, expr
);
365 pushback_token (EXPR
, expr
);
369 /* Matches: <case label> */
374 if (check_token (ELSE
))
375 error ("ELSE in tuples labels not implemented");
376 /* Does not handle the case of a mode name. FIXME */
378 if (check_token (':'))
381 write_exp_elt_opcode (BINOP_RANGE
);
386 parse_opt_untyped_expr ()
388 switch (PEEK_TOKEN ())
395 parse_untyped_expr ();
409 /* Parse NAME '(' MODENAME ')'. */
417 if (PEEK_TOKEN () != TYPENAME
)
418 error ("expect MODENAME here `%s'", lexptr
);
419 type
= PEEK_LVAL().tsym
.type
;
426 parse_mode_or_normal_call ()
431 if (PEEK_TOKEN () == TYPENAME
)
433 type
= PEEK_LVAL().tsym
.type
;
445 /* Parse something that looks like a function call.
446 Assume we have parsed the function, and are at the '('. */
453 /* This is to save the value of arglist_len
454 being accumulated for each dimension. */
456 if (parse_opt_untyped_expr ())
458 int tok
= PEEK_TOKEN ();
460 if (tok
== UP
|| tok
== ':')
464 expect (')', "expected ')' to terminate slice");
466 write_exp_elt_opcode (tok
== UP
? TERNOP_SLICE_COUNT
470 while (check_token (','))
472 parse_untyped_expr ();
479 arg_count
= end_arglist ();
480 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
481 write_exp_elt_longcst (arg_count
);
482 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
486 parse_named_record_element ()
490 label
= PEEK_LVAL ().sval
;
491 expect (FIELD_NAME
, "expected a field name here `%s'", lexptr
);
492 if (check_token (','))
493 parse_named_record_element ();
494 else if (check_token (':'))
497 error ("syntax error near `%s' in named record tuple element", lexptr
);
498 write_exp_elt_opcode (OP_LABELED
);
499 write_exp_string (label
);
500 write_exp_elt_opcode (OP_LABELED
);
503 /* Returns one or nore TREE_LIST nodes, in reverse order. */
506 parse_tuple_element ()
508 if (PEEK_TOKEN () == FIELD_NAME
)
510 /* Parse a labelled structure tuple. */
511 parse_named_record_element ();
515 if (check_token ('('))
517 if (check_token ('*'))
519 expect (')', "missing ')' after '*' case label list");
520 error ("(*) not implemented in case label list");
525 while (check_token (','))
528 write_exp_elt_opcode (BINOP_COMMA
);
534 parse_untyped_expr ();
535 if (check_token (':'))
537 /* A powerset range or a labeled Array. */
538 parse_untyped_expr ();
539 write_exp_elt_opcode (BINOP_RANGE
);
543 /* Matches: a COMMA-separated list of tuple elements.
544 Returns a list (of TREE_LIST nodes). */
546 parse_opt_element_list ()
549 if (PEEK_TOKEN () == ']')
553 parse_tuple_element ();
555 if (PEEK_TOKEN () == ']')
557 if (!check_token (','))
558 error ("bad syntax in tuple");
562 /* Parses: '[' elements ']'
563 If modename is non-NULL it prefixed the tuple. */
571 parse_opt_element_list ();
572 expect (']', "missing ']' after tuple");
573 write_exp_elt_opcode (OP_ARRAY
);
574 write_exp_elt_longcst ((LONGEST
) 0);
575 write_exp_elt_longcst ((LONGEST
) end_arglist () - 1);
576 write_exp_elt_opcode (OP_ARRAY
);
579 struct type
*type
= check_typedef (mode
);
580 if (TYPE_CODE (type
) != TYPE_CODE_ARRAY
581 && TYPE_CODE (type
) != TYPE_CODE_STRUCT
582 && TYPE_CODE (type
) != TYPE_CODE_SET
)
583 error ("invalid tuple mode");
584 write_exp_elt_opcode (UNOP_CAST
);
585 write_exp_elt_type (mode
);
586 write_exp_elt_opcode (UNOP_CAST
);
596 switch (PEEK_TOKEN ())
598 case INTEGER_LITERAL
:
599 case CHARACTER_LITERAL
:
600 write_exp_elt_opcode (OP_LONG
);
601 write_exp_elt_type (PEEK_LVAL ().typed_val
.type
);
602 write_exp_elt_longcst (PEEK_LVAL ().typed_val
.val
);
603 write_exp_elt_opcode (OP_LONG
);
606 case BOOLEAN_LITERAL
:
607 write_exp_elt_opcode (OP_BOOL
);
608 write_exp_elt_longcst ((LONGEST
) PEEK_LVAL ().ulval
);
609 write_exp_elt_opcode (OP_BOOL
);
613 write_exp_elt_opcode (OP_DOUBLE
);
614 write_exp_elt_type (builtin_type_double
);
615 write_exp_elt_dblcst (PEEK_LVAL ().dval
);
616 write_exp_elt_opcode (OP_DOUBLE
);
619 case EMPTINESS_LITERAL
:
620 write_exp_elt_opcode (OP_LONG
);
621 write_exp_elt_type (lookup_pointer_type (builtin_type_void
));
622 write_exp_elt_longcst (0);
623 write_exp_elt_opcode (OP_LONG
);
626 case CHARACTER_STRING_LITERAL
:
627 write_exp_elt_opcode (OP_STRING
);
628 write_exp_string (PEEK_LVAL ().sval
);
629 write_exp_elt_opcode (OP_STRING
);
632 case BIT_STRING_LITERAL
:
633 write_exp_elt_opcode (OP_BITSTRING
);
634 write_exp_bitstring (PEEK_LVAL ().sval
);
635 write_exp_elt_opcode (OP_BITSTRING
);
640 /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
641 which casts to an artificial array. */
644 if (PEEK_TOKEN () != TYPENAME
)
645 error ("missing MODENAME after ARRAY()");
646 type
= PEEK_LVAL().tsym
.type
;
650 expect (')', "missing right parenthesis");
651 type
= create_array_type ((struct type
*) NULL
, type
,
652 create_range_type ((struct type
*) NULL
,
653 builtin_type_int
, 0, 0));
654 TYPE_ARRAY_UPPER_BOUND_TYPE(type
) = BOUND_CANNOT_BE_DETERMINED
;
655 write_exp_elt_opcode (UNOP_CAST
);
656 write_exp_elt_type (type
);
657 write_exp_elt_opcode (UNOP_CAST
);
669 expect (')', "missing right parenthesis");
674 case GENERAL_PROCEDURE_NAME
:
676 write_exp_elt_opcode (OP_VAR_VALUE
);
677 write_exp_elt_block (NULL
);
678 write_exp_elt_sym (PEEK_LVAL ().ssym
.sym
);
679 write_exp_elt_opcode (OP_VAR_VALUE
);
682 case GDB_VARIABLE
: /* gdb specific */
687 write_exp_elt_opcode (UNOP_CAST
);
688 write_exp_elt_type (builtin_type_int
);
689 write_exp_elt_opcode (UNOP_CAST
);
693 write_exp_elt_opcode (UNOP_CARD
);
697 write_exp_elt_opcode (UNOP_CHMAX
);
701 write_exp_elt_opcode (UNOP_CHMIN
);
703 case PRED
: op_name
= "PRED"; goto unimplemented_unary_builtin
;
704 case SUCC
: op_name
= "SUCC"; goto unimplemented_unary_builtin
;
705 case ABS
: op_name
= "ABS"; goto unimplemented_unary_builtin
;
706 unimplemented_unary_builtin
:
708 error ("not implemented: %s builtin function", op_name
);
712 write_exp_elt_opcode (UNOP_ADDR
);
715 type
= parse_mode_or_normal_call ();
717 { write_exp_elt_opcode (OP_LONG
);
718 write_exp_elt_type (builtin_type_int
);
719 CHECK_TYPEDEF (type
);
720 write_exp_elt_longcst ((LONGEST
) TYPE_LENGTH (type
));
721 write_exp_elt_opcode (OP_LONG
);
724 write_exp_elt_opcode (UNOP_SIZEOF
);
733 type
= parse_mode_or_normal_call ();
734 write_lower_upper_value (op
, type
);
738 write_exp_elt_opcode (UNOP_LENGTH
);
741 type
= PEEK_LVAL ().tsym
.type
;
743 switch (PEEK_TOKEN())
751 expect (')', "missing right parenthesis");
752 write_exp_elt_opcode (UNOP_CAST
);
753 write_exp_elt_type (type
);
754 write_exp_elt_opcode (UNOP_CAST
);
757 error ("typename in invalid context");
762 error ("invalid expression syntax at `%s'", lexptr
);
766 switch (PEEK_TOKEN ())
769 write_exp_elt_opcode (STRUCTOP_STRUCT
);
770 write_exp_string (PEEK_LVAL ().sval
);
771 write_exp_elt_opcode (STRUCTOP_STRUCT
);
776 if (PEEK_TOKEN () == TYPENAME
)
778 type
= PEEK_LVAL ().tsym
.type
;
779 write_exp_elt_opcode (UNOP_CAST
);
780 write_exp_elt_type (lookup_pointer_type (type
));
781 write_exp_elt_opcode (UNOP_CAST
);
784 write_exp_elt_opcode (UNOP_IND
);
789 case CHARACTER_STRING_LITERAL
:
790 case CHARACTER_LITERAL
:
791 case BIT_STRING_LITERAL
:
792 /* Handle string repetition. (See comment in parse_operand5.) */
794 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
795 write_exp_elt_longcst (1);
796 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
800 case INTEGER_LITERAL
:
801 case BOOLEAN_LITERAL
:
803 case GENERAL_PROCEDURE_NAME
:
805 case EMPTINESS_LITERAL
:
856 if (check_token (RECEIVE
))
859 error ("not implemented: RECEIVE expression");
861 else if (check_token (POINTER
))
864 write_exp_elt_opcode (UNOP_ADDR
);
874 /* We are supposed to be looking for a <string repetition operator>,
875 but in general we can't distinguish that from a parenthesized
876 expression. This is especially difficult if we allow the
877 string operand to be a constant expression (as requested by
878 some users), and not just a string literal.
879 Consider: LPRN expr RPRN LPRN expr RPRN
880 Is that a function call or string repetition?
881 Instead, we handle string repetition in parse_primval,
882 and build_generalized_call. */
883 switch (PEEK_TOKEN())
885 case NOT
: op
= UNOP_LOGICAL_NOT
; break;
886 case '-': op
= UNOP_NEG
; break;
894 write_exp_elt_opcode (op
);
904 switch (PEEK_TOKEN())
906 case '*': op
= BINOP_MUL
; break;
907 case '/': op
= BINOP_DIV
; break;
908 case MOD
: op
= BINOP_MOD
; break;
909 case REM
: op
= BINOP_REM
; break;
915 write_exp_elt_opcode (op
);
926 switch (PEEK_TOKEN())
928 case '+': op
= BINOP_ADD
; break;
929 case '-': op
= BINOP_SUB
; break;
930 case SLASH_SLASH
: op
= BINOP_CONCAT
; break;
936 write_exp_elt_opcode (op
);
947 if (check_token (IN
))
950 write_exp_elt_opcode (BINOP_IN
);
954 switch (PEEK_TOKEN())
956 case '>': op
= BINOP_GTR
; break;
957 case GEQ
: op
= BINOP_GEQ
; break;
958 case '<': op
= BINOP_LESS
; break;
959 case LEQ
: op
= BINOP_LEQ
; break;
960 case '=': op
= BINOP_EQUAL
; break;
961 case NOTEQUAL
: op
= BINOP_NOTEQUAL
; break;
967 write_exp_elt_opcode (op
);
979 switch (PEEK_TOKEN())
981 case LOGAND
: op
= BINOP_BITWISE_AND
; break;
982 case ANDIF
: op
= BINOP_LOGICAL_AND
; break;
988 write_exp_elt_opcode (op
);
999 switch (PEEK_TOKEN())
1001 case LOGIOR
: op
= BINOP_BITWISE_IOR
; break;
1002 case LOGXOR
: op
= BINOP_BITWISE_XOR
; break;
1003 case ORIF
: op
= BINOP_LOGICAL_OR
; break;
1009 write_exp_elt_opcode (op
);
1017 if (check_token (GDB_ASSIGNMENT
))
1020 write_exp_elt_opcode (BINOP_ASSIGN
);
1025 parse_then_alternative ()
1027 expect (THEN
, "missing 'THEN' in 'IF' expression");
1032 parse_else_alternative ()
1034 if (check_token (ELSIF
))
1035 parse_if_expression_body ();
1036 else if (check_token (ELSE
))
1039 error ("missing ELSE/ELSIF in IF expression");
1042 /* Matches: <boolean expression> <then alternative> <else alternative> */
1045 parse_if_expression_body ()
1048 parse_then_alternative ();
1049 parse_else_alternative ();
1050 write_exp_elt_opcode (TERNOP_COND
);
1054 parse_if_expression ()
1057 parse_if_expression_body ();
1058 expect (FI
, "missing 'FI' at end of conditional expression");
1061 /* An <untyped_expr> is a superset of <expr>. It also includes
1062 <conditional expressions> and untyped <tuples>, whose types
1063 are not given by their constituents. Hence, these are only
1064 allowed in certain contexts that expect a certain type.
1065 You should call convert() to fix up the <untyped_expr>. */
1068 parse_untyped_expr ()
1070 switch (PEEK_TOKEN())
1073 parse_if_expression ();
1076 error ("not implemented: CASE expression");
1078 switch (PEEK_TOKEN1())
1086 parse_untyped_expr ();
1087 expect (')', "missing ')'");
1100 terminal_buffer
[0] = TOKEN_NOT_READ
;
1101 if (PEEK_TOKEN () == TYPENAME
&& PEEK_TOKEN1 () == END_TOKEN
)
1103 write_exp_elt_opcode(OP_TYPE
);
1104 write_exp_elt_type(PEEK_LVAL ().tsym
.type
);
1105 write_exp_elt_opcode(OP_TYPE
);
1110 if (terminal_buffer
[0] != END_TOKEN
)
1112 if (comma_terminates
&& terminal_buffer
[0] == ',')
1113 lexptr
--; /* Put the comma back. */
1115 error ("Junk after end of expression.");
1121 /* Implementation of a dynamically expandable buffer for processing input
1122 characters acquired through lexptr and building a value to return in
1125 static char *tempbuf
; /* Current buffer contents */
1126 static int tempbufsize
; /* Size of allocated buffer */
1127 static int tempbufindex
; /* Current index into buffer */
1129 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1131 #define CHECKBUF(size) \
1133 if (tempbufindex + (size) >= tempbufsize) \
1135 growbuf_by_size (size); \
1139 /* Grow the static temp buffer if necessary, including allocating the first one
1143 growbuf_by_size (count
)
1148 growby
= max (count
, GROWBY_MIN_SIZE
);
1149 tempbufsize
+= growby
;
1150 if (tempbuf
== NULL
)
1152 tempbuf
= (char *) xmalloc (tempbufsize
);
1156 tempbuf
= (char *) xrealloc (tempbuf
, tempbufsize
);
1160 /* Try to consume a simple name string token. If successful, returns
1161 a pointer to a nullbyte terminated copy of the name that can be used
1162 in symbol table lookups. If not successful, returns NULL. */
1165 match_simple_name_string ()
1167 char *tokptr
= lexptr
;
1169 if (isalpha (*tokptr
) || *tokptr
== '_')
1174 } while (isalnum (*tokptr
) || (*tokptr
== '_'));
1175 yylval
.sval
.ptr
= lexptr
;
1176 yylval
.sval
.length
= tokptr
- lexptr
;
1178 result
= copy_name (yylval
.sval
);
1184 /* Start looking for a value composed of valid digits as set by the base
1185 in use. Note that '_' characters are valid anywhere, in any quantity,
1186 and are simply ignored. Since we must find at least one valid digit,
1187 or reject this token as an integer literal, we keep track of how many
1188 digits we have encountered. */
1191 decode_integer_value (base
, tokptrptr
, ivalptr
)
1196 char *tokptr
= *tokptrptr
;
1200 while (*tokptr
!= '\0')
1204 temp
= tolower (temp
);
1210 case '0': case '1': case '2': case '3': case '4':
1211 case '5': case '6': case '7': case '8': case '9':
1214 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1230 /* Found something not in domain for current base. */
1231 tokptr
--; /* Unconsume what gave us indigestion. */
1236 /* If we didn't find any digits, then we don't have a valid integer
1237 value, so reject the entire token. Otherwise, update the lexical
1238 scan pointer, and return non-zero for success. */
1246 *tokptrptr
= tokptr
;
1252 decode_integer_literal (valptr
, tokptrptr
)
1256 char *tokptr
= *tokptrptr
;
1259 int explicit_base
= 0;
1261 /* Look for an explicit base specifier, which is optional. */
1294 /* If we found an explicit base ensure that the character after the
1295 explicit base is a single quote. */
1297 if (explicit_base
&& (*tokptr
++ != '\''))
1302 /* Attempt to decode whatever follows as an integer value in the
1303 indicated base, updating the token pointer in the process and
1304 computing the value into ival. Also, if we have an explicit
1305 base, then the next character must not be a single quote, or we
1306 have a bitstring literal, so reject the entire token in this case.
1307 Otherwise, update the lexical scan pointer, and return non-zero
1310 if (!decode_integer_value (base
, &tokptr
, &ival
))
1314 else if (explicit_base
&& (*tokptr
== '\''))
1321 *tokptrptr
= tokptr
;
1326 /* If it wasn't for the fact that floating point values can contain '_'
1327 characters, we could just let strtod do all the hard work by letting it
1328 try to consume as much of the current token buffer as possible and
1329 find a legal conversion. Unfortunately we need to filter out the '_'
1330 characters before calling strtod, which we do by copying the other
1331 legal chars to a local buffer to be converted. However since we also
1332 need to keep track of where the last unconsumed character in the input
1333 buffer is, we have transfer only as many characters as may compose a
1334 legal floating point value. */
1336 static enum ch_terminal
1337 match_float_literal ()
1339 char *tokptr
= lexptr
;
1343 extern double strtod ();
1345 /* Make local buffer in which to build the string to convert. This is
1346 required because underscores are valid in chill floating point numbers
1347 but not in the string passed to strtod to convert. The string will be
1348 no longer than our input string. */
1350 copy
= buf
= (char *) alloca (strlen (tokptr
) + 1);
1352 /* Transfer all leading digits to the conversion buffer, discarding any
1355 while (isdigit (*tokptr
) || *tokptr
== '_')
1364 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1365 of whether we found any leading digits, and we simply accept it and
1366 continue on to look for the fractional part and/or exponent. One of
1367 [eEdD] is legal only if we have seen digits, and means that there
1368 is no fractional part. If we find neither of these, then this is
1369 not a floating point number, so return failure. */
1374 /* Accept and then look for fractional part and/or exponent. */
1387 goto collect_exponent
;
1395 /* We found a '.', copy any fractional digits to the conversion buffer, up
1396 to the first nondigit, non-underscore character. */
1398 while (isdigit (*tokptr
) || *tokptr
== '_')
1407 /* Look for an exponent, which must start with one of [eEdD]. If none
1408 is found, jump directly to trying to convert what we have collected
1425 /* Accept an optional '-' or '+' following one of [eEdD]. */
1428 if (*tokptr
== '+' || *tokptr
== '-')
1430 *copy
++ = *tokptr
++;
1433 /* Now copy an exponent into the conversion buffer. Note that at the
1434 moment underscores are *not* allowed in exponents. */
1436 while (isdigit (*tokptr
))
1438 *copy
++ = *tokptr
++;
1441 /* If we transfered any chars to the conversion buffer, try to interpret its
1442 contents as a floating point value. If any characters remain, then we
1443 must not have a valid floating point string. */
1449 dval
= strtod (buf
, ©
);
1454 return (FLOAT_LITERAL
);
1460 /* Recognize a string literal. A string literal is a sequence
1461 of characters enclosed in matching single or double quotes, except that
1462 a single character inside single quotes is a character literal, which
1463 we reject as a string literal. To embed the terminator character inside
1464 a string, it is simply doubled (I.E. "this""is""one""string") */
1466 static enum ch_terminal
1467 match_string_literal ()
1469 char *tokptr
= lexptr
;
1473 for (tempbufindex
= 0, tokptr
++; *tokptr
!= '\0'; tokptr
++)
1479 /* skip possible whitespaces */
1480 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1488 else if (*tokptr
!= ',')
1489 error ("Invalid control sequence");
1491 /* skip possible whitespaces */
1492 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1494 if (!decode_integer_literal (&ival
, &tokptr
))
1495 error ("Invalid control sequence");
1498 else if (*tokptr
== *lexptr
)
1500 if (*(tokptr
+ 1) == *lexptr
)
1509 else if (*tokptr
== '^')
1511 if (*(tokptr
+ 1) == '(')
1515 if (!decode_integer_literal (&ival
, &tokptr
))
1516 error ("Invalid control sequence");
1519 else if (*(tokptr
+ 1) == '^')
1522 error ("Invalid control sequence");
1526 tempbuf
[tempbufindex
++] = ival
;
1529 error ("Invalid control sequence");
1531 if (*tokptr
== '\0' /* no terminator */
1532 || (tempbufindex
== 1 && *tokptr
== '\'')) /* char literal */
1538 tempbuf
[tempbufindex
] = '\0';
1539 yylval
.sval
.ptr
= tempbuf
;
1540 yylval
.sval
.length
= tempbufindex
;
1542 return (CHARACTER_STRING_LITERAL
);
1546 /* Recognize a character literal. A character literal is single character
1547 or a control sequence, enclosed in single quotes. A control sequence
1548 is a comma separated list of one or more integer literals, enclosed
1549 in parenthesis and introduced with a circumflex character.
1551 EX: 'a' '^(7)' '^(7,8)'
1553 As a GNU chill extension, the syntax C'xx' is also recognized as a
1554 character literal, where xx is a hex value for the character.
1556 Note that more than a single character, enclosed in single quotes, is
1559 Returns CHARACTER_LITERAL if a match is found.
1562 static enum ch_terminal
1563 match_character_literal ()
1565 char *tokptr
= lexptr
;
1568 if ((*tokptr
== 'c' || *tokptr
== 'C') && (*(tokptr
+ 1) == '\''))
1570 /* We have a GNU chill extension form, so skip the leading "C'",
1571 decode the hex value, and then ensure that we have a trailing
1572 single quote character. */
1574 if (!decode_integer_value (16, &tokptr
, &ival
) || (*tokptr
!= '\''))
1580 else if (*tokptr
== '\'')
1584 /* Determine which form we have, either a control sequence or the
1585 single character form. */
1589 if (*(tokptr
+ 1) == '(')
1591 /* Match and decode a control sequence. Return zero if we don't
1592 find a valid integer literal, or if the next unconsumed character
1593 after the integer literal is not the trailing ')'. */
1595 if (!decode_integer_literal (&ival
, &tokptr
) || (*tokptr
++ != ')'))
1600 else if (*(tokptr
+ 1) == '^')
1607 error ("Invalid control sequence");
1609 else if (*tokptr
== '\'')
1611 /* this must be duplicated */
1620 /* The trailing quote has not yet been consumed. If we don't find
1621 it, then we have no match. */
1623 if (*tokptr
++ != '\'')
1630 /* Not a character literal. */
1633 yylval
.typed_val
.val
= ival
;
1634 yylval
.typed_val
.type
= builtin_type_chill_char
;
1636 return (CHARACTER_LITERAL
);
1639 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1640 Note that according to 5.2.4.2, a single "_" is also a valid integer
1641 literal, however GNU-chill requires there to be at least one "digit"
1642 in any integer literal. */
1644 static enum ch_terminal
1645 match_integer_literal ()
1647 char *tokptr
= lexptr
;
1650 if (!decode_integer_literal (&ival
, &tokptr
))
1656 yylval
.typed_val
.val
= ival
;
1657 #if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1658 if (ival
> (LONGEST
)2147483647U || ival
< -(LONGEST
)2147483648U)
1659 yylval
.typed_val
.type
= builtin_type_long_long
;
1662 yylval
.typed_val
.type
= builtin_type_int
;
1664 return (INTEGER_LITERAL
);
1668 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1669 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1670 literal, however GNU-chill requires there to be at least one "digit"
1671 in any bit-string literal. */
1673 static enum ch_terminal
1674 match_bitstring_literal ()
1676 register char *tokptr
= lexptr
;
1686 /* Look for the required explicit base specifier. */
1707 /* Ensure that the character after the explicit base is a single quote. */
1709 if (*tokptr
++ != '\'')
1714 while (*tokptr
!= '\0' && *tokptr
!= '\'')
1717 if (isupper (digit
))
1718 digit
= tolower (digit
);
1724 case '0': case '1': case '2': case '3': case '4':
1725 case '5': case '6': case '7': case '8': case '9':
1728 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1733 /* this is not a bitstring literal, probably an integer */
1736 if (digit
>= 1 << bits_per_char
)
1738 /* Found something not in domain for current base. */
1739 error ("Too-large digit in bitstring or integer.");
1743 /* Extract bits from digit, packing them into the bitstring byte. */
1744 int k
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? bits_per_char
- 1 : 0;
1745 for (; TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
>= 0 : k
< bits_per_char
;
1746 TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
-- : k
++)
1749 if (digit
& (1 << k
))
1751 tempbuf
[tempbufindex
] |=
1752 (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1753 ? (1 << (HOST_CHAR_BIT
- 1 - bitoffset
))
1757 if (bitoffset
== HOST_CHAR_BIT
)
1762 tempbuf
[tempbufindex
] = 0;
1768 /* Verify that we consumed everything up to the trailing single quote,
1769 and that we found some bits (IE not just underbars). */
1771 if (*tokptr
++ != '\'')
1777 yylval
.sval
.ptr
= tempbuf
;
1778 yylval
.sval
.length
= bitcount
;
1780 return (BIT_STRING_LITERAL
);
1790 static const struct token idtokentab
[] =
1793 { "length", LENGTH
},
1804 { "max", MAX_TOKEN
},
1805 { "min", MIN_TOKEN
},
1814 { "addr", ADDR_TOKEN
},
1815 { "null", EMPTINESS_LITERAL
}
1818 static const struct token tokentab2
[] =
1820 { ":=", GDB_ASSIGNMENT
},
1821 { "//", SLASH_SLASH
},
1828 /* Read one token, getting characters through lexptr. */
1829 /* This is where we will check to make sure that the language and the
1830 operators used are compatible. */
1832 static enum ch_terminal
1836 enum ch_terminal token
;
1840 /* Skip over any leading whitespace. */
1841 while (isspace (*lexptr
))
1845 /* Look for special single character cases which can't be the first
1846 character of some other multicharacter token. */
1863 /* Look for characters which start a particular kind of multicharacter
1864 token, such as a character literal, register name, convenience
1865 variable name, string literal, etc. */
1870 /* First try to match a string literal, which is any
1871 sequence of characters enclosed in matching single or double
1872 quotes, except that a single character inside single quotes
1873 is a character literal, so we have to catch that case also. */
1874 token
= match_string_literal ();
1879 if (*lexptr
== '\'')
1881 token
= match_character_literal ();
1890 token
= match_character_literal ();
1897 yylval
.sval
.ptr
= lexptr
;
1900 } while (isalnum (*lexptr
) || *lexptr
== '_' || *lexptr
== '$');
1901 yylval
.sval
.length
= lexptr
- yylval
.sval
.ptr
;
1902 write_dollar_variable (yylval
.sval
);
1903 return GDB_VARIABLE
;
1906 /* See if it is a special token of length 2. */
1907 for (i
= 0; i
< sizeof (tokentab2
) / sizeof (tokentab2
[0]); i
++)
1909 if (STREQN (lexptr
, tokentab2
[i
].operator, 2))
1912 return (tokentab2
[i
].token
);
1915 /* Look for single character cases which which could be the first
1916 character of some other multicharacter token, but aren't, or we
1917 would already have found it. */
1927 /* Look for a float literal before looking for an integer literal, so
1928 we match as much of the input stream as possible. */
1929 token
= match_float_literal ();
1934 token
= match_bitstring_literal ();
1939 token
= match_integer_literal ();
1945 /* Try to match a simple name string, and if a match is found, then
1946 further classify what sort of name it is and return an appropriate
1947 token. Note that attempting to match a simple name string consumes
1948 the token from lexptr, so we can't back out if we later find that
1949 we can't classify what sort of name it is. */
1951 inputname
= match_simple_name_string ();
1953 if (inputname
!= NULL
)
1955 char *simplename
= (char*) alloca (strlen (inputname
) + 1);
1957 char *dptr
= simplename
, *sptr
= inputname
;
1958 for (; *sptr
; sptr
++)
1959 *dptr
++ = isupper (*sptr
) ? tolower(*sptr
) : *sptr
;
1962 /* See if it is a reserved identifier. */
1963 for (i
= 0; i
< sizeof (idtokentab
) / sizeof (idtokentab
[0]); i
++)
1965 if (STREQ (simplename
, idtokentab
[i
].operator))
1967 return (idtokentab
[i
].token
);
1971 /* Look for other special tokens. */
1972 if (STREQ (simplename
, "true"))
1975 return (BOOLEAN_LITERAL
);
1977 if (STREQ (simplename
, "false"))
1980 return (BOOLEAN_LITERAL
);
1983 sym
= lookup_symbol (inputname
, expression_context_block
,
1984 VAR_NAMESPACE
, (int *) NULL
,
1985 (struct symtab
**) NULL
);
1986 if (sym
== NULL
&& strcmp (inputname
, simplename
) != 0)
1988 sym
= lookup_symbol (simplename
, expression_context_block
,
1989 VAR_NAMESPACE
, (int *) NULL
,
1990 (struct symtab
**) NULL
);
1994 yylval
.ssym
.stoken
.ptr
= NULL
;
1995 yylval
.ssym
.stoken
.length
= 0;
1996 yylval
.ssym
.sym
= sym
;
1997 yylval
.ssym
.is_a_field_of_this
= 0; /* FIXME, C++'ism */
1998 switch (SYMBOL_CLASS (sym
))
2001 /* Found a procedure name. */
2002 return (GENERAL_PROCEDURE_NAME
);
2004 /* Found a global or local static variable. */
2005 return (LOCATION_NAME
);
2010 case LOC_REGPARM_ADDR
:
2014 case LOC_BASEREG_ARG
:
2015 if (innermost_block
== NULL
2016 || contained_in (block_found
, innermost_block
))
2018 innermost_block
= block_found
;
2020 return (LOCATION_NAME
);
2024 return (LOCATION_NAME
);
2027 yylval
.tsym
.type
= SYMBOL_TYPE (sym
);
2030 case LOC_CONST_BYTES
:
2031 case LOC_OPTIMIZED_OUT
:
2032 error ("Symbol \"%s\" names no location.", inputname
);
2034 case LOC_UNRESOLVED
:
2035 error ("unhandled SYMBOL_CLASS in ch_lex()");
2039 else if (!have_full_symbols () && !have_partial_symbols ())
2041 error ("No symbol table is loaded. Use the \"file\" command.");
2045 error ("No symbol \"%s\" in current context.", inputname
);
2049 /* Catch single character tokens which are not part of some
2054 case '.': /* Not float for example. */
2056 while (isspace (*lexptr
)) lexptr
++;
2057 inputname
= match_simple_name_string ();
2063 return (ILLEGAL_TOKEN
);
2067 write_lower_upper_value (opcode
, type
)
2068 enum exp_opcode opcode
; /* Either UNOP_LOWER or UNOP_UPPER */
2072 write_exp_elt_opcode (opcode
);
2075 extern LONGEST
type_lower_upper ();
2076 struct type
*result_type
;
2077 LONGEST val
= type_lower_upper (opcode
, type
, &result_type
);
2078 write_exp_elt_opcode (OP_LONG
);
2079 write_exp_elt_type (result_type
);
2080 write_exp_elt_longcst (val
);
2081 write_exp_elt_opcode (OP_LONG
);