2007-09-12 H.J. Lu <hongjiu.lu@intel.com>
[deliverable/binutils-gdb.git] / gdb / p-lang.c
index 93dd2548f67e70c33ebcee043e29d29f4902bb05..e1a656ddbaa6db3293331a2d52081128dafd6d44 100644 (file)
@@ -1,11 +1,13 @@
 /* Pascal language support routines for GDB, the GNU debugger.
-   Copyright 2000 Free Software Foundation, Inc.
+
+   Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007
+   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
+   the Free Software Foundation; either version 3 of the License, or
    (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    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.  */
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
 
-/* This file is derived from p-lang.c */
+/* This file is derived from c-lang.c */
 
 #include "defs.h"
+#include "gdb_string.h"
 #include "symtab.h"
 #include "gdbtypes.h"
 #include "expression.h"
 #include "language.h"
 #include "p-lang.h"
 #include "valprint.h"
-
+#include "value.h"
+#include <ctype.h>
 extern void _initialize_pascal_language (void);
+
+
+/* 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.
+   If it is a pascal string type, then it also sets info needed
+   to get the length and the data of the string
+   length_pos, length_size and string_pos are given in bytes.
+   char_size gives the element size in bytes.
+   FIXME: if the position or the size of these fields
+   are not multiple of TARGET_CHAR_BIT then the results are wrong
+   but this does not happen for Free Pascal nor for GPC.  */
+int
+is_pascal_string_type (struct type *type,int *length_pos,
+                       int *length_size, int *string_pos, int *char_size,
+                      char **arrayname)
+{
+  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+    {
+      /* Old Borland type pascal strings from Free Pascal Compiler.  */
+      /* Two fields: length and st.  */
+      if (TYPE_NFIELDS (type) == 2 
+          && strcmp (TYPE_FIELDS (type)[0].name, "length") == 0 
+          && strcmp (TYPE_FIELDS (type)[1].name, "st") == 0)
+        {
+          if (length_pos)
+           *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT;
+          if (length_size)
+           *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
+          if (string_pos)
+           *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
+          if (char_size)
+           *char_size = 1;
+         if (arrayname)
+           *arrayname = TYPE_FIELDS (type)[1].name;
+         return 2;
+        };
+      /* GNU pascal strings.  */
+      /* Three fields: Capacity, length and schema$ or _p_schema.  */
+      if (TYPE_NFIELDS (type) == 3
+          && strcmp (TYPE_FIELDS (type)[0].name, "Capacity") == 0
+          && strcmp (TYPE_FIELDS (type)[1].name, "length") == 0)
+        {
+          if (length_pos)
+           *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT;
+          if (length_size)
+           *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1));
+          if (string_pos)
+           *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT;
+          /* FIXME: how can I detect wide chars in GPC ?? */
+          if (char_size)
+           *char_size = 1;
+         if (arrayname)
+           *arrayname = TYPE_FIELDS (type)[2].name;
+         return 3;
+        };
+    }
+  return 0;
+}
+
 static void pascal_one_char (int, struct ui_file *, int *);
 
 /* Print the character C on STREAM as part of the contents of a literal
@@ -36,7 +100,7 @@ static void pascal_one_char (int, struct ui_file *, int *);
    In_quotes is reset to 0 if a char is written with #4 notation */
 
 static void
