/* Chill language support routines for GDB, the GNU debugger.
- Copyright 1992 Free Software Foundation, Inc.
+ Copyright 1992, 1995, 1996 Free Software Foundation, Inc.
This file is part of GDB.
#include "language.h"
#include "ch-lang.h"
+static value_ptr
+evaluate_subexp_chill PARAMS ((struct type *, struct expression *, int *, enum noside));
+
+static value_ptr
+value_chill_max_min PARAMS ((enum exp_opcode, value_ptr));
+
+static value_ptr
+value_chill_card PARAMS ((value_ptr));
+
+static value_ptr
+ value_chill_length PARAMS ((value_ptr));
+
+static struct type *
+chill_create_fundamental_type PARAMS ((struct objfile *, int));
+
+static void
+chill_printstr PARAMS ((GDB_FILE *, char *, unsigned int, int));
+
+static void
+chill_printchar PARAMS ((int, GDB_FILE *));
/* For now, Chill uses a simple mangling algorithm whereby you simply
discard everything after the occurance of two successive CPLUS_MARKER
chill_demangle (mangled)
const char *mangled;
{
- char *joiner;
+ const char *joiner = NULL;
char *demangled;
+ const char *cp = mangled;
- joiner = strchr (mangled, CPLUS_MARKER);
- if (joiner != NULL && *(joiner + 1) == CPLUS_MARKER)
+ while (*cp)
+ {
+ if (is_cplus_marker (*cp))
+ {
+ joiner = cp;
+ break;
+ }
+ cp++;
+ }
+ if (joiner != NULL && *(joiner + 1) == *joiner)
{
demangled = savestring (mangled, joiner - mangled);
}
if (PRINT_LITERAL_FORM (c))
{
- fprintf_filtered (stream, "'%c'", c);
+ if (c == '\'' || c == '^')
+ fprintf_filtered (stream, "'%c%c'", c, c);
+ else
+ fprintf_filtered (stream, "'%c'", c);
}
else
{
- fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
+ fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
}
}
{
if (in_control_form || in_literal_form)
{
+ if (in_control_form)
+ fputs_filtered (")", stream);
fputs_filtered ("\"//", stream);
in_control_form = in_literal_form = 0;
}
}
else
{
+ if (! in_literal_form && ! in_control_form)
+ fputs_filtered ("\"", stream);
if (PRINT_LITERAL_FORM (c))
{
if (!in_literal_form)
{
if (in_control_form)
{
- fputs_filtered ("\"//", stream);
+ fputs_filtered (")", stream);
in_control_form = 0;
}
- fputs_filtered ("\"", stream);
in_literal_form = 1;
}
fprintf_filtered (stream, "%c", c);
+ if (c == '"' || c == '^')
+ /* duplicate this one as must be done at input */
+ fprintf_filtered (stream, "%c", c);
}
else
{
{
if (in_literal_form)
{
- fputs_filtered ("\"//", stream);
in_literal_form = 0;
}
- fputs_filtered ("c\"", stream);
+ fputs_filtered ("^(", stream);
in_control_form = 1;
}
- fprintf_filtered (stream, "%.2x", c);
+ else
+ fprintf_filtered (stream, ",");
+ c = c & 0xff;
+ fprintf_filtered (stream, "%u", (unsigned int) c);
}
++things_printed;
}
}
/* Terminate the quotes if necessary. */
+ if (in_control_form)
+ {
+ fputs_filtered (")", stream);
+ }
if (in_literal_form || in_control_form)
{
fputs_filtered ("\"", stream);
{"SIZE",UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
{"LOWER",UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
{"UPPER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
- {"LOWER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
+ {"CARD",UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
+ {"MAX",UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
+ {"MIN",UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
{"=", BINOP_EQUAL, PREC_EQUAL, 0},
{"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
return value_from_longest (builtin_type_int, tmp);
}
+static value_ptr
+value_chill_card (val)
+ value_ptr val;
+{
+ LONGEST tmp = 0;
+ struct type *type = VALUE_TYPE (val);
+ CHECK_TYPEDEF (type);
+
+ if (TYPE_CODE (type) == TYPE_CODE_SET)
+ {
+ struct type *range_type = TYPE_INDEX_TYPE (type);
+ LONGEST lower_bound, upper_bound;
+ int i;
+
+ get_discrete_bounds (range_type, &lower_bound, &upper_bound);
+ for (i = lower_bound; i <= upper_bound; i++)
+ if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
+ tmp++;
+ }
+ else
+ error ("bad argument to CARD builtin");
+
+ return value_from_longest (builtin_type_int, tmp);
+}
+
+static value_ptr
+value_chill_max_min (op, val)
+ enum exp_opcode op;
+ value_ptr val;
+{
+ LONGEST tmp = 0;
+ struct type *type = VALUE_TYPE (val);
+ struct type *elttype;
+ CHECK_TYPEDEF (type);
+
+ if (TYPE_CODE (type) == TYPE_CODE_SET)
+ {
+ LONGEST lower_bound, upper_bound;
+ int i, empty = 1;
+
+ elttype = TYPE_INDEX_TYPE (type);
+ CHECK_TYPEDEF (elttype);
+ get_discrete_bounds (elttype, &lower_bound, &upper_bound);
+
+ if (op == UNOP_CHMAX)
+ {
+ for (i = upper_bound; i >= lower_bound; i--)
+ {
+ if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
+ {
+ tmp = i;
+ empty = 0;
+ break;
+ }
+ }
+ }
+ else
+ {
+ for (i = lower_bound; i <= upper_bound; i++)
+ {
+ if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
+ {
+ tmp = i;
+ empty = 0;
+ break;
+ }
+ }
+ }
+ if (empty)
+ error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
+ }
+ else
+ error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
+
+ return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
+ ? TYPE_TARGET_TYPE (elttype)
+ : elttype,
+ tmp);
+}
+
static value_ptr
evaluate_subexp_chill (expect_type, exp, pos, noside)
struct type *expect_type;
switch (TYPE_CODE (type))
{
case TYPE_CODE_PTR:
+ type = check_typedef (TYPE_TARGET_TYPE (type));
+ if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
+ error ("reference value used as function");
+ /* ... fall through ... */
case TYPE_CODE_FUNC:
/* It's a function call. */
if (noside == EVAL_AVOID_SIDE_EFFECTS)
argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
argvec[0] = arg1;
tem = 1;
- if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
- type = check_typedef (TYPE_TARGET_TYPE (type));
- if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
+ for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
{
- for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
- {
- argvec[tem]
- = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem-1),
- exp, pos, noside);
- }
+ argvec[tem]
+ = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem-1),
+ exp, pos, noside);
}
for (; tem <= nargs; tem++)
argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
return value_chill_length (arg1);
+ case UNOP_CARD:
+ (*pos)++;
+ arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
+ return value_chill_card (arg1);
+
+ case UNOP_CHMAX:
+ case UNOP_CHMIN:
+ (*pos)++;
+ arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
+ return value_chill_max_min (op, arg1);
+
case BINOP_COMMA:
error ("',' operator used in invalid context");
projects / binutils.git / blobdiff