[rfc/rft] Fix incorrect static type in scm-lang.c

["Ulrich Weigand" <uweigand at de dot ibm dot com>]

Hello,

scm-lang.c also contains a static type defined at startup depending on the
initial current_gdbarch.  As with mdebugread.c, this is broken even with
today's --enable-targets= support.

This patch removes the builtin_type_scm static type, and instead defines
a per-gdbarch structure of builtin types, just like all other languages
already do.

The bulk of the patch is actually getting rid of the deeply-embedded use
of TYPE_LENGTH (builtin_type_scm) is scm_get_field.  This is done by 
passing in the size of the SCM type from outside, using the existing
SCM_SIZE mechanism to bypass the various macros in scm-tags.h.  This
means there's no a couple further places that need to define SCM_SIZE ...

This patch shouldn't change the behaviour, but unfortunately I don't
have a way to test it.  I'd appreciate any hints how to run Guile
with GDB ...

Bye,
Ulrich

ChangeLog:

	* scm-lang.c (builtin_type_scm): Remove.
	(scm_lookup_name): Add GDBARCH parameter.  Use it instead of
	objfile architecture.  Use per-architecture builtin_scm_type instead
	of builtin_type_scm.
	(evaluate_exp): Pass expression architecture to scm_lookup_name.

	(scm_get_field): Add SIZE parameter.  Use it instead of 
	TYPE_LENGTH (builtin_type_scm).

	(build_scm_types): New function.
	(scm_type_data): New variable.
	(builtin_scm_type): New function.
	(_initialize_scheme_language): Do not initialize builtin_type_scm.
	Register build_scm_types as post-init function for scm_type_data.

	* scm-exp.c (scm_lreadr): Use per-architecture builtin_scm_type
	instead of builtin_type_scm.

	* scm-lang.h (SCM_CAR, SCM_CDR): Pass SCM_SIZE to scm_get_field.
	(scm_get_field): Add SIZE paramter.
	(scm_scmval_print): Remove prototype.
	(builtin_type_scm): Remove.
	(struct builtin_scm_type): Add structure definition.
	(builtin_scm_type): Add prototype.

	* scm-valprint.c (scm_inferior_print): Add TYPE parameter.  Use it
	instead of builtin_core_addr type; do not use objfile architecture.
	(scm_scmlist_print): Add TYPE parameter.  Use it to define SCM_SIZE.
	Pass type to scm_scmval_print.
	(scm_ipruk): Add TYPE parameter.  Use it to define SCM_SIZE.
	(scm_scmval_print): Make static.  Add TYPE parameter.  Use it to
	define SCM_SIZE.  Pass type to scm_ipruk and scm_scmlist_print.
	(scm_val_print): Pass type to scm_inferior_print and scm_scmval_print.


Index: gdb-head/gdb/scm-exp.c
===================================================================
--- gdb-head.orig/gdb/scm-exp.c
+++ gdb-head/gdb/scm-exp.c
@@ -470,7 +470,7 @@ handle_immediate:
   if (!skipping)
     {
       write_exp_elt_opcode (OP_LONG);
-      write_exp_elt_type (builtin_type_scm);
+      write_exp_elt_type (builtin_scm_type (parse_gdbarch)->builtin_scm);
       write_exp_elt_longcst (svalue);
       write_exp_elt_opcode (OP_LONG);
     }
Index: gdb-head/gdb/scm-lang.c
===================================================================
--- gdb-head.orig/gdb/scm-lang.c
+++ gdb-head/gdb/scm-lang.c
@@ -37,11 +37,9 @@
 extern void _initialize_scheme_language (void);
 static struct value *evaluate_subexp_scm (struct type *, struct expression *,
 				      int *, enum noside);
-static struct value *scm_lookup_name (char *);
+static struct value *scm_lookup_name (struct gdbarch *, char *);
 static int in_eval_c (void);
 
