This commit was generated by cvs2svn to track changes on a CVS vendor
[deliverable/binutils-gdb.git] / gdb / ch-lang.c
1 /* Chill language support routines for GDB, the GNU debugger.
2 Copyright 1992, 1995, 1996 Free Software Foundation, Inc.
3
4 This file is part of GDB.
5
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.
10
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.
15
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. */
19
20 #include "defs.h"
21 #include "symtab.h"
22 #include "gdbtypes.h"
23 #include "value.h"
24 #include "expression.h"
25 #include "parser-defs.h"
26 #include "language.h"
27 #include "ch-lang.h"
28
29 static value_ptr
30 evaluate_subexp_chill PARAMS ((struct type *, struct expression *, int *, enum noside));
31
32 static value_ptr
33 value_chill_max_min PARAMS ((enum exp_opcode, value_ptr));
34
35 static value_ptr
36 value_chill_card PARAMS ((value_ptr));
37
38 static value_ptr
39 value_chill_length PARAMS ((value_ptr));
40
41 static struct type *
42 chill_create_fundamental_type PARAMS ((struct objfile *, int));
43
44 static void
45 chill_printstr PARAMS ((GDB_FILE *, char *, unsigned int, int));
46
47 static void
48 chill_printchar PARAMS ((int, GDB_FILE *));
49
50 /* For now, Chill uses a simple mangling algorithm whereby you simply
51 discard everything after the occurance of two successive CPLUS_MARKER
52 characters to derive the demangled form. */
53
54 char *
55 chill_demangle (mangled)
56 const char *mangled;
57 {
58 const char *joiner = NULL;
59 char *demangled;
60 const char *cp = mangled;
61
62 while (*cp)
63 {
64 if (is_cplus_marker (*cp))
65 {
66 joiner = cp;
67 break;
68 }
69 cp++;
70 }
71 if (joiner != NULL && *(joiner + 1) == *joiner)
72 {
73 demangled = savestring (mangled, joiner - mangled);
74 }
75 else
76 {
77 demangled = NULL;
78 }
79 return (demangled);
80 }
81
82 static void
83 chill_printchar (c, stream)
84 register int c;
85 GDB_FILE *stream;
86 {
87 c &= 0xFF; /* Avoid sign bit follies */
88
89 if (PRINT_LITERAL_FORM (c))
90 {
91 if (c == '\'' || c == '^')
92 fprintf_filtered (stream, "'%c%c'", c, c);
93 else
94 fprintf_filtered (stream, "'%c'", c);
95 }
96 else
97 {
98 fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
99 }
100 }
101
102 /* Print the character string STRING, printing at most LENGTH characters.
103 Printing stops early if the number hits print_max; repeat counts
104 are printed as appropriate. Print ellipses at the end if we
105 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
106 Note that gdb maintains the length of strings without counting the
107 terminating null byte, while chill strings are typically written with
108 an explicit null byte. So we always assume an implied null byte
109 until gdb is able to maintain non-null terminated strings as well
110 as null terminated strings (FIXME).
111 */
112
113 static void
114 chill_printstr (stream, string, length, force_ellipses)
115 GDB_FILE *stream;
116 char *string;
117 unsigned int length;
118 int force_ellipses;
119 {
120 register unsigned int i;
121 unsigned int things_printed = 0;
122 int in_literal_form = 0;
123 int in_control_form = 0;
124 int need_slashslash = 0;
125 unsigned int c;
126 extern int repeat_count_threshold;
127 extern int print_max;
128
129 if (length == 0)
130 {
131 fputs_filtered ("\"\"", stream);
132 return;
133 }
134
135 for (i = 0; i < length && things_printed < print_max; ++i)
136 {
137 /* Position of the character we are examining
138 to see whether it is repeated. */
139 unsigned int rep1;
140 /* Number of repetitions we have detected so far. */
141 unsigned int reps;
142
143 QUIT;
144
145 if (need_slashslash)
146 {
147 fputs_filtered ("//", stream);
148 need_slashslash = 0;
149 }
150
151 rep1 = i + 1;
152 reps = 1;
153 while (rep1 < length && string[rep1] == string[i])
154 {
155 ++rep1;
156 ++reps;
157 }
158
159 c = string[i];
160 if (reps > repeat_count_threshold)
161 {
162 if (in_control_form || in_literal_form)
163 {
164 if (in_control_form)
165 fputs_filtered (")", stream);
166 fputs_filtered ("\"//", stream);
167 in_control_form = in_literal_form = 0;
168 }
169 chill_printchar (c, stream);
170 fprintf_filtered (stream, "<repeats %u times>", reps);
171 i = rep1 - 1;
172 things_printed += repeat_count_threshold;
173 need_slashslash = 1;
174 }
175 else
176 {
177 if (! in_literal_form && ! in_control_form)
178 fputs_filtered ("\"", stream);
179 if (PRINT_LITERAL_FORM (c))
180 {
181 if (!in_literal_form)
182 {
183 if (in_control_form)
184 {
185 fputs_filtered (")", stream);
186 in_control_form = 0;
187 }
188 in_literal_form = 1;
189 }
190 fprintf_filtered (stream, "%c", c);
191 if (c == '"' || c == '^')
192 /* duplicate this one as must be done at input */
193 fprintf_filtered (stream, "%c", c);
194 }
195 else
196 {
197 if (!in_control_form)
198 {
199 if (in_literal_form)
200 {
201 in_literal_form = 0;
202 }
203 fputs_filtered ("^(", stream);
204 in_control_form = 1;
205 }
206 else
207 fprintf_filtered (stream, ",");
208 c = c & 0xff;
209 fprintf_filtered (stream, "%u", (unsigned int) c);
210 }
211 ++things_printed;
212 }
213 }
214
215 /* Terminate the quotes if necessary. */
216 if (in_control_form)
217 {
218 fputs_filtered (")", stream);
219 }
220 if (in_literal_form || in_control_form)
221 {
222 fputs_filtered ("\"", stream);
223 }
224 if (force_ellipses || (i < length))
225 {
226 fputs_filtered ("...", stream);
227 }
228 }
229
230 static struct type *
231 chill_create_fundamental_type (objfile, typeid)
232 struct objfile *objfile;
233 int typeid;
234 {
235 register struct type *type = NULL;
236
237 switch (typeid)
238 {
239 default:
240 /* FIXME: For now, if we are asked to produce a type not in this
241 language, create the equivalent of a C integer type with the
242 name "<?type?>". When all the dust settles from the type
243 reconstruction work, this should probably become an error. */
244 type = init_type (TYPE_CODE_INT, 2, 0, "<?type?>", objfile);
245 warning ("internal error: no chill fundamental type %d", typeid);
246 break;
247 case FT_VOID:
248 /* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
249 typedefs, unrelated to anything directly in the code being compiled,
250 that have some FT_VOID types. Just fake it for now. */
251 type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
252 break;
253 case FT_BOOLEAN:
254 type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
255 break;
256 case FT_CHAR:
257 type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
258 break;
259 case FT_SIGNED_CHAR:
260 type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
261 break;
262 case FT_UNSIGNED_CHAR:
263 type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
264 break;
265 case FT_SHORT: /* Chill ints are 2 bytes */
266 type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
267 break;
268 case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
269 type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
270 break;
271 case FT_INTEGER: /* FIXME? */
272 case FT_SIGNED_INTEGER: /* FIXME? */
273 case FT_LONG: /* Chill longs are 4 bytes */
274 case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
275 type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
276 break;
277 case FT_UNSIGNED_INTEGER: /* FIXME? */
278 case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
279 type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
280 break;
281 case FT_FLOAT:
282 type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
283 break;
284 case FT_DBL_PREC_FLOAT:
285 type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
286 break;
287 }
288 return (type);
289 }
290
291 \f
292 /* Table of operators and their precedences for printing expressions. */
293
294 static const struct op_print chill_op_print_tab[] = {
295 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
296 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
297 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
298 {"MOD", BINOP_MOD, PREC_MUL, 0},
299 {"REM", BINOP_REM, PREC_MUL, 0},
300 {"SIZE",UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
301 {"LOWER",UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
302 {"UPPER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
303 {"CARD",UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
304 {"MAX",UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
305 {"MIN",UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
306 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
307 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
308 {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
309 {"<=", BINOP_LEQ, PREC_ORDER, 0},
310 {">=", BINOP_GEQ, PREC_ORDER, 0},
311 {">", BINOP_GTR, PREC_ORDER, 0},
312 {"<", BINOP_LESS, PREC_ORDER, 0},
313 {"+", BINOP_ADD, PREC_ADD, 0},
314 {"-", BINOP_SUB, PREC_ADD, 0},
315 {"*", BINOP_MUL, PREC_MUL, 0},
316 {"/", BINOP_DIV, PREC_MUL, 0},
317 {"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
318 {"-", UNOP_NEG, PREC_PREFIX, 0},
319 {"->", UNOP_IND, PREC_SUFFIX, 1},
320 {"->", UNOP_ADDR, PREC_PREFIX, 0},
321 {":", BINOP_RANGE, PREC_ASSIGN, 0},
322 {NULL, 0, 0, 0}
323 };
324 \f
325 /* The built-in types of Chill. */
326
327 struct type *builtin_type_chill_bool;
328 struct type *builtin_type_chill_char;
329 struct type *builtin_type_chill_long;
330 struct type *builtin_type_chill_ulong;
331 struct type *builtin_type_chill_real;
332
333 struct type ** CONST_PTR (chill_builtin_types[]) =
334 {
335 &builtin_type_chill_bool,
336 &builtin_type_chill_char,
337 &builtin_type_chill_long,
338 &builtin_type_chill_ulong,
339 &builtin_type_chill_real,
340 0
341 };
342
343 /* Calculate LOWER or UPPER of TYPE.
344 Returns the result as an integer.
345 *RESULT_TYPE is the appropriate type for the result. */
346
347 LONGEST
348 type_lower_upper (op, type, result_type)
349 enum exp_opcode op; /* Either UNOP_LOWER or UNOP_UPPER */
350 struct type *type;
351 struct type **result_type;
352 {
353 LONGEST low, high;
354 *result_type = type;
355 CHECK_TYPEDEF (type);
356 switch (TYPE_CODE (type))
357 {
358 case TYPE_CODE_STRUCT:
359 *result_type = builtin_type_int;
360 if (chill_varying_type (type))
361 return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
362 break;
363 case TYPE_CODE_ARRAY:
364 case TYPE_CODE_BITSTRING:
365 case TYPE_CODE_STRING:
366 type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
367
368 /* ... fall through ... */
369 case TYPE_CODE_RANGE:
370 *result_type = TYPE_TARGET_TYPE (type);
371 return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
372
373 case TYPE_CODE_ENUM:
374 case TYPE_CODE_BOOL:
375 case TYPE_CODE_INT:
376 case TYPE_CODE_CHAR:
377 if (get_discrete_bounds (type, &low, &high) >= 0)
378 {
379 *result_type = type;
380 return op == UNOP_LOWER ? low : high;
381 }
382 break;
383 case TYPE_CODE_UNDEF:
384 case TYPE_CODE_PTR:
385 case TYPE_CODE_UNION:
386 case TYPE_CODE_FUNC:
387 case TYPE_CODE_FLT:
388 case TYPE_CODE_VOID:
389 case TYPE_CODE_SET:
390 case TYPE_CODE_ERROR:
391 case TYPE_CODE_MEMBER:
392 case TYPE_CODE_METHOD:
393 case TYPE_CODE_REF:
394 case TYPE_CODE_COMPLEX:
395 default:
396 break;
397 }
398 error ("unknown mode for LOWER/UPPER builtin");
399 }
400
401 static value_ptr
402 value_chill_length (val)
403 value_ptr val;
404 {
405 LONGEST tmp;
406 struct type *type = VALUE_TYPE (val);
407 struct type *ttype;
408 CHECK_TYPEDEF (type);
409 switch (TYPE_CODE (type))
410 {
411 case TYPE_CODE_ARRAY:
412 case TYPE_CODE_BITSTRING:
413 case TYPE_CODE_STRING:
414 tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
415 - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
416 break;
417 case TYPE_CODE_STRUCT:
418 if (chill_varying_type (type))
419 {
420 tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
421 break;
422 }
423 /* ... else fall through ... */
424 default:
425 error ("bad argument to LENGTH builtin");
426 }
427 return value_from_longest (builtin_type_int, tmp);
428 }
429
430 static value_ptr
431 value_chill_card (val)
432 value_ptr val;
433 {
434 LONGEST tmp = 0;
435 struct type *type = VALUE_TYPE (val);
436 CHECK_TYPEDEF (type);
437
438 if (TYPE_CODE (type) == TYPE_CODE_SET)
439 {
440 struct type *range_type = TYPE_INDEX_TYPE (type);
441 LONGEST lower_bound, upper_bound;
442 int i;
443
444 get_discrete_bounds (range_type, &lower_bound, &upper_bound);
445 for (i = lower_bound; i <= upper_bound; i++)
446 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
447 tmp++;
448 }
449 else
450 error ("bad argument to CARD builtin");
451
452 return value_from_longest (builtin_type_int, tmp);
453 }
454
455 static value_ptr
456 value_chill_max_min (op, val)
457 enum exp_opcode op;
458 value_ptr val;
459 {
460 LONGEST tmp = 0;
461 struct type *type = VALUE_TYPE (val);
462 struct type *elttype;
463 CHECK_TYPEDEF (type);
464
465 if (TYPE_CODE (type) == TYPE_CODE_SET)
466 {
467 LONGEST lower_bound, upper_bound;
468 int i, empty = 1;
469
470 elttype = TYPE_INDEX_TYPE (type);
471 CHECK_TYPEDEF (elttype);
472 get_discrete_bounds (elttype, &lower_bound, &upper_bound);
473
474 if (op == UNOP_CHMAX)
475 {
476 for (i = upper_bound; i >= lower_bound; i--)
477 {
478 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
479 {
480 tmp = i;
481 empty = 0;
482 break;
483 }
484 }
485 }
486 else
487 {
488 for (i = lower_bound; i <= upper_bound; i++)
489 {
490 if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
491 {
492 tmp = i;
493 empty = 0;
494 break;
495 }
496 }
497 }
498 if (empty)
499 error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
500 }
501 else
502 error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
503
504 return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
505 ? TYPE_TARGET_TYPE (elttype)
506 : elttype,
507 tmp);
508 }
509
510 static value_ptr
511 evaluate_subexp_chill (expect_type, exp, pos, noside)
512 struct type *expect_type;
513 register struct expression *exp;
514 register int *pos;
515 enum noside noside;
516 {
517 int pc = *pos;
518 struct type *type;
519 int tem, nargs;
520 value_ptr arg1;
521 value_ptr *argvec;
522 enum exp_opcode op = exp->elts[*pos].opcode;
523 switch (op)
524 {
525 case MULTI_SUBSCRIPT:
526 if (noside == EVAL_SKIP)
527 break;
528 (*pos) += 3;
529 nargs = longest_to_int (exp->elts[pc + 1].longconst);
530 arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
531 type = check_typedef (VALUE_TYPE (arg1));
532
533 if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
534 {
535 /* Looks like string repetition. */
536 value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
537 return value_concat (arg1, string);
538 }
539
540 switch (TYPE_CODE (type))
541 {
542 case TYPE_CODE_PTR:
543 type = check_typedef (TYPE_TARGET_TYPE (type));
544 if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
545 error ("reference value used as function");
546 /* ... fall through ... */
547 case TYPE_CODE_FUNC:
548 /* It's a function call. */
549 if (noside == EVAL_AVOID_SIDE_EFFECTS)
550 break;
551
552 /* Allocate arg vector, including space for the function to be
553 called in argvec[0] and a terminating NULL */
554 argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
555 argvec[0] = arg1;
556 tem = 1;
557 for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
558 {
559 argvec[tem]
560 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem-1),
561 exp, pos, noside);
562 }
563 for (; tem <= nargs; tem++)
564 argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
565 argvec[tem] = 0; /* signal end of arglist */
566
567 return call_function_by_hand (argvec[0], nargs, argvec + 1);
568 default:
569 break;
570 }
571
572 while (nargs-- > 0)
573 {
574 value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
575 arg1 = value_subscript (arg1, index);
576 }
577 return (arg1);
578
579 case UNOP_LOWER:
580 case UNOP_UPPER:
581 (*pos)++;
582 if (noside == EVAL_SKIP)
583 {
584 (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
585 goto nosideret;
586 }
587 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
588 EVAL_AVOID_SIDE_EFFECTS);
589 tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
590 return value_from_longest (type, tem);
591
592 case UNOP_LENGTH:
593 (*pos)++;
594 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
595 return value_chill_length (arg1);
596
597 case UNOP_CARD:
598 (*pos)++;
599 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
600 return value_chill_card (arg1);
601
602 case UNOP_CHMAX:
603 case UNOP_CHMIN:
604 (*pos)++;
605 arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
606 return value_chill_max_min (op, arg1);
607
608 case BINOP_COMMA:
609 error ("',' operator used in invalid context");
610
611 default:
612 break;
613 }
614
615 return evaluate_subexp_standard (expect_type, exp, pos, noside);
616 nosideret:
617 return value_from_longest (builtin_type_long, (LONGEST) 1);
618 }
619
620 const struct language_defn chill_language_defn = {
621 "chill",
622 language_chill,
623 chill_builtin_types,
624 range_check_on,
625 type_check_on,
626 chill_parse, /* parser */
627 chill_error, /* parser error function */
628 evaluate_subexp_chill,
629 chill_printchar, /* print a character constant */
630 chill_printstr, /* function to print a string constant */
631 chill_create_fundamental_type,/* Create fundamental type in this language */
632 chill_print_type, /* Print a type using appropriate syntax */
633 chill_val_print, /* Print a value using appropriate syntax */
634 chill_value_print, /* Print a top-levl value */
635 {"", "B'", "", ""}, /* Binary format info */
636 {"O'%lo", "O'", "o", ""}, /* Octal format info */
637 {"D'%ld", "D'", "d", ""}, /* Decimal format info */
638 {"H'%lx", "H'", "x", ""}, /* Hex format info */
639 chill_op_print_tab, /* expression operators for printing */
640 0, /* arrays are first-class (not c-style) */
641 0, /* String lower bound */
642 &builtin_type_chill_char, /* Type of string elements */
643 LANG_MAGIC
644 };
645
646 /* Initialization for Chill */
647
648 void
649 _initialize_chill_language ()
650 {
651 builtin_type_chill_bool =
652 init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
653 TYPE_FLAG_UNSIGNED,
654 "BOOL", (struct objfile *) NULL);
655 builtin_type_chill_char =
656 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
657 TYPE_FLAG_UNSIGNED,
658 "CHAR", (struct objfile *) NULL);
659 builtin_type_chill_long =
660 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
661 0,
662 "LONG", (struct objfile *) NULL);
663 builtin_type_chill_ulong =
664 init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
665 TYPE_FLAG_UNSIGNED,
666 "ULONG", (struct objfile *) NULL);
667 builtin_type_chill_real =
668 init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
669 0,
670 "LONG_REAL", (struct objfile *) NULL);
671
672 add_language (&chill_language_defn);
673 }
This page took 0.048489 seconds and 5 git commands to generate.