Subversion Repositories or1k

/* Modula 2 language support routines for GDB, the GNU debugger.

   Copyright 1992, 2000 Free Software Foundation, Inc.

   This file is part of GDB.

   This program is free software; you can redistribute it and/or modify

   it under the terms of the GNU General Public License as published by

   the Free Software Foundation; either version 2 of the License, or

   (at your option) any later version.

   This program is distributed in the hope that it will be useful,

   but WITHOUT ANY WARRANTY; without even the implied warranty of

   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License

   along with this program; if not, write to the Free Software

   Foundation, Inc., 59 Temple Place - Suite 330,

   Boston, MA 02111-1307, USA.  */

#include "defs.h"

#include "symtab.h"

#include "gdbtypes.h"

#include "expression.h"

#include "parser-defs.h"

#include "language.h"

#include "m2-lang.h"

#include "c-lang.h"

#include "valprint.h"

extern void _initialize_m2_language PARAMS ((void));

static struct type *m2_create_fundamental_type PARAMS ((struct objfile *, int));

static void m2_printstr (struct ui_file * stream, char *string,

                         unsigned int length, int width,

                         int force_ellipses);

static void m2_printchar (int, struct ui_file *);

static void m2_emit_char (int, struct ui_file *, int);

/* Print the character C on STREAM as part of the contents of a literal

   string whose delimiter is QUOTER.  Note that that format for printing

   characters and strings is language specific.

   FIXME:  This is a copy of the same function from c-exp.y.  It should

   be replaced with a true Modula version.

 */

static void

m2_emit_char (c, stream, quoter)

     register int c;

     struct ui_file *stream;

     int quoter;

{

  c &= 0xFF;                    /* Avoid sign bit follies */

  if (PRINT_LITERAL_FORM (c))

    {

      if (c == '\\' || c == quoter)

        {

          fputs_filtered ("\\", stream);

        }

      fprintf_filtered (stream, "%c", c);

    }

  else

    {

      switch (c)

        {

        case '\n':

          fputs_filtered ("\\n", stream);

          break;

        case '\b':

          fputs_filtered ("\\b", stream);

          break;

        case '\t':

          fputs_filtered ("\\t", stream);

          break;

        case '\f':

          fputs_filtered ("\\f", stream);

          break;

        case '\r':

          fputs_filtered ("\\r", stream);

          break;

        case '\033':

          fputs_filtered ("\\e", stream);

          break;

        case '\007':

          fputs_filtered ("\\a", stream);

          break;

        default:

          fprintf_filtered (stream, "\\%.3o", (unsigned int) c);

          break;

        }

    }

}

/* FIXME:  This is a copy of the same function from c-exp.y.  It should

   be replaced with a true Modula version. */

static void

m2_printchar (c, stream)

     int c;

     struct ui_file *stream;

{

  fputs_filtered ("'", stream);

  LA_EMIT_CHAR (c, stream, '\'');

  fputs_filtered ("'", stream);

}

/* Print the character string STRING, printing at most LENGTH characters.

   Printing stops early if the number hits print_max; repeat counts

   are printed as appropriate.  Print ellipses at the end if we

   had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.

   FIXME:  This is a copy of the same function from c-exp.y.  It should

   be replaced with a true Modula version. */

static void

m2_printstr (stream, string, length, width, force_ellipses)

     struct ui_file *stream;

     char *string;

     unsigned int length;

     int width;

     int force_ellipses;

{

  register unsigned int i;

  unsigned int things_printed = 0;

  int in_quotes = 0;

  int need_comma = 0;

  extern int inspect_it;

  if (length == 0)

    {

      fputs_filtered ("\"\"", gdb_stdout);

      return;

    }

  for (i = 0; i < length && things_printed < print_max; ++i)

    {

      /* Position of the character we are examining

         to see whether it is repeated.  */

      unsigned int rep1;

      /* Number of repetitions we have detected so far.  */

      unsigned int reps;

      QUIT;

      if (need_comma)

        {

          fputs_filtered (", ", stream);

          need_comma = 0;

        }

      rep1 = i + 1;

      reps = 1;

      while (rep1 < length && string[rep1] == string[i])

        {

          ++rep1;

          ++reps;

        }

      if (reps > repeat_count_threshold)

        {

          if (in_quotes)

            {

              if (inspect_it)

                fputs_filtered ("\\\", ", stream);

              else

                fputs_filtered ("\", ", stream);

              in_quotes = 0;

            }

          m2_printchar (string[i], stream);

          fprintf_filtered (stream, " <repeats %u times>", reps);

          i = rep1 - 1;

          things_printed += repeat_count_threshold;

          need_comma = 1;

        }

      else

        {

          if (!in_quotes)

            {

              if (inspect_it)

                fputs_filtered ("\\\"", stream);

              else

                fputs_filtered ("\"", stream);

              in_quotes = 1;

            }

          LA_EMIT_CHAR (string[i], stream, '"');

          ++things_printed;

        }

    }

  /* Terminate the quotes if necessary.  */

  if (in_quotes)

    {

      if (inspect_it)

        fputs_filtered ("\\\"", stream);

      else

        fputs_filtered ("\"", stream);

    }

  if (force_ellipses || i < length)

    fputs_filtered ("...", stream);

}

