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  retry:
 309   switch (TYPE_CODE (type))
 310     {
 311     case TYPE_CODE_STRUCT:
 312       if (chill_varying_type (type))
 313         return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
 314       break;
 315     case TYPE_CODE_ARRAY:
 316     case TYPE_CODE_BITSTRING:
 317     case TYPE_CODE_STRING:
 318       type = TYPE_FIELD_TYPE (type, 0);  /* Get index type */
 319
 320       /* ... fall through ... */
 321     case TYPE_CODE_RANGE:
 322       if (TYPE_DUMMY_RANGE (type) > 0)
 323         return type_lower_upper (op, TYPE_TARGET_TYPE (type), result_type);
 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       *result_type = type;
 329       if (TYPE_NFIELDS (type) > 0)
 330         return TYPE_FIELD_BITPOS (type,
 331                                   op == UNOP_LOWER ? 0
 332                                   : TYPE_NFIELDS (type) - 1);
 333
 334     case TYPE_CODE_BOOL:
 335       *result_type = type;
 336       return op == UNOP_LOWER ? 0 : 1;
 337     case TYPE_CODE_INT:
 338     case TYPE_CODE_CHAR:
 339       *result_type = type;
 340       tmp = (LONGEST) 1 << (TARGET_CHAR_BIT * TYPE_LENGTH (type));
 341       if (TYPE_UNSIGNED (type))
 342         return op == UNOP_LOWER ? 0 : tmp - (LONGEST) 1;
 343       tmp = tmp >> 1;
 344       return op == UNOP_LOWER ? -tmp : (tmp - 1);
 345     }
 346   error ("unknown mode for LOWER/UPPER builtin");
 347 }
 348
 349 static value_ptr
 350 value_chill_length (val)
 351      value_ptr val;
 352 {
 353   LONGEST tmp;
 354   struct type *type = VALUE_TYPE (val);
 355   struct type *ttype;
 356   switch (TYPE_CODE (type))
 357     {
 358     case TYPE_CODE_ARRAY:
 359     case TYPE_CODE_BITSTRING:
 360     case TYPE_CODE_STRING:
 361       tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
 362         - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
 363       break;
 364     case TYPE_CODE_STRUCT:
 365       if (chill_varying_type (type))
 366         {
 367           tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
 368           break;
 369         }
 370       /* ... else fall through ... */
 371     default:
 372       error ("bad argument to LENGTH builtin");
 373     }
 374   return value_from_longest (builtin_type_int, tmp);
 375 }
 376
 377 static value_ptr
 378 evaluate_subexp_chill (expect_type, exp, pos, noside)
 379      struct type *expect_type;
 380      register struct expression *exp;
 381      register int *pos;
 382      enum noside noside;
 383 {
 384   int pc = *pos;
 385   struct type *type;
 386   int tem, nargs;
 387   value_ptr arg1;
 388   value_ptr *argvec;
 389   enum exp_opcode op = exp->elts[*pos].opcode;
 390   switch (op)
 391     {
 392     case MULTI_SUBSCRIPT:
 393       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 394         break;
 395       (*pos) += 3;
 396       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 397       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 398
 399       switch (TYPE_CODE (VALUE_TYPE (arg1)))
 400         {
 401         case TYPE_CODE_PTR:
 402         case TYPE_CODE_FUNC:
 403           /* It's a function call. */
 404           /* Allocate arg vector, including space for the function to be
 405              called in argvec[0] and a terminating NULL */
 406           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 407           argvec[0] = arg1;
 408           tem = 1;
 409           for (; tem <= nargs; tem++)
 410             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 411           argvec[tem] = 0; /* signal end of arglist */
 412
 413           return call_function_by_hand (argvec[0], nargs, argvec + 1);
 414         default:
 415           break;
 416         }
 417
 418       while (nargs-- > 0)
 419         {
 420           value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
 421           arg1 = value_subscript (arg1, index);
 422         }
 423       return (arg1);
 424
 425     case UNOP_LOWER:
 426     case UNOP_UPPER:
 427       (*pos)++;
 428       if (noside == EVAL_SKIP)
 429         {
 430           (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
 431           goto nosideret;
 432         }
 433       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
 434                                                   EVAL_AVOID_SIDE_EFFECTS);
 435       tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
 436       return value_from_longest (type, tem);
 437
 438     case UNOP_LENGTH:
 439       (*pos)++;
 440       arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
 441       return value_chill_length (arg1);
 442
 443     default:
 444       break;
 445     }
 446
 447   return evaluate_subexp_standard (expect_type, exp, pos, noside);
 448  nosideret:
 449   return value_from_longest (builtin_type_long, (LONGEST) 1);
 450 }
 451
 452 const struct language_defn chill_language_defn = {
 453   "chill",
 454   language_chill,
 455   chill_builtin_types,
 456   range_check_on,
 457   type_check_on,
 458   chill_parse,                  /* parser */
 459   chill_error,                  /* parser error function */
 460   evaluate_subexp_chill,
 461   chill_printchar,              /* print a character constant */
 462   chill_printstr,               /* function to print a string constant */
 463   chill_create_fundamental_type,/* Create fundamental type in this language */
 464   chill_print_type,             /* Print a type using appropriate syntax */
 465   chill_val_print,              /* Print a value using appropriate syntax */
 466   chill_value_print,            /* Print a top-levl value */
 467   {"",      "B'",  "",   ""},   /* Binary format info */
 468   {"O'%lo",  "O'",  "o",  ""},  /* Octal format info */
 469   {"D'%ld",  "D'",  "d",  ""},  /* Decimal format info */
 470   {"H'%lx",  "H'",  "x",  ""},  /* Hex format info */
 471   chill_op_print_tab,           /* expression operators for printing */
 472   0,                            /* arrays are first-class (not c-style) */
 473   0,                            /* String lower bound */
 474   &builtin_type_chill_char,     /* Type of string elements */
 475   LANG_MAGIC
 476 };
 477
 478 /* Initialization for Chill */
 479
 480 void
 481 _initialize_chill_language ()
 482 {
 483   builtin_type_chill_bool =
 484     init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 485                TYPE_FLAG_UNSIGNED,
 486                "BOOL", (struct objfile *) NULL);
 487   builtin_type_chill_char =
 488     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 489                TYPE_FLAG_UNSIGNED,
 490                "CHAR", (struct objfile *) NULL);
 491   builtin_type_chill_long =
 492     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 493                0,
 494                "LONG", (struct objfile *) NULL);
 495   builtin_type_chill_ulong =
 496     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 497                TYPE_FLAG_UNSIGNED,
 498                "ULONG", (struct objfile *) NULL);
 499   builtin_type_chill_real =
 500     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 501                0,
 502                "LONG_REAL", (struct objfile *) NULL);
 503
 504   add_language (&chill_language_defn);
 505 }