-struct type *builtin_type_scm;
-
 void
 scm_printchar (int c, struct type *type, struct ui_file *stream)
 {
@@ -70,12 +68,11 @@ is_scmvalue_type (struct type *type)
    of the 0'th one.  */
 
 LONGEST
-scm_get_field (LONGEST svalue, int index)
+scm_get_field (LONGEST svalue, int index, int size)
 {
   gdb_byte buffer[20];
-  read_memory (SCM2PTR (svalue) + index * TYPE_LENGTH (builtin_type_scm),
-	       buffer, TYPE_LENGTH (builtin_type_scm));
-  return extract_signed_integer (buffer, TYPE_LENGTH (builtin_type_scm));
+  read_memory (SCM2PTR (svalue) + index * size, buffer, size);
+  return extract_signed_integer (buffer, size);
 }
 
 /* Unpack a value of type TYPE in buffer VALADDR as an integer
@@ -147,18 +144,15 @@ in_eval_c (void)
    function), then try lookup_symbol for compiled variables. */
 
 static struct value *
-scm_lookup_name (char *str)
+scm_lookup_name (struct gdbarch *gdbarch, char *str)
 {
-  struct objfile *objf;
-  struct gdbarch *gdbarch;
   struct value *args[3];
   int len = strlen (str);
   struct value *func;
   struct value *val;
   struct symbol *sym;
 
-  func = find_function_in_inferior ("scm_lookup_cstr", &objf);
-  gdbarch = get_objfile_arch (objf);
+  func = find_function_in_inferior ("scm_lookup_cstr", NULL);
 
   args[0] = value_allocate_space_in_inferior (len);
   args[1] = value_from_longest (builtin_type (gdbarch)->builtin_int, len);
@@ -171,7 +165,8 @@ scm_lookup_name (char *str)
     args[2] = value_of_variable (sym, expression_context_block);
   else
     /* FIXME in this case, we should try lookup_symbol first */
-    args[2] = value_from_longest (builtin_type_scm, SCM_EOL);
+    args[2] = value_from_longest (builtin_scm_type (gdbarch)->builtin_scm,
+				  SCM_EOL);
 
   val = call_function_by_hand (func, 3, args);
   if (!value_logical_not (val))
@@ -214,7 +209,7 @@ evaluate_exp (struct type *expect_type, 
       if (noside == EVAL_SKIP)
 	goto nosideret;
       str = &exp->elts[pc + 2].string;
-      return scm_lookup_name (str);
+      return scm_lookup_name (exp->gdbarch, str);
     case OP_STRING:
       pc = (*pos)++;
       len = longest_to_int (exp->elts[pc + 1].longconst);
@@ -277,12 +272,32 @@ const struct language_defn scm_language_
   LANG_MAGIC
 };
 
+static void *
+build_scm_types (struct gdbarch *gdbarch)
+{
+  struct builtin_scm_type *builtin_scm_type
+    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_scm_type);
+
+  builtin_scm_type->builtin_scm =
+    init_type (TYPE_CODE_INT,
+	       gdbarch_long_bit (gdbarch) / TARGET_CHAR_BIT,
+	       0, "SCM", (struct objfile *) NULL);
+
+  return builtin_scm_type;
+}
+
+static struct gdbarch_data *scm_type_data;
+
+const struct builtin_scm_type *
+builtin_scm_type (struct gdbarch *gdbarch)
+{
+  return gdbarch_data (gdbarch, scm_type_data);
+}
+
 void
 _initialize_scheme_language (void)
 {
+  scm_type_data = gdbarch_data_register_post_init (build_scm_types);
+
   add_language (&scm_language_defn);
-  builtin_type_scm =
-    init_type (TYPE_CODE_INT,
-	       gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
-	       0, "SCM", (struct objfile *) NULL);
 }
Index: gdb-head/gdb/scm-lang.h
===================================================================
--- gdb-head.orig/gdb/scm-lang.h
+++ gdb-head/gdb/scm-lang.h
@@ -35,8 +35,8 @@
 #define SCM_LENGTH(x) (((unsigned long)SCM_CAR(x))>>8)
 #define SCM_NCONSP(x) (1 & (int)SCM_CAR(x))
 #define SCM_NECONSP(x) (SCM_NCONSP(x) && (1 != SCM_TYP3(x)))
-#define SCM_CAR(x) scm_get_field (x, 0)
-#define SCM_CDR(x) scm_get_field (x, 1)
+#define SCM_CAR(x) scm_get_field (x, 0, SCM_SIZE)
+#define SCM_CDR(x) scm_get_field (x, 1, SCM_SIZE)
 #define SCM_VELTS(x) ((SCM *)SCM_CDR(x))
 #define SCM_CLOSCAR(x) (SCM_CAR(x)-scm_tc3_closure)
 #define SCM_CODE(x) SCM_CAR(SCM_CLOSCAR (x))
@@ -52,10 +52,7 @@ extern int scm_val_print (struct type *,
 			  struct ui_file *, int,
 			  const struct value_print_options *);
 
-extern LONGEST scm_get_field (LONGEST, int);
-
-extern void scm_scmval_print (LONGEST, struct ui_file *, int,
-			      const struct value_print_options *);
+extern LONGEST scm_get_field (LONGEST, int, int);
 
 extern int is_scmvalue_type (struct type *);
 
@@ -63,8 +60,17 @@ extern void scm_printchar (int, struct t
 
 extern struct value *scm_evaluate_string (char *, int);
 
-extern struct type *builtin_type_scm;
-
 extern int scm_parse (void);
 
 extern LONGEST scm_unpack (struct type *, const gdb_byte *, enum type_code);
+
+/* Scheme types */
+
+struct builtin_scm_type
+{
+  struct type *builtin_scm;
+};
+
+/* Return the Scheme type table for the specified architecture.  */
+extern const struct builtin_scm_type *builtin_scm_type (struct gdbarch *gdbarch);
+
Index: gdb-head/gdb/scm-valprint.c
===================================================================
--- gdb-head.orig/gdb/scm-valprint.c
+++ gdb-head/gdb/scm-valprint.c
@@ -32,30 +32,29 @@
 #include "infcall.h"
 #include "objfiles.h"
 
-static void scm_ipruk (char *, LONGEST, struct ui_file *);
-static void scm_scmlist_print (LONGEST, struct ui_file *, int,
-			       const struct value_print_options *);
-static int scm_inferior_print (LONGEST, struct ui_file *, int,
-			       const struct value_print_options *);
+static void scm_ipruk (char *, struct type *, LONGEST, struct ui_file *);
+static void scm_scmval_print (struct type *, LONGEST, struct ui_file *,
+			      int, const struct value_print_options *);
+static void scm_scmlist_print (struct type *, LONGEST, struct ui_file *,
+			       int, const struct value_print_options *);
+static int scm_inferior_print (struct type *, LONGEST, struct ui_file *,
+			       int, const struct value_print_options *);
 
 /* Prints the SCM value VALUE by invoking the inferior, if appropraite.
    Returns >= 0 on success;  return -1 if the inferior cannot/should not
    print VALUE. */
 
 static int
-scm_inferior_print (LONGEST value, struct ui_file *stream,
+scm_inferior_print (struct type *type, LONGEST value, struct ui_file *stream,
 		    int recurse, const struct value_print_options *options)
 {
-  struct objfile *objf;
-  struct gdbarch *gdbarch;
   struct value *func, *arg, *result;
   struct symbol *gdb_output_sym, *gdb_output_len_sym;
   char *output;
   int ret, output_len;
 
-  func = find_function_in_inferior ("gdb_print", &objf);
-  gdbarch = get_objfile_arch (objf);
-  arg = value_from_longest (builtin_type (gdbarch)->builtin_core_addr, value);
+  func = find_function_in_inferior ("gdb_print", NULL);
+  arg = value_from_longest (type, value);
 
   result = call_function_by_hand (func, 1, &arg);
   ret = (int) value_as_long (result);
@@ -77,7 +76,7 @@ scm_inferior_print (LONGEST value, struc
 		       (char *) &output_len, sizeof (output_len));
 
 	  output = (char *) alloca (output_len);
-	  remote_buffer = value_at (builtin_type (gdbarch)->builtin_core_addr,
+	  remote_buffer = value_at (type,
 				    SYMBOL_VALUE_ADDRESS (gdb_output_sym));
 	  read_memory (value_as_address (remote_buffer),
 		       output, output_len);
@@ -129,16 +128,18 @@ static char *scm_isymnames[] =
 };
 
 static void
-scm_scmlist_print (LONGEST svalue, struct ui_file *stream, int recurse,
+scm_scmlist_print (struct type *type, LONGEST svalue,
+		   struct ui_file *stream, int recurse,
 		   const struct value_print_options *options)
 {
+#define SCM_SIZE (TYPE_LENGTH (type))
   unsigned int more = options->print_max;
   if (recurse > 6)
     {
       fputs_filtered ("...", stream);
       return;
     }
-  scm_scmval_print (SCM_CAR (svalue), stream, recurse + 1, options);
+  scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options);
   svalue = SCM_CDR (svalue);
   for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
     {
@@ -150,30 +151,35 @@ scm_scmlist_print (LONGEST svalue, struc
 	  fputs_filtered ("...", stream);
 	  return;
 	}
-      scm_scmval_print (SCM_CAR (svalue), stream, recurse + 1, options);
+      scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options);
     }
   if (SCM_NNULLP (svalue))
     {
       fputs_filtered (" . ", stream);
-      scm_scmval_print (svalue, stream, recurse + 1, options);
+      scm_scmval_print (type, svalue, stream, recurse + 1, options);
     }
+#undef SCM_SIZE
 }
 
 static void
-scm_ipruk (char *hdr, LONGEST ptr, struct ui_file *stream)
+scm_ipruk (char *hdr, struct type *type, LONGEST ptr,
+	   struct ui_file *stream)
 {
+#define SCM_SIZE (TYPE_LENGTH (type))
   fprintf_filtered (stream, "#<unknown-%s", hdr);
-#define SCM_SIZE TYPE_LENGTH (builtin_type_scm)
   if (SCM_CELLP (ptr))
     fprintf_filtered (stream, " (0x%lx . 0x%lx) @",
 		      (long) SCM_CAR (ptr), (long) SCM_CDR (ptr));
   fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr));
+#undef SCM_SIZE
 }
 
-void
-scm_scmval_print (LONGEST svalue, struct ui_file *stream,
-		  int recurse, const struct value_print_options *options)
+static void
+scm_scmval_print (struct type *type, LONGEST svalue,
+		  struct ui_file *stream, int recurse,
+		  const struct value_print_options *options)
 {
+#define SCM_SIZE (TYPE_LENGTH (type))
 taloop:
   switch (7 & (int) svalue)
     {
@@ -215,7 +221,7 @@ taloop:
       goto taloop;
     default:
     idef:
-      scm_ipruk ("immediate", svalue, stream);
+      scm_ipruk ("immediate", type, svalue, stream);
       break;
     case 0:
 
@@ -243,12 +249,13 @@ taloop:
 	case scm_tcs_cons_imcar:
 	case scm_tcs_cons_nimcar:
 	  fputs_filtered ("(", stream);
-	  scm_scmlist_print (svalue, stream, recurse + 1, options);
+	  scm_scmlist_print (type, svalue, stream, recurse + 1, options);
 	  fputs_filtered (")", stream);
 	  break;
 	case scm_tcs_closures:
 	  fputs_filtered ("#<CLOSURE ", stream);
-	  scm_scmlist_print (SCM_CODE (svalue), stream, recurse + 1, options);
+	  scm_scmlist_print (type, SCM_CODE (svalue), stream,
+			     recurse + 1, options);
 	  fputs_filtered (">", stream);
 	  break;
 	case scm_tc7_string:
@@ -303,8 +310,8 @@ taloop:
 	      {
 		if (i > 0)
 		  fputs_filtered (" ", stream);
-		scm_scmval_print (scm_get_field (elements, i), stream,
-				  recurse + 1, options);
+		scm_scmval_print (type, scm_get_field (elements, i, SCM_SIZE),
+				  stream, recurse + 1, options);
 	      }
 	    fputs_filtered (")", stream);
 	  }
@@ -390,10 +397,11 @@ taloop:
 #if 0
 	punk:
 #endif
-	  scm_ipruk ("type", svalue, stream);
+	  scm_ipruk ("type", type, svalue, stream);
 	}
       break;
     }
+#undef SCM_SIZE
 }
 
 int
@@ -406,12 +414,12 @@ scm_val_print (struct type *type, const 
     {
       LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
 
-      if (scm_inferior_print (svalue, stream, recurse, options) >= 0)
+      if (scm_inferior_print (type, svalue, stream, recurse, options) >= 0)
 	{
 	}
       else
 	{
-	  scm_scmval_print (svalue, stream, recurse, options);
+	  scm_scmval_print (type, svalue, stream, recurse, options);
 	}
 
       gdb_flush (stream);
-- 
  Dr. Ulrich Weigand
  GNU Toolchain for Linux on System z and Cell BE
  Ulrich.Weigand@de.ibm.com