2009-01-06 Sandra Loosemore <sandra@codesourcery.com>
[deliverable/binutils-gdb.git] / gdb / p-lang.c
index e1a656ddbaa6db3293331a2d52081128dafd6d44..0e0de2e05b2db7cac55e69709b6d8ba46c2d3c60 100644 (file)
@@ -1,6 +1,6 @@
 /* Pascal language support routines for GDB, the GNU debugger.
 
-   Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007
+   Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007, 2008, 2009
    Free Software Foundation, Inc.
 
    This file is part of GDB.
 extern void _initialize_pascal_language (void);
 
 
+/* All GPC versions until now (2007-09-27) also define a symbol called
+   '_p_initialize'. Check for the presence of this symbol first.  */
+static const char GPC_P_INITIALIZE[] = "_p_initialize";
+
+/* The name of the symbol that GPC uses as the name of the main
+   procedure (since version 20050212).  */
+static const char GPC_MAIN_PROGRAM_NAME_1[] = "_p__M0_main_program";
+
+/* Older versions of GPC (versions older than 20050212) were using
+   a different name for the main procedure.  */
+static const char GPC_MAIN_PROGRAM_NAME_2[] = "pascal_main_program";
+
+/* Function returning the special symbol name used
+   by GPC for the main procedure in the main program
+   if it is found in minimal symbol list.
+   This function tries to find minimal symbols generated by GPC
+   so that it finds the even if the program was compiled
+   without debugging information.
+   According to information supplied by Waldeck Hebisch,
+   this should work for all versions posterior to June 2000. */
+
+const char *
+pascal_main_name (void)
+{
+  struct minimal_symbol *msym;
+
+  msym = lookup_minimal_symbol (GPC_P_INITIALIZE, NULL, NULL);
+
+  /*  If '_p_initialize' was not found, the main program is likely not
+     written in Pascal.  */
+  if (msym == NULL)
+    return NULL;
+
+  msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_1, NULL, NULL);
+  if (msym != NULL)
+    {
+      return GPC_MAIN_PROGRAM_NAME_1;
+    }
+
+  msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_2, NULL, NULL);
+  if (msym != NULL)
+    {
+      return GPC_MAIN_PROGRAM_NAME_2;
+    }
+
+  /*  No known entry procedure found, the main program is probably
+      not compiled with GPC.  */
+  return NULL;
+}
+
 /* Determines if type TYPE is a pascal string type.
    Returns 1 if the type is a known pascal type
    This function is used by p-valprint.c code to allow better string display.
@@ -157,7 +207,8 @@ pascal_printchar (int c, struct ui_file *stream)
 
 void
 pascal_printstr (struct ui_file *stream, const gdb_byte *string,
-                unsigned int length, int width, int force_ellipses)
+                unsigned int length, int width, int force_ellipses,
+                const struct value_print_options *options)
 {
   unsigned int i;
   unsigned int things_printed = 0;
@@ -176,7 +227,7 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
       return;
     }
 
-  for (i = 0; i < length && things_printed < print_max; ++i)
+  for (i = 0; i < length && things_printed < options->print_max; ++i)
     {
       /* Position of the character we are examining
          to see whether it is repeated.  */
@@ -200,11 +251,11 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
          ++reps;
        }
 
