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