Ticket [ecf13be4c9] Multi interpreter solution

Author: oehhar

generic/tclsample.c

@@ -28,14 +28,23 @@
 static const unsigned char itoa64f[] =
         "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_,";
 
-static int numcontexts = 0;
-static SHA1_CTX *sha1Contexts = NULL;
-static Tcl_Size *ctxtotalRead = NULL;
+#define DIGESTSIZE 20
+
+/*
+ * The procedure needs interpreter local state. This is called
+ * "Command client data" in TCL. Typically, a struct is allocated and
+ * the pointer to it is made available on each operation by TCL.
+ * Here is the struct for the sha1 procedure.
+ */
+
+struct Sha1ClientData {
+    int numcontexts;
+    SHA1_CTX *sha1Contexts;
+    Tcl_Size *ctxtotalRead;
+};
 
 static int Sha1_Cmd(void *clientData, Tcl_Interp *interp,
 		int objc, Tcl_Obj *const objv[]);
-
-#define DIGESTSIZE 20
 
 /*
  *----------------------------------------------------------------------
@@ -55,12 +64,18 @@ static int Sha1_Cmd(void *clientData, Tcl_Interp *interp,
 
 static int
 Sha1_Cmd(
-    void *dummy,	/* Not used. */
+    ClientData clientData,	/* Client data with thread local state */
     Tcl_Interp *interp,		/* Current interpreter */
     int objc,			/* Number of arguments */
     Tcl_Obj *const objv[]	/* Argument strings */
     )
 {
+    /*
+     * Get my thread local memory
+     */
+
+    struct Sha1ClientData *sha1ClientDataPtr = clientData;
+
     /*
      * The default base is hex
      */
@@ -72,15 +87,13 @@ Sha1_Cmd(
     Tcl_Channel copychan = NULL;
     int mode;
     int contextnum = 0;
-#define sha1Context (sha1Contexts[contextnum])
     char *bufPtr;
     Tcl_WideInt maxbytes = 0;
     int doinit = 1;
     int dofinal = 1;
     Tcl_Obj *descriptorObj = NULL;
     Tcl_Size totalRead = 0, n;
     int i, j, mask, bits, offset;
-    (void)dummy;
 
     /*
      * For binary representation + null char
@@ -113,24 +126,26 @@ Sha1_Cmd(
 	}
 	switch ((enum ShaOpts) index) {
 	case SHAOPT_INIT:
-	    for (contextnum = 1; contextnum < numcontexts; contextnum++) {
-		if (ctxtotalRead[contextnum] == -1) {
+	    for (contextnum = 1; contextnum < sha1ClientDataPtr->numcontexts; contextnum++) {
+		if (sha1ClientDataPtr->ctxtotalRead[contextnum] == -1) {
 		    break;
 		}
 	    }
-	    if (contextnum == numcontexts) {
+	    if (contextnum == sha1ClientDataPtr->numcontexts) {
 		/*
 		 * Allocate a new context.
 		 */
 
-		numcontexts++;
-		sha1Contexts = (SHA1_CTX *) ckrealloc((void *) sha1Contexts,
-			numcontexts * sizeof(SHA1_CTX));
-		ctxtotalRead = (Tcl_Size *)ckrealloc(ctxtotalRead,
-			numcontexts * sizeof(Tcl_Size));
+		sha1ClientDataPtr->numcontexts++;
+		sha1ClientDataPtr->sha1Contexts = (SHA1_CTX *) ckrealloc(
+			(void *) sha1ClientDataPtr->sha1Contexts,
+			sha1ClientDataPtr->numcontexts * sizeof(SHA1_CTX));
+		sha1ClientDataPtr->ctxtotalRead = (Tcl_Size *)ckrealloc(
+			sha1ClientDataPtr->ctxtotalRead,
+			sha1ClientDataPtr->numcontexts * sizeof(Tcl_Size));
 	    }
-	    ctxtotalRead[contextnum] = 0;
-	    SHA1Init(&sha1Context);
+	    sha1ClientDataPtr->ctxtotalRead[contextnum] = 0;
+	    SHA1Init(&sha1ClientDataPtr->sha1Contexts[contextnum]);
 	    snprintf(buf, sizeof(buf), "sha1%d", contextnum);
 	    Tcl_AppendResult(interp, buf, NULL);
 	    return TCL_OK;
@@ -188,16 +203,16 @@ Sha1_Cmd(
 
     if (descriptorObj != NULL) {
 	if ((sscanf(Tcl_GetString(descriptorObj), "sha1%d",
-		&contextnum) != 1) || (contextnum >= numcontexts) ||
-		(ctxtotalRead[contextnum] == -1)) {
+		&contextnum) != 1) || (contextnum >= sha1ClientDataPtr->numcontexts) ||
+		(sha1ClientDataPtr->ctxtotalRead[contextnum] == -1)) {
 	    Tcl_AppendResult(interp, "invalid sha1 descriptor \"",
 		    Tcl_GetString(descriptorObj), "\"", NULL);
 	    return TCL_ERROR;
 	}
     }
 
     if (doinit) {
-	SHA1Init(&sha1Context);
+	SHA1Init(&sha1ClientDataPtr->sha1Contexts[contextnum]);
     }
 
     if (stringObj != NULL) {
@@ -206,10 +221,17 @@ Sha1_Cmd(
 	    goto wrongArgs;
 	}
 	string = Tcl_GetStringFromObj(stringObj, &totalRead);
-	SHA1Update(&sha1Context, (unsigned char *) string, totalRead);
+	SHA1Update(&sha1ClientDataPtr->sha1Contexts[contextnum],
+		(unsigned char *) string, totalRead);
     } else if (chan != NULL) {
 	bufPtr = (char *)ckalloc(TCL_READ_CHUNK_SIZE);
 	totalRead = 0;
+	/*
+	 * FIXME: MS-VC 2015 gives the following warning in the next line I
+	 * was not able to fix (translated from German):
+	 * warning C4244: "Function": Conversion of "Tcl_WideInt" to "int",
+	 * possible data loss
+	 */
 	while ((n = Tcl_Read(chan, bufPtr,
 		maxbytes == 0
 		? TCL_READ_CHUNK_SIZE
@@ -226,7 +248,8 @@ Sha1_Cmd(
 
 	    totalRead += n;
 
-	    SHA1Update(&sha1Context, (unsigned char *) bufPtr, n);
+	    SHA1Update(&sha1ClientDataPtr->sha1Contexts[contextnum],
+		    (unsigned char *) bufPtr, n);
 
 	    if (copychan != NULL) {
 		n = Tcl_Write(copychan, bufPtr, n);
@@ -250,17 +273,17 @@ Sha1_Cmd(
     }
 
     if (!dofinal) {
-	ctxtotalRead[contextnum] += totalRead;
+	sha1ClientDataPtr->ctxtotalRead[contextnum] += totalRead;
 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(totalRead));
 	return TCL_OK;
     }
 
     if (stringObj == NULL) {
-	totalRead += ctxtotalRead[contextnum];
+	totalRead += sha1ClientDataPtr->ctxtotalRead[contextnum];
 	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(totalRead));
     }
 
-    SHA1Final(&sha1Context, digest);
+    SHA1Final(&sha1ClientDataPtr->sha1Contexts[contextnum], digest);
 
     /*
      * Take the 20 byte array and print it in the requested base
@@ -297,7 +320,7 @@ Sha1_Cmd(
     buf[j++] = '\0';
     Tcl_AppendResult(interp, buf, NULL);
     if (contextnum > 0) {
-	ctxtotalRead[contextnum] = -1;
+	sha1ClientDataPtr->ctxtotalRead[contextnum] = -1;
     }
     return TCL_OK;
 
@@ -325,6 +348,42 @@ Sha1_Cmd(
 	    NULL);
     return TCL_ERROR;
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Sha1_CmdDeleteProc --
+ *
+ *	 Clear all thread data of the Sha1 command.
+ *
+ * Results:
+ *	No result
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Sha1_CmdDeleteProc(ClientData clientData)
+{
+    struct Sha1ClientData *sha1ClientDataPtr = clientData;
+    
+    /*
+     * Release the sha1 contextes
+     */
+    
+    ckfree(sha1ClientDataPtr->sha1Contexts);
+    ckfree(sha1ClientDataPtr->ctxtotalRead);
+
+    /*
+     * Release the procedure client data
+     */
+
+    ckfree(sha1ClientDataPtr);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -358,6 +417,7 @@ Sample_Init(
     Tcl_Interp* interp)		/* Tcl interpreter */
 {
     Tcl_CmdInfo info;
+    struct Sha1ClientData *sha1ClientDataPtr;
 
     /*
      * Require compatible TCL version.
@@ -368,10 +428,35 @@ Sample_Init(
      * Note that Tcl_InitStubs is a macro, which is replaced by a Tcl version
      * check only, if TCL_STUBS is not defined (e.g. direct link, static build)
      */
+
     if (Tcl_InitStubs(interp, "8.1-", 0) == NULL) {
 	return TCL_ERROR;
     }
 
+    /*
+     * Init the sha1 context queues
+     */
+
+    sha1ClientDataPtr = ckalloc(sizeof(struct Sha1ClientData));
+    sha1ClientDataPtr->numcontexts = 1;
+    sha1ClientDataPtr->sha1Contexts = (SHA1_CTX *) ckalloc(sizeof(SHA1_CTX));
+    sha1ClientDataPtr->ctxtotalRead = (Tcl_Size *) ckalloc(sizeof(Tcl_Size));
+
+    /*
+     * Create the sha1 command.
+     * Pass the client data pointer to the procedure, so the queue data is
+     * available.
+     * Also, register a delete proc to clear the sha1 queue on deletion.
+     */
+
+    Tcl_CreateObjCommand(
+	    interp, "sha1", (Tcl_ObjCmdProc *)Sha1_Cmd,
+	    sha1ClientDataPtr, Sha1_CmdDeleteProc);
+
+    /*
+     * Create the buildinfo command if tcl supports it
+     */
+
     if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
 	Tcl_CreateObjCommand(interp, "::sample::build-info",
 		info.objProc, (void *)(
@@ -434,13 +519,6 @@ Sample_Init(
     if (Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION, NULL) != TCL_OK) {
 	return TCL_ERROR;
     }
-    Tcl_CreateObjCommand(interp, "sha1", (Tcl_ObjCmdProc *)Sha1_Cmd,
-	    NULL, NULL);
-
-    numcontexts = 1;
-    sha1Contexts = (SHA1_CTX *) ckalloc(sizeof(SHA1_CTX));
-    ctxtotalRead = (Tcl_Size *) ckalloc(sizeof(Tcl_Size));
-    ctxtotalRead[0] = 0;
 
     return TCL_OK;
 }