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     {":=",  BINOP_ASSIGN, PREC_ASSIGN, 1},
 257     {"=",   BINOP_EQUAL, PREC_EQUAL, 0},
 258     {"/=",  BINOP_NOTEQUAL, PREC_EQUAL, 0},
 259     {"<=",  BINOP_LEQ, PREC_ORDER, 0},
 260     {">=",  BINOP_GEQ, PREC_ORDER, 0},
 261     {">",   BINOP_GTR, PREC_ORDER, 0},
 262     {"<",   BINOP_LESS, PREC_ORDER, 0},
 263     {"+",   BINOP_ADD, PREC_ADD, 0},
 264     {"-",   BINOP_SUB, PREC_ADD, 0},
 265     {"*",   BINOP_MUL, PREC_MUL, 0},
 266     {"/",   BINOP_DIV, PREC_MUL, 0},
 267     {"//",  BINOP_CONCAT, PREC_PREFIX, 0},      /* FIXME: precedence? */
 268     {"-",   UNOP_NEG, PREC_PREFIX, 0},
 269     {"->",  UNOP_IND, PREC_SUFFIX, 1},
 270     {"->",  UNOP_ADDR, PREC_PREFIX, 0},
 271     {NULL,  0, 0, 0}
 272 };
 273 \f
 274 /* The built-in types of Chill.  */
 275
 276 struct type *builtin_type_chill_bool;
 277 struct type *builtin_type_chill_char;
 278 struct type *builtin_type_chill_long;
 279 struct type *builtin_type_chill_ulong;
 280 struct type *builtin_type_chill_real;
 281
 282 struct type ** const (chill_builtin_types[]) =
 283 {
 284   &builtin_type_chill_bool,
 285   &builtin_type_chill_char,
 286   &builtin_type_chill_long,
 287   &builtin_type_chill_ulong,
 288   &builtin_type_chill_real,
 289   0
 290 };
 291
 292 static value_ptr
 293 evaluate_subexp_chill (expect_type, exp, pos, noside)
 294      struct type *expect_type;
 295      register struct expression *exp;
 296      register int *pos;
 297      enum noside noside;
 298 {
 299   int pc = *pos;
 300   int tem, nargs;
 301   value_ptr arg1;
 302   value_ptr *argvec;
 303   switch (exp->elts[*pos].opcode)
 304     {
 305     case MULTI_SUBSCRIPT:
 306       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 307         break;
 308       (*pos) += 3;
 309       nargs = longest_to_int (exp->elts[pc + 1].longconst);
 310       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 311
 312       switch (TYPE_CODE (VALUE_TYPE (arg1)))
 313         {
 314         case TYPE_CODE_PTR:
 315         case TYPE_CODE_FUNC:
 316           /* It's a function call. */
 317           /* Allocate arg vector, including space for the function to be
 318              called in argvec[0] and a terminating NULL */
 319           argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
 320           argvec[0] = arg1;
 321           tem = 1;
 322           for (; tem <= nargs; tem++)
 323             argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 324           argvec[tem] = 0; /* signal end of arglist */
 325
 326           return call_function_by_hand (argvec[0], nargs, argvec + 1);
 327         default:
 328           break;
 329         }
 330
 331       while (nargs-- > 0)
 332         {
 333           value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
 334           arg1 = value_subscript (arg1, index);
 335         }
 336       return (arg1);
 337     default:
 338       break;
 339     }
 340
 341   return evaluate_subexp_standard (expect_type, exp, pos, noside);
 342 }
 343
 344 const struct language_defn chill_language_defn = {
 345   "chill",
 346   language_chill,
 347   chill_builtin_types,
 348   range_check_on,
 349   type_check_on,
 350   chill_parse,                  /* parser */
 351   chill_error,                  /* parser error function */
 352   evaluate_subexp_chill,
 353   chill_printchar,              /* print a character constant */
 354   chill_printstr,               /* function to print a string constant */
 355   chill_create_fundamental_type,/* Create fundamental type in this language */
 356   chill_print_type,             /* Print a type using appropriate syntax */
 357   chill_val_print,              /* Print a value using appropriate syntax */
 358   chill_value_print,            /* Print a top-levl value */
 359   {"",      "B'",  "",   ""},   /* Binary format info */
 360   {"O'%lo",  "O'",  "o",  ""},  /* Octal format info */
 361   {"D'%ld",  "D'",  "d",  ""},  /* Decimal format info */
 362   {"H'%lx",  "H'",  "x",  ""},  /* Hex format info */
 363   chill_op_print_tab,           /* expression operators for printing */
 364   0,                            /* arrays are first-class (not c-style) */
 365   0,                            /* String lower bound */
 366   &builtin_type_chill_char,     /* Type of string elements */
 367   LANG_MAGIC
 368 };
 369
 370 /* Initialization for Chill */
 371
 372 void
 373 _initialize_chill_language ()
 374 {
 375   builtin_type_chill_bool =
 376     init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 377                TYPE_FLAG_UNSIGNED,
 378                "BOOL", (struct objfile *) NULL);
 379   builtin_type_chill_char =
 380     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 381                TYPE_FLAG_UNSIGNED,
 382                "CHAR", (struct objfile *) NULL);
 383   builtin_type_chill_long =
 384     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 385                0,
 386                "LONG", (struct objfile *) NULL);
 387   builtin_type_chill_ulong =
 388     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
 389                TYPE_FLAG_UNSIGNED,
 390                "ULONG", (struct objfile *) NULL);
 391   builtin_type_chill_real =
 392     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
 393                0,
 394                "LONG_REAL", (struct objfile *) NULL);
 395
 396   add_language (&chill_language_defn);
 397 }