/* FIXME:  This is a copy of c_create_fundamental_type(), before

   all the non-C types were stripped from it.  Needs to be fixed

   by an experienced Modula programmer. */

static struct type *

m2_create_fundamental_type (objfile, typeid)

     struct objfile *objfile;

     int typeid;

{

  register struct type *type = NULL;

  switch (typeid)

    {

    default:

      /* FIXME:  For now, if we are asked to produce a type not in this

         language, create the equivalent of a C integer type with the

         name "<?type?>".  When all the dust settles from the type

         reconstruction work, this should probably become an error. */

      type = init_type (TYPE_CODE_INT,

                        TARGET_INT_BIT / TARGET_CHAR_BIT,

                        0, "<?type?>", objfile);

      warning ("internal error: no Modula fundamental type %d", typeid);

      break;

    case FT_VOID:

      type = init_type (TYPE_CODE_VOID,

                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,

                        0, "void", objfile);

      break;

    case FT_BOOLEAN:

      type = init_type (TYPE_CODE_BOOL,

                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,

                        TYPE_FLAG_UNSIGNED, "boolean", objfile);

      break;

    case FT_STRING:

      type = init_type (TYPE_CODE_STRING,

                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,

                        0, "string", objfile);

      break;

    case FT_CHAR:

      type = init_type (TYPE_CODE_INT,

                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,

                        0, "char", objfile);

      break;

    case FT_SIGNED_CHAR:

      type = init_type (TYPE_CODE_INT,

                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,

                        0, "signed char", objfile);

      break;

    case FT_UNSIGNED_CHAR:

      type = init_type (TYPE_CODE_INT,

                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,

                        TYPE_FLAG_UNSIGNED, "unsigned char", objfile);

      break;

    case FT_SHORT:

      type = init_type (TYPE_CODE_INT,

                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,

                        0, "short", objfile);

      break;

    case FT_SIGNED_SHORT:

      type = init_type (TYPE_CODE_INT,

                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,

                        0, "short", objfile);    /* FIXME-fnf */

      break;

    case FT_UNSIGNED_SHORT:

      type = init_type (TYPE_CODE_INT,

                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,

                        TYPE_FLAG_UNSIGNED, "unsigned short", objfile);

      break;

    case FT_INTEGER:

      type = init_type (TYPE_CODE_INT,

                        TARGET_INT_BIT / TARGET_CHAR_BIT,

                        0, "int", objfile);

      break;

    case FT_SIGNED_INTEGER:

      type = init_type (TYPE_CODE_INT,

                        TARGET_INT_BIT / TARGET_CHAR_BIT,

                        0, "int", objfile);      /* FIXME -fnf */

      break;

    case FT_UNSIGNED_INTEGER:

      type = init_type (TYPE_CODE_INT,

                        TARGET_INT_BIT / TARGET_CHAR_BIT,

                        TYPE_FLAG_UNSIGNED, "unsigned int", objfile);

      break;

    case FT_FIXED_DECIMAL:

      type = init_type (TYPE_CODE_INT,

                        TARGET_INT_BIT / TARGET_CHAR_BIT,

                        0, "fixed decimal", objfile);

      break;

    case FT_LONG:

      type = init_type (TYPE_CODE_INT,

                        TARGET_LONG_BIT / TARGET_CHAR_BIT,

                        0, "long", objfile);

      break;

    case FT_SIGNED_LONG:

      type = init_type (TYPE_CODE_INT,

                        TARGET_LONG_BIT / TARGET_CHAR_BIT,

                        0, "long", objfile);     /* FIXME -fnf */

      break;

    case FT_UNSIGNED_LONG:

      type = init_type (TYPE_CODE_INT,

                        TARGET_LONG_BIT / TARGET_CHAR_BIT,

                        TYPE_FLAG_UNSIGNED, "unsigned long", objfile);

      break;

    case FT_LONG_LONG:

      type = init_type (TYPE_CODE_INT,

                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,

                        0, "long long", objfile);

      break;

    case FT_SIGNED_LONG_LONG:

      type = init_type (TYPE_CODE_INT,

                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,

                        0, "signed long long", objfile);

      break;

    case FT_UNSIGNED_LONG_LONG:

      type = init_type (TYPE_CODE_INT,

                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,

                        TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);

      break;

    case FT_FLOAT:

      type = init_type (TYPE_CODE_FLT,

                        TARGET_FLOAT_BIT / TARGET_CHAR_BIT,

                        0, "float", objfile);

      break;

    case FT_DBL_PREC_FLOAT:

      type = init_type (TYPE_CODE_FLT,

                        TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,

                        0, "double", objfile);

      break;

    case FT_FLOAT_DECIMAL:

      type = init_type (TYPE_CODE_FLT,

                        TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,

                        0, "floating decimal", objfile);

      break;

    case FT_EXT_PREC_FLOAT:

      type = init_type (TYPE_CODE_FLT,

                        TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,

                        0, "long double", objfile);

      break;

    case FT_COMPLEX:

      type = init_type (TYPE_CODE_COMPLEX,

                        2 * TARGET_FLOAT_BIT / TARGET_CHAR_BIT,

                        0, "complex", objfile);

      TYPE_TARGET_TYPE (type)

        = m2_create_fundamental_type (objfile, FT_FLOAT);

      break;

    case FT_DBL_PREC_COMPLEX:

      type = init_type (TYPE_CODE_COMPLEX,

                        2 * TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,

                        0, "double complex", objfile);

      TYPE_TARGET_TYPE (type)

        = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);

      break;

    case FT_EXT_PREC_COMPLEX:

      type = init_type (TYPE_CODE_COMPLEX,

                        2 * TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,

                        0, "long double complex", objfile);

      TYPE_TARGET_TYPE (type)

        = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);

      break;

    }

  return (type);

}