-      if (reps > repeat_count_threshold)
+      if (reps > options->repeat_count_threshold)
        {
          if (in_quotes)
            {
-             if (inspect_it)
+             if (options->inspect_it)
                fputs_filtered ("\\', ", stream);
              else
                fputs_filtered ("', ", stream);
@@ -213,7 +264,7 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
          pascal_printchar (string[i], stream);
          fprintf_filtered (stream, " <repeats %u times>", reps);
          i = rep1 - 1;
-         things_printed += repeat_count_threshold;
+         things_printed += options->repeat_count_threshold;
          need_comma = 1;
        }
       else
@@ -221,7 +272,7 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
          int c = string[i];
          if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
            {
-             if (inspect_it)
+             if (options->inspect_it)
                fputs_filtered ("\\'", stream);
              else
                fputs_filtered ("'", stream);
@@ -235,7 +286,7 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
   /* Terminate the quotes if necessary.  */
   if (in_quotes)
     {
-      if (inspect_it)
+      if (options->inspect_it)
        fputs_filtered ("\\'", stream);
       else
        fputs_filtered ("'", stream);
@@ -244,153 +295,6 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string,
   if (force_ellipses || i < length)
     fputs_filtered ("...", stream);
 }
-
-/* Create a fundamental Pascal type using default reasonable for the current
-   target machine.
-
-   Some object/debugging file formats (DWARF version 1, COFF, etc) do not
-   define fundamental types such as "int" or "double".  Others (stabs or
-   DWARF version 2, etc) do define fundamental types.  For the formats which
-   don't provide fundamental types, gdb can create such types using this
-   function.
-
-   FIXME:  Some compilers distinguish explicitly signed integral types
-   (signed short, signed int, signed long) from "regular" integral types
-   (short, int, long) in the debugging information.  There is some dis-
-   agreement as to how useful this feature is.  In particular, gcc does
-   not support this.  Also, only some debugging formats allow the
-   distinction to be passed on to a debugger.  For now, we always just
-   use "short", "int", or "long" as the type name, for both the implicit
-   and explicitly signed types.  This also makes life easier for the
-   gdb test suite since we don't have to account for the differences
-   in output depending upon what the compiler and debugging format
-   support.  We will probably have to re-examine the issue when gdb
-   starts taking it's fundamental type information directly from the
-   debugging information supplied by the compiler.  fnf@cygnus.com */
-
-/* Note there might be some discussion about the choosen correspondance
-   because it mainly reflects Free Pascal Compiler setup for now PM */
-
-
-struct type *
-pascal_create_fundamental_type (struct objfile *objfile, int typeid)
-{
-  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,
-                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "<?type?>", objfile);
-      warning (_("internal error: no Pascal 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_CHAR:
-      type = init_type (TYPE_CODE_CHAR,
-                       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, "shortint", objfile);
-      break;
-    case FT_UNSIGNED_CHAR:
-      type = init_type (TYPE_CODE_INT,
-                       TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-                       TYPE_FLAG_UNSIGNED, "byte", objfile);
-      break;
-    case FT_SHORT:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "integer", objfile);
-      break;
-    case FT_SIGNED_SHORT:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "integer", objfile);         /* FIXME-fnf */
-      break;
-    case FT_UNSIGNED_SHORT:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       TYPE_FLAG_UNSIGNED, "word", objfile);
-      break;
-    case FT_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "longint", objfile);
-      break;
-    case FT_SIGNED_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "longint", objfile);         /* FIXME -fnf */
-      break;
-    case FT_UNSIGNED_INTEGER:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       TYPE_FLAG_UNSIGNED, "cardinal", objfile);
-      break;
-    case FT_LONG:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "long", objfile);
-      break;
-    case FT_SIGNED_LONG:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "long", objfile);    /* FIXME -fnf */
-      break;
-    case FT_UNSIGNED_LONG:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
-      break;
-    case FT_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_long_long_bit
-                         (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "long long", objfile);
-      break;
-    case FT_SIGNED_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_long_long_bit
-                         (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "signed long long", objfile);
-      break;
-    case FT_UNSIGNED_LONG_LONG:
-      type = init_type (TYPE_CODE_INT,
-                       gdbarch_long_long_bit
-                         (current_gdbarch) / TARGET_CHAR_BIT,
-                       TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
-      break;
-    case FT_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-                       gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "float", objfile);
-      break;
-    case FT_DBL_PREC_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-                       gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
-                       0, "double", objfile);
-      break;
-    case FT_EXT_PREC_FLOAT:
-      type = init_type (TYPE_CODE_FLT,
-                       gdbarch_long_double_bit (current_gdbarch)
-                         / TARGET_CHAR_BIT,
-                       0, "extended", objfile);
-      break;
-    }
-  return (type);
-}
 \f
 
 /* Table mapping opcodes into strings for printing operators
@@ -490,17 +394,20 @@ pascal_language_arch_info (struct gdbarch *gdbarch,
     = builtin->builtin_complex;
   lai->primitive_type_vector [pascal_primitive_type_double_complex]
     = builtin->builtin_double_complex;
+
+  lai->bool_type_symbol = "boolean";
+  lai->bool_type_default = builtin->builtin_bool;
 }
 
 const struct language_defn pascal_language_defn =
 {
   "pascal",                    /* Language name */
   language_pascal,
-  NULL,
   range_check_on,
   type_check_on,
   case_sensitive_on,
   array_row_major,
+  macro_expansion_no,
   &exp_descriptor_standard,
   pascal_parse,
   pascal_error,
@@ -508,12 +415,12 @@ const struct language_defn pascal_language_defn =
   pascal_printchar,            /* Print a character constant */
   pascal_printstr,             /* Function to print string constant */
   pascal_emit_char,            /* Print a single char */
-  pascal_create_fundamental_type,      /* Create fundamental type in this language */
   pascal_print_type,           /* Print a type using appropriate syntax */
+  pascal_print_typedef,                /* Print a typedef using appropriate syntax */
   pascal_val_print,            /* Print a value using appropriate syntax */
   pascal_value_print,          /* Print a top-level value */
   NULL,                                /* Language specific skip_trampoline */
-  value_of_this,               /* value_of_this */
+  "this",                      /* name_of_this */
   basic_lookup_symbol_nonlocal,        /* lookup_symbol_nonlocal */
   basic_lookup_transparent_type,/* lookup_transparent_type */
   NULL,                                /* Language specific symbol demangler */
@@ -521,10 +428,11 @@ const struct language_defn pascal_language_defn =
   pascal_op_print_tab,         /* expression operators for printing */
   1,                           /* c-style arrays */
   0,                           /* String lower bound */
-  NULL,
   default_word_break_characters,
+  default_make_symbol_completion_list,
   pascal_language_arch_info,
   default_print_array_index,
+  default_pass_by_reference,
   LANG_MAGIC
 };
 
This page took 0.026832 seconds and 4 git commands to generate.