2010-07-01 Basile Starynkevitch <basile@starynkevitch.net>

	{{try hard to detect that the melt-run.h is the good one by
	generating it with a unique hash}}

	* Makefile.in (melt-run.h): is generated from melt-run.proto.h and
	contains a generated #define MELT_RUN_HASHCMD5

	* melt-run.h: removed file, since renamed to melt-run.proto.h & generated.

	* melt-run.proto.h: added file, was melt-run.h before. Got $Id$ inside.

	* melt-runtime.h (meltgc_output_file, melt_sparebreakpoint_1)
	(melt_sparebreakpoint_2): Added declarations

	* melt-runtime.c (load_checked_dynamic_module_index): Uses &
	checks the used_meltrun_md5_melt.
	(melt_output_cfile_decl_impl_secondary): Generates used_meltrun_md5_melt.
	(meltgc_output_file, melt_sparebreakpoint_1_at)
	(melt_sparebreakpoint_2_at): Added new functions.

	* melt/warmelt-outobj.melt: Generates clearing of initial frame in
	startup routine.

	* testsuite/gcc/melt/tfullgc.melt: added calls to
	melt_sparebreakpoint_[12] to ease debugging.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@161672 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 95 insertions, 1 deletions

diff --git a/gcc/melt-runtime.c b/gcc/melt-runtime.c
index edd657c7767..55094087c2c 100644
--- a/gcc/melt-runtime.c
+++ b/gcc/melt-runtime.c
@@ -5979,6 +5979,7 @@ load_checked_dynamic_module_index (const char *dypath, char *md5src)
   void *dlh = NULL;
   char *dyncomptimstamp = NULL;
   char *dynmd5prepromeltrun = NULL;
+  char *dynusedmd5meltrun = NULL;
   typedef melt_ptr_t startroutine_t (melt_ptr_t);
   typedef void markroutine_t (void *);
   PTR_UNION_TYPE(startroutine_t*) startrout_uf = {0};
@@ -6050,6 +6051,14 @@ load_checked_dynamic_module_index (const char *dypath, char *md5src)
     inform (UNKNOWN_LOCATION, "Current melt-run.h signature: %s", melt_run_preprocessed_md5);
   }
 
+  /* check the used hash at build time of melt-run.h; see macro MELT_RUN_HASHMD5. */
+  dynusedmd5meltrun = (char*) dlsym ((void *) dlh, "used_meltrun_md5_melt");
+  if (dynusedmd5meltrun
+      && strcmp(dynusedmd5meltrun, melt_run_preprocessed_md5)) {
+    warning (0, "loaded MELT module %s built for a incompatible melt-run.h header", dypath);
+    inform (UNKNOWN_LOCATION, "MELT_RUN_HASHMD5 at module build time: %s", dynusedmd5meltrun);
+    inform (UNKNOWN_LOCATION, "Current melt-run.h signature: %s", melt_run_preprocessed_md5);
+  }
   PTR_UNION_AS_VOID_PTR(startrout_uf) =
     dlsym ((void *) dlh, "start_module_melt");
   if (!PTR_UNION_AS_VOID_PTR(startrout_uf))
