1 /* Chill language support routines for GDB, the GNU debugger.
2 Copyright 1992 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, Boston, MA 02111-1307, USA. */
24 #include "expression.h"
25 #include "parser-defs.h"
30 /* For now, Chill uses a simple mangling algorithm whereby you simply
31 discard everything after the occurance of two successive CPLUS_MARKER
32 characters to derive the demangled form. */
35 chill_demangle (mangled
)
41 joiner
= strchr (mangled
, CPLUS_MARKER
);
42 if (joiner
!= NULL
&& *(joiner
+ 1) == CPLUS_MARKER
)
44 demangled
= savestring (mangled
, joiner
- mangled
);
54 chill_printchar (c
, stream
)
58 c
&= 0xFF; /* Avoid sign bit follies */
60 if (PRINT_LITERAL_FORM (c
))
62 fprintf_filtered (stream
, "'%c'", c
);
66 fprintf_filtered (stream
, "C'%.2x'", (unsigned int) c
);
70 /* Print the character string STRING, printing at most LENGTH characters.
71 Printing stops early if the number hits print_max; repeat counts
72 are printed as appropriate. Print ellipses at the end if we
73 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
74 Note that gdb maintains the length of strings without counting the
75 terminating null byte, while chill strings are typically written with
76 an explicit null byte. So we always assume an implied null byte
77 until gdb is able to maintain non-null terminated strings as well
78 as null terminated strings (FIXME).
82 chill_printstr (stream
, string
, length
, force_ellipses
)
88 register unsigned int i
;
89 unsigned int things_printed
= 0;
90 int in_literal_form
= 0;
91 int in_control_form
= 0;
92 int need_slashslash
= 0;
94 extern int repeat_count_threshold
;
99 fputs_filtered ("\"\"", stream
);
103 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
105 /* Position of the character we are examining
106 to see whether it is repeated. */
108 /* Number of repetitions we have detected so far. */
115 fputs_filtered ("//", stream
);
121 while (rep1
< length
&& string
[rep1
] == string
[i
])
128 if (reps
> repeat_count_threshold
)
130 if (in_control_form
|| in_literal_form
)
132 fputs_filtered ("\"//", stream
);
133 in_control_form
= in_literal_form
= 0;
135 chill_printchar (c
, stream
);
136 fprintf_filtered (stream
, "<repeats %u times>", reps
);
138 things_printed
+= repeat_count_threshold
;
143 if (PRINT_LITERAL_FORM (c
))
145 if (!in_literal_form
)
149 fputs_filtered ("\"//", stream
);
152 fputs_filtered ("\"", stream
);
155 fprintf_filtered (stream
, "%c", c
);
159 if (!in_control_form
)
163 fputs_filtered ("\"//", stream
);
166 fputs_filtered ("c\"", stream
);
169 fprintf_filtered (stream
, "%.2x", c
);
175 /* Terminate the quotes if necessary. */
176 if (in_literal_form
|| in_control_form
)
178 fputs_filtered ("\"", stream
);
180 if (force_ellipses
|| (i
< length
))
182 fputs_filtered ("...", stream
);
187 chill_create_fundamental_type (objfile
, typeid)
188 struct objfile
*objfile
;
191 register struct type
*type
= NULL
;
196 /* FIXME: For now, if we are asked to produce a type not in this
197 language, create the equivalent of a C integer type with the
198 name "<?type?>". When all the dust settles from the type
199 reconstruction work, this should probably become an error. */
200 type
= init_type (TYPE_CODE_INT
, 2, 0, "<?type?>", objfile
);
201 warning ("internal error: no chill fundamental type %d", typeid);
204 /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
205 typedefs, unrelated to anything directly in the code being compiled,
206 that have some FT_VOID types. Just fake it for now. */
207 type
= init_type (TYPE_CODE_VOID
, 0, 0, "<?VOID?>", objfile
);
210 type
= init_type (TYPE_CODE_BOOL
, 1, TYPE_FLAG_UNSIGNED
, "BOOL", objfile
);
213 type
= init_type (TYPE_CODE_CHAR
, 1, TYPE_FLAG_UNSIGNED
, "CHAR", objfile
);
216 type
= init_type (TYPE_CODE_INT
, 1, 0, "BYTE", objfile
);
218 case FT_UNSIGNED_CHAR
:
219 type
= init_type (TYPE_CODE_INT
, 1, TYPE_FLAG_UNSIGNED
, "UBYTE", objfile
);
221 case FT_SHORT
: /* Chill ints are 2 bytes */
222 type
= init_type (TYPE_CODE_INT
, 2, 0, "INT", objfile
);
224 case FT_UNSIGNED_SHORT
: /* Chill ints are 2 bytes */
225 type
= init_type (TYPE_CODE_INT
, 2, TYPE_FLAG_UNSIGNED
, "UINT", objfile
);
227 case FT_INTEGER
: /* FIXME? */
228 case FT_SIGNED_INTEGER
: /* FIXME? */
229 case FT_LONG
: /* Chill longs are 4 bytes */
230 case FT_SIGNED_LONG
: /* Chill longs are 4 bytes */
231 type
= init_type (TYPE_CODE_INT
, 4, 0, "LONG", objfile
);
233 case FT_UNSIGNED_INTEGER
: /* FIXME? */
234 case FT_UNSIGNED_LONG
: /* Chill longs are 4 bytes */
235 type
= init_type (TYPE_CODE_INT
, 4, TYPE_FLAG_UNSIGNED
, "ULONG", objfile
);
238 type
= init_type (TYPE_CODE_FLT
, 4, 0, "REAL", objfile
);
240 case FT_DBL_PREC_FLOAT
:
241 type
= init_type (TYPE_CODE_FLT
, 8, 0, "LONG_REAL", objfile
);
248 /* Table of operators and their precedences for printing expressions. */
250 static const struct op_print chill_op_print_tab
[] = {
251 {"AND", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
252 {"OR", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
253 {"NOT", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
254 {"MOD", BINOP_MOD
, PREC_MUL
, 0},
255 {"REM", BINOP_REM
, PREC_MUL
, 0},
256 {"SIZE",UNOP_SIZEOF
, PREC_BUILTIN_FUNCTION
, 0},
257 {"LOWER",UNOP_LOWER
, PREC_BUILTIN_FUNCTION
, 0},
258 {"UPPER",UNOP_UPPER
, PREC_BUILTIN_FUNCTION
, 0},
259 {"LOWER",UNOP_UPPER
, PREC_BUILTIN_FUNCTION
, 0},
260 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
261 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
262 {"/=", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
263 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
264 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
265 {">", BINOP_GTR
, PREC_ORDER
, 0},
266 {"<", BINOP_LESS
, PREC_ORDER
, 0},
267 {"+", BINOP_ADD
, PREC_ADD
, 0},
268 {"-", BINOP_SUB
, PREC_ADD
, 0},
269 {"*", BINOP_MUL
, PREC_MUL
, 0},
270 {"/", BINOP_DIV
, PREC_MUL
, 0},
271 {"//", BINOP_CONCAT
, PREC_PREFIX
, 0}, /* FIXME: precedence? */
272 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
273 {"->", UNOP_IND
, PREC_SUFFIX
, 1},
274 {"->", UNOP_ADDR
, PREC_PREFIX
, 0},
275 {":", BINOP_RANGE
, PREC_ASSIGN
, 0},
279 /* The built-in types of Chill. */
281 struct type
*builtin_type_chill_bool
;
282 struct type
*builtin_type_chill_char
;
283 struct type
*builtin_type_chill_long
;
284 struct type
*builtin_type_chill_ulong
;
285 struct type
*builtin_type_chill_real
;
287 struct type
** const (chill_builtin_types
[]) =
289 &builtin_type_chill_bool
,
290 &builtin_type_chill_char
,
291 &builtin_type_chill_long
,
292 &builtin_type_chill_ulong
,
293 &builtin_type_chill_real
,
297 /* Calculate LOWER or UPPER of TYPE.
298 Returns the result as an integer.
299 *RESULT_TYPE is the appropriate type for the result. */
302 type_lower_upper (op
, type
, result_type
)
303 enum exp_opcode op
; /* Either UNOP_LOWER or UNOP_UPPER */
305 struct type
**result_type
;
309 CHECK_TYPEDEF (type
);
310 switch (TYPE_CODE (type
))
312 case TYPE_CODE_STRUCT
:
313 *result_type
= builtin_type_int
;
314 if (chill_varying_type (type
))
315 return type_lower_upper (op
, TYPE_FIELD_TYPE (type
, 1), result_type
);
317 case TYPE_CODE_ARRAY
:
318 case TYPE_CODE_BITSTRING
:
319 case TYPE_CODE_STRING
:
320 type
= TYPE_FIELD_TYPE (type
, 0); /* Get index type */
322 /* ... fall through ... */
323 case TYPE_CODE_RANGE
:
324 *result_type
= TYPE_TARGET_TYPE (type
);
325 return op
== UNOP_LOWER
? TYPE_LOW_BOUND (type
) : TYPE_HIGH_BOUND (type
);
331 if (get_discrete_bounds (type
, &low
, &high
) >= 0)
334 return op
== UNOP_LOWER
? low
: high
;
337 case TYPE_CODE_UNDEF
:
339 case TYPE_CODE_UNION
:
344 case TYPE_CODE_ERROR
:
345 case TYPE_CODE_MEMBER
:
346 case TYPE_CODE_METHOD
:
348 case TYPE_CODE_COMPLEX
:
352 error ("unknown mode for LOWER/UPPER builtin");
356 value_chill_length (val
)
360 struct type
*type
= VALUE_TYPE (val
);
362 CHECK_TYPEDEF (type
);
363 switch (TYPE_CODE (type
))
365 case TYPE_CODE_ARRAY
:
366 case TYPE_CODE_BITSTRING
:
367 case TYPE_CODE_STRING
:
368 tmp
= type_lower_upper (UNOP_UPPER
, type
, &ttype
)
369 - type_lower_upper (UNOP_LOWER
, type
, &ttype
) + 1;
371 case TYPE_CODE_STRUCT
:
372 if (chill_varying_type (type
))
374 tmp
= unpack_long (TYPE_FIELD_TYPE (type
, 0), VALUE_CONTENTS (val
));
377 /* ... else fall through ... */
379 error ("bad argument to LENGTH builtin");
381 return value_from_longest (builtin_type_int
, tmp
);
385 evaluate_subexp_chill (expect_type
, exp
, pos
, noside
)
386 struct type
*expect_type
;
387 register struct expression
*exp
;
396 enum exp_opcode op
= exp
->elts
[*pos
].opcode
;
399 case MULTI_SUBSCRIPT
:
400 if (noside
== EVAL_SKIP
)
403 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
404 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
405 type
= check_typedef (VALUE_TYPE (arg1
));
407 if (nargs
== 1 && TYPE_CODE (type
) == TYPE_CODE_INT
)
409 /* Looks like string repetition. */
410 value_ptr string
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
411 return value_concat (arg1
, string
);
414 switch (TYPE_CODE (type
))
418 /* It's a function call. */
419 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
422 /* Allocate arg vector, including space for the function to be
423 called in argvec[0] and a terminating NULL */
424 argvec
= (value_ptr
*) alloca (sizeof (value_ptr
) * (nargs
+ 2));
427 if (type
&& TYPE_CODE (type
) == TYPE_CODE_PTR
)
428 type
= check_typedef (TYPE_TARGET_TYPE (type
));
429 if (type
&& TYPE_CODE (type
) == TYPE_CODE_FUNC
)
431 for (; tem
<= nargs
&& tem
<= TYPE_NFIELDS (type
); tem
++)
434 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type
, tem
-1),
438 for (; tem
<= nargs
; tem
++)
439 argvec
[tem
] = evaluate_subexp_with_coercion (exp
, pos
, noside
);
440 argvec
[tem
] = 0; /* signal end of arglist */
442 return call_function_by_hand (argvec
[0], nargs
, argvec
+ 1);
449 value_ptr index
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
450 arg1
= value_subscript (arg1
, index
);
457 if (noside
== EVAL_SKIP
)
459 (*exp
->language_defn
->evaluate_exp
) (NULL_TYPE
, exp
, pos
, EVAL_SKIP
);
462 arg1
= (*exp
->language_defn
->evaluate_exp
) (NULL_TYPE
, exp
, pos
,
463 EVAL_AVOID_SIDE_EFFECTS
);
464 tem
= type_lower_upper (op
, VALUE_TYPE (arg1
), &type
);
465 return value_from_longest (type
, tem
);
469 arg1
= (*exp
->language_defn
->evaluate_exp
) (NULL_TYPE
, exp
, pos
, noside
);
470 return value_chill_length (arg1
);
473 error ("',' operator used in invalid context");
479 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
481 return value_from_longest (builtin_type_long
, (LONGEST
) 1);
484 const struct language_defn chill_language_defn
= {
490 chill_parse
, /* parser */
491 chill_error
, /* parser error function */
492 evaluate_subexp_chill
,
493 chill_printchar
, /* print a character constant */
494 chill_printstr
, /* function to print a string constant */
495 chill_create_fundamental_type
,/* Create fundamental type in this language */
496 chill_print_type
, /* Print a type using appropriate syntax */
497 chill_val_print
, /* Print a value using appropriate syntax */
498 chill_value_print
, /* Print a top-levl value */
499 {"", "B'", "", ""}, /* Binary format info */
500 {"O'%lo", "O'", "o", ""}, /* Octal format info */
501 {"D'%ld", "D'", "d", ""}, /* Decimal format info */
502 {"H'%lx", "H'", "x", ""}, /* Hex format info */
503 chill_op_print_tab
, /* expression operators for printing */
504 0, /* arrays are first-class (not c-style) */
505 0, /* String lower bound */
506 &builtin_type_chill_char
, /* Type of string elements */
510 /* Initialization for Chill */
513 _initialize_chill_language ()
515 builtin_type_chill_bool
=
516 init_type (TYPE_CODE_BOOL
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
518 "BOOL", (struct objfile
*) NULL
);
519 builtin_type_chill_char
=
520 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
522 "CHAR", (struct objfile
*) NULL
);
523 builtin_type_chill_long
=
524 init_type (TYPE_CODE_INT
, TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
526 "LONG", (struct objfile
*) NULL
);
527 builtin_type_chill_ulong
=
528 init_type (TYPE_CODE_INT
, TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
530 "ULONG", (struct objfile
*) NULL
);
531 builtin_type_chill_real
=
532 init_type (TYPE_CODE_FLT
, TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
534 "LONG_REAL", (struct objfile
*) NULL
);
536 add_language (&chill_language_defn
);