2000-12-17 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
[deliverable/binutils-gdb.git] / gdb / ch-lang.c
1 /* Chill language support routines for GDB, the GNU debugger.
2 Copyright 1992, 1995, 1996, 2000 Free Software Foundation, Inc.
3
4 This file is part of GDB.
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 #include "defs.h"
22 #include "symtab.h"
23 #include "gdbtypes.h"
24 #include "value.h"
25 #include "expression.h"
26 #include "parser-defs.h"
27 #include "language.h"
28 #include "ch-lang.h"
29 #include "valprint.h"
30
31 extern void _initialize_chill_language (void);
32
33 static value_ptr
34 evaluate_subexp_chill (struct type *, struct expression *, int *,
35 enum noside);
36
37 static value_ptr value_chill_max_min (enum exp_opcode, value_ptr);
38
39 static value_ptr value_chill_card (value_ptr);
40
41 static value_ptr value_chill_length (value_ptr);
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 value_ptr
392 value_chill_length (value_ptr 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 value_ptr
420 value_chill_card (value_ptr 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 value_ptr
444 value_chill_max_min (enum exp_opcode op, value_ptr 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 value_ptr
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 value_ptr arg1;
505 value_ptr *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 value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
521 return value_concat (arg1, string);
522 }
523
524 switch (TYPE_CODE (type))
525 {
526 case TYPE_CODE_PTR:
527 type = check_typedef (TYPE_TARGET_TYPE (type));
528 if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
529 error ("reference value used as function");
530 /* ... fall through ... */
531 case TYPE_CODE_FUNC:
532 /* It's a function call. */
533 if (noside == EVAL_AVOID_SIDE_EFFECTS)
534 break;
535
536 /* Allocate arg vector, including space for the function to be
537 called in argvec[0] and a terminating NULL */
538 argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
539 argvec[0] = arg1;
540 tem = 1;
541 for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
542 {
543 argvec[tem]
544 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
545 exp, pos, noside);
546 }
547 for (; tem <= nargs; tem++)
548 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
549 argvec[tem] = 0; /* signal end of arglist */
550
551 return call_function_by_hand (argvec[0], nargs, argvec + 1);
552 default:
553 break;
554 }
555
556 while (nargs-- > 0)
557 {
558 value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
559 arg1 = value_subscript (arg1, index);
560 }
561 return (arg1);
562
563 case UNOP_LOWER:
564 case UNOP_UPPER:
565 (*pos)++;
566 if (noside == EVAL_SKIP)
567 {
568 (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
569 goto nosideret;
570 }
571 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
572 EVAL_AVOID_SIDE_EFFECTS);
573 tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
574 return value_from_longest (type, tem);
575
576 case UNOP_LENGTH:
577 (*pos)++;
578 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
579 return value_chill_length (arg1);
580
581 case UNOP_CARD:
582 (*pos)++;
583 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
584 return value_chill_card (arg1);
585
586 case UNOP_CHMAX:
587 case UNOP_CHMIN:
588 (*pos)++;
589 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
590 return value_chill_max_min (op, arg1);
591
592 case BINOP_COMMA:
593 error ("',' operator used in invalid context");
594
595 default:
596 break;
597 }
598
599 return evaluate_subexp_standard (expect_type, exp, pos, noside);
600 nosideret:
601 return value_from_longest (builtin_type_long, (LONGEST) 1);
602 }
603
604 const struct language_defn chill_language_defn =
605 {
606 "chill",
607 language_chill,
608 chill_builtin_types,
609 range_check_on,
610 type_check_on,
611 case_sensitive_on,
612 chill_parse, /* parser */
613 chill_error, /* parser error function */
614 evaluate_subexp_chill,
615 chill_printchar, /* print a character constant */
616 chill_printstr, /* function to print a string constant */
617 NULL, /* Function to print a single char */
618 chill_create_fundamental_type, /* Create fundamental type in this language */
619 chill_print_type, /* Print a type using appropriate syntax */
620 chill_val_print, /* Print a value using appropriate syntax */
621 chill_value_print, /* Print a top-levl value */
622 {"", "B'", "", ""}, /* Binary format info */
623 {"O'%lo", "O'", "o", ""}, /* Octal format info */
624 {"D'%ld", "D'", "d", ""}, /* Decimal format info */
625 {"H'%lx", "H'", "x", ""}, /* Hex format info */
626 chill_op_print_tab, /* expression operators for printing */
627 0, /* arrays are first-class (not c-style) */
628 0, /* String lower bound */
629 &builtin_type_chill_char, /* Type of string elements */
630 LANG_MAGIC
631 };
632
633 /* Initialization for Chill */
634
635 void
636 _initialize_chill_language (void)
637 {
638 builtin_type_chill_bool =
639 init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
640 TYPE_FLAG_UNSIGNED,
641 "BOOL", (struct objfile *) NULL);
642 builtin_type_chill_char =
643 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
644 TYPE_FLAG_UNSIGNED,
645 "CHAR", (struct objfile *) NULL);
646 builtin_type_chill_long =
647 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
648 0,
649 "LONG", (struct objfile *) NULL);
650 builtin_type_chill_ulong =
651 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
652 TYPE_FLAG_UNSIGNED,
653 "ULONG", (struct objfile *) NULL);
654 builtin_type_chill_real =
655 init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
656 0,
657 "LONG_REAL", (struct objfile *) NULL);
658
659 add_language (&chill_language_defn);
660 }
This page took 0.042085 seconds and 4 git commands to generate.