* c-exp.y, m2-exp.y: Migrate code that has nothing to do with
[binutils-gdb.git] / gdb / ch-exp.y
1 /* YACC grammar for Chill expressions, for GDB.
2 Copyright (C) 1992 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., 675 Mass Ave, Cambridge, MA 02139, USA. */
19
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.
28
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.
36
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.
51
52 */
53
54 %{
55
56 #include "defs.h"
57 #include "expression.h"
58 #include "language.h"
59 #include "value.h"
60 #include "parser-defs.h"
61 #include "ch-lang.h"
62
63 /* These MUST be included in any grammar file!!!! Please choose unique names!
64 Note that this are a combined list of variables that can be produced
65 by any one of bison, byacc, or yacc. */
66 #define yymaxdepth chill_maxdepth
67 #define yyparse chill_parse
68 #define yylex chill_lex
69 #define yyerror chill_error
70 #define yylval chill_lval
71 #define yychar chill_char
72 #define yydebug chill_debug
73 #define yypact chill_pact
74 #define yyr1 chill_r1
75 #define yyr2 chill_r2
76 #define yydef chill_def
77 #define yychk chill_chk
78 #define yypgo chill_pgo
79 #define yyact chill_act
80 #define yyexca chill_exca
81 #define yyerrflag chill_errflag
82 #define yynerrs chill_nerrs
83 #define yyps chill_ps
84 #define yypv chill_pv
85 #define yys chill_s
86 #define yy_yys chill_yys
87 #define yystate chill_state
88 #define yytmp chill_tmp
89 #define yyv chill_v
90 #define yy_yyv chill_yyv
91 #define yyval chill_val
92 #define yylloc chill_lloc
93 #define yyss chill_yyss /* byacc */
94 #define yyssp chill_yysp /* byacc */
95 #define yyvs chill_yyvs /* byacc */
96 #define yyvsp chill_yyvsp /* byacc */
97
98 static int
99 yylex PARAMS ((void));
100
101 void
102 yyerror PARAMS ((char *));
103
104 int
105 yyparse PARAMS ((void));
106
107 /* #define YYDEBUG 1 */
108
109 %}
110
111 /* Although the yacc "value" of an expression is not used,
112 since the result is stored in the structure being created,
113 other node types do have values. */
114
115 %union
116 {
117 LONGEST lval;
118 unsigned LONGEST ulval;
119 struct {
120 LONGEST val;
121 struct type *type;
122 } typed_val;
123 double dval;
124 struct symbol *sym;
125 struct type *tval;
126 struct stoken sval;
127 struct ttype tsym;
128 struct symtoken ssym;
129 int voidval;
130 struct block *bval;
131 enum exp_opcode opcode;
132 struct internalvar *ivar;
133
134 struct type **tvec;
135 int *ivec;
136 }
137
138 %{
139 static int parse_number PARAMS ((void));
140 %}
141
142 %token <voidval> FIXME
143
144 %token <typed_val> INTEGER_LITERAL
145 %token <ulval> BOOLEAN_LITERAL
146 %token <typed_val> CHARACTER_LITERAL
147 %token <ssym> GENERAL_PROCEDURE_NAME
148 %token <ssym> LOCATION_NAME
149 %token <voidval> SET_LITERAL
150 %token <voidval> EMPTINESS_LITERAL
151 %token <voidval> CHARACTER_STRING_LITERAL
152 %token <voidval> BIT_STRING_LITERAL
153
154 %token <voidval> STRING
155 %token <voidval> CONSTANT
156 %token <voidval> '.'
157 %token <voidval> ';'
158 %token <voidval> ':'
159 %token <voidval> CASE
160 %token <voidval> OF
161 %token <voidval> ESAC
162 %token <voidval> LOGIOR
163 %token <voidval> ORIF
164 %token <voidval> LOGXOR
165 %token <voidval> LOGAND
166 %token <voidval> ANDIF
167 %token <voidval> '='
168 %token <voidval> NOTEQUAL
169 %token <voidval> '>'
170 %token <voidval> GTR
171 %token <voidval> '<'
172 %token <voidval> LEQ
173 %token <voidval> IN
174 %token <voidval> '+'
175 %token <voidval> '-'
176 %token <voidval> '*'
177 %token <voidval> '/'
178 %token <voidval> SLASH_SLASH
179 %token <voidval> MOD
180 %token <voidval> REM
181 %token <voidval> NOT
182 %token <voidval> POINTER
183 %token <voidval> RECEIVE
184 %token <voidval> SC
185 %token <voidval> '['
186 %token <voidval> ']'
187 %token <voidval> '('
188 %token <voidval> ')'
189 %token <voidval> UP
190 %token <voidval> IF
191 %token <voidval> THEN
192 %token <voidval> ELSE
193 %token <voidval> FI
194 %token <voidval> ELSIF
195 %token <voidval> ILLEGAL_TOKEN
196
197 %type <voidval> location
198 %type <voidval> access_name
199 %type <voidval> primitive_value
200 %type <voidval> location_contents
201 %type <voidval> value_name
202 %type <voidval> literal
203 %type <voidval> tuple
204 %type <voidval> value_string_element
205 %type <voidval> value_string_slice
206 %type <voidval> value_array_element
207 %type <voidval> value_array_slice
208 %type <voidval> value_structure_field
209 %type <voidval> expression_conversion
210 %type <voidval> value_procedure_call
211 %type <voidval> value_built_in_routine_call
212 %type <voidval> start_expression
213 %type <voidval> zero_adic_operator
214 %type <voidval> parenthesised_expression
215 %type <voidval> value
216 %type <voidval> undefined_value
217 %type <voidval> expression
218 %type <voidval> conditional_expression
219 %type <voidval> then_alternative
220 %type <voidval> else_alternative
221 %type <voidval> sub_expression
222 %type <voidval> value_case_alternative
223 %type <voidval> operand_0
224 %type <voidval> operand_1
225 %type <voidval> operand_2
226 %type <voidval> operand_3
227 %type <voidval> operand_4
228 %type <voidval> operand_5
229 %type <voidval> operand_6
230 %type <voidval> integer_literal_expression
231 %type <voidval> synonym_name
232 %type <voidval> value_enumeration_name
233 %type <voidval> value_do_with_name
234 %type <voidval> value_receive_name
235 %type <voidval> string_primitive_value
236 %type <voidval> start_element
237 %type <voidval> left_element
238 %type <voidval> right_element
239 %type <voidval> slice_size
240 %type <voidval> array_primitive_value
241 %type <voidval> expression_list
242 %type <voidval> lower_element
243 %type <voidval> upper_element
244 %type <voidval> first_element
245 %type <voidval> structure_primitive_value
246 %type <voidval> field_name
247 %type <voidval> mode_name
248 %type <voidval> boolean_expression
249 %type <voidval> case_selector_list
250 %type <voidval> subexpression
251 %type <voidval> case_label_specification
252 %type <voidval> buffer_location
253
254 %%
255
256 /* Z.200, 5.3.1 */
257
258 value : expression
259 {
260 $$ = 0; /* FIXME */
261 }
262 | undefined_value
263 {
264 $$ = 0; /* FIXME */
265 }
266 ;
267
268 undefined_value : FIXME
269 {
270 $$ = 0; /* FIXME */
271 }
272 ;
273
274 /* Z.200, 4.2.1 */
275
276 location : access_name
277 {
278 $$ = 0; /* FIXME */
279 }
280 | FIXME
281 {
282 $$ = 0; /* FIXME */
283 }
284 ;
285
286 /* Z.200, 4.2.2 */
287
288 access_name : LOCATION_NAME
289 {
290 write_exp_elt_opcode (OP_VAR_VALUE);
291 write_exp_elt_sym ($1.sym);
292 write_exp_elt_opcode (OP_VAR_VALUE);
293 }
294 | FIXME
295 {
296 $$ = 0; /* FIXME */
297 }
298 ;
299
300 /* Z.200, 5.2.1 */
301
302 primitive_value : location_contents
303 {
304 $$ = 0; /* FIXME */
305 }
306 | value_name
307 {
308 $$ = 0; /* FIXME */
309 }
310 | literal
311 {
312 $$ = 0; /* FIXME */
313 }
314 | tuple
315 {
316 $$ = 0; /* FIXME */
317 }
318 | value_string_element
319 {
320 $$ = 0; /* FIXME */
321 }
322 | value_string_slice
323 {
324 $$ = 0; /* FIXME */
325 }
326 | value_array_element
327 {
328 $$ = 0; /* FIXME */
329 }
330 | value_array_slice
331 {
332 $$ = 0; /* FIXME */
333 }
334 | value_structure_field
335 {
336 $$ = 0; /* FIXME */
337 }
338 | expression_conversion
339 {
340 $$ = 0; /* FIXME */
341 }
342 | value_procedure_call
343 {
344 $$ = 0; /* FIXME */
345 }
346 | value_built_in_routine_call
347 {
348 $$ = 0; /* FIXME */
349 }
350 | start_expression
351 {
352 $$ = 0; /* FIXME */
353 }
354 | zero_adic_operator
355 {
356 $$ = 0; /* FIXME */
357 }
358 | parenthesised_expression
359 {
360 $$ = 0; /* FIXME */
361 }
362 ;
363
364 /* Z.200, 5.2.2 */
365
366 location_contents: location
367 {
368 $$ = 0; /* FIXME */
369 }
370 ;
371
372 /* Z.200, 5.2.3 */
373
374 value_name : synonym_name
375 {
376 $$ = 0; /* FIXME */
377 }
378 | value_enumeration_name
379 {
380 $$ = 0; /* FIXME */
381 }
382 | value_do_with_name
383 {
384 $$ = 0; /* FIXME */
385 }
386 | value_receive_name
387 {
388 $$ = 0; /* FIXME */
389 }
390 | GENERAL_PROCEDURE_NAME
391 {
392 write_exp_elt_opcode (OP_VAR_VALUE);
393 write_exp_elt_sym ($1.sym);
394 write_exp_elt_opcode (OP_VAR_VALUE);
395 }
396 ;
397
398 /* Z.200, 5.2.4.1 */
399
400 literal : INTEGER_LITERAL
401 {
402 write_exp_elt_opcode (OP_LONG);
403 write_exp_elt_type ($1.type);
404 write_exp_elt_longcst ((LONGEST) ($1.val));
405 write_exp_elt_opcode (OP_LONG);
406 }
407 | BOOLEAN_LITERAL
408 {
409 write_exp_elt_opcode (OP_BOOL);
410 write_exp_elt_longcst ((LONGEST) $1);
411 write_exp_elt_opcode (OP_BOOL);
412 }
413 | CHARACTER_LITERAL
414 {
415 write_exp_elt_opcode (OP_LONG);
416 write_exp_elt_type ($1.type);
417 write_exp_elt_longcst ((LONGEST) ($1.val));
418 write_exp_elt_opcode (OP_LONG);
419 }
420 | SET_LITERAL
421 {
422 $$ = 0; /* FIXME */
423 }
424 | EMPTINESS_LITERAL
425 {
426 $$ = 0; /* FIXME */
427 }
428 | CHARACTER_STRING_LITERAL
429 {
430 $$ = 0; /* FIXME */
431 }
432 | BIT_STRING_LITERAL
433 {
434 $$ = 0; /* FIXME */
435 }
436 ;
437
438 /* Z.200, 5.2.5 */
439
440 tuple : FIXME
441 {
442 $$ = 0; /* FIXME */
443 }
444 ;
445
446
447 /* Z.200, 5.2.6 */
448
449 value_string_element: string_primitive_value '(' start_element ')'
450 {
451 $$ = 0; /* FIXME */
452 }
453 ;
454
455 /* Z.200, 5.2.7 */
456
457 value_string_slice: string_primitive_value '(' left_element ':' right_element ')'
458 {
459 $$ = 0; /* FIXME */
460 }
461 | string_primitive_value '(' start_element UP slice_size ')'
462 {
463 $$ = 0; /* FIXME */
464 }
465 ;
466
467 /* Z.200, 5.2.8 */
468
469 value_array_element: array_primitive_value '(' expression_list ')'
470 {
471 $$ = 0; /* FIXME */
472 }
473 ;
474
475 /* Z.200, 5.2.9 */
476
477 value_array_slice: array_primitive_value '(' lower_element ':' upper_element ')'
478 {
479 $$ = 0; /* FIXME */
480 }
481 | array_primitive_value '(' first_element UP slice_size '('
482 {
483 $$ = 0; /* FIXME */
484 }
485 ;
486
487 /* Z.200, 5.2.10 */
488
489 value_structure_field: structure_primitive_value '.' field_name
490 {
491 $$ = 0; /* FIXME */
492 }
493 ;
494
495 /* Z.200, 5.2.11 */
496
497 expression_conversion: mode_name '(' expression ')'
498 {
499 $$ = 0; /* FIXME */
500 }
501 ;
502
503 /* Z.200, 5.2.12 */
504
505 value_procedure_call: FIXME
506 {
507 $$ = 0; /* FIXME */
508 }
509 ;
510
511 /* Z.200, 5.2.13 */
512
513 value_built_in_routine_call: FIXME
514 {
515 $$ = 0; /* FIXME */
516 }
517 ;
518
519 /* Z.200, 5.2.14 */
520
521 start_expression: FIXME
522 {
523 $$ = 0; /* FIXME */
524 } /* Not in GNU-Chill */
525 ;
526
527 /* Z.200, 5.2.15 */
528
529 zero_adic_operator: FIXME
530 {
531 $$ = 0; /* FIXME */
532 }
533 ;
534
535 /* Z.200, 5.2.16 */
536
537 parenthesised_expression: '(' expression ')'
538 {
539 $$ = 0; /* FIXME */
540 }
541 ;
542
543 /* Z.200, 5.3.2 */
544
545 expression : operand_0
546 {
547 $$ = 0; /* FIXME */
548 }
549 | conditional_expression
550 {
551 $$ = 0; /* FIXME */
552 }
553 ;
554
555 conditional_expression : IF boolean_expression then_alternative else_alternative FI
556 {
557 $$ = 0; /* FIXME */
558 }
559 | CASE case_selector_list OF value_case_alternative '[' ELSE sub_expression ']' ESAC
560 {
561 $$ = 0; /* FIXME */
562 }
563 ;
564
565 then_alternative: THEN subexpression
566 {
567 $$ = 0; /* FIXME */
568 }
569 ;
570
571 else_alternative: ELSE subexpression
572 {
573 $$ = 0; /* FIXME */
574 }
575 | ELSIF boolean_expression then_alternative else_alternative
576 {
577 $$ = 0; /* FIXME */
578 }
579 ;
580
581 sub_expression : expression
582 {
583 $$ = 0; /* FIXME */
584 }
585 ;
586
587 value_case_alternative: case_label_specification ':' sub_expression ';'
588 {
589 $$ = 0; /* FIXME */
590 }
591 ;
592
593 /* Z.200, 5.3.3 */
594
595 operand_0 : operand_1
596 {
597 $$ = 0; /* FIXME */
598 }
599 | operand_0 LOGIOR operand_1
600 {
601 write_exp_elt_opcode (BINOP_BITWISE_IOR);
602 }
603 | operand_0 ORIF operand_1
604 {
605 $$ = 0; /* FIXME */
606 }
607 | operand_0 LOGXOR operand_1
608 {
609 write_exp_elt_opcode (BINOP_BITWISE_XOR);
610 }
611 ;
612
613 /* Z.200, 5.3.4 */
614
615 operand_1 : operand_2
616 {
617 $$ = 0; /* FIXME */
618 }
619 | operand_1 LOGAND operand_2
620 {
621 write_exp_elt_opcode (BINOP_BITWISE_AND);
622 }
623 | operand_1 ANDIF operand_2
624 {
625 $$ = 0; /* FIXME */
626 }
627 ;
628
629 /* Z.200, 5.3.5 */
630
631 operand_2 : operand_3
632 {
633 $$ = 0; /* FIXME */
634 }
635 | operand_2 '=' operand_3
636 {
637 write_exp_elt_opcode (BINOP_EQUAL);
638 }
639 | operand_2 NOTEQUAL operand_3
640 {
641 write_exp_elt_opcode (BINOP_NOTEQUAL);
642 }
643 | operand_2 '>' operand_3
644 {
645 write_exp_elt_opcode (BINOP_GTR);
646 }
647 | operand_2 GTR operand_3
648 {
649 write_exp_elt_opcode (BINOP_GEQ);
650 }
651 | operand_2 '<' operand_3
652 {
653 write_exp_elt_opcode (BINOP_LESS);
654 }
655 | operand_2 LEQ operand_3
656 {
657 write_exp_elt_opcode (BINOP_LEQ);
658 }
659 | operand_2 IN operand_3
660 {
661 $$ = 0; /* FIXME */
662 }
663 ;
664
665
666 /* Z.200, 5.3.6 */
667
668 operand_3 : operand_4
669 {
670 $$ = 0; /* FIXME */
671 }
672 | operand_3 '+' operand_4
673 {
674 write_exp_elt_opcode (BINOP_ADD);
675 }
676 | operand_3 '-' operand_4
677 {
678 write_exp_elt_opcode (BINOP_SUB);
679 }
680 | operand_3 SLASH_SLASH operand_4
681 {
682 $$ = 0; /* FIXME */
683 }
684 ;
685
686 /* Z.200, 5.3.7 */
687
688 operand_4 : operand_5
689 {
690 $$ = 0; /* FIXME */
691 }
692 | operand_4 '*' operand_5
693 {
694 write_exp_elt_opcode (BINOP_MUL);
695 }
696 | operand_4 '/' operand_5
697 {
698 write_exp_elt_opcode (BINOP_DIV);
699 }
700 | operand_4 MOD operand_5
701 {
702 $$ = 0; /* FIXME */
703 }
704 | operand_4 REM operand_5
705 {
706 $$ = 0; /* FIXME */
707 }
708 ;
709
710 /* Z.200, 5.3.8 */
711
712 operand_5 : operand_6
713 {
714 $$ = 0; /* FIXME */
715 }
716 | '-' operand_6
717 {
718 write_exp_elt_opcode (UNOP_NEG);
719 }
720 | NOT operand_6
721 {
722 write_exp_elt_opcode (UNOP_LOGICAL_NOT);
723 }
724 | '(' integer_literal_expression ')' operand_6
725 {
726 $$ = 0; /* FIXME */
727 }
728 ;
729
730 /* Z.200, 5.3.9 */
731
732 operand_6 : POINTER location
733 {
734 $$ = 0; /* FIXME */
735 }
736 | RECEIVE buffer_location
737 {
738 $$ = 0; /* FIXME */
739 }
740 | primitive_value
741 {
742 $$ = 0; /* FIXME */
743 }
744 ;
745
746
747 /* Z.200, 12.4.3 */
748 /* FIXME: For now we just accept only a single integer literal. */
749
750 integer_literal_expression:
751 INTEGER_LITERAL
752 {
753 $$ = 0;
754 }
755
756 /* Things which still need productions... */
757 synonym_name : FIXME { $$ = 0; }
758 value_enumeration_name : FIXME { $$ = 0; }
759 value_do_with_name : FIXME { $$ = 0; }
760 value_receive_name : FIXME { $$ = 0; }
761 string_primitive_value : FIXME { $$ = 0; }
762 start_element : FIXME { $$ = 0; }
763 left_element : FIXME { $$ = 0; }
764 right_element : FIXME { $$ = 0; }
765 slice_size : FIXME { $$ = 0; }
766 array_primitive_value : FIXME { $$ = 0; }
767 expression_list : FIXME { $$ = 0; }
768 lower_element : FIXME { $$ = 0; }
769 upper_element : FIXME { $$ = 0; }
770 first_element : FIXME { $$ = 0; }
771 structure_primitive_value: FIXME { $$ = 0; }
772 field_name : FIXME { $$ = 0; }
773 mode_name : FIXME { $$ = 0; }
774 boolean_expression : FIXME { $$ = 0; }
775 case_selector_list : FIXME { $$ = 0; }
776 subexpression : FIXME { $$ = 0; }
777 case_label_specification: FIXME { $$ = 0; }
778 buffer_location : FIXME { $$ = 0; }
779
780 %%
781
782 /* Try to consume a simple name string token. If successful, returns
783 a pointer to a nullbyte terminated copy of the name that can be used
784 in symbol table lookups. If not successful, returns NULL. */
785
786 static char *
787 match_simple_name_string ()
788 {
789 char *tokptr = lexptr;
790
791 if (isalpha (*tokptr))
792 {
793 do {
794 tokptr++;
795 } while (isalpha (*tokptr) || isdigit (*tokptr) || (*tokptr == '_'));
796 yylval.sval.ptr = lexptr;
797 yylval.sval.length = tokptr - lexptr;
798 lexptr = tokptr;
799 return (copy_name (yylval.sval));
800 }
801 return (NULL);
802 }
803
804 /* Start looking for a value composed of valid digits as set by the base
805 in use. Note that '_' characters are valid anywhere, in any quantity,
806 and are simply ignored. Since we must find at least one valid digit,
807 or reject this token as an integer literal, we keep track of how many
808 digits we have encountered. */
809
810 static int
811 decode_integer_value (base, tokptrptr, ivalptr)
812 int base;
813 char **tokptrptr;
814 int *ivalptr;
815 {
816 char *tokptr = *tokptrptr;
817 int temp;
818 int digits = 0;
819
820 while (*tokptr != '\0')
821 {
822 temp = tolower (*tokptr);
823 tokptr++;
824 switch (temp)
825 {
826 case '_':
827 continue;
828 case '0': case '1': case '2': case '3': case '4':
829 case '5': case '6': case '7': case '8': case '9':
830 temp -= '0';
831 break;
832 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
833 temp -= 'a';
834 temp += 10;
835 break;
836 default:
837 temp = base;
838 break;
839 }
840 if (temp < base)
841 {
842 digits++;
843 *ivalptr *= base;
844 *ivalptr += temp;
845 }
846 else
847 {
848 /* Found something not in domain for current base. */
849 tokptr--; /* Unconsume what gave us indigestion. */
850 break;
851 }
852 }
853
854 /* If we didn't find any digits, then we don't have a valid integer
855 value, so reject the entire token. Otherwise, update the lexical
856 scan pointer, and return non-zero for success. */
857
858 if (digits == 0)
859 {
860 return (0);
861 }
862 else
863 {
864 *tokptrptr = tokptr;
865 return (1);
866 }
867 }
868
869 static int
870 decode_integer_literal (valptr, tokptrptr)
871 int *valptr;
872 char **tokptrptr;
873 {
874 char *tokptr = *tokptrptr;
875 int base = 0;
876 int ival = 0;
877 int digits = 0;
878 int temp;
879 int explicit_base = 0;
880
881 /* Look for an explicit base specifier, which is optional. */
882
883 switch (*tokptr)
884 {
885 case 'd':
886 case 'D':
887 explicit_base++;
888 base = 10;
889 tokptr++;
890 break;
891 case 'b':
892 case 'B':
893 explicit_base++;
894 base = 2;
895 tokptr++;
896 break;
897 case 'h':
898 case 'H':
899 explicit_base++;
900 base = 16;
901 tokptr++;
902 break;
903 case 'o':
904 case 'O':
905 explicit_base++;
906 base = 8;
907 tokptr++;
908 break;
909 default:
910 base = 10;
911 break;
912 }
913
914 /* If we found an explicit base ensure that the character after the
915 explicit base is a single quote. */
916
917 if (explicit_base && (*tokptr++ != '\''))
918 {
919 return (0);
920 }
921
922 /* Attempt to decode whatever follows as an integer value in the
923 indicated base, updating the token pointer in the process and
924 computing the value into ival. Also, if we have an explicit
925 base, then the next character must not be a single quote, or we
926 have a bitstring literal, so reject the entire token in this case.
927 Otherwise, update the lexical scan pointer, and return non-zero
928 for success. */
929
930 if (!decode_integer_value (base, &tokptr, &ival))
931 {
932 return (0);
933 }
934 else if (explicit_base && (*tokptr == '\''))
935 {
936 return (0);
937 }
938 else
939 {
940 *valptr = ival;
941 *tokptrptr = tokptr;
942 return (1);
943 }
944 }
945
946 /* Recognize a character literal. A character literal is single character
947 or a control sequence, enclosed in single quotes. A control sequence
948 is a comma separated list of one or more integer literals, enclosed
949 in parenthesis and introduced with a circumflex character.
950
951 EX: 'a' '^(7)' '^(7,8)'
952
953 As a GNU chill extension, the syntax C'xx' is also recognized as a
954 character literal, where xx is a hex value for the character.
955
956 Returns CHARACTER_LITERAL if a match is found.
957 */
958
959 static int
960 match_character_literal ()
961 {
962 char *tokptr = lexptr;
963 int ival = 0;
964
965 if ((tolower (*tokptr) == 'c') && (*(tokptr + 1) == '\''))
966 {
967 /* We have a GNU chill extension form, so skip the leading "C'",
968 decode the hex value, and then ensure that we have a trailing
969 single quote character. */
970 tokptr += 2;
971 if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
972 {
973 return (0);
974 }
975 tokptr++;
976 }
977 else if (*tokptr == '\'')
978 {
979 tokptr++;
980
981 /* Determine which form we have, either a control sequence or the
982 single character form. */
983
984 if ((*tokptr == '^') && (*(tokptr + 1) == '('))
985 {
986 /* Match and decode a control sequence. Return zero if we don't
987 find a valid integer literal, or if the next unconsumed character
988 after the integer literal is not the trailing ')'.
989 FIXME: We currently don't handle the multiple integer literal
990 form. */
991 tokptr += 2;
992 if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
993 {
994 return (0);
995 }
996 }
997 else
998 {
999 ival = *tokptr++;
1000 }
1001
1002 /* The trailing quote has not yet been consumed. If we don't find
1003 it, then we have no match. */
1004
1005 if (*tokptr++ != '\'')
1006 {
1007 return (0);
1008 }
1009 }
1010 else
1011 {
1012 /* Not a character literal. */
1013 return (0);
1014 }
1015 yylval.typed_val.val = ival;
1016 yylval.typed_val.type = builtin_type_chill_char;
1017 lexptr = tokptr;
1018 return (CHARACTER_LITERAL);
1019 }
1020
1021 /* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1022 Note that according to 5.2.4.2, a single "_" is also a valid integer
1023 literal, however GNU-chill requires there to be at least one "digit"
1024 in any integer literal. */
1025
1026 static int
1027 match_integer_literal ()
1028 {
1029 char *tokptr = lexptr;
1030 int ival;
1031
1032 if (!decode_integer_literal (&ival, &tokptr))
1033 {
1034 return (0);
1035 }
1036 else
1037 {
1038 yylval.typed_val.val = ival;
1039 yylval.typed_val.type = builtin_type_int;
1040 lexptr = tokptr;
1041 return (INTEGER_LITERAL);
1042 }
1043 }
1044
1045 static void convert_float ()
1046 {
1047 #if 0
1048 extern double strtod ();
1049 double d;
1050 char tmp[256];
1051 char *p = yytext, *p1 = tmp;
1052 char c;
1053
1054 while (c = *p++)
1055 {
1056 switch (c)
1057 {
1058 case '_':
1059 break;
1060 case 'E':
1061 case 'd':
1062 case 'D':
1063 *p1++ = 'e';
1064 break;
1065 default:
1066 *p1++ = c;
1067 break;
1068 }
1069 }
1070 *p1 = '\0';
1071 d = strtod (tmp, &p1);
1072 if (*p1)
1073 {
1074 /* add error handling here */
1075 ;
1076 }
1077 yylval.dval = d;
1078 #endif
1079 }
1080
1081 /* Take care of parsing a number (anything that starts with a digit).
1082 Set yylval and return the token type; update lexptr.
1083 LEN is the number of characters in it. */
1084
1085 /*** Needs some error checking for the float case ***/
1086
1087 static int
1088 parse_number ()
1089 {
1090 }
1091
1092 struct token
1093 {
1094 char *operator;
1095 int token;
1096 };
1097
1098 const static struct token tokentab5[] =
1099 {
1100 { "ANDIF", ANDIF }
1101 };
1102
1103 const static struct token tokentab4[] =
1104 {
1105 { "ORIF", ORIF }
1106 };
1107
1108 const static struct token tokentab3[] =
1109 {
1110 { "NOT", NOT },
1111 { "XOR", LOGXOR },
1112 { "AND", LOGAND }
1113 };
1114
1115 const static struct token tokentab2[] =
1116 {
1117 { "//", SLASH_SLASH },
1118 { "/=", NOTEQUAL },
1119 { "<=", LEQ },
1120 { ">=", GTR },
1121 { "IN", IN },
1122 { "OR", LOGIOR }
1123 };
1124
1125 /* Read one token, getting characters through lexptr. */
1126 /* This is where we will check to make sure that the language and the
1127 operators used are compatible. */
1128
1129 static int
1130 yylex ()
1131 {
1132 unsigned int i;
1133 int token;
1134 char *simplename;
1135 struct symbol *sym;
1136
1137 /* Skip over any leading whitespace. */
1138 while (isspace (*lexptr))
1139 {
1140 lexptr++;
1141 }
1142 /* Look for special single character cases which can't be the first
1143 character of some other multicharacter token. */
1144 switch (*lexptr)
1145 {
1146 case '\0':
1147 return (0);
1148 case '.':
1149 case '=':
1150 case ':':
1151 case ';':
1152 case '!':
1153 case '+':
1154 case '-':
1155 case '*':
1156 case '/':
1157 case '(':
1158 case ')':
1159 case '[':
1160 case ']':
1161 return (*lexptr++);
1162 }
1163 /* Look for characters which start a particular kind of multicharacter
1164 token, such as a character literal. */
1165 switch (*lexptr)
1166 {
1167 case 'C':
1168 case 'c':
1169 case '\'':
1170 token = match_character_literal ();
1171 if (token != 0)
1172 {
1173 return (token);
1174 }
1175 break;
1176 }
1177 /* See if it is a special token of length 5. */
1178 for (i = 0; i < sizeof (tokentab5) / sizeof (tokentab5[0]); i++)
1179 {
1180 if (strncmp (lexptr, tokentab5[i].operator, 5) == 0)
1181 {
1182 lexptr += 5;
1183 return (tokentab5[i].token);
1184 }
1185 }
1186 /* See if it is a special token of length 4. */
1187 for (i = 0; i < sizeof (tokentab4) / sizeof (tokentab4[0]); i++)
1188 {
1189 if (strncmp (lexptr, tokentab4[i].operator, 4) == 0)
1190 {
1191 lexptr += 4;
1192 return (tokentab4[i].token);
1193 }
1194 }
1195 /* See if it is a special token of length 3. */
1196 for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1197 {
1198 if (strncmp (lexptr, tokentab3[i].operator, 3) == 0)
1199 {
1200 lexptr += 3;
1201 return (tokentab3[i].token);
1202 }
1203 }
1204 /* See if it is a special token of length 2. */
1205 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1206 {
1207 if (strncmp (lexptr, tokentab2[i].operator, 2) == 0)
1208 {
1209 lexptr += 2;
1210 return (tokentab2[i].token);
1211 }
1212 }
1213 /* Look for single character cases which which could be the first
1214 character of some other multicharacter token, but aren't, or we
1215 would already have found it. */
1216 switch (*lexptr)
1217 {
1218 case '/':
1219 case '<':
1220 case '>':
1221 return (*lexptr++);
1222 }
1223 /* Look for other special tokens. */
1224 if (strncmp (lexptr, "TRUE", 4) == 0) /* FIXME: What about lowercase? */
1225 {
1226 yylval.ulval = 1;
1227 lexptr += 4;
1228 return (BOOLEAN_LITERAL);
1229 }
1230 if (strncmp (lexptr, "FALSE", 5) == 0) /* FIXME: What about lowercase? */
1231 {
1232 yylval.ulval = 0;
1233 lexptr += 5;
1234 return (BOOLEAN_LITERAL);
1235 }
1236 token = match_integer_literal ();
1237 if (token != 0)
1238 {
1239 return (token);
1240 }
1241
1242 /* Try to match a simple name string, and if a match is found, then
1243 further classify what sort of name it is and return an appropriate
1244 token. Note that attempting to match a simple name string consumes
1245 the token from lexptr, so we can't back out if we later find that
1246 we can't classify what sort of name it is. */
1247
1248 simplename = match_simple_name_string ();
1249 if (simplename != NULL)
1250 {
1251 sym = lookup_symbol (simplename, expression_context_block,
1252 VAR_NAMESPACE, (int *) NULL,
1253 (struct symtab **) NULL);
1254 if (sym != NULL)
1255 {
1256 yylval.ssym.stoken.ptr = NULL;
1257 yylval.ssym.stoken.length = 0;
1258 yylval.ssym.sym = sym;
1259 yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
1260 switch (SYMBOL_CLASS (sym))
1261 {
1262 case LOC_BLOCK:
1263 /* Found a procedure name. */
1264 return (GENERAL_PROCEDURE_NAME);
1265 case LOC_STATIC:
1266 /* Found a global or local static variable. */
1267 return (LOCATION_NAME);
1268 }
1269 }
1270 else if (!have_full_symbols () && !have_partial_symbols ())
1271 {
1272 error ("No symbol table is loaded. Use the \"file\" command.");
1273 }
1274 else
1275 {
1276 error ("No symbol \"%s\" in current context.", simplename);
1277 }
1278 }
1279
1280 return (ILLEGAL_TOKEN);
1281 }
1282
1283 void
1284 yyerror (msg)
1285 char *msg; /* unused */
1286 {
1287 printf ("Parsing: %s\n", lexptr);
1288 if (yychar < 256)
1289 {
1290 error ("Invalid syntax in expression near character '%c'.", yychar);
1291 }
1292 else
1293 {
1294 error ("Invalid syntax in expression");
1295 }
1296 }