From fdfc542b12991e548085a886824225a4083c8cf5 Mon Sep 17 00:00:00 2001 From: bstarynk Date: Mon, 9 May 2016 14:38:59 +0000 Subject: 2016-05-06 Basile Starynkevitch {{very unstable; I had an heisenbug... -code crashing with ASLR, but nearly working without; The commit on 2016-05-03 commented as more stable as GCC5 plugin; but perhaps wrong with generate_runtypesupport_forwcopy_fun handle the unlikely case of young discriminant same as current object... etc is perhaps incorrect}} * melt-runtime.h: Add long comment about MELT_HAVE_DEBUG vs MELT_HAVE_RUNTIME_DEBUG and melt_flag_debug. Use more systematically MELT_HAVE_RUNTIME_DEBUG... (MELT_ENTERFRAME_AT): Test melt_flag_debug. The buffer for location is always needed. (MELT_TOUCHED_CACHE_SIZE): Raised slightly. (meltgc_touch): Introduce the touchgapwords constant. * melt-runtime.cc: Use more systematically MELT_HAVE_RUNTIME_DEBUG... (Melt_Module::Melt_Module): Copy dlerror() to some static buffer before showing it. (melt_compile_source, meltgc_readsexpr) (meltgc_readmacrostringsequence, meltgc_readval) (meltgc_read_from_rawstring, meltgc_read_from_val): Always have a curlocbuf.. (meltgc_run_cc_extension): Copy dlerror() to some static buffer before showing it. (meltgc_start_module_by_index,meltgc_load_flavored_module) (meltgc_start_flavored_module, meltgc_load_one_module) (meltgc_load_module_list, meltgc_load_modules_and_do_mode): Always have some locbuf. (melt_really_initialize): Copy dlerror() to some static buffer. (melt_fatal_info): call melt_dbgshortbacktrace on runtime or flagged debugging. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@236035 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ChangeLog.MELT | 36 ++++- gcc/melt-runtime.cc | 425 +++++++++++++++++++++++++--------------------------- gcc/melt-runtime.h | 231 ++++++++++++++++++---------- 3 files changed, 397 insertions(+), 295 deletions(-) diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT index 67cf6a78b2d..859ec683579 100644 --- a/gcc/ChangeLog.MELT +++ b/gcc/ChangeLog.MELT @@ -1,3 +1,37 @@ +2016-05-06 Basile Starynkevitch + {{very unstable; I had an heisenbug... -code crashing with ASLR, + but nearly working without; The commit on 2016-05-03 commented as + more stable as GCC5 plugin; but perhaps wrong with + generate_runtypesupport_forwcopy_fun handle the unlikely case of + young discriminant same as current object... etc is perhaps + incorrect}} + * melt-runtime.h: Add long comment about MELT_HAVE_DEBUG vs + MELT_HAVE_RUNTIME_DEBUG and melt_flag_debug. Use more + systematically MELT_HAVE_RUNTIME_DEBUG... + (MELT_ENTERFRAME_AT): Test melt_flag_debug. The buffer for + location is always needed. + (MELT_TOUCHED_CACHE_SIZE): Raised slightly. + (meltgc_touch): Introduce the touchgapwords constant. + + * melt-runtime.cc: Use more systematically + MELT_HAVE_RUNTIME_DEBUG... + + (Melt_Module::Melt_Module): Copy dlerror() to some static buffer + before showing it. + (melt_compile_source, meltgc_readsexpr) + (meltgc_readmacrostringsequence, meltgc_readval) + (meltgc_read_from_rawstring, meltgc_read_from_val): Always have a + curlocbuf.. + (meltgc_run_cc_extension): Copy dlerror() to some static buffer + before showing it. + (meltgc_start_module_by_index,meltgc_load_flavored_module) + (meltgc_start_flavored_module, meltgc_load_one_module) + (meltgc_load_module_list, meltgc_load_modules_and_do_mode): Always + have some locbuf. + (melt_really_initialize): Copy dlerror() to some static buffer. + (melt_fatal_info): call melt_dbgshortbacktrace on runtime or + flagged debugging. + 2016-05-06 Basile Starynkevitch * melt/generated/*: Regenerated all. @@ -126,7 +160,7 @@ * melt-runtime.h (MELT_VERSION_STRING): Bump to 1.3.rc1 2016-05-03 Basile Starynkevitch - {{more stable as GCC5 plugin}} + {{more stable as GCC5 plugin; but perhaps wrong}} * melt/warmelt-modes.melt (generate_runtypesupport_forwcopy_fun) In the generated melt_forwarded_copy handle the unlikely case of young discriminant same as current object... diff --git a/gcc/melt-runtime.cc b/gcc/melt-runtime.cc index e3751c790ee..2d38417504e 100644 --- a/gcc/melt-runtime.cc +++ b/gcc/melt-runtime.cc @@ -49,7 +49,7 @@ const int melt_is_plugin = 0; #error MELT Gcc version and GCC plugin version does not match #if GCCPLUGIN_VERSION==5005 /** See e.g. https://lists.debian.org/debian-gcc/2015/07/msg00167.html - and https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=793478 + and https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=793478 or the bug report https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66991 which is a wrong report, since specific to Debian. **/ @@ -494,7 +494,13 @@ Melt_Module::Melt_Module (unsigned magic, const char*modpath, const char* descrb errno = 0; dlh = dlopen (_mm_modpath.c_str(), RTLD_NOW | RTLD_GLOBAL); if (!dlh) - melt_fatal_error ("failed to dlopen Melt module %s - %s", _mm_modpath.c_str(), dlerror()); + { + static char dldup[256]; + const char*dle = dlerror(); + if (!dle) dle = "??"; + strncpy (dldup, dle, sizeof(dldup)-1); + melt_fatal_error ("failed to dlopen Melt module %s - %s", _mm_modpath.c_str(), dldup); + } } _mm_dlh = dlh; _mm_index = ix; @@ -532,10 +538,10 @@ Melt_Module::~Melt_Module() Melt_CallProtoFrame* melt_top_call_frame =NULL; -#if MELT_HAVE_DEBUG > 0 +#if MELT_HAVE_RUNTIME_DEBUG > 0 FILE* Melt_CallProtoFrame::_dbgcall_file_ = NULL; long Melt_CallProtoFrame::_dbgcall_count_ = 0L; -#endif /*MELT_HAVE_DEBUG*/ +#endif /*MELT_HAVE_RUNTIME_DEBUG*/ /* The start routine of every MELT extension (dynamically loaded shared object to evaluate at runtime some expressions in a given @@ -739,7 +745,7 @@ melt_intern_cstring (const char* s) } /*****************************************************************/ -#if MELT_HAVE_DEBUG +#if MELT_HAVE_RUNTIME_DEBUG > 0 void melt_break_alptr_1_at (const char*msg, const char* fil, int line); void melt_break_alptr_2_at (const char*msg, const char* fil, int line); @@ -1145,7 +1151,7 @@ static void melt_scanning (melt_ptr_t); -#if MELT_HAVE_DEBUG +#if MELT_HAVE_RUNTIME_DEBUG > 0 /*** * check our call frames ***/ @@ -1190,7 +1196,7 @@ melt_cbreak_at (const char *msg, const char *fil, int lin) gcc_assert (nbcbreak>0); // useless, but you can put a GDB breakpoint here } -#endif /*MELT_HAVE_DEBUG*/ +#endif /*MELT_HAVE_RUNTIME_DEBUG*/ /* make a special value; return NULL if the discriminant is not special */ @@ -1209,7 +1215,7 @@ meltgc_make_special (melt_ptr_t discr_p) magic = ((meltobject_ptr_t)discrv)->meltobj_magic; switch (magic) { - /* our new special data */ + /* our new special data */ case MELTOBMAG_SPECIAL_DATA: { specv = (melt_ptr_t) meltgc_allocate (sizeof(struct meltspecialdata_st), 0); @@ -1551,7 +1557,7 @@ melt_ggcstart_callback (void *gcc_data ATTRIBUTE_UNUSED, { if (melt_prohibit_garbcoll) melt_fatal_error ("MELT minor garbage collection prohibited from GGC start callback (with %ld young Kilobytes)", - (((char *) melt_curalz - (char *) melt_startalz))>>10); + (((char *) melt_curalz - (char *) melt_startalz))>>10); melt_debuggc_eprintf ("melt_ggcstart_callback need a minor copying GC with %ld young Kilobytes\n", (((char *) melt_curalz - (char *) melt_startalz))>>10); @@ -1666,7 +1672,7 @@ melt_garbcoll (size_t wanted, enum melt_gckind_en gckd) const char* needfullreason = NULL; if (melt_prohibit_garbcoll) melt_fatal_error ("MELT garbage collection prohibited (wanted %ld)", - (long)wanted); + (long)wanted); gcc_assert (melt_scangcvect == NULL); melt_nb_garbcoll++; if (gckd == MELT_NEED_FULL) @@ -3432,13 +3438,14 @@ meltgc_new_list_from_pair (meltobject_ptr_t discr_p, melt_ptr_t pair_p) goto end; if (object_discrv->meltobj_magic != MELTOBMAG_LIST) goto end; - if (melt_magic_discr((melt_ptr_t) pairv) == MELTOBMAG_PAIR) { - firstpairv = pairv; - lastpairv = firstpairv; - while (melt_magic_discr((melt_ptr_t) lastpairv) == MELTOBMAG_PAIR - && (((struct meltpair_st *)lastpairv)->tl) != NULL) - lastpairv = (melt_ptr_t)(((struct meltpair_st *)lastpairv)->tl); - } + if (melt_magic_discr((melt_ptr_t) pairv) == MELTOBMAG_PAIR) + { + firstpairv = pairv; + lastpairv = firstpairv; + while (melt_magic_discr((melt_ptr_t) lastpairv) == MELTOBMAG_PAIR + && (((struct meltpair_st *)lastpairv)->tl) != NULL) + lastpairv = (melt_ptr_t)(((struct meltpair_st *)lastpairv)->tl); + } newlist = (melt_ptr_t) meltgc_allocate (sizeof (struct meltlist_st), 0); list_newlist->discr = object_discrv; list_newlist->first = (struct meltpair_st*)firstpairv; @@ -5843,10 +5850,8 @@ melt_compile_source (const char *srcbase, const char *binbase, const char*workdi const char* ourmakefile = NULL; const char* ourcflags = NULL; const char* mycwd = NULL; -#if MELT_HAVE_DEBUG char curlocbuf[250]; curlocbuf[0] = 0; -#endif /* we want a MELT frame for MELT_LOCATION here */ MELT_ENTEREMPTYFRAME(NULL); mycwd = getpwd (); @@ -5859,15 +5864,15 @@ melt_compile_source (const char *srcbase, const char *binbase, const char*workdi MELT_LOCATION_HERE_PRINTF (curlocbuf, "melt_compile_source srcbase %s binbase %s flavor %s", srcbase?(srcbase[0]?srcbase:"*empty*"):"*null*", - binbase?(binbase[0]?binbase:"*empty*"):"*null*", - flavor?(flavor[0]?flavor:"*empty*"):"*null*"); + binbase?(binbase[0]?binbase:"*empty*"):"*null*", + flavor?(flavor[0]?flavor:"*empty*"):"*null*"); if (getenv ("IFS")) /* Having an IFS is a huge security risk for shells. */ melt_fatal_error ("MELT cannot compile source base %s of flavor %s with an $IFS (probable security risk)", srcbase, flavor); if (!srcbase || !srcbase[0]) - { + { melt_fatal_error ("no source base given to compile for MELT (%p)", srcbase); } @@ -6829,10 +6834,8 @@ meltgc_readsexpr (struct melt_reading_st *rd, int endc) { int lineno = rd->rlineno; location_t loc = 0; -#if MELT_HAVE_DEBUG char curlocbuf[100]; curlocbuf[0] = 0; -#endif MELT_ENTERFRAME (3, NULL); #define sexprv meltfram__.mcfr_varptr[0] #define contv meltfram__.mcfr_varptr[1] @@ -7211,10 +7214,8 @@ meltgc_readmacrostringsequence (struct melt_reading_st *rd) int escaped = 0; int quoted = 0; location_t loc = 0; -#if MELT_HAVE_DEBUG char curlocbuf[100]; curlocbuf[0] = 0; -#endif MELT_ENTERFRAME (8, NULL); #define readv meltfram__.mcfr_varptr[0] #define strv meltfram__.mcfr_varptr[1] @@ -7288,135 +7289,137 @@ meltgc_readmacrostringsequence (struct melt_reading_st *rd) if (rdcurc()=='}' && rdfollowc(1)=='#') { - melt_macrostring_flush_sbufv (); - rdnext (); - rdnext (); + melt_macrostring_flush_sbufv (); + rdnext (); + rdnext (); - break; - } + break; + } else if (rdcurc()=='$') { - /* $ followed by letters or underscore makes a symbol */ - if (ISALPHA(rdfollowc(1)) || rdfollowc(1)=='_') - { - int lnam = 1; - char tinybuf[80]; - memset(tinybuf, 0, sizeof(tinybuf)); - melt_macrostring_flush_sbufv (); - symbv = NULL; - gcc_assert(sizeof(tinybuf)-1 >= sizeof(MELT_MAGICSYMB_FILE)); - gcc_assert(sizeof(tinybuf)-1 >= sizeof(MELT_MAGICSYMB_LINE)); - while (ISALNUM(rdfollowc(lnam)) || rdfollowc(lnam) == '_') - lnam++; - if (lnam< (int)sizeof(tinybuf)-2) - { - memcpy(tinybuf, &rdfollowc(1), lnam-1); - for (int ix=0; ixrpfilnam)?(*rd->rpfilnam):MELT_PREDEF(UNKNOWN_LOCATION); - else if (!strcmp(tinybuf, MELT_MAGICSYMB_LINE)) - symbv = meltgc_new_int((meltobject_ptr_t) MELT_PREDEF(DISCR_INTEGER), - rd->rlineno); - }; - if (MELT_LIKELY(!symbv)) { - if (quoted) - MELT_READ_WARNING ("quoted macro string with $%s symbol", tinybuf); - symbv = melthookproc_HOOK_NAMED_SYMBOL(tinybuf, (long) MELT_CREATE); - } - } - else - { - char *nambuf = (char*) xcalloc(lnam+2, 1); - memcpy(nambuf, &rdfollowc(1), lnam-1); - nambuf[lnam] = (char)0; - symbv = melthookproc_HOOK_NAMED_SYMBOL(nambuf, (long) MELT_CREATE); - if (quoted) - MELT_READ_WARNING ("quoted macro string with $%s symbol", nambuf); - free(nambuf); - } - rd->rcol += lnam; - /* skip the hash # if just after the symbol */ - if (rdcurc() == '#') - rdnext(); - /* append the symbol */ - meltgc_append_list ((melt_ptr_t) seqv, (melt_ptr_t) symbv);; - melt_dbgread_value ("readmacrostringsequence symbv=", symbv); - symbv = NULL; - } - /* $. is silently skipped */ - else if (rdfollowc(1) == '.') - { - escaped = 1; - rdnext(); - rdnext(); - } - /* $$ is handled as a single dollar $ */ - else if (rdfollowc(1) == '$') - { - if (!sbufv) - sbufv = (melt_ptr_t) meltgc_new_strbuf((meltobject_ptr_t) MELT_PREDEF(DISCR_STRBUF), (char*)0); - meltgc_add_strbuf_raw_len((melt_ptr_t)sbufv, "$", 1); - rdnext(); - rdnext(); - } - /* $# is handled as a single hash # */ - else if (rdfollowc(1) == '#') - { - escaped = 1; - if (!sbufv) - sbufv = (melt_ptr_t) meltgc_new_strbuf((meltobject_ptr_t) MELT_PREDEF(DISCR_STRBUF), (char*)0); - meltgc_add_strbuf_raw_len((melt_ptr_t)sbufv, "#", 1); - rdnext(); - rdnext(); - } - /* $(some s-expr) is acceptable to embed a single s-expression */ - else if (rdfollowc(1) == '(') - { - melt_macrostring_flush_sbufv (); - rdnext (); - rdnext (); - compv = meltgc_readsexpr (rd, ')'); - melt_dbgread_value ("readmacrostringsequence sexpr compv=", compv); - /* append the s-expr */ - meltgc_append_list((melt_ptr_t) seqv, (melt_ptr_t) compv); - compv = NULL; - } - /* $[several sub-expr] is acceptable to embed a sequence of s-expressions */ - else if (rdfollowc(1) == '[') - { - melt_macrostring_flush_sbufv (); - rdnext (); - rdnext (); - subseqv = meltgc_readseqlist(rd, ']'); - if (melt_magic_discr ((melt_ptr_t)subseqv) == MELTOBMAG_LIST) - { - compv = NULL; - for (pairv = (melt_ptr_t) ((struct meltlist_st*)(subseqv))->first; - pairv && melt_magic_discr((melt_ptr_t)pairv) == MELTOBMAG_PAIR; - pairv = (melt_ptr_t) ((struct meltpair_st*)(pairv))->tl) - { - compv = (melt_ptr_t) ((struct meltpair_st*)(pairv))->hd; - if (compv) - { - meltgc_append_list ((melt_ptr_t) seqv, (melt_ptr_t) compv); - melt_dbgread_value ("readmacrostringsequence sexpr compv=", compv); - } - } - pairv = NULL; - compv = NULL; - } - } - /* any other dollar something is an error */ - else MELT_READ_FAILURE("unexpected dollar escape in macrostring %.4s started line %d", - &rdcurc(), lineno); - } + /* $ followed by letters or underscore makes a symbol */ + if (ISALPHA(rdfollowc(1)) || rdfollowc(1)=='_') + { + int lnam = 1; + char tinybuf[80]; + memset(tinybuf, 0, sizeof(tinybuf)); + melt_macrostring_flush_sbufv (); + symbv = NULL; + gcc_assert(sizeof(tinybuf)-1 >= sizeof(MELT_MAGICSYMB_FILE)); + gcc_assert(sizeof(tinybuf)-1 >= sizeof(MELT_MAGICSYMB_LINE)); + while (ISALNUM(rdfollowc(lnam)) || rdfollowc(lnam) == '_') + lnam++; + if (lnam< (int)sizeof(tinybuf)-2) + { + memcpy(tinybuf, &rdfollowc(1), lnam-1); + for (int ix=0; ixrpfilnam)?(*rd->rpfilnam):MELT_PREDEF(UNKNOWN_LOCATION); + else if (!strcmp(tinybuf, MELT_MAGICSYMB_LINE)) + symbv = meltgc_new_int((meltobject_ptr_t) MELT_PREDEF(DISCR_INTEGER), + rd->rlineno); + }; + if (MELT_LIKELY(!symbv)) + { + if (quoted) + MELT_READ_WARNING ("quoted macro string with $%s symbol", tinybuf); + symbv = melthookproc_HOOK_NAMED_SYMBOL(tinybuf, (long) MELT_CREATE); + } + } + else + { + char *nambuf = (char*) xcalloc(lnam+2, 1); + memcpy(nambuf, &rdfollowc(1), lnam-1); + nambuf[lnam] = (char)0; + symbv = melthookproc_HOOK_NAMED_SYMBOL(nambuf, (long) MELT_CREATE); + if (quoted) + MELT_READ_WARNING ("quoted macro string with $%s symbol", nambuf); + free(nambuf); + } + rd->rcol += lnam; + /* skip the hash # if just after the symbol */ + if (rdcurc() == '#') + rdnext(); + /* append the symbol */ + meltgc_append_list ((melt_ptr_t) seqv, (melt_ptr_t) symbv);; + melt_dbgread_value ("readmacrostringsequence symbv=", symbv); + symbv = NULL; + } + /* $. is silently skipped */ + else if (rdfollowc(1) == '.') + { + escaped = 1; + rdnext(); + rdnext(); + } + /* $$ is handled as a single dollar $ */ + else if (rdfollowc(1) == '$') + { + if (!sbufv) + sbufv = (melt_ptr_t) meltgc_new_strbuf((meltobject_ptr_t) MELT_PREDEF(DISCR_STRBUF), (char*)0); + meltgc_add_strbuf_raw_len((melt_ptr_t)sbufv, "$", 1); + rdnext(); + rdnext(); + } + /* $# is handled as a single hash # */ + else if (rdfollowc(1) == '#') + { + escaped = 1; + if (!sbufv) + sbufv = (melt_ptr_t) meltgc_new_strbuf((meltobject_ptr_t) MELT_PREDEF(DISCR_STRBUF), (char*)0); + meltgc_add_strbuf_raw_len((melt_ptr_t)sbufv, "#", 1); + rdnext(); + rdnext(); + } + /* $(some s-expr) is acceptable to embed a single s-expression */ + else if (rdfollowc(1) == '(') + { + melt_macrostring_flush_sbufv (); + rdnext (); + rdnext (); + compv = meltgc_readsexpr (rd, ')'); + melt_dbgread_value ("readmacrostringsequence sexpr compv=", compv); + /* append the s-expr */ + meltgc_append_list((melt_ptr_t) seqv, (melt_ptr_t) compv); + compv = NULL; + } + /* $[several sub-expr] is acceptable to embed a sequence of s-expressions */ + else if (rdfollowc(1) == '[') + { + melt_macrostring_flush_sbufv (); + rdnext (); + rdnext (); + subseqv = meltgc_readseqlist(rd, ']'); + if (melt_magic_discr ((melt_ptr_t)subseqv) == MELTOBMAG_LIST) + { + compv = NULL; + for (pairv = (melt_ptr_t) ((struct meltlist_st*)(subseqv))->first; + pairv && melt_magic_discr((melt_ptr_t)pairv) == MELTOBMAG_PAIR; + pairv = (melt_ptr_t) ((struct meltpair_st*)(pairv))->tl) + { + compv = (melt_ptr_t) ((struct meltpair_st*)(pairv))->hd; + if (compv) + { + meltgc_append_list ((melt_ptr_t) seqv, (melt_ptr_t) compv); + melt_dbgread_value ("readmacrostringsequence sexpr compv=", compv); + } + } + pairv = NULL; + compv = NULL; + } + } + /* any other dollar something is an error */ + else MELT_READ_FAILURE("unexpected dollar escape in macrostring %.4s started line %d", + &rdcurc(), lineno); + } else if ( ISALNUM(rdcurc()) || ISSPACE(rdcurc()) ) { /* handle efficiently the common case of alphanum and spaces */ @@ -7646,10 +7649,8 @@ meltgc_readval (struct melt_reading_st *rd, bool * pgot) char *nam = 0; int lineno = rd->rlineno; location_t loc = 0; -#if MELT_HAVE_DEBUG char curlocbuf[120]; curlocbuf[0] = 0; -#endif MELT_ENTERFRAME (4, NULL); #define readv meltfram__.mcfr_varptr[0] #define compv meltfram__.mcfr_varptr[1] @@ -7900,15 +7901,16 @@ meltgc_readval (struct melt_reading_st *rd, bool * pgot) // handle the magic symbols _MELT_FILE_ and _MELT_LINE_ to // expand them to the file name and the line number respectively // at read time! - if (MELT_UNLIKELY(((nam[0]=='_') && (nam[1]=='M' || nam[1]=='M')))) { - if (!strcasecmp(nam, MELT_MAGICSYMB_FILE)) - readv = (*rd->rpfilnam)?(*rd->rpfilnam):MELT_PREDEF(UNKNOWN_LOCATION); - else if (!strcasecmp(nam, MELT_MAGICSYMB_LINE)) - readv = meltgc_new_int((meltobject_ptr_t) MELT_PREDEF(DISCR_INTEGER), - rd->rlineno); - } + if (MELT_UNLIKELY(((nam[0]=='_') && (nam[1]=='M' || nam[1]=='M')))) + { + if (!strcasecmp(nam, MELT_MAGICSYMB_FILE)) + readv = (*rd->rpfilnam)?(*rd->rpfilnam):MELT_PREDEF(UNKNOWN_LOCATION); + else if (!strcasecmp(nam, MELT_MAGICSYMB_LINE)) + readv = meltgc_new_int((meltobject_ptr_t) MELT_PREDEF(DISCR_INTEGER), + rd->rlineno); + } if (!readv) - readv = melthookproc_HOOK_NAMED_SYMBOL (nam, (long) MELT_CREATE); + readv = melthookproc_HOOK_NAMED_SYMBOL (nam, (long) MELT_CREATE); melt_dbgread_value ("readval symbol readv=", readv); *pgot = TRUE; goto end; @@ -8299,9 +8301,8 @@ melt_inform_str (melt_ptr_t mixloc_p, const char *msg, melt_ptr_t meltgc_read_file (const char *filnam, const char *locnam) { -#if MELT_HAVE_DEBUG char curlocbuf[140]; -#endif + memset (curlocbuf, 0, sizeof(curlocbuf)); struct melt_reading_st rds; FILE *fil = NULL; struct melt_reading_st *rd = NULL; @@ -8449,9 +8450,8 @@ melt_ptr_t meltgc_read_from_rawstring (const char *rawstr, const char *locnam, location_t loch) { -#if MELT_HAVE_DEBUG char curlocbuf[140]; -#endif + memset (curlocbuf, 0, sizeof(curlocbuf)); struct melt_reading_st rds; char *rbuf = 0; struct melt_reading_st *rd = 0; @@ -8525,9 +8525,8 @@ melt_ptr_t meltgc_read_from_val (melt_ptr_t strv_p, melt_ptr_t locnam_p) { static long parsecount; -#if MELT_HAVE_DEBUG char curlocbuf[140]; -#endif + memset (curlocbuf, 0, sizeof(curlocbuf)); struct melt_reading_st rds; char *rbuf = 0; struct melt_reading_st *rd = 0; @@ -9114,7 +9113,13 @@ melt_load_module_index (const char*srcbase, const char*flavor, char**errorp) errno = 0; dlh = dlopen (sopath, RTLD_NOW | RTLD_GLOBAL); if (!dlh) - melt_fatal_error ("Failed to dlopen MELT module %s - %s", sopath, dlerror ()); + { + static char dldup[256]; + const char* dle = dlerror(); + if (!dle) dle = "??"; + strncpy(dldup, dle, sizeof(dldup)-1); + melt_fatal_error ("Failed to dlopen MELT module %s - %s", sopath, dldup); + } if (melt_trace_module_fil) fprintf (melt_trace_module_fil, "dlopened %s #%d\n", sopath, Melt_Module::nb_modules()); @@ -9508,8 +9513,14 @@ meltgc_run_cc_extension (melt_ptr_t basename_p, melt_ptr_t env_p, melt_ptr_t lit debugeprintf("meltgc_run_cc_extension sopath %s before dlopen", sopath); dlh = dlopen (sopath, RTLD_NOW | RTLD_GLOBAL); if (!dlh) - melt_fatal_error ("failed to dlopen runtime extension %s - %s", - sopath, dlerror ()); + { + static char dldup[256]; + const char*dle = dlerror(); + if (!dle) dle = "??"; + strncpy(dldup, dle, sizeof(dldup)-1); + melt_fatal_error ("failed to dlopen runtime extension %s - %s", + sopath, dldup); + } MELT_LOCATION_HERE ("meltgc_run_cc_extension after dlopen"); @@ -9595,9 +9606,8 @@ end: melt_ptr_t meltgc_start_module_by_index (melt_ptr_t env_p, int modix) { -#if MELT_HAVE_DEBUG char locbuf[200]; -#endif + memset (locbuf, 0, sizeof(locbuf)); MELT_ENTERFRAME(2, NULL); #define resmodv meltfram__.mcfr_varptr[0] #define env meltfram__.mcfr_varptr[1] @@ -9692,14 +9702,10 @@ meltgc_load_flavored_module (const char*modulbase, const char*flavor) char* descrfull = NULL; char* tempdirpath = melt_tempdir_path(NULL, NULL); int modix = 0; -#if MELT_HAVE_DEBUG /* The location buffer is local, since this function may recurse! */ - char curlocbuf[220]; -#endif + char curlocbuf[160]; MELT_ENTEREMPTYFRAME (NULL); -#if MELT_HAVE_DEBUG memset (curlocbuf, 0, sizeof (curlocbuf)); -#endif debugeprintf("meltgc_load_flavored_module start base %s flavor %s tempdirpath %s", modulbase, flavor, tempdirpath); if (!modulbase || !modulbase[0]) @@ -9803,15 +9809,11 @@ meltgc_start_flavored_module (melt_ptr_t env_p, const char*modulbase, const char int modix = -1; char modulbuf[80]; char flavorbuf[32]; -#if MELT_HAVE_DEBUG /* The location buffer is local, since this function may recurse! */ - char curlocbuf[220]; -#endif + char curlocbuf[200]; MELT_ENTERFRAME(1, NULL); #define env meltfram__.mcfr_varptr[0] -#if MELT_HAVE_DEBUG memset (curlocbuf, 0, sizeof (curlocbuf)); -#endif env = env_p; memset (modulbuf, 0, sizeof(modulbuf)); memset (flavorbuf, 0, sizeof(flavorbuf)); @@ -9882,14 +9884,10 @@ meltgc_load_one_module (const char*flavoredmodule) char* dupflavmod = NULL; char* dotptr = NULL; char* flavor = NULL; -#if MELT_HAVE_DEBUG /* The location buffer is local, since this function may recurse! */ - char curlocbuf[220]; -#endif - MELT_ENTEREMPTYFRAME (NULL); -#if MELT_HAVE_DEBUG + char curlocbuf[200]; memset (curlocbuf, 0, sizeof (curlocbuf)); -#endif + MELT_ENTEREMPTYFRAME (NULL); if (!flavoredmodule) goto end; memset (tinybuf, 0, sizeof(tinybuf)); @@ -9941,14 +9939,10 @@ meltgc_load_module_list (int depth, const char *modlistbase) int modlistbaselen = 0; int lincnt = 0; const char* srcpathstr = melt_argument ("source-path"); -#if MELT_HAVE_DEBUG /* The location buffer is local, since this function recurses! */ - char curlocbuf[220]; -#endif - MELT_ENTEREMPTYFRAME (NULL); -#if MELT_HAVE_DEBUG + char curlocbuf[200]; memset (curlocbuf, 0, sizeof (curlocbuf)); -#endif + MELT_ENTEREMPTYFRAME (NULL); debugeprintf("meltgc_load_module_list start modlistbase %s depth %d", modlistbase, depth); MELT_LOCATION_HERE_PRINTF (curlocbuf, @@ -10106,9 +10100,8 @@ meltgc_load_modules_and_do_mode (void) const char* xtrastr = NULL; char *dupmodpath = NULL; int lastmodix = 0; -#if MELT_HAVE_DEBUG - char locbuf[240]; -#endif + char locbuf[200]; + memset(locbuf, 0, sizeof(locbuf)); MELT_ENTERFRAME(1, NULL); #define modatv meltfram__.mcfr_varptr[0] inistr = melt_argument ("init"); @@ -10136,9 +10129,6 @@ meltgc_load_modules_and_do_mode (void) curmod = dupmodpath; while (curmod && curmod[0]) { -#if MELT_HAVE_DEBUG - char locbuf[250]; -#endif nextmod = strchr (curmod, ':'); if (nextmod) { @@ -10719,16 +10709,14 @@ melt_really_initialize (const char* pluginame, const char*versionstr) proghandle = dlopen (NULL, RTLD_NOW | RTLD_GLOBAL); if (!proghandle) { + const char*dle = dlerror(); + if (!dle) dle="??"; + static char dlbuf[256]; + strncpy(dlbuf, dle, sizeof(dlbuf)-1); /* Don't call melt_fatal_error - we are initializing! */ -#if GCCPLUGIN_VERSION >= 5000 /* GCC 5.0 */ fatal_error (UNKNOWN_LOCATION, "MELT failed to get whole program handle - %s", - dlerror ()); -#else - /* Don't call melt_fatal_error - we are initializing! */ - fatal_error ("MELT failed to get whole program handle - %s", - dlerror ()); -#endif /* GCC 5.0 */ + dlbuf); } if (countdbgstr != (char *) 0) @@ -11783,7 +11771,7 @@ meltgc_ppout_gimple_seq (melt_ptr_t out_p, int indentsp, outmagic = melt_magic_discr ((melt_ptr_t) outv); switch (outmagic) { - // Nota Bene: passing TDF_VOPS give a crash from an IPA pass like justcount + // Nota Bene: passing TDF_VOPS give a crash from an IPA pass like justcount case MELTOBMAG_STRBUF: { FILE* oldfil = melt_open_ppfile (); @@ -11941,7 +11929,7 @@ meltgc_out_edge (melt_ptr_t out_p, edge edg) if (!f) goto end; dump_edge_info (f, edg, - TDF_DETAILS, + TDF_DETAILS, /*do_succ=*/ 1); fflush (f); } @@ -12598,9 +12586,8 @@ melt_fatal_info (const char*filename, int lineno) "MELT failed with work directory %s", workdir); } fflush (NULL); -#if MELT_HAVE_DEBUG - melt_dbgshortbacktrace ("MELT fatal failure", 100); -#endif + if (MELT_HAVE_RUNTIME_DEBUG > 0 || melt_flag_debug > 0) + melt_dbgshortbacktrace ("MELT fatal failure", 100); /* Index 0 is unused in melt_modulinfo. */ for (ix = 1; ix <= Melt_Module::nb_modules(); ix++) { @@ -13318,7 +13305,7 @@ void melt_gt_ggc_mx_gimple_seq_d(void*p) #endif /* GCC 6, 5 or less */ -///////////////// always at end of file +///////////////// always at end of file /* For debugging purposes, used thru gdb. */ // for some reason, I need to always declare these, so before any include; // this might be a dirty hack... @@ -13327,9 +13314,9 @@ void melt_gt_ggc_mx_gimple_seq_d(void*p) #undef melt_objhash_1 #undef melt_objhash_2 extern "C" { -void *melt_alptr_1=(void*)0; -void *melt_alptr_2=(void*)0; -unsigned melt_objhash_1=0; -unsigned melt_objhash_2=0; -}; + void *melt_alptr_1=(void*)0; + void *melt_alptr_2=(void*)0; + unsigned melt_objhash_1=0; + unsigned melt_objhash_2=0; +} /* eof $Id$ */ diff --git a/gcc/melt-runtime.h b/gcc/melt-runtime.h index e506efd00a0..66f8e916c21 100644 --- a/gcc/melt-runtime.h +++ b/gcc/melt-runtime.h @@ -42,7 +42,10 @@ along with GCC; see the file COPYING3. If not see #include "diagnostic-core.h" // optimize is defined in gcc/options.h of the build tree, we might need to access it, but we could use it as an attribute, so... -static inline int melt_gcc_optimize (void) { return optimize; } +static inline int melt_gcc_optimize (void) +{ + return optimize; +} #undef optimize /* it is defined in gcc/options.h in build tree */ #if __GNUC__ >= 4 @@ -181,26 +184,70 @@ extern const int melt_is_plugin; #define MELT_DYNLOADED_SUFFIX ".so" #endif /*MELT_DYNLOADED_SUFFIX */ +/*** + ABOUT DEBUGGING FLAGS. + ====================== + +We have two preprocessor debugging flags. The MELT_HAVE_DEBUG flag is +related to debugging MELT code. The MELT_HAVE_RUNTIME_DEBUG flag is +related to debugging the MELT runtime (e.g. the melt.so plugin) coded +in C++, mostly in melt-runtime.h, melt-runtime.c, +melt/generated/meltrunsup.h & melt/generated/meltrunsup-inc.cc +files. Both flags are possibly passed to g++ when compiling C++ code. + +There is only one single runtime binary (e.g. melt.so or +melt-runtime.o in the MELT branch) which is the same and should be +usable both with debugged and optimized flavors of C++ emitted code +from MELT source files. + +MELT_HAVE_DEBUG is about enabling (at C++ compile time of the +generated C++ code) debugging of MELT generated C++ code. It is +relevant for the (assert_msg ...) and (debug ...) MELT builtin macros, +which are extensively used in MELT code. So the MELT_HAVE_DEBUG flag is +relevant to every MELT user. + +The MELT_HAVE_RUNTIME_DEBUG flag is for debugging the MELT runtime. It is +rarely used (mostly by MELT implementors, i.e. me, Basile +Starynkevitch), and will slow down the runtime significantly. + +Both MELT_HAVE_DEBUG & MELT_HAVE_RUNTIME_DEBUG are always defined as +some preprocessor integer literal, before the end of this header. They +are usually disabled by setting them to 0 (which is the default +value). They can be enabled by setting them to 1 (or some other +positive integer). + +The melt_flag_debug is a runtime variable which is positive when asked +for debugging output. + + ***/ + + + #if GCCPLUGIN_VERSION < 6000 /*GCC 5*/ #if defined(ENABLE_CHECKING) -#define MELT_HAVE_DEBUG 1 -#else -#ifndef MELT_HAVE_DEBUG -#define MELT_HAVE_DEBUG 0 -#endif /* undef MELT_HAVE_DEBUG */ +#ifndef MELT_HAVE_RUNTIME_DEBUG +#define MELT_HAVE_RUNTIME_DEBUG 1 +#endif #endif /*ENABLE_CHECKING */ #else /* GCC 6 */ #if CHECKING_P -#undef MELT_HAVE_DEBUG -#define MELT_HAVE_DEBUG 1 +#ifndef MELT_HAVE_RUNTIME_DEBUG +#define MELT_HAVE_RUNTIME_DEBUG 1 +#endif #endif /*CHECKING_P*/ #endif /* GCC 5 or 6.0 */ +// default value for MELT code debugging is disabled #ifndef MELT_HAVE_DEBUG #define MELT_HAVE_DEBUG 0 #endif /*MELT_HAVE_DEBUG*/ +// default value for MELT-runtime debugging is disabled +#ifndef MELT_HAVE_RUNTIME_DEBUG +#define MELT_HAVE_RUNTIME_DEBUG 0 +#endif /*MELT_HAVE_RUNTIME_DEBUG*/ + extern long melt_dbgcounter; extern long melt_debugskipcount; extern long melt_error_counter; @@ -241,7 +288,7 @@ long melt_cpu_time_millisec (void); void melt_set_real_timer_millisec (long millisec); -#if MELT_HAVE_DEBUG > 0 && ENABLE_GC_CHECKING +#if MELT_HAVE_RUNTIME_DEBUG > 0 && ENABLE_GC_CHECKING /* memory is poisoned by an 0xa5a5a5a5a5a5a5a5... pointer in ggc-zone.c or ggc-page.c */ #if SIZEOF_VOID_P == 8 #define MELT_POISON_POINTER (void*)0xa5a5a5a5a5a5a5a5 @@ -250,7 +297,7 @@ void melt_set_real_timer_millisec (long millisec); #else #error cannot set MELT_POISON_POINTER #endif -#endif /*MELT_HAVE_DEBUG > 0 && ENABLE_GC_CHECKING*/ +#endif /*MELT_HAVE_RUNTIME_DEBUG > 0 && ENABLE_GC_CHECKING*/ /* the MELT debug depth for debug_msg ... can be set with -fmelt-debug-depth= */ MELT_EXTERN int melt_debug_depth(void); @@ -260,7 +307,7 @@ extern "C" int melt_flag_bootstrapping; - +//////////////////////////////////////////////////////////////// #if MELT_HAVE_DEBUG > 0 #define debugeprintf_raw(Fmt,...) do{if (melt_flag_debug) \ @@ -309,7 +356,7 @@ extern "C" int melt_flag_bootstrapping; #else /* !MELT_HAVE_DEBUG*/ -#define debugeprintf_raw(Fmt,...) do{if (0) \ +#define debugeprintf_raw(Fmt,...) do{if (false) \ {fprintf(stderr, Fmt, ##__VA_ARGS__); fflush(stderr);}}while(0) /* The usual debugging macro. */ #define debugeprintf(Fmt,...) debugeprintfline(__LINE__,Fmt,##__VA_ARGS__) @@ -325,13 +372,13 @@ extern "C" int melt_flag_bootstrapping; #define debugeprintfnonl(Fmt,...) \ debugeprintflinenonl(__LINE__, Fmt, ##__VA_ARGS__) -#define debugeprintvalue(Msg,Val) do{if (0){ \ +#define debugeprintvalue(Msg,Val) do{if (false) { \ void* __val = (Val); \ fprintf(stderr,"!@%s:%d:\n@! %s @%p= ", \ melt_basename(__FILE__), __LINE__, (Msg), __val); \ melt_dbgeprint(__val); }} while(0) -#define debugebacktrace(Msg,Depth) do{if (0){ \ +#define debugebacktrace(Msg,Depth) do{if (false) { \ void* __val = (Val); \ fprintf(stderr,"!@%s:%d: %s **backtrace** ", \ melt_basename(__FILE__), __LINE__, (Msg)); \ @@ -341,7 +388,7 @@ extern "C" int melt_flag_bootstrapping; melt_low_debug_value_at(__FILE__,__LINE__,(Msg),(Val)) #define melt_low_debug_value_at(Fil,Lin,Msg,Val) \ - do {if(0) (void)(Val);}while(0) + do {if (false) (void)(Val);}while(0) #endif /*MELT_HAVE_DEBUG*/ @@ -379,18 +426,27 @@ extern void melt_clear_flag_debug (void); static inline int melt_need_debug (int depth) { +#if MELT_HAVE_DEBUG > 0 return melt_flag_debug && melt_dbgcounter>=melt_debugskipcount && depth >= 0 && depth < MELTDBG_MAXDEPTH; -} +#else + return 0 && depth; +#endif /*MELT_HAVE_DEBUG*/ +} // end of melt_need_debug static inline int melt_need_debug_limit (int depth, int lim) { +#if MELT_HAVE_DEBUG > 0 return melt_flag_debug && melt_dbgcounter>=melt_debugskipcount && depth >= 0 && depth < lim; -} +#else + return 0 && depth && lim; +#endif /*MELT_HAVE_DEBUG*/ +} // end of melt_need_debug_limit + /* unspecified flexible dimension in structure, we use 1 not 0 for standard compliance... */ #if ((__clang__ || __GNUC__) && MELT_FORCE_FLEXIBLE_DIM) @@ -596,14 +652,14 @@ melt_release_ppbuf (void) meltppbufsiz = 0; } -#ifdef ENABLE_GC_CHECKING +#if MELT_HAVE_RUNTIME_DEBUG > 0 extern int melt_debug_garbcoll; #define melt_debuggc_eprintf(Fmt,...) do {if (melt_debug_garbcoll > 0) \ fprintf (stderr, "%s:%d:@$*" Fmt "\n", \ melt_basename(__FILE__), __LINE__, ##__VA_ARGS__);} while(0) -#else /*!ENABLE_GC_CHECKING*/ +#else /*!MELT_HAVE_RUNTIME_DEBUG*/ #define melt_debuggc_eprintf(Fmt,...) do{}while(0) -#endif /*ENABLE_GC_CHECKING*/ +#endif /*MELT_HAVE_RUNTIME_DEBUG*/ /* also in generated meltrunsup.h */ #ifndef meltobject_ptr_t_TYPEDEFINED @@ -805,7 +861,7 @@ melt_magic_discr (melt_ptr_t p) { if (!p) return 0; -#if MELT_HAVE_DEBUG > 0 && ENABLE_GC_CHECKING +#if MELT_HAVE_RUNTIME_DEBUG > 0 && defined(MELT_POISON_POINTER) if ((void*) p == MELT_POISON_POINTER) { /* This should never happen, and if it happens it means that p @@ -816,19 +872,19 @@ melt_magic_discr (melt_ptr_t p) " (= the poison pointer)", (void*) p); } -#endif /*MELT_HAVE_DEBUG > 0 && ENABLE_GC_CHECKING */ -#if MELT_HAVE_DEBUG > 0 +#endif /*MELT_HAVE_DEBUG > 0 && defined(MELT_POISON_POINTER) */ +#if MELT_HAVE_DEBUG > 0 || MELT_HAVE_RUNTIME_DEBUG > 0 if (!p->u_discr) { /* This should never happen, we are asking the discriminant of a not yet filled, since cleared, memory zone. */ melt_fatal_error ("corrupted memory heap retrieving magic discriminant of %p," - "(= a cleeared memory zone)", + "(= a cleared memory zone)", (void*) p); } -#endif /*MELT_HAVE_DEBUG*/ -#if MELT_HAVE_DEBUG > 0 && ENABLE_GC_CHECKING +#endif /*MELT_HAVE_DEBUG or MELT_HAVE_RUNTIME_DEBUG */ +#if MELT_HAVE_RUNTIME_DEBUG > 0 && defined(MELT_POISON_POINTER) if ((void*) (p->u_discr) == MELT_POISON_POINTER) { /* This should never happen, we are asking the discriminant of a @@ -838,7 +894,8 @@ melt_magic_discr (melt_ptr_t p) "(= a freed and poisoned memory zone)", (void*) p); } -#endif /*MELT_HAVE_DEBUG > 0 && ENABLE_GC_CHECKING*/ +#endif /*MELT_HAVE_RUNTIME_DEBUG > 0 && defined(MELT_POISON_POINTER)*/ + gcc_assert (p->u_discr != NULL); return p->u_discr->meltobj_magic; } @@ -1063,9 +1120,10 @@ melt_forwarded (void *ptr) { if (p->u_discr == MELT_FORWARDED_DISCR) p = ((struct meltforward_st *) p)->forward; - else { - p = melt_forwarded_copy (p); - } + else + { + p = melt_forwarded_copy (p); + } } return p; } @@ -1081,7 +1139,7 @@ void melt_garbcoll (size_t wanted, enum melt_gckind_en gckd); -#if MELT_HAVE_DEBUG > 0 +#if MELT_HAVE_RUNTIME_DEBUG > 0 /***** with debugging *****/ /* to ease debugging we sometimes want to know when some pointer is allocated: set these variables in the debugger */ @@ -1222,9 +1280,11 @@ melt_allocatereserved (size_t basesz, size_t gap) } + + /* we maintain a small cache hasharray of touched values - the touched cache size should be a small prime */ -#define MELT_TOUCHED_CACHE_SIZE 19 +#define MELT_TOUCHED_CACHE_SIZE 23 extern void *melt_touched_cache[MELT_TOUCHED_CACHE_SIZE]; /* the touching routine should be called on every melt value which has been touched (by mutating one of its internal pointers) - it @@ -1233,6 +1293,9 @@ extern void *melt_touched_cache[MELT_TOUCHED_CACHE_SIZE]; static inline void meltgc_touch (void *touchedptr) { + // Caution: when lowering too much the constant below, the runtime + // becomes very unstable. + const unsigned touchgapwords = 8; /* we know that this may loose -eg on some 64bits hosts- some highend bits of the pointer but we don't care, since the 32 lowest bits are enough (as hash); we need a double cast to avoid @@ -1253,11 +1316,12 @@ meltgc_touch (void *touchedptr) melt_storalz--; melt_touched_cache[pad] = touchedptr; if (MELT_UNLIKELY - ((char *) ((void **) melt_storalz - 3) <= (char *) melt_curalz)) + ((char *) (((void **) melt_storalz) - touchgapwords) + <= (char *) melt_curalz)) melt_garbcoll (1024 * sizeof (void *) + ((char *) melt_endalz - (char *) melt_storalz), MELT_MINOR_OR_FULL); -} +} /* end of meltgc_touch */ /* we can avoid the hassle of adding a touched pointer to the store list if we know that the newly added pointer inside does not point @@ -1644,7 +1708,7 @@ melt_dynobjstruct_make_raw_object (melt_ptr_t klas, int len, Clanam, __FILE__, __LINE__, \ (int**)0, (int*)0) -#elif MELT_HAVE_DEBUG > 0 +#elif MELT_HAVE_DEBUG > 0 /* no dynamic flavor, but debugging */ static inline melt_ptr_t melt_getfield_object_at (melt_ptr_t ob, unsigned off, const char*msg, const char*fil, int lin) { @@ -1694,7 +1758,7 @@ melt_make_raw_object(melt_ptr_t klas, int len, const char*clanam) #define melt_object_get_field(Slot,Obj,Off,Fldnam) do { \ Slot = melt_getfield_object(Obj,Off,Fldnam);} while(0) #define melt_putfield_object(Obj,Off,Val,Fldnam) melt_putfield_object_at((melt_ptr_t)(Obj),(Off),(melt_ptr_t)(Val),(Fldnam),__FILE__,__LINE__) -#else +#else /* no debugging & no dynamic */ #define melt_getfield_object(Obj,Off,Fldnam) (((meltobject_ptr_t)(Obj))->obj_vartab[Off]) #define melt_object_get_field(Slot,Obj,Off,Fldnam) do { \ Slot = melt_getfield_object(Obj,Off,Fldnam);} while(0) @@ -1705,7 +1769,7 @@ melt_make_raw_object(melt_ptr_t klas, int len, const char*clanam) ((melt_ptr_t)meltgc_new_raw_object((meltobject_ptr_t)(Klas),Len)) #define melt_raw_object_create(Newobj,Klas,Len,Clanam) do { \ Newobj = melt_make_raw_object(Klas,Len,Clanam); } while(0) -#endif +#endif /* debugging, or dynamic, ... */ @@ -3096,9 +3160,9 @@ protected: const char* _meltcf_dbgfile; const long _meltcf_dbgline; const long _meltcf_dbgserial; +#endif /*MELT_HAVE_DEBUG*/ static FILE* _dbgcall_file_; static long _dbgcall_count_; -#endif /*MELT_HAVE_DEBUG*/ public: static Melt_CallProtoFrame* top_call_frame() { @@ -3344,14 +3408,14 @@ public: melt_ptr_t mcfr_varptr[(NbVal>0)?NbVal:1]; virtual void melt_forward_values (void) { -#if MELT_HAVE_DEBUG > 0 +#if MELT_HAVE_RUNTIME_DEBUG > 0 && MELT_HAVE_DEBUG > 0 if (dbg_file()) melt_debuggc_eprintf("forwarding %d values call frame @%p from %s:%ld #%ld", NbVal, (void*) this, dbg_file(), dbg_line(), dbg_serial()); else melt_debuggc_eprintf("forwarding %d values call frame @%p #%ld", NbVal, (void*) this, dbg_serial()); -#endif /*MELT_HAVE_DEBUG*/ +#endif /*MELT_HAVE_RUNTIME_DEBUG >0 && MELT_HAVE_DEBUG > 0*/ MELT_FORWARDED (mcfr_current); for (unsigned ix=0; ix 0 #define MELT_ENTERFRAME_AT(NbVar,Clos,Lin) \ @@ -3390,28 +3461,30 @@ public: Melt_CallFrameWithValues meltfram__ \ (__FILE__, Lin, sizeof(Melt_CallFrameWithValues), \ meltcast_meltclosure_st((melt_ptr_t)(Clos))); \ - if (MELT_HAVE_DEBUG) { \ + if (melt_flag_debug > 0) { \ static char meltlocbuf_##Lin [92]; \ if (MELT_UNLIKELY(!meltlocbuf_##Lin [0])) \ snprintf (meltlocbuf_##Lin, sizeof(meltlocbuf_##Lin), \ "%s:%d ~%s", melt_basename (__FILE__), \ Lin, __func__); \ - meltfram__.mcfr_flocs = meltlocbuf_##Lin; } + meltfram__.mcfr_flocs = meltlocbuf_##Lin; } \ + else meltfram__.mcfr_flocs = MELT_FRAMEHERELOC_STRING_LINE(Lin); #else /*!MELT_HAVE_DEBUG*/ -#define MELT_ENTERFRAME_AT(NbVar,Clos,Lin) \ - /* classy enter frame, nodebug */ \ - Melt_CallFrameWithValues meltfram__ \ - (sizeof(Melt_CallFrameWithValues), \ - meltcast_meltclosure_st((melt_ptr_t)(Clos))); \ - if (MELT_HAVE_DEBUG) { \ - static char meltlocbuf_##Lin [92]; \ - if (MELT_UNLIKELY(!meltlocbuf_##Lin [0])) \ - snprintf (meltlocbuf_##Lin, sizeof(meltlocbuf_##Lin), \ - "%s:%d ~%s", melt_basename (__FILE__), \ - Lin, __func__); \ - meltfram__.mcfr_flocs = meltlocbuf_##Lin; } +#define MELT_ENTERFRAME_AT(NbVar,Clos,Lin) \ + /* classy enter frame, nodebug */ \ + Melt_CallFrameWithValues meltfram__ \ + (sizeof(Melt_CallFrameWithValues), \ + meltcast_meltclosure_st((melt_ptr_t)(Clos))); \ + if (melt_flag_debug > 0) { \ + static char meltlocbuf_##Lin [92]; \ + if (MELT_UNLIKELY(!meltlocbuf_##Lin [0])) \ + snprintf (meltlocbuf_##Lin, sizeof(meltlocbuf_##Lin), \ + "%s:%d ~%s", melt_basename (__FILE__), \ + Lin, __func__); \ + meltfram__.mcfr_flocs = meltlocbuf_##Lin; } \ + else meltfram__.mcfr_flocs = MELT_FRAMEHERELOC_STRING_LINE(Lin); #endif /*MELT_HAVE_DEBUG*/ @@ -3434,25 +3507,33 @@ melt_curframdepth (void) /* MELT location macros should work with both oldstyle and classy - frames. They use "if (MELT_HAVE_DEBUG)" not "#if MELT_HAVE_DEBUG" - so the optimizer compiling them would remove the dead code when not - debugging. */ + frames. They are also called from the MELT runtime; so we should + not use MELT_HAVE_DEBUG in them. */ +#if __GNUC__ +#define MELT_IS_LITERAL_STRING(Arg) (__builtin_constant_p(Arg) && Arg[0] != (char)0) +#else +#define MELT_IS_LITERAL_STRING(Arg) false +#endif -#define MELT_LOCATION(LOCS) do{ \ - if (MELT_HAVE_DEBUG > 0) \ - meltfram__.mcfr_flocs = LOCS; \ +#define MELT_LOCATION(LOCS) do{ \ + if (MELT_HAVE_RUNTIME_DEBUG > 0 || melt_flag_debug > 0 \ + || MELT_IS_LITERAL_STRING(LOCS)) \ + meltfram__.mcfr_flocs = LOCS; \ + else \ + meltfram__.mcfr_flocs = MELT_FRAMEHERELOC_STRING(); \ }while(0) -#define MELT_LOCATION_HERE_AT(FIL,LIN,MSG) do { \ - if (MELT_HAVE_DEBUG) { \ - static char locbuf_##LIN[92]; \ - locbuf_##LIN[0] = 0; \ - if (!MELT_UNLIKELY(locbuf_##LIN[0])) \ - snprintf(locbuf_##LIN, sizeof(locbuf_##LIN), \ - "%s:%d <%s>", \ - melt_basename (FIL), (int)LIN, MSG); \ - meltfram__.mcfr_flocs = locbuf_##LIN; \ - } \ +#define MELT_LOCATION_HERE_AT(FIL,LIN,MSG) do { \ + if (MELT_HAVE_RUNTIME_DEBUG > 0 || melt_flag_debug > 0 \ + || MELT_IS_LITERAL_STRING(MSG)) { \ + static char locbuf_##LIN[92]; \ + locbuf_##LIN[0] = 0; \ + if (!MELT_UNLIKELY(locbuf_##LIN[0])) \ + snprintf(locbuf_##LIN, sizeof(locbuf_##LIN), \ + "%s:%d <%s>", \ + melt_basename (FIL), (int)LIN, MSG); \ + meltfram__.mcfr_flocs = locbuf_##LIN; \ + } \ } while(0) /* We need several indirections of macro to have the ##LIN trick above @@ -3462,7 +3543,7 @@ melt_curframdepth (void) #define MELT_LOCATION_HERE_MACRO(MSG) \ MELT_LOCATION_HERE_AT_MACRO(__FILE__,__LINE__,MSG) -#if MELT_HAVE_DEBUG > 0 +#if MELT_HAVE_DEBUG > 0 || MELT_HAVE_RUNTIME_DEBUG > 0 #define MELT_LOCATION_HERE(MSG) MELT_LOCATION_HERE_MACRO(MSG) #else #define MELT_LOCATION_HERE(MSG) do{}while(0) @@ -3471,7 +3552,7 @@ melt_curframdepth (void) /* SBUF should be a local array of char */ #define MELT_LOCATION_HERE_PRINTF_AT(SBUF,FIL,LIN,FMT,...) do { \ SBUF[0] = 0; \ - if (MELT_HAVE_DEBUG) { \ + if (MELT_HAVE_RUNTIME_DEBUG > 0 || melt_flag_debug > 0) { \ memset (SBUF, 0, sizeof(SBUF)); \ snprintf (SBUF, sizeof(SBUF), \ "%s:%d:: " FMT, \ @@ -3487,7 +3568,7 @@ melt_curframdepth (void) #define MELT_LOCATION_HERE_PRINTF_MACRO(SBUF,FMT,...) \ MELT_LOCATION_HERE_PRINTF_AT_MACRO(SBUF,__FILE__,__LINE__,FMT,__VA_ARGS__) -#if MELT_HAVE_DEBUG > 0 +#if MELT_HAVE_DEBUG > 0 || MELT_HAVE_RUNTIME_DEBUG > 0 #define MELT_LOCATION_HERE_PRINTF(SBUF,FMT,...) \ MELT_LOCATION_HERE_PRINTF_MACRO(SBUF,FMT, __VA_ARGS__) #else @@ -3517,7 +3598,7 @@ MELT_EXTERN opt_pass *melt_current_pass_ptr; static inline void melt_puts (FILE * f, const char *str) { - if (f && str) + if (f && str && str[0]) fputs (str, f); } @@ -3600,7 +3681,7 @@ melt_output_cfile_decl_impl(melt_ptr_t cfilnam, lists, tuples, strings, strbufs, but don't handle objects! */ void meltgc_output_file (FILE* fil, melt_ptr_t val_p); -#ifdef MELT_HAVE_DEBUG +#if MELT_HAVE_DEBUG > 0 || MELT_HAVE_RUNTIME_DEBUG > 0 static inline void debugeputs_at (const char *fil, int lin, const char *msg) { -- cgit v1.2.1