* elf32-sparc.c (_bfd_sparc_elf_howto_table): Fix dst_mask for
[deliverable/binutils-gdb.git] / gdb / ch-lang.c
1 /* Chill language support routines for GDB, the GNU debugger.
2 Copyright 1992, 1993, 1994, 1995, 1996, 2000, 2001
3 Free Software Foundation, Inc.
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
19 Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include "defs.h"
23 #include "symtab.h"
24 #include "gdbtypes.h"
25 #include "value.h"
26 #include "expression.h"
27 #include "parser-defs.h"
28 #include "language.h"
29 #include "ch-lang.h"
30 #include "valprint.h"
31
32 extern void _initialize_chill_language (void);
33
34 static struct value *evaluate_subexp_chill (struct type *, struct expression *,
35 int *, enum noside);
36
37 static struct value *value_chill_max_min (enum exp_opcode, struct value *);
38
39 static struct value *value_chill_card (struct value *);
40
41 static struct value *value_chill_length (struct value *);
42
43 static struct type *chill_create_fundamental_type (struct objfile *, int);
44
45 static void chill_printstr (struct ui_file * stream, char *string,
46 unsigned int length, int width,
47 int force_ellipses);
48
49 static void chill_printchar (int, struct ui_file *);
50
51 /* For now, Chill uses a simple mangling algorithm whereby you simply
52 discard everything after the occurance of two successive CPLUS_MARKER
53 characters to derive the demangled form. */
54
55 char *
56 chill_demangle (const char *mangled)
57 {
58 const char *joiner = NULL;
59 char *demangled;
60 const char *cp = mangled;
61
62 while (*cp)
63 {
64 if (is_cplus_marker (*cp))
65 {
66 joiner = cp;
67 break;
68 }
69 cp++;
70 }
71 if (joiner != NULL && *(joiner + 1) == *joiner)
72 {
73 demangled = savestring (mangled, joiner - mangled);
74 }
75 else
76 {
77 demangled = NULL;
78 }
79 return (demangled);
80 }
81
82 static void
83 chill_printchar (register int c, struct ui_file *stream)
84 {
85 c &= 0xFF; /* Avoid sign bit follies */
86
87 if (PRINT_LITERAL_FORM (c))
88 {
89 if (c == '\'' || c == '^')
90 fprintf_filtered (stream, "'%c%c'", c, c);
91 else
92 fprintf_filtered (stream, "'%c'", c);
93 }
94 else
95 {
96 fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
97 }
98 }
99
100 /* Print the character string STRING, printing at most LENGTH characters.
101 Printing stops early if the number hits print_max; repeat counts
102 are printed as appropriate. Print ellipses at the end if we
103 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
104 Note that gdb maintains the length of strings without counting the
105 terminating null byte, while chill strings are typically written with
106 an explicit null byte. So we always assume an implied null byte
107 until gdb is able to maintain non-null terminated strings as well
108 as null terminated strings (FIXME).
109 */
110
111 static void
112 chill_printstr (struct ui_file *stream, char *string, unsigned int length,
113 int width, int force_ellipses)
114 {
115 register unsigned int i;
116 unsigned int things_printed = 0;
117 int in_literal_form = 0;
118 int in_control_form = 0;
119 int need_slashslash = 0;
120 unsigned int c;
121
122 if (length == 0)
123 {
124 fputs_filtered ("\"\"", stream);
125 return;
126 }
127
128 for (i = 0; i < length && things_printed < print_max; ++i)
129 {
130 /* Position of the character we are examining
131 to see whether it is repeated. */
132 unsigned int rep1;
133 /* Number of repetitions we have detected so far. */
134 unsigned int reps;
135
136 QUIT;
137
138 if (need_slashslash)
139 {
140 fputs_filtered ("//", stream);
141 need_slashslash = 0;
142 }
143
144 rep1 = i + 1;
145 reps = 1;
146 while (rep1 < length && string[rep1] == string[i])
147 {
148 ++rep1;
149 ++reps;
150 }
151
152 c = string[i];
153 if (reps > repeat_count_threshold)
154 {
155 if (in_control_form || in_literal_form)
156 {
157 if (in_control_form)
158 fputs_filtered (")", stream);
159 fputs_filtered ("\"//", stream);
160 in_control_form = in_literal_form = 0;
161 }
162 chill_printchar (c, stream);
163 fprintf_filtered (stream, "<repeats %u times>", reps);
164 i = rep1 - 1;
165 things_printed += repeat_count_threshold;
166 need_slashslash = 1;
167 }
168 else
169 {
170 if (!in_literal_form && !in_control_form)
171 fputs_filtered ("\"", stream);
172 if (PRINT_LITERAL_FORM (c))
173 {
174 if (!in_literal_form)
175 {
176 if (in_control_form)
177 {
178 fputs_filtered (")", stream);
179 in_control_form = 0;
180 }
181 in_literal_form = 1;
182 }
183 fprintf_filtered (stream, "%c", c);
184 if (c == '"' || c == '^')
185 /* duplicate this one as must be done at input */
186 fprintf_filtered (stream, "%c", c);
187 }
188 else
189 {
190 if (!in_control_form)
191 {
192 if (in_literal_form)
193 {
194 in_literal_form = 0;
195 }
196 fputs_filtered ("^(", stream);
197 in_control_form = 1;
198 }
199 else
200 fprintf_filtered (stream, ",");
201 c = c & 0xff;
202 fprintf_filtered (stream, "%u", (unsigned int) c);
203 }
204 ++things_printed;
205 }
206 }
207
208 /* Terminate the quotes if necessary. */
209 if (in_control_form)
210 {
211 fputs_filtered (")", stream);
212 }
213 if (in_literal_form || in_control_form)
214 {
215 fputs_filtered ("\"", stream);
216 }
217 if (force_ellipses || (i < length))
218 {
219 fputs_filtered ("...", stream);
220 }
221 }
222
223 static struct type *
224 chill_create_fundamental_type (struct objfile *objfile, int typeid)
225 {
226 register struct type *type = NULL;
227
228 switch (typeid)
229 {
230 default:
231 /* FIXME: For now, if we are asked to produce a type not in this
232 language, create the equivalent of a C integer type with the
233 name "<?type?>". When all the dust settles from the type
234 reconstruction work, this should probably become an error. */
235 type = init_type (TYPE_CODE_INT, 2, 0, "<?type?>", objfile);
236 warning ("internal error: no chill fundamental type %d", typeid);
237 break;
238 case FT_VOID:
239 /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
240 typedefs, unrelated to anything directly in the code being compiled,
241 that have some FT_VOID types. Just fake it for now. */
242 type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
243 break;
244 case FT_BOOLEAN:
245 type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
246 break;
247 case FT_CHAR:
248 type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
249 break;
250 case FT_SIGNED_CHAR:
251 type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
252 break;
253 case FT_UNSIGNED_CHAR:
254 type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
255 break;
256 case FT_SHORT: /* Chill ints are 2 bytes */
257 type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
258 break;
259 case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
260 type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
261 break;
262 case FT_INTEGER: /* FIXME? */
263 case FT_SIGNED_INTEGER: /* FIXME? */
264 case FT_LONG: /* Chill longs are 4 bytes */
265 case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
266 type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
267 break;
268 case FT_UNSIGNED_INTEGER: /* FIXME? */
269 case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
270 type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
271 break;
272 case FT_FLOAT:
273 type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
274 break;
275 case FT_DBL_PREC_FLOAT:
276 type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
277 break;
278 }
279 return (type);
280 }
281 \f
282
283 /* Table of operators and their precedences for printing expressions. */
284
285 static const struct op_print chill_op_print_tab[] =
286 {
287 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
288 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
289 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
290 {"MOD", BINOP_MOD, PREC_MUL, 0},
291 {"REM", BINOP_REM, PREC_MUL, 0},
292 {"SIZE", UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
293 {"LOWER", UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
294 {"UPPER", UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
295 {"CARD", UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
296 {"MAX", UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
297 {"MIN", UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
298 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
299 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
300 {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
301 {"<=", BINOP_LEQ, PREC_ORDER, 0},
302 {">=", BINOP_GEQ, PREC_ORDER, 0},
303 {">", BINOP_GTR, PREC_ORDER, 0},
304 {"<", BINOP_LESS, PREC_ORDER, 0},
305 {"+", BINOP_ADD, PREC_ADD, 0},
306 {"-", BINOP_SUB, PREC_ADD, 0},
307 {"*", BINOP_MUL, PREC_MUL, 0},
308 {"/", BINOP_DIV, PREC_MUL, 0},
309 {"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
310 {"-", UNOP_NEG, PREC_PREFIX, 0},
311 {"->", UNOP_IND, PREC_SUFFIX, 1},
312 {"->", UNOP_ADDR, PREC_PREFIX, 0},
313 {":", BINOP_RANGE, PREC_ASSIGN, 0},
314 {NULL, 0, 0, 0}
315 };
316 \f
317 /* The built-in types of Chill. */
318
319 struct type *builtin_type_chill_bool;
320 struct type *builtin_type_chill_char;
321 struct type *builtin_type_chill_long;
322 struct type *builtin_type_chill_ulong;
323 struct type *builtin_type_chill_real;
324
325 struct type **CONST_PTR (chill_builtin_types[]) =
326 {
327 &builtin_type_chill_bool,
328 &builtin_type_chill_char,
329 &builtin_type_chill_long,
330 &builtin_type_chill_ulong,
331 &builtin_type_chill_real,
332 0
333 };
334
335 /* Calculate LOWER or UPPER of TYPE.
336 Returns the result as an integer.
337 *RESULT_TYPE is the appropriate type for the result. */
338
339 LONGEST
340 type_lower_upper (enum exp_opcode op, /* Either UNOP_LOWER or UNOP_UPPER */
341 struct type *type, struct type **result_type)
342 {
343 LONGEST low, high;
344 *result_type = type;
345 CHECK_TYPEDEF (type);
346 switch (TYPE_CODE (type))
347 {
348 case TYPE_CODE_STRUCT:
349 *result_type = builtin_type_int;
350 if (chill_varying_type (type))
351 return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
352 break;
353 case TYPE_CODE_ARRAY:
354 case TYPE_CODE_BITSTRING:
355 case TYPE_CODE_STRING:
356 type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
357
358 /* ... fall through ... */
359 case TYPE_CODE_RANGE:
360 *result_type = TYPE_TARGET_TYPE (type);
361 return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
362
363 case TYPE_CODE_ENUM:
364 case TYPE_CODE_BOOL:
365 case TYPE_CODE_INT:
366 case TYPE_CODE_CHAR:
367 if (get_discrete_bounds (type, &low, &high) >= 0)
368 {
369 *result_type = type;
370 return op == UNOP_LOWER ? low : high;
371 }
372 break;
373 case TYPE_CODE_UNDEF:
374 case TYPE_CODE_PTR:
375 case TYPE_CODE_UNION:
376 case TYPE_CODE_FUNC:
377 case TYPE_CODE_FLT:
378 case TYPE_CODE_VOID:
379 case TYPE_CODE_SET:
380 case TYPE_CODE_ERROR:
381 case TYPE_CODE_MEMBER:
382 case TYPE_CODE_METHOD:
383 case TYPE_CODE_REF:
384 case TYPE_CODE_COMPLEX:
385 default:
386 break;
387 }
388 error ("unknown mode for LOWER/UPPER builtin");
389 }
390
391 static struct value *
392 value_chill_length (struct value *val)
393 {
394 LONGEST tmp;
395 struct type *type = VALUE_TYPE (val);
396 struct type *ttype;
397 CHECK_TYPEDEF (type);
398 switch (TYPE_CODE (type))
399 {
400 case TYPE_CODE_ARRAY:
401 case TYPE_CODE_BITSTRING:
402 case TYPE_CODE_STRING:
403 tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
404 - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
405 break;
406 case TYPE_CODE_STRUCT:
407 if (chill_varying_type (type))
408 {
409 tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
410 break;
411 }
412 /* ... else fall through ... */
413 default:
414 error ("bad argument to LENGTH builtin");
415 }
416 return value_from_longest (builtin_type_int, tmp);
417 }
418
419 static struct value *
420 value_chill_card (struct value *val)
421 {
422 LONGEST tmp = 0;
423 struct type *type = VALUE_TYPE (val);
424 CHECK_TYPEDEF (type);
425
426 if (TYPE_CODE (type) == TYPE_CODE_SET)
427 {
428 struct type *range_type = TYPE_INDEX_TYPE (type);
429 LONGEST lower_bound, upper_bound;
430 int i;
431
432 get_discrete_bounds (range_type, &lower_bound, &upper_bound);
433 for (i = lower_bound; i <= upper_bound; i++)
434 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
435 tmp++;
436 }
437 else
438 error ("bad argument to CARD builtin");
439
440 return value_from_longest (builtin_type_int, tmp);
441 }
442
443 static struct value *
444 value_chill_max_min (enum exp_opcode op, struct value *val)
445 {
446 LONGEST tmp = 0;
447 struct type *type = VALUE_TYPE (val);
448 struct type *elttype;
449 CHECK_TYPEDEF (type);
450
451 if (TYPE_CODE (type) == TYPE_CODE_SET)
452 {
453 LONGEST lower_bound, upper_bound;
454 int i, empty = 1;
455
456 elttype = TYPE_INDEX_TYPE (type);
457 CHECK_TYPEDEF (elttype);
458 get_discrete_bounds (elttype, &lower_bound, &upper_bound);
459
460 if (op == UNOP_CHMAX)
461 {
462 for (i = upper_bound; i >= lower_bound; i--)
463 {
464 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
465 {
466 tmp = i;
467 empty = 0;
468 break;
469 }
470 }
471 }
472 else
473 {
474 for (i = lower_bound; i <= upper_bound; i++)
475 {
476 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
477 {
478 tmp = i;
479 empty = 0;
480 break;
481 }
482 }
483 }
484 if (empty)
485 error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
486 }
487 else
488 error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
489
490 return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
491 ? TYPE_TARGET_TYPE (elttype)
492 : elttype,
493 tmp);
494 }
495
496 static struct value *
497 evaluate_subexp_chill (struct type *expect_type,
498 register struct expression *exp, register int *pos,
499 enum noside noside)
500 {
501 int pc = *pos;
502 struct type *type;
503 int tem, nargs;
504 struct value *arg1;
505 struct value **argvec;
506 enum exp_opcode op = exp->elts[*pos].opcode;
507 switch (op)
508 {
509 case MULTI_SUBSCRIPT:
510 if (noside == EVAL_SKIP)
511 break;
512 (*pos) += 3;
513 nargs = longest_to_int (exp->elts[pc + 1].longconst);
514 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
515 type = check_typedef (VALUE_TYPE (arg1));
516
517 if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
518 {
519 /* Looks like string repetition. */
520 struct value *string = evaluate_subexp_with_coercion (exp, pos,
521 noside);
522 return value_concat (arg1, string);
523 }
524
525 switch (TYPE_CODE (type))
526 {
527 case TYPE_CODE_PTR:
528 type = check_typedef (TYPE_TARGET_TYPE (type));
529 if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
530 error ("reference value used as function");
531 /* ... fall through ... */
532 case TYPE_CODE_FUNC:
533 /* It's a function call. */
534 if (noside == EVAL_AVOID_SIDE_EFFECTS)
535 break;
536
537 /* Allocate arg vector, including space for the function to be
538 called in argvec[0] and a terminating NULL */
539 argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
540 argvec[0] = arg1;
541 tem = 1;
542 for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
543 {
544 argvec[tem]
545 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
546 exp, pos, noside);
547 }
548 for (; tem <= nargs; tem++)
549 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
550 argvec[tem] = 0; /* signal end of arglist */
551
552 return call_function_by_hand (argvec[0], nargs, argvec + 1);
553 default:
554 break;
555 }
556
557 while (nargs-- > 0)
558 {
559 struct value *index = evaluate_subexp_with_coercion (exp, pos,
560 noside);
561 arg1 = value_subscript (arg1, index);
562 }
563 return (arg1);
564
565 case UNOP_LOWER:
566 case UNOP_UPPER:
567 (*pos)++;
568 if (noside == EVAL_SKIP)
569 {
570 (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
571 goto nosideret;
572 }
573 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
574 EVAL_AVOID_SIDE_EFFECTS);
575 tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
576 return value_from_longest (type, tem);
577
578 case UNOP_LENGTH:
579 (*pos)++;
580 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
581 return value_chill_length (arg1);
582
583 case UNOP_CARD:
584 (*pos)++;
585 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
586 return value_chill_card (arg1);
587
588 case UNOP_CHMAX:
589 case UNOP_CHMIN:
590 (*pos)++;
591 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
592 return value_chill_max_min (op, arg1);
593
594 case BINOP_COMMA:
595 error ("',' operator used in invalid context");
596
597 default:
598 break;
599 }
600
601 return evaluate_subexp_standard (expect_type, exp, pos, noside);
602 nosideret:
603 return value_from_longest (builtin_type_long, (LONGEST) 1);
604 }
605
606 const struct language_defn chill_language_defn =
607 {
608 "chill",
609 language_chill,
610 chill_builtin_types,
611 range_check_on,
612 type_check_on,
613 case_sensitive_on,
614 chill_parse, /* parser */
615 chill_error, /* parser error function */
616 evaluate_subexp_chill,
617 chill_printchar, /* print a character constant */
618 chill_printstr, /* function to print a string constant */
619 NULL, /* Function to print a single char */
620 chill_create_fundamental_type, /* Create fundamental type in this language */
621 chill_print_type, /* Print a type using appropriate syntax */
622 chill_val_print, /* Print a value using appropriate syntax */
623 chill_value_print, /* Print a top-levl value */
624 {"", "B'", "", ""}, /* Binary format info */
625 {"O'%lo", "O'", "o", ""}, /* Octal format info */
626 {"D'%ld", "D'", "d", ""}, /* Decimal format info */
627 {"H'%lx", "H'", "x", ""}, /* Hex format info */
628 chill_op_print_tab, /* expression operators for printing */
629 0, /* arrays are first-class (not c-style) */
630 0, /* String lower bound */
631 &builtin_type_chill_char, /* Type of string elements */
632 LANG_MAGIC
633 };
634
635 /* Initialization for Chill */
636
637 void
638 _initialize_chill_language (void)
639 {
640 builtin_type_chill_bool =
641 init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
642 TYPE_FLAG_UNSIGNED,
643 "BOOL", (struct objfile *) NULL);
644 builtin_type_chill_char =
645 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
646 TYPE_FLAG_UNSIGNED,
647 "CHAR", (struct objfile *) NULL);
648 builtin_type_chill_long =
649 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
650 0,
651 "LONG", (struct objfile *) NULL);
652 builtin_type_chill_ulong =
653 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
654 TYPE_FLAG_UNSIGNED,
655 "ULONG", (struct objfile *) NULL);
656 builtin_type_chill_real =
657 init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
658 0,
659 "LONG_REAL", (struct objfile *) NULL);
660
661 add_language (&chill_language_defn);
662 }
This page took 0.043197 seconds and 4 git commands to generate.