* config/m88k/delta88v4.h (NATDEPFILES): Remove infptrace.o inftarg.o.
[deliverable/binutils-gdb.git] / gdb / ch-exp.y
CommitLineData
e58de8a2 1/* YACC grammar for Chill expressions, for GDB.
57ffffe3 2 Copyright 1992, 1993 Free Software Foundation, Inc.
e58de8a2
FF
3
4This file is part of GDB.
5
6This program is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2 of the License, or
9(at your option) any later version.
10
11This program is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with this program; if not, write to the Free Software
18Foundation, 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
e58de8a2 56#include "defs.h"
00cea52f 57#include <ctype.h>
e58de8a2
FF
58#include "expression.h"
59#include "language.h"
60#include "value.h"
61#include "parser-defs.h"
22e39759 62#include "ch-lang.h"
e58de8a2 63
19d0f3f4
FF
64/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
65 as well as gratuitiously global symbol names, so we can have multiple
66 yacc generated parsers in gdb. Note that these are only the variables
67 produced by yacc. If other parser generators (bison, byacc, etc) produce
68 additional global names that conflict at link time, then those parser
69 generators need to be fixed instead of adding those names to this list. */
70
e58de8a2
FF
71#define yymaxdepth chill_maxdepth
72#define yyparse chill_parse
73#define yylex chill_lex
74#define yyerror chill_error
75#define yylval chill_lval
76#define yychar chill_char
77#define yydebug chill_debug
78#define yypact chill_pact
79#define yyr1 chill_r1
80#define yyr2 chill_r2
81#define yydef chill_def
82#define yychk chill_chk
83#define yypgo chill_pgo
84#define yyact chill_act
85#define yyexca chill_exca
4015bfb9
BK
86#define yyerrflag chill_errflag
87#define yynerrs chill_nerrs
e58de8a2
FF
88#define yyps chill_ps
89#define yypv chill_pv
90#define yys chill_s
91#define yy_yys chill_yys
92#define yystate chill_state
93#define yytmp chill_tmp
94#define yyv chill_v
95#define yy_yyv chill_yyv
96#define yyval chill_val
97#define yylloc chill_lloc
4015bfb9
BK
98#define yyreds chill_reds /* With YYDEBUG defined */
99#define yytoks chill_toks /* With YYDEBUG defined */
19d0f3f4
FF
100
101#ifndef YYDEBUG
102#define YYDEBUG 0 /* Default to no yydebug support */
103#endif
104
105int
106yyparse PARAMS ((void));
e58de8a2
FF
107
108static int
109yylex PARAMS ((void));
110
22e39759 111void
e58de8a2
FF
112yyerror PARAMS ((char *));
113
e58de8a2
FF
114%}
115
116/* Although the yacc "value" of an expression is not used,
117 since the result is stored in the structure being created,
118 other node types do have values. */
119
120%union
121 {
122 LONGEST lval;
123 unsigned LONGEST ulval;
124 struct {
125 LONGEST val;
126 struct type *type;
127 } typed_val;
128 double dval;
129 struct symbol *sym;
130 struct type *tval;
131 struct stoken sval;
132 struct ttype tsym;
133 struct symtoken ssym;
134 int voidval;
135 struct block *bval;
136 enum exp_opcode opcode;
137 struct internalvar *ivar;
138
139 struct type **tvec;
140 int *ivec;
141 }
142
2fcc38b8
FF
143%token <voidval> FIXME_01
144%token <voidval> FIXME_02
145%token <voidval> FIXME_03
146%token <voidval> FIXME_04
147%token <voidval> FIXME_05
148%token <voidval> FIXME_06
149%token <voidval> FIXME_07
150%token <voidval> FIXME_08
151%token <voidval> FIXME_09
152%token <voidval> FIXME_10
153%token <voidval> FIXME_11
154%token <voidval> FIXME_12
155%token <voidval> FIXME_13
156%token <voidval> FIXME_14
157%token <voidval> FIXME_15
158%token <voidval> FIXME_16
159%token <voidval> FIXME_17
160%token <voidval> FIXME_18
161%token <voidval> FIXME_19
162%token <voidval> FIXME_20
163%token <voidval> FIXME_21
164%token <voidval> FIXME_22
2fcc38b8
FF
165%token <voidval> FIXME_24
166%token <voidval> FIXME_25
167%token <voidval> FIXME_26
168%token <voidval> FIXME_27
169%token <voidval> FIXME_28
170%token <voidval> FIXME_29
171%token <voidval> FIXME_30
e58de8a2
FF
172
173%token <typed_val> INTEGER_LITERAL
174%token <ulval> BOOLEAN_LITERAL
2e66cf7d 175%token <typed_val> CHARACTER_LITERAL
1188fbbf 176%token <dval> FLOAT_LITERAL
cbd1bdc3
FF
177%token <ssym> GENERAL_PROCEDURE_NAME
178%token <ssym> LOCATION_NAME
e58de8a2
FF
179%token <voidval> SET_LITERAL
180%token <voidval> EMPTINESS_LITERAL
c7da3ed3 181%token <sval> CHARACTER_STRING_LITERAL
81028ab0 182%token <sval> BIT_STRING_LITERAL
8a177da6
PB
183%token <tsym> TYPENAME
184%token <sval> FIELD_NAME
e58de8a2 185
e58de8a2
FF
186%token <voidval> '.'
187%token <voidval> ';'
188%token <voidval> ':'
189%token <voidval> CASE
190%token <voidval> OF
191%token <voidval> ESAC
192%token <voidval> LOGIOR
193%token <voidval> ORIF
194%token <voidval> LOGXOR
195%token <voidval> LOGAND
196%token <voidval> ANDIF
197%token <voidval> '='
198%token <voidval> NOTEQUAL
199%token <voidval> '>'
200%token <voidval> GTR
201%token <voidval> '<'
202%token <voidval> LEQ
203%token <voidval> IN
204%token <voidval> '+'
205%token <voidval> '-'
206%token <voidval> '*'
207%token <voidval> '/'
208%token <voidval> SLASH_SLASH
209%token <voidval> MOD
210%token <voidval> REM
211%token <voidval> NOT
212%token <voidval> POINTER
213%token <voidval> RECEIVE
e58de8a2
FF
214%token <voidval> '['
215%token <voidval> ']'
216%token <voidval> '('
217%token <voidval> ')'
218%token <voidval> UP
219%token <voidval> IF
220%token <voidval> THEN
221%token <voidval> ELSE
222%token <voidval> FI
223%token <voidval> ELSIF
224%token <voidval> ILLEGAL_TOKEN
81028ab0
FF
225%token <voidval> NUM
226%token <voidval> PRED
227%token <voidval> SUCC
228%token <voidval> ABS
229%token <voidval> CARD
57ffffe3
JG
230%token <voidval> MAX_TOKEN
231%token <voidval> MIN_TOKEN
81028ab0
FF
232%token <voidval> SIZE
233%token <voidval> UPPER
234%token <voidval> LOWER
235%token <voidval> LENGTH
e58de8a2 236
45fe3db4
FF
237/* Tokens which are not Chill tokens used in expressions, but rather GDB
238 specific things that we recognize in the same context as Chill tokens
239 (register names for example). */
240
241%token <lval> GDB_REGNAME /* Machine register name */
242%token <lval> GDB_LAST /* Value history */
243%token <ivar> GDB_VARIABLE /* Convenience variable */
244%token <voidval> GDB_ASSIGNMENT /* Assign value to somewhere */
245
e58de8a2 246%type <voidval> location
cbd1bdc3 247%type <voidval> access_name
e58de8a2
FF
248%type <voidval> primitive_value
249%type <voidval> location_contents
250%type <voidval> value_name
251%type <voidval> literal
252%type <voidval> tuple
253%type <voidval> value_string_element
254%type <voidval> value_string_slice
255%type <voidval> value_array_element
256%type <voidval> value_array_slice
257%type <voidval> value_structure_field
258%type <voidval> expression_conversion
259%type <voidval> value_procedure_call
260%type <voidval> value_built_in_routine_call
81028ab0 261%type <voidval> chill_value_built_in_routine_call
e58de8a2
FF
262%type <voidval> start_expression
263%type <voidval> zero_adic_operator
264%type <voidval> parenthesised_expression
265%type <voidval> value
266%type <voidval> undefined_value
267%type <voidval> expression
268%type <voidval> conditional_expression
269%type <voidval> then_alternative
270%type <voidval> else_alternative
271%type <voidval> sub_expression
272%type <voidval> value_case_alternative
273%type <voidval> operand_0
274%type <voidval> operand_1
275%type <voidval> operand_2
276%type <voidval> operand_3
277%type <voidval> operand_4
278%type <voidval> operand_5
279%type <voidval> operand_6
e58de8a2
FF
280%type <voidval> synonym_name
281%type <voidval> value_enumeration_name
282%type <voidval> value_do_with_name
283%type <voidval> value_receive_name
e58de8a2
FF
284%type <voidval> string_primitive_value
285%type <voidval> start_element
286%type <voidval> left_element
287%type <voidval> right_element
288%type <voidval> slice_size
289%type <voidval> array_primitive_value
290%type <voidval> expression_list
291%type <voidval> lower_element
292%type <voidval> upper_element
293%type <voidval> first_element
81028ab0
FF
294%type <voidval> mode_argument
295%type <voidval> upper_lower_argument
296%type <voidval> length_argument
81028ab0
FF
297%type <voidval> array_mode_name
298%type <voidval> string_mode_name
299%type <voidval> variant_structure_mode_name
e58de8a2
FF
300%type <voidval> boolean_expression
301%type <voidval> case_selector_list
302%type <voidval> subexpression
303%type <voidval> case_label_specification
304%type <voidval> buffer_location
45fe3db4 305%type <voidval> single_assignment_action
8a177da6 306%type <tsym> mode_name
45fe3db4 307
e58de8a2
FF
308%%
309
310/* Z.200, 5.3.1 */
311
f39a2631 312start : value { }
8a177da6
PB
313 | mode_name
314 { write_exp_elt_opcode(OP_TYPE);
315 write_exp_elt_type($1.type);
316 write_exp_elt_opcode(OP_TYPE);}
317 ;
318
e58de8a2
FF
319value : expression
320 {
2e66cf7d 321 $$ = 0; /* FIXME */
e58de8a2
FF
322 }
323 | undefined_value
324 {
2e66cf7d 325 $$ = 0; /* FIXME */
e58de8a2
FF
326 }
327 ;
328
2fcc38b8 329undefined_value : FIXME_01
e58de8a2 330 {
2e66cf7d 331 $$ = 0; /* FIXME */
e58de8a2
FF
332 }
333 ;
334
335/* Z.200, 4.2.1 */
336
cbd1bdc3 337location : access_name
8a177da6 338 | primitive_value POINTER
cbd1bdc3 339 {
8a177da6 340 write_exp_elt_opcode (UNOP_IND);
cbd1bdc3
FF
341 }
342 ;
343
344/* Z.200, 4.2.2 */
345
346access_name : LOCATION_NAME
347 {
348 write_exp_elt_opcode (OP_VAR_VALUE);
479fdd26 349 write_exp_elt_block (NULL);
cbd1bdc3
FF
350 write_exp_elt_sym ($1.sym);
351 write_exp_elt_opcode (OP_VAR_VALUE);
352 }
45fe3db4
FF
353 | GDB_LAST /* gdb specific */
354 {
355 write_exp_elt_opcode (OP_LAST);
356 write_exp_elt_longcst ($1);
357 write_exp_elt_opcode (OP_LAST);
358 }
359 | GDB_REGNAME /* gdb specific */
360 {
361 write_exp_elt_opcode (OP_REGISTER);
362 write_exp_elt_longcst ($1);
363 write_exp_elt_opcode (OP_REGISTER);
364 }
365 | GDB_VARIABLE /* gdb specific */
366 {
367 write_exp_elt_opcode (OP_INTERNALVAR);
368 write_exp_elt_intern ($1);
369 write_exp_elt_opcode (OP_INTERNALVAR);
370 }
2fcc38b8 371 | FIXME_03
e58de8a2 372 {
2e66cf7d 373 $$ = 0; /* FIXME */
e58de8a2
FF
374 }
375 ;
376
54bbbfb4
FF
377/* Z.200, 4.2.8 */
378
379expression_list : expression
380 {
381 arglist_len = 1;
382 }
383 | expression_list ',' expression
384 {
385 arglist_len++;
386 }
387
e58de8a2
FF
388/* Z.200, 5.2.1 */
389
390primitive_value : location_contents
391 {
2e66cf7d 392 $$ = 0; /* FIXME */
e58de8a2
FF
393 }
394 | value_name
395 {
2e66cf7d 396 $$ = 0; /* FIXME */
e58de8a2
FF
397 }
398 | literal
399 {
2e66cf7d 400 $$ = 0; /* FIXME */
e58de8a2
FF
401 }
402 | tuple
403 {
2e66cf7d 404 $$ = 0; /* FIXME */
e58de8a2
FF
405 }
406 | value_string_element
407 {
2e66cf7d 408 $$ = 0; /* FIXME */
e58de8a2
FF
409 }
410 | value_string_slice
411 {
2e66cf7d 412 $$ = 0; /* FIXME */
e58de8a2
FF
413 }
414 | value_array_element
415 {
2e66cf7d 416 $$ = 0; /* FIXME */
e58de8a2
FF
417 }
418 | value_array_slice
419 {
2e66cf7d 420 $$ = 0; /* FIXME */
e58de8a2
FF
421 }
422 | value_structure_field
423 {
2e66cf7d 424 $$ = 0; /* FIXME */
e58de8a2
FF
425 }
426 | expression_conversion
427 {
2e66cf7d 428 $$ = 0; /* FIXME */
e58de8a2
FF
429 }
430 | value_procedure_call
431 {
2e66cf7d 432 $$ = 0; /* FIXME */
e58de8a2
FF
433 }
434 | value_built_in_routine_call
435 {
2e66cf7d 436 $$ = 0; /* FIXME */
e58de8a2
FF
437 }
438 | start_expression
439 {
2e66cf7d 440 $$ = 0; /* FIXME */
e58de8a2
FF
441 }
442 | zero_adic_operator
443 {
2e66cf7d 444 $$ = 0; /* FIXME */
e58de8a2
FF
445 }
446 | parenthesised_expression
447 {
2e66cf7d 448 $$ = 0; /* FIXME */
e58de8a2
FF
449 }
450 ;
451
452/* Z.200, 5.2.2 */
453
454location_contents: location
455 {
2e66cf7d 456 $$ = 0; /* FIXME */
e58de8a2
FF
457 }
458 ;
459
460/* Z.200, 5.2.3 */
461
462value_name : synonym_name
463 {
2e66cf7d 464 $$ = 0; /* FIXME */
e58de8a2
FF
465 }
466 | value_enumeration_name
467 {
2e66cf7d 468 $$ = 0; /* FIXME */
e58de8a2
FF
469 }
470 | value_do_with_name
471 {
2e66cf7d 472 $$ = 0; /* FIXME */
e58de8a2
FF
473 }
474 | value_receive_name
475 {
2e66cf7d 476 $$ = 0; /* FIXME */
e58de8a2 477 }
cbd1bdc3 478 | GENERAL_PROCEDURE_NAME
e58de8a2 479 {
cbd1bdc3 480 write_exp_elt_opcode (OP_VAR_VALUE);
479fdd26 481 write_exp_elt_block (NULL);
cbd1bdc3
FF
482 write_exp_elt_sym ($1.sym);
483 write_exp_elt_opcode (OP_VAR_VALUE);
e58de8a2
FF
484 }
485 ;
486
487/* Z.200, 5.2.4.1 */
488
489literal : INTEGER_LITERAL
490 {
2e66cf7d
FF
491 write_exp_elt_opcode (OP_LONG);
492 write_exp_elt_type ($1.type);
493 write_exp_elt_longcst ((LONGEST) ($1.val));
494 write_exp_elt_opcode (OP_LONG);
e58de8a2
FF
495 }
496 | BOOLEAN_LITERAL
497 {
2e66cf7d
FF
498 write_exp_elt_opcode (OP_BOOL);
499 write_exp_elt_longcst ((LONGEST) $1);
500 write_exp_elt_opcode (OP_BOOL);
e58de8a2
FF
501 }
502 | CHARACTER_LITERAL
503 {
2e66cf7d
FF
504 write_exp_elt_opcode (OP_LONG);
505 write_exp_elt_type ($1.type);
506 write_exp_elt_longcst ((LONGEST) ($1.val));
507 write_exp_elt_opcode (OP_LONG);
e58de8a2 508 }
1188fbbf
FF
509 | FLOAT_LITERAL
510 {
511 write_exp_elt_opcode (OP_DOUBLE);
512 write_exp_elt_type (builtin_type_double);
513 write_exp_elt_dblcst ($1);
514 write_exp_elt_opcode (OP_DOUBLE);
515 }
e58de8a2
FF
516 | SET_LITERAL
517 {
2e66cf7d 518 $$ = 0; /* FIXME */
e58de8a2
FF
519 }
520 | EMPTINESS_LITERAL
521 {
2e66cf7d 522 $$ = 0; /* FIXME */
e58de8a2
FF
523 }
524 | CHARACTER_STRING_LITERAL
525 {
c7da3ed3
FF
526 write_exp_elt_opcode (OP_STRING);
527 write_exp_string ($1);
528 write_exp_elt_opcode (OP_STRING);
e58de8a2
FF
529 }
530 | BIT_STRING_LITERAL
531 {
81028ab0
FF
532 write_exp_elt_opcode (OP_BITSTRING);
533 write_exp_bitstring ($1);
534 write_exp_elt_opcode (OP_BITSTRING);
e58de8a2
FF
535 }
536 ;
537
538/* Z.200, 5.2.5 */
539
2fcc38b8 540tuple : FIXME_04
e58de8a2 541 {
2e66cf7d 542 $$ = 0; /* FIXME */
e58de8a2
FF
543 }
544 ;
545
546
547/* Z.200, 5.2.6 */
548
549value_string_element: string_primitive_value '(' start_element ')'
550 {
2e66cf7d 551 $$ = 0; /* FIXME */
e58de8a2
FF
552 }
553 ;
554
555/* Z.200, 5.2.7 */
556
557value_string_slice: string_primitive_value '(' left_element ':' right_element ')'
558 {
2e66cf7d 559 $$ = 0; /* FIXME */
e58de8a2
FF
560 }
561 | string_primitive_value '(' start_element UP slice_size ')'
562 {
2e66cf7d 563 $$ = 0; /* FIXME */
e58de8a2
FF
564 }
565 ;
566
567/* Z.200, 5.2.8 */
568
54bbbfb4
FF
569value_array_element: array_primitive_value '('
570 /* This is to save the value of arglist_len
571 being accumulated for each dimension. */
572 { start_arglist (); }
573 expression_list ')'
e58de8a2 574 {
54bbbfb4
FF
575 write_exp_elt_opcode (MULTI_SUBSCRIPT);
576 write_exp_elt_longcst ((LONGEST) end_arglist ());
577 write_exp_elt_opcode (MULTI_SUBSCRIPT);
e58de8a2
FF
578 }
579 ;
580
581/* Z.200, 5.2.9 */
582
583value_array_slice: array_primitive_value '(' lower_element ':' upper_element ')'
584 {
2e66cf7d 585 $$ = 0; /* FIXME */
e58de8a2 586 }
a9b37611 587 | array_primitive_value '(' first_element UP slice_size ')'
e58de8a2 588 {
2e66cf7d 589 $$ = 0; /* FIXME */
e58de8a2
FF
590 }
591 ;
592
593/* Z.200, 5.2.10 */
594
8a177da6
PB
595value_structure_field: primitive_value FIELD_NAME
596 { write_exp_elt_opcode (STRUCTOP_STRUCT);
597 write_exp_string ($2);
598 write_exp_elt_opcode (STRUCTOP_STRUCT);
e58de8a2
FF
599 }
600 ;
601
602/* Z.200, 5.2.11 */
603
2fcc38b8 604expression_conversion: mode_name parenthesised_expression
e58de8a2 605 {
8a177da6
PB
606 write_exp_elt_opcode (UNOP_CAST);
607 write_exp_elt_type ($1.type);
608 write_exp_elt_opcode (UNOP_CAST);
e58de8a2
FF
609 }
610 ;
611
612/* Z.200, 5.2.12 */
613
2fcc38b8 614value_procedure_call: FIXME_05
e58de8a2 615 {
2e66cf7d 616 $$ = 0; /* FIXME */
e58de8a2
FF
617 }
618 ;
619
620/* Z.200, 5.2.13 */
621
81028ab0 622value_built_in_routine_call: chill_value_built_in_routine_call
e58de8a2 623 {
2e66cf7d 624 $$ = 0; /* FIXME */
e58de8a2
FF
625 }
626 ;
627
628/* Z.200, 5.2.14 */
629
2fcc38b8 630start_expression: FIXME_06
e58de8a2 631 {
2e66cf7d 632 $$ = 0; /* FIXME */
e58de8a2
FF
633 } /* Not in GNU-Chill */
634 ;
635
636/* Z.200, 5.2.15 */
637
2fcc38b8 638zero_adic_operator: FIXME_07
e58de8a2 639 {
2e66cf7d 640 $$ = 0; /* FIXME */
e58de8a2
FF
641 }
642 ;
643
644/* Z.200, 5.2.16 */
645
646parenthesised_expression: '(' expression ')'
647 {
2e66cf7d 648 $$ = 0; /* FIXME */
e58de8a2
FF
649 }
650 ;
651
652/* Z.200, 5.3.2 */
653
654expression : operand_0
655 {
2e66cf7d 656 $$ = 0; /* FIXME */
e58de8a2 657 }
8a177da6
PB
658 | single_assignment_action
659 {
660 $$ = 0; /* FIXME */
661 }
e58de8a2
FF
662 | conditional_expression
663 {
2e66cf7d 664 $$ = 0; /* FIXME */
e58de8a2
FF
665 }
666 ;
667
668conditional_expression : IF boolean_expression then_alternative else_alternative FI
669 {
2e66cf7d 670 $$ = 0; /* FIXME */
e58de8a2
FF
671 }
672 | CASE case_selector_list OF value_case_alternative '[' ELSE sub_expression ']' ESAC
673 {
2e66cf7d 674 $$ = 0; /* FIXME */
e58de8a2
FF
675 }
676 ;
677
678then_alternative: THEN subexpression
679 {
2e66cf7d 680 $$ = 0; /* FIXME */
e58de8a2
FF
681 }
682 ;
683
684else_alternative: ELSE subexpression
685 {
2e66cf7d 686 $$ = 0; /* FIXME */
e58de8a2
FF
687 }
688 | ELSIF boolean_expression then_alternative else_alternative
689 {
2e66cf7d 690 $$ = 0; /* FIXME */
e58de8a2
FF
691 }
692 ;
693
694sub_expression : expression
695 {
2e66cf7d 696 $$ = 0; /* FIXME */
e58de8a2
FF
697 }
698 ;
699
700value_case_alternative: case_label_specification ':' sub_expression ';'
701 {
2e66cf7d 702 $$ = 0; /* FIXME */
e58de8a2
FF
703 }
704 ;
705
706/* Z.200, 5.3.3 */
707
708operand_0 : operand_1
709 {
2e66cf7d 710 $$ = 0; /* FIXME */
e58de8a2
FF
711 }
712 | operand_0 LOGIOR operand_1
713 {
2e66cf7d 714 write_exp_elt_opcode (BINOP_BITWISE_IOR);
e58de8a2
FF
715 }
716 | operand_0 ORIF operand_1
717 {
2e66cf7d 718 $$ = 0; /* FIXME */
e58de8a2
FF
719 }
720 | operand_0 LOGXOR operand_1
721 {
2e66cf7d 722 write_exp_elt_opcode (BINOP_BITWISE_XOR);
e58de8a2
FF
723 }
724 ;
725
726/* Z.200, 5.3.4 */
727
728operand_1 : operand_2
729 {
2e66cf7d 730 $$ = 0; /* FIXME */
e58de8a2
FF
731 }
732 | operand_1 LOGAND operand_2
733 {
2e66cf7d 734 write_exp_elt_opcode (BINOP_BITWISE_AND);
e58de8a2
FF
735 }
736 | operand_1 ANDIF operand_2
737 {
2e66cf7d 738 $$ = 0; /* FIXME */
e58de8a2
FF
739 }
740 ;
741
742/* Z.200, 5.3.5 */
743
744operand_2 : operand_3
745 {
2e66cf7d 746 $$ = 0; /* FIXME */
e58de8a2
FF
747 }
748 | operand_2 '=' operand_3
749 {
2e66cf7d 750 write_exp_elt_opcode (BINOP_EQUAL);
e58de8a2
FF
751 }
752 | operand_2 NOTEQUAL operand_3
753 {
2e66cf7d 754 write_exp_elt_opcode (BINOP_NOTEQUAL);
e58de8a2
FF
755 }
756 | operand_2 '>' operand_3
757 {
2e66cf7d 758 write_exp_elt_opcode (BINOP_GTR);
e58de8a2
FF
759 }
760 | operand_2 GTR operand_3
761 {
2e66cf7d 762 write_exp_elt_opcode (BINOP_GEQ);
e58de8a2
FF
763 }
764 | operand_2 '<' operand_3
765 {
2e66cf7d 766 write_exp_elt_opcode (BINOP_LESS);
e58de8a2
FF
767 }
768 | operand_2 LEQ operand_3
769 {
2e66cf7d 770 write_exp_elt_opcode (BINOP_LEQ);
e58de8a2
FF
771 }
772 | operand_2 IN operand_3
773 {
2e66cf7d 774 $$ = 0; /* FIXME */
e58de8a2
FF
775 }
776 ;
777
778
779/* Z.200, 5.3.6 */
780
781operand_3 : operand_4
782 {
2e66cf7d 783 $$ = 0; /* FIXME */
e58de8a2
FF
784 }
785 | operand_3 '+' operand_4
786 {
2e66cf7d 787 write_exp_elt_opcode (BINOP_ADD);
e58de8a2
FF
788 }
789 | operand_3 '-' operand_4
790 {
2e66cf7d 791 write_exp_elt_opcode (BINOP_SUB);
e58de8a2
FF
792 }
793 | operand_3 SLASH_SLASH operand_4
794 {
fcbadaee 795 write_exp_elt_opcode (BINOP_CONCAT);
e58de8a2
FF
796 }
797 ;
798
799/* Z.200, 5.3.7 */
800
801operand_4 : operand_5
802 {
2e66cf7d 803 $$ = 0; /* FIXME */
e58de8a2
FF
804 }
805 | operand_4 '*' operand_5
806 {
2e66cf7d 807 write_exp_elt_opcode (BINOP_MUL);
e58de8a2
FF
808 }
809 | operand_4 '/' operand_5
810 {
2e66cf7d 811 write_exp_elt_opcode (BINOP_DIV);
e58de8a2
FF
812 }
813 | operand_4 MOD operand_5
814 {
76a0ffb4 815 write_exp_elt_opcode (BINOP_MOD);
e58de8a2
FF
816 }
817 | operand_4 REM operand_5
818 {
76a0ffb4 819 write_exp_elt_opcode (BINOP_REM);
e58de8a2
FF
820 }
821 ;
822
823/* Z.200, 5.3.8 */
824
825operand_5 : operand_6
826 {
2e66cf7d 827 $$ = 0; /* FIXME */
e58de8a2
FF
828 }
829 | '-' operand_6
830 {
2e66cf7d 831 write_exp_elt_opcode (UNOP_NEG);
e58de8a2
FF
832 }
833 | NOT operand_6
834 {
2e66cf7d 835 write_exp_elt_opcode (UNOP_LOGICAL_NOT);
e58de8a2 836 }
47f366bc 837 | parenthesised_expression literal
8a177da6
PB
838/* We require the string operand to be a literal, to avoid some
839 nasty parsing ambiguities. */
e58de8a2 840 {
2fcc38b8 841 write_exp_elt_opcode (BINOP_CONCAT);
e58de8a2
FF
842 }
843 ;
844
845/* Z.200, 5.3.9 */
846
847operand_6 : POINTER location
848 {
8a177da6 849 write_exp_elt_opcode (UNOP_ADDR);
e58de8a2
FF
850 }
851 | RECEIVE buffer_location
852 {
2e66cf7d 853 $$ = 0; /* FIXME */
e58de8a2
FF
854 }
855 | primitive_value
856 {
2e66cf7d 857 $$ = 0; /* FIXME */
e58de8a2
FF
858 }
859 ;
860
861
45fe3db4
FF
862/* Z.200, 6.2 */
863
81028ab0
FF
864single_assignment_action :
865 location GDB_ASSIGNMENT value
45fe3db4
FF
866 {
867 write_exp_elt_opcode (BINOP_ASSIGN);
868 }
81028ab0
FF
869 ;
870
871/* Z.200, 6.20.3 */
872
873chill_value_built_in_routine_call :
874 NUM '(' expression ')'
875 {
876 $$ = 0; /* FIXME */
877 }
878 | PRED '(' expression ')'
879 {
880 $$ = 0; /* FIXME */
881 }
882 | SUCC '(' expression ')'
883 {
884 $$ = 0; /* FIXME */
885 }
886 | ABS '(' expression ')'
887 {
888 $$ = 0; /* FIXME */
889 }
890 | CARD '(' expression ')'
891 {
892 $$ = 0; /* FIXME */
893 }
57ffffe3 894 | MAX_TOKEN '(' expression ')'
81028ab0
FF
895 {
896 $$ = 0; /* FIXME */
897 }
57ffffe3 898 | MIN_TOKEN '(' expression ')'
81028ab0
FF
899 {
900 $$ = 0; /* FIXME */
901 }
902 | SIZE '(' location ')'
903 {
904 $$ = 0; /* FIXME */
905 }
906 | SIZE '(' mode_argument ')'
907 {
908 $$ = 0; /* FIXME */
909 }
910 | UPPER '(' upper_lower_argument ')'
911 {
912 $$ = 0; /* FIXME */
913 }
914 | LOWER '(' upper_lower_argument ')'
915 {
916 $$ = 0; /* FIXME */
917 }
918 | LENGTH '(' length_argument ')'
919 {
920 $$ = 0; /* FIXME */
921 }
922 ;
923
924mode_argument : mode_name
925 {
926 $$ = 0; /* FIXME */
927 }
928 | array_mode_name '(' expression ')'
929 {
930 $$ = 0; /* FIXME */
931 }
932 | string_mode_name '(' expression ')'
933 {
934 $$ = 0; /* FIXME */
935 }
936 | variant_structure_mode_name '(' expression_list ')'
937 {
938 $$ = 0; /* FIXME */
939 }
940 ;
941
8a177da6
PB
942mode_name : TYPENAME
943 ;
944
945upper_lower_argument : expression
81028ab0
FF
946 {
947 $$ = 0; /* FIXME */
948 }
949 | mode_name
950 {
951 $$ = 0; /* FIXME */
952 }
953 ;
954
8a177da6 955length_argument : expression
81028ab0
FF
956 {
957 $$ = 0; /* FIXME */
958 }
959 ;
45fe3db4 960
54bbbfb4
FF
961/* Z.200, 12.4.3 */
962
963array_primitive_value : primitive_value
964 {
965 $$ = 0;
966 }
81028ab0 967 ;
54bbbfb4
FF
968
969
e58de8a2 970/* Things which still need productions... */
54bbbfb4 971
2fcc38b8
FF
972array_mode_name : FIXME_08 { $$ = 0; }
973string_mode_name : FIXME_09 { $$ = 0; }
974variant_structure_mode_name: FIXME_10 { $$ = 0; }
975synonym_name : FIXME_11 { $$ = 0; }
976value_enumeration_name : FIXME_12 { $$ = 0; }
977value_do_with_name : FIXME_13 { $$ = 0; }
978value_receive_name : FIXME_14 { $$ = 0; }
979string_primitive_value : FIXME_15 { $$ = 0; }
980start_element : FIXME_16 { $$ = 0; }
981left_element : FIXME_17 { $$ = 0; }
982right_element : FIXME_18 { $$ = 0; }
983slice_size : FIXME_19 { $$ = 0; }
984lower_element : FIXME_20 { $$ = 0; }
985upper_element : FIXME_21 { $$ = 0; }
986first_element : FIXME_22 { $$ = 0; }
2fcc38b8
FF
987boolean_expression : FIXME_26 { $$ = 0; }
988case_selector_list : FIXME_27 { $$ = 0; }
989subexpression : FIXME_28 { $$ = 0; }
990case_label_specification: FIXME_29 { $$ = 0; }
991buffer_location : FIXME_30 { $$ = 0; }
e58de8a2
FF
992
993%%
994
c7da3ed3
FF
995/* Implementation of a dynamically expandable buffer for processing input
996 characters acquired through lexptr and building a value to return in
997 yylval. */
998
999static char *tempbuf; /* Current buffer contents */
1000static int tempbufsize; /* Size of allocated buffer */
1001static int tempbufindex; /* Current index into buffer */
1002
1003#define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1004
1005#define CHECKBUF(size) \
1006 do { \
1007 if (tempbufindex + (size) >= tempbufsize) \
1008 { \
1009 growbuf_by_size (size); \
1010 } \
1011 } while (0);
1012
1013/* Grow the static temp buffer if necessary, including allocating the first one
1014 on demand. */
1015
1016static void
1017growbuf_by_size (count)
1018 int count;
1019{
1020 int growby;
1021
1022 growby = max (count, GROWBY_MIN_SIZE);
1023 tempbufsize += growby;
1024 if (tempbuf == NULL)
1025 {
1026 tempbuf = (char *) malloc (tempbufsize);
1027 }
1028 else
1029 {
1030 tempbuf = (char *) realloc (tempbuf, tempbufsize);
1031 }
1032}
1033
cbd1bdc3
FF
1034/* Try to consume a simple name string token. If successful, returns
1035 a pointer to a nullbyte terminated copy of the name that can be used
1036 in symbol table lookups. If not successful, returns NULL. */
1037
1038static char *
1039match_simple_name_string ()
1040{
1041 char *tokptr = lexptr;
1042
1043 if (isalpha (*tokptr))
1044 {
5a7c9cce 1045 char *result;
cbd1bdc3
FF
1046 do {
1047 tokptr++;
5a7c9cce 1048 } while (isalnum (*tokptr) || (*tokptr == '_'));
cbd1bdc3
FF
1049 yylval.sval.ptr = lexptr;
1050 yylval.sval.length = tokptr - lexptr;
1051 lexptr = tokptr;
5a7c9cce
PB
1052 result = copy_name (yylval.sval);
1053 for (tokptr = result; *tokptr; tokptr++)
1054 if (isupper (*tokptr))
1055 *tokptr = tolower(*tokptr);
1056 return result;
cbd1bdc3
FF
1057 }
1058 return (NULL);
1059}
1060
5d074aa9
FF
1061/* Start looking for a value composed of valid digits as set by the base
1062 in use. Note that '_' characters are valid anywhere, in any quantity,
1063 and are simply ignored. Since we must find at least one valid digit,
1064 or reject this token as an integer literal, we keep track of how many
1065 digits we have encountered. */
1066
1067static int
1068decode_integer_value (base, tokptrptr, ivalptr)
1069 int base;
1070 char **tokptrptr;
1071 int *ivalptr;
1072{
1073 char *tokptr = *tokptrptr;
1074 int temp;
1075 int digits = 0;
1076
1077 while (*tokptr != '\0')
1078 {
1079 temp = tolower (*tokptr);
1080 tokptr++;
1081 switch (temp)
1082 {
1083 case '_':
1084 continue;
1085 case '0': case '1': case '2': case '3': case '4':
1086 case '5': case '6': case '7': case '8': case '9':
1087 temp -= '0';
1088 break;
1089 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1090 temp -= 'a';
1091 temp += 10;
1092 break;
1093 default:
1094 temp = base;
1095 break;
1096 }
1097 if (temp < base)
1098 {
1099 digits++;
1100 *ivalptr *= base;
1101 *ivalptr += temp;
1102 }
1103 else
1104 {
1105 /* Found something not in domain for current base. */
1106 tokptr--; /* Unconsume what gave us indigestion. */
1107 break;
1108 }
1109 }
1110
1111 /* If we didn't find any digits, then we don't have a valid integer
1112 value, so reject the entire token. Otherwise, update the lexical
1113 scan pointer, and return non-zero for success. */
1114
1115 if (digits == 0)
1116 {
1117 return (0);
1118 }
1119 else
1120 {
1121 *tokptrptr = tokptr;
1122 return (1);
1123 }
1124}
1125
e58de8a2 1126static int
2e66cf7d 1127decode_integer_literal (valptr, tokptrptr)
5d074aa9
FF
1128 int *valptr;
1129 char **tokptrptr;
e58de8a2 1130{
2e66cf7d
FF
1131 char *tokptr = *tokptrptr;
1132 int base = 0;
1133 int ival = 0;
2e66cf7d
FF
1134 int explicit_base = 0;
1135
1136 /* Look for an explicit base specifier, which is optional. */
1137
1138 switch (*tokptr)
1139 {
1140 case 'd':
1141 case 'D':
1142 explicit_base++;
1143 base = 10;
1144 tokptr++;
1145 break;
1146 case 'b':
1147 case 'B':
1148 explicit_base++;
1149 base = 2;
1150 tokptr++;
1151 break;
1152 case 'h':
1153 case 'H':
1154 explicit_base++;
1155 base = 16;
1156 tokptr++;
1157 break;
1158 case 'o':
1159 case 'O':
1160 explicit_base++;
1161 base = 8;
1162 tokptr++;
1163 break;
1164 default:
1165 base = 10;
1166 break;
1167 }
1168
1169 /* If we found an explicit base ensure that the character after the
1170 explicit base is a single quote. */
1171
1172 if (explicit_base && (*tokptr++ != '\''))
1173 {
1174 return (0);
1175 }
1176
5d074aa9
FF
1177 /* Attempt to decode whatever follows as an integer value in the
1178 indicated base, updating the token pointer in the process and
1179 computing the value into ival. Also, if we have an explicit
2e66cf7d 1180 base, then the next character must not be a single quote, or we
5d074aa9
FF
1181 have a bitstring literal, so reject the entire token in this case.
1182 Otherwise, update the lexical scan pointer, and return non-zero
1183 for success. */
1184
1185 if (!decode_integer_value (base, &tokptr, &ival))
2e66cf7d
FF
1186 {
1187 return (0);
1188 }
1189 else if (explicit_base && (*tokptr == '\''))
1190 {
1191 return (0);
1192 }
1193 else
1194 {
1195 *valptr = ival;
1196 *tokptrptr = tokptr;
1197 return (1);
1198 }
1199}
1200
1188fbbf
FF
1201/* If it wasn't for the fact that floating point values can contain '_'
1202 characters, we could just let strtod do all the hard work by letting it
1203 try to consume as much of the current token buffer as possible and
1204 find a legal conversion. Unfortunately we need to filter out the '_'
1205 characters before calling strtod, which we do by copying the other
1206 legal chars to a local buffer to be converted. However since we also
1207 need to keep track of where the last unconsumed character in the input
1208 buffer is, we have transfer only as many characters as may compose a
1209 legal floating point value. */
1210
1211static int
1212match_float_literal ()
1213{
1214 char *tokptr = lexptr;
1215 char *buf;
1216 char *copy;
1188fbbf
FF
1217 double dval;
1218 extern double strtod ();
1219
1220 /* Make local buffer in which to build the string to convert. This is
1221 required because underscores are valid in chill floating point numbers
1222 but not in the string passed to strtod to convert. The string will be
1223 no longer than our input string. */
1224
1225 copy = buf = (char *) alloca (strlen (tokptr) + 1);
1226
1227 /* Transfer all leading digits to the conversion buffer, discarding any
1228 underscores. */
1229
1230 while (isdigit (*tokptr) || *tokptr == '_')
1231 {
1232 if (*tokptr != '_')
1233 {
1234 *copy++ = *tokptr;
1235 }
1236 tokptr++;
1237 }
1238
1239 /* Now accept either a '.', or one of [eEdD]. Dot is legal regardless
1240 of whether we found any leading digits, and we simply accept it and
1241 continue on to look for the fractional part and/or exponent. One of
1242 [eEdD] is legal only if we have seen digits, and means that there
1243 is no fractional part. If we find neither of these, then this is
1244 not a floating point number, so return failure. */
1245
1246 switch (*tokptr++)
1247 {
1248 case '.':
1249 /* Accept and then look for fractional part and/or exponent. */
1250 *copy++ = '.';
1251 break;
1252
1253 case 'e':
1254 case 'E':
1255 case 'd':
1256 case 'D':
1257 if (copy == buf)
1258 {
1259 return (0);
1260 }
1261 *copy++ = 'e';
1262 goto collect_exponent;
1263 break;
1264
1265 default:
1266 return (0);
1267 break;
1268 }
1269
1270 /* We found a '.', copy any fractional digits to the conversion buffer, up
1271 to the first nondigit, non-underscore character. */
1272
1273 while (isdigit (*tokptr) || *tokptr == '_')
1274 {
1275 if (*tokptr != '_')
1276 {
1277 *copy++ = *tokptr;
1278 }
1279 tokptr++;
1280 }
1281
1282 /* Look for an exponent, which must start with one of [eEdD]. If none
1283 is found, jump directly to trying to convert what we have collected
1284 so far. */
1285
1286 switch (*tokptr)
1287 {
1288 case 'e':
1289 case 'E':
1290 case 'd':
1291 case 'D':
1292 *copy++ = 'e';
1293 tokptr++;
1294 break;
1295 default:
1296 goto convert_float;
1297 break;
1298 }
1299
1300 /* Accept an optional '-' or '+' following one of [eEdD]. */
1301
1302 collect_exponent:
1303 if (*tokptr == '+' || *tokptr == '-')
1304 {
1305 *copy++ = *tokptr++;
1306 }
1307
1308 /* Now copy an exponent into the conversion buffer. Note that at the
1309 moment underscores are *not* allowed in exponents. */
1310
1311 while (isdigit (*tokptr))
1312 {
1313 *copy++ = *tokptr++;
1314 }
1315
1316 /* If we transfered any chars to the conversion buffer, try to interpret its
1317 contents as a floating point value. If any characters remain, then we
1318 must not have a valid floating point string. */
1319
1320 convert_float:
1321 *copy = '\0';
1322 if (copy != buf)
1323 {
1324 dval = strtod (buf, &copy);
1325 if (*copy == '\0')
1326 {
1327 yylval.dval = dval;
1328 lexptr = tokptr;
1329 return (FLOAT_LITERAL);
1330 }
1331 }
1332 return (0);
1333}
1334
c7da3ed3
FF
1335/* Recognize a string literal. A string literal is a nonzero sequence
1336 of characters enclosed in matching single or double quotes, except that
1337 a single character inside single quotes is a character literal, which
1338 we reject as a string literal. To embed the terminator character inside
1339 a string, it is simply doubled (I.E. "this""is""one""string") */
1340
1341static int
1342match_string_literal ()
1343{
1344 char *tokptr = lexptr;
1345
1346 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1347 {
1348 CHECKBUF (1);
1349 if (*tokptr == *lexptr)
1350 {
1351 if (*(tokptr + 1) == *lexptr)
1352 {
1353 tokptr++;
1354 }
1355 else
1356 {
1357 break;
1358 }
1359 }
1360 tempbuf[tempbufindex++] = *tokptr;
1361 }
1362 if (*tokptr == '\0' /* no terminator */
1363 || tempbufindex == 0 /* no string */
1364 || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
1365 {
1366 return (0);
1367 }
1368 else
1369 {
1370 tempbuf[tempbufindex] = '\0';
1371 yylval.sval.ptr = tempbuf;
1372 yylval.sval.length = tempbufindex;
1373 lexptr = ++tokptr;
1374 return (CHARACTER_STRING_LITERAL);
1375 }
1376}
1377
2e66cf7d
FF
1378/* Recognize a character literal. A character literal is single character
1379 or a control sequence, enclosed in single quotes. A control sequence
1380 is a comma separated list of one or more integer literals, enclosed
1381 in parenthesis and introduced with a circumflex character.
1382
1383 EX: 'a' '^(7)' '^(7,8)'
1384
5d074aa9
FF
1385 As a GNU chill extension, the syntax C'xx' is also recognized as a
1386 character literal, where xx is a hex value for the character.
1387
c7da3ed3
FF
1388 Note that more than a single character, enclosed in single quotes, is
1389 a string literal.
1390
c4413e2c
FF
1391 Also note that the control sequence form is not in GNU Chill since it
1392 is ambiguous with the string literal form using single quotes. I.E.
1393 is '^(7)' a character literal or a string literal. In theory it it
1394 possible to tell by context, but GNU Chill doesn't accept the control
1395 sequence form, so neither do we (for now the code is disabled).
1396
2e66cf7d
FF
1397 Returns CHARACTER_LITERAL if a match is found.
1398 */
1399
1400static int
1401match_character_literal ()
1402{
1403 char *tokptr = lexptr;
1404 int ival = 0;
1405
5d074aa9 1406 if ((tolower (*tokptr) == 'c') && (*(tokptr + 1) == '\''))
2e66cf7d 1407 {
5d074aa9
FF
1408 /* We have a GNU chill extension form, so skip the leading "C'",
1409 decode the hex value, and then ensure that we have a trailing
1410 single quote character. */
2e66cf7d 1411 tokptr += 2;
5d074aa9 1412 if (!decode_integer_value (16, &tokptr, &ival) || (*tokptr != '\''))
e58de8a2 1413 {
2e66cf7d 1414 return (0);
e58de8a2 1415 }
5d074aa9 1416 tokptr++;
2e66cf7d 1417 }
5d074aa9 1418 else if (*tokptr == '\'')
2e66cf7d 1419 {
5d074aa9 1420 tokptr++;
2e66cf7d 1421
5d074aa9
FF
1422 /* Determine which form we have, either a control sequence or the
1423 single character form. */
1424
1425 if ((*tokptr == '^') && (*(tokptr + 1) == '('))
1426 {
9da75ad3 1427#if 0 /* Disable, see note above. -fnf */
5d074aa9
FF
1428 /* Match and decode a control sequence. Return zero if we don't
1429 find a valid integer literal, or if the next unconsumed character
1430 after the integer literal is not the trailing ')'.
1431 FIXME: We currently don't handle the multiple integer literal
1432 form. */
1433 tokptr += 2;
1434 if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
1435 {
1436 return (0);
1437 }
9da75ad3
FF
1438#else
1439 return (0);
1440#endif
5d074aa9
FF
1441 }
1442 else
1443 {
1444 ival = *tokptr++;
1445 }
1446
1447 /* The trailing quote has not yet been consumed. If we don't find
1448 it, then we have no match. */
1449
1450 if (*tokptr++ != '\'')
1451 {
1452 return (0);
1453 }
2e66cf7d 1454 }
aed656ba
FF
1455 else
1456 {
1457 /* Not a character literal. */
1458 return (0);
1459 }
2e66cf7d
FF
1460 yylval.typed_val.val = ival;
1461 yylval.typed_val.type = builtin_type_chill_char;
1462 lexptr = tokptr;
1463 return (CHARACTER_LITERAL);
e58de8a2
FF
1464}
1465
1466/* Recognize an integer literal, as specified in Z.200 sec 5.2.4.2.
1467 Note that according to 5.2.4.2, a single "_" is also a valid integer
1468 literal, however GNU-chill requires there to be at least one "digit"
1469 in any integer literal. */
1470
1471static int
2e66cf7d 1472match_integer_literal ()
e58de8a2 1473{
2e66cf7d 1474 char *tokptr = lexptr;
ae0afa4b 1475 int ival;
2e66cf7d 1476
ae0afa4b 1477 if (!decode_integer_literal (&ival, &tokptr))
2e66cf7d
FF
1478 {
1479 return (0);
1480 }
ae0afa4b 1481 else
2e66cf7d
FF
1482 {
1483 yylval.typed_val.val = ival;
1484 yylval.typed_val.type = builtin_type_int;
1485 lexptr = tokptr;
1486 return (INTEGER_LITERAL);
1487 }
e58de8a2
FF
1488}
1489
81028ab0
FF
1490/* Recognize a bit-string literal, as specified in Z.200 sec 5.2.4.8
1491 Note that according to 5.2.4.8, a single "_" is also a valid bit-string
1492 literal, however GNU-chill requires there to be at least one "digit"
1493 in any bit-string literal. */
1494
1495static int
1496match_bitstring_literal ()
1497{
1498 char *tokptr = lexptr;
1499 int mask;
1500 int bitoffset = 0;
1501 int bitcount = 0;
1502 int base;
1503 int digit;
81028ab0 1504
c7da3ed3
FF
1505 tempbufindex = 0;
1506
81028ab0
FF
1507 /* Look for the required explicit base specifier. */
1508
1509 switch (*tokptr++)
1510 {
1511 case 'b':
1512 case 'B':
1513 base = 2;
1514 break;
1515 case 'o':
1516 case 'O':
1517 base = 8;
1518 break;
1519 case 'h':
1520 case 'H':
1521 base = 16;
1522 break;
1523 default:
1524 return (0);
1525 break;
1526 }
1527
1528 /* Ensure that the character after the explicit base is a single quote. */
1529
1530 if (*tokptr++ != '\'')
1531 {
1532 return (0);
1533 }
1534
1535 while (*tokptr != '\0' && *tokptr != '\'')
1536 {
1537 digit = tolower (*tokptr);
1538 tokptr++;
1539 switch (digit)
1540 {
1541 case '_':
1542 continue;
1543 case '0': case '1': case '2': case '3': case '4':
1544 case '5': case '6': case '7': case '8': case '9':
1545 digit -= '0';
1546 break;
1547 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1548 digit -= 'a';
1549 digit += 10;
1550 break;
1551 default:
1552 return (0);
1553 break;
1554 }
1555 if (digit >= base)
1556 {
1557 /* Found something not in domain for current base. */
1558 return (0);
1559 }
1560 else
1561 {
1562 /* Extract bits from digit, starting with the msbit appropriate for
1563 the current base, and packing them into the bitstring byte,
1564 starting at the lsbit. */
1565 for (mask = (base >> 1); mask > 0; mask >>= 1)
1566 {
1567 bitcount++;
c7da3ed3 1568 CHECKBUF (1);
81028ab0
FF
1569 if (digit & mask)
1570 {
1571 tempbuf[tempbufindex] |= (1 << bitoffset);
1572 }
1573 bitoffset++;
1574 if (bitoffset == HOST_CHAR_BIT)
1575 {
1576 bitoffset = 0;
1577 tempbufindex++;
1578 }
1579 }
1580 }
1581 }
1582
1583 /* Verify that we consumed everything up to the trailing single quote,
1584 and that we found some bits (IE not just underbars). */
1585
1586 if (*tokptr++ != '\'')
1587 {
1588 return (0);
1589 }
1590 else
1591 {
1592 yylval.sval.ptr = tempbuf;
1593 yylval.sval.length = bitcount;
1594 lexptr = tokptr;
1595 return (BIT_STRING_LITERAL);
1596 }
1597}
1598
45fe3db4
FF
1599/* Recognize tokens that start with '$'. These include:
1600
1601 $regname A native register name or a "standard
1602 register name".
1603 Return token GDB_REGNAME.
1604
1605 $variable A convenience variable with a name chosen
1606 by the user.
1607 Return token GDB_VARIABLE.
1608
1609 $digits Value history with index <digits>, starting
1610 from the first value which has index 1.
1611 Return GDB_LAST.
1612
1613 $$digits Value history with index <digits> relative
1614 to the last value. I.E. $$0 is the last
1615 value, $$1 is the one previous to that, $$2
1616 is the one previous to $$1, etc.
1617 Return token GDB_LAST.
1618
1619 $ | $0 | $$0 The last value in the value history.
1620 Return token GDB_LAST.
1621
1622 $$ An abbreviation for the second to the last
1623 value in the value history, I.E. $$1
1624 Return token GDB_LAST.
1625
1626 Note that we currently assume that register names and convenience
1627 variables follow the convention of starting with a letter or '_'.
1628
1629 */
1630
1631static int
1632match_dollar_tokens ()
1633{
1634 char *tokptr;
1635 int regno;
1636 int namelength;
1637 int negate;
1638 int ival;
1639
1640 /* We will always have a successful match, even if it is just for
1641 a single '$', the abbreviation for $$0. So advance lexptr. */
1642
1643 tokptr = ++lexptr;
1644
1645 if (*tokptr == '_' || isalpha (*tokptr))
1646 {
1647 /* Look for a match with a native register name, usually something
1648 like "r0" for example. */
1649
1650 for (regno = 0; regno < NUM_REGS; regno++)
1651 {
1652 namelength = strlen (reg_names[regno]);
1653 if (STREQN (tokptr, reg_names[regno], namelength)
1654 && !isalnum (tokptr[namelength]))
1655 {
1656 yylval.lval = regno;
1657 lexptr += namelength + 1;
1658 return (GDB_REGNAME);
1659 }
1660 }
1661
1662 /* Look for a match with a standard register name, usually something
1663 like "pc", which gdb always recognizes as the program counter
1664 regardless of what the native register name is. */
1665
1666 for (regno = 0; regno < num_std_regs; regno++)
1667 {
1668 namelength = strlen (std_regs[regno].name);
1669 if (STREQN (tokptr, std_regs[regno].name, namelength)
1670 && !isalnum (tokptr[namelength]))
1671 {
1672 yylval.lval = std_regs[regno].regnum;
1673 lexptr += namelength;
1674 return (GDB_REGNAME);
1675 }
1676 }
1677
1678 /* Attempt to match against a convenience variable. Note that
1679 this will always succeed, because if no variable of that name
1680 already exists, the lookup_internalvar will create one for us.
1681 Also note that both lexptr and tokptr currently point to the
1682 start of the input string we are trying to match, and that we
1683 have already tested the first character for non-numeric, so we
1684 don't have to treat it specially. */
1685
1686 while (*tokptr == '_' || isalnum (*tokptr))
1687 {
1688 tokptr++;
1689 }
1690 yylval.sval.ptr = lexptr;
1691 yylval.sval.length = tokptr - lexptr;
1692 yylval.ivar = lookup_internalvar (copy_name (yylval.sval));
1693 lexptr = tokptr;
1694 return (GDB_VARIABLE);
1695 }
1696
1697 /* Since we didn't match against a register name or convenience
1698 variable, our only choice left is a history value. */
1699
1700 if (*tokptr == '$')
1701 {
1702 negate = 1;
1703 ival = 1;
1704 tokptr++;
1705 }
1706 else
1707 {
1708 negate = 0;
1709 ival = 0;
1710 }
1711
1712 /* Attempt to decode more characters as an integer value giving
1713 the index in the history list. If successful, the value will
1714 overwrite ival (currently 0 or 1), and if not, ival will be
1715 left alone, which is good since it is currently correct for
1716 the '$' or '$$' case. */
1717
1718 decode_integer_literal (&ival, &tokptr);
1719 yylval.lval = negate ? -ival : ival;
1720 lexptr = tokptr;
1721 return (GDB_LAST);
1722}
1723
e58de8a2
FF
1724struct token
1725{
1726 char *operator;
1727 int token;
1728};
1729
5a7c9cce 1730static const struct token idtokentab[] =
81028ab0 1731{
5a7c9cce
PB
1732 { "length", LENGTH },
1733 { "lower", LOWER },
1734 { "upper", UPPER },
1735 { "andif", ANDIF },
1736 { "pred", PRED },
1737 { "succ", SUCC },
1738 { "card", CARD },
1739 { "size", SIZE },
1740 { "orif", ORIF },
1741 { "num", NUM },
1742 { "abs", ABS },
57ffffe3
JG
1743 { "max", MAX_TOKEN },
1744 { "min", MIN_TOKEN },
5a7c9cce
PB
1745 { "mod", MOD },
1746 { "rem", REM },
1747 { "not", NOT },
1748 { "xor", LOGXOR },
1749 { "and", LOGAND },
1750 { "in", IN },
1751 { "or", LOGIOR }
e58de8a2
FF
1752};
1753
a8a69e63 1754static const struct token tokentab2[] =
e58de8a2 1755{
45fe3db4 1756 { ":=", GDB_ASSIGNMENT },
e58de8a2 1757 { "//", SLASH_SLASH },
8a177da6 1758 { "->", POINTER },
e58de8a2
FF
1759 { "/=", NOTEQUAL },
1760 { "<=", LEQ },
5a7c9cce 1761 { ">=", GTR }
e58de8a2
FF
1762};
1763
1764/* Read one token, getting characters through lexptr. */
1765/* This is where we will check to make sure that the language and the
1766 operators used are compatible. */
1767
1768static int
1769yylex ()
1770{
1771 unsigned int i;
1772 int token;
cbd1bdc3
FF
1773 char *simplename;
1774 struct symbol *sym;
e58de8a2
FF
1775
1776 /* Skip over any leading whitespace. */
1777 while (isspace (*lexptr))
1778 {
1779 lexptr++;
1780 }
1781 /* Look for special single character cases which can't be the first
1782 character of some other multicharacter token. */
1783 switch (*lexptr)
1784 {
1785 case '\0':
1786 return (0);
54bbbfb4 1787 case ',':
e58de8a2 1788 case '=':
e58de8a2
FF
1789 case ';':
1790 case '!':
1791 case '+':
e58de8a2 1792 case '*':
e58de8a2
FF
1793 case '(':
1794 case ')':
1795 case '[':
1796 case ']':
1797 return (*lexptr++);
1798 }
1799 /* Look for characters which start a particular kind of multicharacter
45fe3db4 1800 token, such as a character literal, register name, convenience
c7da3ed3 1801 variable name, string literal, etc. */
e58de8a2 1802 switch (*lexptr)
2e66cf7d 1803 {
c7da3ed3
FF
1804 case '\'':
1805 case '\"':
1806 /* First try to match a string literal, which is any nonzero
1807 sequence of characters enclosed in matching single or double
1808 quotes, except that a single character inside single quotes
1809 is a character literal, so we have to catch that case also. */
1810 token = match_string_literal ();
1811 if (token != 0)
1812 {
1813 return (token);
1814 }
1815 if (*lexptr == '\'')
1816 {
1817 token = match_character_literal ();
1818 if (token != 0)
1819 {
1820 return (token);
1821 }
1822 }
1823 break;
5d074aa9
FF
1824 case 'C':
1825 case 'c':
2e66cf7d
FF
1826 token = match_character_literal ();
1827 if (token != 0)
1828 {
1829 return (token);
1830 }
1831 break;
45fe3db4
FF
1832 case '$':
1833 token = match_dollar_tokens ();
1834 if (token != 0)
1835 {
1836 return (token);
1837 }
1838 break;
2e66cf7d 1839 }
e58de8a2
FF
1840 /* See if it is a special token of length 2. */
1841 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1842 {
45fe3db4 1843 if (STREQN (lexptr, tokentab2[i].operator, 2))
e58de8a2
FF
1844 {
1845 lexptr += 2;
1846 return (tokentab2[i].token);
1847 }
1848 }
1849 /* Look for single character cases which which could be the first
1850 character of some other multicharacter token, but aren't, or we
1851 would already have found it. */
1852 switch (*lexptr)
1853 {
8a177da6 1854 case '-':
45fe3db4 1855 case ':':
e58de8a2
FF
1856 case '/':
1857 case '<':
1858 case '>':
1859 return (*lexptr++);
1860 }
1188fbbf
FF
1861 /* Look for a float literal before looking for an integer literal, so
1862 we match as much of the input stream as possible. */
1863 token = match_float_literal ();
81028ab0
FF
1864 if (token != 0)
1865 {
1866 return (token);
1867 }
1868 token = match_bitstring_literal ();
1188fbbf
FF
1869 if (token != 0)
1870 {
1871 return (token);
1872 }
2e66cf7d 1873 token = match_integer_literal ();
cbd1bdc3 1874 if (token != 0)
e58de8a2
FF
1875 {
1876 return (token);
1877 }
cbd1bdc3
FF
1878
1879 /* Try to match a simple name string, and if a match is found, then
1880 further classify what sort of name it is and return an appropriate
1881 token. Note that attempting to match a simple name string consumes
1882 the token from lexptr, so we can't back out if we later find that
1883 we can't classify what sort of name it is. */
1884
1885 simplename = match_simple_name_string ();
5a7c9cce 1886
cbd1bdc3
FF
1887 if (simplename != NULL)
1888 {
d8f23320
PS
1889 /* See if it is a reserved identifier. */
1890 for (i = 0; i < sizeof (idtokentab) / sizeof (idtokentab[0]); i++)
1891 {
1892 if (STREQ (simplename, idtokentab[i].operator))
1893 {
1894 return (idtokentab[i].token);
1895 }
1896 }
1897
1898 /* Look for other special tokens. */
1899 if (STREQ (simplename, "true"))
1900 {
1901 yylval.ulval = 1;
1902 return (BOOLEAN_LITERAL);
1903 }
1904 if (STREQ (simplename, "false"))
1905 {
1906 yylval.ulval = 0;
1907 return (BOOLEAN_LITERAL);
1908 }
1909
cbd1bdc3
FF
1910 sym = lookup_symbol (simplename, expression_context_block,
1911 VAR_NAMESPACE, (int *) NULL,
1912 (struct symtab **) NULL);
1913 if (sym != NULL)
1914 {
1915 yylval.ssym.stoken.ptr = NULL;
1916 yylval.ssym.stoken.length = 0;
1917 yylval.ssym.sym = sym;
1918 yylval.ssym.is_a_field_of_this = 0; /* FIXME, C++'ism */
1919 switch (SYMBOL_CLASS (sym))
1920 {
1921 case LOC_BLOCK:
1922 /* Found a procedure name. */
1923 return (GENERAL_PROCEDURE_NAME);
1924 case LOC_STATIC:
1925 /* Found a global or local static variable. */
1926 return (LOCATION_NAME);
a8a69e63
FF
1927 case LOC_REGISTER:
1928 case LOC_ARG:
1929 case LOC_REF_ARG:
1930 case LOC_REGPARM:
996ccb30 1931 case LOC_REGPARM_ADDR:
a8a69e63 1932 case LOC_LOCAL:
76a0ffb4 1933 case LOC_LOCAL_ARG:
a1c8d76e
JK
1934 case LOC_BASEREG:
1935 case LOC_BASEREG_ARG:
76a0ffb4
FF
1936 if (innermost_block == NULL
1937 || contained_in (block_found, innermost_block))
1938 {
1939 innermost_block = block_found;
1940 }
1941 return (LOCATION_NAME);
1942 break;
1943 case LOC_CONST:
a8a69e63 1944 case LOC_LABEL:
76a0ffb4
FF
1945 return (LOCATION_NAME);
1946 break;
76a0ffb4 1947 case LOC_TYPEDEF:
8a177da6
PB
1948 yylval.tsym.type = SYMBOL_TYPE (sym);
1949 return TYPENAME;
1950 case LOC_UNDEF:
a8a69e63 1951 case LOC_CONST_BYTES:
0848ad1c 1952 case LOC_OPTIMIZED_OUT:
76a0ffb4 1953 error ("Symbol \"%s\" names no location.", simplename);
a8a69e63 1954 break;
cbd1bdc3
FF
1955 }
1956 }
1957 else if (!have_full_symbols () && !have_partial_symbols ())
1958 {
1959 error ("No symbol table is loaded. Use the \"file\" command.");
1960 }
1961 else
1962 {
1963 error ("No symbol \"%s\" in current context.", simplename);
1964 }
1965 }
1966
1188fbbf
FF
1967 /* Catch single character tokens which are not part of some
1968 longer token. */
1969
1970 switch (*lexptr)
1971 {
1972 case '.': /* Not float for example. */
8a177da6
PB
1973 lexptr++;
1974 while (isspace (*lexptr)) lexptr++;
1975 simplename = match_simple_name_string ();
1976 if (!simplename)
1977 return '.';
1978 return FIELD_NAME;
1188fbbf
FF
1979 }
1980
e58de8a2
FF
1981 return (ILLEGAL_TOKEN);
1982}
1983
22e39759 1984void
e58de8a2
FF
1985yyerror (msg)
1986 char *msg; /* unused */
1987{
1988 printf ("Parsing: %s\n", lexptr);
1989 if (yychar < 256)
1990 {
1991 error ("Invalid syntax in expression near character '%c'.", yychar);
1992 }
1993 else
1994 {
1995 error ("Invalid syntax in expression");
1996 }
1997}
This page took 0.150189 seconds and 4 git commands to generate.