Commit | Line | Data |
---|---|---|
14f9c5c9 | 1 | /* YACC parser for Ada expressions, for GDB. |
6aba47ca | 2 | Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003, 2004, |
9b254dd1 | 3 | 2007, 2008 Free Software Foundation, Inc. |
14f9c5c9 AS |
4 | |
5 | This file is part of GDB. | |
6 | ||
7 | This program is free software; you can redistribute it and/or modify | |
8 | it under the terms of the GNU General Public License as published by | |
9 | the Free Software Foundation; either version 2 of the License, or | |
10 | (at your option) any later version. | |
11 | ||
12 | This program is distributed in the hope that it will be useful, | |
13 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | GNU General Public License for more details. | |
16 | ||
17 | You should have received a copy of the GNU General Public License | |
18 | along with this program; if not, write to the Free Software | |
197e01b6 EZ |
19 | Foundation, Inc., 51 Franklin Street, Fifth Floor, |
20 | Boston, MA 02110-1301, USA. */ | |
14f9c5c9 AS |
21 | |
22 | /* Parse an Ada expression from text in a string, | |
23 | and return the result as a struct expression pointer. | |
24 | That structure contains arithmetic operations in reverse polish, | |
25 | with constants represented by operations that are followed by special data. | |
26 | See expression.h for the details of the format. | |
27 | What is important here is that it can be built up sequentially | |
28 | during the process of parsing; the lower levels of the tree always | |
29 | come first in the result. | |
30 | ||
31 | malloc's and realloc's in this file are transformed to | |
32 | xmalloc and xrealloc respectively by the same sed command in the | |
33 | makefile that remaps any other malloc/realloc inserted by the parser | |
34 | generator. Doing this with #defines and trying to control the interaction | |
35 | with include files (<malloc.h> and <stdlib.h> for example) just became | |
36 | too messy, particularly when such includes can be inserted at random | |
37 | times by the parser generator. */ | |
4c4b4cd2 | 38 | |
14f9c5c9 AS |
39 | %{ |
40 | ||
41 | #include "defs.h" | |
19c1ef65 | 42 | #include "gdb_string.h" |
14f9c5c9 AS |
43 | #include <ctype.h> |
44 | #include "expression.h" | |
45 | #include "value.h" | |
46 | #include "parser-defs.h" | |
47 | #include "language.h" | |
48 | #include "ada-lang.h" | |
49 | #include "bfd.h" /* Required by objfiles.h. */ | |
50 | #include "symfile.h" /* Required by objfiles.h. */ | |
51 | #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ | |
52 | #include "frame.h" | |
fe898f56 | 53 | #include "block.h" |
14f9c5c9 | 54 | |
3e79cecf UW |
55 | #define parse_type builtin_type (parse_gdbarch) |
56 | ||
14f9c5c9 AS |
57 | /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), |
58 | as well as gratuitiously global symbol names, so we can have multiple | |
59 | yacc generated parsers in gdb. These are only the variables | |
60 | produced by yacc. If other parser generators (bison, byacc, etc) produce | |
61 | additional global names that conflict at link time, then those parser | |
4c4b4cd2 | 62 | generators need to be fixed instead of adding those names to this list. */ |
14f9c5c9 | 63 | |
4c4b4cd2 | 64 | /* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix |
14f9c5c9 AS |
65 | options. I presume we are maintaining it to accommodate systems |
66 | without BISON? (PNH) */ | |
67 | ||
68 | #define yymaxdepth ada_maxdepth | |
69 | #define yyparse _ada_parse /* ada_parse calls this after initialization */ | |
70 | #define yylex ada_lex | |
71 | #define yyerror ada_error | |
72 | #define yylval ada_lval | |
73 | #define yychar ada_char | |
74 | #define yydebug ada_debug | |
4c4b4cd2 PH |
75 | #define yypact ada_pact |
76 | #define yyr1 ada_r1 | |
77 | #define yyr2 ada_r2 | |
78 | #define yydef ada_def | |
79 | #define yychk ada_chk | |
80 | #define yypgo ada_pgo | |
81 | #define yyact ada_act | |
14f9c5c9 AS |
82 | #define yyexca ada_exca |
83 | #define yyerrflag ada_errflag | |
84 | #define yynerrs ada_nerrs | |
85 | #define yyps ada_ps | |
86 | #define yypv ada_pv | |
87 | #define yys ada_s | |
88 | #define yy_yys ada_yys | |
89 | #define yystate ada_state | |
90 | #define yytmp ada_tmp | |
91 | #define yyv ada_v | |
92 | #define yy_yyv ada_yyv | |
93 | #define yyval ada_val | |
94 | #define yylloc ada_lloc | |
95 | #define yyreds ada_reds /* With YYDEBUG defined */ | |
96 | #define yytoks ada_toks /* With YYDEBUG defined */ | |
06891d83 JT |
97 | #define yyname ada_name /* With YYDEBUG defined */ |
98 | #define yyrule ada_rule /* With YYDEBUG defined */ | |
14f9c5c9 AS |
99 | |
100 | #ifndef YYDEBUG | |
f461f5cf | 101 | #define YYDEBUG 1 /* Default to yydebug support */ |
14f9c5c9 AS |
102 | #endif |
103 | ||
f461f5cf PM |
104 | #define YYFPRINTF parser_fprintf |
105 | ||
14f9c5c9 | 106 | struct name_info { |
4c4b4cd2 PH |
107 | struct symbol *sym; |
108 | struct minimal_symbol *msym; | |
109 | struct block *block; | |
14f9c5c9 AS |
110 | struct stoken stoken; |
111 | }; | |
112 | ||
52ce6436 PH |
113 | static struct stoken empty_stoken = { "", 0 }; |
114 | ||
14f9c5c9 | 115 | /* If expression is in the context of TYPE'(...), then TYPE, else |
4c4b4cd2 PH |
116 | * NULL. */ |
117 | static struct type *type_qualifier; | |
14f9c5c9 AS |
118 | |
119 | int yyparse (void); | |
120 | ||
121 | static int yylex (void); | |
122 | ||
123 | void yyerror (char *); | |
124 | ||
125 | static struct stoken string_to_operator (struct stoken); | |
126 | ||
4c4b4cd2 | 127 | static void write_int (LONGEST, struct type *); |
14f9c5c9 | 128 | |
aeb5907d JB |
129 | static void write_object_renaming (struct block *, const char *, int, |
130 | const char *, int); | |
14f9c5c9 | 131 | |
52ce6436 PH |
132 | static struct type* write_var_or_type (struct block *, struct stoken); |
133 | ||
134 | static void write_name_assoc (struct stoken); | |
135 | ||
136 | static void write_exp_op_with_string (enum exp_opcode, struct stoken); | |
137 | ||
138 | static struct block *block_lookup (struct block *, char *); | |
14f9c5c9 | 139 | |
19c1ef65 | 140 | static LONGEST convert_char_literal (struct type *, LONGEST); |
72d5681a | 141 | |
52ce6436 PH |
142 | static void write_ambiguous_var (struct block *, char *, int); |
143 | ||
72d5681a PH |
144 | static struct type *type_int (void); |
145 | ||
146 | static struct type *type_long (void); | |
147 | ||
148 | static struct type *type_long_long (void); | |
149 | ||
150 | static struct type *type_float (void); | |
151 | ||
152 | static struct type *type_double (void); | |
153 | ||
154 | static struct type *type_long_double (void); | |
155 | ||
156 | static struct type *type_char (void); | |
157 | ||
690cc4eb PH |
158 | static struct type *type_boolean (void); |
159 | ||
72d5681a | 160 | static struct type *type_system_address (void); |
52ce6436 | 161 | |
4c4b4cd2 | 162 | %} |
14f9c5c9 AS |
163 | |
164 | %union | |
165 | { | |
166 | LONGEST lval; | |
167 | struct { | |
168 | LONGEST val; | |
169 | struct type *type; | |
170 | } typed_val; | |
171 | struct { | |
172 | DOUBLEST dval; | |
173 | struct type *type; | |
174 | } typed_val_float; | |
175 | struct type *tval; | |
176 | struct stoken sval; | |
14f9c5c9 AS |
177 | struct block *bval; |
178 | struct internalvar *ivar; | |
14f9c5c9 AS |
179 | } |
180 | ||
52ce6436 PH |
181 | %type <lval> positional_list component_groups component_associations |
182 | %type <lval> aggregate_component_list | |
183 | %type <tval> var_or_type | |
14f9c5c9 AS |
184 | |
185 | %token <typed_val> INT NULL_PTR CHARLIT | |
186 | %token <typed_val_float> FLOAT | |
690cc4eb | 187 | %token TRUEKEYWORD FALSEKEYWORD |
52ce6436 PH |
188 | %token COLONCOLON |
189 | %token <sval> STRING NAME DOT_ID | |
4c4b4cd2 | 190 | %type <bval> block |
14f9c5c9 AS |
191 | %type <lval> arglist tick_arglist |
192 | ||
193 | %type <tval> save_qualifier | |
194 | ||
195 | %token DOT_ALL | |
196 | ||
197 | /* Special type cases, put in to allow the parser to distinguish different | |
198 | legal basetypes. */ | |
4c4b4cd2 | 199 | %token <sval> SPECIAL_VARIABLE |
14f9c5c9 AS |
200 | |
201 | %nonassoc ASSIGN | |
202 | %left _AND_ OR XOR THEN ELSE | |
203 | %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT | |
204 | %left '@' | |
205 | %left '+' '-' '&' | |
206 | %left UNARY | |
207 | %left '*' '/' MOD REM | |
208 | %right STARSTAR ABS NOT | |
52ce6436 PH |
209 | |
210 | /* Artificial token to give NAME => ... and NAME | priority over reducing | |
211 | NAME to <primary> and to give <primary>' priority over reducing <primary> | |
212 | to <simple_exp>. */ | |
213 | %nonassoc VAR | |
214 | ||
215 | %nonassoc ARROW '|' | |
216 | ||
14f9c5c9 AS |
217 | %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH |
218 | %right TICK_MAX TICK_MIN TICK_MODULUS | |
219 | %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL | |
52ce6436 PH |
220 | /* The following are right-associative only so that reductions at this |
221 | precedence have lower precedence than '.' and '('. The syntax still | |
222 | forces a.b.c, e.g., to be LEFT-associated. */ | |
14f9c5c9 AS |
223 | %right '.' '(' '[' DOT_ID DOT_ALL |
224 | ||
52ce6436 | 225 | %token NEW OTHERS |
14f9c5c9 AS |
226 | |
227 | \f | |
228 | %% | |
229 | ||
230 | start : exp1 | |
14f9c5c9 AS |
231 | ; |
232 | ||
233 | /* Expressions, including the sequencing operator. */ | |
234 | exp1 : exp | |
235 | | exp1 ';' exp | |
236 | { write_exp_elt_opcode (BINOP_COMMA); } | |
52ce6436 PH |
237 | | primary ASSIGN exp /* Extension for convenience */ |
238 | { write_exp_elt_opcode (BINOP_ASSIGN); } | |
14f9c5c9 AS |
239 | ; |
240 | ||
241 | /* Expressions, not including the sequencing operator. */ | |
52ce6436 | 242 | primary : primary DOT_ALL |
14f9c5c9 AS |
243 | { write_exp_elt_opcode (UNOP_IND); } |
244 | ; | |
245 | ||
52ce6436 PH |
246 | primary : primary DOT_ID |
247 | { write_exp_op_with_string (STRUCTOP_STRUCT, $2); } | |
14f9c5c9 AS |
248 | ; |
249 | ||
52ce6436 | 250 | primary : primary '(' arglist ')' |
14f9c5c9 AS |
251 | { |
252 | write_exp_elt_opcode (OP_FUNCALL); | |
253 | write_exp_elt_longcst ($3); | |
254 | write_exp_elt_opcode (OP_FUNCALL); | |
255 | } | |
52ce6436 | 256 | | var_or_type '(' arglist ')' |
14f9c5c9 | 257 | { |
52ce6436 PH |
258 | if ($1 != NULL) |
259 | { | |
260 | if ($3 != 1) | |
e1d5a0d2 | 261 | error (_("Invalid conversion")); |
52ce6436 PH |
262 | write_exp_elt_opcode (UNOP_CAST); |
263 | write_exp_elt_type ($1); | |
264 | write_exp_elt_opcode (UNOP_CAST); | |
265 | } | |
266 | else | |
267 | { | |
268 | write_exp_elt_opcode (OP_FUNCALL); | |
269 | write_exp_elt_longcst ($3); | |
270 | write_exp_elt_opcode (OP_FUNCALL); | |
271 | } | |
14f9c5c9 AS |
272 | } |
273 | ; | |
274 | ||
52ce6436 PH |
275 | primary : var_or_type '\'' save_qualifier { type_qualifier = $1; } |
276 | '(' exp ')' | |
14f9c5c9 | 277 | { |
52ce6436 | 278 | if ($1 == NULL) |
e1d5a0d2 | 279 | error (_("Type required for qualification")); |
4c4b4cd2 | 280 | write_exp_elt_opcode (UNOP_QUAL); |
14f9c5c9 | 281 | write_exp_elt_type ($1); |
4c4b4cd2 | 282 | write_exp_elt_opcode (UNOP_QUAL); |
14f9c5c9 AS |
283 | type_qualifier = $3; |
284 | } | |
285 | ; | |
286 | ||
287 | save_qualifier : { $$ = type_qualifier; } | |
525d6a61 | 288 | ; |
14f9c5c9 | 289 | |
52ce6436 PH |
290 | primary : |
291 | primary '(' simple_exp DOTDOT simple_exp ')' | |
14f9c5c9 | 292 | { write_exp_elt_opcode (TERNOP_SLICE); } |
52ce6436 PH |
293 | | var_or_type '(' simple_exp DOTDOT simple_exp ')' |
294 | { if ($1 == NULL) | |
295 | write_exp_elt_opcode (TERNOP_SLICE); | |
296 | else | |
e1d5a0d2 | 297 | error (_("Cannot slice a type")); |
52ce6436 | 298 | } |
14f9c5c9 AS |
299 | ; |
300 | ||
52ce6436 | 301 | primary : '(' exp1 ')' { } |
14f9c5c9 AS |
302 | ; |
303 | ||
52ce6436 PH |
304 | /* The following rule causes a conflict with the type conversion |
305 | var_or_type (exp) | |
306 | To get around it, we give '(' higher priority and add bridge rules for | |
307 | var_or_type (exp, exp, ...) | |
308 | var_or_type (exp .. exp) | |
309 | We also have the action for var_or_type(exp) generate a function call | |
310 | when the first symbol does not denote a type. */ | |
311 | ||
312 | primary : var_or_type %prec VAR | |
313 | { if ($1 != NULL) | |
314 | { | |
315 | write_exp_elt_opcode (OP_TYPE); | |
316 | write_exp_elt_type ($1); | |
317 | write_exp_elt_opcode (OP_TYPE); | |
318 | } | |
319 | } | |
14f9c5c9 AS |
320 | ; |
321 | ||
52ce6436 | 322 | primary : SPECIAL_VARIABLE /* Various GDB extensions */ |
4c4b4cd2 | 323 | { write_dollar_variable ($1); } |
14f9c5c9 AS |
324 | ; |
325 | ||
52ce6436 PH |
326 | primary : aggregate |
327 | ; | |
14f9c5c9 | 328 | |
52ce6436 | 329 | simple_exp : primary |
14f9c5c9 AS |
330 | ; |
331 | ||
52ce6436 | 332 | simple_exp : '-' simple_exp %prec UNARY |
14f9c5c9 AS |
333 | { write_exp_elt_opcode (UNOP_NEG); } |
334 | ; | |
335 | ||
52ce6436 | 336 | simple_exp : '+' simple_exp %prec UNARY |
14f9c5c9 AS |
337 | { write_exp_elt_opcode (UNOP_PLUS); } |
338 | ; | |
339 | ||
52ce6436 | 340 | simple_exp : NOT simple_exp %prec UNARY |
14f9c5c9 AS |
341 | { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } |
342 | ; | |
343 | ||
52ce6436 | 344 | simple_exp : ABS simple_exp %prec UNARY |
14f9c5c9 AS |
345 | { write_exp_elt_opcode (UNOP_ABS); } |
346 | ; | |
347 | ||
348 | arglist : { $$ = 0; } | |
349 | ; | |
350 | ||
351 | arglist : exp | |
352 | { $$ = 1; } | |
52ce6436 | 353 | | NAME ARROW exp |
14f9c5c9 AS |
354 | { $$ = 1; } |
355 | | arglist ',' exp | |
356 | { $$ = $1 + 1; } | |
52ce6436 | 357 | | arglist ',' NAME ARROW exp |
14f9c5c9 AS |
358 | { $$ = $1 + 1; } |
359 | ; | |
360 | ||
bb28a9dc | 361 | primary : '{' var_or_type '}' primary %prec '.' |
14f9c5c9 | 362 | /* GDB extension */ |
52ce6436 PH |
363 | { |
364 | if ($2 == NULL) | |
e1d5a0d2 | 365 | error (_("Type required within braces in coercion")); |
52ce6436 | 366 | write_exp_elt_opcode (UNOP_MEMVAL); |
14f9c5c9 | 367 | write_exp_elt_type ($2); |
4c4b4cd2 | 368 | write_exp_elt_opcode (UNOP_MEMVAL); |
14f9c5c9 AS |
369 | } |
370 | ; | |
371 | ||
372 | /* Binary operators in order of decreasing precedence. */ | |
373 | ||
52ce6436 | 374 | simple_exp : simple_exp STARSTAR simple_exp |
14f9c5c9 AS |
375 | { write_exp_elt_opcode (BINOP_EXP); } |
376 | ; | |
377 | ||
52ce6436 | 378 | simple_exp : simple_exp '*' simple_exp |
14f9c5c9 AS |
379 | { write_exp_elt_opcode (BINOP_MUL); } |
380 | ; | |
381 | ||
52ce6436 | 382 | simple_exp : simple_exp '/' simple_exp |
14f9c5c9 AS |
383 | { write_exp_elt_opcode (BINOP_DIV); } |
384 | ; | |
385 | ||
52ce6436 | 386 | simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */ |
14f9c5c9 AS |
387 | { write_exp_elt_opcode (BINOP_REM); } |
388 | ; | |
389 | ||
52ce6436 | 390 | simple_exp : simple_exp MOD simple_exp |
14f9c5c9 AS |
391 | { write_exp_elt_opcode (BINOP_MOD); } |
392 | ; | |
393 | ||
52ce6436 | 394 | simple_exp : simple_exp '@' simple_exp /* GDB extension */ |
14f9c5c9 AS |
395 | { write_exp_elt_opcode (BINOP_REPEAT); } |
396 | ; | |
397 | ||
52ce6436 | 398 | simple_exp : simple_exp '+' simple_exp |
14f9c5c9 AS |
399 | { write_exp_elt_opcode (BINOP_ADD); } |
400 | ; | |
401 | ||
52ce6436 | 402 | simple_exp : simple_exp '&' simple_exp |
14f9c5c9 AS |
403 | { write_exp_elt_opcode (BINOP_CONCAT); } |
404 | ; | |
405 | ||
52ce6436 | 406 | simple_exp : simple_exp '-' simple_exp |
14f9c5c9 AS |
407 | { write_exp_elt_opcode (BINOP_SUB); } |
408 | ; | |
409 | ||
52ce6436 PH |
410 | relation : simple_exp |
411 | ; | |
412 | ||
413 | relation : simple_exp '=' simple_exp | |
14f9c5c9 AS |
414 | { write_exp_elt_opcode (BINOP_EQUAL); } |
415 | ; | |
416 | ||
52ce6436 | 417 | relation : simple_exp NOTEQUAL simple_exp |
14f9c5c9 AS |
418 | { write_exp_elt_opcode (BINOP_NOTEQUAL); } |
419 | ; | |
420 | ||
52ce6436 | 421 | relation : simple_exp LEQ simple_exp |
14f9c5c9 AS |
422 | { write_exp_elt_opcode (BINOP_LEQ); } |
423 | ; | |
424 | ||
52ce6436 | 425 | relation : simple_exp IN simple_exp DOTDOT simple_exp |
4c4b4cd2 | 426 | { write_exp_elt_opcode (TERNOP_IN_RANGE); } |
52ce6436 | 427 | | simple_exp IN primary TICK_RANGE tick_arglist |
4c4b4cd2 | 428 | { write_exp_elt_opcode (BINOP_IN_BOUNDS); |
14f9c5c9 | 429 | write_exp_elt_longcst ((LONGEST) $5); |
4c4b4cd2 | 430 | write_exp_elt_opcode (BINOP_IN_BOUNDS); |
14f9c5c9 | 431 | } |
52ce6436 PH |
432 | | simple_exp IN var_or_type %prec TICK_ACCESS |
433 | { | |
434 | if ($3 == NULL) | |
e1d5a0d2 | 435 | error (_("Right operand of 'in' must be type")); |
52ce6436 | 436 | write_exp_elt_opcode (UNOP_IN_RANGE); |
14f9c5c9 | 437 | write_exp_elt_type ($3); |
4c4b4cd2 | 438 | write_exp_elt_opcode (UNOP_IN_RANGE); |
14f9c5c9 | 439 | } |
52ce6436 | 440 | | simple_exp NOT IN simple_exp DOTDOT simple_exp |
4c4b4cd2 PH |
441 | { write_exp_elt_opcode (TERNOP_IN_RANGE); |
442 | write_exp_elt_opcode (UNOP_LOGICAL_NOT); | |
14f9c5c9 | 443 | } |
52ce6436 | 444 | | simple_exp NOT IN primary TICK_RANGE tick_arglist |
4c4b4cd2 | 445 | { write_exp_elt_opcode (BINOP_IN_BOUNDS); |
14f9c5c9 | 446 | write_exp_elt_longcst ((LONGEST) $6); |
4c4b4cd2 PH |
447 | write_exp_elt_opcode (BINOP_IN_BOUNDS); |
448 | write_exp_elt_opcode (UNOP_LOGICAL_NOT); | |
14f9c5c9 | 449 | } |
52ce6436 PH |
450 | | simple_exp NOT IN var_or_type %prec TICK_ACCESS |
451 | { | |
452 | if ($4 == NULL) | |
e1d5a0d2 | 453 | error (_("Right operand of 'in' must be type")); |
52ce6436 | 454 | write_exp_elt_opcode (UNOP_IN_RANGE); |
14f9c5c9 | 455 | write_exp_elt_type ($4); |
4c4b4cd2 PH |
456 | write_exp_elt_opcode (UNOP_IN_RANGE); |
457 | write_exp_elt_opcode (UNOP_LOGICAL_NOT); | |
14f9c5c9 AS |
458 | } |
459 | ; | |
460 | ||
52ce6436 | 461 | relation : simple_exp GEQ simple_exp |
14f9c5c9 AS |
462 | { write_exp_elt_opcode (BINOP_GEQ); } |
463 | ; | |
464 | ||
52ce6436 | 465 | relation : simple_exp '<' simple_exp |
14f9c5c9 AS |
466 | { write_exp_elt_opcode (BINOP_LESS); } |
467 | ; | |
468 | ||
52ce6436 | 469 | relation : simple_exp '>' simple_exp |
14f9c5c9 AS |
470 | { write_exp_elt_opcode (BINOP_GTR); } |
471 | ; | |
472 | ||
52ce6436 PH |
473 | exp : relation |
474 | | and_exp | |
475 | | and_then_exp | |
476 | | or_exp | |
477 | | or_else_exp | |
478 | | xor_exp | |
479 | ; | |
480 | ||
481 | and_exp : | |
482 | relation _AND_ relation | |
14f9c5c9 | 483 | { write_exp_elt_opcode (BINOP_BITWISE_AND); } |
52ce6436 PH |
484 | | and_exp _AND_ relation |
485 | { write_exp_elt_opcode (BINOP_BITWISE_AND); } | |
486 | ; | |
14f9c5c9 | 487 | |
52ce6436 PH |
488 | and_then_exp : |
489 | relation _AND_ THEN relation | |
490 | { write_exp_elt_opcode (BINOP_LOGICAL_AND); } | |
491 | | and_then_exp _AND_ THEN relation | |
14f9c5c9 AS |
492 | { write_exp_elt_opcode (BINOP_LOGICAL_AND); } |
493 | ; | |
494 | ||
52ce6436 PH |
495 | or_exp : |
496 | relation OR relation | |
14f9c5c9 | 497 | { write_exp_elt_opcode (BINOP_BITWISE_IOR); } |
52ce6436 PH |
498 | | or_exp OR relation |
499 | { write_exp_elt_opcode (BINOP_BITWISE_IOR); } | |
500 | ; | |
14f9c5c9 | 501 | |
52ce6436 PH |
502 | or_else_exp : |
503 | relation OR ELSE relation | |
504 | { write_exp_elt_opcode (BINOP_LOGICAL_OR); } | |
505 | | or_else_exp OR ELSE relation | |
14f9c5c9 AS |
506 | { write_exp_elt_opcode (BINOP_LOGICAL_OR); } |
507 | ; | |
508 | ||
52ce6436 PH |
509 | xor_exp : relation XOR relation |
510 | { write_exp_elt_opcode (BINOP_BITWISE_XOR); } | |
511 | | xor_exp XOR relation | |
14f9c5c9 AS |
512 | { write_exp_elt_opcode (BINOP_BITWISE_XOR); } |
513 | ; | |
514 | ||
52ce6436 | 515 | /* Primaries can denote types (OP_TYPE). In cases such as |
f98ce7c2 | 516 | primary TICK_ADDRESS, where a type would be invalid, it will be |
52ce6436 PH |
517 | caught when evaluate_subexp in ada-lang.c tries to evaluate the |
518 | primary, expecting a value. Precedence rules resolve the ambiguity | |
519 | in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A | |
520 | construct such as aType'access'access will again cause an error when | |
521 | aType'access evaluates to a type that evaluate_subexp attempts to | |
522 | evaluate. */ | |
523 | primary : primary TICK_ACCESS | |
14f9c5c9 | 524 | { write_exp_elt_opcode (UNOP_ADDR); } |
52ce6436 | 525 | | primary TICK_ADDRESS |
14f9c5c9 AS |
526 | { write_exp_elt_opcode (UNOP_ADDR); |
527 | write_exp_elt_opcode (UNOP_CAST); | |
72d5681a | 528 | write_exp_elt_type (type_system_address ()); |
14f9c5c9 AS |
529 | write_exp_elt_opcode (UNOP_CAST); |
530 | } | |
52ce6436 | 531 | | primary TICK_FIRST tick_arglist |
72d5681a | 532 | { write_int ($3, type_int ()); |
4c4b4cd2 | 533 | write_exp_elt_opcode (OP_ATR_FIRST); } |
52ce6436 | 534 | | primary TICK_LAST tick_arglist |
72d5681a | 535 | { write_int ($3, type_int ()); |
4c4b4cd2 | 536 | write_exp_elt_opcode (OP_ATR_LAST); } |
52ce6436 | 537 | | primary TICK_LENGTH tick_arglist |
72d5681a | 538 | { write_int ($3, type_int ()); |
4c4b4cd2 | 539 | write_exp_elt_opcode (OP_ATR_LENGTH); } |
52ce6436 | 540 | | primary TICK_SIZE |
4c4b4cd2 | 541 | { write_exp_elt_opcode (OP_ATR_SIZE); } |
52ce6436 | 542 | | primary TICK_TAG |
4c4b4cd2 | 543 | { write_exp_elt_opcode (OP_ATR_TAG); } |
14f9c5c9 | 544 | | opt_type_prefix TICK_MIN '(' exp ',' exp ')' |
4c4b4cd2 | 545 | { write_exp_elt_opcode (OP_ATR_MIN); } |
14f9c5c9 | 546 | | opt_type_prefix TICK_MAX '(' exp ',' exp ')' |
4c4b4cd2 | 547 | { write_exp_elt_opcode (OP_ATR_MAX); } |
14f9c5c9 | 548 | | opt_type_prefix TICK_POS '(' exp ')' |
4c4b4cd2 | 549 | { write_exp_elt_opcode (OP_ATR_POS); } |
14f9c5c9 | 550 | | type_prefix TICK_VAL '(' exp ')' |
4c4b4cd2 PH |
551 | { write_exp_elt_opcode (OP_ATR_VAL); } |
552 | | type_prefix TICK_MODULUS | |
553 | { write_exp_elt_opcode (OP_ATR_MODULUS); } | |
14f9c5c9 AS |
554 | ; |
555 | ||
556 | tick_arglist : %prec '(' | |
557 | { $$ = 1; } | |
558 | | '(' INT ')' | |
559 | { $$ = $2.val; } | |
560 | ; | |
561 | ||
562 | type_prefix : | |
52ce6436 PH |
563 | var_or_type |
564 | { | |
565 | if ($1 == NULL) | |
e1d5a0d2 | 566 | error (_("Prefix must be type")); |
52ce6436 | 567 | write_exp_elt_opcode (OP_TYPE); |
14f9c5c9 AS |
568 | write_exp_elt_type ($1); |
569 | write_exp_elt_opcode (OP_TYPE); } | |
570 | ; | |
571 | ||
572 | opt_type_prefix : | |
573 | type_prefix | |
4c4b4cd2 | 574 | | /* EMPTY */ |
14f9c5c9 | 575 | { write_exp_elt_opcode (OP_TYPE); |
3e79cecf | 576 | write_exp_elt_type (parse_type->builtin_void); |
14f9c5c9 AS |
577 | write_exp_elt_opcode (OP_TYPE); } |
578 | ; | |
4c4b4cd2 | 579 | |
14f9c5c9 | 580 | |
52ce6436 | 581 | primary : INT |
4c4b4cd2 | 582 | { write_int ((LONGEST) $1.val, $1.type); } |
14f9c5c9 AS |
583 | ; |
584 | ||
52ce6436 | 585 | primary : CHARLIT |
4c4b4cd2 PH |
586 | { write_int (convert_char_literal (type_qualifier, $1.val), |
587 | (type_qualifier == NULL) | |
588 | ? $1.type : type_qualifier); | |
589 | } | |
525d6a61 | 590 | ; |
4c4b4cd2 | 591 | |
52ce6436 | 592 | primary : FLOAT |
14f9c5c9 AS |
593 | { write_exp_elt_opcode (OP_DOUBLE); |
594 | write_exp_elt_type ($1.type); | |
595 | write_exp_elt_dblcst ($1.dval); | |
4c4b4cd2 | 596 | write_exp_elt_opcode (OP_DOUBLE); |
14f9c5c9 AS |
597 | } |
598 | ; | |
599 | ||
52ce6436 | 600 | primary : NULL_PTR |
72d5681a | 601 | { write_int (0, type_int ()); } |
525d6a61 | 602 | ; |
14f9c5c9 | 603 | |
52ce6436 | 604 | primary : STRING |
4c4b4cd2 | 605 | { |
52ce6436 | 606 | write_exp_op_with_string (OP_STRING, $1); |
4c4b4cd2 | 607 | } |
14f9c5c9 AS |
608 | ; |
609 | ||
690cc4eb PH |
610 | primary : TRUEKEYWORD |
611 | { write_int (1, type_boolean ()); } | |
612 | | FALSEKEYWORD | |
613 | { write_int (0, type_boolean ()); } | |
614 | ; | |
615 | ||
52ce6436 | 616 | primary : NEW NAME |
e1d5a0d2 | 617 | { error (_("NEW not implemented.")); } |
14f9c5c9 AS |
618 | ; |
619 | ||
52ce6436 PH |
620 | var_or_type: NAME %prec VAR |
621 | { $$ = write_var_or_type (NULL, $1); } | |
622 | | block NAME %prec VAR | |
623 | { $$ = write_var_or_type ($1, $2); } | |
624 | | NAME TICK_ACCESS | |
625 | { | |
626 | $$ = write_var_or_type (NULL, $1); | |
627 | if ($$ == NULL) | |
628 | write_exp_elt_opcode (UNOP_ADDR); | |
629 | else | |
630 | $$ = lookup_pointer_type ($$); | |
631 | } | |
632 | | block NAME TICK_ACCESS | |
633 | { | |
634 | $$ = write_var_or_type ($1, $2); | |
635 | if ($$ == NULL) | |
636 | write_exp_elt_opcode (UNOP_ADDR); | |
637 | else | |
638 | $$ = lookup_pointer_type ($$); | |
639 | } | |
14f9c5c9 AS |
640 | ; |
641 | ||
52ce6436 PH |
642 | /* GDB extension */ |
643 | block : NAME COLONCOLON | |
644 | { $$ = block_lookup (NULL, $1.ptr); } | |
645 | | block NAME COLONCOLON | |
646 | { $$ = block_lookup ($1, $2.ptr); } | |
647 | ; | |
14f9c5c9 | 648 | |
52ce6436 PH |
649 | aggregate : |
650 | '(' aggregate_component_list ')' | |
651 | { | |
652 | write_exp_elt_opcode (OP_AGGREGATE); | |
653 | write_exp_elt_longcst ($2); | |
654 | write_exp_elt_opcode (OP_AGGREGATE); | |
655 | } | |
14f9c5c9 AS |
656 | ; |
657 | ||
52ce6436 PH |
658 | aggregate_component_list : |
659 | component_groups { $$ = $1; } | |
660 | | positional_list exp | |
661 | { write_exp_elt_opcode (OP_POSITIONAL); | |
662 | write_exp_elt_longcst ($1); | |
663 | write_exp_elt_opcode (OP_POSITIONAL); | |
664 | $$ = $1 + 1; | |
665 | } | |
666 | | positional_list component_groups | |
667 | { $$ = $1 + $2; } | |
668 | ; | |
14f9c5c9 | 669 | |
52ce6436 PH |
670 | positional_list : |
671 | exp ',' | |
672 | { write_exp_elt_opcode (OP_POSITIONAL); | |
673 | write_exp_elt_longcst (0); | |
674 | write_exp_elt_opcode (OP_POSITIONAL); | |
675 | $$ = 1; | |
676 | } | |
677 | | positional_list exp ',' | |
678 | { write_exp_elt_opcode (OP_POSITIONAL); | |
679 | write_exp_elt_longcst ($1); | |
680 | write_exp_elt_opcode (OP_POSITIONAL); | |
681 | $$ = $1 + 1; | |
682 | } | |
683 | ; | |
684 | ||
685 | component_groups: | |
686 | others { $$ = 1; } | |
687 | | component_group { $$ = 1; } | |
688 | | component_group ',' component_groups | |
689 | { $$ = $3 + 1; } | |
690 | ; | |
691 | ||
692 | others : OTHERS ARROW exp | |
693 | { write_exp_elt_opcode (OP_OTHERS); } | |
694 | ; | |
695 | ||
696 | component_group : | |
697 | component_associations | |
698 | { | |
699 | write_exp_elt_opcode (OP_CHOICES); | |
700 | write_exp_elt_longcst ($1); | |
701 | write_exp_elt_opcode (OP_CHOICES); | |
702 | } | |
703 | ; | |
704 | ||
705 | /* We use this somewhat obscure definition in order to handle NAME => and | |
706 | NAME | differently from exp => and exp |. ARROW and '|' have a precedence | |
707 | above that of the reduction of NAME to var_or_type. By delaying | |
708 | decisions until after the => or '|', we convert the ambiguity to a | |
709 | resolved shift/reduce conflict. */ | |
710 | component_associations : | |
711 | NAME ARROW | |
712 | { write_name_assoc ($1); } | |
713 | exp { $$ = 1; } | |
714 | | simple_exp ARROW exp | |
715 | { $$ = 1; } | |
716 | | simple_exp DOTDOT simple_exp ARROW | |
717 | { write_exp_elt_opcode (OP_DISCRETE_RANGE); | |
718 | write_exp_op_with_string (OP_NAME, empty_stoken); | |
719 | } | |
720 | exp { $$ = 1; } | |
721 | | NAME '|' | |
722 | { write_name_assoc ($1); } | |
723 | component_associations { $$ = $4 + 1; } | |
724 | | simple_exp '|' | |
725 | component_associations { $$ = $3 + 1; } | |
726 | | simple_exp DOTDOT simple_exp '|' | |
727 | { write_exp_elt_opcode (OP_DISCRETE_RANGE); } | |
728 | component_associations { $$ = $6 + 1; } | |
729 | ; | |
14f9c5c9 AS |
730 | |
731 | /* Some extensions borrowed from C, for the benefit of those who find they | |
4c4b4cd2 | 732 | can't get used to Ada notation in GDB. */ |
14f9c5c9 | 733 | |
52ce6436 | 734 | primary : '*' primary %prec '.' |
14f9c5c9 | 735 | { write_exp_elt_opcode (UNOP_IND); } |
52ce6436 | 736 | | '&' primary %prec '.' |
14f9c5c9 | 737 | { write_exp_elt_opcode (UNOP_ADDR); } |
52ce6436 | 738 | | primary '[' exp ']' |
14f9c5c9 AS |
739 | { write_exp_elt_opcode (BINOP_SUBSCRIPT); } |
740 | ; | |
741 | ||
742 | %% | |
743 | ||
744 | /* yylex defined in ada-lex.c: Reads one token, getting characters */ | |
745 | /* through lexptr. */ | |
746 | ||
747 | /* Remap normal flex interface names (yylex) as well as gratuitiously */ | |
748 | /* global symbol names, so we can have multiple flex-generated parsers */ | |
749 | /* in gdb. */ | |
750 | ||
751 | /* (See note above on previous definitions for YACC.) */ | |
752 | ||
753 | #define yy_create_buffer ada_yy_create_buffer | |
754 | #define yy_delete_buffer ada_yy_delete_buffer | |
755 | #define yy_init_buffer ada_yy_init_buffer | |
756 | #define yy_load_buffer_state ada_yy_load_buffer_state | |
757 | #define yy_switch_to_buffer ada_yy_switch_to_buffer | |
758 | #define yyrestart ada_yyrestart | |
759 | #define yytext ada_yytext | |
760 | #define yywrap ada_yywrap | |
761 | ||
4c4b4cd2 PH |
762 | static struct obstack temp_parse_space; |
763 | ||
14f9c5c9 AS |
764 | /* The following kludge was found necessary to prevent conflicts between */ |
765 | /* defs.h and non-standard stdlib.h files. */ | |
766 | #define qsort __qsort__dummy | |
767 | #include "ada-lex.c" | |
768 | ||
769 | int | |
4c4b4cd2 | 770 | ada_parse (void) |
14f9c5c9 | 771 | { |
4c4b4cd2 | 772 | lexer_init (yyin); /* (Re-)initialize lexer. */ |
14f9c5c9 | 773 | type_qualifier = NULL; |
4c4b4cd2 PH |
774 | obstack_free (&temp_parse_space, NULL); |
775 | obstack_init (&temp_parse_space); | |
776 | ||
14f9c5c9 AS |
777 | return _ada_parse (); |
778 | } | |
779 | ||
780 | void | |
4c4b4cd2 | 781 | yyerror (char *msg) |
14f9c5c9 | 782 | { |
03ee6b2e | 783 | error (_("Error in expression, near `%s'."), lexptr); |
14f9c5c9 AS |
784 | } |
785 | ||
4c4b4cd2 | 786 | /* The operator name corresponding to operator symbol STRING (adds |
14f9c5c9 AS |
787 | quotes and maps to lower-case). Destroys the previous contents of |
788 | the array pointed to by STRING.ptr. Error if STRING does not match | |
789 | a valid Ada operator. Assumes that STRING.ptr points to a | |
790 | null-terminated string and that, if STRING is a valid operator | |
791 | symbol, the array pointed to by STRING.ptr contains at least | |
4c4b4cd2 | 792 | STRING.length+3 characters. */ |
14f9c5c9 AS |
793 | |
794 | static struct stoken | |
4c4b4cd2 | 795 | string_to_operator (struct stoken string) |
14f9c5c9 AS |
796 | { |
797 | int i; | |
798 | ||
4c4b4cd2 | 799 | for (i = 0; ada_opname_table[i].encoded != NULL; i += 1) |
14f9c5c9 | 800 | { |
4c4b4cd2 PH |
801 | if (string.length == strlen (ada_opname_table[i].decoded)-2 |
802 | && strncasecmp (string.ptr, ada_opname_table[i].decoded+1, | |
14f9c5c9 AS |
803 | string.length) == 0) |
804 | { | |
4c4b4cd2 | 805 | strncpy (string.ptr, ada_opname_table[i].decoded, |
14f9c5c9 AS |
806 | string.length+2); |
807 | string.length += 2; | |
808 | return string; | |
809 | } | |
810 | } | |
e1d5a0d2 | 811 | error (_("Invalid operator symbol `%s'"), string.ptr); |
14f9c5c9 AS |
812 | } |
813 | ||
814 | /* Emit expression to access an instance of SYM, in block BLOCK (if | |
4c4b4cd2 | 815 | * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */ |
14f9c5c9 | 816 | static void |
4c4b4cd2 PH |
817 | write_var_from_sym (struct block *orig_left_context, |
818 | struct block *block, | |
819 | struct symbol *sym) | |
14f9c5c9 AS |
820 | { |
821 | if (orig_left_context == NULL && symbol_read_needs_frame (sym)) | |
822 | { | |
c3e5cd34 PH |
823 | if (innermost_block == 0 |
824 | || contained_in (block, innermost_block)) | |
14f9c5c9 AS |
825 | innermost_block = block; |
826 | } | |
827 | ||
828 | write_exp_elt_opcode (OP_VAR_VALUE); | |
4c4b4cd2 | 829 | write_exp_elt_block (block); |
14f9c5c9 AS |
830 | write_exp_elt_sym (sym); |
831 | write_exp_elt_opcode (OP_VAR_VALUE); | |
832 | } | |
833 | ||
690cc4eb | 834 | /* Write integer or boolean constant ARG of type TYPE. */ |
14f9c5c9 AS |
835 | |
836 | static void | |
4c4b4cd2 | 837 | write_int (LONGEST arg, struct type *type) |
14f9c5c9 AS |
838 | { |
839 | write_exp_elt_opcode (OP_LONG); | |
4c4b4cd2 | 840 | write_exp_elt_type (type); |
14f9c5c9 AS |
841 | write_exp_elt_longcst (arg); |
842 | write_exp_elt_opcode (OP_LONG); | |
4c4b4cd2 | 843 | } |
14f9c5c9 | 844 | |
52ce6436 PH |
845 | /* Write an OPCODE, string, OPCODE sequence to the current expression. */ |
846 | static void | |
847 | write_exp_op_with_string (enum exp_opcode opcode, struct stoken token) | |
848 | { | |
849 | write_exp_elt_opcode (opcode); | |
850 | write_exp_string (token); | |
851 | write_exp_elt_opcode (opcode); | |
852 | } | |
853 | ||
aeb5907d JB |
854 | /* Emit expression corresponding to the renamed object named |
855 | * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the | |
856 | * context of ORIG_LEFT_CONTEXT, to which is applied the operations | |
857 | * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of | |
858 | * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it | |
859 | * defaults to the currently selected block. ORIG_SYMBOL is the | |
860 | * symbol that originally encoded the renaming. It is needed only | |
861 | * because its prefix also qualifies any index variables used to index | |
862 | * or slice an array. It should not be necessary once we go to the | |
863 | * new encoding entirely (FIXME pnh 7/20/2007). */ | |
864 | ||
14f9c5c9 | 865 | static void |
aeb5907d JB |
866 | write_object_renaming (struct block *orig_left_context, |
867 | const char *renamed_entity, int renamed_entity_len, | |
868 | const char *renaming_expr, int max_depth) | |
14f9c5c9 | 869 | { |
4c4b4cd2 | 870 | char *name; |
14f9c5c9 | 871 | enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state; |
aeb5907d JB |
872 | struct symbol *sym; |
873 | struct block *block; | |
14f9c5c9 | 874 | |
4c4b4cd2 | 875 | if (max_depth <= 0) |
e1d5a0d2 | 876 | error (_("Could not find renamed symbol")); |
4c4b4cd2 | 877 | |
14f9c5c9 AS |
878 | if (orig_left_context == NULL) |
879 | orig_left_context = get_selected_block (NULL); | |
880 | ||
aeb5907d JB |
881 | name = obsavestring (renamed_entity, renamed_entity_len, &temp_parse_space); |
882 | sym = ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, | |
21b556f4 | 883 | &block); |
4c4b4cd2 | 884 | if (sym == NULL) |
e1d5a0d2 | 885 | error (_("Could not find renamed variable: %s"), ada_decode (name)); |
aeb5907d JB |
886 | else if (SYMBOL_CLASS (sym) == LOC_TYPEDEF) |
887 | /* We have a renaming of an old-style renaming symbol. Don't | |
888 | trust the block information. */ | |
889 | block = orig_left_context; | |
890 | ||
891 | { | |
892 | const char *inner_renamed_entity; | |
893 | int inner_renamed_entity_len; | |
894 | const char *inner_renaming_expr; | |
895 | ||
896 | switch (ada_parse_renaming (sym, &inner_renamed_entity, | |
897 | &inner_renamed_entity_len, | |
898 | &inner_renaming_expr)) | |
899 | { | |
900 | case ADA_NOT_RENAMING: | |
901 | write_var_from_sym (orig_left_context, block, sym); | |
902 | break; | |
903 | case ADA_OBJECT_RENAMING: | |
904 | write_object_renaming (block, | |
905 | inner_renamed_entity, inner_renamed_entity_len, | |
906 | inner_renaming_expr, max_depth - 1); | |
907 | break; | |
908 | default: | |
909 | goto BadEncoding; | |
910 | } | |
911 | } | |
14f9c5c9 | 912 | |
14f9c5c9 | 913 | slice_state = SIMPLE_INDEX; |
aeb5907d | 914 | while (*renaming_expr == 'X') |
14f9c5c9 | 915 | { |
aeb5907d | 916 | renaming_expr += 1; |
14f9c5c9 | 917 | |
aeb5907d | 918 | switch (*renaming_expr) { |
4c4b4cd2 | 919 | case 'A': |
aeb5907d | 920 | renaming_expr += 1; |
4c4b4cd2 PH |
921 | write_exp_elt_opcode (UNOP_IND); |
922 | break; | |
14f9c5c9 AS |
923 | case 'L': |
924 | slice_state = LOWER_BOUND; | |
925 | case 'S': | |
aeb5907d JB |
926 | renaming_expr += 1; |
927 | if (isdigit (*renaming_expr)) | |
14f9c5c9 | 928 | { |
4c4b4cd2 | 929 | char *next; |
aeb5907d JB |
930 | long val = strtol (renaming_expr, &next, 10); |
931 | if (next == renaming_expr) | |
14f9c5c9 | 932 | goto BadEncoding; |
aeb5907d | 933 | renaming_expr = next; |
14f9c5c9 | 934 | write_exp_elt_opcode (OP_LONG); |
72d5681a | 935 | write_exp_elt_type (type_int ()); |
14f9c5c9 AS |
936 | write_exp_elt_longcst ((LONGEST) val); |
937 | write_exp_elt_opcode (OP_LONG); | |
4c4b4cd2 | 938 | } |
14f9c5c9 AS |
939 | else |
940 | { | |
4c4b4cd2 PH |
941 | const char *end; |
942 | char *index_name; | |
4c4b4cd2 | 943 | struct symbol *index_sym; |
14f9c5c9 | 944 | |
aeb5907d | 945 | end = strchr (renaming_expr, 'X'); |
4c4b4cd2 | 946 | if (end == NULL) |
aeb5907d JB |
947 | end = renaming_expr + strlen (renaming_expr); |
948 | ||
949 | index_name = | |
950 | obsavestring (renaming_expr, end - renaming_expr, | |
951 | &temp_parse_space); | |
952 | renaming_expr = end; | |
953 | ||
954 | index_sym = ada_lookup_encoded_symbol (index_name, NULL, | |
21b556f4 | 955 | VAR_DOMAIN, &block); |
14f9c5c9 | 956 | if (index_sym == NULL) |
e1d5a0d2 | 957 | error (_("Could not find %s"), index_name); |
aeb5907d JB |
958 | else if (SYMBOL_CLASS (index_sym) == LOC_TYPEDEF) |
959 | /* Index is an old-style renaming symbol. */ | |
960 | block = orig_left_context; | |
961 | write_var_from_sym (NULL, block, index_sym); | |
14f9c5c9 AS |
962 | } |
963 | if (slice_state == SIMPLE_INDEX) | |
4c4b4cd2 | 964 | { |
14f9c5c9 AS |
965 | write_exp_elt_opcode (OP_FUNCALL); |
966 | write_exp_elt_longcst ((LONGEST) 1); | |
967 | write_exp_elt_opcode (OP_FUNCALL); | |
968 | } | |
969 | else if (slice_state == LOWER_BOUND) | |
970 | slice_state = UPPER_BOUND; | |
971 | else if (slice_state == UPPER_BOUND) | |
972 | { | |
973 | write_exp_elt_opcode (TERNOP_SLICE); | |
974 | slice_state = SIMPLE_INDEX; | |
975 | } | |
976 | break; | |
977 | ||
978 | case 'R': | |
979 | { | |
980 | struct stoken field_name; | |
4c4b4cd2 | 981 | const char *end; |
aeb5907d | 982 | renaming_expr += 1; |
4c4b4cd2 | 983 | |
14f9c5c9 AS |
984 | if (slice_state != SIMPLE_INDEX) |
985 | goto BadEncoding; | |
aeb5907d | 986 | end = strchr (renaming_expr, 'X'); |
4c4b4cd2 | 987 | if (end == NULL) |
aeb5907d JB |
988 | end = renaming_expr + strlen (renaming_expr); |
989 | field_name.length = end - renaming_expr; | |
990 | field_name.ptr = xmalloc (end - renaming_expr + 1); | |
991 | strncpy (field_name.ptr, renaming_expr, end - renaming_expr); | |
992 | field_name.ptr[end - renaming_expr] = '\000'; | |
993 | renaming_expr = end; | |
52ce6436 | 994 | write_exp_op_with_string (STRUCTOP_STRUCT, field_name); |
14f9c5c9 AS |
995 | break; |
996 | } | |
4c4b4cd2 | 997 | |
14f9c5c9 AS |
998 | default: |
999 | goto BadEncoding; | |
1000 | } | |
1001 | } | |
1002 | if (slice_state == SIMPLE_INDEX) | |
1003 | return; | |
1004 | ||
1005 | BadEncoding: | |
aeb5907d | 1006 | error (_("Internal error in encoding of renaming declaration")); |
14f9c5c9 AS |
1007 | } |
1008 | ||
52ce6436 PH |
1009 | static struct block* |
1010 | block_lookup (struct block *context, char *raw_name) | |
1011 | { | |
1012 | char *name; | |
1013 | struct ada_symbol_info *syms; | |
1014 | int nsyms; | |
1015 | struct symtab *symtab; | |
1016 | ||
1017 | if (raw_name[0] == '\'') | |
1018 | { | |
1019 | raw_name += 1; | |
1020 | name = raw_name; | |
1021 | } | |
1022 | else | |
1023 | name = ada_encode (raw_name); | |
1024 | ||
1025 | nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms); | |
1026 | if (context == NULL && | |
1027 | (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)) | |
1028 | symtab = lookup_symtab (name); | |
1029 | else | |
1030 | symtab = NULL; | |
1031 | ||
1032 | if (symtab != NULL) | |
1033 | return BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK); | |
1034 | else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK) | |
1035 | { | |
1036 | if (context == NULL) | |
e1d5a0d2 | 1037 | error (_("No file or function \"%s\"."), raw_name); |
52ce6436 | 1038 | else |
e1d5a0d2 | 1039 | error (_("No function \"%s\" in specified context."), raw_name); |
52ce6436 PH |
1040 | } |
1041 | else | |
1042 | { | |
1043 | if (nsyms > 1) | |
e1d5a0d2 | 1044 | warning (_("Function name \"%s\" ambiguous here"), raw_name); |
52ce6436 PH |
1045 | return SYMBOL_BLOCK_VALUE (syms[0].sym); |
1046 | } | |
1047 | } | |
1048 | ||
1049 | static struct symbol* | |
1050 | select_possible_type_sym (struct ada_symbol_info *syms, int nsyms) | |
1051 | { | |
1052 | int i; | |
1053 | int preferred_index; | |
1054 | struct type *preferred_type; | |
1055 | ||
1056 | preferred_index = -1; preferred_type = NULL; | |
1057 | for (i = 0; i < nsyms; i += 1) | |
1058 | switch (SYMBOL_CLASS (syms[i].sym)) | |
1059 | { | |
1060 | case LOC_TYPEDEF: | |
1061 | if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type)) | |
1062 | { | |
1063 | preferred_index = i; | |
1064 | preferred_type = SYMBOL_TYPE (syms[i].sym); | |
1065 | } | |
1066 | break; | |
1067 | case LOC_REGISTER: | |
1068 | case LOC_ARG: | |
1069 | case LOC_REF_ARG: | |
52ce6436 PH |
1070 | case LOC_REGPARM_ADDR: |
1071 | case LOC_LOCAL: | |
52ce6436 | 1072 | case LOC_COMPUTED: |
52ce6436 PH |
1073 | return NULL; |
1074 | default: | |
1075 | break; | |
1076 | } | |
1077 | if (preferred_type == NULL) | |
1078 | return NULL; | |
1079 | return syms[preferred_index].sym; | |
1080 | } | |
1081 | ||
1082 | static struct type* | |
1083 | find_primitive_type (char *name) | |
1084 | { | |
1085 | struct type *type; | |
3e79cecf UW |
1086 | type = language_lookup_primitive_type_by_name (parse_language, |
1087 | parse_gdbarch, | |
52ce6436 PH |
1088 | name); |
1089 | if (type == NULL && strcmp ("system__address", name) == 0) | |
1090 | type = type_system_address (); | |
1091 | ||
1092 | if (type != NULL) | |
1093 | { | |
1094 | /* Check to see if we have a regular definition of this | |
1095 | type that just didn't happen to have been read yet. */ | |
1096 | int ntypes; | |
1097 | struct symbol *sym; | |
1098 | char *expanded_name = | |
1099 | (char *) alloca (strlen (name) + sizeof ("standard__")); | |
1100 | strcpy (expanded_name, "standard__"); | |
1101 | strcat (expanded_name, name); | |
21b556f4 | 1102 | sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL); |
52ce6436 PH |
1103 | if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF) |
1104 | type = SYMBOL_TYPE (sym); | |
1105 | } | |
1106 | ||
1107 | return type; | |
1108 | } | |
1109 | ||
1110 | static int | |
1111 | chop_selector (char *name, int end) | |
1112 | { | |
1113 | int i; | |
1114 | for (i = end - 1; i > 0; i -= 1) | |
1115 | if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_')) | |
1116 | return i; | |
1117 | return -1; | |
1118 | } | |
1119 | ||
d3353bbd JB |
1120 | /* If NAME is a string beginning with a separator (either '__', or |
1121 | '.'), chop this separator and return the result; else, return | |
1122 | NAME. */ | |
1123 | ||
1124 | static char * | |
1125 | chop_separator (char *name) | |
1126 | { | |
1127 | if (*name == '.') | |
1128 | return name + 1; | |
1129 | ||
1130 | if (name[0] == '_' && name[1] == '_') | |
1131 | return name + 2; | |
1132 | ||
1133 | return name; | |
1134 | } | |
1135 | ||
52ce6436 PH |
1136 | /* Given that SELS is a string of the form (<sep><identifier>)*, where |
1137 | <sep> is '__' or '.', write the indicated sequence of | |
1138 | STRUCTOP_STRUCT expression operators. */ | |
1139 | static void | |
1140 | write_selectors (char *sels) | |
1141 | { | |
1142 | while (*sels != '\0') | |
1143 | { | |
1144 | struct stoken field_name; | |
d3353bbd JB |
1145 | char *p = chop_separator (sels); |
1146 | sels = p; | |
52ce6436 PH |
1147 | while (*sels != '\0' && *sels != '.' |
1148 | && (sels[0] != '_' || sels[1] != '_')) | |
1149 | sels += 1; | |
1150 | field_name.length = sels - p; | |
1151 | field_name.ptr = p; | |
1152 | write_exp_op_with_string (STRUCTOP_STRUCT, field_name); | |
1153 | } | |
1154 | } | |
1155 | ||
1156 | /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name | |
1157 | NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes | |
1158 | a temporary symbol that is valid until the next call to ada_parse. | |
1159 | */ | |
1160 | static void | |
1161 | write_ambiguous_var (struct block *block, char *name, int len) | |
1162 | { | |
1163 | struct symbol *sym = | |
1164 | obstack_alloc (&temp_parse_space, sizeof (struct symbol)); | |
1165 | memset (sym, 0, sizeof (struct symbol)); | |
1166 | SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN; | |
1167 | SYMBOL_LINKAGE_NAME (sym) = obsavestring (name, len, &temp_parse_space); | |
1168 | SYMBOL_LANGUAGE (sym) = language_ada; | |
1169 | ||
1170 | write_exp_elt_opcode (OP_VAR_VALUE); | |
1171 | write_exp_elt_block (block); | |
1172 | write_exp_elt_sym (sym); | |
1173 | write_exp_elt_opcode (OP_VAR_VALUE); | |
1174 | } | |
1175 | ||
d3353bbd JB |
1176 | /* A convenient wrapper around ada_get_field_index that takes |
1177 | a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead | |
1178 | of a NUL-terminated field name. */ | |
1179 | ||
1180 | static int | |
1181 | ada_nget_field_index (const struct type *type, const char *field_name0, | |
1182 | int field_name_len, int maybe_missing) | |
1183 | { | |
1184 | char *field_name = alloca ((field_name_len + 1) * sizeof (char)); | |
1185 | ||
1186 | strncpy (field_name, field_name0, field_name_len); | |
1187 | field_name[field_name_len] = '\0'; | |
1188 | return ada_get_field_index (type, field_name, maybe_missing); | |
1189 | } | |
1190 | ||
1191 | /* If encoded_field_name is the name of a field inside symbol SYM, | |
1192 | then return the type of that field. Otherwise, return NULL. | |
1193 | ||
1194 | This function is actually recursive, so if ENCODED_FIELD_NAME | |
1195 | doesn't match one of the fields of our symbol, then try to see | |
1196 | if ENCODED_FIELD_NAME could not be a succession of field names | |
1197 | (in other words, the user entered an expression of the form | |
1198 | TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate | |
1199 | each field name sequentially to obtain the desired field type. | |
1200 | In case of failure, we return NULL. */ | |
1201 | ||
1202 | static struct type * | |
1203 | get_symbol_field_type (struct symbol *sym, char *encoded_field_name) | |
1204 | { | |
1205 | char *field_name = encoded_field_name; | |
1206 | char *subfield_name; | |
1207 | struct type *type = SYMBOL_TYPE (sym); | |
1208 | int fieldno; | |
1209 | ||
1210 | if (type == NULL || field_name == NULL) | |
1211 | return NULL; | |
1212 | ||
1213 | while (field_name[0] != '\0') | |
1214 | { | |
1215 | field_name = chop_separator (field_name); | |
1216 | ||
1217 | fieldno = ada_get_field_index (type, field_name, 1); | |
1218 | if (fieldno >= 0) | |
1219 | return TYPE_FIELD_TYPE (type, fieldno); | |
1220 | ||
1221 | subfield_name = field_name; | |
1222 | while (*subfield_name != '\0' && *subfield_name != '.' | |
1223 | && (subfield_name[0] != '_' || subfield_name[1] != '_')) | |
1224 | subfield_name += 1; | |
1225 | ||
1226 | if (subfield_name[0] == '\0') | |
1227 | return NULL; | |
1228 | ||
1229 | fieldno = ada_nget_field_index (type, field_name, | |
1230 | subfield_name - field_name, 1); | |
1231 | if (fieldno < 0) | |
1232 | return NULL; | |
1233 | ||
1234 | type = TYPE_FIELD_TYPE (type, fieldno); | |
1235 | field_name = subfield_name; | |
1236 | } | |
1237 | ||
1238 | return NULL; | |
1239 | } | |
52ce6436 PH |
1240 | |
1241 | /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or | |
1242 | expression_block_context if NULL). If it denotes a type, return | |
1243 | that type. Otherwise, write expression code to evaluate it as an | |
1244 | object and return NULL. In this second case, NAME0 will, in general, | |
1245 | have the form <name>(.<selector_name>)*, where <name> is an object | |
1246 | or renaming encoded in the debugging data. Calls error if no | |
1247 | prefix <name> matches a name in the debugging data (i.e., matches | |
1248 | either a complete name or, as a wild-card match, the final | |
1249 | identifier). */ | |
1250 | ||
1251 | static struct type* | |
1252 | write_var_or_type (struct block *block, struct stoken name0) | |
1253 | { | |
1254 | int depth; | |
1255 | char *encoded_name; | |
1256 | int name_len; | |
1257 | ||
1258 | if (block == NULL) | |
1259 | block = expression_context_block; | |
1260 | ||
1261 | encoded_name = ada_encode (name0.ptr); | |
1262 | name_len = strlen (encoded_name); | |
1263 | encoded_name = obsavestring (encoded_name, name_len, &temp_parse_space); | |
1264 | for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1) | |
1265 | { | |
1266 | int tail_index; | |
1267 | ||
1268 | tail_index = name_len; | |
1269 | while (tail_index > 0) | |
1270 | { | |
1271 | int nsyms; | |
1272 | struct ada_symbol_info *syms; | |
1273 | struct symbol *type_sym; | |
aeb5907d JB |
1274 | struct symbol *renaming_sym; |
1275 | const char* renaming; | |
1276 | int renaming_len; | |
1277 | const char* renaming_expr; | |
52ce6436 PH |
1278 | int terminator = encoded_name[tail_index]; |
1279 | ||
1280 | encoded_name[tail_index] = '\0'; | |
1281 | nsyms = ada_lookup_symbol_list (encoded_name, block, | |
1282 | VAR_DOMAIN, &syms); | |
1283 | encoded_name[tail_index] = terminator; | |
1284 | ||
1285 | /* A single symbol may rename a package or object. */ | |
1286 | ||
aeb5907d JB |
1287 | /* This should go away when we move entirely to new version. |
1288 | FIXME pnh 7/20/2007. */ | |
1289 | if (nsyms == 1) | |
52ce6436 | 1290 | { |
aeb5907d | 1291 | struct symbol *renaming = |
52ce6436 PH |
1292 | ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym), |
1293 | syms[0].block); | |
1294 | ||
aeb5907d JB |
1295 | if (renaming != NULL) |
1296 | syms[0].sym = renaming; | |
52ce6436 PH |
1297 | } |
1298 | ||
1299 | type_sym = select_possible_type_sym (syms, nsyms); | |
aeb5907d JB |
1300 | |
1301 | if (type_sym != NULL) | |
1302 | renaming_sym = type_sym; | |
1303 | else if (nsyms == 1) | |
1304 | renaming_sym = syms[0].sym; | |
1305 | else | |
1306 | renaming_sym = NULL; | |
1307 | ||
1308 | switch (ada_parse_renaming (renaming_sym, &renaming, | |
1309 | &renaming_len, &renaming_expr)) | |
1310 | { | |
1311 | case ADA_NOT_RENAMING: | |
1312 | break; | |
1313 | case ADA_PACKAGE_RENAMING: | |
1314 | case ADA_EXCEPTION_RENAMING: | |
1315 | case ADA_SUBPROGRAM_RENAMING: | |
1316 | { | |
1317 | char *new_name | |
1318 | = obstack_alloc (&temp_parse_space, | |
1319 | renaming_len + name_len - tail_index + 1); | |
1320 | strncpy (new_name, renaming, renaming_len); | |
1321 | strcpy (new_name + renaming_len, encoded_name + tail_index); | |
1322 | encoded_name = new_name; | |
1323 | name_len = renaming_len + name_len - tail_index; | |
1324 | goto TryAfterRenaming; | |
1325 | } | |
1326 | case ADA_OBJECT_RENAMING: | |
1327 | write_object_renaming (block, renaming, renaming_len, | |
1328 | renaming_expr, MAX_RENAMING_CHAIN_LENGTH); | |
1329 | write_selectors (encoded_name + tail_index); | |
1330 | return NULL; | |
1331 | default: | |
1332 | internal_error (__FILE__, __LINE__, | |
1333 | _("impossible value from ada_parse_renaming")); | |
1334 | } | |
1335 | ||
52ce6436 PH |
1336 | if (type_sym != NULL) |
1337 | { | |
d3353bbd JB |
1338 | struct type *field_type; |
1339 | ||
1340 | if (tail_index == name_len) | |
1341 | return SYMBOL_TYPE (type_sym); | |
1342 | ||
1343 | /* We have some extraneous characters after the type name. | |
1344 | If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN", | |
1345 | then try to get the type of FIELDN. */ | |
1346 | field_type | |
1347 | = get_symbol_field_type (type_sym, encoded_name + tail_index); | |
1348 | if (field_type != NULL) | |
1349 | return field_type; | |
52ce6436 | 1350 | else |
d3353bbd JB |
1351 | error (_("Invalid attempt to select from type: \"%s\"."), |
1352 | name0.ptr); | |
52ce6436 PH |
1353 | } |
1354 | else if (tail_index == name_len && nsyms == 0) | |
1355 | { | |
1356 | struct type *type = find_primitive_type (encoded_name); | |
1357 | ||
1358 | if (type != NULL) | |
1359 | return type; | |
1360 | } | |
1361 | ||
1362 | if (nsyms == 1) | |
1363 | { | |
1364 | write_var_from_sym (block, syms[0].block, syms[0].sym); | |
1365 | write_selectors (encoded_name + tail_index); | |
1366 | return NULL; | |
1367 | } | |
1368 | else if (nsyms == 0) | |
1369 | { | |
1370 | int i; | |
1371 | struct minimal_symbol *msym | |
1372 | = ada_lookup_simple_minsym (encoded_name); | |
1373 | if (msym != NULL) | |
1374 | { | |
c841afd5 | 1375 | write_exp_msymbol (msym); |
52ce6436 PH |
1376 | /* Maybe cause error here rather than later? FIXME? */ |
1377 | write_selectors (encoded_name + tail_index); | |
1378 | return NULL; | |
1379 | } | |
1380 | ||
1381 | if (tail_index == name_len | |
1382 | && strncmp (encoded_name, "standard__", | |
1383 | sizeof ("standard__") - 1) == 0) | |
e1d5a0d2 | 1384 | error (_("No definition of \"%s\" found."), name0.ptr); |
52ce6436 PH |
1385 | |
1386 | tail_index = chop_selector (encoded_name, tail_index); | |
1387 | } | |
1388 | else | |
1389 | { | |
1390 | write_ambiguous_var (block, encoded_name, tail_index); | |
1391 | write_selectors (encoded_name + tail_index); | |
1392 | return NULL; | |
1393 | } | |
1394 | } | |
1395 | ||
1396 | if (!have_full_symbols () && !have_partial_symbols () && block == NULL) | |
e1d5a0d2 | 1397 | error (_("No symbol table is loaded. Use the \"file\" command.")); |
52ce6436 | 1398 | if (block == expression_context_block) |
e1d5a0d2 | 1399 | error (_("No definition of \"%s\" in current context."), name0.ptr); |
52ce6436 | 1400 | else |
e1d5a0d2 | 1401 | error (_("No definition of \"%s\" in specified context."), name0.ptr); |
52ce6436 PH |
1402 | |
1403 | TryAfterRenaming: ; | |
1404 | } | |
1405 | ||
e1d5a0d2 | 1406 | error (_("Could not find renamed symbol \"%s\""), name0.ptr); |
52ce6436 PH |
1407 | |
1408 | } | |
1409 | ||
1410 | /* Write a left side of a component association (e.g., NAME in NAME => | |
1411 | exp). If NAME has the form of a selected component, write it as an | |
1412 | ordinary expression. If it is a simple variable that unambiguously | |
1413 | corresponds to exactly one symbol that does not denote a type or an | |
1414 | object renaming, also write it normally as an OP_VAR_VALUE. | |
1415 | Otherwise, write it as an OP_NAME. | |
1416 | ||
1417 | Unfortunately, we don't know at this point whether NAME is supposed | |
1418 | to denote a record component name or the value of an array index. | |
1419 | Therefore, it is not appropriate to disambiguate an ambiguous name | |
1420 | as we normally would, nor to replace a renaming with its referent. | |
1421 | As a result, in the (one hopes) rare case that one writes an | |
1422 | aggregate such as (R => 42) where R renames an object or is an | |
1423 | ambiguous name, one must write instead ((R) => 42). */ | |
1424 | ||
1425 | static void | |
1426 | write_name_assoc (struct stoken name) | |
1427 | { | |
1428 | if (strchr (name.ptr, '.') == NULL) | |
1429 | { | |
1430 | struct ada_symbol_info *syms; | |
1431 | int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block, | |
1432 | VAR_DOMAIN, &syms); | |
1433 | if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF) | |
1434 | write_exp_op_with_string (OP_NAME, name); | |
1435 | else | |
1436 | write_var_from_sym (NULL, syms[0].block, syms[0].sym); | |
1437 | } | |
1438 | else | |
1439 | if (write_var_or_type (NULL, name) != NULL) | |
e1d5a0d2 | 1440 | error (_("Invalid use of type.")); |
52ce6436 PH |
1441 | } |
1442 | ||
14f9c5c9 AS |
1443 | /* Convert the character literal whose ASCII value would be VAL to the |
1444 | appropriate value of type TYPE, if there is a translation. | |
4c4b4cd2 PH |
1445 | Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), |
1446 | the literal 'A' (VAL == 65), returns 0. */ | |
52ce6436 | 1447 | |
14f9c5c9 | 1448 | static LONGEST |
4c4b4cd2 | 1449 | convert_char_literal (struct type *type, LONGEST val) |
14f9c5c9 AS |
1450 | { |
1451 | char name[7]; | |
1452 | int f; | |
1453 | ||
1454 | if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) | |
1455 | return val; | |
1456 | sprintf (name, "QU%02x", (int) val); | |
4c4b4cd2 | 1457 | for (f = 0; f < TYPE_NFIELDS (type); f += 1) |
14f9c5c9 | 1458 | { |
4c4b4cd2 | 1459 | if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0) |
14f9c5c9 AS |
1460 | return TYPE_FIELD_BITPOS (type, f); |
1461 | } | |
1462 | return val; | |
1463 | } | |
4c4b4cd2 | 1464 | |
72d5681a PH |
1465 | static struct type * |
1466 | type_int (void) | |
1467 | { | |
3e79cecf | 1468 | return parse_type->builtin_int; |
72d5681a PH |
1469 | } |
1470 | ||
1471 | static struct type * | |
1472 | type_long (void) | |
1473 | { | |
3e79cecf | 1474 | return parse_type->builtin_long; |
72d5681a PH |
1475 | } |
1476 | ||
1477 | static struct type * | |
1478 | type_long_long (void) | |
1479 | { | |
3e79cecf | 1480 | return parse_type->builtin_long_long; |
72d5681a PH |
1481 | } |
1482 | ||
1483 | static struct type * | |
1484 | type_float (void) | |
1485 | { | |
3e79cecf | 1486 | return parse_type->builtin_float; |
72d5681a PH |
1487 | } |
1488 | ||
1489 | static struct type * | |
1490 | type_double (void) | |
1491 | { | |
3e79cecf | 1492 | return parse_type->builtin_double; |
72d5681a PH |
1493 | } |
1494 | ||
1495 | static struct type * | |
1496 | type_long_double (void) | |
1497 | { | |
3e79cecf | 1498 | return parse_type->builtin_long_double; |
72d5681a PH |
1499 | } |
1500 | ||
1501 | static struct type * | |
1502 | type_char (void) | |
1503 | { | |
3e79cecf | 1504 | return language_string_char_type (parse_language, parse_gdbarch); |
72d5681a PH |
1505 | } |
1506 | ||
690cc4eb PH |
1507 | static struct type * |
1508 | type_boolean (void) | |
1509 | { | |
3e79cecf | 1510 | return parse_type->builtin_bool; |
690cc4eb PH |
1511 | } |
1512 | ||
72d5681a PH |
1513 | static struct type * |
1514 | type_system_address (void) | |
1515 | { | |
1516 | struct type *type | |
3e79cecf UW |
1517 | = language_lookup_primitive_type_by_name (parse_language, |
1518 | parse_gdbarch, | |
72d5681a | 1519 | "system__address"); |
3e79cecf | 1520 | return type != NULL ? type : parse_type->builtin_data_ptr; |
72d5681a PH |
1521 | } |
1522 | ||
4c4b4cd2 PH |
1523 | void |
1524 | _initialize_ada_exp (void) | |
1525 | { | |
1526 | obstack_init (&temp_parse_space); | |
1527 | } | |
23485554 PH |
1528 | |
1529 | /* FIXME: hilfingr/2004-10-05: Hack to remove warning. The function | |
1530 | string_to_operator is supposed to be used for cases where one | |
1531 | calls an operator function with prefix notation, as in | |
1532 | "+" (a, b), but at some point, this code seems to have gone | |
1533 | missing. */ | |
1534 | ||
1535 | struct stoken (*dummy_string_to_ada_operator) (struct stoken) | |
1536 | = string_to_operator; |