summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-07-05 21:18:14 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-07-05 21:18:14 (GMT)
commitb70197afbdb6e71461ae861830db8f544fc47505 (patch)
treeb66ee0bc1d9995dfd54be7ef3fa6d9d8a30024ac
parentbf7695058ddedaee83cf8f2386277dded31a5260 (diff)
downloadtcl-b70197afbdb6e71461ae861830db8f544fc47505.zip
tcl-b70197afbdb6e71461ae861830db8f544fc47505.tar.gz
tcl-b70197afbdb6e71461ae861830db8f544fc47505.tar.bz2
* generic/tclCmdAH.c New "encoding" Tcl_ObjType (not registered)
* generic/tclEncoding.c that permits longer lifetimes of the * generic/tclInt.h Tcl_Encoding values kept as intreps of Tcl_Obj's. Reduces the need for repeated reading of encoding definition files from the filesystem. [Bug 1077262]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdAH.c15
-rw-r--r--generic/tclEncoding.c90
-rw-r--r--generic/tclInt.h4
4 files changed, 104 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index a9c5495..a8c435e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
2005-07-05 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclCmdAH.c New "encoding" Tcl_ObjType (not registered)
+ * generic/tclEncoding.c that permits longer lifetimes of the
+ * generic/tclInt.h Tcl_Encoding values kept as intreps of
+ Tcl_Obj's. Reduces the need for repeated reading of encoding
+ definition files from the filesystem. [Bug 1077262]
+
* generic/tclNamesp.c: Allow for [namespace import] of a command
* tests/namespace.test: over a previous [namespace import] of itself
without throwing an error. [RFE 1230597]
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 9c9fe7e..545af15 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.12 2005/06/17 23:26:20 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.13 2005/07/05 21:18:23 dgp Exp $
*/
#include "tclInt.h"
@@ -440,24 +440,21 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv)
switch ((enum options) index) {
case ENC_CONVERTTO:
case ENC_CONVERTFROM: {
- char *name;
Tcl_Obj *data;
if (objc == 3) {
- name = NULL;
+ encoding = Tcl_GetEncoding(interp, NULL);
data = objv[2];
} else if (objc == 4) {
- name = Tcl_GetString(objv[2]);
+ if (TclGetEncodingFromObj(interp, objv[2], &encoding)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
data = objv[3];
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
return TCL_ERROR;
}
- encoding = Tcl_GetEncoding(interp, name);
- if (!encoding) {
- return TCL_ERROR;
- }
-
if ((enum options) index == ENC_CONVERTFROM) {
/*
* Treat the string as binary data.
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index d35cd4c..efe5905 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEncoding.c,v 1.16.2.6 2004/11/12 23:42:00 hobbs Exp $
+ * RCS: @(#) $Id: tclEncoding.c,v 1.16.2.7 2005/07/05 21:18:23 dgp Exp $
*/
#include "tclInt.h"
@@ -178,6 +178,8 @@ static int BinaryProc _ANSI_ARGS_((ClientData clientData,
Tcl_EncodingState *statePtr, char *dst, int dstLen,
int *srcReadPtr, int *dstWrotePtr,
int *dstCharsPtr));
+static void DupEncodingIntRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *dupPtr));
static void EscapeFreeProc _ANSI_ARGS_((ClientData clientData));
static int EscapeFromUtfProc _ANSI_ARGS_((ClientData clientData,
CONST char *src, int srcLen, int flags,
@@ -190,6 +192,7 @@ static int EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
int *srcReadPtr, int *dstWrotePtr,
int *dstCharsPtr));
static void FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
+static void FreeEncodingIntRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static Encoding * GetTableEncoding _ANSI_ARGS_((
EscapeEncodingData *dataPtr, int state));
static Tcl_Encoding LoadEncodingFile _ANSI_ARGS_((Tcl_Interp *interp,
@@ -239,6 +242,91 @@ static int UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
int *dstCharsPtr));
static int TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
+/*
+ * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep.
+ * This should help the lifetime of encodings be more useful.
+ * See concerns raised in [Bug 1077262].
+ */
+
+static Tcl_ObjType EncodingType = {
+ "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetEncodingFromObj --
+ *
+ * Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr),
+ * if possible, and returns TCL_OK. If no such encoding exists,
+ * TCL_ERROR is returned, and if interp is non-NULL, an error message
+ * is written there.
+ *
+ * Results:
+ * Standard Tcl return code.
+ *
+ * Side effects:
+ * Caches the Tcl_Encoding value as the internal rep of (*objPtr).
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclGetEncodingFromObj(interp, objPtr, encodingPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ Tcl_Encoding *encodingPtr;
+{
+ CONST char *name = Tcl_GetString(objPtr);
+ if (objPtr->typePtr != &EncodingType) {
+ Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
+
+ if (encoding == NULL) {
+ return TCL_ERROR;
+ }
+ if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.otherValuePtr = (VOID *) encoding;
+ objPtr->typePtr = &EncodingType;
+ }
+ *encodingPtr = Tcl_GetEncoding(NULL, name);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEncodingIntRep --
+ *
+ * The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeEncodingIntRep(objPtr)
+ Tcl_Obj *objPtr;
+{
+ Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupEncodingIntRep --
+ *
+ * The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DupEncodingIntRep(srcPtr, dupPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *dupPtr;
+{
+ dupPtr->internalRep.otherValuePtr = (VOID *)
+ Tcl_GetEncoding(NULL, srcPtr->bytes);
+}
/*
*---------------------------------------------------------------------------
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 115866d..d3f1ce1 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.118.2.15 2005/06/24 18:21:40 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.16 2005/07/05 21:18:23 dgp Exp $
*/
#ifndef _TCLINT
@@ -1668,6 +1668,8 @@ EXTERN void TclFinalizeNotifier _ANSI_ARGS_((void));
EXTERN void TclFinalizePreserve _ANSI_ARGS_((void));
EXTERN void TclFinalizeSynchronization _ANSI_ARGS_((void));
EXTERN void TclFinalizeThreadData _ANSI_ARGS_((void));
+EXTERN int TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr));
EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
char *pattern, Tcl_Obj *unquotedPrefix,
int globFlags, Tcl_GlobTypeData* types));