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 ();
141 static void calculate_array_length (struct type
*);
143 #define MAX_LOOK_AHEAD 2
144 static enum ch_terminal terminal_buffer
[MAX_LOOK_AHEAD
+1] = {
145 TOKEN_NOT_READ
, TOKEN_NOT_READ
, TOKEN_NOT_READ
};
146 static YYSTYPE yylval
;
147 static YYSTYPE val_buffer
[MAX_LOOK_AHEAD
+1];
149 /*int current_token, lookahead_token;*/
154 static enum ch_terminal
157 if (terminal_buffer
[0] == TOKEN_NOT_READ
)
159 terminal_buffer
[0] = ch_lex ();
160 val_buffer
[0] = yylval
;
162 return terminal_buffer
[0];
164 #define PEEK_LVAL() val_buffer[0]
165 #define PEEK_TOKEN1() peek_token_(1)
166 #define PEEK_TOKEN2() peek_token_(2)
167 static enum ch_terminal
171 if (i
> MAX_LOOK_AHEAD
)
172 fatal ("internal error - too much lookahead");
173 if (terminal_buffer
[i
] == TOKEN_NOT_READ
)
175 terminal_buffer
[i
] = ch_lex ();
176 val_buffer
[i
] = yylval
;
178 return terminal_buffer
[i
];
184 pushback_token (code
, node
)
185 enum ch_terminal code
;
189 if (terminal_buffer
[MAX_LOOK_AHEAD
] != TOKEN_NOT_READ
)
190 fatal ("internal error - cannot pushback token");
191 for (i
= MAX_LOOK_AHEAD
; i
> 0; i
--)
193 terminal_buffer
[i
] = terminal_buffer
[i
- 1];
194 val_buffer
[i
] = val_buffer
[i
- 1];
196 terminal_buffer
[0] = code
;
197 val_buffer
[0] = node
;
206 for (i
= 0; i
< MAX_LOOK_AHEAD
; i
++)
208 terminal_buffer
[i
] = terminal_buffer
[i
+1];
209 val_buffer
[i
] = val_buffer
[i
+1];
211 terminal_buffer
[MAX_LOOK_AHEAD
] = TOKEN_NOT_READ
;
213 #define FORWARD_TOKEN() forward_token_()
215 /* Skip the next token.
216 if it isn't TOKEN, the parser is broken. */
220 enum ch_terminal token
;
222 if (PEEK_TOKEN() != token
)
225 sprintf (buf
, "internal parser error - expected token %d", (int)token
);
233 enum ch_terminal token
;
235 if (PEEK_TOKEN() != token
)
241 /* return 0 if expected token was not found,
245 expect(token
, message
)
246 enum ch_terminal token
;
249 if (PEEK_TOKEN() != token
)
253 else if (token
< 256)
254 error ("syntax error - expected a '%c' here \"%s\"", token
, lexptr
);
256 error ("syntax error");
266 parse_opt_name_string (allow_all
)
267 int allow_all
; /* 1 if ALL is allowed as a postfix */
269 int token
= PEEK_TOKEN();
273 if (token
== ALL
&& allow_all
)
284 token
= PEEK_TOKEN();
288 token
= PEEK_TOKEN();
289 if (token
== ALL
&& allow_all
)
290 return get_identifier3(IDENTIFIER_POINTER (name
), "!", "*");
294 error ("'%s!' is not followed by an identifier",
295 IDENTIFIER_POINTER (name
));
298 name
= get_identifier3(IDENTIFIER_POINTER(name
),
299 "!", IDENTIFIER_POINTER(PEEK_LVAL()));
304 parse_simple_name_string ()
306 int token
= PEEK_TOKEN();
310 error ("expected a name here");
311 return error_mark_node
;
321 tree name
= parse_opt_name_string (0);
325 error ("expected a name string here");
326 return error_mark_node
;
329 /* Matches: <name_string>
330 Returns if pass 1: the identifier.
331 Returns if pass 2: a decl or value for identifier. */
336 tree name
= parse_name_string ();
337 if (pass
== 1 || ignoring
)
341 tree decl
= lookup_name (name
);
342 if (decl
== NULL_TREE
)
344 error ("`%s' undeclared", IDENTIFIER_POINTER (name
));
345 return error_mark_node
;
347 else if (TREE_CODE (TREE_TYPE (decl
)) == ERROR_MARK
)
348 return error_mark_node
;
349 else if (TREE_CODE (decl
) == CONST_DECL
)
350 return DECL_INITIAL (decl
);
351 else if (TREE_CODE (TREE_TYPE (decl
)) == REFERENCE_TYPE
)
352 return convert_from_reference (decl
);
361 pushback_paren_expr (expr
)
364 if (pass
== 1 && !ignoring
)
365 expr
= build1 (PAREN_EXPR
, NULL_TREE
, expr
);
366 pushback_token (EXPR
, expr
);
370 /* Matches: <case label> */
375 if (check_token (ELSE
))
376 error ("ELSE in tuples labels not implemented");
377 /* Does not handle the case of a mode name. FIXME */
379 if (check_token (':'))
382 write_exp_elt_opcode (BINOP_RANGE
);
387 parse_opt_untyped_expr ()
389 switch (PEEK_TOKEN ())
396 parse_untyped_expr ();
410 /* Parse NAME '(' MODENAME ')'. */
418 if (PEEK_TOKEN () != TYPENAME
)
419 error ("expect MODENAME here `%s'", lexptr
);
420 type
= PEEK_LVAL().tsym
.type
;
427 parse_mode_or_normal_call ()
432 if (PEEK_TOKEN () == TYPENAME
)
434 type
= PEEK_LVAL().tsym
.type
;
446 /* Parse something that looks like a function call.
447 Assume we have parsed the function, and are at the '('. */
454 /* This is to save the value of arglist_len
455 being accumulated for each dimension. */
457 if (parse_opt_untyped_expr ())
459 int tok
= PEEK_TOKEN ();
461 if (tok
== UP
|| tok
== ':')
465 expect (')', "expected ')' to terminate slice");
467 write_exp_elt_opcode (tok
== UP
? TERNOP_SLICE_COUNT
471 while (check_token (','))
473 parse_untyped_expr ();
480 arg_count
= end_arglist ();
481 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
482 write_exp_elt_longcst (arg_count
);
483 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
487 parse_named_record_element ()
491 label
= PEEK_LVAL ().sval
;
492 expect (FIELD_NAME
, "expected a field name here `%s'", lexptr
);
493 if (check_token (','))
494 parse_named_record_element ();
495 else if (check_token (':'))
498 error ("syntax error near `%s' in named record tuple element", lexptr
);
499 write_exp_elt_opcode (OP_LABELED
);
500 write_exp_string (label
);
501 write_exp_elt_opcode (OP_LABELED
);
504 /* Returns one or nore TREE_LIST nodes, in reverse order. */
507 parse_tuple_element ()
509 if (PEEK_TOKEN () == FIELD_NAME
)
511 /* Parse a labelled structure tuple. */
512 parse_named_record_element ();
516 if (check_token ('('))
518 if (check_token ('*'))
520 expect (')', "missing ')' after '*' case label list");
521 error ("(*) not implemented in case label list");
526 while (check_token (','))
529 write_exp_elt_opcode (BINOP_COMMA
);
535 parse_untyped_expr ();
536 if (check_token (':'))
538 /* A powerset range or a labeled Array. */
539 parse_untyped_expr ();
540 write_exp_elt_opcode (BINOP_RANGE
);
544 /* Matches: a COMMA-separated list of tuple elements.
545 Returns a list (of TREE_LIST nodes). */
547 parse_opt_element_list ()
550 if (PEEK_TOKEN () == ']')
554 parse_tuple_element ();
556 if (PEEK_TOKEN () == ']')
558 if (!check_token (','))
559 error ("bad syntax in tuple");
563 /* Parses: '[' elements ']'
564 If modename is non-NULL it prefixed the tuple. */
572 parse_opt_element_list ();
573 expect (']', "missing ']' after tuple");
574 write_exp_elt_opcode (OP_ARRAY
);
575 write_exp_elt_longcst ((LONGEST
) 0);
576 write_exp_elt_longcst ((LONGEST
) end_arglist () - 1);
577 write_exp_elt_opcode (OP_ARRAY
);
580 struct type
*type
= check_typedef (mode
);
581 if (TYPE_CODE (type
) != TYPE_CODE_ARRAY
582 && TYPE_CODE (type
) != TYPE_CODE_STRUCT
583 && TYPE_CODE (type
) != TYPE_CODE_SET
)
584 error ("invalid tuple mode");
585 write_exp_elt_opcode (UNOP_CAST
);
586 write_exp_elt_type (mode
);
587 write_exp_elt_opcode (UNOP_CAST
);
597 switch (PEEK_TOKEN ())
599 case INTEGER_LITERAL
:
600 case CHARACTER_LITERAL
:
601 write_exp_elt_opcode (OP_LONG
);
602 write_exp_elt_type (PEEK_LVAL ().typed_val
.type
);
603 write_exp_elt_longcst (PEEK_LVAL ().typed_val
.val
);
604 write_exp_elt_opcode (OP_LONG
);
607 case BOOLEAN_LITERAL
:
608 write_exp_elt_opcode (OP_BOOL
);
609 write_exp_elt_longcst ((LONGEST
) PEEK_LVAL ().ulval
);
610 write_exp_elt_opcode (OP_BOOL
);
614 write_exp_elt_opcode (OP_DOUBLE
);
615 write_exp_elt_type (builtin_type_double
);
616 write_exp_elt_dblcst (PEEK_LVAL ().dval
);
617 write_exp_elt_opcode (OP_DOUBLE
);
620 case EMPTINESS_LITERAL
:
621 write_exp_elt_opcode (OP_LONG
);
622 write_exp_elt_type (lookup_pointer_type (builtin_type_void
));
623 write_exp_elt_longcst (0);
624 write_exp_elt_opcode (OP_LONG
);
627 case CHARACTER_STRING_LITERAL
:
628 write_exp_elt_opcode (OP_STRING
);
629 write_exp_string (PEEK_LVAL ().sval
);
630 write_exp_elt_opcode (OP_STRING
);
633 case BIT_STRING_LITERAL
:
634 write_exp_elt_opcode (OP_BITSTRING
);
635 write_exp_bitstring (PEEK_LVAL ().sval
);
636 write_exp_elt_opcode (OP_BITSTRING
);
641 /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
642 which casts to an artificial array. */
645 if (PEEK_TOKEN () != TYPENAME
)
646 error ("missing MODENAME after ARRAY()");
647 type
= PEEK_LVAL().tsym
.type
;
651 expect (')', "missing right parenthesis");
652 type
= create_array_type ((struct type
*) NULL
, type
,
653 create_range_type ((struct type
*) NULL
,
654 builtin_type_int
, 0, 0));
655 TYPE_ARRAY_UPPER_BOUND_TYPE(type
) = BOUND_CANNOT_BE_DETERMINED
;
656 write_exp_elt_opcode (UNOP_CAST
);
657 write_exp_elt_type (type
);
658 write_exp_elt_opcode (UNOP_CAST
);
670 expect (')', "missing right parenthesis");
675 case GENERAL_PROCEDURE_NAME
:
680 /* FIXME: look at calculate_array_length */
681 type
= PEEK_LVAL().ssym
.sym
->type
;
682 if (type
&& TYPE_CODE (type
) == TYPE_CODE_ARRAY
&&
683 TYPE_LENGTH (type
) == 0)
684 calculate_array_length (type
);
685 write_exp_elt_opcode (OP_VAR_VALUE
);
686 write_exp_elt_block (NULL
);
687 write_exp_elt_sym (PEEK_LVAL ().ssym
.sym
);
688 write_exp_elt_opcode (OP_VAR_VALUE
);
692 case GDB_VARIABLE
: /* gdb specific */
697 write_exp_elt_opcode (UNOP_CAST
);
698 write_exp_elt_type (builtin_type_int
);
699 write_exp_elt_opcode (UNOP_CAST
);
703 write_exp_elt_opcode (UNOP_CARD
);
707 write_exp_elt_opcode (UNOP_CHMAX
);
711 write_exp_elt_opcode (UNOP_CHMIN
);
713 case PRED
: op_name
= "PRED"; goto unimplemented_unary_builtin
;
714 case SUCC
: op_name
= "SUCC"; goto unimplemented_unary_builtin
;
715 case ABS
: op_name
= "ABS"; goto unimplemented_unary_builtin
;
716 unimplemented_unary_builtin
:
718 error ("not implemented: %s builtin function", op_name
);
722 write_exp_elt_opcode (UNOP_ADDR
);
725 type
= parse_mode_or_normal_call ();
727 { write_exp_elt_opcode (OP_LONG
);
728 write_exp_elt_type (builtin_type_int
);
729 CHECK_TYPEDEF (type
);
730 write_exp_elt_longcst ((LONGEST
) TYPE_LENGTH (type
));
731 write_exp_elt_opcode (OP_LONG
);
734 write_exp_elt_opcode (UNOP_SIZEOF
);
743 type
= parse_mode_or_normal_call ();
744 write_lower_upper_value (op
, type
);
748 write_exp_elt_opcode (UNOP_LENGTH
);
751 type
= PEEK_LVAL ().tsym
.type
;
753 switch (PEEK_TOKEN())
761 expect (')', "missing right parenthesis");
762 write_exp_elt_opcode (UNOP_CAST
);
763 write_exp_elt_type (type
);
764 write_exp_elt_opcode (UNOP_CAST
);
767 error ("typename in invalid context");
772 error ("invalid expression syntax at `%s'", lexptr
);
776 switch (PEEK_TOKEN ())
779 write_exp_elt_opcode (STRUCTOP_STRUCT
);
780 write_exp_string (PEEK_LVAL ().sval
);
781 write_exp_elt_opcode (STRUCTOP_STRUCT
);
786 if (PEEK_TOKEN () == TYPENAME
)
788 type
= PEEK_LVAL ().tsym
.type
;
789 write_exp_elt_opcode (UNOP_CAST
);
790 write_exp_elt_type (lookup_pointer_type (type
));
791 write_exp_elt_opcode (UNOP_CAST
);
794 write_exp_elt_opcode (UNOP_IND
);
799 case CHARACTER_STRING_LITERAL
:
800 case CHARACTER_LITERAL
:
801 case BIT_STRING_LITERAL
:
802 /* Handle string repetition. (See comment in parse_operand5.) */
804 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
805 write_exp_elt_longcst (1);
806 write_exp_elt_opcode (MULTI_SUBSCRIPT
);
810 case INTEGER_LITERAL
:
811 case BOOLEAN_LITERAL
:
813 case GENERAL_PROCEDURE_NAME
:
815 case EMPTINESS_LITERAL
:
866 if (check_token (RECEIVE
))
869 error ("not implemented: RECEIVE expression");
871 else if (check_token (POINTER
))
874 write_exp_elt_opcode (UNOP_ADDR
);
884 /* We are supposed to be looking for a <string repetition operator>,
885 but in general we can't distinguish that from a parenthesized
886 expression. This is especially difficult if we allow the
887 string operand to be a constant expression (as requested by
888 some users), and not just a string literal.
889 Consider: LPRN expr RPRN LPRN expr RPRN
890 Is that a function call or string repetition?
891 Instead, we handle string repetition in parse_primval,
892 and build_generalized_call. */
893 switch (PEEK_TOKEN())
895 case NOT
: op
= UNOP_LOGICAL_NOT
; break;
896 case '-': op
= UNOP_NEG
; break;
904 write_exp_elt_opcode (op
);
914 switch (PEEK_TOKEN())
916 case '*': op
= BINOP_MUL
; break;
917 case '/': op
= BINOP_DIV
; break;
918 case MOD
: op
= BINOP_MOD
; break;
919 case REM
: op
= BINOP_REM
; break;
925 write_exp_elt_opcode (op
);
936 switch (PEEK_TOKEN())
938 case '+': op
= BINOP_ADD
; break;
939 case '-': op
= BINOP_SUB
; break;
940 case SLASH_SLASH
: op
= BINOP_CONCAT
; break;
946 write_exp_elt_opcode (op
);
957 if (check_token (IN
))
960 write_exp_elt_opcode (BINOP_IN
);
964 switch (PEEK_TOKEN())
966 case '>': op
= BINOP_GTR
; break;
967 case GEQ
: op
= BINOP_GEQ
; break;
968 case '<': op
= BINOP_LESS
; break;
969 case LEQ
: op
= BINOP_LEQ
; break;
970 case '=': op
= BINOP_EQUAL
; break;
971 case NOTEQUAL
: op
= BINOP_NOTEQUAL
; break;
977 write_exp_elt_opcode (op
);
989 switch (PEEK_TOKEN())
991 case LOGAND
: op
= BINOP_BITWISE_AND
; break;
992 case ANDIF
: op
= BINOP_LOGICAL_AND
; break;
998 write_exp_elt_opcode (op
);
1009 switch (PEEK_TOKEN())
1011 case LOGIOR
: op
= BINOP_BITWISE_IOR
; break;
1012 case LOGXOR
: op
= BINOP_BITWISE_XOR
; break;
1013 case ORIF
: op
= BINOP_LOGICAL_OR
; break;
1019 write_exp_elt_opcode (op
);
1027 if (check_token (GDB_ASSIGNMENT
))
1030 write_exp_elt_opcode (BINOP_ASSIGN
);
1035 parse_then_alternative ()
1037 expect (THEN
, "missing 'THEN' in 'IF' expression");
1042 parse_else_alternative ()
1044 if (check_token (ELSIF
))
1045 parse_if_expression_body ();
1046 else if (check_token (ELSE
))
1049 error ("missing ELSE/ELSIF in IF expression");
1052 /* Matches: <boolean expression> <then alternative> <else alternative> */
1055 parse_if_expression_body ()
1058 parse_then_alternative ();
1059 parse_else_alternative ();
1060 write_exp_elt_opcode (TERNOP_COND
);
1064 parse_if_expression ()
1067 parse_if_expression_body ();
1068 expect (FI
, "missing 'FI' at end of conditional expression");
1071 /* An <untyped_expr> is a superset of <expr>. It also includes
1072 <conditional expressions> and untyped <tuples>, whose types
1073 are not given by their constituents. Hence, these are only
1074 allowed in certain contexts that expect a certain type.
1075 You should call convert() to fix up the <untyped_expr>. */
1078 parse_untyped_expr ()
1080 switch (PEEK_TOKEN())
1083 parse_if_expression ();
1086 error ("not implemented: CASE expression");
1088 switch (PEEK_TOKEN1())
1096 parse_untyped_expr ();
1097 expect (')', "missing ')'");
1110 terminal_buffer
[0] = TOKEN_NOT_READ
;
1111 if (PEEK_TOKEN () == TYPENAME
&& PEEK_TOKEN1 () == END_TOKEN
)
1113 write_exp_elt_opcode(OP_TYPE
);
1114 write_exp_elt_type(PEEK_LVAL ().tsym
.type
);
1115 write_exp_elt_opcode(OP_TYPE
);
1120 if (terminal_buffer
[0] != END_TOKEN
)
1122 if (comma_terminates
&& terminal_buffer
[0] == ',')
1123 lexptr
--; /* Put the comma back. */
1125 error ("Junk after end of expression.");
1131 /* Implementation of a dynamically expandable buffer for processing input
1132 characters acquired through lexptr and building a value to return in
1135 static char *tempbuf
; /* Current buffer contents */
1136 static int tempbufsize
; /* Size of allocated buffer */
1137 static int tempbufindex
; /* Current index into buffer */
1139 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1141 #define CHECKBUF(size) \
1143 if (tempbufindex + (size) >= tempbufsize) \
1145 growbuf_by_size (size); \
1149 /* Grow the static temp buffer if necessary, including allocating the first one
1153 growbuf_by_size (count
)
1158 growby
= max (count
, GROWBY_MIN_SIZE
);
1159 tempbufsize
+= growby
;
1160 if (tempbuf
== NULL
)
1162 tempbuf
= (char *) xmalloc (tempbufsize
);
1166 tempbuf
= (char *) xrealloc (tempbuf
, tempbufsize
);
1170 /* Try to consume a simple name string token. If successful, returns
1171 a pointer to a nullbyte terminated copy of the name that can be used
1172 in symbol table lookups. If not successful, returns NULL. */
1175 match_simple_name_string ()
1177 char *tokptr
= lexptr
;
1179 if (isalpha (*tokptr
) || *tokptr
== '_')
1184 } while (isalnum (*tokptr
) || (*tokptr
== '_'));
1185 yylval
.sval
.ptr
= lexptr
;
1186 yylval
.sval
.length
= tokptr
- lexptr
;
1188 result
= copy_name (yylval
.sval
);
1194 /* Start looking for a value composed of valid digits as set by the base
1195 in use. Note that '_' characters are valid anywhere, in any quantity,
1196 and are simply ignored. Since we must find at least one valid digit,
1197 or reject this token as an integer literal, we keep track of how many
1198 digits we have encountered. */
1201 decode_integer_value (base
, tokptrptr
, ivalptr
)
1206 char *tokptr
= *tokptrptr
;
1210 while (*tokptr
!= '\0')
1214 temp
= tolower (temp
);
1220 case '0': case '1': case '2': case '3': case '4':
1221 case '5': case '6': case '7': case '8': case '9':
1224 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1240 /* Found something not in domain for current base. */
1241 tokptr
--; /* Unconsume what gave us indigestion. */
1246 /* If we didn't find any digits, then we don't have a valid integer
1247 value, so reject the entire token. Otherwise, update the lexical
1248 scan pointer, and return non-zero for success. */
1256 *tokptrptr
= tokptr
;
1262 decode_integer_literal (valptr
, tokptrptr
)
1266 char *tokptr
= *tokptrptr
;
1269 int explicit_base
= 0;
1271 /* Look for an explicit base specifier, which is optional. */
1304 /* If we found an explicit base ensure that the character after the
1305 explicit base is a single quote. */
1307 if (explicit_base
&& (*tokptr
++ != '\''))
1312 /* Attempt to decode whatever follows as an integer value in the
1313 indicated base, updating the token pointer in the process and
1314 computing the value into ival. Also, if we have an explicit
1315 base, then the next character must not be a single quote, or we
1316 have a bitstring literal, so reject the entire token in this case.
1317 Otherwise, update the lexical scan pointer, and return non-zero
1320 if (!decode_integer_value (base
, &tokptr
, &ival
))
1324 else if (explicit_base
&& (*tokptr
== '\''))
1331 *tokptrptr
= tokptr
;
1336 /* If it wasn't for the fact that floating point values can contain '_'
1337 characters, we could just let strtod do all the hard work by letting it
1338 try to consume as much of the current token buffer as possible and
1339 find a legal conversion. Unfortunately we need to filter out the '_'
1340 characters before calling strtod, which we do by copying the other
1341 legal chars to a local buffer to be converted. However since we also
1342 need to keep track of where the last unconsumed character in the input
1343 buffer is, we have transfer only as many characters as may compose a
1344 legal floating point value. */
1346 static enum ch_terminal
1347 match_float_literal ()
1349 char *tokptr
= lexptr
;
1353 extern double strtod ();
1355 /* Make local buffer in which to build the string to convert. This is
1356 required because underscores are valid in chill floating point numbers
1357 but not in the string passed to strtod to convert. The string will be
1358 no longer than our input string. */
1360 copy
= buf
= (char *) alloca (strlen (tokptr
) + 1);
1362 /* Transfer all leading digits to the conversion buffer, discarding any
1365 while (isdigit (*tokptr
) || *tokptr
== '_')
1374 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1375 of whether we found any leading digits, and we simply accept it and
1376 continue on to look for the fractional part and/or exponent. One of
1377 [eEdD] is legal only if we have seen digits, and means that there
1378 is no fractional part. If we find neither of these, then this is
1379 not a floating point number, so return failure. */
1384 /* Accept and then look for fractional part and/or exponent. */
1397 goto collect_exponent
;
1405 /* We found a '.', copy any fractional digits to the conversion buffer, up
1406 to the first nondigit, non-underscore character. */
1408 while (isdigit (*tokptr
) || *tokptr
== '_')
1417 /* Look for an exponent, which must start with one of [eEdD]. If none
1418 is found, jump directly to trying to convert what we have collected
1435 /* Accept an optional '-' or '+' following one of [eEdD]. */
1438 if (*tokptr
== '+' || *tokptr
== '-')
1440 *copy
++ = *tokptr
++;
1443 /* Now copy an exponent into the conversion buffer. Note that at the
1444 moment underscores are *not* allowed in exponents. */
1446 while (isdigit (*tokptr
))
1448 *copy
++ = *tokptr
++;
1451 /* If we transfered any chars to the conversion buffer, try to interpret its
1452 contents as a floating point value. If any characters remain, then we
1453 must not have a valid floating point string. */
1459 dval
= strtod (buf
, ©
);
1464 return (FLOAT_LITERAL
);
1470 /* Recognize a string literal. A string literal is a sequence
1471 of characters enclosed in matching single or double quotes, except that
1472 a single character inside single quotes is a character literal, which
1473 we reject as a string literal. To embed the terminator character inside
1474 a string, it is simply doubled (I.E. "this""is""one""string") */
1476 static enum ch_terminal
1477 match_string_literal ()
1479 char *tokptr
= lexptr
;
1483 for (tempbufindex
= 0, tokptr
++; *tokptr
!= '\0'; tokptr
++)
1489 /* skip possible whitespaces */
1490 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1498 else if (*tokptr
!= ',')
1499 error ("Invalid control sequence");
1501 /* skip possible whitespaces */
1502 while ((*tokptr
== ' ' || *tokptr
== '\t') && *tokptr
)
1504 if (!decode_integer_literal (&ival
, &tokptr
))
1505 error ("Invalid control sequence");
1508 else if (*tokptr
== *lexptr
)
1510 if (*(tokptr
+ 1) == *lexptr
)
1519 else if (*tokptr
== '^')
1521 if (*(tokptr
+ 1) == '(')
1525 if (!decode_integer_literal (&ival
, &tokptr
))
1526 error ("Invalid control sequence");
1529 else if (*(tokptr
+ 1) == '^')
1532 error ("Invalid control sequence");
1536 tempbuf
[tempbufindex
++] = ival
;
1539 error ("Invalid control sequence");
1541 if (*tokptr
== '\0' /* no terminator */
1542 || (tempbufindex
== 1 && *tokptr
== '\'')) /* char literal */
1548 tempbuf
[tempbufindex
] = '\0';
1549 yylval
.sval
.ptr
= tempbuf
;
1550 yylval
.sval
.length
= tempbufindex
;
1552 return (CHARACTER_STRING_LITERAL
);
1556 /* Recognize a character literal. A character literal is single character
1557 or a control sequence, enclosed in single quotes. A control sequence
1558 is a comma separated list of one or more integer literals, enclosed
1559 in parenthesis and introduced with a circumflex character.
1561 EX: 'a' '^(7)' '^(7,8)'
1563 As a GNU chill extension, the syntax C'xx' is also recognized as a
1564 character literal, where xx is a hex value for the character.
1566 Note that more than a single character, enclosed in single quotes, is
1569 Returns CHARACTER_LITERAL if a match is found.
1572 static enum ch_terminal
1573 match_character_literal ()
1575 char *tokptr
= lexptr
;
1578 if ((*tokptr
== 'c' || *tokptr
== 'C') && (*(tokptr
+ 1) == '\''))
1580 /* We have a GNU chill extension form, so skip the leading "C'",
1581 decode the hex value, and then ensure that we have a trailing
1582 single quote character. */
1584 if (!decode_integer_value (16, &tokptr
, &ival
) || (*tokptr
!= '\''))
1590 else if (*tokptr
== '\'')
1594 /* Determine which form we have, either a control sequence or the
1595 single character form. */
1599 if (*(tokptr
+ 1) == '(')
1601 /* Match and decode a control sequence. Return zero if we don't
1602 find a valid integer literal, or if the next unconsumed character
1603 after the integer literal is not the trailing ')'. */
1605 if (!decode_integer_literal (&ival
, &tokptr
) || (*tokptr
++ != ')'))
1610 else if (*(tokptr
+ 1) == '^')
1617 error ("Invalid control sequence");
1619 else if (*tokptr
== '\'')
1621 /* this must be duplicated */
1630 /* The trailing quote has not yet been consumed. If we don't find
1631 it, then we have no match. */
1633 if (*tokptr
++ != '\'')
1640 /* Not a character literal. */
1643 yylval
.typed_val
.val
= ival
;
1644 yylval
.typed_val
.type
= builtin_type_chill_char
;
1646 return (CHARACTER_LITERAL
);
1649 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1650 Note that according to 5.2.4.2, a single "_" is also a valid integer
1651 literal, however GNU-chill requires there to be at least one "digit"
1652 in any integer literal. */
1654 static enum ch_terminal
1655 match_integer_literal ()
1657 char *tokptr
= lexptr
;
1660 if (!decode_integer_literal (&ival
, &tokptr
))
1666 yylval
.typed_val
.val
= ival
;
1667 #if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1668 if (ival
> (LONGEST
)2147483647U || ival
< -(LONGEST
)2147483648U)
1669 yylval
.typed_val
.type
= builtin_type_long_long
;
1672 yylval
.typed_val
.type
= builtin_type_int
;
1674 return (INTEGER_LITERAL
);
1678 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1679 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1680 literal, however GNU-chill requires there to be at least one "digit"
1681 in any bit-string literal. */
1683 static enum ch_terminal
1684 match_bitstring_literal ()
1686 register char *tokptr
= lexptr
;
1696 /* Look for the required explicit base specifier. */
1717 /* Ensure that the character after the explicit base is a single quote. */
1719 if (*tokptr
++ != '\'')
1724 while (*tokptr
!= '\0' && *tokptr
!= '\'')
1727 if (isupper (digit
))
1728 digit
= tolower (digit
);
1734 case '0': case '1': case '2': case '3': case '4':
1735 case '5': case '6': case '7': case '8': case '9':
1738 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1743 /* this is not a bitstring literal, probably an integer */
1746 if (digit
>= 1 << bits_per_char
)
1748 /* Found something not in domain for current base. */
1749 error ("Too-large digit in bitstring or integer.");
1753 /* Extract bits from digit, packing them into the bitstring byte. */
1754 int k
= TARGET_BYTE_ORDER
== BIG_ENDIAN
? bits_per_char
- 1 : 0;
1755 for (; TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
>= 0 : k
< bits_per_char
;
1756 TARGET_BYTE_ORDER
== BIG_ENDIAN
? k
-- : k
++)
1759 if (digit
& (1 << k
))
1761 tempbuf
[tempbufindex
] |=
1762 (TARGET_BYTE_ORDER
== BIG_ENDIAN
)
1763 ? (1 << (HOST_CHAR_BIT
- 1 - bitoffset
))
1767 if (bitoffset
== HOST_CHAR_BIT
)
1772 tempbuf
[tempbufindex
] = 0;
1778 /* Verify that we consumed everything up to the trailing single quote,
1779 and that we found some bits (IE not just underbars). */
1781 if (*tokptr
++ != '\'')
1787 yylval
.sval
.ptr
= tempbuf
;
1788 yylval
.sval
.length
= bitcount
;
1790 return (BIT_STRING_LITERAL
);
1800 static const struct token idtokentab
[] =
1803 { "length", LENGTH
},
1814 { "max", MAX_TOKEN
},
1815 { "min", MIN_TOKEN
},
1824 { "addr", ADDR_TOKEN
},
1825 { "null", EMPTINESS_LITERAL
}
1828 static const struct token tokentab2
[] =
1830 { ":=", GDB_ASSIGNMENT
},
1831 { "//", SLASH_SLASH
},
1838 /* Read one token, getting characters through lexptr. */
1839 /* This is where we will check to make sure that the language and the
1840 operators used are compatible. */
1842 static enum ch_terminal
1846 enum ch_terminal token
;
1850 /* Skip over any leading whitespace. */
1851 while (isspace (*lexptr
))
1855 /* Look for special single character cases which can't be the first
1856 character of some other multicharacter token. */
1873 /* Look for characters which start a particular kind of multicharacter
1874 token, such as a character literal, register name, convenience
1875 variable name, string literal, etc. */
1880 /* First try to match a string literal, which is any
1881 sequence of characters enclosed in matching single or double
1882 quotes, except that a single character inside single quotes
1883 is a character literal, so we have to catch that case also. */
1884 token
= match_string_literal ();
1889 if (*lexptr
== '\'')
1891 token
= match_character_literal ();
1900 token
= match_character_literal ();
1907 yylval
.sval
.ptr
= lexptr
;
1910 } while (isalnum (*lexptr
) || *lexptr
== '_' || *lexptr
== '$');
1911 yylval
.sval
.length
= lexptr
- yylval
.sval
.ptr
;
1912 write_dollar_variable (yylval
.sval
);
1913 return GDB_VARIABLE
;
1916 /* See if it is a special token of length 2. */
1917 for (i
= 0; i
< sizeof (tokentab2
) / sizeof (tokentab2
[0]); i
++)
1919 if (STREQN (lexptr
, tokentab2
[i
].operator, 2))
1922 return (tokentab2
[i
].token
);
1925 /* Look for single character cases which which could be the first
1926 character of some other multicharacter token, but aren't, or we
1927 would already have found it. */
1937 /* Look for a float literal before looking for an integer literal, so
1938 we match as much of the input stream as possible. */
1939 token
= match_float_literal ();
1944 token
= match_bitstring_literal ();
1949 token
= match_integer_literal ();
1955 /* Try to match a simple name string, and if a match is found, then
1956 further classify what sort of name it is and return an appropriate
1957 token. Note that attempting to match a simple name string consumes
1958 the token from lexptr, so we can't back out if we later find that
1959 we can't classify what sort of name it is. */
1961 inputname
= match_simple_name_string ();
1963 if (inputname
!= NULL
)
1965 char *simplename
= (char*) alloca (strlen (inputname
) + 1);
1967 char *dptr
= simplename
, *sptr
= inputname
;
1968 for (; *sptr
; sptr
++)
1969 *dptr
++ = isupper (*sptr
) ? tolower(*sptr
) : *sptr
;
1972 /* See if it is a reserved identifier. */
1973 for (i
= 0; i
< sizeof (idtokentab
) / sizeof (idtokentab
[0]); i
++)
1975 if (STREQ (simplename
, idtokentab
[i
].operator))
1977 return (idtokentab
[i
].token
);
1981 /* Look for other special tokens. */
1982 if (STREQ (simplename
, "true"))
1985 return (BOOLEAN_LITERAL
);
1987 if (STREQ (simplename
, "false"))
1990 return (BOOLEAN_LITERAL
);
1993 sym
= lookup_symbol (inputname
, expression_context_block
,
1994 VAR_NAMESPACE
, (int *) NULL
,
1995 (struct symtab
**) NULL
);
1996 if (sym
== NULL
&& strcmp (inputname
, simplename
) != 0)
1998 sym
= lookup_symbol (simplename
, expression_context_block
,
1999 VAR_NAMESPACE
, (int *) NULL
,
2000 (struct symtab
**) NULL
);
2004 yylval
.ssym
.stoken
.ptr
= NULL
;
2005 yylval
.ssym
.stoken
.length
= 0;
2006 yylval
.ssym
.sym
= sym
;
2007 yylval
.ssym
.is_a_field_of_this
= 0; /* FIXME, C++'ism */
2008 switch (SYMBOL_CLASS (sym
))
2011 /* Found a procedure name. */
2012 return (GENERAL_PROCEDURE_NAME
);
2014 /* Found a global or local static variable. */
2015 return (LOCATION_NAME
);
2020 case LOC_REGPARM_ADDR
:
2024 case LOC_BASEREG_ARG
:
2025 if (innermost_block
== NULL
2026 || contained_in (block_found
, innermost_block
))
2028 innermost_block
= block_found
;
2030 return (LOCATION_NAME
);
2034 return (LOCATION_NAME
);
2037 yylval
.tsym
.type
= SYMBOL_TYPE (sym
);
2040 case LOC_CONST_BYTES
:
2041 case LOC_OPTIMIZED_OUT
:
2042 error ("Symbol \"%s\" names no location.", inputname
);
2044 case LOC_UNRESOLVED
:
2045 error ("unhandled SYMBOL_CLASS in ch_lex()");
2049 else if (!have_full_symbols () && !have_partial_symbols ())
2051 error ("No symbol table is loaded. Use the \"file\" command.");
2055 error ("No symbol \"%s\" in current context.", inputname
);
2059 /* Catch single character tokens which are not part of some
2064 case '.': /* Not float for example. */
2066 while (isspace (*lexptr
)) lexptr
++;
2067 inputname
= match_simple_name_string ();
2073 return (ILLEGAL_TOKEN
);
2077 write_lower_upper_value (opcode
, type
)
2078 enum exp_opcode opcode
; /* Either UNOP_LOWER or UNOP_UPPER */
2082 write_exp_elt_opcode (opcode
);
2085 extern LONGEST
type_lower_upper ();
2086 struct type
*result_type
;
2087 LONGEST val
= type_lower_upper (opcode
, type
, &result_type
);
2088 write_exp_elt_opcode (OP_LONG
);
2089 write_exp_elt_type (result_type
);
2090 write_exp_elt_longcst (val
);
2091 write_exp_elt_opcode (OP_LONG
);
2095 /* In certain cases it could happen, that an array type doesn't
2096 have a length (this have to do with seizing). The reason is
2097 shown in the following stabs:
2099 .stabs "m_x:Tt81=s36i:1,0,32;ar:82=ar80;0;1;83=xsm_struct:,32,256;;",128,0,25,0
2101 .stabs "m_struct:Tt83=s16f1:9,0,16;f2:85=*84,32,32;f3:84,64,64;;",128,0,10,0
2103 When processing t81, the array ar80 doesn't have a length, cause
2104 struct m_struct is specified extern at thse moment. Afterwards m_struct
2105 gets specified and updated, but not the surrounding type.
2107 So we walk through array's till we find a type with a length and
2108 calculate the array length.
2110 FIXME: Where may this happen too ?
2114 calculate_array_length (type
)
2117 struct type
*target_type
;
2118 struct type
*range_type
;
2119 LONGEST lower_bound
, upper_bound
;
2121 if (TYPE_CODE (type
) != TYPE_CODE_ARRAY
)
2122 /* not an array, stop processing */
2125 target_type
= TYPE_TARGET_TYPE (type
);
2126 range_type
= TYPE_FIELD_TYPE (type
, 0);
2127 lower_bound
= TYPE_FIELD_BITPOS (range_type
, 0);
2128 upper_bound
= TYPE_FIELD_BITPOS (range_type
, 1);
2130 if (TYPE_LENGTH (target_type
) == 0 &&
2131 TYPE_CODE (target_type
) == TYPE_CODE_ARRAY
)
2132 /* we've got another array */
2133 calculate_array_length (target_type
);
2135 TYPE_LENGTH (type
) = (upper_bound
- lower_bound
+ 1) * TYPE_LENGTH (target_type
);