-pascal_one_char (register int c, struct ui_file *stream, int *in_quotes)
+pascal_one_char (int c, struct ui_file *stream, int *in_quotes)
 {
 
   c &= 0xFF;                   /* Avoid sign bit follies */
@@ -69,7 +133,7 @@ static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
    characters and strings is language specific. */
 
 static void
-pascal_emit_char (register int c, struct ui_file *stream, int quoter)
+pascal_emit_char (int c, struct ui_file *stream, int quoter)
 {
   int in_quotes = 0;
   pascal_one_char (c, stream, &in_quotes);
@@ -92,14 +156,13 @@ pascal_printchar (int c, struct ui_file *stream)
    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.  */
 
 void
-pascal_printstr (struct ui_file *stream, char *string, unsigned int length,
-                int width, int force_ellipses)
+pascal_printstr (struct ui_file *stream, const gdb_byte *string,
+                unsigned int length, int width, int force_ellipses)
 {
-  register unsigned int i;
+  unsigned int i;
   unsigned int things_printed = 0;
   int in_quotes = 0;
   int need_comma = 0;
-  extern int inspect_it;
 
   /* If the string was not truncated due to `set print elements', and
      the last byte of it is a null, we don't print that, in traditional C
@@ -212,7 +275,7 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length,
 struct type *
 pascal_create_fundamental_type (struct objfile *objfile, int typeid)
 {
-  register struct type *type = NULL;
+  struct type *type = NULL;
 
   switch (typeid)
     {
@@ -222,9 +285,9 @@ pascal_create_fundamental_type (struct objfile *objfile, int typeid)
          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,
+                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "<?type?>", objfile);
-      warning ("internal error: no Pascal fundamental type %d", typeid);
+      warning (_("internal error: no Pascal fundamental type %d"), typeid);
       break;
     case FT_VOID:
       type = init_type (TYPE_CODE_VOID,
@@ -232,7 +295,7 @@ pascal_create_fundamental_type (struct objfile *objfile, int typeid)
                        0, "void", objfile);
       break;
     case FT_CHAR:
-      type = init_type (TYPE_CODE_INT,
+      type = init_type (TYPE_CODE_CHAR,
                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
                        0, "char", objfile);
       break;
@@ -248,77 +311,81 @@ pascal_create_fundamental_type (struct objfile *objfile, int typeid)
       break;
     case FT_SHORT:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "integer", objfile);
       break;
     case FT_SIGNED_SHORT:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "integer", objfile);         /* FIXME-fnf */
       break;
     case FT_UNSIGNED_SHORT:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        TYPE_FLAG_UNSIGNED, "word", objfile);
       break;
     case FT_INTEGER:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_INT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "longint", objfile);
       break;
     case FT_SIGNED_INTEGER:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_INT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "longint", objfile);         /* FIXME -fnf */
       break;
     case FT_UNSIGNED_INTEGER:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_INT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        TYPE_FLAG_UNSIGNED, "cardinal", objfile);
       break;
     case FT_LONG:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_LONG_BIT / TARGET_CHAR_BIT,
+                       gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "long", objfile);
       break;
     case FT_SIGNED_LONG:
       type = init_type (TYPE_CODE_INT,
-                       TARGET_LONG_BIT / TARGET_CHAR_BIT,
+                       gdbarch_long_bit (current_gdbarch) / 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,
+                       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,
-                       TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+                       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,
-                       TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+                       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,
-                       TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+                       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,
-                       TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
+                       gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "float", objfile);
       break;
     case FT_DBL_PREC_FLOAT:
       type = init_type (TYPE_CODE_FLT,
-                       TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
+                       gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
                        0, "double", objfile);
       break;
     case FT_EXT_PREC_FLOAT:
       type = init_type (TYPE_CODE_FLT,
-                       TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
+                       gdbarch_long_double_bit (current_gdbarch)
+                         / TARGET_CHAR_BIT,
                        0, "extended", objfile);
       break;
     }
@@ -359,39 +426,85 @@ const struct op_print pascal_op_print_tab[] =
   {NULL, 0, 0, 0}
 };
 \f
