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 malloc's and realloc's in this file are transformed to
30 xmalloc and xrealloc respectively by the same sed command in the
31 makefile that remaps any other malloc/realloc inserted by the parser
32 generator. Doing this with #defines and trying to control the interaction
33 with include files (<malloc.h> and <stdlib.h> for example) just became
34 too messy, particularly when such includes can be inserted at random
35 times by the parser generator.
37 Also note that the language accepted by this parser is more liberal
38 than the one accepted by an actual Chill compiler. For example, the
39 language rule that a simple name string can not be one of the reserved
40 simple name strings is not enforced (e.g "case" is not treated as a
41 reserved name). Another example is that Chill is a strongly typed
42 language, and certain expressions that violate the type constraints
43 may still be evaluated if gdb can do so in a meaningful manner, while
44 such expressions would be rejected by the compiler. The reason for
45 this more liberal behavior is the philosophy that the debugger
46 is intended to be a tool that is used by the programmer when things
47 go wrong, and as such, it should provide as few artificial barriers
48 to it's use as possible. If it can do something meaningful, even
49 something that violates language contraints that are enforced by the
50 compiler, it should do so without complaint.
57 #include "expression.h"
60 #include "parser-defs.h"
62 #include "bfd.h" /* Required by objfiles.h. */
63 #include "symfile.h" /* Required by objfiles.h. */
64 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
70 unsigned LONGEST ulval;
85 /* '\001' ... '\xff' come first. */
91 GENERAL_PROCEDURE_NAME,
94 CHARACTER_STRING_LITERAL,
140 /* Forward declarations. */
141 static void parse_expr ();
142 static void parse_primval ();
143 static void parse_untyped_expr ();
144 static int parse_opt_untyped_expr ();
145 static void parse_if_expression_body PARAMS((void));
146 static void write_lower_upper_value PARAMS ((enum exp_opcode, struct type *));
147 static enum ch_terminal ch_lex ();
149 #define MAX_LOOK_AHEAD 2
150 static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD+1] = {
151 TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
152 static YYSTYPE yylval;
153 static YYSTYPE val_buffer[MAX_LOOK_AHEAD+1];
155 /*int current_token, lookahead_token;*/
160 static enum ch_terminal
163 if (terminal_buffer[0] == TOKEN_NOT_READ)
165 terminal_buffer[0] = ch_lex ();
166 val_buffer[0] = yylval;
168 return terminal_buffer[0];
170 #define PEEK_LVAL() val_buffer[0]
171 #define PEEK_TOKEN1() peek_token_(1)
172 #define PEEK_TOKEN2() peek_token_(2)
173 static enum ch_terminal
177 if (i > MAX_LOOK_AHEAD)
178 fatal ("internal error - too much lookahead");
179 if (terminal_buffer[i] == TOKEN_NOT_READ)
181 terminal_buffer[i] = ch_lex ();
182 val_buffer[i] = yylval;
184 return terminal_buffer[i];
188 pushback_token (code, node)
189 enum ch_terminal code;
193 if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
194 fatal ("internal error - cannot pushback token");
195 for (i = MAX_LOOK_AHEAD; i > 0; i--)
197 terminal_buffer[i] = terminal_buffer[i - 1];
198 val_buffer[i] = val_buffer[i - 1];
200 terminal_buffer[0] = code;
201 val_buffer[0] = node;
208 for (i = 0; i < MAX_LOOK_AHEAD; i++)
210 terminal_buffer[i] = terminal_buffer[i+1];
211 val_buffer[i] = val_buffer[i+1];
213 terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
215 #define FORWARD_TOKEN() forward_token_()
217 /* Skip the next token.
218 if it isn't TOKEN, the parser is broken. */
222 enum ch_terminal token;
224 if (PEEK_TOKEN() != token)
227 sprintf (buf, "internal parser error - expected token %d", (int)token);
235 enum ch_terminal token;
237 if (PEEK_TOKEN() != token)
243 /* return 0 if expected token was not found,
247 expect(token, message)
248 enum ch_terminal token;
251 if (PEEK_TOKEN() != token)
255 else if (token < 256)
256 error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
258 error ("syntax error");
268 parse_opt_name_string (allow_all)
269 int allow_all; /* 1 if ALL is allowed as a postfix */
271 int token = PEEK_TOKEN();
275 if (token == ALL && allow_all)
286 token = PEEK_TOKEN();
290 token = PEEK_TOKEN();
291 if (token == ALL && allow_all)
292 return get_identifier3(IDENTIFIER_POINTER (name), "!", "*");
296 error ("'%s!' is not followed by an identifier",
297 IDENTIFIER_POINTER (name));
300 name = get_identifier3(IDENTIFIER_POINTER(name),
301 "!", IDENTIFIER_POINTER(PEEK_LVAL()));
306 parse_simple_name_string ()
308 int token = PEEK_TOKEN();
312 error ("expected a name here");
313 return error_mark_node;
323 tree name = parse_opt_name_string (0);
327 error ("expected a name string here");
328 return error_mark_node;
331 /* Matches: <name_string>
332 Returns if pass 1: the identifier.
333 Returns if pass 2: a decl or value for identifier. */
338 tree name = parse_name_string ();
339 if (pass == 1 || ignoring)
343 tree decl = lookup_name (name);
344 if (decl == NULL_TREE)
346 error ("`%s' undeclared", IDENTIFIER_POINTER (name));
347 return error_mark_node;
349 else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
350 return error_mark_node;
351 else if (TREE_CODE (decl) == CONST_DECL)
352 return DECL_INITIAL (decl);
353 else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
354 return convert_from_reference (decl);
363 pushback_paren_expr (expr)
366 if (pass == 1 && !ignoring)
367 expr = build1 (PAREN_EXPR, NULL_TREE, expr);
368 pushback_token (EXPR, expr);
372 /* Matches: <case label> */
377 if (check_token (ELSE))
378 error ("ELSE in tuples labels not implemented");
379 /* Does not handle the case of a mode name. FIXME */
381 if (check_token (':'))
384 write_exp_elt_opcode (BINOP_RANGE);
389 parse_opt_untyped_expr ()
391 switch (PEEK_TOKEN ())
398 parse_untyped_expr ();
412 /* Parse NAME '(' MODENAME ')'. */
420 if (PEEK_TOKEN () != TYPENAME)
421 error ("expect MODENAME here `%s'", lexptr);
422 type = PEEK_LVAL().tsym.type;
429 parse_mode_or_normal_call ()
434 if (PEEK_TOKEN () == TYPENAME)
436 type = PEEK_LVAL().tsym.type;
448 /* Parse something that looks like a function call.
449 Assume we have parsed the function, and are at the '('. */
456 /* This is to save the value of arglist_len
457 being accumulated for each dimension. */
459 if (parse_opt_untyped_expr ())
461 int tok = PEEK_TOKEN ();
463 if (tok == UP || tok == ':')
467 expect (')', "expected ')' to terminate slice");
469 write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
473 while (check_token (','))
475 parse_untyped_expr ();
482 arg_count = end_arglist ();
483 write_exp_elt_opcode (MULTI_SUBSCRIPT);
484 write_exp_elt_longcst (arg_count);
485 write_exp_elt_opcode (MULTI_SUBSCRIPT);
489 parse_named_record_element ()
493 label = PEEK_LVAL ().sval;
494 expect (FIELD_NAME, "expected a field name here `%s'", lexptr);
495 if (check_token (','))
496 parse_named_record_element ();
497 else if (check_token (':'))
500 error ("syntax error near `%s' in named record tuple element", lexptr);
501 write_exp_elt_opcode (OP_LABELED);
502 write_exp_string (label);
503 write_exp_elt_opcode (OP_LABELED);
506 /* Returns one or nore TREE_LIST nodes, in reverse order. */
509 parse_tuple_element ()
511 if (PEEK_TOKEN () == FIELD_NAME)
513 /* Parse a labelled structure tuple. */
514 parse_named_record_element ();
518 if (check_token ('('))
520 if (check_token ('*'))
522 expect (')', "missing ')' after '*' case label list");
523 error ("(*) not implemented in case label list");
528 while (check_token (','))
531 write_exp_elt_opcode (BINOP_COMMA);
537 parse_untyped_expr ();
538 if (check_token (':'))
540 /* A powerset range or a labeled Array. */
541 parse_untyped_expr ();
542 write_exp_elt_opcode (BINOP_RANGE);
546 /* Matches: a COMMA-separated list of tuple elements.
547 Returns a list (of TREE_LIST nodes). */
549 parse_opt_element_list ()
552 if (PEEK_TOKEN () == ']')
556 parse_tuple_element ();
558 if (PEEK_TOKEN () == ']')
560 if (!check_token (','))
561 error ("bad syntax in tuple");
565 /* Parses: '[' elements ']'
566 If modename is non-NULL it prefixed the tuple. */
574 parse_opt_element_list ();
575 expect (']', "missing ']' after tuple");
576 write_exp_elt_opcode (OP_ARRAY);
577 write_exp_elt_longcst ((LONGEST) 0);
578 write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
579 write_exp_elt_opcode (OP_ARRAY);
582 write_exp_elt_opcode (UNOP_CAST);
583 write_exp_elt_type (mode);
584 write_exp_elt_opcode (UNOP_CAST);
594 switch (PEEK_TOKEN ())
596 case INTEGER_LITERAL:
597 case CHARACTER_LITERAL:
598 write_exp_elt_opcode (OP_LONG);
599 write_exp_elt_type (PEEK_LVAL ().typed_val.type);
600 write_exp_elt_longcst ((LONGEST) (PEEK_LVAL ().typed_val.val));
601 write_exp_elt_opcode (OP_LONG);
604 case BOOLEAN_LITERAL:
605 write_exp_elt_opcode (OP_BOOL);
606 write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
607 write_exp_elt_opcode (OP_BOOL);
611 write_exp_elt_opcode (OP_DOUBLE);
612 write_exp_elt_type (builtin_type_double);
613 write_exp_elt_dblcst (PEEK_LVAL ().dval);
614 write_exp_elt_opcode (OP_DOUBLE);
617 case EMPTINESS_LITERAL:
618 write_exp_elt_opcode (OP_LONG);
619 write_exp_elt_type (lookup_pointer_type (builtin_type_void));
620 write_exp_elt_longcst (0);
621 write_exp_elt_opcode (OP_LONG);
624 case CHARACTER_STRING_LITERAL:
625 write_exp_elt_opcode (OP_STRING);
626 write_exp_string (PEEK_LVAL ().sval);
627 write_exp_elt_opcode (OP_STRING);
630 case BIT_STRING_LITERAL:
631 write_exp_elt_opcode (OP_BITSTRING);
632 write_exp_bitstring (PEEK_LVAL ().sval);
633 write_exp_elt_opcode (OP_BITSTRING);
638 /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
639 which casts to an artificial array. */
642 if (PEEK_TOKEN () != TYPENAME)
643 error ("missing MODENAME after ARRAY()");
644 type = PEEK_LVAL().tsym.type;
647 expect (')', "missing right parenthesis");
648 type = create_array_type ((struct type *) NULL, type,
649 create_range_type ((struct type *) NULL,
650 builtin_type_int, 0, 0));
651 TYPE_ARRAY_UPPER_BOUND_TYPE(type) = BOUND_CANNOT_BE_DETERMINED;
652 write_exp_elt_opcode (UNOP_CAST);
653 write_exp_elt_type (type);
654 write_exp_elt_opcode (UNOP_CAST);
666 expect (')', "missing right parenthesis");
671 case GENERAL_PROCEDURE_NAME:
673 write_exp_elt_opcode (OP_VAR_VALUE);
674 write_exp_elt_block (NULL);
675 write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
676 write_exp_elt_opcode (OP_VAR_VALUE);
679 case GDB_VARIABLE: /* gdb specific */
684 write_exp_elt_opcode (UNOP_CAST);
685 write_exp_elt_type (builtin_type_int);
686 write_exp_elt_opcode (UNOP_CAST);
688 case PRED: op_name = "PRED"; goto unimplemented_unary_builtin;
689 case SUCC: op_name = "SUCC"; goto unimplemented_unary_builtin;
690 case ABS: op_name = "ABS"; goto unimplemented_unary_builtin;
691 case CARD: op_name = "CARD"; goto unimplemented_unary_builtin;
692 case MAX_TOKEN: op_name = "MAX"; goto unimplemented_unary_builtin;
693 case MIN_TOKEN: op_name = "MIN"; goto unimplemented_unary_builtin;
694 unimplemented_unary_builtin:
696 error ("not implemented: %s builtin function", op_name);
700 write_exp_elt_opcode (UNOP_ADDR);
703 type = parse_mode_or_normal_call ();
705 { write_exp_elt_opcode (OP_LONG);
706 write_exp_elt_type (builtin_type_int);
707 CHECK_TYPEDEF (type);
708 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
709 write_exp_elt_opcode (OP_LONG);
712 write_exp_elt_opcode (UNOP_SIZEOF);
721 type = parse_mode_or_normal_call ();
722 write_lower_upper_value (op, type);
726 write_exp_elt_opcode (UNOP_LENGTH);
729 type = PEEK_LVAL ().tsym.type;
731 switch (PEEK_TOKEN())
739 expect (')', "missing right parenthesis");
740 write_exp_elt_opcode (UNOP_CAST);
741 write_exp_elt_type (type);
742 write_exp_elt_opcode (UNOP_CAST);
745 error ("typename in invalid context");
750 error ("invalid expression syntax at `%s'", lexptr);
754 switch (PEEK_TOKEN ())
757 write_exp_elt_opcode (STRUCTOP_STRUCT);
758 write_exp_string (PEEK_LVAL ().sval);
759 write_exp_elt_opcode (STRUCTOP_STRUCT);
764 if (PEEK_TOKEN () == TYPENAME)
766 type = PEEK_LVAL ().tsym.type;
767 write_exp_elt_opcode (UNOP_CAST);
768 write_exp_elt_type (lookup_pointer_type (type));
769 write_exp_elt_opcode (UNOP_CAST);
772 write_exp_elt_opcode (UNOP_IND);
777 case CHARACTER_STRING_LITERAL:
778 case CHARACTER_LITERAL:
779 case BIT_STRING_LITERAL:
780 /* Handle string repetition. (See comment in parse_operand5.) */
782 write_exp_elt_opcode (MULTI_SUBSCRIPT);
783 write_exp_elt_longcst (1);
784 write_exp_elt_opcode (MULTI_SUBSCRIPT);
795 if (check_token (RECEIVE))
798 error ("not implemented: RECEIVE expression");
800 else if (check_token (POINTER))
803 write_exp_elt_opcode (UNOP_ADDR);
813 /* We are supposed to be looking for a <string repetition operator>,
814 but in general we can't distinguish that from a parenthesized
815 expression. This is especially difficult if we allow the
816 string operand to be a constant expression (as requested by
817 some users), and not just a string literal.
818 Consider: LPRN expr RPRN LPRN expr RPRN
819 Is that a function call or string repetition?
820 Instead, we handle string repetition in parse_primval,
821 and build_generalized_call. */
822 switch (PEEK_TOKEN())
824 case NOT: op = UNOP_LOGICAL_NOT; break;
825 case '-': op = UNOP_NEG; break;
833 write_exp_elt_opcode (op);
843 switch (PEEK_TOKEN())
845 case '*': op = BINOP_MUL; break;
846 case '/': op = BINOP_DIV; break;
847 case MOD: op = BINOP_MOD; break;
848 case REM: op = BINOP_REM; break;
854 write_exp_elt_opcode (op);
865 switch (PEEK_TOKEN())
867 case '+': op = BINOP_ADD; break;
868 case '-': op = BINOP_SUB; break;
869 case SLASH_SLASH: op = BINOP_CONCAT; break;
875 write_exp_elt_opcode (op);
886 if (check_token (IN))
889 write_exp_elt_opcode (BINOP_IN);
893 switch (PEEK_TOKEN())
895 case '>': op = BINOP_GTR; break;
896 case GEQ: op = BINOP_GEQ; break;
897 case '<': op = BINOP_LESS; break;
898 case LEQ: op = BINOP_LEQ; break;
899 case '=': op = BINOP_EQUAL; break;
900 case NOTEQUAL: op = BINOP_NOTEQUAL; break;
906 write_exp_elt_opcode (op);
918 switch (PEEK_TOKEN())
920 case LOGAND: op = BINOP_BITWISE_AND; break;
921 case ANDIF: op = BINOP_LOGICAL_AND; break;
927 write_exp_elt_opcode (op);
938 switch (PEEK_TOKEN())
940 case LOGIOR: op = BINOP_BITWISE_IOR; break;
941 case LOGXOR: op = BINOP_BITWISE_XOR; break;
942 case ORIF: op = BINOP_LOGICAL_OR; break;
948 write_exp_elt_opcode (op);
956 if (check_token (GDB_ASSIGNMENT))
959 write_exp_elt_opcode (BINOP_ASSIGN);
964 parse_then_alternative ()
966 expect (THEN, "missing 'THEN' in 'IF' expression");
971 parse_else_alternative ()
973 if (check_token (ELSIF))
974 parse_if_expression_body ();
975 else if (check_token (ELSE))
978 error ("missing ELSE/ELSIF in IF expression");
981 /* Matches: <boolean expression> <then alternative> <else alternative> */
984 parse_if_expression_body ()
987 parse_then_alternative ();
988 parse_else_alternative ();
989 write_exp_elt_opcode (TERNOP_COND);
993 parse_if_expression ()
996 parse_if_expression_body ();
997 expect (FI, "missing 'FI' at end of conditional expression");
1000 /* An <untyped_expr> is a superset of <expr>. It also includes
1001 <conditional expressions> and untyped <tuples>, whose types
1002 are not given by their constituents. Hence, these are only
1003 allowed in certain contexts that expect a certain type.
1004 You should call convert() to fix up the <untyped_expr>. */
1007 parse_untyped_expr ()
1009 switch (PEEK_TOKEN())
1012 parse_if_expression ();
1015 error ("not implemented: CASE expression");
1017 switch (PEEK_TOKEN1())
1025 parse_untyped_expr ();
1026 expect (')', "missing ')'");
1039 terminal_buffer[0] = TOKEN_NOT_READ;
1040 if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
1042 write_exp_elt_opcode(OP_TYPE);
1043 write_exp_elt_type(PEEK_LVAL ().tsym.type);
1044 write_exp_elt_opcode(OP_TYPE);
1049 if (terminal_buffer[0] != END_TOKEN)
1051 if (comma_terminates && terminal_buffer[0] == ',')
1052 lexptr--; /* Put the comma back. */
1054 error ("Junk after end of expression.");
1060 /* Implementation of a dynamically expandable buffer for processing input
1061 characters acquired through lexptr and building a value to return in
1064 static char *tempbuf; /* Current buffer contents */
1065 static int tempbufsize; /* Size of allocated buffer */
1066 static int tempbufindex; /* Current index into buffer */
1068 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1070 #define CHECKBUF(size) \
1072 if (tempbufindex + (size) >= tempbufsize) \
1074 growbuf_by_size (size); \
1078 /* Grow the static temp buffer if necessary, including allocating the first one
1082 growbuf_by_size (count)
1087 growby = max (count, GROWBY_MIN_SIZE);
1088 tempbufsize += growby;
1089 if (tempbuf == NULL)
1091 tempbuf = (char *) malloc (tempbufsize);
1095 tempbuf = (char *) realloc (tempbuf, tempbufsize);
1099 /* Try to consume a simple name string token. If successful, returns
1100 a pointer to a nullbyte terminated copy of the name that can be used
1101 in symbol table lookups. If not successful, returns NULL. */
1104 match_simple_name_string ()
1106 char *tokptr = lexptr;
1108 if (isalpha (*tokptr) || *tokptr == '_')
1113 } while (isalnum (*tokptr) || (*tokptr == '_'));
1114 yylval.sval.ptr = lexptr;
1115 yylval.sval.length = tokptr - lexptr;
1117 result = copy_name (yylval.sval);
1123 /* Start looking for a value composed of valid digits as set by the base
1124 in use. Note that '_' characters are valid anywhere, in any quantity,
1125 and are simply ignored. Since we must find at least one valid digit,
1126 or reject this token as an integer literal, we keep track of how many
1127 digits we have encountered. */
1130 decode_integer_value (base, tokptrptr, ivalptr)
1135 char *tokptr = *tokptrptr;
1139 while (*tokptr != '\0')
1143 temp = tolower (temp);
1149 case '0': case '1': case '2': case '3': case '4':
1150 case '5': case '6': case '7': case '8': case '9':
1153 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1169 /* Found something not in domain for current base. */
1170 tokptr--; /* Unconsume what gave us indigestion. */
1175 /* If we didn't find any digits, then we don't have a valid integer
1176 value, so reject the entire token. Otherwise, update the lexical
1177 scan pointer, and return non-zero for success. */
1185 *tokptrptr = tokptr;
1191 decode_integer_literal (valptr, tokptrptr)
1195 char *tokptr = *tokptrptr;
1198 int explicit_base = 0;
1200 /* Look for an explicit base specifier, which is optional. */
1233 /* If we found an explicit base ensure that the character after the
1234 explicit base is a single quote. */
1236 if (explicit_base && (*tokptr++ != '\''))
1241 /* Attempt to decode whatever follows as an integer value in the
1242 indicated base, updating the token pointer in the process and
1243 computing the value into ival. Also, if we have an explicit
1244 base, then the next character must not be a single quote, or we
1245 have a bitstring literal, so reject the entire token in this case.
1246 Otherwise, update the lexical scan pointer, and return non-zero
1249 if (!decode_integer_value (base, &tokptr, &ival))
1253 else if (explicit_base && (*tokptr == '\''))
1260 *tokptrptr = tokptr;
1265 /* If it wasn't for the fact that floating point values can contain '_'
1266 characters, we could just let strtod do all the hard work by letting it
1267 try to consume as much of the current token buffer as possible and
1268 find a legal conversion. Unfortunately we need to filter out the '_'
1269 characters before calling strtod, which we do by copying the other
1270 legal chars to a local buffer to be converted. However since we also
1271 need to keep track of where the last unconsumed character in the input
1272 buffer is, we have transfer only as many characters as may compose a
1273 legal floating point value. */
1275 static enum ch_terminal
1276 match_float_literal ()
1278 char *tokptr = lexptr;
1282 extern double strtod ();
1284 /* Make local buffer in which to build the string to convert. This is
1285 required because underscores are valid in chill floating point numbers
1286 but not in the string passed to strtod to convert. The string will be
1287 no longer than our input string. */
1289 copy = buf = (char *) alloca (strlen (tokptr) + 1);
1291 /* Transfer all leading digits to the conversion buffer, discarding any
1294 while (isdigit (*tokptr) || *tokptr == '_')
1303 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1304 of whether we found any leading digits, and we simply accept it and
1305 continue on to look for the fractional part and/or exponent. One of
1306 [eEdD] is legal only if we have seen digits, and means that there
1307 is no fractional part. If we find neither of these, then this is
1308 not a floating point number, so return failure. */
1313 /* Accept and then look for fractional part and/or exponent. */
1326 goto collect_exponent;
1334 /* We found a '.', copy any fractional digits to the conversion buffer, up
1335 to the first nondigit, non-underscore character. */
1337 while (isdigit (*tokptr) || *tokptr == '_')
1346 /* Look for an exponent, which must start with one of [eEdD]. If none
1347 is found, jump directly to trying to convert what we have collected
1364 /* Accept an optional '-' or '+' following one of [eEdD]. */
1367 if (*tokptr == '+' || *tokptr == '-')
1369 *copy++ = *tokptr++;
1372 /* Now copy an exponent into the conversion buffer. Note that at the
1373 moment underscores are *not* allowed in exponents. */
1375 while (isdigit (*tokptr))
1377 *copy++ = *tokptr++;
1380 /* If we transfered any chars to the conversion buffer, try to interpret its
1381 contents as a floating point value. If any characters remain, then we
1382 must not have a valid floating point string. */
1388 dval = strtod (buf, ©);
1393 return (FLOAT_LITERAL);
1399 /* Recognize a string literal. A string literal is a sequence
1400 of characters enclosed in matching single or double quotes, except that
1401 a single character inside single quotes is a character literal, which
1402 we reject as a string literal. To embed the terminator character inside
1403 a string, it is simply doubled (I.E. "this""is""one""string") */
1405 static enum ch_terminal
1406 match_string_literal ()
1408 char *tokptr = lexptr;
1410 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1413 if (*tokptr == *lexptr)
1415 if (*(tokptr + 1) == *lexptr)
1424 tempbuf[tempbufindex++] = *tokptr;
1426 if (*tokptr == '\0' /* no terminator */
1427 || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
1433 tempbuf[tempbufindex] = '\0';
1434 yylval.sval.ptr = tempbuf;
1435 yylval.sval.length = tempbufindex;
1437 return (CHARACTER_STRING_LITERAL);
1441 /* Recognize a character literal. A character literal is single character
1442 or a control sequence, enclosed in single quotes. A control sequence
1443 is a comma separated list of one or more integer literals, enclosed
1444 in parenthesis and introduced with a circumflex character.
1446 EX: 'a' '^(7)' '^(7,8)'
1448 As a GNU chill extension, the syntax C'xx' is also recognized as a
1449 character literal, where xx is a hex value for the character.
1451 Note that more than a single character, enclosed in single quotes, is
1454 Also note that the control sequence form is not in GNU Chill since it
1455 is ambiguous with the string literal form using single quotes. I.E.
1456 is '^(7)' a character literal or a string literal. In theory it it
1457 possible to tell by context, but GNU Chill doesn't accept the control
1458 sequence form, so neither do we (for now the code is disabled).
1460 Returns CHARACTER_LITERAL if a match is found.
1463 static enum ch_terminal
1464 match_character_literal ()
1466 char *tokptr = lexptr;
1469 if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
1471 /* We have a GNU chill extension form, so skip the leading "C'",
1472 decode the hex value, and then ensure that we have a trailing
1473 single quote character. */
1475 if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
1481 else if (*tokptr == '\'')
1485 /* Determine which form we have, either a control sequence or the
1486 single character form. */
1488 if ((*tokptr == '^') && (*(tokptr + 1) == '('))
1490 #if 0 /* Disable, see note above. -fnf */
1491 /* Match and decode a control sequence. Return zero if we don't
1492 find a valid integer literal, or if the next unconsumed character
1493 after the integer literal is not the trailing ')'.
1494 FIXME: We currently don't handle the multiple integer literal
1497 if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1510 /* The trailing quote has not yet been consumed. If we don't find
1511 it, then we have no match. */
1513 if (*tokptr++ != '\'')
1520 /* Not a character literal. */
1523 yylval.typed_val.val = ival;
1524 yylval.typed_val.type = builtin_type_chill_char;
1526 return (CHARACTER_LITERAL);
1529 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1530 Note that according to 5.2.4.2, a single "_" is also a valid integer
1531 literal, however GNU-chill requires there to be at least one "digit"
1532 in any integer literal. */
1534 static enum ch_terminal
1535 match_integer_literal ()
1537 char *tokptr = lexptr;
1540 if (!decode_integer_literal (&ival, &tokptr))
1546 yylval.typed_val.val = ival;
1547 #ifdef CC_HAS_LONG_LONG
1548 if (ival > 2147483647 || ival < -2147483648)
1549 yylval.typed_val.type = builtin_type_long_long;
1552 yylval.typed_val.type = builtin_type_int;
1554 return (INTEGER_LITERAL);
1558 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1559 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1560 literal, however GNU-chill requires there to be at least one "digit"
1561 in any bit-string literal. */
1563 static enum ch_terminal
1564 match_bitstring_literal ()
1566 register char *tokptr = lexptr;
1576 /* Look for the required explicit base specifier. */
1597 /* Ensure that the character after the explicit base is a single quote. */
1599 if (*tokptr++ != '\'')
1604 while (*tokptr != '\0' && *tokptr != '\'')
1607 if (isupper (digit))
1608 digit = tolower (digit);
1614 case '0': case '1': case '2': case '3': case '4':
1615 case '5': case '6': case '7': case '8': case '9':
1618 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1623 error ("Invalid character in bitstring or integer.");
1625 if (digit >= 1 << bits_per_char)
1627 /* Found something not in domain for current base. */
1628 error ("Too-large digit in bitstring or integer.");
1632 /* Extract bits from digit, packing them into the bitstring byte. */
1633 int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
1634 for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
1635 TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
1638 if (digit & (1 << k))
1640 tempbuf[tempbufindex] |=
1641 (TARGET_BYTE_ORDER == BIG_ENDIAN)
1642 ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
1646 if (bitoffset == HOST_CHAR_BIT)
1651 tempbuf[tempbufindex] = 0;
1657 /* Verify that we consumed everything up to the trailing single quote,
1658 and that we found some bits (IE not just underbars). */
1660 if (*tokptr++ != '\'')
1666 yylval.sval.ptr = tempbuf;
1667 yylval.sval.length = bitcount;
1669 return (BIT_STRING_LITERAL);
1679 static const struct token idtokentab[] =
1682 { "length", LENGTH },
1693 { "max", MAX_TOKEN },
1694 { "min", MIN_TOKEN },
1703 { "addr", ADDR_TOKEN },
1704 { "null", EMPTINESS_LITERAL }
1707 static const struct token tokentab2[] =
1709 { ":=", GDB_ASSIGNMENT },
1710 { "//", SLASH_SLASH },
1717 /* Read one token, getting characters through lexptr. */
1718 /* This is where we will check to make sure that the language and the
1719 operators used are compatible. */
1721 static enum ch_terminal
1725 enum ch_terminal token;
1729 /* Skip over any leading whitespace. */
1730 while (isspace (*lexptr))
1734 /* Look for special single character cases which can't be the first
1735 character of some other multicharacter token. */
1752 /* Look for characters which start a particular kind of multicharacter
1753 token, such as a character literal, register name, convenience
1754 variable name, string literal, etc. */
1759 /* First try to match a string literal, which is any
1760 sequence of characters enclosed in matching single or double
1761 quotes, except that a single character inside single quotes
1762 is a character literal, so we have to catch that case also. */
1763 token = match_string_literal ();
1768 if (*lexptr == '\'')
1770 token = match_character_literal ();
1779 token = match_character_literal ();
1786 yylval.sval.ptr = lexptr;
1789 } while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
1790 yylval.sval.length = lexptr - yylval.sval.ptr;
1791 write_dollar_variable (yylval.sval);
1792 return GDB_VARIABLE;
1795 /* See if it is a special token of length 2. */
1796 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1798 if (STREQN (lexptr, tokentab2[i].operator, 2))
1801 return (tokentab2[i].token);
1804 /* Look for single character cases which which could be the first
1805 character of some other multicharacter token, but aren't, or we
1806 would already have found it. */
1816 /* Look for a float literal before looking for an integer literal, so
1817 we match as much of the input stream as possible. */
1818 token = match_float_literal ();
1823 token = match_bitstring_literal ();
1828 token = match_integer_literal ();
1834 /* Try to match a simple name string, and if a match is found, then
1835 further classify what sort of name it is and return an appropriate
1836 token. Note that attempting to match a simple name string consumes
1837 the token from lexptr, so we can't back out if we later find that
1838 we can't classify what sort of name it is. */
1840 inputname = match_simple_name_string ();
1842 if (inputname != NULL)
1844 char *simplename = (char*) alloca (strlen (inputname) + 1);
1846 char *dptr = simplename, *sptr = inputname;
1847 for (; *sptr; sptr++)
1848 *dptr++ = isupper (*sptr) ? tolower(*sptr) : *sptr;
1851 /* See if it is a reserved identifier. */
1852 for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
1854 if (STREQ (simplename, idtokentab[i].operator))
1856 return (idtokentab[i].token);
1860 /* Look for other special tokens. */
1861 if (STREQ (simplename, "true"))
1864 return (BOOLEAN_LITERAL);
1866 if (STREQ (simplename, "false"))
1869 return (BOOLEAN_LITERAL);
1872 sym = lookup_symbol (inputname, expression_context_block,
1873 VAR_NAMESPACE, (int *) NULL,
1874 (struct symtab **) NULL);
1875 if (sym == NULL && strcmp (inputname, simplename) != 0)
1877 sym = lookup_symbol (simplename, expression_context_block,
1878 VAR_NAMESPACE, (int *) NULL,
1879 (struct symtab **) NULL);
1883 yylval.ssym.stoken.ptr = NULL;
1884 yylval.ssym.stoken.length = 0;
1885 yylval.ssym.sym = sym;
1886 yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
1887 switch (SYMBOL_CLASS (sym))
1890 /* Found a procedure name. */
1891 return (GENERAL_PROCEDURE_NAME);
1893 /* Found a global or local static variable. */
1894 return (LOCATION_NAME);
1899 case LOC_REGPARM_ADDR:
1903 case LOC_BASEREG_ARG:
1904 if (innermost_block == NULL
1905 || contained_in (block_found, innermost_block))
1907 innermost_block = block_found;
1909 return (LOCATION_NAME);
1913 return (LOCATION_NAME);
1916 yylval.tsym.type = SYMBOL_TYPE (sym);
1919 case LOC_CONST_BYTES:
1920 case LOC_OPTIMIZED_OUT:
1921 error ("Symbol \"%s\" names no location.", inputname);
1925 else if (!have_full_symbols () && !have_partial_symbols ())
1927 error ("No symbol table is loaded. Use the \"file\" command.");
1931 error ("No symbol \"%s\" in current context.", inputname);
1935 /* Catch single character tokens which are not part of some
1940 case '.': /* Not float for example. */
1942 while (isspace (*lexptr)) lexptr++;
1943 inputname = match_simple_name_string ();
1949 return (ILLEGAL_TOKEN);
1953 write_lower_upper_value (opcode, type)
1954 enum exp_opcode opcode; /* Either UNOP_LOWER or UNOP_UPPER */
1958 write_exp_elt_opcode (opcode);
1961 extern LONGEST type_lower_upper ();
1962 struct type *result_type;
1963 LONGEST val = type_lower_upper (opcode, type, &result_type);
1964 write_exp_elt_opcode (OP_LONG);
1965 write_exp_elt_type (result_type);
1966 write_exp_elt_longcst (val);
1967 write_exp_elt_opcode (OP_LONG);