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       fprintf_filtered (stream, "'%c'", c);
  72     }
  73   else
  74     {
  75       fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
  76     }
  77 }
  78
  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).
  88   */
  89
  90 static void
  91 chill_printstr (stream, string, length, force_ellipses)
  92      GDB_FILE *stream;
  93      char *string;
  94      unsigned int length;
  95      int force_ellipses;
  96 {
  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;
 102   unsigned int c;
 103   extern int repeat_count_threshold;
 104   extern int print_max;
 105
 106   if (length == 0)
 107     {
 108       fputs_filtered ("\"\"", stream);
 109       return;
 110     }
 111
 112   for (i = 0; i < length && things_printed < print_max; ++i)
 113     {
 114       /* Position of the character we are examining
 115          to see whether it is repeated.  */
 116       unsigned int rep1;
 117       /* Number of repetitions we have detected so far.  */
 118       unsigned int reps;
 119
 120       QUIT;
 121
 122       if (need_slashslash)
 123         {
 124           fputs_filtered ("//", stream);
 125           need_slashslash = 0;
 126         }
 127
 128       rep1 = i + 1;
 129       reps = 1;
 130       while (rep1 < length && string[rep1] == string[i])
 131         {
 132           ++rep1;
 133           ++reps;
 134         }
 135
 136       c = string[i];
 137       if (reps > repeat_count_threshold)
 138         {
 139           if (in_control_form || in_literal_form)
 140             {
 141               fputs_filtered ("\"//", stream);
 142               in_control_form = in_literal_form = 0;
 143             }
 144           chill_printchar (c, stream);
 145           fprintf_filtered (stream, "<repeats %u times>", reps);
 146           i = rep1 - 1;
 147           things_printed += repeat_count_threshold;
 148           need_slashslash = 1;
 149         }
 150       else
 151         {
 152           if (PRINT_LITERAL_FORM (c))
 153             {
 154               if (!in_literal_form)
 155                 {
 156                   if (in_control_form)
 157                     {
 158                       fputs_filtered ("\"//", stream);
 159                       in_control_form = 0;
 160                     }
 161                   fputs_filtered ("\"", stream);
 162                   in_literal_form = 1;
 163                 }
 164               fprintf_filtered (stream, "%c", c);
 165             }
 166           else
 167             {
 168               if (!in_control_form)
 169                 {
 170                   if (in_literal_form)
 171                     {
 172                       fputs_filtered ("\"//", stream);
 173                       in_literal_form = 0;
 174                     }
 175                   fputs_filtered ("c\"", stream);
 176                   in_control_form = 1;
 177                 }
 178               fprintf_filtered (stream, "%.2x", c);
 179             }
 180           ++things_printed;
 181         }
 182     }
 183
 184   /* Terminate the quotes if necessary.  */
 185   if (in_literal_form || in_control_form)
 186     {
 187       fputs_filtered ("\"", stream);
 188     }
 189   if (force_ellipses || (i < length))
 190     {
 191       fputs_filtered ("...", stream);
 192     }
 193 }
 194
 195 static struct type *
 196 chill_create_fundamental_type (objfile, typeid)
 197      struct objfile *objfile;
 198      int typeid;
 199 {
 200   register struct type *type = NULL;
 201
 202   switch (typeid)
 203     {
 204       default:
 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);
 211         break;
 212       case FT_VOID:
 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);
 217         break;
 218       case FT_BOOLEAN:
 219         type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
 220         break;
 221       case FT_CHAR:
 222         type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
 223         break;
 224       case FT_SIGNED_CHAR:
 225         type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
 226         break;
 227       case FT_UNSIGNED_CHAR:
 228         type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
 229         break;
 230       case FT_SHORT:                    /* Chill ints are 2 bytes */
 231         type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
 232         break;
 233       case FT_UNSIGNED_SHORT:           /* Chill ints are 2 bytes */
 234         type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
 235         break;
 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);
 241         break;
 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);
 245         break;
 246       case FT_FLOAT:
 247         type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
 248         break;
 249       case FT_DBL_PREC_FLOAT:
 250         type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
 251         break;
 252       }
 253   return (type);
 254 }
 255
 256 \f
 257 /* Table of operators and their precedences for printing expressions.  */
 258
 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},
 285     {NULL,  0, 0, 0}
 286 };
 287 \f
 288 /* The built-in types of Chill.  */
 289
 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;
 295
 296 struct type ** const (chill_builtin_types[]) =
 297 {
 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,
 303   0
 304 };
 305
 306 /* Calculate LOWER or UPPER of TYPE.
 307    Returns the result as an integer.
 308    *RESULT_TYPE is the appropriate type for the result. */
 309
 310 LONGEST
 311 type_lower_upper (op, type, result_type)
 312      enum exp_opcode op;  /* Either UNOP_LOWER or UNOP_UPPER */
 313      struct type *type;
 314      struct type **result_type;
 315 {
 316   LONGEST low, high;
 317   *result_type = type;
 318   CHECK_TYPEDEF (type);
 319   switch (TYPE_CODE (type))
 320     {
 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);
 325       break;
 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 */
 330
 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);
 335
 336     case TYPE_CODE_ENUM:
 337     case TYPE_CODE_BOOL:
 338     case TYPE_CODE_INT:
 339     case TYPE_CODE_CHAR:
 340       if (get_discrete_bounds (type, &low, &high) >= 0)
 341         {
 342           *result_type = type;
 343           return op == UNOP_LOWER ? low : high;
 344         }
 345       break;
 346     case TYPE_CODE_UNDEF:
 347     case TYPE_CODE_PTR:
 348     case TYPE_CODE_UNION:
 349     case TYPE_CODE_FUNC:
 350     case TYPE_CODE_FLT:
 351     case TYPE_CODE_VOID:
 352     case TYPE_CODE_SET:
 353     case TYPE_CODE_ERROR:
 354     case TYPE_CODE_MEMBER:
 355     case TYPE_CODE_METHOD:
 356     case TYPE_CODE_REF:
 357     case TYPE_CODE_COMPLEX:
 358     default:
 359       break;
 360     }
 361   error ("unknown mode for LOWER/UPPER builtin");
 362 }
 363
 364 static value_ptr
 365 value_chill_length (val)
 366      value_ptr val;
 367 {
 368   LONGEST tmp;
 369   struct type *type = VALUE_TYPE (val);
 370   struct type *ttype;
 371   CHECK_TYPEDEF (type);
 372   switch (TYPE_CODE (type))
 373     {
 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;
 379       break;
 380     case TYPE_CODE_STRUCT:
 381       if (chill_varying_type (type))
 382         {
 383           tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
 384           break;
 385         }
 386       /* ... else fall through ... */
 387     default:
 388       error ("bad argument to LENGTH builtin");
 389     }
 390   return value_from_longest (builtin_type_int, tmp);
 391 }
 392
 393 static value_ptr
 394 evaluate_subexp_chill (expect_type, exp, pos, noside)
 395      struct type *expect_type;
 396      register struct expression *exp;
 397      register int *pos;
 398      enum noside noside;
 399 {
 400   int pc = *pos;
 401   struct type *type;
 402   int tem, nargs;
 403   value_ptr arg1;
 404   value_ptr *argvec;
 405   enum exp_opcode op = exp->elts[*pos].opcode;
 406   switch (op)
 407     {
 408     case MULTI_SUBSCRIPT:
 409       if (noside == EVAL_SKIP)
 410         break;
 411       (*pos) += 3;
 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));
 415
 416       if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
 417         {
 418           /* Looks like string repetition. */
 419           value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
 420           return value_concat (arg1, string);
 421         }
 422
 423       switch (TYPE_CODE (type))
 424         {
 425         case TYPE_CODE_PTR:
 426           type = check_typedef (TYPE_TARGET_TYPE (type));
 427           if (!type || TYPE_CODE (type) || TYPE_CODE_FUNC)
 428             error ("reference value used as function");
 429           /* ... fall through ... */
 430         case TYPE_CODE_FUNC:
 431           /* It's a function call. */
 432           if (noside == EVAL_AVOID_SIDE_EFFECTS)
 433             break;
 434
 435           /* Allocate arg vector, including space for the function to be
 436              called in argvec[0] and a terminating NULL */
 437           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 438           argvec[0] = arg1;
 439           tem = 1;
 440           for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
 441             {
 442               argvec[tem]
 443                 = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem-1),
 444                                          exp, pos, noside);
 445             }
 446           for (; tem <= nargs; tem++)
 447             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 448           argvec[tem] = 0; /* signal end of arglist */
 449
 450           return call_function_by_hand (argvec[0], nargs, argvec + 1);
 451         default:
 452           break;
 453         }
 454
 455       while (nargs-- > 0)
 456         {
 457           value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
 458           arg1 = value_subscript (arg1, index);
 459         }
 460       return (arg1);
 461
 462     case UNOP_LOWER:
 463     case UNOP_UPPER:
 464       (*pos)++;
 465       if (noside == EVAL_SKIP)
 466         {
 467           (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
 468           goto nosideret;
 469         }
 470       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
 471                                                   EVAL_AVOID_SIDE_EFFECTS);
 472       tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
 473       return value_from_longest (type, tem);
 474
 475     case UNOP_LENGTH:
 476       (*pos)++;
 477       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
 478       return value_chill_length (arg1);
 479
 480     case BINOP_COMMA:
 481       error ("',' operator used in invalid context");
 482
 483     default:
 484       break;
 485     }
 486
 487   return evaluate_subexp_standard (expect_type, exp, pos, noside);
 488  nosideret:
 489   return value_from_longest (builtin_type_long, (LONGEST) 1);
 490 }
 491
 492 const struct language_defn chill_language_defn = {
 493   "chill",
 494   language_chill,
 495   chill_builtin_types,
 496   range_check_on,
 497   type_check_on,
 498   chill_parse,                  /* parser */
 499   chill_error,                  /* parser error function */
 500   evaluate_subexp_chill,
 501   chill_printchar,              /* print a character constant */
 502   chill_printstr,               /* function to print a string constant */
 503   chill_create_fundamental_type,/* Create fundamental type in this language */
 504   chill_print_type,             /* Print a type using appropriate syntax */
 505   chill_val_print,              /* Print a value using appropriate syntax */
 506   chill_value_print,            /* Print a top-levl value */
 507   {"",      "B'",  "",   ""},   /* Binary format info */
 508   {"O'%lo",  "O'",  "o",  ""},  /* Octal format info */
 509   {"D'%ld",  "D'",  "d",  ""},  /* Decimal format info */
 510   {"H'%lx",  "H'",  "x",  ""},  /* Hex format info */
 511   chill_op_print_tab,           /* expression operators for printing */
 512   0,                            /* arrays are first-class (not c-style) */
 513   0,                            /* String lower bound */
 514   &builtin_type_chill_char,     /* Type of string elements */
 515   LANG_MAGIC
 516 };
 517
 518 /* Initialization for Chill */
 519
 520 void
 521 _initialize_chill_language ()
 522 {
 523   builtin_type_chill_bool =
 524     init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 525                TYPE_FLAG_UNSIGNED,
 526                "BOOL", (struct objfile *) NULL);
 527   builtin_type_chill_char =
 528     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 529                TYPE_FLAG_UNSIGNED,
 530                "CHAR", (struct objfile *) NULL);
 531   builtin_type_chill_long =
 532     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 533                0,
 534                "LONG", (struct objfile *) NULL);
 535   builtin_type_chill_ulong =
 536     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 537                TYPE_FLAG_UNSIGNED,
 538                "ULONG", (struct objfile *) NULL);
 539   builtin_type_chill_real =
 540     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 541                0,
 542                "LONG_REAL", (struct objfile *) NULL);
 543
 544   add_language (&chill_language_defn);
 545 }