From 6d0db57c023c72893e0a7221030126a4ec637b3c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 30 Mar 2013 21:44:39 +0000 Subject: Better Windows console panic proc, still to be TIPped. --- generic/tcl.h | 8 +++++- generic/tclPanic.c | 16 +++-------- win/Makefile.in | 6 +++- win/makefile.bc | 6 +++- win/makefile.vc | 6 +++- win/tcl.dsp | 4 +++ win/tclWinPanic.c | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 114 insertions(+), 16 deletions(-) create mode 100644 win/tclWinPanic.c diff --git a/generic/tcl.h b/generic/tcl.h index 4de18f0..73229b1 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2395,6 +2395,11 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); +#ifdef _WIN32 +void Tcl_ConsolePanic(const char *format, ...); +#else +#define Tcl_ConsolePanic NULL +#endif /* * When not using stubs, make it a macro. @@ -2415,7 +2420,8 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ - (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) + (Tcl_SetPanicProc(Tcl_ConsolePanic), \ + Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) EXTERN void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, diff --git a/generic/tclPanic.c b/generic/tclPanic.c index b87a8df..a95b9c9 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -23,11 +23,7 @@ * procedure. */ -#if defined(__CYGWIN__) -static Tcl_PanicProc *panicProc = tclWinDebugPanic; -#else static Tcl_PanicProc *panicProc = NULL; -#endif /* *---------------------------------------------------------------------- @@ -49,10 +45,6 @@ void Tcl_SetPanicProc( Tcl_PanicProc *proc) { -#if defined(_WIN32) - /* tclWinDebugPanic only installs if there is no panicProc yet. */ - if ((proc != tclWinDebugPanic) || (panicProc == NULL)) -#endif panicProc = proc; } @@ -93,15 +85,15 @@ Tcl_PanicVA( if (panicProc != NULL) { panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#ifdef _WIN32 - } else if (IsDebuggerPresent()) { - tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); -#endif } else { +#if defined(_WIN32) || defined(__CYGWIN__) + tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +#else fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); fprintf(stderr, "\n"); fflush(stderr); +#endif #if defined(_WIN32) || defined(__CYGWIN__) # if defined(__GNUC__) __builtin_trap(); diff --git a/win/Makefile.in b/win/Makefile.in index 99009b9..2942da4 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -384,7 +384,8 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ tclTomMathStubLib.$(OBJEXT) \ - tclOOStubLib.$(OBJEXT) + tclOOStubLib.$(OBJEXT) \ + tclWinPanic.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) @@ -519,6 +520,9 @@ tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c tclOOStubLib.${OBJEXT}: tclOOStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) +tclWinPanic.${OBJEXT}: tclWinPanic.c + $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) + # Implicit rule for all object files that will end up in the Tcl library %.${OBJEXT}: %.c diff --git a/win/makefile.bc b/win/makefile.bc index 18bfa28..b5f388c 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -278,7 +278,8 @@ TCLOBJS = \ TCLSTUBOBJS = \ $(TMPDIR)\tclStubLib.obj \ $(TMPDIR)\tclTomMathStubLib.obj \ - $(TMPDIR)\tclOOStubLib.obj + $(TMPDIR)\tclOOStubLib.obj \ + $(TMPDIR)\tclWinPanic.obj WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic @@ -532,6 +533,9 @@ $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? +$(TMPDIR)\tclWinPanic.obj : $(GENERICDIR)\tclWinPanic.c + $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? + # Dedependency rules diff --git a/win/makefile.vc b/win/makefile.vc index 2784140..e4f064e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -449,7 +449,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ $(TMP_DIR)\tclTomMathStubLib.obj \ - $(TMP_DIR)\tclOOStubLib.obj + $(TMP_DIR)\tclOOStubLib.obj \ + $(TMP_DIR)\tclWinPanic.obj ### The following paths CANNOT have spaces in them. COMPATDIR = $(ROOT)\compat @@ -983,6 +984,9 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? +$(TMP_DIR)\tclWinPanic.obj: $(GENERICDIR)\tclWinPanic.c + $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? + #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a diff --git a/win/tcl.dsp b/win/tcl.dsp index 57ec6bf..5880d09 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1304,6 +1304,10 @@ SOURCE=..\generic\tclOOStubLib.c # End Source File # Begin Source File +SOURCE=..\generic\tclWinPanic.c +# End Source File +# Begin Source File + SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c new file mode 100644 index 0000000..266625c --- /dev/null +++ b/win/tclWinPanic.c @@ -0,0 +1,84 @@ +/* + * tclWinPanic.c -- + * + * Contains the Windows-specific command-line panic proc. + * + * Copyright (c) 2013 by Jan Nijtmans. + * All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" + +/* + *---------------------------------------------------------------------- + * + * Tcl_ConsolePanic -- + * + * Display a message. If a debugger is present, present it directly to + * the debugger, otherwise send it to stderr. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_ConsolePanic( + const char *format, ...) +{ +#define TCL_MAX_WARN_LEN 1024 + DWORD dummy; + va_list argList; + WCHAR msgString[TCL_MAX_WARN_LEN]; + char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX]; + HANDLE handle = GetStdHandle(STD_ERROR_HANDLE); + + va_start(argList, format); + _vsnprintf(buf+3, sizeof(buf)-3, format, argList); + buf[sizeof(buf)-1] = 0; + msgString[TCL_MAX_WARN_LEN-1] = L'\0'; + MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN); + + /* + * Truncate MessageBox string if it is too long to not overflow the buffer. + */ + + if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') { + memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR)); + } + + if (IsDebuggerPresent()) { + OutputDebugStringW(msgString); + } else if (_isatty(2)) { + WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0); + } else { + buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */ + WriteFile(handle, buf, strlen(buf), &dummy, 0); + FlushFileBuffers(handle); + } +#if defined(__GNUC__) + __builtin_trap(); +#elif defined(_WIN64) + __debugbreak(); +#elif defined(_MSC_VER) + _asm {int 3} +#else + DebugBreak(); +#endif + ExitProcess(1); +} +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * tab-width: 8 + * End: + */ -- cgit v0.12