-struct type **const /* CONST_PTR v 4.17 */ (pascal_builtin_types[]) =
-{
-  &builtin_type_int,
-    &builtin_type_long,
-    &builtin_type_short,
-    &builtin_type_char,
-    &builtin_type_float,
-    &builtin_type_double,
-    &builtin_type_void,
-    &builtin_type_long_long,
-    &builtin_type_signed_char,
-    &builtin_type_unsigned_char,
-    &builtin_type_unsigned_short,
-    &builtin_type_unsigned_int,
-    &builtin_type_unsigned_long,
-    &builtin_type_unsigned_long_long,
-    &builtin_type_long_double,
-    &builtin_type_complex,
-    &builtin_type_double_complex,
-    0
+enum pascal_primitive_types {
+  pascal_primitive_type_int,
+  pascal_primitive_type_long,
+  pascal_primitive_type_short,
+  pascal_primitive_type_char,
+  pascal_primitive_type_float,
+  pascal_primitive_type_double,
+  pascal_primitive_type_void,
+  pascal_primitive_type_long_long,
+  pascal_primitive_type_signed_char,
+  pascal_primitive_type_unsigned_char,
+  pascal_primitive_type_unsigned_short,
+  pascal_primitive_type_unsigned_int,
+  pascal_primitive_type_unsigned_long,
+  pascal_primitive_type_unsigned_long_long,
+  pascal_primitive_type_long_double,
+  pascal_primitive_type_complex,
+  pascal_primitive_type_double_complex,
+  nr_pascal_primitive_types
 };
 
+static void
+pascal_language_arch_info (struct gdbarch *gdbarch,
+                          struct language_arch_info *lai)
+{
+  const struct builtin_type *builtin = builtin_type (gdbarch);
+  lai->string_char_type = builtin->builtin_char;
+  lai->primitive_type_vector
+    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_pascal_primitive_types + 1,
+                              struct type *);
+  lai->primitive_type_vector [pascal_primitive_type_int]
+    = builtin->builtin_int;
+  lai->primitive_type_vector [pascal_primitive_type_long]
+    = builtin->builtin_long;
+  lai->primitive_type_vector [pascal_primitive_type_short]
+    = builtin->builtin_short;
+  lai->primitive_type_vector [pascal_primitive_type_char]
+    = builtin->builtin_char;
+  lai->primitive_type_vector [pascal_primitive_type_float]
+    = builtin->builtin_float;
+  lai->primitive_type_vector [pascal_primitive_type_double]
+    = builtin->builtin_double;
+  lai->primitive_type_vector [pascal_primitive_type_void]
+    = builtin->builtin_void;
+  lai->primitive_type_vector [pascal_primitive_type_long_long]
+    = builtin->builtin_long_long;
+  lai->primitive_type_vector [pascal_primitive_type_signed_char]
+    = builtin->builtin_signed_char;
+  lai->primitive_type_vector [pascal_primitive_type_unsigned_char]
+    = builtin->builtin_unsigned_char;
+  lai->primitive_type_vector [pascal_primitive_type_unsigned_short]
+    = builtin->builtin_unsigned_short;
+  lai->primitive_type_vector [pascal_primitive_type_unsigned_int]
+    = builtin->builtin_unsigned_int;
+  lai->primitive_type_vector [pascal_primitive_type_unsigned_long]
+    = builtin->builtin_unsigned_long;
+  lai->primitive_type_vector [pascal_primitive_type_unsigned_long_long]
+    = builtin->builtin_unsigned_long_long;
+  lai->primitive_type_vector [pascal_primitive_type_long_double]
+    = builtin->builtin_long_double;
+  lai->primitive_type_vector [pascal_primitive_type_complex]
+    = builtin->builtin_complex;
+  lai->primitive_type_vector [pascal_primitive_type_double_complex]
+    = builtin->builtin_double_complex;
+}
+
 const struct language_defn pascal_language_defn =
 {
   "pascal",                    /* Language name */
   language_pascal,
-  pascal_builtin_types,
+  NULL,
   range_check_on,
   type_check_on,
   case_sensitive_on,
+  array_row_major,
+  &exp_descriptor_standard,
   pascal_parse,
   pascal_error,
-  evaluate_subexp_standard,
+  null_post_parser,
   pascal_printchar,            /* Print a character constant */
   pascal_printstr,             /* Function to print string constant */
   pascal_emit_char,            /* Print a single char */
@@ -399,14 +512,19 @@ const struct language_defn pascal_language_defn =
   pascal_print_type,           /* Print a type using appropriate syntax */
   pascal_val_print,            /* Print a value using appropriate syntax */
   pascal_value_print,          /* Print a top-level value */
-  {"", "%", "b", ""},          /* Binary format info */
-  {"0%lo", "0", "o", ""},      /* Octal format info */
-  {"%ld", "", "d", ""},                /* Decimal format info */
-  {"$%lx", "$", "x", ""},      /* Hex format info */
+  NULL,                                /* Language specific skip_trampoline */
+  value_of_this,               /* value_of_this */
+  basic_lookup_symbol_nonlocal,        /* lookup_symbol_nonlocal */
+  basic_lookup_transparent_type,/* lookup_transparent_type */
+  NULL,                                /* Language specific symbol demangler */
+  NULL,                                /* Language specific class_name_from_physname */
   pascal_op_print_tab,         /* expression operators for printing */
   1,                           /* c-style arrays */
   0,                           /* String lower bound */
-  &builtin_type_char,          /* Type of string elements */
+  NULL,
+  default_word_break_characters,
+  pascal_language_arch_info,
+  default_print_array_index,
   LANG_MAGIC
 };
 
This page took 0.028809 seconds and 4 git commands to generate.