1 /* Chill language support routines for GDB, the GNU debugger.
2 Copyright 1992, 1995, 1996 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
)
38 const char *joiner
= NULL
;
40 const char *cp
= mangled
;
44 if (is_cplus_marker (*cp
))
51 if (joiner
!= NULL
&& *(joiner
+ 1) == *joiner
)
53 demangled
= savestring (mangled
, joiner
- mangled
);
63 chill_printchar (c
, stream
)
67 c
&= 0xFF; /* Avoid sign bit follies */
69 if (PRINT_LITERAL_FORM (c
))
71 fprintf_filtered (stream
, "'%c'", c
);
75 fprintf_filtered (stream
, "C'%.2x'", (unsigned int) c
);
79 /* Print the character string STRING, printing at most LENGTH characters.
80 Printing stops early if the number hits print_max; repeat counts
81 are printed as appropriate. Print ellipses at the end if we
82 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
83 Note that gdb maintains the length of strings without counting the
84 terminating null byte, while chill strings are typically written with
85 an explicit null byte. So we always assume an implied null byte
86 until gdb is able to maintain non-null terminated strings as well
87 as null terminated strings (FIXME).
91 chill_printstr (stream
, string
, length
, force_ellipses
)
97 register unsigned int i
;
98 unsigned int things_printed
= 0;
99 int in_literal_form
= 0;
100 int in_control_form
= 0;
101 int need_slashslash
= 0;
103 extern int repeat_count_threshold
;
104 extern int print_max
;
108 fputs_filtered ("\"\"", stream
);
112 for (i
= 0; i
< length
&& things_printed
< print_max
; ++i
)
114 /* Position of the character we are examining
115 to see whether it is repeated. */
117 /* Number of repetitions we have detected so far. */
124 fputs_filtered ("//", stream
);
130 while (rep1
< length
&& string
[rep1
] == string
[i
])
137 if (reps
> repeat_count_threshold
)
139 if (in_control_form
|| in_literal_form
)
141 fputs_filtered ("\"//", stream
);
142 in_control_form
= in_literal_form
= 0;
144 chill_printchar (c
, stream
);
145 fprintf_filtered (stream
, "<repeats %u times>", reps
);
147 things_printed
+= repeat_count_threshold
;
152 if (PRINT_LITERAL_FORM (c
))
154 if (!in_literal_form
)
158 fputs_filtered ("\"//", stream
);
161 fputs_filtered ("\"", stream
);
164 fprintf_filtered (stream
, "%c", c
);
168 if (!in_control_form
)
172 fputs_filtered ("\"//", stream
);
175 fputs_filtered ("c\"", stream
);
178 fprintf_filtered (stream
, "%.2x", c
);
184 /* Terminate the quotes if necessary. */
185 if (in_literal_form
|| in_control_form
)
187 fputs_filtered ("\"", stream
);
189 if (force_ellipses
|| (i
< length
))
191 fputs_filtered ("...", stream
);
196 chill_create_fundamental_type (objfile
, typeid)
197 struct objfile
*objfile
;
200 register struct type
*type
= NULL
;
205 /* FIXME: For now, if we are asked to produce a type not in this
206 language, create the equivalent of a C integer type with the
207 name "<?type?>". When all the dust settles from the type
208 reconstruction work, this should probably become an error. */
209 type
= init_type (TYPE_CODE_INT
, 2, 0, "<?type?>", objfile
);
210 warning ("internal error: no chill fundamental type %d", typeid);
213 /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
214 typedefs, unrelated to anything directly in the code being compiled,
215 that have some FT_VOID types. Just fake it for now. */
216 type
= init_type (TYPE_CODE_VOID
, 0, 0, "<?VOID?>", objfile
);
219 type
= init_type (TYPE_CODE_BOOL
, 1, TYPE_FLAG_UNSIGNED
, "BOOL", objfile
);
222 type
= init_type (TYPE_CODE_CHAR
, 1, TYPE_FLAG_UNSIGNED
, "CHAR", objfile
);
225 type
= init_type (TYPE_CODE_INT
, 1, 0, "BYTE", objfile
);
227 case FT_UNSIGNED_CHAR
:
228 type
= init_type (TYPE_CODE_INT
, 1, TYPE_FLAG_UNSIGNED
, "UBYTE", objfile
);
230 case FT_SHORT
: /* Chill ints are 2 bytes */
231 type
= init_type (TYPE_CODE_INT
, 2, 0, "INT", objfile
);
233 case FT_UNSIGNED_SHORT
: /* Chill ints are 2 bytes */
234 type
= init_type (TYPE_CODE_INT
, 2, TYPE_FLAG_UNSIGNED
, "UINT", objfile
);
236 case FT_INTEGER
: /* FIXME? */
237 case FT_SIGNED_INTEGER
: /* FIXME? */
238 case FT_LONG
: /* Chill longs are 4 bytes */
239 case FT_SIGNED_LONG
: /* Chill longs are 4 bytes */
240 type
= init_type (TYPE_CODE_INT
, 4, 0, "LONG", objfile
);
242 case FT_UNSIGNED_INTEGER
: /* FIXME? */
243 case FT_UNSIGNED_LONG
: /* Chill longs are 4 bytes */
244 type
= init_type (TYPE_CODE_INT
, 4, TYPE_FLAG_UNSIGNED
, "ULONG", objfile
);
247 type
= init_type (TYPE_CODE_FLT
, 4, 0, "REAL", objfile
);
249 case FT_DBL_PREC_FLOAT
:
250 type
= init_type (TYPE_CODE_FLT
, 8, 0, "LONG_REAL", objfile
);
257 /* Table of operators and their precedences for printing expressions. */
259 static const struct op_print chill_op_print_tab
[] = {
260 {"AND", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
261 {"OR", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
262 {"NOT", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
263 {"MOD", BINOP_MOD
, PREC_MUL
, 0},
264 {"REM", BINOP_REM
, PREC_MUL
, 0},
265 {"SIZE",UNOP_SIZEOF
, PREC_BUILTIN_FUNCTION
, 0},
266 {"LOWER",UNOP_LOWER
, PREC_BUILTIN_FUNCTION
, 0},
267 {"UPPER",UNOP_UPPER
, PREC_BUILTIN_FUNCTION
, 0},
268 {"LOWER",UNOP_UPPER
, PREC_BUILTIN_FUNCTION
, 0},
269 {":=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
270 {"=", BINOP_EQUAL
, PREC_EQUAL
, 0},
271 {"/=", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
272 {"<=", BINOP_LEQ
, PREC_ORDER
, 0},
273 {">=", BINOP_GEQ
, PREC_ORDER
, 0},
274 {">", BINOP_GTR
, PREC_ORDER
, 0},
275 {"<", BINOP_LESS
, PREC_ORDER
, 0},
276 {"+", BINOP_ADD
, PREC_ADD
, 0},
277 {"-", BINOP_SUB
, PREC_ADD
, 0},
278 {"*", BINOP_MUL
, PREC_MUL
, 0},
279 {"/", BINOP_DIV
, PREC_MUL
, 0},
280 {"//", BINOP_CONCAT
, PREC_PREFIX
, 0}, /* FIXME: precedence? */
281 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
282 {"->", UNOP_IND
, PREC_SUFFIX
, 1},
283 {"->", UNOP_ADDR
, PREC_PREFIX
, 0},
284 {":", BINOP_RANGE
, PREC_ASSIGN
, 0},
288 /* The built-in types of Chill. */
290 struct type
*builtin_type_chill_bool
;
291 struct type
*builtin_type_chill_char
;
292 struct type
*builtin_type_chill_long
;
293 struct type
*builtin_type_chill_ulong
;
294 struct type
*builtin_type_chill_real
;
296 struct type
** const (chill_builtin_types
[]) =
298 &builtin_type_chill_bool
,
299 &builtin_type_chill_char
,
300 &builtin_type_chill_long
,
301 &builtin_type_chill_ulong
,
302 &builtin_type_chill_real
,
306 /* Calculate LOWER or UPPER of TYPE.
307 Returns the result as an integer.
308 *RESULT_TYPE is the appropriate type for the result. */
311 type_lower_upper (op
, type
, result_type
)
312 enum exp_opcode op
; /* Either UNOP_LOWER or UNOP_UPPER */
314 struct type
**result_type
;
318 CHECK_TYPEDEF (type
);
319 switch (TYPE_CODE (type
))
321 case TYPE_CODE_STRUCT
:
322 *result_type
= builtin_type_int
;
323 if (chill_varying_type (type
))
324 return type_lower_upper (op
, TYPE_FIELD_TYPE (type
, 1), result_type
);
326 case TYPE_CODE_ARRAY
:
327 case TYPE_CODE_BITSTRING
:
328 case TYPE_CODE_STRING
:
329 type
= TYPE_FIELD_TYPE (type
, 0); /* Get index type */
331 /* ... fall through ... */
332 case TYPE_CODE_RANGE
:
333 *result_type
= TYPE_TARGET_TYPE (type
);
334 return op
== UNOP_LOWER
? TYPE_LOW_BOUND (type
) : TYPE_HIGH_BOUND (type
);
340 if (get_discrete_bounds (type
, &low
, &high
) >= 0)
343 return op
== UNOP_LOWER
? low
: high
;
346 case TYPE_CODE_UNDEF
:
348 case TYPE_CODE_UNION
:
353 case TYPE_CODE_ERROR
:
354 case TYPE_CODE_MEMBER
:
355 case TYPE_CODE_METHOD
:
357 case TYPE_CODE_COMPLEX
:
361 error ("unknown mode for LOWER/UPPER builtin");
365 value_chill_length (val
)
369 struct type
*type
= VALUE_TYPE (val
);
371 CHECK_TYPEDEF (type
);
372 switch (TYPE_CODE (type
))
374 case TYPE_CODE_ARRAY
:
375 case TYPE_CODE_BITSTRING
:
376 case TYPE_CODE_STRING
:
377 tmp
= type_lower_upper (UNOP_UPPER
, type
, &ttype
)
378 - type_lower_upper (UNOP_LOWER
, type
, &ttype
) + 1;
380 case TYPE_CODE_STRUCT
:
381 if (chill_varying_type (type
))
383 tmp
= unpack_long (TYPE_FIELD_TYPE (type
, 0), VALUE_CONTENTS (val
));
386 /* ... else fall through ... */
388 error ("bad argument to LENGTH builtin");
390 return value_from_longest (builtin_type_int
, tmp
);
394 evaluate_subexp_chill (expect_type
, exp
, pos
, noside
)
395 struct type
*expect_type
;
396 register struct expression
*exp
;
405 enum exp_opcode op
= exp
->elts
[*pos
].opcode
;
408 case MULTI_SUBSCRIPT
:
409 if (noside
== EVAL_SKIP
)
412 nargs
= longest_to_int (exp
->elts
[pc
+ 1].longconst
);
413 arg1
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
414 type
= check_typedef (VALUE_TYPE (arg1
));
416 if (nargs
== 1 && TYPE_CODE (type
) == TYPE_CODE_INT
)
418 /* Looks like string repetition. */
419 value_ptr string
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
420 return value_concat (arg1
, string
);
423 switch (TYPE_CODE (type
))
427 /* It's a function call. */
428 if (noside
== EVAL_AVOID_SIDE_EFFECTS
)
431 /* Allocate arg vector, including space for the function to be
432 called in argvec[0] and a terminating NULL */
433 argvec
= (value_ptr
*) alloca (sizeof (value_ptr
) * (nargs
+ 2));
436 if (type
&& TYPE_CODE (type
) == TYPE_CODE_PTR
)
437 type
= check_typedef (TYPE_TARGET_TYPE (type
));
438 if (type
&& TYPE_CODE (type
) == TYPE_CODE_FUNC
)
440 for (; tem
<= nargs
&& tem
<= TYPE_NFIELDS (type
); tem
++)
443 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type
, tem
-1),
447 for (; tem
<= nargs
; tem
++)
448 argvec
[tem
] = evaluate_subexp_with_coercion (exp
, pos
, noside
);
449 argvec
[tem
] = 0; /* signal end of arglist */
451 return call_function_by_hand (argvec
[0], nargs
, argvec
+ 1);
458 value_ptr index
= evaluate_subexp_with_coercion (exp
, pos
, noside
);
459 arg1
= value_subscript (arg1
, index
);
466 if (noside
== EVAL_SKIP
)
468 (*exp
->language_defn
->evaluate_exp
) (NULL_TYPE
, exp
, pos
, EVAL_SKIP
);
471 arg1
= (*exp
->language_defn
->evaluate_exp
) (NULL_TYPE
, exp
, pos
,
472 EVAL_AVOID_SIDE_EFFECTS
);
473 tem
= type_lower_upper (op
, VALUE_TYPE (arg1
), &type
);
474 return value_from_longest (type
, tem
);
478 arg1
= (*exp
->language_defn
->evaluate_exp
) (NULL_TYPE
, exp
, pos
, noside
);
479 return value_chill_length (arg1
);
482 error ("',' operator used in invalid context");
488 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
490 return value_from_longest (builtin_type_long
, (LONGEST
) 1);
493 const struct language_defn chill_language_defn
= {
499 chill_parse
, /* parser */
500 chill_error
, /* parser error function */
501 evaluate_subexp_chill
,
502 chill_printchar
, /* print a character constant */
503 chill_printstr
, /* function to print a string constant */
504 chill_create_fundamental_type
,/* Create fundamental type in this language */
505 chill_print_type
, /* Print a type using appropriate syntax */
506 chill_val_print
, /* Print a value using appropriate syntax */
507 chill_value_print
, /* Print a top-levl value */
508 {"", "B'", "", ""}, /* Binary format info */
509 {"O'%lo", "O'", "o", ""}, /* Octal format info */
510 {"D'%ld", "D'", "d", ""}, /* Decimal format info */
511 {"H'%lx", "H'", "x", ""}, /* Hex format info */
512 chill_op_print_tab
, /* expression operators for printing */
513 0, /* arrays are first-class (not c-style) */
514 0, /* String lower bound */
515 &builtin_type_chill_char
, /* Type of string elements */
519 /* Initialization for Chill */
522 _initialize_chill_language ()
524 builtin_type_chill_bool
=
525 init_type (TYPE_CODE_BOOL
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
527 "BOOL", (struct objfile
*) NULL
);
528 builtin_type_chill_char
=
529 init_type (TYPE_CODE_CHAR
, TARGET_CHAR_BIT
/ TARGET_CHAR_BIT
,
531 "CHAR", (struct objfile
*) NULL
);
532 builtin_type_chill_long
=
533 init_type (TYPE_CODE_INT
, TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
535 "LONG", (struct objfile
*) NULL
);
536 builtin_type_chill_ulong
=
537 init_type (TYPE_CODE_INT
, TARGET_LONG_BIT
/ TARGET_CHAR_BIT
,
539 "ULONG", (struct objfile
*) NULL
);
540 builtin_type_chill_real
=
541 init_type (TYPE_CODE_FLT
, TARGET_DOUBLE_BIT
/ TARGET_CHAR_BIT
,
543 "LONG_REAL", (struct objfile
*) NULL
);
545 add_language (&chill_language_defn
);