@@ -10990,7 +10999,14 @@ melt_output_cfile_decl_impl_secondary (melt_ptr_t unitnam,
   else
     fprintf (cfil, "/* secondary MELT generated C file of rank #%d */\n",
 	     filrank);
-  fprintf (cfil, "#include \"melt-run.h\"\n");
+  fprintf (cfil, "#include \"melt-run.h\"\n\n");;
+  if (filrank <= 0)
+    fprintf (cfil, "\n/* used hash from melt-run.h when compiling this file: */\n" 
+	     "const char used_meltrun_md5_melt[] = MELT_RUN_HASHMD5 /* from melt-run.h */;\n\n");
+  else 
+    fprintf (cfil, "\n/* used hash from melt-run.h when compiling this file: */\n" 
+	     "const char used_meltrun_md5_melt_f%d[] = MELT_RUN_HASHMD5 /* from melt-run.h */;\n\n", filrank);
+
   fprintf (cfil, "\n/**** %s declarations ****/\n",
 	   melt_string_str (unitnam));
   melt_putstrbuf (cfil, declbuf);
@@ -11069,6 +11085,64 @@ melt_output_cfile_decl_impl_secondary (melt_ptr_t unitnam,
   free (dotcpercentnam);
 }
 
+/* recursive function to output to a file. Handle boxed integers,
+   lists, tuples, strings, strbufs, but don't handle objects! */
+void meltgc_output_file (FILE* fil, melt_ptr_t val_p)
+{
+  MELT_ENTERFRAME(4, NULL);
+#define valv        meltfram__.mcfr_varptr[0]
+#define compv       meltfram__.mcfr_varptr[1]
+#define pairv       meltfram__.mcfr_varptr[2]
+  valv = val_p;
+  if (!fil || !valv) goto end;
+  switch (melt_magic_discr((melt_ptr_t)valv)) {
+  case OBMAG_STRING:
+    melt_puts (fil, melt_string_str ((melt_ptr_t)valv));
+    break;
+  case OBMAG_STRBUF:
+    melt_puts (fil, melt_strbuf_str ((melt_ptr_t)valv));
+    break;
+  case OBMAG_INT:
+    fprintf (fil, "%ld", melt_get_int ((melt_ptr_t)valv));
+    break;
+  case OBMAG_LIST:
+    {
+      for (pairv = ((struct meltlist_st*)(valv))->first;
+	   pairv && melt_magic_discr((melt_ptr_t)pairv);
+	   pairv = ((struct meltpair_st*)(pairv))->tl)
+	{
+	  compv = ((struct meltpair_st*)(pairv))->hd;
+	  if (compv)
+	    meltgc_output_file (fil, (melt_ptr_t) compv);
+	  compv = NULL;
+	};
+      pairv = NULL;		/* for GC happiness */
+    }
+    break;
+  case OBMAG_MULTIPLE:
+    {
+      int sz = ((struct meltmultiple_st*)(valv))->nbval;
+      int ix = 0;
+      for (ix = 0; ix < sz; ix ++)
+	{
+	  compv = melt_multiple_nth ((melt_ptr_t)valv, ix);
+	  if (!compv) 
+	    continue;
+	  meltgc_output_file (fil, (melt_ptr_t) compv);
+	}
+    }
+    break;
+  default:
+    /* FIXME: perhaps add a warning, or handle more cases... */
+    ;
+  }
+ end:
+  MELT_EXITFRAME();
+#undef valv
+#undef compv
+#undef pairv
+}
+
 /* Added */
 #undef melt_assert_failed
 #undef melt_check_failed
@@ -11985,6 +12059,26 @@ end:
 #undef atclov
 }
 
+
+#if ENABLE_CHECKING
+/* two useless routines in wich we can add a breakpoint from gdb. */
+void 
+melt_sparebreakpoint_1_at (const char*fil, int lin, void*ptr, const char*msg) {
+  dbgprintf_raw ("@%s:%d: MELT sparebreakpoint_1 ptr=%p msg=%s\n",
+		fil, lin, ptr, msg);
+  melt_dbgshortbacktrace("melt_sparebreakpoint_1", 20);
+  debugeprintf ("melt_sparebreakpoint_1_at msg %s", msg);
+}
+
+void 
+melt_sparebreakpoint_2_at (const char*fil, int lin, void*ptr, const char*msg) {
+  dbgprintf_raw ("@%s:%d: MELT sparebreakpoint_2 ptr=%p msg=%s\n",
+		fil, lin, ptr, msg);
+  melt_dbgshortbacktrace("melt_sparebreakpoint_2", 20);
+  debugeprintf ("melt_sparebreakpoint_2_at msg %s", msg);
+}
+#endif /*ENABLE_CHECKING*/
+
 /* the file gt-melt-runtime.h is generated by gengtype from
    melt-runtime.c & melt-runtime.h */
 #include "gt-melt-runtime.h"