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 (void);
34 evaluate_subexp_chill (struct type *, struct expression *, int *,
37 static value_ptr value_chill_max_min (enum exp_opcode, value_ptr);
39 static value_ptr value_chill_card (value_ptr);
41 static value_ptr value_chill_length (value_ptr);
43 static struct type *chill_create_fundamental_type (struct objfile *, int);
45 static void chill_printstr (struct ui_file * stream, char *string,
46 unsigned int length, int width,
49 static void chill_printchar (int, struct ui_file *);
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. */
56 chill_demangle (const char *mangled)
58 const char *joiner = NULL;
60 const char *cp = mangled;
64 if (is_cplus_marker (*cp))
71 if (joiner != NULL && *(joiner + 1) == *joiner)
73 demangled = savestring (mangled, joiner - mangled);
83 chill_printchar (register int c, struct ui_file *stream)
85 c &= 0xFF; /* Avoid sign bit follies */
87 if (PRINT_LITERAL_FORM (c))
89 if (c == '\'' || c == '^')
90 fprintf_filtered (stream, "'%c%c'", c, c);
92 fprintf_filtered (stream, "'%c'", c);
96 fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
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).
112 chill_printstr (struct ui_file *stream, char *string, unsigned int length,
113 int width, int force_ellipses)
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;
124 fputs_filtered ("\"\"", stream);
128 for (i = 0; i < length && things_printed < print_max; ++i)
130 /* Position of the character we are examining
131 to see whether it is repeated. */
133 /* Number of repetitions we have detected so far. */
140 fputs_filtered ("//", stream);
146 while (rep1 < length && string[rep1] == string[i])
153 if (reps > repeat_count_threshold)
155 if (in_control_form || in_literal_form)
158 fputs_filtered (")", stream);
159 fputs_filtered ("\"//", stream);
160 in_control_form = in_literal_form = 0;
162 chill_printchar (c, stream);
163 fprintf_filtered (stream, "<repeats %u times>", reps);
165 things_printed += repeat_count_threshold;
170 if (!in_literal_form && !in_control_form)
171 fputs_filtered ("\"", stream);
172 if (PRINT_LITERAL_FORM (c))
174 if (!in_literal_form)
178 fputs_filtered (")", stream);
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);
190 if (!in_control_form)
196 fputs_filtered ("^(", stream);
200 fprintf_filtered (stream, ",");
202 fprintf_filtered (stream, "%u", (unsigned int) c);
208 /* Terminate the quotes if necessary. */
211 fputs_filtered (")", stream);
213 if (in_literal_form || in_control_form)
215 fputs_filtered ("\"", stream);
217 if (force_ellipses || (i < length))
219 fputs_filtered ("...", stream);
224 chill_create_fundamental_type (struct objfile *objfile, int typeid)
226 register struct type *type = NULL;
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);
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);
245 type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
248 type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
251 type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
253 case FT_UNSIGNED_CHAR:
254 type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
256 case FT_SHORT: /* Chill ints are 2 bytes */
257 type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
259 case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
260 type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
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);
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);
273 type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
275 case FT_DBL_PREC_FLOAT:
276 type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
283 /* Table of operators and their precedences for printing expressions. */
285 static const struct op_print chill_op_print_tab[] =
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},
317 /* The built-in types of Chill. */
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;
325 struct type **CONST_PTR (chill_builtin_types[]) =
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,
335 /* Calculate LOWER or UPPER of TYPE.
336 Returns the result as an integer.
337 *RESULT_TYPE is the appropriate type for the result. */
340 type_lower_upper (enum exp_opcode op, /* Either UNOP_LOWER or UNOP_UPPER */
341 struct type *type, struct type **result_type)
345 CHECK_TYPEDEF (type);
346 switch (TYPE_CODE (type))
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);
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 */
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);
367 if (get_discrete_bounds (type, &low, &high) >= 0)
370 return op == UNOP_LOWER ? low : high;
373 case TYPE_CODE_UNDEF:
375 case TYPE_CODE_UNION:
380 case TYPE_CODE_ERROR:
381 case TYPE_CODE_MEMBER:
382 case TYPE_CODE_METHOD:
384 case TYPE_CODE_COMPLEX:
388 error ("unknown mode for LOWER/UPPER builtin");
392 value_chill_length (value_ptr val)
395 struct type *type = VALUE_TYPE (val);
397 CHECK_TYPEDEF (type);
398 switch (TYPE_CODE (type))
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;
406 case TYPE_CODE_STRUCT:
407 if (chill_varying_type (type))
409 tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
412 /* ... else fall through ... */
414 error ("bad argument to LENGTH builtin");
416 return value_from_longest (builtin_type_int, tmp);
420 value_chill_card (value_ptr val)
423 struct type *type = VALUE_TYPE (val);
424 CHECK_TYPEDEF (type);
426 if (TYPE_CODE (type) == TYPE_CODE_SET)
428 struct type *range_type = TYPE_INDEX_TYPE (type);
429 LONGEST lower_bound, upper_bound;
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)
438 error ("bad argument to CARD builtin");
440 return value_from_longest (builtin_type_int, tmp);
444 value_chill_max_min (enum exp_opcode op, value_ptr val)
447 struct type *type = VALUE_TYPE (val);
448 struct type *elttype;
449 CHECK_TYPEDEF (type);
451 if (TYPE_CODE (type) == TYPE_CODE_SET)
453 LONGEST lower_bound, upper_bound;
456 elttype = TYPE_INDEX_TYPE (type);
457 CHECK_TYPEDEF (elttype);
458 get_discrete_bounds (elttype, &lower_bound, &upper_bound);
460 if (op == UNOP_CHMAX)
462 for (i = upper_bound; i >= lower_bound; i--)
464 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
474 for (i = lower_bound; i <= upper_bound; i++)
476 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
485 error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
488 error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
490 return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
491 ? TYPE_TARGET_TYPE (elttype)
497 evaluate_subexp_chill (struct type *expect_type,
498 register struct expression *exp, register int *pos,
506 enum exp_opcode op = exp->elts[*pos].opcode;
509 case MULTI_SUBSCRIPT:
510 if (noside == EVAL_SKIP)
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));
517 if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
519 /* Looks like string repetition. */
520 value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
521 return value_concat (arg1, string);
524 switch (TYPE_CODE (type))
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 ... */
532 /* It's a function call. */
533 if (noside == EVAL_AVOID_SIDE_EFFECTS)
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));
541 for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
544 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
547 for (; tem <= nargs; tem++)
548 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
549 argvec[tem] = 0; /* signal end of arglist */
551 return call_function_by_hand (argvec[0], nargs, argvec + 1);
558 value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
559 arg1 = value_subscript (arg1, index);
566 if (noside == EVAL_SKIP)
568 (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
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);
578 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
579 return value_chill_length (arg1);
583 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
584 return value_chill_card (arg1);
589 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
590 return value_chill_max_min (op, arg1);
593 error ("',' operator used in invalid context");
599 return evaluate_subexp_standard (expect_type, exp, pos, noside);
601 return value_from_longest (builtin_type_long, (LONGEST) 1);
604 const struct language_defn chill_language_defn =
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 */
633 /* Initialization for Chill */
636 _initialize_chill_language (void)
638 builtin_type_chill_bool =
639 init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
641 "BOOL", (struct objfile *) NULL);
642 builtin_type_chill_char =
643 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
645 "CHAR", (struct objfile *) NULL);
646 builtin_type_chill_long =
647 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
649 "LONG", (struct objfile *) NULL);
650 builtin_type_chill_ulong =
651 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
653 "ULONG", (struct objfile *) NULL);
654 builtin_type_chill_real =
655 init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
657 "LONG_REAL", (struct objfile *) NULL);
659 add_language (&chill_language_defn);