gdb/ch-lang.c

   1 /* Chill language support routines for GDB, the GNU debugger.
   2    Copyright 1992 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., 675 Mass Ave, Cambridge, MA 02139, 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   char *joiner;
  39   char *demangled;
  40
  41   joiner = strchr (mangled, CPLUS_MARKER);
  42   if (joiner != NULL && *(joiner + 1) == CPLUS_MARKER)
  43     {
  44       demangled = savestring (mangled, joiner - mangled);
  45     }
  46   else
  47     {
  48       demangled = NULL;
  49     }
  50   return (demangled);
  51 }
  52
  53 static void
  54 chill_printchar (c, stream)
  55      register int c;
  56      GDB_FILE *stream;
  57 {
  58   c &= 0xFF;                    /* Avoid sign bit follies */
  59
  60   if (PRINT_LITERAL_FORM (c))
  61     {
  62       fprintf_filtered (stream, "'%c'", c);
  63     }
  64   else
  65     {
  66       fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
  67     }
  68 }
  69
  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).
  79   */
  80
  81 static void
  82 chill_printstr (stream, string, length, force_ellipses)
  83      GDB_FILE *stream;
  84      char *string;
  85      unsigned int length;
  86      int force_ellipses;
  87 {
  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;
  93   unsigned int c;
  94   extern int repeat_count_threshold;
  95   extern int print_max;
  96
  97   if (length == 0)
  98     {
  99       fputs_filtered ("\"\"", stream);
 100       return;
 101     }
 102
 103   for (i = 0; i < length && things_printed < print_max; ++i)
 104     {
 105       /* Position of the character we are examining
 106          to see whether it is repeated.  */
 107       unsigned int rep1;
 108       /* Number of repetitions we have detected so far.  */
 109       unsigned int reps;
 110
 111       QUIT;
 112
 113       if (need_slashslash)
 114         {
 115           fputs_filtered ("//", stream);
 116           need_slashslash = 0;
 117         }
 118
 119       rep1 = i + 1;
 120       reps = 1;
 121       while (rep1 < length && string[rep1] == string[i])
 122         {
 123           ++rep1;
 124           ++reps;
 125         }
 126
 127       c = string[i];
 128       if (reps > repeat_count_threshold)
 129         {
 130           if (in_control_form || in_literal_form)
 131             {
 132               fputs_filtered ("\"//", stream);
 133               in_control_form = in_literal_form = 0;
 134             }
 135           chill_printchar (c, stream);
 136           fprintf_filtered (stream, "<repeats %u times>", reps);
 137           i = rep1 - 1;
 138           things_printed += repeat_count_threshold;
 139           need_slashslash = 1;
 140         }
 141       else
 142         {
 143           if (PRINT_LITERAL_FORM (c))
 144             {
 145               if (!in_literal_form)
 146                 {
 147                   if (in_control_form)
 148                     {
 149                       fputs_filtered ("\"//", stream);
 150                       in_control_form = 0;
 151                     }
 152                   fputs_filtered ("\"", stream);
 153                   in_literal_form = 1;
 154                 }
 155               fprintf_filtered (stream, "%c", c);
 156             }
 157           else
 158             {
 159               if (!in_control_form)
 160                 {
 161                   if (in_literal_form)
 162                     {
 163                       fputs_filtered ("\"//", stream);
 164                       in_literal_form = 0;
 165                     }
 166                   fputs_filtered ("c\"", stream);
 167                   in_control_form = 1;
 168                 }
 169               fprintf_filtered (stream, "%.2x", c);
 170             }
 171           ++things_printed;
 172         }
 173     }
 174
 175   /* Terminate the quotes if necessary.  */
 176   if (in_literal_form || in_control_form)
 177     {
 178       fputs_filtered ("\"", stream);
 179     }
 180   if (force_ellipses || (i < length))
 181     {
 182       fputs_filtered ("...", stream);
 183     }
 184 }
 185
 186 static struct type *
 187 chill_create_fundamental_type (objfile, typeid)
 188      struct objfile *objfile;
 189      int typeid;
 190 {
 191   register struct type *type = NULL;
 192
 193   switch (typeid)
 194     {
 195       default:
 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);
 202         break;
 203       case FT_VOID:
 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);
 208         break;
 209       case FT_BOOLEAN:
 210         type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
 211         break;
 212       case FT_CHAR:
 213         type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
 214         break;
 215       case FT_SIGNED_CHAR:
 216         type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
 217         break;
 218       case FT_UNSIGNED_CHAR:
 219         type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
 220         break;
 221       case FT_SHORT:                    /* Chill ints are 2 bytes */
 222         type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
 223         break;
 224       case FT_UNSIGNED_SHORT:           /* Chill ints are 2 bytes */
 225         type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
 226         break;
 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);
 232         break;
 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);
 236         break;
 237       case FT_FLOAT:
 238         type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
 239         break;
 240       case FT_DBL_PREC_FLOAT:
 241         type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
 242         break;
 243       }
 244   return (type);
 245 }
 246
 247 \f
 248 /* Table of operators and their precedences for printing expressions.  */
 249
 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     {NULL,  0, 0, 0}
 276 };
 277 \f
 278 /* The built-in types of Chill.  */
 279
 280 struct type *builtin_type_chill_bool;
 281 struct type *builtin_type_chill_char;
 282 struct type *builtin_type_chill_long;
 283 struct type *builtin_type_chill_ulong;
 284 struct type *builtin_type_chill_real;
 285
 286 struct type ** const (chill_builtin_types[]) =
 287 {
 288   &builtin_type_chill_bool,
 289   &builtin_type_chill_char,
 290   &builtin_type_chill_long,
 291   &builtin_type_chill_ulong,
 292   &builtin_type_chill_real,
 293   0
 294 };
 295
 296 /* Calculate LOWER or UPPER of TYPE.
 297    Returns the result as an integer.
 298    *RESULT_TYPE is the appropriate type for the result. */
 299
 300 LONGEST
 301 type_lower_upper (op, type, result_type)
 302      enum exp_opcode op;  /* Either UNOP_LOWER or UNOP_UPPER */
 303      struct type *type;
 304      struct type **result_type;
 305 {
 306   LONGEST tmp;
 307   *result_type = builtin_type_int;
 308   switch (TYPE_CODE (type))
 309     {
 310     case TYPE_CODE_STRUCT:
 311       if (chill_varying_type (type))
 312         return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
 313       break;
 314     case TYPE_CODE_ARRAY:
 315     case TYPE_CODE_BITSTRING:
 316     case TYPE_CODE_STRING:
 317       type = TYPE_FIELD_TYPE (type, 0);  /* Get index type */
 318
 319       /* ... fall through ... */
 320     case TYPE_CODE_RANGE:
 321       if (TYPE_DUMMY_RANGE (type) > 0)
 322         return type_lower_upper (op, TYPE_TARGET_TYPE (type), result_type);
 323       *result_type = TYPE_TARGET_TYPE (type);
 324       return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
 325
 326     case TYPE_CODE_ENUM:
 327       *result_type = type;
 328       if (TYPE_NFIELDS (type) > 0)
 329         return TYPE_FIELD_BITPOS (type,
 330                                   op == UNOP_LOWER ? 0
 331                                   : TYPE_NFIELDS (type) - 1);
 332
 333     case TYPE_CODE_BOOL:
 334       *result_type = type;
 335       return op == UNOP_LOWER ? 0 : 1;
 336     case TYPE_CODE_INT:
 337     case TYPE_CODE_CHAR:
 338       *result_type = type;
 339       tmp = (LONGEST) 1 << (TARGET_CHAR_BIT * TYPE_LENGTH (type));
 340       if (TYPE_UNSIGNED (type))
 341         return op == UNOP_LOWER ? 0 : tmp - (LONGEST) 1;
 342       tmp = tmp >> 1;
 343       return op == UNOP_LOWER ? -tmp : (tmp - 1);
 344     case TYPE_CODE_UNDEF:
 345     case TYPE_CODE_PTR:
 346     case TYPE_CODE_UNION:
 347     case TYPE_CODE_FUNC:
 348     case TYPE_CODE_FLT:
 349     case TYPE_CODE_VOID:
 350     case TYPE_CODE_SET:
 351     case TYPE_CODE_ERROR:
 352     case TYPE_CODE_MEMBER:
 353     case TYPE_CODE_METHOD:
 354     case TYPE_CODE_REF:
 355     case TYPE_CODE_COMPLEX:
 356     default:
 357       break;
 358     }
 359   error ("unknown mode for LOWER/UPPER builtin");
 360 }
 361
 362 static value_ptr
 363 value_chill_length (val)
 364      value_ptr val;
 365 {
 366   LONGEST tmp;
 367   struct type *type = VALUE_TYPE (val);
 368   struct type *ttype;
 369   switch (TYPE_CODE (type))
 370     {
 371     case TYPE_CODE_ARRAY:
 372     case TYPE_CODE_BITSTRING:
 373     case TYPE_CODE_STRING:
 374       tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
 375         - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
 376       break;
 377     case TYPE_CODE_STRUCT:
 378       if (chill_varying_type (type))
 379         {
 380           tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
 381           break;
 382         }
 383       /* ... else fall through ... */
 384     default:
 385       error ("bad argument to LENGTH builtin");
 386     }
 387   return value_from_longest (builtin_type_int, tmp);
 388 }
 389
 390 static value_ptr
 391 evaluate_subexp_chill (expect_type, exp, pos, noside)
 392      struct type *expect_type;
 393      register struct expression *exp;
 394      register int *pos;
 395      enum noside noside;
 396 {
 397   int pc = *pos;
 398   struct type *type;
 399   int tem, nargs;
 400   value_ptr arg1;
 401   value_ptr *argvec;
 402   enum exp_opcode op = exp->elts[*pos].opcode;
 403   switch (op)
 404     {
 405     case MULTI_SUBSCRIPT:
 406       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 407         break;
 408       (*pos) += 3;
 409       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 410       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 411
 412       switch (TYPE_CODE (VALUE_TYPE (arg1)))
 413         {
 414         case TYPE_CODE_PTR:
 415         case TYPE_CODE_FUNC:
 416           /* It's a function call. */
 417           /* Allocate arg vector, including space for the function to be
 418              called in argvec[0] and a terminating NULL */
 419           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 420           argvec[0] = arg1;
 421           tem = 1;
 422           for (; tem <= nargs; tem++)
 423             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 424           argvec[tem] = 0; /* signal end of arglist */
 425
 426           return call_function_by_hand (argvec[0], nargs, argvec + 1);
 427         default:
 428           break;
 429         }
 430
 431       while (nargs-- > 0)
 432         {
 433           value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
 434           arg1 = value_subscript (arg1, index);
 435         }
 436       return (arg1);
 437
 438     case UNOP_LOWER:
 439     case UNOP_UPPER:
 440       (*pos)++;
 441       if (noside == EVAL_SKIP)
 442         {
 443           (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
 444           goto nosideret;
 445         }
 446       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
 447                                                   EVAL_AVOID_SIDE_EFFECTS);
 448       tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
 449       return value_from_longest (type, tem);
 450
 451     case UNOP_LENGTH:
 452       (*pos)++;
 453       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
 454       return value_chill_length (arg1);
 455
 456     default:
 457       break;
 458     }
 459
 460   return evaluate_subexp_standard (expect_type, exp, pos, noside);
 461  nosideret:
 462   return value_from_longest (builtin_type_long, (LONGEST) 1);
 463 }
 464
 465 const struct language_defn chill_language_defn = {
 466   "chill",
 467   language_chill,
 468   chill_builtin_types,
 469   range_check_on,
 470   type_check_on,
 471   chill_parse,                  /* parser */
 472   chill_error,                  /* parser error function */
 473   evaluate_subexp_chill,
 474   chill_printchar,              /* print a character constant */
 475   chill_printstr,               /* function to print a string constant */
 476   chill_create_fundamental_type,/* Create fundamental type in this language */
 477   chill_print_type,             /* Print a type using appropriate syntax */
 478   chill_val_print,              /* Print a value using appropriate syntax */
 479   chill_value_print,            /* Print a top-levl value */
 480   {"",      "B'",  "",   ""},   /* Binary format info */
 481   {"O'%lo",  "O'",  "o",  ""},  /* Octal format info */
 482   {"D'%ld",  "D'",  "d",  ""},  /* Decimal format info */
 483   {"H'%lx",  "H'",  "x",  ""},  /* Hex format info */
 484   chill_op_print_tab,           /* expression operators for printing */
 485   0,                            /* arrays are first-class (not c-style) */
 486   0,                            /* String lower bound */
 487   &builtin_type_chill_char,     /* Type of string elements */
 488   LANG_MAGIC
 489 };
 490
 491 /* Initialization for Chill */
 492
 493 void
 494 _initialize_chill_language ()
 495 {
 496   builtin_type_chill_bool =
 497     init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 498                TYPE_FLAG_UNSIGNED,
 499                "BOOL", (struct objfile *) NULL);
 500   builtin_type_chill_char =
 501     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 502                TYPE_FLAG_UNSIGNED,
 503                "CHAR", (struct objfile *) NULL);
 504   builtin_type_chill_long =
 505     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 506                0,
 507                "LONG", (struct objfile *) NULL);
 508   builtin_type_chill_ulong =
 509     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 510                TYPE_FLAG_UNSIGNED,
 511                "ULONG", (struct objfile *) NULL);
 512   builtin_type_chill_real =
 513     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 514                0,
 515                "LONG_REAL", (struct objfile *) NULL);
 516
 517   add_language (&chill_language_defn);
 518 }