Move putchar_filtered() to utils.c.
[platform/upstream/binutils.git] / gdb / ch-lang.c
1 /* Chill language support routines for GDB, the GNU debugger.
2    Copyright 1992, 1995, 1996, 2000 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,
19    Boston, MA 02111-1307, USA.  */
20
21 #include "defs.h"
22 #include "symtab.h"
23 #include "gdbtypes.h"
24 #include "value.h"
25 #include "expression.h"
26 #include "parser-defs.h"
27 #include "language.h"
28 #include "ch-lang.h"
29 #include "valprint.h"
30
31 extern void _initialize_chill_language (void);
32
33 static value_ptr
34 evaluate_subexp_chill (struct type *, struct expression *, int *,
35                        enum noside);
36
37 static value_ptr value_chill_max_min (enum exp_opcode, value_ptr);
38
39 static value_ptr value_chill_card (value_ptr);
40
41 static value_ptr value_chill_length (value_ptr);
42
43 static struct type *chill_create_fundamental_type (struct objfile *, int);
44
45 static void chill_printstr (struct ui_file * stream, char *string,
46                             unsigned int length, int width,
47                             int force_ellipses);
48
49 static void chill_printchar (int, struct ui_file *);
50
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. */
54
55 char *
56 chill_demangle (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 (register int c, struct ui_file *stream)
84 {
85   c &= 0xFF;                    /* Avoid sign bit follies */
86
87   if (PRINT_LITERAL_FORM (c))
88     {
89       if (c == '\'' || c == '^')
90         fprintf_filtered (stream, "'%c%c'", c, c);
91       else
92         fprintf_filtered (stream, "'%c'", c);
93     }
94   else
95     {
96       fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
97     }
98 }
99
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).
109  */
110
111 static void
112 chill_printstr (struct ui_file *stream, char *string, unsigned int length,
113                 int width, int force_ellipses)
114 {
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;
120   unsigned int c;
121
122   if (length == 0)
123     {
124       fputs_filtered ("\"\"", stream);
125       return;
126     }
127
128   for (i = 0; i < length && things_printed < print_max; ++i)
129     {
130       /* Position of the character we are examining
131          to see whether it is repeated.  */
132       unsigned int rep1;
133       /* Number of repetitions we have detected so far.  */
134       unsigned int reps;
135
136       QUIT;
137
138       if (need_slashslash)
139         {
140           fputs_filtered ("//", stream);
141           need_slashslash = 0;
142         }
143
144       rep1 = i + 1;
145       reps = 1;
146       while (rep1 < length && string[rep1] == string[i])
147         {
148           ++rep1;
149           ++reps;
150         }
151
152       c = string[i];
153       if (reps > repeat_count_threshold)
154         {
155           if (in_control_form || in_literal_form)
156             {
157               if (in_control_form)
158                 fputs_filtered (")", stream);
159               fputs_filtered ("\"//", stream);
160               in_control_form = in_literal_form = 0;
161             }
162           chill_printchar (c, stream);
163           fprintf_filtered (stream, "<repeats %u times>", reps);
164           i = rep1 - 1;
165           things_printed += repeat_count_threshold;
166           need_slashslash = 1;
167         }
168       else
169         {
170           if (!in_literal_form && !in_control_form)
171             fputs_filtered ("\"", stream);
172           if (PRINT_LITERAL_FORM (c))
173             {
174               if (!in_literal_form)
175                 {
176                   if (in_control_form)
177                     {
178                       fputs_filtered (")", stream);
179                       in_control_form = 0;
180                     }
181                   in_literal_form = 1;
182                 }
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);
187             }
188           else
189             {
190               if (!in_control_form)
191                 {
192                   if (in_literal_form)
193                     {
194                       in_literal_form = 0;
195                     }
196                   fputs_filtered ("^(", stream);
197                   in_control_form = 1;
198                 }
199               else
200                 fprintf_filtered (stream, ",");
201               c = c & 0xff;
202               fprintf_filtered (stream, "%u", (unsigned int) c);
203             }
204           ++things_printed;
205         }
206     }
207
208   /* Terminate the quotes if necessary.  */
209   if (in_control_form)
210     {
211       fputs_filtered (")", stream);
212     }
213   if (in_literal_form || in_control_form)
214     {
215       fputs_filtered ("\"", stream);
216     }
217   if (force_ellipses || (i < length))
218     {
219       fputs_filtered ("...", stream);
220     }
221 }
222
223 static struct type *
224 chill_create_fundamental_type (struct objfile *objfile, int typeid)
225 {
226   register struct type *type = NULL;
227
228   switch (typeid)
229     {
230     default:
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);
237       break;
238     case FT_VOID:
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);
243       break;
244     case FT_BOOLEAN:
245       type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
246       break;
247     case FT_CHAR:
248       type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
249       break;
250     case FT_SIGNED_CHAR:
251       type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
252       break;
253     case FT_UNSIGNED_CHAR:
254       type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
255       break;
256     case FT_SHORT:              /* Chill ints are 2 bytes */
257       type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
258       break;
259     case FT_UNSIGNED_SHORT:     /* Chill ints are 2 bytes */
260       type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
261       break;
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);
267       break;
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);
271       break;
272     case FT_FLOAT:
273       type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
274       break;
275     case FT_DBL_PREC_FLOAT:
276       type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
277       break;
278     }
279   return (type);
280 }
281 \f
282
283 /* Table of operators and their precedences for printing expressions.  */
284
285 static const struct op_print chill_op_print_tab[] =
286 {
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},
314   {NULL, 0, 0, 0}
315 };
316 \f
317 /* The built-in types of Chill.  */
318
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;
324
325 struct type **CONST_PTR (chill_builtin_types[]) =
326 {
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,
332     0
333 };
334
335 /* Calculate LOWER or UPPER of TYPE.
336    Returns the result as an integer.
337    *RESULT_TYPE is the appropriate type for the result. */
338
339 LONGEST
340 type_lower_upper (enum exp_opcode op,   /* Either UNOP_LOWER or UNOP_UPPER */
341                   struct type *type, struct type **result_type)
342 {
343   LONGEST low, high;
344   *result_type = type;
345   CHECK_TYPEDEF (type);
346   switch (TYPE_CODE (type))
347     {
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);
352       break;
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 */
357
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);
362
363     case TYPE_CODE_ENUM:
364     case TYPE_CODE_BOOL:
365     case TYPE_CODE_INT:
366     case TYPE_CODE_CHAR:
367       if (get_discrete_bounds (type, &low, &high) >= 0)
368         {
369           *result_type = type;
370           return op == UNOP_LOWER ? low : high;
371         }
372       break;
373     case TYPE_CODE_UNDEF:
374     case TYPE_CODE_PTR:
375     case TYPE_CODE_UNION:
376     case TYPE_CODE_FUNC:
377     case TYPE_CODE_FLT:
378     case TYPE_CODE_VOID:
379     case TYPE_CODE_SET:
380     case TYPE_CODE_ERROR:
381     case TYPE_CODE_MEMBER:
382     case TYPE_CODE_METHOD:
383     case TYPE_CODE_REF:
384     case TYPE_CODE_COMPLEX:
385     default:
386       break;
387     }
388   error ("unknown mode for LOWER/UPPER builtin");
389 }
390
391 static value_ptr
392 value_chill_length (value_ptr val)
393 {
394   LONGEST tmp;
395   struct type *type = VALUE_TYPE (val);
396   struct type *ttype;
397   CHECK_TYPEDEF (type);
398   switch (TYPE_CODE (type))
399     {
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;
405       break;
406     case TYPE_CODE_STRUCT:
407       if (chill_varying_type (type))
408         {
409           tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
410           break;
411         }
412       /* ... else fall through ... */
413     default:
414       error ("bad argument to LENGTH builtin");
415     }
416   return value_from_longest (builtin_type_int, tmp);
417 }
418
419 static value_ptr
420 value_chill_card (value_ptr val)
421 {
422   LONGEST tmp = 0;
423   struct type *type = VALUE_TYPE (val);
424   CHECK_TYPEDEF (type);
425
426   if (TYPE_CODE (type) == TYPE_CODE_SET)
427     {
428       struct type *range_type = TYPE_INDEX_TYPE (type);
429       LONGEST lower_bound, upper_bound;
430       int i;
431
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)
435           tmp++;
436     }
437   else
438     error ("bad argument to CARD builtin");
439
440   return value_from_longest (builtin_type_int, tmp);
441 }
442
443 static value_ptr
444 value_chill_max_min (enum exp_opcode op, value_ptr val)
445 {
446   LONGEST tmp = 0;
447   struct type *type = VALUE_TYPE (val);
448   struct type *elttype;
449   CHECK_TYPEDEF (type);
450
451   if (TYPE_CODE (type) == TYPE_CODE_SET)
452     {
453       LONGEST lower_bound, upper_bound;
454       int i, empty = 1;
455
456       elttype = TYPE_INDEX_TYPE (type);
457       CHECK_TYPEDEF (elttype);
458       get_discrete_bounds (elttype, &lower_bound, &upper_bound);
459
460       if (op == UNOP_CHMAX)
461         {
462           for (i = upper_bound; i >= lower_bound; i--)
463             {
464               if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
465                 {
466                   tmp = i;
467                   empty = 0;
468                   break;
469                 }
470             }
471         }
472       else
473         {
474           for (i = lower_bound; i <= upper_bound; i++)
475             {
476               if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
477                 {
478                   tmp = i;
479                   empty = 0;
480                   break;
481                 }
482             }
483         }
484       if (empty)
485         error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
486     }
487   else
488     error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
489
490   return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
491                              ? TYPE_TARGET_TYPE (elttype)
492                              : elttype,
493                              tmp);
494 }
495
496 static value_ptr
497 evaluate_subexp_chill (struct type *expect_type,
498                        register struct expression *exp, register int *pos,
499                        enum noside noside)
500 {
501   int pc = *pos;
502   struct type *type;
503   int tem, nargs;
504   value_ptr arg1;
505   value_ptr *argvec;
506   enum exp_opcode op = exp->elts[*pos].opcode;
507   switch (op)
508     {
509     case MULTI_SUBSCRIPT:
510       if (noside == EVAL_SKIP)
511         break;
512       (*pos) += 3;
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));
516
517       if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
518         {
519           /* Looks like string repetition. */
520           value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
521           return value_concat (arg1, string);
522         }
523
524       switch (TYPE_CODE (type))
525         {
526         case TYPE_CODE_PTR:
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 ... */
531         case TYPE_CODE_FUNC:
532           /* It's a function call. */
533           if (noside == EVAL_AVOID_SIDE_EFFECTS)
534             break;
535
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));
539           argvec[0] = arg1;
540           tem = 1;
541           for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
542             {
543               argvec[tem]
544                 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
545                                          exp, pos, noside);
546             }
547           for (; tem <= nargs; tem++)
548             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
549           argvec[tem] = 0;      /* signal end of arglist */
550
551           return call_function_by_hand (argvec[0], nargs, argvec + 1);
552         default:
553           break;
554         }
555
556       while (nargs-- > 0)
557         {
558           value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
559           arg1 = value_subscript (arg1, index);
560         }
561       return (arg1);
562
563     case UNOP_LOWER:
564     case UNOP_UPPER:
565       (*pos)++;
566       if (noside == EVAL_SKIP)
567         {
568           (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
569           goto nosideret;
570         }
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);
575
576     case UNOP_LENGTH:
577       (*pos)++;
578       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
579       return value_chill_length (arg1);
580
581     case UNOP_CARD:
582       (*pos)++;
583       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
584       return value_chill_card (arg1);
585
586     case UNOP_CHMAX:
587     case UNOP_CHMIN:
588       (*pos)++;
589       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
590       return value_chill_max_min (op, arg1);
591
592     case BINOP_COMMA:
593       error ("',' operator used in invalid context");
594
595     default:
596       break;
597     }
598
599   return evaluate_subexp_standard (expect_type, exp, pos, noside);
600 nosideret:
601   return value_from_longest (builtin_type_long, (LONGEST) 1);
602 }
603
604 const struct language_defn chill_language_defn =
605 {
606   "chill",
607   language_chill,
608   chill_builtin_types,
609   range_check_on,
610   type_check_on,
611   case_sensitive_on,
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 */
630   LANG_MAGIC
631 };
632
633 /* Initialization for Chill */
634
635 void
636 _initialize_chill_language (void)
637 {
638   builtin_type_chill_bool =
639     init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
640                TYPE_FLAG_UNSIGNED,
641                "BOOL", (struct objfile *) NULL);
642   builtin_type_chill_char =
643     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
644                TYPE_FLAG_UNSIGNED,
645                "CHAR", (struct objfile *) NULL);
646   builtin_type_chill_long =
647     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
648                0,
649                "LONG", (struct objfile *) NULL);
650   builtin_type_chill_ulong =
651     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
652                TYPE_FLAG_UNSIGNED,
653                "ULONG", (struct objfile *) NULL);
654   builtin_type_chill_real =
655     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
656                0,
657                "LONG_REAL", (struct objfile *) NULL);
658
659   add_language (&chill_language_defn);
660 }