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., 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   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     {":",   BINOP_RANGE, PREC_ASSIGN, 0},
 276     {NULL,  0, 0, 0}
 277 };
 278 \f
 279 /* The built-in types of Chill.  */
 280
 281 struct type *builtin_type_chill_bool;
 282 struct type *builtin_type_chill_char;
 283 struct type *builtin_type_chill_long;
 284 struct type *builtin_type_chill_ulong;
 285 struct type *builtin_type_chill_real;
 286
 287 struct type ** const (chill_builtin_types[]) =
 288 {
 289   &builtin_type_chill_bool,
 290   &builtin_type_chill_char,
 291   &builtin_type_chill_long,
 292   &builtin_type_chill_ulong,
 293   &builtin_type_chill_real,
 294   0
 295 };
 296
 297 /* Calculate LOWER or UPPER of TYPE.
 298    Returns the result as an integer.
 299    *RESULT_TYPE is the appropriate type for the result. */
 300
 301 LONGEST
 302 type_lower_upper (op, type, result_type)
 303      enum exp_opcode op;  /* Either UNOP_LOWER or UNOP_UPPER */
 304      struct type *type;
 305      struct type **result_type;
 306 {
 307   LONGEST low, high;
 308   *result_type = type;
 309   CHECK_TYPEDEF (type);
 310   switch (TYPE_CODE (type))
 311     {
 312     case TYPE_CODE_STRUCT:
 313       *result_type = builtin_type_int;
 314       if (chill_varying_type (type))
 315         return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
 316       break;
 317     case TYPE_CODE_ARRAY:
 318     case TYPE_CODE_BITSTRING:
 319     case TYPE_CODE_STRING:
 320       type = TYPE_FIELD_TYPE (type, 0);  /* Get index type */
 321
 322       /* ... fall through ... */
 323     case TYPE_CODE_RANGE:
 324       *result_type = TYPE_TARGET_TYPE (type);
 325       return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
 326
 327     case TYPE_CODE_ENUM:
 328     case TYPE_CODE_BOOL:
 329     case TYPE_CODE_INT:
 330     case TYPE_CODE_CHAR:
 331       if (get_discrete_bounds (type, &low, &high) >= 0)
 332         {
 333           *result_type = type;
 334           return op == UNOP_LOWER ? low : high;
 335         }
 336       break;
 337     case TYPE_CODE_UNDEF:
 338     case TYPE_CODE_PTR:
 339     case TYPE_CODE_UNION:
 340     case TYPE_CODE_FUNC:
 341     case TYPE_CODE_FLT:
 342     case TYPE_CODE_VOID:
 343     case TYPE_CODE_SET:
 344     case TYPE_CODE_ERROR:
 345     case TYPE_CODE_MEMBER:
 346     case TYPE_CODE_METHOD:
 347     case TYPE_CODE_REF:
 348     case TYPE_CODE_COMPLEX:
 349     default:
 350       break;
 351     }
 352   error ("unknown mode for LOWER/UPPER builtin");
 353 }
 354
 355 static value_ptr
 356 value_chill_length (val)
 357      value_ptr val;
 358 {
 359   LONGEST tmp;
 360   struct type *type = VALUE_TYPE (val);
 361   struct type *ttype;
 362   CHECK_TYPEDEF (type);
 363   switch (TYPE_CODE (type))
 364     {
 365     case TYPE_CODE_ARRAY:
 366     case TYPE_CODE_BITSTRING:
 367     case TYPE_CODE_STRING:
 368       tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
 369         - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
 370       break;
 371     case TYPE_CODE_STRUCT:
 372       if (chill_varying_type (type))
 373         {
 374           tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
 375           break;
 376         }
 377       /* ... else fall through ... */
 378     default:
 379       error ("bad argument to LENGTH builtin");
 380     }
 381   return value_from_longest (builtin_type_int, tmp);
 382 }
 383
 384 static value_ptr
 385 evaluate_subexp_chill (expect_type, exp, pos, noside)
 386      struct type *expect_type;
 387      register struct expression *exp;
 388      register int *pos;
 389      enum noside noside;
 390 {
 391   int pc = *pos;
 392   struct type *type;
 393   int tem, nargs;
 394   value_ptr arg1;
 395   value_ptr *argvec;
 396   enum exp_opcode op = exp->elts[*pos].opcode;
 397   switch (op)
 398     {
 399     case MULTI_SUBSCRIPT:
 400       if (noside == EVAL_SKIP)
 401         break;
 402       (*pos) += 3;
 403       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 404       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 405       type = check_typedef (VALUE_TYPE (arg1));
 406
 407       if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
 408         {
 409           /* Looks like string repetition. */
 410           value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
 411           return value_concat (arg1, string);
 412         }
 413
 414       switch (TYPE_CODE (type))
 415         {
 416         case TYPE_CODE_PTR:
 417         case TYPE_CODE_FUNC:
 418           /* It's a function call. */
 419           if (noside == EVAL_AVOID_SIDE_EFFECTS)
 420             break;
 421
 422           /* Allocate arg vector, including space for the function to be
 423              called in argvec[0] and a terminating NULL */
 424           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 425           argvec[0] = arg1;
 426           tem = 1;
 427           if (type && TYPE_CODE (type) == TYPE_CODE_PTR)
 428             type = check_typedef (TYPE_TARGET_TYPE (type));
 429           if (type && TYPE_CODE (type) == TYPE_CODE_FUNC)
 430             {
 431               for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
 432                 {
 433                   argvec[tem]
 434                     = evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem-1),
 435                                              exp, pos, noside);
 436                 }
 437             }
 438           for (; tem <= nargs; tem++)
 439             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 440           argvec[tem] = 0; /* signal end of arglist */
 441
 442           return call_function_by_hand (argvec[0], nargs, argvec + 1);
 443         default:
 444           break;
 445         }
 446
 447       while (nargs-- > 0)
 448         {
 449           value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
 450           arg1 = value_subscript (arg1, index);
 451         }
 452       return (arg1);
 453
 454     case UNOP_LOWER:
 455     case UNOP_UPPER:
 456       (*pos)++;
 457       if (noside == EVAL_SKIP)
 458         {
 459           (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
 460           goto nosideret;
 461         }
 462       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
 463                                                   EVAL_AVOID_SIDE_EFFECTS);
 464       tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
 465       return value_from_longest (type, tem);
 466
 467     case UNOP_LENGTH:
 468       (*pos)++;
 469       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
 470       return value_chill_length (arg1);
 471
 472     case BINOP_COMMA:
 473       error ("',' operator used in invalid context");
 474
 475     default:
 476       break;
 477     }
 478
 479   return evaluate_subexp_standard (expect_type, exp, pos, noside);
 480  nosideret:
 481   return value_from_longest (builtin_type_long, (LONGEST) 1);
 482 }
 483
 484 const struct language_defn chill_language_defn = {
 485   "chill",
 486   language_chill,
 487   chill_builtin_types,
 488   range_check_on,
 489   type_check_on,
 490   chill_parse,                  /* parser */
 491   chill_error,                  /* parser error function */
 492   evaluate_subexp_chill,
 493   chill_printchar,              /* print a character constant */
 494   chill_printstr,               /* function to print a string constant */
 495   chill_create_fundamental_type,/* Create fundamental type in this language */
 496   chill_print_type,             /* Print a type using appropriate syntax */
 497   chill_val_print,              /* Print a value using appropriate syntax */
 498   chill_value_print,            /* Print a top-levl value */
 499   {"",      "B'",  "",   ""},   /* Binary format info */
 500   {"O'%lo",  "O'",  "o",  ""},  /* Octal format info */
 501   {"D'%ld",  "D'",  "d",  ""},  /* Decimal format info */
 502   {"H'%lx",  "H'",  "x",  ""},  /* Hex format info */
 503   chill_op_print_tab,           /* expression operators for printing */
 504   0,                            /* arrays are first-class (not c-style) */
 505   0,                            /* String lower bound */
 506   &builtin_type_chill_char,     /* Type of string elements */
 507   LANG_MAGIC
 508 };
 509
 510 /* Initialization for Chill */
 511
 512 void
 513 _initialize_chill_language ()
 514 {
 515   builtin_type_chill_bool =
 516     init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 517                TYPE_FLAG_UNSIGNED,
 518                "BOOL", (struct objfile *) NULL);
 519   builtin_type_chill_char =
 520     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 521                TYPE_FLAG_UNSIGNED,
 522                "CHAR", (struct objfile *) NULL);
 523   builtin_type_chill_long =
 524     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 525                0,
 526                "LONG", (struct objfile *) NULL);
 527   builtin_type_chill_ulong =
 528     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 529                TYPE_FLAG_UNSIGNED,
 530                "ULONG", (struct objfile *) NULL);
 531   builtin_type_chill_real =
 532     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 533                0,
 534                "LONG_REAL", (struct objfile *) NULL);
 535
 536   add_language (&chill_language_defn);
 537 }