/* Table of operators and their precedences for printing expressions.  */

static const struct op_print m2_op_print_tab[] =

{

  {"+", BINOP_ADD, PREC_ADD, 0},

  {"+", UNOP_PLUS, PREC_PREFIX, 0},

  {"-", BINOP_SUB, PREC_ADD, 0},

  {"-", UNOP_NEG, PREC_PREFIX, 0},

  {"*", BINOP_MUL, PREC_MUL, 0},

  {"/", BINOP_DIV, PREC_MUL, 0},

  {"DIV", BINOP_INTDIV, PREC_MUL, 0},

  {"MOD", BINOP_REM, PREC_MUL, 0},

  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},

  {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},

  {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},

  {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},

  {"=", BINOP_EQUAL, PREC_EQUAL, 0},

  {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},

  {"<=", BINOP_LEQ, PREC_ORDER, 0},

  {">=", BINOP_GEQ, PREC_ORDER, 0},

  {">", BINOP_GTR, PREC_ORDER, 0},

  {"<", BINOP_LESS, PREC_ORDER, 0},

  {"^", UNOP_IND, PREC_PREFIX, 0},

  {"@", BINOP_REPEAT, PREC_REPEAT, 0},

  {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},

  {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},

  {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},

  {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},

  {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},

  {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},

  {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},

  {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},

  {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},

  {NULL, 0, 0, 0}

};

/* The built-in types of Modula-2.  */

struct type *builtin_type_m2_char;

struct type *builtin_type_m2_int;

struct type *builtin_type_m2_card;

struct type *builtin_type_m2_real;

struct type *builtin_type_m2_bool;

struct type **CONST_PTR (m2_builtin_types[]) =

{

  &builtin_type_m2_char,

    &builtin_type_m2_int,

    &builtin_type_m2_card,

    &builtin_type_m2_real,

    &builtin_type_m2_bool,

};

const struct language_defn m2_language_defn =

{

  "modula-2",

  language_m2,

  m2_builtin_types,

  range_check_on,

  type_check_on,

  m2_parse,                     /* parser */

  m2_error,                     /* parser error function */

  evaluate_subexp_standard,

  m2_printchar,                 /* Print character constant */

  m2_printstr,                  /* function to print string constant */

  m2_emit_char,                 /* Function to print a single character */

  m2_create_fundamental_type,   /* Create fundamental type in this language */

  m2_print_type,                /* Print a type using appropriate syntax */

  m2_val_print,                 /* Print a value using appropriate syntax */

  c_value_print,                /* Print a top-level value */

  {"", "", "", ""},             /* Binary format info */

  {"%loB", "", "o", "B"},       /* Octal format info */

  {"%ld", "", "d", ""},         /* Decimal format info */

  {"0%lXH", "0", "X", "H"},      /* Hex format info */

  m2_op_print_tab,              /* expression operators for printing */

  0,                             /* arrays are first-class (not c-style) */

  0,                             /* String lower bound */

  &builtin_type_m2_char,        /* Type of string elements */

  LANG_MAGIC

};

/* Initialization for Modula-2 */

void

_initialize_m2_language ()

{

  /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */

  builtin_type_m2_int =

    init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,

               0,

               "INTEGER", (struct objfile *) NULL);

  builtin_type_m2_card =

    init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,

               TYPE_FLAG_UNSIGNED,

               "CARDINAL", (struct objfile *) NULL);

  builtin_type_m2_real =

    init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,

               0,

               "REAL", (struct objfile *) NULL);

  builtin_type_m2_char =

    init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,

               TYPE_FLAG_UNSIGNED,

               "CHAR", (struct objfile *) NULL);

  builtin_type_m2_bool =

    init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,

               TYPE_FLAG_UNSIGNED,

               "BOOLEAN", (struct objfile *) NULL);

  add_language (&m2_language_defn);

}