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