diff options
| -rw-r--r-- | gcc/ChangeLog.MELT | 13 | ||||
| -rw-r--r-- | gcc/melt/warmelt-base.melt | 2 | ||||
| -rw-r--r-- | gcc/melt/warmelt-hooks.melt | 36 | ||||
| -rw-r--r-- | gcc/melt/warmelt-modes.melt | 4 | ||||
| -rw-r--r-- | gcc/melt/warmelt-outobj.melt | 22 |
5 files changed, 48 insertions, 29 deletions
diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT index 7490553ba94..c5dd141a94d 100644 --- a/gcc/ChangeLog.MELT +++ b/gcc/ChangeLog.MELT @@ -1,4 +1,17 @@ +2016-05-12 Basile Starynkevitch <basile@starynkevitch.net> + {{use melt_debugeprintf... not debugeprintf... in MELT translator}} + * melt/warmelt-base.melt (message_dbg): Use melt_debugeputs. + + * melt/warmelt-hooks.melt (hook_gimple_gate) + (melt_attribute_handler_glue, register_gcc_attribute) + (connect_to_server, json_lexer): Use melt_debugeprintf... + + * melt/warmelt-modes.melt (eval_docmd): Ditto. + + * melt/warmelt-outobj.melt (output_curframe_declstruct_init) + (outpucod_initialmoduleroutine): Ditto. + 2016-05-11 Basile Starynkevitch <basile@starynkevitch.net> * melt-runtime.h (MELT_VERSION_STRING): Bump to 1.3rc2+. diff --git a/gcc/melt/warmelt-base.melt b/gcc/melt/warmelt-base.melt index 283ed220d15..93e4e8e67da 100644 --- a/gcc/melt/warmelt-base.melt +++ b/gcc/melt/warmelt-base.melt @@ -906,7 +906,7 @@ an integer $I if $I is lower than $N.}# (defprimitive message_dbg (:cstring msg) :void :doc #{Debug message $msg}# - #{debugeputs(($msg))}#) + #{melt_debugeputs(($msg))}#) (defprimitive messagenum_dbg (:cstring msg :long i) :void :doc #{Debug output with message $msg number $i}# #{melt_debugnum(($msg), ($i))}#) diff --git a/gcc/melt/warmelt-hooks.melt b/gcc/melt/warmelt-hooks.melt index 6fd8d95fdb3..1b57a20c296 100644 --- a/gcc/melt/warmelt-hooks.melt +++ b/gcc/melt/warmelt-hooks.melt @@ -2,7 +2,7 @@ ;; file warmelt-hooks.melt ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (comment "*** - Copyright 2012 - 2014 Free Software Foundation, Inc. + Copyright 2012 - 2016 Free Software Foundation, Inc. Contributed by Basile Starynkevitch <basile@starynkevitch.net> This file is part of GCC. @@ -1878,7 +1878,7 @@ bool melthk_pass_execution_registered_flag; #{ /* hook_gimple_gate $GETMYPASS_CHK */ gcc_assert(this_pass != NULL) ; gcc_assert(this_pass->name != NULL) ; - debugeprintf ("hook_gimple_gate this_pass %p named %s", + melt_debugeprintf ("hook_gimple_gate this_pass %p named %s", (void*) this_pass->name, this_pass->name) ; gcc_assert(this_pass->type == GIMPLE_PASS) ; $MYPASS = melt_get_mapstrings ((struct meltmapstrings_st*) $PASSDICT, @@ -2252,7 +2252,7 @@ melt_attribute_handler_glue (tree *pnode, tree name, tree args, int flags, bool tree orignode = *pnode; tree outnode= NULL_TREE; long out_no_add_attrs= (*pno_add_attrs); - debugeprintf("melt_attribute_handler_glue pnode@%p orignode=%p outnode=%p name=%p args@%p flags=%d pno_add_attrs@%p: %ld" + melt_debugeprintf("melt_attribute_handler_glue pnode@%p orignode=%p outnode=%p name=%p args@%p flags=%d pno_add_attrs@%p: %ld" " before HOOK_HANDLE_ATTRIBUTE", (void*)pnode, (void*)orignode, (void*)outnode, (void*)name, (void*)args, flags, @@ -2261,12 +2261,12 @@ melt_attribute_handler_glue (tree *pnode, tree name, tree args, int flags, bool melthookproc_HOOK_HANDLE_ATTRIBUTE (orignode, name, args, flags, &outnode, &out_no_add_attrs); - debugeprintf("melt_attribute_handler_glue orignode=%p outnode=%p res=%p out_no_add_attrs=%ld after HOOK_HANDLE_ATTRIBUTE", + melt_debugeprintf("melt_attribute_handler_glue orignode=%p outnode=%p res=%p out_no_add_attrs=%ld after HOOK_HANDLE_ATTRIBUTE", (void*)orignode, (void*)outnode, (void*)res, out_no_add_attrs); if (outnode) *pnode = outnode; *pno_add_attrs = (bool)out_no_add_attrs; - debugeprintf("melt_attribute_handler_glue *pno_add_attrs=%d *pnode=%p", + melt_debugeprintf("melt_attribute_handler_glue *pno_add_attrs=%d *pnode=%p", (int)(*pno_add_attrs), (void*)(*pnode)); melt_cbreak("ending melt_attribute_handler_glue"); return res; @@ -2619,11 +2619,11 @@ melt_attribute_handler_glue (tree *pnode, tree name, tree args, int flags, bool atspec->function_type_required = $VFUNCTIONTYPEREQUIRED != NULL ; atspec->affects_type_identity = $VAFFECTSTYPEIDENTITY != NULL ; atspec->handler = melt_attribute_handler_glue ; - debugeprintf("melt_attribute_handler_glue/lambda atspec@%p " + melt_debugeprintf("melt_attribute_handler_glue/lambda atspec@%p " "name %s min_length %d, max_length %d", (void*)atspec, atspec->name, atspec->min_length, atspec->max_length); - debugeprintf("decl_required %s, type_required %s,\n.. " + melt_debugeprintf("decl_required %s, type_required %s,\n.. " "function_type_required %s, affects_type_identity %s,\n.. " "handler@%p", (atspec->decl_required)?"yes":"no", @@ -2632,7 +2632,7 @@ melt_attribute_handler_glue (tree *pnode, tree name, tree args, int flags, bool (atspec->affects_type_identity)?"yes":"no", (void*)atspec->handler); register_attribute (atspec) ; - debugeprintf ("melt_register_gcc_attribute_at/lambda registered atspec=%p", + melt_debugeprintf ("melt_register_gcc_attribute_at/lambda registered atspec=%p", (void*)atspec); /* -- melt_register_gcc_attribute_at/lambda $GCCATTR_CHK end */ }#) @@ -3060,7 +3060,7 @@ exit, in last place.}# $(progn (debug "hook_poll_inputs nbfd=" nbfd " tupinch=" tupinch) (void)) /* hook_poll_inputs $POLLIN_CHK do the poll */ $RESPOLL = poll (fdtab, $NBFD, $DELAYMS); - debugeprintf ("hook_poll_inputs respoll=%ld", $RESPOLL); + melt_debugeprintf ("hook_poll_inputs respoll=%ld", $RESPOLL); $(if (>i respoll 0) (let ( (tupstate (make_multiple discr_multiple nbfd)) @@ -3403,7 +3403,7 @@ exit, in last place.}# #endif /*UNIX_PATH_MAX */ struct sockaddr_un saun; memset (&saun, 0, sizeof(saun)); - debugeprintf("connect_to_server unix service %s", + melt_debugeprintf("connect_to_server unix service %s", melt_string_str($SERVICE)); if (strlen(melt_string_str($SERVICE))>=UNIX_PATH_MAX) { warning (0, "MELT connect_to_server: AF_UNIX too long path %s", melt_string_str($SERVICE)); @@ -3419,7 +3419,7 @@ exit, in last place.}# }; // read man page unix(7) socklen_t saulen = offsetof(struct sockaddr_un, sun_path) + strlen(saun.sun_path) + 1; - debugeprintf ("connect_to_server: connect sun_path %s saulen=%d", + melt_debugeprintf ("connect_to_server: connect sun_path %s saulen=%d", saun.sun_path, (int)saulen); if (connect ((int)$UNIXSOCKFD, (const struct sockaddr*)&saun, saulen)) { warning (0, "MELT connect_to_server: AF_UNIX %s connect failure: %s", @@ -3454,11 +3454,11 @@ exit, in last place.}# Melt_connect_info conninfo; bool gotconninfo = false; const char* servicestr = melt_string_str ($SERVICE); - debugeprintf("connect_to_server TCPlike servicestr=%s", servicestr); + melt_debugeprintf("connect_to_server TCPlike servicestr=%s", servicestr); if ((sscanf(servicestr, "localhost:%d", &locportnum)>0 || sscanf(servicestr, ":%d", &locportnum)>0) && locportnum>0) { - debugeprintf("connect_to_server locportnum=%d", locportnum); + melt_debugeprintf("connect_to_server locportnum=%d", locportnum); struct sockaddr_in sain; memset (&sain, 0, sizeof (sain)); servicestr = NULL; @@ -3489,7 +3489,7 @@ exit, in last place.}# conninfo = iterconninfo->second; gotconninfo = true; } - debugeprintf("connect_to_server gotconninfo=%d", + melt_debugeprintf("connect_to_server gotconninfo=%d", (int) gotconninfo); if (strlen(servicestr) >= sizeof(remhostname)) { warning (0, "MELT connect_to_server: too long service name %s", servicestr); @@ -3501,7 +3501,7 @@ exit, in last place.}# MIN((unsigned)(lastcolon-servicestr), (unsigned)sizeof(remhostname))); strncpy (remservicename, lastcolon+1, sizeof(remservicename)-1); - debugeprintf("connect_to_server remhostname=%s remservicename=%s", remhostname, remservicename); + melt_debugeprintf("connect_to_server remhostname=%s remservicename=%s", remhostname, remservicename); if (gotconninfo) { // cached network info from previous call gcc_assert (!strcmp(conninfo.mci_service.c_str(), melt_string_str($SERVICE))); $TCPSOCKFD = (long) socket (conninfo.mci_family, conninfo.mci_socktype, conninfo.mci_protocol); @@ -3699,18 +3699,18 @@ exit, in last place.}# double x = 0.0 ; int lnum = melt_strbuf_peek_long_number($SBUF,0,&l) ; int ldbl = melt_strbuf_peek_double_number($SBUF,0,&x) ; - debugeprintf("json_lexer $PARSEJSONNUM_CHK lnum=%d ldbl=%d l=%ld x=%g bulen=%ld", + melt_debugeprintf("json_lexer $PARSEJSONNUM_CHK lnum=%d ldbl=%d l=%ld x=%g bulen=%ld", lnum, ldbl, l, x, $BULEN); if (lnum>0 && lnum>=ldbl && (long)lnum<$BULEN) { $EATLEN = (long)lnum ; - debugeprintf("json_lexer $PARSEJSONNUM_CHK long number l=%ld eatlen=%ld", l, $EATLEN); + melt_debugeprintf("json_lexer $PARSEJSONNUM_CHK long number l=%ld eatlen=%ld", l, $EATLEN); $VAL = meltgc_new_int((meltobject_ptr_t) MELT_PREDEF(DISCR_CONSTANT_INTEGER), l) ; } else if (ldbl>0 && (long)ldbl<$BULEN) { $EATLEN = (long)ldbl ; - debugeprintf("json_lexer $PARSEJSONNUM_CHK double number x=%g eatlen=%ld", x, $EATLEN); + melt_debugeprintf("json_lexer $PARSEJSONNUM_CHK double number x=%g eatlen=%ld", x, $EATLEN); $VAL = meltgc_new_double((meltobject_ptr_t) MELT_PREDEF(DISCR_CONSTANT_DOUBLE), x) ; diff --git a/gcc/melt/warmelt-modes.melt b/gcc/melt/warmelt-modes.melt index 3e99252a83c..0c54d900c96 100644 --- a/gcc/melt/warmelt-modes.melt +++ b/gcc/melt/warmelt-modes.melt @@ -210,7 +210,7 @@ has basic debug support thru DEBUG, ASSERT_MSG..." ) (code_chunk evalstart_chk #{ /* eval_docmd $EVALSTART_CHK */ - debugeprintf ("eval_docmd start cmd@%p", (void*)$CMD); + melt_debugeprintf ("eval_docmd start cmd@%p", (void*)$CMD); MELT_LOCATION_HERE ("eval_docmd @*@starting eval@*@"); }#) (debug "eval_docmd start parmodenv=" parmodenv @@ -261,7 +261,7 @@ has basic debug support thru DEBUG, ASSERT_MSG..." ) (code_chunk evalstart_chk #{ /* evalfile_docmd $EVALSTART_CHK */ - debugeprintf ("evalfile_docmd start cmd@%p", (void*)$CMD); + melt_debugeprintf ("evalfile_docmd start cmd@%p", (void*)$CMD); MELT_LOCATION_HERE ("evalfile_docmd @*@starting eval@*@"); }#) (debug "evalfile_docmd start parmodenv=" parmodenv diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt index 74aa7af8dea..00f73d79f3c 100644 --- a/gcc/melt/warmelt-outobj.melt +++ b/gcc/melt/warmelt-outobj.melt @@ -1768,9 +1768,11 @@ between 2Mb and 64Mb. See also $GET_CODE_BUFFER_LIMIT.}# ) ( (is_a rou class_initialroutineobj) (add2sbuf_indentnl implbuf 1) - (add2out implbuf "debugeprintf(\"sizeof Melt_InitialFrame in " rouname "=%d\", (int) sizeof(Melt_InitialFrame));") + (add2out implbuf "melt_debugeprintf(\"sizeof Melt_InitialFrame in " + rouname "=%d\", (int) sizeof(Melt_InitialFrame));") (add2sbuf_indentnl implbuf 1) - (add2out implbuf "/* classy initial frame " rouname " fromline " (this_line) "*/ Melt_InitialFrame ")) + (add2out implbuf "/* classy initial frame " rouname + " fromline " (this_line) "*/ Melt_InitialFrame ")) ( :else (debug "output_curframe_declstruct_init classy bad routine=" rou) (assert_msg "unexpected routine for classy frame declaration" () rou)) @@ -2333,11 +2335,15 @@ between 2Mb and 64Mb. See also $GET_CODE_BUFFER_LIMIT.}# ) ;; declare each chunk and call it. (add2sbuf_indentnl implbuf 1) - (add2out implbuf "debugeprintf (\" in initialization of " omodnam " thru " - (multiple_length chunktup) " chunk routines with frame @%p of %d bytes\",\n" - " /*fromline " (this_line) "*/ (void*)&meltfram__, (int) sizeof(meltfram__));") + (add2out implbuf "melt_debugeprintf (\" in initialization of " + omodnam " thru " + (multiple_length chunktup) + " chunk routines with frame @%p of %d bytes\",\n" + " /*fromline " (this_line) + "*/ (void*)&meltfram__, (int) sizeof(meltfram__));") (add2sbuf_indentnl implbuf 1) - (add2out implbuf "melt_debuggc_eprintf (\"initialization of " omodnam " thru " + (add2out implbuf "melt_debuggc_eprintf (\"initialization of " + omodnam " thru " (multiple_length chunktup) " chunks, frame @%p of %d bytes\",\n " " (void*)&meltfram__, (int) sizeof(meltfram__));") (add2sbuf_indentnl implbuf 1) @@ -2375,7 +2381,7 @@ between 2Mb and 64Mb. See also $GET_CODE_BUFFER_LIMIT.}# (add2sbuf_strconst implbuf "/*noretval*/ NULL")) (add2sbuf_strconst implbuf ";") (add2sbuf_indentnl implbuf 1) - (add2out implbuf "debugeprintf (\"returning @%p from initial routine of " omodnam + (add2out implbuf "melt_debugeprintf (\"returning @%p from initial routine of " omodnam "\", (void*)retval); /*fromline " (this_line) "*/") (add2sbuf_indentnl implbuf 0) (add2sbuf_strconst implbuf " return retval;}") @@ -3487,7 +3493,7 @@ meltlabend_rout: #if MELTDEBUG_MATCHING static long meltlab_count_$COUNT; meltlab_count_$COUNT++; - debugeprintf("objlabel_$COUNT $OPREFIX#$OBRANK $OBLAB %ld", meltlab_count_$COUNT); + melt_debugeprintf("objlabel_$COUNT $OPREFIX#$OBRANK $OBLAB %ld", meltlab_count_$COUNT); #endif }#) (add2sbuf_indentnl implbuf depth) |