summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/InitSubSyst.384
-rw-r--r--generic/tcl.h14
-rw-r--r--generic/tclEncoding.c24
-rw-r--r--generic/tclMain.c2
-rw-r--r--generic/tclZlib.c18
-rw-r--r--unix/Makefile.in4
-rw-r--r--unix/tclAppInit.c7
-rw-r--r--win/Makefile.in6
-rw-r--r--win/makefile.bc6
-rw-r--r--win/makefile.vc6
-rw-r--r--win/tcl.dsp4
-rw-r--r--win/tclAppInit.c3
-rw-r--r--win/tclWinPanic.c84
13 files changed, 164 insertions, 98 deletions
diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3
index db3951e..88eaf2b 100644
--- a/doc/InitSubSyst.3
+++ b/doc/InitSubSyst.3
@@ -1,11 +1,11 @@
'\"
-'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2013 Tcl Core Team
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.so man.macros
-.TH Tcl_InitSubsystems 3 8.6.1 Tcl "Tcl Library Procedures"
+.TH Tcl_InitSubsystems 3 8.7 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_InitSubsystems \- initialize the Tcl library.
@@ -13,15 +13,13 @@ Tcl_InitSubsystems \- initialize the Tcl library.
.nf
\fB#include <tcl.h>\fR
.sp
-Tcl_Interp *
-\fBTcl_InitSubsystems\fR(\fIflags\fR, \fI...\fR)
+const char *
+\fBTcl_InitSubsystems\fR(\fIpanicProc\fR)
.SH ARGUMENTS
-.AS int flags
-.AP int flags in
-Any combination of flags which might modify the initialization sequence.
-At this moment, only 0, \fBTCL_INIT_PANIC\fR and \fBTCL_INIT_CUSTOM\fR
-(or a combination) are supported.
-The value 0 can be used if Tcl is used as utility library only.
+.AS "Tcl_PanicProc *" panicProc
+.AP "Tcl_PanicProc *" panicProc
+PanicProc. The value NULL is used when the default panicProc is
+desired.
.BE
.SH DESCRIPTION
@@ -29,61 +27,25 @@ The value 0 can be used if Tcl is used as utility library only.
The \fBTcl_InitSubsystems\fR procedure initializes the Tcl
library. This procedure is typically invoked as the very
first thing in the application's main program.
-Its \fBflags\fR argument controls exactly what is initialized,
-and what additional arguments are expected.
+This function is almost the same as Tcl_SetPanicProc, except
+that Tcl_SetPanicProc is in the stub table, meant for Tcl
+extenders, and can be called at any time to change the
+panic proc. \fBTcl_InitSubsystems\fR is only meant to be
+called once, and does all initializations necessary such
+that Tcl_CreateInterp() can be called.
.PP
-The call \fBTcl_InitSubsystems(0)\fR does the same as
-\fBTcl_FindExecutable(NULL)\fR, except that a Tcl_Interp *
-is returned which can be used only by \fBTcl_InitStubs\fR
-to initialize the stub table. This opens up the Tcl Stub
-technology for Tcl embedders, which now can dynamically
-load the Tcl shared library and use functions in it
-without ever creating an interpreter. E.g. the
-following code can be compiled with -DUSE_TCL_STUBS:
-.CS
-Tcl_Interp *interp, *(*initSubSystems)(int, ...);
-const char *version;
-void *handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
-initSubSystems = dlsym(handle, "Tcl_InitSubsystems");
-version = Tcl_InitStubs(initSubSystems(0), NULL, 0);
-/* At this point, Tcl C API calls without interp are ready for use */
-interp = Tcl_CreateInterp(); /* Now we have a real interpreter */
-Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */
-.CE
-This is equivalent to (without dynamical loading)
+The return value is the Tcl version.
+.PP
+If \fBTcl_InitSubsystems()\fR is called while -DUSE_TCL_STUBS
+is set, it does one additional thing: initialize the Stub
+table for using Tcl as utility library, without needing
+a Tcl interpreter. For example:
.CS
-Tcl_Interp *interp;
-const char *version;
-version = Tcl_InitStubs(Tcl_InitSubSystems(0), NULL, 0);
+const char *version = Tcl_InitSubSystems(0);
/* At this point, Tcl C API calls without interp are ready for use */
-interp = Tcl_CreateInterp(); /* Now we have a real interpreter */
+Tcl_Interp *interp = Tcl_CreateInterp(); /* Now we have a real interpreter */
Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */
.CE
-The function \fBTcl_CreateInterp\fR, or any other Tcl function you
-would like to call, no longer needs to be searched for in the
-shared library. It can be called directly through the stub table.
-Note that the stub table needs to be initialized twice, in order
-to be sure that you can call all functions without limitations
-after the real interpreter is created.
-.PP
-If you supply the flag \fBTCL_INIT_PANIC\fR to \fBTcl_InitSubsystems\fR,
-the function expects an additional argument, a custom panicProc.
-This is equivalent to calling \fBTcl_SetPanicProc\fR immediately
-before \fBTcl_InitSubsystems\fR, except that you possibly cannot do
-that yet if it requires an initialized stub table. Of course you
-could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR,
-but then panics which could be produced by the initialization
-itself still use the default panic procedure.
-.PP
-If you supply the flag \fBTCL_INIT_CUSTOM\fR to \fBTcl_InitSubsystems\fR,
-the function expects two additional arguments: ClientData and a
-custom proc. The proc will be supplied two arguments, the (pseudo)
-Tcl interpreter and ClientData. The given function will be executed
-just before the encodings are initialized.
-.PP
-The interpreter returned by Tcl_InitSubsystems(0) or passed to the
-TCL_INIT_CUSTOM function cannot be passed to any other function than
-Tcl_InitStubs(). Tcl functions with an "interp" argument can only
-be called if the function supports passing NULL.
+This will work as expected even when -DUSE_TCL_STUBS is set.
.SH KEYWORDS
binary, executable file
diff --git a/generic/tcl.h b/generic/tcl.h
index 522171e..451c6cc 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.
@@ -2414,7 +2419,12 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
#define TCL_INIT_PANIC (1) /* Set Panic proc */
#define TCL_INIT_CUSTOM (2) /* Do any stuff before initializing the encoding */
-EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
+#ifdef USE_TCL_STUBS
+EXTERN Tcl_Interp *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
+#define Tcl_InitSubsystems(panicProc) Tcl_InitStubs((Tcl_InitSubsystems)(panicProc), NULL, 0)
+#else
+EXTERN const char *Tcl_InitSubsystems(Tcl_PanicProc *panicProc);
+#endif
/*
* Public functions that are not accessible via the stubs table.
@@ -2422,7 +2432,7 @@ EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
*/
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
- (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+ (Tcl_InitSubsystems(Tcl_ConsolePanic), 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/tclEncoding.c b/generic/tclEncoding.c
index 9905eaa..e57272f 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1442,28 +1442,14 @@ static const struct {
};
#undef Tcl_FindExecutable
-Tcl_Interp *
-Tcl_InitSubsystems(int flags, ...)
+const char *
+Tcl_InitSubsystems(Tcl_PanicProc *panicProc)
{
- va_list argList;
- Tcl_Interp *interp = (Tcl_Interp *) &dummyInterp;
-
- va_start(argList, flags);
- if (flags & TCL_INIT_PANIC) {
- Tcl_SetPanicProc(va_arg(argList, Tcl_PanicProc *));
+ if (panicProc) {
+ Tcl_SetPanicProc(panicProc);
}
TclInitSubsystems();
- if (flags & TCL_INIT_CUSTOM) {
- ClientData clientData = va_arg(argList, ClientData);
- void (*fn)(Tcl_Interp *, ClientData) = va_arg(argList,
- void (*)(Tcl_Interp *, ClientData));
- fn(interp, clientData);
- }
- va_end(argList);
-
- TclpSetInitialEncodings();
- TclpFindExecutable(NULL);
- return interp;
+ return dummyInterp.version;
}
void
diff --git a/generic/tclMain.c b/generic/tclMain.c
index f445383..38c4450 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -313,6 +313,8 @@ Tcl_MainEx(
Tcl_Channel chan;
InteractiveState is;
+ TclpSetInitialEncodings();
+ TclpFindExecutable(argv[0]);
Tcl_InitMemory(interp);
is.interp = interp;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index ff887c8..9bceb4c 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3891,8 +3891,10 @@ Tcl_ZlibStreamInit(
Tcl_Obj *dictObj,
Tcl_ZlibStream *zshandle)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
- Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
return TCL_ERROR;
}
@@ -3957,8 +3959,10 @@ Tcl_ZlibDeflate(
int level,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
- Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
return TCL_ERROR;
}
@@ -3970,8 +3974,10 @@ Tcl_ZlibInflate(
int bufferSize,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
- Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
return TCL_ERROR;
}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 0eea33a..d570b23 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -633,9 +633,9 @@ tclLibObjs:
# This targets actually build the objects needed for the lib in the above case
objs: ${OBJS}
-${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE}
+${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${STUB_LIB_FILE}
${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \
- @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \
+ @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ ${STUB_LIB_FILE} \
${CC_SEARCH_FLAGS} -o ${TCL_EXE}
# Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index f3edcff..171c1a4 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -12,8 +12,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#undef BUILD_tcl
-#undef STATIC_BUILD
+#define USE_TCL_STUBS
#include "tcl.h"
#ifdef TCL_TEST
@@ -150,10 +149,10 @@ Tcl_AppInit(
*/
#ifdef DJGPP
- (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY);
#else
- (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY);
#endif
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/tclAppInit.c b/win/tclAppInit.c
index 753eaff..66b2abb 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -13,6 +13,7 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#define USE_TCL_STUBS
#include "tcl.h"
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
@@ -196,7 +197,7 @@ Tcl_AppInit(
* specific startup file will be run under any conditions.
*/
- (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
return TCL_OK;
}
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:
+ */
generated by cgit v0.12 at 2024-11-17 13:24:54 (GMT)