1 /* Chill language support routines for GDB, the GNU debugger.
2 Copyright 1992, 1995, 1996, 2000 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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. */
25 #include "expression.h"
26 #include "parser-defs.h"
31 extern void _initialize_chill_language PARAMS ((void));
34 evaluate_subexp_chill PARAMS ((struct type *, struct expression *, int *, enum noside));
37 value_chill_max_min PARAMS ((enum exp_opcode, value_ptr));
40 value_chill_card PARAMS ((value_ptr));
43 value_chill_length PARAMS ((value_ptr));
46 chill_create_fundamental_type PARAMS ((struct objfile *, int));
48 static void chill_printstr (struct ui_file * stream, char *string,
49 unsigned int length, int width,
52 static void chill_printchar (int, struct ui_file *);
54 /* For now, Chill uses a simple mangling algorithm whereby you simply
55 discard everything after the occurance of two successive CPLUS_MARKER
56 characters to derive the demangled form. */
59 chill_demangle (mangled)
62 const char *joiner = NULL;
64 const char *cp = mangled;
68 if (is_cplus_marker (*cp))
75 if (joiner != NULL && *(joiner + 1) == *joiner)
77 demangled = savestring (mangled, joiner - mangled);
87 chill_printchar (c, stream)
89 struct ui_file *stream;
91 c &= 0xFF; /* Avoid sign bit follies */
93 if (PRINT_LITERAL_FORM (c))
95 if (c == '\'' || c == '^')
96 fprintf_filtered (stream, "'%c%c'", c, c);
98 fprintf_filtered (stream, "'%c'", c);
102 fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
106 /* Print the character string STRING, printing at most LENGTH characters.
107 Printing stops early if the number hits print_max; repeat counts
108 are printed as appropriate. Print ellipses at the end if we
109 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
110 Note that gdb maintains the length of strings without counting the
111 terminating null byte, while chill strings are typically written with
112 an explicit null byte. So we always assume an implied null byte
113 until gdb is able to maintain non-null terminated strings as well
114 as null terminated strings (FIXME).
118 chill_printstr (stream, string, length, width, force_ellipses)
119 struct ui_file *stream;
125 register unsigned int i;
126 unsigned int things_printed = 0;
127 int in_literal_form = 0;
128 int in_control_form = 0;
129 int need_slashslash = 0;
134 fputs_filtered ("\"\"", stream);
138 for (i = 0; i < length && things_printed < print_max; ++i)
140 /* Position of the character we are examining
141 to see whether it is repeated. */
143 /* Number of repetitions we have detected so far. */
150 fputs_filtered ("//", stream);
156 while (rep1 < length && string[rep1] == string[i])
163 if (reps > repeat_count_threshold)
165 if (in_control_form || in_literal_form)
168 fputs_filtered (")", stream);
169 fputs_filtered ("\"//", stream);
170 in_control_form = in_literal_form = 0;
172 chill_printchar (c, stream);
173 fprintf_filtered (stream, "<repeats %u times>", reps);
175 things_printed += repeat_count_threshold;
180 if (!in_literal_form && !in_control_form)
181 fputs_filtered ("\"", stream);
182 if (PRINT_LITERAL_FORM (c))
184 if (!in_literal_form)
188 fputs_filtered (")", stream);
193 fprintf_filtered (stream, "%c", c);
194 if (c == '"' || c == '^')
195 /* duplicate this one as must be done at input */
196 fprintf_filtered (stream, "%c", c);
200 if (!in_control_form)
206 fputs_filtered ("^(", stream);
210 fprintf_filtered (stream, ",");
212 fprintf_filtered (stream, "%u", (unsigned int) c);
218 /* Terminate the quotes if necessary. */
221 fputs_filtered (")", stream);
223 if (in_literal_form || in_control_form)
225 fputs_filtered ("\"", stream);
227 if (force_ellipses || (i < length))
229 fputs_filtered ("...", stream);
234 chill_create_fundamental_type (objfile, typeid)
235 struct objfile *objfile;
238 register struct type *type = NULL;
243 /* FIXME: For now, if we are asked to produce a type not in this
244 language, create the equivalent of a C integer type with the
245 name "<?type?>". When all the dust settles from the type
246 reconstruction work, this should probably become an error. */
247 type = init_type (TYPE_CODE_INT, 2, 0, "<?type?>", objfile);
248 warning ("internal error: no chill fundamental type %d", typeid);
251 /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
252 typedefs, unrelated to anything directly in the code being compiled,
253 that have some FT_VOID types. Just fake it for now. */
254 type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
257 type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
260 type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
263 type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
265 case FT_UNSIGNED_CHAR:
266 type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
268 case FT_SHORT: /* Chill ints are 2 bytes */
269 type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
271 case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
272 type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
274 case FT_INTEGER: /* FIXME? */
275 case FT_SIGNED_INTEGER: /* FIXME? */
276 case FT_LONG: /* Chill longs are 4 bytes */
277 case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
278 type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
280 case FT_UNSIGNED_INTEGER: /* FIXME? */
281 case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
282 type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
285 type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
287 case FT_DBL_PREC_FLOAT:
288 type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
295 /* Table of operators and their precedences for printing expressions. */
297 static const struct op_print chill_op_print_tab[] =
299 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
300 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
301 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
302 {"MOD", BINOP_MOD, PREC_MUL, 0},
303 {"REM", BINOP_REM, PREC_MUL, 0},
304 {"SIZE", UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
305 {"LOWER", UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
306 {"UPPER", UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
307 {"CARD", UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
308 {"MAX", UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
309 {"MIN", UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
310 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
311 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
312 {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
313 {"<=", BINOP_LEQ, PREC_ORDER, 0},
314 {">=", BINOP_GEQ, PREC_ORDER, 0},
315 {">", BINOP_GTR, PREC_ORDER, 0},
316 {"<", BINOP_LESS, PREC_ORDER, 0},
317 {"+", BINOP_ADD, PREC_ADD, 0},
318 {"-", BINOP_SUB, PREC_ADD, 0},
319 {"*", BINOP_MUL, PREC_MUL, 0},
320 {"/", BINOP_DIV, PREC_MUL, 0},
321 {"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
322 {"-", UNOP_NEG, PREC_PREFIX, 0},
323 {"->", UNOP_IND, PREC_SUFFIX, 1},
324 {"->", UNOP_ADDR, PREC_PREFIX, 0},
325 {":", BINOP_RANGE, PREC_ASSIGN, 0},
329 /* The built-in types of Chill. */
331 struct type *builtin_type_chill_bool;
332 struct type *builtin_type_chill_char;
333 struct type *builtin_type_chill_long;
334 struct type *builtin_type_chill_ulong;
335 struct type *builtin_type_chill_real;
337 struct type **CONST_PTR (chill_builtin_types[]) =
339 &builtin_type_chill_bool,
340 &builtin_type_chill_char,
341 &builtin_type_chill_long,
342 &builtin_type_chill_ulong,
343 &builtin_type_chill_real,
347 /* Calculate LOWER or UPPER of TYPE.
348 Returns the result as an integer.
349 *RESULT_TYPE is the appropriate type for the result. */
352 type_lower_upper (op, type, result_type)
353 enum exp_opcode op; /* Either UNOP_LOWER or UNOP_UPPER */
355 struct type **result_type;
359 CHECK_TYPEDEF (type);
360 switch (TYPE_CODE (type))
362 case TYPE_CODE_STRUCT:
363 *result_type = builtin_type_int;
364 if (chill_varying_type (type))
365 return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
367 case TYPE_CODE_ARRAY:
368 case TYPE_CODE_BITSTRING:
369 case TYPE_CODE_STRING:
370 type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
372 /* ... fall through ... */
373 case TYPE_CODE_RANGE:
374 *result_type = TYPE_TARGET_TYPE (type);
375 return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
381 if (get_discrete_bounds (type, &low, &high) >= 0)
384 return op == UNOP_LOWER ? low : high;
387 case TYPE_CODE_UNDEF:
389 case TYPE_CODE_UNION:
394 case TYPE_CODE_ERROR:
395 case TYPE_CODE_MEMBER:
396 case TYPE_CODE_METHOD:
398 case TYPE_CODE_COMPLEX:
402 error ("unknown mode for LOWER/UPPER builtin");
406 value_chill_length (val)
410 struct type *type = VALUE_TYPE (val);
412 CHECK_TYPEDEF (type);
413 switch (TYPE_CODE (type))
415 case TYPE_CODE_ARRAY:
416 case TYPE_CODE_BITSTRING:
417 case TYPE_CODE_STRING:
418 tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
419 - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
421 case TYPE_CODE_STRUCT:
422 if (chill_varying_type (type))
424 tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
427 /* ... else fall through ... */
429 error ("bad argument to LENGTH builtin");
431 return value_from_longest (builtin_type_int, tmp);
435 value_chill_card (val)
439 struct type *type = VALUE_TYPE (val);
440 CHECK_TYPEDEF (type);
442 if (TYPE_CODE (type) == TYPE_CODE_SET)
444 struct type *range_type = TYPE_INDEX_TYPE (type);
445 LONGEST lower_bound, upper_bound;
448 get_discrete_bounds (range_type, &lower_bound, &upper_bound);
449 for (i = lower_bound; i <= upper_bound; i++)
450 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
454 error ("bad argument to CARD builtin");
456 return value_from_longest (builtin_type_int, tmp);
460 value_chill_max_min (op, val)
465 struct type *type = VALUE_TYPE (val);
466 struct type *elttype;
467 CHECK_TYPEDEF (type);
469 if (TYPE_CODE (type) == TYPE_CODE_SET)
471 LONGEST lower_bound, upper_bound;
474 elttype = TYPE_INDEX_TYPE (type);
475 CHECK_TYPEDEF (elttype);
476 get_discrete_bounds (elttype, &lower_bound, &upper_bound);
478 if (op == UNOP_CHMAX)
480 for (i = upper_bound; i >= lower_bound; i--)
482 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
492 for (i = lower_bound; i <= upper_bound; i++)
494 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
503 error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
506 error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
508 return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
509 ? TYPE_TARGET_TYPE (elttype)
515 evaluate_subexp_chill (expect_type, exp, pos, noside)
516 struct type *expect_type;
517 register struct expression *exp;
526 enum exp_opcode op = exp->elts[*pos].opcode;
529 case MULTI_SUBSCRIPT:
530 if (noside == EVAL_SKIP)
533 nargs = longest_to_int (exp->elts[pc + 1].longconst);
534 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
535 type = check_typedef (VALUE_TYPE (arg1));
537 if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
539 /* Looks like string repetition. */
540 value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
541 return value_concat (arg1, string);
544 switch (TYPE_CODE (type))
547 type = check_typedef (TYPE_TARGET_TYPE (type));
548 if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
549 error ("reference value used as function");
550 /* ... fall through ... */
552 /* It's a function call. */
553 if (noside == EVAL_AVOID_SIDE_EFFECTS)
556 /* Allocate arg vector, including space for the function to be
557 called in argvec[0] and a terminating NULL */
558 argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
561 for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
564 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
567 for (; tem <= nargs; tem++)
568 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
569 argvec[tem] = 0; /* signal end of arglist */
571 return call_function_by_hand (argvec[0], nargs, argvec + 1);
578 value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
579 arg1 = value_subscript (arg1, index);
586 if (noside == EVAL_SKIP)
588 (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
591 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
592 EVAL_AVOID_SIDE_EFFECTS);
593 tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
594 return value_from_longest (type, tem);
598 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
599 return value_chill_length (arg1);
603 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
604 return value_chill_card (arg1);
609 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
610 return value_chill_max_min (op, arg1);
613 error ("',' operator used in invalid context");
619 return evaluate_subexp_standard (expect_type, exp, pos, noside);
621 return value_from_longest (builtin_type_long, (LONGEST) 1);
624 const struct language_defn chill_language_defn =
631 chill_parse, /* parser */
632 chill_error, /* parser error function */
633 evaluate_subexp_chill,
634 chill_printchar, /* print a character constant */
635 chill_printstr, /* function to print a string constant */
636 NULL, /* Function to print a single char */
637 chill_create_fundamental_type, /* Create fundamental type in this language */
638 chill_print_type, /* Print a type using appropriate syntax */
639 chill_val_print, /* Print a value using appropriate syntax */
640 chill_value_print, /* Print a top-levl value */
641 {"", "B'", "", ""}, /* Binary format info */
642 {"O'%lo", "O'", "o", ""}, /* Octal format info */
643 {"D'%ld", "D'", "d", ""}, /* Decimal format info */
644 {"H'%lx", "H'", "x", ""}, /* Hex format info */
645 chill_op_print_tab, /* expression operators for printing */
646 0, /* arrays are first-class (not c-style) */
647 0, /* String lower bound */
648 &builtin_type_chill_char, /* Type of string elements */
652 /* Initialization for Chill */
655 _initialize_chill_language ()
657 builtin_type_chill_bool =
658 init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
660 "BOOL", (struct objfile *) NULL);
661 builtin_type_chill_char =
662 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
664 "CHAR", (struct objfile *) NULL);
665 builtin_type_chill_long =
666 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
668 "LONG", (struct objfile *) NULL);
669 builtin_type_chill_ulong =
670 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
672 "ULONG", (struct objfile *) NULL);
673 builtin_type_chill_real =
674 init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
676 "LONG_REAL", (struct objfile *) NULL);
678 add_language (&chill_language_defn);