From 51c5a1366f9f877862df857137905b9b6808fcd5 Mon Sep 17 00:00:00 2001 From: Jim Ingham Date: Tue, 9 Jun 1998 22:33:46 +0000 Subject: [PATCH] Tue Jun 9 15:27:09 1998 Jim Ingham * gdbtk.c: Added hooks to run gdbtk under the TclPro debugger. To do this, build gdbtk with: make CFLAGS="-g -DTCLPRO_DEBUGGER" Then set the environment variable TCLPRO_DEBUG_DIR to point to wherever you have installed the TclPro debugger. Finally, in the Alpha of the TclPro Debugger, you have to start up the TclPro Debugger BEFORE you start gdbtk. Unfortunately, the debugger does not understand Itcl 1.5 style classes... * .Sanitize: Sanitize out references to the TclPro debugger, since it is not yet released. --- gdb/.Sanitize | 36 +++++++++++++++++++++++++++++++++++ gdb/gdbtk.c | 52 +++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 74 insertions(+), 14 deletions(-) diff --git a/gdb/.Sanitize b/gdb/.Sanitize index f4b57704496..163f702c5b6 100644 --- a/gdb/.Sanitize +++ b/gdb/.Sanitize @@ -834,6 +834,42 @@ else done fi +# This is a temporary measure to sanitize out references to the +# startup code need by the TclPro debugger. When that goes out +# of alpha, we can remove this. + +if ( echo $* | grep keep\-tclpro > /dev/null ) ; then + for i in * ; do + if test ! -d $i && (grep sanitize-tclpro $i > /dev/null) ; then + echo Keeping \"tclpro\" stuff in $i, but editing out sanitize lines... + cp $i new + sed -e '/start\-sanitize\-tclpro/d' -e '/end\-sanitize\-tclpro/d' < $i > new + if [ -n "${safe}" -a ! -f .Recover/$i ] ; then + echo Caching $i in .Recover... + mv $i .Recover + fi + mv new $i + fi + done +else + for i in * ; do + if test ! -d $i && (grep sanitize-tclpro $i > /dev/null) ; then + if [ -n "${verbose}" ] ; then + echo Removing traces of \"tclpro\" from $i... + fi + cp $i new + sed '/start\-sanitize\-tclpro/,/end-\sanitize\-tclpro/d' < $i > new + if [ -n "${safe}" -a ! -f .Recover/$i ] ; then + if [ -n "${verbose}" ] ; then + echo Caching $i in .Recover... + fi + mv $i .Recover + fi + mv new $i + fi + done +fi + if ( echo $* | grep keep\-mswin > /dev/null ) ; then for i in * ; do if test ! -d $i && (grep sanitize-mswin $i > /dev/null) ; then diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index 4718e155427..15e5ed1989b 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -1338,17 +1338,16 @@ call_obj_wrapper (clientData, interp, objc, objv) running_now = 0; Tcl_Eval (interp, "gdbtk_tcl_idle"); - - - /* if the error message is in RESULT instead of ERROR_STRING we copy it - back to ERROR_STRING and free RESULT */ - - if ((Tcl_DStringLength (&error_string) == 0) && (Tcl_DStringLength (&result) > 0)) - { - Tcl_DStringAppend (&error_string, Tcl_DStringValue (&result), Tcl_DStringLength (&result)); - Tcl_DStringFree (&result); - } - + /* if the error message is in RESULT instead of ERROR_STRING we copy it + back to ERROR_STRING and free RESULT */ + + if ((Tcl_DStringLength (&error_string) == 0) && + (Tcl_DStringLength (&result) > 0)) + { + Tcl_DStringAppend (&error_string, Tcl_DStringValue (&result), + Tcl_DStringLength (&result)); + Tcl_DStringFree (&result); + } } /* do not suppress any errors -- a remote target could have errored */ @@ -2454,8 +2453,27 @@ gdbtk_find_main"; fputs_unfiltered_hook = gdbtk_fputs; - if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK) - { +/* start-sanitize-tclpro */ +#ifdef TCLPRO_DEBUGGER + { + Tcl_DString source_cmd; + + Tcl_DStringInit (&source_cmd); + Tcl_DStringAppend (&source_cmd, + "if {[info exists env(TCLPRO_DEBUG_DIR)]} {source [file join $env(TCLPRO_DEBUG_DIR) src loader.tcl];", -1); + Tcl_DStringAppend (&source_cmd, "debugger_init; debugger_eval {source {", -1); + Tcl_DStringAppend (&source_cmd, gdbtk_file, -1); + Tcl_DStringAppend (&source_cmd, "}}} else {source {", -1); + Tcl_DStringAppend (&source_cmd, gdbtk_file, -1); + Tcl_DStringAppend (&source_cmd, "}}", -1); + if (Tcl_GlobalEval (interp, Tcl_DStringValue (&source_cmd)) != TCL_OK) +#else +/* end-sanitize-tclpro */ + if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK) +/* start-sanitize-tclpro */ +#endif +/* end-sanitize-tclpro */ + { char *msg; /* Force errorInfo to be set up propertly. */ @@ -2473,7 +2491,13 @@ gdbtk_find_main"; error (""); } - +/* start-sanitize-tclpro */ +#ifdef TCLPRO_DEBUGGER + Tcl_DStringFree(&source_cmd); + } +#endif +/* end-sanitize-tclpro */ + #ifdef IDE /* start-sanitize-ide */ /* Don't do this until we have initialized. Otherwise, we may get a -- 2.30.2