Add __FILE__ and __LINE__ parameter to internal_error() /
[deliverable/binutils-gdb.git] / gdb / ch-exp.c
1 /* Parser for GNU CHILL (CCITT High-Level Language) -*- C -*-
2 Copyright (C) 1992, 1993, 1995, 2001 Free Software Foundation, Inc.
3
4 This file is part of GDB.
5
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.
10
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.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Parse a Chill expression from text in a string,
22 and return the result as a struct expression pointer.
23 That structure contains arithmetic operations in reverse polish,
24 with constants represented by operations that are followed by special data.
25 See expression.h for the details of the format.
26 What is important here is that it can be built up sequentially
27 during the process of parsing; the lower levels of the tree always
28 come first in the result.
29
30 Note that the language accepted by this parser is more liberal
31 than the one accepted by an actual Chill compiler. For example, the
32 language rule that a simple name string can not be one of the reserved
33 simple name strings is not enforced (e.g "case" is not treated as a
34 reserved name). Another example is that Chill is a strongly typed
35 language, and certain expressions that violate the type constraints
36 may still be evaluated if gdb can do so in a meaningful manner, while
37 such expressions would be rejected by the compiler. The reason for
38 this more liberal behavior is the philosophy that the debugger
39 is intended to be a tool that is used by the programmer when things
40 go wrong, and as such, it should provide as few artificial barriers
41 to it's use as possible. If it can do something meaningful, even
42 something that violates language contraints that are enforced by the
43 compiler, it should do so without complaint.
44
45 */
46
47 #include "defs.h"
48 #include "gdb_string.h"
49 #include <ctype.h>
50 #include "expression.h"
51 #include "language.h"
52 #include "value.h"
53 #include "parser-defs.h"
54 #include "ch-lang.h"
55 #include "bfd.h" /* Required by objfiles.h. */
56 #include "symfile.h" /* Required by objfiles.h. */
57 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
58
59 #ifdef __GNUC__
60 #define INLINE __inline__
61 #endif
62
63 typedef union
64
65 {
66 LONGEST lval;
67 ULONGEST ulval;
68 struct
69 {
70 LONGEST val;
71 struct type *type;
72 }
73 typed_val;
74 double dval;
75 struct symbol *sym;
76 struct type *tval;
77 struct stoken sval;
78 struct ttype tsym;
79 struct symtoken ssym;
80 }
81 YYSTYPE;
82
83 enum ch_terminal
84 {
85 END_TOKEN = 0,
86 /* '\001' ... '\xff' come first. */
87 OPEN_PAREN = '(',
88 TOKEN_NOT_READ = 999,
89 INTEGER_LITERAL,
90 BOOLEAN_LITERAL,
91 CHARACTER_LITERAL,
92 FLOAT_LITERAL,
93 GENERAL_PROCEDURE_NAME,
94 LOCATION_NAME,
95 EMPTINESS_LITERAL,
96 CHARACTER_STRING_LITERAL,
97 BIT_STRING_LITERAL,
98 TYPENAME,
99 DOT_FIELD_NAME, /* '.' followed by <field name> */
100 CASE,
101 OF,
102 ESAC,
103 LOGIOR,
104 ORIF,
105 LOGXOR,
106 LOGAND,
107 ANDIF,
108 NOTEQUAL,
109 GEQ,
110 LEQ,
111 IN,
112 SLASH_SLASH,
113 MOD,
114 REM,
115 NOT,
116 POINTER,
117 RECEIVE,
118 UP,
119 IF,
120 THEN,
121 ELSE,
122 FI,
123 ELSIF,
124 ILLEGAL_TOKEN,
125 NUM,
126 PRED,
127 SUCC,
128 ABS,
129 CARD,
130 MAX_TOKEN,
131 MIN_TOKEN,
132 ADDR_TOKEN,
133 SIZE,
134 UPPER,
135 LOWER,
136 LENGTH,
137 ARRAY,
138 GDB_VARIABLE,
139 GDB_ASSIGNMENT
140 };
141
142 /* Forward declarations. */
143
144 static void write_lower_upper_value (enum exp_opcode, struct type *);
145 static enum ch_terminal match_bitstring_literal (void);
146 static enum ch_terminal match_integer_literal (void);
147 static enum ch_terminal match_character_literal (void);
148 static enum ch_terminal match_string_literal (void);
149 static enum ch_terminal match_float_literal (void);
150 static enum ch_terminal match_float_literal (void);
151 static int decode_integer_literal (LONGEST *, char **);
152 static int decode_integer_value (int, char **, LONGEST *);
153 static char *match_simple_name_string (void);
154 static void growbuf_by_size (int);
155 static void parse_untyped_expr (void);
156 static void parse_if_expression (void);
157 static void parse_else_alternative (void);
158 static void parse_then_alternative (void);
159 static void parse_expr (void);
160 static void parse_operand0 (void);
161 static void parse_operand1 (void);
162 static void parse_operand2 (void);
163 static void parse_operand3 (void);
164 static void parse_operand4 (void);
165 static void parse_operand5 (void);
166 static void parse_operand6 (void);
167 static void parse_primval (void);
168 static void parse_tuple (struct type *);
169 static void parse_opt_element_list (struct type *);
170 static void parse_tuple_element (struct type *);
171 static void parse_named_record_element (void);
172 static void parse_call (void);
173 static struct type *parse_mode_or_normal_call (void);
174 #if 0
175 static struct type *parse_mode_call (void);
176 #endif
177 static void parse_unary_call (void);
178 static int parse_opt_untyped_expr (void);
179 static void parse_case_label (void);
180 static int expect (enum ch_terminal, char *);
181 static void parse_expr (void);
182 static void parse_primval (void);
183 static void parse_untyped_expr (void);
184 static int parse_opt_untyped_expr (void);
185 static void parse_if_expression_body (void);
186 static enum ch_terminal ch_lex (void);
187 INLINE static enum ch_terminal PEEK_TOKEN (void);
188 static enum ch_terminal peek_token_ (int);
189 static void forward_token_ (void);
190 static void require (enum ch_terminal);
191 static int check_token (enum ch_terminal);
192
193 #define MAX_LOOK_AHEAD 2
194 static enum ch_terminal terminal_buffer[MAX_LOOK_AHEAD + 1] =
195 {
196 TOKEN_NOT_READ, TOKEN_NOT_READ, TOKEN_NOT_READ};
197 static YYSTYPE yylval;
198 static YYSTYPE val_buffer[MAX_LOOK_AHEAD + 1];
199
200 /*int current_token, lookahead_token; */
201
202 INLINE static enum ch_terminal
203 PEEK_TOKEN (void)
204 {
205 if (terminal_buffer[0] == TOKEN_NOT_READ)
206 {
207 terminal_buffer[0] = ch_lex ();
208 val_buffer[0] = yylval;
209 }
210 return terminal_buffer[0];
211 }
212 #define PEEK_LVAL() val_buffer[0]
213 #define PEEK_TOKEN1() peek_token_(1)
214 #define PEEK_TOKEN2() peek_token_(2)
215 static enum ch_terminal
216 peek_token_ (int i)
217 {
218 if (i > MAX_LOOK_AHEAD)
219 internal_error (__FILE__, __LINE__,
220 "too much lookahead");
221 if (terminal_buffer[i] == TOKEN_NOT_READ)
222 {
223 terminal_buffer[i] = ch_lex ();
224 val_buffer[i] = yylval;
225 }
226 return terminal_buffer[i];
227 }
228
229 #if 0
230
231 static void
232 pushback_token (enum ch_terminal code, YYSTYPE node)
233 {
234 int i;
235 if (terminal_buffer[MAX_LOOK_AHEAD] != TOKEN_NOT_READ)
236 internal_error (__FILE__, __LINE__,
237 "cannot pushback token");
238 for (i = MAX_LOOK_AHEAD; i > 0; i--)
239 {
240 terminal_buffer[i] = terminal_buffer[i - 1];
241 val_buffer[i] = val_buffer[i - 1];
242 }
243 terminal_buffer[0] = code;
244 val_buffer[0] = node;
245 }
246
247 #endif
248
249 static void
250 forward_token_ (void)
251 {
252 int i;
253 for (i = 0; i < MAX_LOOK_AHEAD; i++)
254 {
255 terminal_buffer[i] = terminal_buffer[i + 1];
256 val_buffer[i] = val_buffer[i + 1];
257 }
258 terminal_buffer[MAX_LOOK_AHEAD] = TOKEN_NOT_READ;
259 }
260 #define FORWARD_TOKEN() forward_token_()
261
262 /* Skip the next token.
263 if it isn't TOKEN, the parser is broken. */
264
265 static void
266 require (enum ch_terminal token)
267 {
268 if (PEEK_TOKEN () != token)
269 {
270 internal_error (__FILE__, __LINE__,
271 "expected token %d", (int) token);
272 }
273 FORWARD_TOKEN ();
274 }
275
276 static int
277 check_token (enum ch_terminal token)
278 {
279 if (PEEK_TOKEN () != token)
280 return 0;
281 FORWARD_TOKEN ();
282 return 1;
283 }
284
285 /* return 0 if expected token was not found,
286 else return 1.
287 */
288 static int
289 expect (enum ch_terminal token, char *message)
290 {
291 if (PEEK_TOKEN () != token)
292 {
293 if (message)
294 error (message);
295 else if (token < 256)
296 error ("syntax error - expected a '%c' here \"%s\"", token, lexptr);
297 else
298 error ("syntax error");
299 return 0;
300 }
301 else
302 FORWARD_TOKEN ();
303 return 1;
304 }
305
306 #if 0
307 /* Parse a name string. If ALLOW_ALL is 1, ALL is allowed as a postfix. */
308
309 static tree
310 parse_opt_name_string (int allow_all)
311 {
312 int token = PEEK_TOKEN ();
313 tree name;
314 if (token != NAME)
315 {
316 if (token == ALL && allow_all)
317 {
318 FORWARD_TOKEN ();
319 return ALL_POSTFIX;
320 }
321 return NULL_TREE;
322 }
323 name = PEEK_LVAL ();
324 for (;;)
325 {
326 FORWARD_TOKEN ();
327 token = PEEK_TOKEN ();
328 if (token != '!')
329 return name;
330 FORWARD_TOKEN ();
331 token = PEEK_TOKEN ();
332 if (token == ALL && allow_all)
333 return get_identifier3 (IDENTIFIER_POINTER (name), "!", "*");
334 if (token != NAME)
335 {
336 if (pass == 1)
337 error ("'%s!' is not followed by an identifier",
338 IDENTIFIER_POINTER (name));
339 return name;
340 }
341 name = get_identifier3 (IDENTIFIER_POINTER (name),
342 "!", IDENTIFIER_POINTER (PEEK_LVAL ()));
343 }
344 }
345
346 static tree
347 parse_simple_name_string (void)
348 {
349 int token = PEEK_TOKEN ();
350 tree name;
351 if (token != NAME)
352 {
353 error ("expected a name here");
354 return error_mark_node;
355 }
356 name = PEEK_LVAL ();
357 FORWARD_TOKEN ();
358 return name;
359 }
360
361 static tree
362 parse_name_string (void)
363 {
364 tree name = parse_opt_name_string (0);
365 if (name)
366 return name;
367 if (pass == 1)
368 error ("expected a name string here");
369 return error_mark_node;
370 }
371
372 /* Matches: <name_string>
373 Returns if pass 1: the identifier.
374 Returns if pass 2: a decl or value for identifier. */
375
376 static tree
377 parse_name (void)
378 {
379 tree name = parse_name_string ();
380 if (pass == 1 || ignoring)
381 return name;
382 else
383 {
384 tree decl = lookup_name (name);
385 if (decl == NULL_TREE)
386 {
387 error ("`%s' undeclared", IDENTIFIER_POINTER (name));
388 return error_mark_node;
389 }
390 else if (TREE_CODE (TREE_TYPE (decl)) == ERROR_MARK)
391 return error_mark_node;
392 else if (TREE_CODE (decl) == CONST_DECL)
393 return DECL_INITIAL (decl);
394 else if (TREE_CODE (TREE_TYPE (decl)) == REFERENCE_TYPE)
395 return convert_from_reference (decl);
396 else
397 return decl;
398 }
399 }
400 #endif
401
402 #if 0
403 static void
404 pushback_paren_expr (tree expr)
405 {
406 if (pass == 1 && !ignoring)
407 expr = build1 (PAREN_EXPR, NULL_TREE, expr);
408 pushback_token (EXPR, expr);
409 }
410 #endif
411
412 /* Matches: <case label> */
413
414 static void
415 parse_case_label (void)
416 {
417 if (check_token (ELSE))
418 error ("ELSE in tuples labels not implemented");
419 /* Does not handle the case of a mode name. FIXME */
420 parse_expr ();
421 if (check_token (':'))
422 {
423 parse_expr ();
424 write_exp_elt_opcode (BINOP_RANGE);
425 }
426 }
427
428 static int
429 parse_opt_untyped_expr (void)
430 {
431 switch (PEEK_TOKEN ())
432 {
433 case ',':
434 case ':':
435 case ')':
436 return 0;
437 default:
438 parse_untyped_expr ();
439 return 1;
440 }
441 }
442
443 static void
444 parse_unary_call (void)
445 {
446 FORWARD_TOKEN ();
447 expect ('(', NULL);
448 parse_expr ();
449 expect (')', NULL);
450 }
451
452 /* Parse NAME '(' MODENAME ')'. */
453
454 #if 0
455
456 static struct type *
457 parse_mode_call (void)
458 {
459 struct type *type;
460 FORWARD_TOKEN ();
461 expect ('(', NULL);
462 if (PEEK_TOKEN () != TYPENAME)
463 error ("expect MODENAME here `%s'", lexptr);
464 type = PEEK_LVAL ().tsym.type;
465 FORWARD_TOKEN ();
466 expect (')', NULL);
467 return type;
468 }
469
470 #endif
471
472 static struct type *
473 parse_mode_or_normal_call (void)
474 {
475 struct type *type;
476 FORWARD_TOKEN ();
477 expect ('(', NULL);
478 if (PEEK_TOKEN () == TYPENAME)
479 {
480 type = PEEK_LVAL ().tsym.type;
481 FORWARD_TOKEN ();
482 }
483 else
484 {
485 parse_expr ();
486 type = NULL;
487 }
488 expect (')', NULL);
489 return type;
490 }
491
492 /* Parse something that looks like a function call.
493 Assume we have parsed the function, and are at the '('. */
494
495 static void
496 parse_call (void)
497 {
498 int arg_count;
499 require ('(');
500 /* This is to save the value of arglist_len
501 being accumulated for each dimension. */
502 start_arglist ();
503 if (parse_opt_untyped_expr ())
504 {
505 int tok = PEEK_TOKEN ();
506 arglist_len = 1;
507 if (tok == UP || tok == ':')
508 {
509 FORWARD_TOKEN ();
510 parse_expr ();
511 expect (')', "expected ')' to terminate slice");
512 end_arglist ();
513 write_exp_elt_opcode (tok == UP ? TERNOP_SLICE_COUNT
514 : TERNOP_SLICE);
515 return;
516 }
517 while (check_token (','))
518 {
519 parse_untyped_expr ();
520 arglist_len++;
521 }
522 }
523 else
524 arglist_len = 0;
525 expect (')', NULL);
526 arg_count = end_arglist ();
527 write_exp_elt_opcode (MULTI_SUBSCRIPT);
528 write_exp_elt_longcst (arg_count);
529 write_exp_elt_opcode (MULTI_SUBSCRIPT);
530 }
531
532 static void
533 parse_named_record_element (void)
534 {
535 struct stoken label;
536 char buf[256];
537
538 label = PEEK_LVAL ().sval;
539 sprintf (buf, "expected a field name here `%s'", lexptr);
540 expect (DOT_FIELD_NAME, buf);
541 if (check_token (','))
542 parse_named_record_element ();
543 else if (check_token (':'))
544 parse_expr ();
545 else
546 error ("syntax error near `%s' in named record tuple element", lexptr);
547 write_exp_elt_opcode (OP_LABELED);
548 write_exp_string (label);
549 write_exp_elt_opcode (OP_LABELED);
550 }
551
552 /* Returns one or more TREE_LIST nodes, in reverse order. */
553
554 static void
555 parse_tuple_element (struct type *type)
556 {
557 if (PEEK_TOKEN () == DOT_FIELD_NAME)
558 {
559 /* Parse a labelled structure tuple. */
560 parse_named_record_element ();
561 return;
562 }
563
564 if (check_token ('('))
565 {
566 if (check_token ('*'))
567 {
568 expect (')', "missing ')' after '*' case label list");
569 if (type)
570 {
571 if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
572 {
573 /* do this as a range from low to high */
574 struct type *range_type = TYPE_FIELD_TYPE (type, 0);
575 LONGEST low_bound, high_bound;
576 if (get_discrete_bounds (range_type, &low_bound, &high_bound) < 0)
577 error ("cannot determine bounds for (*)");
578 /* lower bound */
579 write_exp_elt_opcode (OP_LONG);
580 write_exp_elt_type (range_type);
581 write_exp_elt_longcst (low_bound);
582 write_exp_elt_opcode (OP_LONG);
583 /* upper bound */
584 write_exp_elt_opcode (OP_LONG);
585 write_exp_elt_type (range_type);
586 write_exp_elt_longcst (high_bound);
587 write_exp_elt_opcode (OP_LONG);
588 write_exp_elt_opcode (BINOP_RANGE);
589 }
590 else
591 error ("(*) in invalid context");
592 }
593 else
594 error ("(*) only possible with modename in front of tuple (mode[..])");
595 }
596 else
597 {
598 parse_case_label ();
599 while (check_token (','))
600 {
601 parse_case_label ();
602 write_exp_elt_opcode (BINOP_COMMA);
603 }
604 expect (')', NULL);
605 }
606 }
607 else
608 parse_untyped_expr ();
609 if (check_token (':'))
610 {
611 /* A powerset range or a labeled Array. */
612 parse_untyped_expr ();
613 write_exp_elt_opcode (BINOP_RANGE);
614 }
615 }
616
617 /* Matches: a COMMA-separated list of tuple elements.
618 Returns a list (of TREE_LIST nodes). */
619 static void
620 parse_opt_element_list (struct type *type)
621 {
622 arglist_len = 0;
623 if (PEEK_TOKEN () == ']')
624 return;
625 for (;;)
626 {
627 parse_tuple_element (type);
628 arglist_len++;
629 if (PEEK_TOKEN () == ']')
630 break;
631 if (!check_token (','))
632 error ("bad syntax in tuple");
633 }
634 }
635
636 /* Parses: '[' elements ']'
637 If modename is non-NULL it prefixed the tuple. */
638
639 static void
640 parse_tuple (struct type *mode)
641 {
642 struct type *type;
643 if (mode)
644 type = check_typedef (mode);
645 else
646 type = 0;
647 require ('[');
648 start_arglist ();
649 parse_opt_element_list (type);
650 expect (']', "missing ']' after tuple");
651 write_exp_elt_opcode (OP_ARRAY);
652 write_exp_elt_longcst ((LONGEST) 0);
653 write_exp_elt_longcst ((LONGEST) end_arglist () - 1);
654 write_exp_elt_opcode (OP_ARRAY);
655 if (type)
656 {
657 if (TYPE_CODE (type) != TYPE_CODE_ARRAY
658 && TYPE_CODE (type) != TYPE_CODE_STRUCT
659 && TYPE_CODE (type) != TYPE_CODE_SET)
660 error ("invalid tuple mode");
661 write_exp_elt_opcode (UNOP_CAST);
662 write_exp_elt_type (mode);
663 write_exp_elt_opcode (UNOP_CAST);
664 }
665 }
666
667 static void
668 parse_primval (void)
669 {
670 struct type *type;
671 enum exp_opcode op;
672 char *op_name;
673 switch (PEEK_TOKEN ())
674 {
675 case INTEGER_LITERAL:
676 case CHARACTER_LITERAL:
677 write_exp_elt_opcode (OP_LONG);
678 write_exp_elt_type (PEEK_LVAL ().typed_val.type);
679 write_exp_elt_longcst (PEEK_LVAL ().typed_val.val);
680 write_exp_elt_opcode (OP_LONG);
681 FORWARD_TOKEN ();
682 break;
683 case BOOLEAN_LITERAL:
684 write_exp_elt_opcode (OP_BOOL);
685 write_exp_elt_longcst ((LONGEST) PEEK_LVAL ().ulval);
686 write_exp_elt_opcode (OP_BOOL);
687 FORWARD_TOKEN ();
688 break;
689 case FLOAT_LITERAL:
690 write_exp_elt_opcode (OP_DOUBLE);
691 write_exp_elt_type (builtin_type_double);
692 write_exp_elt_dblcst (PEEK_LVAL ().dval);
693 write_exp_elt_opcode (OP_DOUBLE);
694 FORWARD_TOKEN ();
695 break;
696 case EMPTINESS_LITERAL:
697 write_exp_elt_opcode (OP_LONG);
698 write_exp_elt_type (lookup_pointer_type (builtin_type_void));
699 write_exp_elt_longcst (0);
700 write_exp_elt_opcode (OP_LONG);
701 FORWARD_TOKEN ();
702 break;
703 case CHARACTER_STRING_LITERAL:
704 write_exp_elt_opcode (OP_STRING);
705 write_exp_string (PEEK_LVAL ().sval);
706 write_exp_elt_opcode (OP_STRING);
707 FORWARD_TOKEN ();
708 break;
709 case BIT_STRING_LITERAL:
710 write_exp_elt_opcode (OP_BITSTRING);
711 write_exp_bitstring (PEEK_LVAL ().sval);
712 write_exp_elt_opcode (OP_BITSTRING);
713 FORWARD_TOKEN ();
714 break;
715 case ARRAY:
716 FORWARD_TOKEN ();
717 /* This is pseudo-Chill, similar to C's '(TYPE[])EXPR'
718 which casts to an artificial array. */
719 expect ('(', NULL);
720 expect (')', NULL);
721 if (PEEK_TOKEN () != TYPENAME)
722 error ("missing MODENAME after ARRAY()");
723 type = PEEK_LVAL ().tsym.type;
724 FORWARD_TOKEN ();
725 expect ('(', NULL);
726 parse_expr ();
727 expect (')', "missing right parenthesis");
728 type = create_array_type ((struct type *) NULL, type,
729 create_range_type ((struct type *) NULL,
730 builtin_type_int, 0, 0));
731 TYPE_ARRAY_UPPER_BOUND_TYPE (type) = BOUND_CANNOT_BE_DETERMINED;
732 write_exp_elt_opcode (UNOP_CAST);
733 write_exp_elt_type (type);
734 write_exp_elt_opcode (UNOP_CAST);
735 break;
736 #if 0
737 case CONST:
738 case EXPR:
739 val = PEEK_LVAL ();
740 FORWARD_TOKEN ();
741 break;
742 #endif
743 case '(':
744 FORWARD_TOKEN ();
745 parse_expr ();
746 expect (')', "missing right parenthesis");
747 break;
748 case '[':
749 parse_tuple (NULL);
750 break;
751 case GENERAL_PROCEDURE_NAME:
752 case LOCATION_NAME:
753 write_exp_elt_opcode (OP_VAR_VALUE);
754 write_exp_elt_block (NULL);
755 write_exp_elt_sym (PEEK_LVAL ().ssym.sym);
756 write_exp_elt_opcode (OP_VAR_VALUE);
757 FORWARD_TOKEN ();
758 break;
759 case GDB_VARIABLE: /* gdb specific */
760 FORWARD_TOKEN ();
761 break;
762 case NUM:
763 parse_unary_call ();
764 write_exp_elt_opcode (UNOP_CAST);
765 write_exp_elt_type (builtin_type_int);
766 write_exp_elt_opcode (UNOP_CAST);
767 break;
768 case CARD:
769 parse_unary_call ();
770 write_exp_elt_opcode (UNOP_CARD);
771 break;
772 case MAX_TOKEN:
773 parse_unary_call ();
774 write_exp_elt_opcode (UNOP_CHMAX);
775 break;
776 case MIN_TOKEN:
777 parse_unary_call ();
778 write_exp_elt_opcode (UNOP_CHMIN);
779 break;
780 case PRED:
781 op_name = "PRED";
782 goto unimplemented_unary_builtin;
783 case SUCC:
784 op_name = "SUCC";
785 goto unimplemented_unary_builtin;
786 case ABS:
787 op_name = "ABS";
788 goto unimplemented_unary_builtin;
789 unimplemented_unary_builtin:
790 parse_unary_call ();
791 error ("not implemented: %s builtin function", op_name);
792 break;
793 case ADDR_TOKEN:
794 parse_unary_call ();
795 write_exp_elt_opcode (UNOP_ADDR);
796 break;
797 case SIZE:
798 type = parse_mode_or_normal_call ();
799 if (type)
800 {
801 write_exp_elt_opcode (OP_LONG);
802 write_exp_elt_type (builtin_type_int);
803 CHECK_TYPEDEF (type);
804 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH (type));
805 write_exp_elt_opcode (OP_LONG);
806 }
807 else
808 write_exp_elt_opcode (UNOP_SIZEOF);
809 break;
810 case LOWER:
811 op = UNOP_LOWER;
812 goto lower_upper;
813 case UPPER:
814 op = UNOP_UPPER;
815 goto lower_upper;
816 lower_upper:
817 type = parse_mode_or_normal_call ();
818 write_lower_upper_value (op, type);
819 break;
820 case LENGTH:
821 parse_unary_call ();
822 write_exp_elt_opcode (UNOP_LENGTH);
823 break;
824 case TYPENAME:
825 type = PEEK_LVAL ().tsym.type;
826 FORWARD_TOKEN ();
827 switch (PEEK_TOKEN ())
828 {
829 case '[':
830 parse_tuple (type);
831 break;
832 case '(':
833 FORWARD_TOKEN ();
834 parse_expr ();
835 expect (')', "missing right parenthesis");
836 write_exp_elt_opcode (UNOP_CAST);
837 write_exp_elt_type (type);
838 write_exp_elt_opcode (UNOP_CAST);
839 break;
840 default:
841 error ("typename in invalid context");
842 }
843 break;
844
845 default:
846 error ("invalid expression syntax at `%s'", lexptr);
847 }
848 for (;;)
849 {
850 switch (PEEK_TOKEN ())
851 {
852 case DOT_FIELD_NAME:
853 write_exp_elt_opcode (STRUCTOP_STRUCT);
854 write_exp_string (PEEK_LVAL ().sval);
855 write_exp_elt_opcode (STRUCTOP_STRUCT);
856 FORWARD_TOKEN ();
857 continue;
858 case POINTER:
859 FORWARD_TOKEN ();
860 if (PEEK_TOKEN () == TYPENAME)
861 {
862 type = PEEK_LVAL ().tsym.type;
863 write_exp_elt_opcode (UNOP_CAST);
864 write_exp_elt_type (lookup_pointer_type (type));
865 write_exp_elt_opcode (UNOP_CAST);
866 FORWARD_TOKEN ();
867 }
868 write_exp_elt_opcode (UNOP_IND);
869 continue;
870 case OPEN_PAREN:
871 parse_call ();
872 continue;
873 case CHARACTER_STRING_LITERAL:
874 case CHARACTER_LITERAL:
875 case BIT_STRING_LITERAL:
876 /* Handle string repetition. (See comment in parse_operand5.) */
877 parse_primval ();
878 write_exp_elt_opcode (MULTI_SUBSCRIPT);
879 write_exp_elt_longcst (1);
880 write_exp_elt_opcode (MULTI_SUBSCRIPT);
881 continue;
882 case END_TOKEN:
883 case TOKEN_NOT_READ:
884 case INTEGER_LITERAL:
885 case BOOLEAN_LITERAL:
886 case FLOAT_LITERAL:
887 case GENERAL_PROCEDURE_NAME:
888 case LOCATION_NAME:
889 case EMPTINESS_LITERAL:
890 case TYPENAME:
891 case CASE:
892 case OF:
893 case ESAC:
894 case LOGIOR:
895 case ORIF:
896 case LOGXOR:
897 case LOGAND:
898 case ANDIF:
899 case NOTEQUAL:
900 case GEQ:
901 case LEQ:
902 case IN:
903 case SLASH_SLASH:
904 case MOD:
905 case REM:
906 case NOT:
907 case RECEIVE:
908 case UP:
909 case IF:
910 case THEN:
911 case ELSE:
912 case FI:
913 case ELSIF:
914 case ILLEGAL_TOKEN:
915 case NUM:
916 case PRED:
917 case SUCC:
918 case ABS:
919 case CARD:
920 case MAX_TOKEN:
921 case MIN_TOKEN:
922 case ADDR_TOKEN:
923 case SIZE:
924 case UPPER:
925 case LOWER:
926 case LENGTH:
927 case ARRAY:
928 case GDB_VARIABLE:
929 case GDB_ASSIGNMENT:
930 break;
931 }
932 break;
933 }
934 return;
935 }
936
937 static void
938 parse_operand6 (void)
939 {
940 if (check_token (RECEIVE))
941 {
942 parse_primval ();
943 error ("not implemented: RECEIVE expression");
944 }
945 else if (check_token (POINTER))
946 {
947 parse_primval ();
948 write_exp_elt_opcode (UNOP_ADDR);
949 }
950 else
951 parse_primval ();
952 }
953
954 static void
955 parse_operand5 (void)
956 {
957 enum exp_opcode op;
958 /* We are supposed to be looking for a <string repetition operator>,
959 but in general we can't distinguish that from a parenthesized
960 expression. This is especially difficult if we allow the
961 string operand to be a constant expression (as requested by
962 some users), and not just a string literal.
963 Consider: LPRN expr RPRN LPRN expr RPRN
964 Is that a function call or string repetition?
965 Instead, we handle string repetition in parse_primval,
966 and build_generalized_call. */
967 switch (PEEK_TOKEN ())
968 {
969 case NOT:
970 op = UNOP_LOGICAL_NOT;
971 break;
972 case '-':
973 op = UNOP_NEG;
974 break;
975 default:
976 op = OP_NULL;
977 }
978 if (op != OP_NULL)
979 FORWARD_TOKEN ();
980 parse_operand6 ();
981 if (op != OP_NULL)
982 write_exp_elt_opcode (op);
983 }
984
985 static void
986 parse_operand4 (void)
987 {
988 enum exp_opcode op;
989 parse_operand5 ();
990 for (;;)
991 {
992 switch (PEEK_TOKEN ())
993 {
994 case '*':
995 op = BINOP_MUL;
996 break;
997 case '/':
998 op = BINOP_DIV;
999 break;
1000 case MOD:
1001 op = BINOP_MOD;
1002 break;
1003 case REM:
1004 op = BINOP_REM;
1005 break;
1006 default:
1007 return;
1008 }
1009 FORWARD_TOKEN ();
1010 parse_operand5 ();
1011 write_exp_elt_opcode (op);
1012 }
1013 }
1014
1015 static void
1016 parse_operand3 (void)
1017 {
1018 enum exp_opcode op;
1019 parse_operand4 ();
1020 for (;;)
1021 {
1022 switch (PEEK_TOKEN ())
1023 {
1024 case '+':
1025 op = BINOP_ADD;
1026 break;
1027 case '-':
1028 op = BINOP_SUB;
1029 break;
1030 case SLASH_SLASH:
1031 op = BINOP_CONCAT;
1032 break;
1033 default:
1034 return;
1035 }
1036 FORWARD_TOKEN ();
1037 parse_operand4 ();
1038 write_exp_elt_opcode (op);
1039 }
1040 }
1041
1042 static void
1043 parse_operand2 (void)
1044 {
1045 enum exp_opcode op;
1046 parse_operand3 ();
1047 for (;;)
1048 {
1049 if (check_token (IN))
1050 {
1051 parse_operand3 ();
1052 write_exp_elt_opcode (BINOP_IN);
1053 }
1054 else
1055 {
1056 switch (PEEK_TOKEN ())
1057 {
1058 case '>':
1059 op = BINOP_GTR;
1060 break;
1061 case GEQ:
1062 op = BINOP_GEQ;
1063 break;
1064 case '<':
1065 op = BINOP_LESS;
1066 break;
1067 case LEQ:
1068 op = BINOP_LEQ;
1069 break;
1070 case '=':
1071 op = BINOP_EQUAL;
1072 break;
1073 case NOTEQUAL:
1074 op = BINOP_NOTEQUAL;
1075 break;
1076 default:
1077 return;
1078 }
1079 FORWARD_TOKEN ();
1080 parse_operand3 ();
1081 write_exp_elt_opcode (op);
1082 }
1083 }
1084 }
1085
1086 static void
1087 parse_operand1 (void)
1088 {
1089 enum exp_opcode op;
1090 parse_operand2 ();
1091 for (;;)
1092 {
1093 switch (PEEK_TOKEN ())
1094 {
1095 case LOGAND:
1096 op = BINOP_BITWISE_AND;
1097 break;
1098 case ANDIF:
1099 op = BINOP_LOGICAL_AND;
1100 break;
1101 default:
1102 return;
1103 }
1104 FORWARD_TOKEN ();
1105 parse_operand2 ();
1106 write_exp_elt_opcode (op);
1107 }
1108 }
1109
1110 static void
1111 parse_operand0 (void)
1112 {
1113 enum exp_opcode op;
1114 parse_operand1 ();
1115 for (;;)
1116 {
1117 switch (PEEK_TOKEN ())
1118 {
1119 case LOGIOR:
1120 op = BINOP_BITWISE_IOR;
1121 break;
1122 case LOGXOR:
1123 op = BINOP_BITWISE_XOR;
1124 break;
1125 case ORIF:
1126 op = BINOP_LOGICAL_OR;
1127 break;
1128 default:
1129 return;
1130 }
1131 FORWARD_TOKEN ();
1132 parse_operand1 ();
1133 write_exp_elt_opcode (op);
1134 }
1135 }
1136
1137 static void
1138 parse_expr (void)
1139 {
1140 parse_operand0 ();
1141 if (check_token (GDB_ASSIGNMENT))
1142 {
1143 parse_expr ();
1144 write_exp_elt_opcode (BINOP_ASSIGN);
1145 }
1146 }
1147
1148 static void
1149 parse_then_alternative (void)
1150 {
1151 expect (THEN, "missing 'THEN' in 'IF' expression");
1152 parse_expr ();
1153 }
1154
1155 static void
1156 parse_else_alternative (void)
1157 {
1158 if (check_token (ELSIF))
1159 parse_if_expression_body ();
1160 else if (check_token (ELSE))
1161 parse_expr ();
1162 else
1163 error ("missing ELSE/ELSIF in IF expression");
1164 }
1165
1166 /* Matches: <boolean expression> <then alternative> <else alternative> */
1167
1168 static void
1169 parse_if_expression_body (void)
1170 {
1171 parse_expr ();
1172 parse_then_alternative ();
1173 parse_else_alternative ();
1174 write_exp_elt_opcode (TERNOP_COND);
1175 }
1176
1177 static void
1178 parse_if_expression (void)
1179 {
1180 require (IF);
1181 parse_if_expression_body ();
1182 expect (FI, "missing 'FI' at end of conditional expression");
1183 }
1184
1185 /* An <untyped_expr> is a superset of <expr>. It also includes
1186 <conditional expressions> and untyped <tuples>, whose types
1187 are not given by their constituents. Hence, these are only
1188 allowed in certain contexts that expect a certain type.
1189 You should call convert() to fix up the <untyped_expr>. */
1190
1191 static void
1192 parse_untyped_expr (void)
1193 {
1194 switch (PEEK_TOKEN ())
1195 {
1196 case IF:
1197 parse_if_expression ();
1198 return;
1199 case CASE:
1200 error ("not implemented: CASE expression");
1201 case '(':
1202 switch (PEEK_TOKEN1 ())
1203 {
1204 case IF:
1205 case CASE:
1206 goto skip_lprn;
1207 case '[':
1208 skip_lprn:
1209 FORWARD_TOKEN ();
1210 parse_untyped_expr ();
1211 expect (')', "missing ')'");
1212 return;
1213 default:;
1214 /* fall through */
1215 }
1216 default:
1217 parse_operand0 ();
1218 }
1219 }
1220
1221 int
1222 chill_parse (void)
1223 {
1224 terminal_buffer[0] = TOKEN_NOT_READ;
1225 if (PEEK_TOKEN () == TYPENAME && PEEK_TOKEN1 () == END_TOKEN)
1226 {
1227 write_exp_elt_opcode (OP_TYPE);
1228 write_exp_elt_type (PEEK_LVAL ().tsym.type);
1229 write_exp_elt_opcode (OP_TYPE);
1230 FORWARD_TOKEN ();
1231 }
1232 else
1233 parse_expr ();
1234 if (terminal_buffer[0] != END_TOKEN)
1235 {
1236 if (comma_terminates && terminal_buffer[0] == ',')
1237 lexptr--; /* Put the comma back. */
1238 else
1239 error ("Junk after end of expression.");
1240 }
1241 return 0;
1242 }
1243
1244
1245 /* Implementation of a dynamically expandable buffer for processing input
1246 characters acquired through lexptr and building a value to return in
1247 yylval. */
1248
1249 static char *tempbuf; /* Current buffer contents */
1250 static int tempbufsize; /* Size of allocated buffer */
1251 static int tempbufindex; /* Current index into buffer */
1252
1253 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1254
1255 #define CHECKBUF(size) \
1256 do { \
1257 if (tempbufindex + (size) >= tempbufsize) \
1258 { \
1259 growbuf_by_size (size); \
1260 } \
1261 } while (0);
1262
1263 /* Grow the static temp buffer if necessary, including allocating the first one
1264 on demand. */
1265
1266 static void
1267 growbuf_by_size (int count)
1268 {
1269 int growby;
1270
1271 growby = max (count, GROWBY_MIN_SIZE);
1272 tempbufsize += growby;
1273 if (tempbuf == NULL)
1274 {
1275 tempbuf = (char *) xmalloc (tempbufsize);
1276 }
1277 else
1278 {
1279 tempbuf = (char *) xrealloc (tempbuf, tempbufsize);
1280 }
1281 }
1282
1283 /* Try to consume a simple name string token. If successful, returns
1284 a pointer to a nullbyte terminated copy of the name that can be used
1285 in symbol table lookups. If not successful, returns NULL. */
1286
1287 static char *
1288 match_simple_name_string (void)
1289 {
1290 char *tokptr = lexptr;
1291
1292 if (isalpha (*tokptr) || *tokptr == '_')
1293 {
1294 char *result;
1295 do
1296 {
1297 tokptr++;
1298 }
1299 while (isalnum (*tokptr) || (*tokptr == '_'));
1300 yylval.sval.ptr = lexptr;
1301 yylval.sval.length = tokptr - lexptr;
1302 lexptr = tokptr;
1303 result = copy_name (yylval.sval);
1304 return result;
1305 }
1306 return (NULL);
1307 }
1308
1309 /* Start looking for a value composed of valid digits as set by the base
1310 in use. Note that '_' characters are valid anywhere, in any quantity,
1311 and are simply ignored. Since we must find at least one valid digit,
1312 or reject this token as an integer literal, we keep track of how many
1313 digits we have encountered. */
1314
1315 static int
1316 decode_integer_value (int base, char **tokptrptr, LONGEST *ivalptr)
1317 {
1318 char *tokptr = *tokptrptr;
1319 int temp;
1320 int digits = 0;
1321
1322 while (*tokptr != '\0')
1323 {
1324 temp = *tokptr;
1325 if (isupper (temp))
1326 temp = tolower (temp);
1327 tokptr++;
1328 switch (temp)
1329 {
1330 case '_':
1331 continue;
1332 case '0':
1333 case '1':
1334 case '2':
1335 case '3':
1336 case '4':
1337 case '5':
1338 case '6':
1339 case '7':
1340 case '8':
1341 case '9':
1342 temp -= '0';
1343 break;
1344 case 'a':
1345 case 'b':
1346 case 'c':
1347 case 'd':
1348 case 'e':
1349 case 'f':
1350 temp -= 'a';
1351 temp += 10;
1352 break;
1353 default:
1354 temp = base;
1355 break;
1356 }
1357 if (temp < base)
1358 {
1359 digits++;
1360 *ivalptr *= base;
1361 *ivalptr += temp;
1362 }
1363 else
1364 {
1365 /* Found something not in domain for current base. */
1366 tokptr--; /* Unconsume what gave us indigestion. */
1367 break;
1368 }
1369 }
1370
1371 /* If we didn't find any digits, then we don't have a valid integer
1372 value, so reject the entire token. Otherwise, update the lexical
1373 scan pointer, and return non-zero for success. */
1374
1375 if (digits == 0)
1376 {
1377 return (0);
1378 }
1379 else
1380 {
1381 *tokptrptr = tokptr;
1382 return (1);
1383 }
1384 }
1385
1386 static int
1387 decode_integer_literal (LONGEST *valptr, char **tokptrptr)
1388 {
1389 char *tokptr = *tokptrptr;
1390 int base = 0;
1391 LONGEST ival = 0;
1392 int explicit_base = 0;
1393
1394 /* Look for an explicit base specifier, which is optional. */
1395
1396 switch (*tokptr)
1397 {
1398 case 'd':
1399 case 'D':
1400 explicit_base++;
1401 base = 10;
1402 tokptr++;
1403 break;
1404 case 'b':
1405 case 'B':
1406 explicit_base++;
1407 base = 2;
1408 tokptr++;
1409 break;
1410 case 'h':
1411 case 'H':
1412 explicit_base++;
1413 base = 16;
1414 tokptr++;
1415 break;
1416 case 'o':
1417 case 'O':
1418 explicit_base++;
1419 base = 8;
1420 tokptr++;
1421 break;
1422 default:
1423 base = 10;
1424 break;
1425 }
1426
1427 /* If we found an explicit base ensure that the character after the
1428 explicit base is a single quote. */
1429
1430 if (explicit_base && (*tokptr++ != '\''))
1431 {
1432 return (0);
1433 }
1434
1435 /* Attempt to decode whatever follows as an integer value in the
1436 indicated base, updating the token pointer in the process and
1437 computing the value into ival. Also, if we have an explicit
1438 base, then the next character must not be a single quote, or we
1439 have a bitstring literal, so reject the entire token in this case.
1440 Otherwise, update the lexical scan pointer, and return non-zero
1441 for success. */
1442
1443 if (!decode_integer_value (base, &tokptr, &ival))
1444 {
1445 return (0);
1446 }
1447 else if (explicit_base && (*tokptr == '\''))
1448 {
1449 return (0);
1450 }
1451 else
1452 {
1453 *valptr = ival;
1454 *tokptrptr = tokptr;
1455 return (1);
1456 }
1457 }
1458
1459 /* If it wasn't for the fact that floating point values can contain '_'
1460 characters, we could just let strtod do all the hard work by letting it
1461 try to consume as much of the current token buffer as possible and
1462 find a legal conversion. Unfortunately we need to filter out the '_'
1463 characters before calling strtod, which we do by copying the other
1464 legal chars to a local buffer to be converted. However since we also
1465 need to keep track of where the last unconsumed character in the input
1466 buffer is, we have transfer only as many characters as may compose a
1467 legal floating point value. */
1468
1469 static enum ch_terminal
1470 match_float_literal (void)
1471 {
1472 char *tokptr = lexptr;
1473 char *buf;
1474 char *copy;
1475 double dval;
1476 extern double strtod ();
1477
1478 /* Make local buffer in which to build the string to convert. This is
1479 required because underscores are valid in chill floating point numbers
1480 but not in the string passed to strtod to convert. The string will be
1481 no longer than our input string. */
1482
1483 copy = buf = (char *) alloca (strlen (tokptr) + 1);
1484
1485 /* Transfer all leading digits to the conversion buffer, discarding any
1486 underscores. */
1487
1488 while (isdigit (*tokptr) || *tokptr == '_')
1489 {
1490 if (*tokptr != '_')
1491 {
1492 *copy++ = *tokptr;
1493 }
1494 tokptr++;
1495 }
1496
1497 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1498 of whether we found any leading digits, and we simply accept it and
1499 continue on to look for the fractional part and/or exponent. One of
1500 [eEdD] is legal only if we have seen digits, and means that there
1501 is no fractional part. If we find neither of these, then this is
1502 not a floating point number, so return failure. */
1503
1504 switch (*tokptr++)
1505 {
1506 case '.':
1507 /* Accept and then look for fractional part and/or exponent. */
1508 *copy++ = '.';
1509 break;
1510
1511 case 'e':
1512 case 'E':
1513 case 'd':
1514 case 'D':
1515 if (copy == buf)
1516 {
1517 return (0);
1518 }
1519 *copy++ = 'e';
1520 goto collect_exponent;
1521 break;
1522
1523 default:
1524 return (0);
1525 break;
1526 }
1527
1528 /* We found a '.', copy any fractional digits to the conversion buffer, up
1529 to the first nondigit, non-underscore character. */
1530
1531 while (isdigit (*tokptr) || *tokptr == '_')
1532 {
1533 if (*tokptr != '_')
1534 {
1535 *copy++ = *tokptr;
1536 }
1537 tokptr++;
1538 }
1539
1540 /* Look for an exponent, which must start with one of [eEdD]. If none
1541 is found, jump directly to trying to convert what we have collected
1542 so far. */
1543
1544 switch (*tokptr)
1545 {
1546 case 'e':
1547 case 'E':
1548 case 'd':
1549 case 'D':
1550 *copy++ = 'e';
1551 tokptr++;
1552 break;
1553 default:
1554 goto convert_float;
1555 break;
1556 }
1557
1558 /* Accept an optional '-' or '+' following one of [eEdD]. */
1559
1560 collect_exponent:
1561 if (*tokptr == '+' || *tokptr == '-')
1562 {
1563 *copy++ = *tokptr++;
1564 }
1565
1566 /* Now copy an exponent into the conversion buffer. Note that at the
1567 moment underscores are *not* allowed in exponents. */
1568
1569 while (isdigit (*tokptr))
1570 {
1571 *copy++ = *tokptr++;
1572 }
1573
1574 /* If we transfered any chars to the conversion buffer, try to interpret its
1575 contents as a floating point value. If any characters remain, then we
1576 must not have a valid floating point string. */
1577
1578 convert_float:
1579 *copy = '\0';
1580 if (copy != buf)
1581 {
1582 dval = strtod (buf, &copy);
1583 if (*copy == '\0')
1584 {
1585 yylval.dval = dval;
1586 lexptr = tokptr;
1587 return (FLOAT_LITERAL);
1588 }
1589 }
1590 return (0);
1591 }
1592
1593 /* Recognize a string literal. A string literal is a sequence
1594 of characters enclosed in matching single or double quotes, except that
1595 a single character inside single quotes is a character literal, which
1596 we reject as a string literal. To embed the terminator character inside
1597 a string, it is simply doubled (I.E. "this""is""one""string") */
1598
1599 static enum ch_terminal
1600 match_string_literal (void)
1601 {
1602 char *tokptr = lexptr;
1603 int in_ctrlseq = 0;
1604 LONGEST ival;
1605
1606 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1607 {
1608 CHECKBUF (1);
1609 tryagain:;
1610 if (in_ctrlseq)
1611 {
1612 /* skip possible whitespaces */
1613 while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
1614 tokptr++;
1615 if (*tokptr == ')')
1616 {
1617 in_ctrlseq = 0;
1618 tokptr++;
1619 goto tryagain;
1620 }
1621 else if (*tokptr != ',')
1622 error ("Invalid control sequence");
1623 tokptr++;
1624 /* skip possible whitespaces */
1625 while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
1626 tokptr++;
1627 if (!decode_integer_literal (&ival, &tokptr))
1628 error ("Invalid control sequence");
1629 tokptr--;
1630 }
1631 else if (*tokptr == *lexptr)
1632 {
1633 if (*(tokptr + 1) == *lexptr)
1634 {
1635 ival = *tokptr++;
1636 }
1637 else
1638 {
1639 break;
1640 }
1641 }
1642 else if (*tokptr == '^')
1643 {
1644 if (*(tokptr + 1) == '(')
1645 {
1646 in_ctrlseq = 1;
1647 tokptr += 2;
1648 if (!decode_integer_literal (&ival, &tokptr))
1649 error ("Invalid control sequence");
1650 tokptr--;
1651 }
1652 else if (*(tokptr + 1) == '^')
1653 ival = *tokptr++;
1654 else
1655 error ("Invalid control sequence");
1656 }
1657 else
1658 ival = *tokptr;
1659 tempbuf[tempbufindex++] = ival;
1660 }
1661 if (in_ctrlseq)
1662 error ("Invalid control sequence");
1663
1664 if (*tokptr == '\0' /* no terminator */
1665 || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
1666 {
1667 return (0);
1668 }
1669 else
1670 {
1671 tempbuf[tempbufindex] = '\0';
1672 yylval.sval.ptr = tempbuf;
1673 yylval.sval.length = tempbufindex;
1674 lexptr = ++tokptr;
1675 return (CHARACTER_STRING_LITERAL);
1676 }
1677 }
1678
1679 /* Recognize a character literal. A character literal is single character
1680 or a control sequence, enclosed in single quotes. A control sequence
1681 is a comma separated list of one or more integer literals, enclosed
1682 in parenthesis and introduced with a circumflex character.
1683
1684 EX: 'a' '^(7)' '^(7,8)'
1685
1686 As a GNU chill extension, the syntax C'xx' is also recognized as a
1687 character literal, where xx is a hex value for the character.
1688
1689 Note that more than a single character, enclosed in single quotes, is
1690 a string literal.
1691
1692 Returns CHARACTER_LITERAL if a match is found.
1693 */
1694
1695 static enum ch_terminal
1696 match_character_literal (void)
1697 {
1698 char *tokptr = lexptr;
1699 LONGEST ival = 0;
1700
1701 if ((*tokptr == 'c' || *tokptr == 'C') && (*(tokptr + 1) == '\''))
1702 {
1703 /* We have a GNU chill extension form, so skip the leading "C'",
1704 decode the hex value, and then ensure that we have a trailing
1705 single quote character. */
1706 tokptr += 2;
1707 if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
1708 {
1709 return (0);
1710 }
1711 tokptr++;
1712 }
1713 else if (*tokptr == '\'')
1714 {
1715 tokptr++;
1716
1717 /* Determine which form we have, either a control sequence or the
1718 single character form. */
1719
1720 if (*tokptr == '^')
1721 {
1722 if (*(tokptr + 1) == '(')
1723 {
1724 /* Match and decode a control sequence. Return zero if we don't
1725 find a valid integer literal, or if the next unconsumed character
1726 after the integer literal is not the trailing ')'. */
1727 tokptr += 2;
1728 if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1729 {
1730 return (0);
1731 }
1732 }
1733 else if (*(tokptr + 1) == '^')
1734 {
1735 ival = *tokptr;
1736 tokptr += 2;
1737 }
1738 else
1739 /* fail */
1740 error ("Invalid control sequence");
1741 }
1742 else if (*tokptr == '\'')
1743 {
1744 /* this must be duplicated */
1745 ival = *tokptr;
1746 tokptr += 2;
1747 }
1748 else
1749 {
1750 ival = *tokptr++;
1751 }
1752
1753 /* The trailing quote has not yet been consumed. If we don't find
1754 it, then we have no match. */
1755
1756 if (*tokptr++ != '\'')
1757 {
1758 return (0);
1759 }
1760 }
1761 else
1762 {
1763 /* Not a character literal. */
1764 return (0);
1765 }
1766 yylval.typed_val.val = ival;
1767 yylval.typed_val.type = builtin_type_chill_char;
1768 lexptr = tokptr;
1769 return (CHARACTER_LITERAL);
1770 }
1771
1772 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1773 Note that according to 5.2.4.2, a single "_" is also a valid integer
1774 literal, however GNU-chill requires there to be at least one "digit"
1775 in any integer literal. */
1776
1777 static enum ch_terminal
1778 match_integer_literal (void)
1779 {
1780 char *tokptr = lexptr;
1781 LONGEST ival;
1782
1783 if (!decode_integer_literal (&ival, &tokptr))
1784 {
1785 return (0);
1786 }
1787 else
1788 {
1789 yylval.typed_val.val = ival;
1790 #if defined(CC_HAS_LONG_LONG) && defined(__STDC__)
1791 if (ival > (LONGEST) 2147483647U || ival < -(LONGEST) 2147483648U)
1792 yylval.typed_val.type = builtin_type_long_long;
1793 else
1794 #endif
1795 yylval.typed_val.type = builtin_type_int;
1796 lexptr = tokptr;
1797 return (INTEGER_LITERAL);
1798 }
1799 }
1800
1801 /* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1802 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1803 literal, however GNU-chill requires there to be at least one "digit"
1804 in any bit-string literal. */
1805
1806 static enum ch_terminal
1807 match_bitstring_literal (void)
1808 {
1809 register char *tokptr = lexptr;
1810 int bitoffset = 0;
1811 int bitcount = 0;
1812 int bits_per_char;
1813 int digit;
1814
1815 tempbufindex = 0;
1816 CHECKBUF (1);
1817 tempbuf[0] = 0;
1818
1819 /* Look for the required explicit base specifier. */
1820
1821 switch (*tokptr++)
1822 {
1823 case 'b':
1824 case 'B':
1825 bits_per_char = 1;
1826 break;
1827 case 'o':
1828 case 'O':
1829 bits_per_char = 3;
1830 break;
1831 case 'h':
1832 case 'H':
1833 bits_per_char = 4;
1834 break;
1835 default:
1836 return (0);
1837 break;
1838 }
1839
1840 /* Ensure that the character after the explicit base is a single quote. */
1841
1842 if (*tokptr++ != '\'')
1843 {
1844 return (0);
1845 }
1846
1847 while (*tokptr != '\0' && *tokptr != '\'')
1848 {
1849 digit = *tokptr;
1850 if (isupper (digit))
1851 digit = tolower (digit);
1852 tokptr++;
1853 switch (digit)
1854 {
1855 case '_':
1856 continue;
1857 case '0':
1858 case '1':
1859 case '2':
1860 case '3':
1861 case '4':
1862 case '5':
1863 case '6':
1864 case '7':
1865 case '8':
1866 case '9':
1867 digit -= '0';
1868 break;
1869 case 'a':
1870 case 'b':
1871 case 'c':
1872 case 'd':
1873 case 'e':
1874 case 'f':
1875 digit -= 'a';
1876 digit += 10;
1877 break;
1878 default:
1879 /* this is not a bitstring literal, probably an integer */
1880 return 0;
1881 }
1882 if (digit >= 1 << bits_per_char)
1883 {
1884 /* Found something not in domain for current base. */
1885 error ("Too-large digit in bitstring or integer.");
1886 }
1887 else
1888 {
1889 /* Extract bits from digit, packing them into the bitstring byte. */
1890 int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
1891 for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
1892 TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
1893 {
1894 bitcount++;
1895 if (digit & (1 << k))
1896 {
1897 tempbuf[tempbufindex] |=
1898 (TARGET_BYTE_ORDER == BIG_ENDIAN)
1899 ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
1900 : (1 << bitoffset);
1901 }
1902 bitoffset++;
1903 if (bitoffset == HOST_CHAR_BIT)
1904 {
1905 bitoffset = 0;
1906 tempbufindex++;
1907 CHECKBUF (1);
1908 tempbuf[tempbufindex] = 0;
1909 }
1910 }
1911 }
1912 }
1913
1914 /* Verify that we consumed everything up to the trailing single quote,
1915 and that we found some bits (IE not just underbars). */
1916
1917 if (*tokptr++ != '\'')
1918 {
1919 return (0);
1920 }
1921 else
1922 {
1923 yylval.sval.ptr = tempbuf;
1924 yylval.sval.length = bitcount;
1925 lexptr = tokptr;
1926 return (BIT_STRING_LITERAL);
1927 }
1928 }
1929
1930 struct token
1931 {
1932 char *operator;
1933 int token;
1934 };
1935
1936 static const struct token idtokentab[] =
1937 {
1938 {"array", ARRAY},
1939 {"length", LENGTH},
1940 {"lower", LOWER},
1941 {"upper", UPPER},
1942 {"andif", ANDIF},
1943 {"pred", PRED},
1944 {"succ", SUCC},
1945 {"card", CARD},
1946 {"size", SIZE},
1947 {"orif", ORIF},
1948 {"num", NUM},
1949 {"abs", ABS},
1950 {"max", MAX_TOKEN},
1951 {"min", MIN_TOKEN},
1952 {"mod", MOD},
1953 {"rem", REM},
1954 {"not", NOT},
1955 {"xor", LOGXOR},
1956 {"and", LOGAND},
1957 {"in", IN},
1958 {"or", LOGIOR},
1959 {"up", UP},
1960 {"addr", ADDR_TOKEN},
1961 {"null", EMPTINESS_LITERAL}
1962 };
1963
1964 static const struct token tokentab2[] =
1965 {
1966 {":=", GDB_ASSIGNMENT},
1967 {"//", SLASH_SLASH},
1968 {"->", POINTER},
1969 {"/=", NOTEQUAL},
1970 {"<=", LEQ},
1971 {">=", GEQ}
1972 };
1973
1974 /* Read one token, getting characters through lexptr. */
1975 /* This is where we will check to make sure that the language and the
1976 operators used are compatible. */
1977
1978 static enum ch_terminal
1979 ch_lex (void)
1980 {
1981 unsigned int i;
1982 enum ch_terminal token;
1983 char *inputname;
1984 struct symbol *sym;
1985
1986 /* Skip over any leading whitespace. */
1987 while (isspace (*lexptr))
1988 {
1989 lexptr++;
1990 }
1991 /* Look for special single character cases which can't be the first
1992 character of some other multicharacter token. */
1993 switch (*lexptr)
1994 {
1995 case '\0':
1996 return END_TOKEN;
1997 case ',':
1998 case '=':
1999 case ';':
2000 case '!':
2001 case '+':
2002 case '*':
2003 case '(':
2004 case ')':
2005 case '[':
2006 case ']':
2007 return (*lexptr++);
2008 }
2009 /* Look for characters which start a particular kind of multicharacter
2010 token, such as a character literal, register name, convenience
2011 variable name, string literal, etc. */
2012 switch (*lexptr)
2013 {
2014 case '\'':
2015 case '\"':
2016 /* First try to match a string literal, which is any
2017 sequence of characters enclosed in matching single or double
2018 quotes, except that a single character inside single quotes
2019 is a character literal, so we have to catch that case also. */
2020 token = match_string_literal ();
2021 if (token != 0)
2022 {
2023 return (token);
2024 }
2025 if (*lexptr == '\'')
2026 {
2027 token = match_character_literal ();
2028 if (token != 0)
2029 {
2030 return (token);
2031 }
2032 }
2033 break;
2034 case 'C':
2035 case 'c':
2036 token = match_character_literal ();
2037 if (token != 0)
2038 {
2039 return (token);
2040 }
2041 break;
2042 case '$':
2043 yylval.sval.ptr = lexptr;
2044 do
2045 {
2046 lexptr++;
2047 }
2048 while (isalnum (*lexptr) || *lexptr == '_' || *lexptr == '$');
2049 yylval.sval.length = lexptr - yylval.sval.ptr;
2050 write_dollar_variable (yylval.sval);
2051 return GDB_VARIABLE;
2052 break;
2053 }
2054 /* See if it is a special token of length 2. */
2055 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
2056 {
2057 if (STREQN (lexptr, tokentab2[i].operator, 2))
2058 {
2059 lexptr += 2;
2060 return (tokentab2[i].token);
2061 }
2062 }
2063 /* Look for single character cases which which could be the first
2064 character of some other multicharacter token, but aren't, or we
2065 would already have found it. */
2066 switch (*lexptr)
2067 {
2068 case '-':
2069 case ':':
2070 case '/':
2071 case '<':
2072 case '>':
2073 return (*lexptr++);
2074 }
2075 /* Look for a float literal before looking for an integer literal, so
2076 we match as much of the input stream as possible. */
2077 token = match_float_literal ();
2078 if (token != 0)
2079 {
2080 return (token);
2081 }
2082 token = match_bitstring_literal ();
2083 if (token != 0)
2084 {
2085 return (token);
2086 }
2087 token = match_integer_literal ();
2088 if (token != 0)
2089 {
2090 return (token);
2091 }
2092
2093 /* Try to match a simple name string, and if a match is found, then
2094 further classify what sort of name it is and return an appropriate
2095 token. Note that attempting to match a simple name string consumes
2096 the token from lexptr, so we can't back out if we later find that
2097 we can't classify what sort of name it is. */
2098
2099 inputname = match_simple_name_string ();
2100
2101 if (inputname != NULL)
2102 {
2103 char *simplename = (char *) alloca (strlen (inputname) + 1);
2104
2105 char *dptr = simplename, *sptr = inputname;
2106 for (; *sptr; sptr++)
2107 *dptr++ = isupper (*sptr) ? tolower (*sptr) : *sptr;
2108 *dptr = '\0';
2109
2110 /* See if it is a reserved identifier. */
2111 for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
2112 {
2113 if (STREQ (simplename, idtokentab[i].operator))
2114 {
2115 return (idtokentab[i].token);
2116 }
2117 }
2118
2119 /* Look for other special tokens. */
2120 if (STREQ (simplename, "true"))
2121 {
2122 yylval.ulval = 1;
2123 return (BOOLEAN_LITERAL);
2124 }
2125 if (STREQ (simplename, "false"))
2126 {
2127 yylval.ulval = 0;
2128 return (BOOLEAN_LITERAL);
2129 }
2130
2131 sym = lookup_symbol (inputname, expression_context_block,
2132 VAR_NAMESPACE, (int *) NULL,
2133 (struct symtab **) NULL);
2134 if (sym == NULL && strcmp (inputname, simplename) != 0)
2135 {
2136 sym = lookup_symbol (simplename, expression_context_block,
2137 VAR_NAMESPACE, (int *) NULL,
2138 (struct symtab **) NULL);
2139 }
2140 if (sym != NULL)
2141 {
2142 yylval.ssym.stoken.ptr = NULL;
2143 yylval.ssym.stoken.length = 0;
2144 yylval.ssym.sym = sym;
2145 yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
2146 switch (SYMBOL_CLASS (sym))
2147 {
2148 case LOC_BLOCK:
2149 /* Found a procedure name. */
2150 return (GENERAL_PROCEDURE_NAME);
2151 case LOC_STATIC:
2152 /* Found a global or local static variable. */
2153 return (LOCATION_NAME);
2154 case LOC_REGISTER:
2155 case LOC_ARG:
2156 case LOC_REF_ARG:
2157 case LOC_REGPARM:
2158 case LOC_REGPARM_ADDR:
2159 case LOC_LOCAL:
2160 case LOC_LOCAL_ARG:
2161 case LOC_BASEREG:
2162 case LOC_BASEREG_ARG:
2163 if (innermost_block == NULL
2164 || contained_in (block_found, innermost_block))
2165 {
2166 innermost_block = block_found;
2167 }
2168 return (LOCATION_NAME);
2169 break;
2170 case LOC_CONST:
2171 case LOC_LABEL:
2172 return (LOCATION_NAME);
2173 break;
2174 case LOC_TYPEDEF:
2175 yylval.tsym.type = SYMBOL_TYPE (sym);
2176 return TYPENAME;
2177 case LOC_UNDEF:
2178 case LOC_CONST_BYTES:
2179 case LOC_OPTIMIZED_OUT:
2180 error ("Symbol \"%s\" names no location.", inputname);
2181 break;
2182 default:
2183 internal_error (__FILE__, __LINE__,
2184 "unhandled SYMBOL_CLASS in ch_lex()");
2185 break;
2186 }
2187 }
2188 else if (!have_full_symbols () && !have_partial_symbols ())
2189 {
2190 error ("No symbol table is loaded. Use the \"file\" command.");
2191 }
2192 else
2193 {
2194 error ("No symbol \"%s\" in current context.", inputname);
2195 }
2196 }
2197
2198 /* Catch single character tokens which are not part of some
2199 longer token. */
2200
2201 switch (*lexptr)
2202 {
2203 case '.': /* Not float for example. */
2204 lexptr++;
2205 while (isspace (*lexptr))
2206 lexptr++;
2207 inputname = match_simple_name_string ();
2208 if (!inputname)
2209 return '.';
2210 return DOT_FIELD_NAME;
2211 }
2212
2213 return (ILLEGAL_TOKEN);
2214 }
2215
2216 static void
2217 write_lower_upper_value (enum exp_opcode opcode, /* Either UNOP_LOWER or UNOP_UPPER */
2218 struct type *type)
2219 {
2220 if (type == NULL)
2221 write_exp_elt_opcode (opcode);
2222 else
2223 {
2224 struct type *result_type;
2225 LONGEST val = type_lower_upper (opcode, type, &result_type);
2226 write_exp_elt_opcode (OP_LONG);
2227 write_exp_elt_type (result_type);
2228 write_exp_elt_longcst (val);
2229 write_exp_elt_opcode (OP_LONG);
2230 }
2231 }
2232
2233 void
2234 chill_error (char *msg)
2235 {
2236 /* Never used. */
2237 }
This page took 0.098982 seconds and 5 git commands to generate.