Updated 2017-08-22 12:56:48 by pooryorick

Authored by Lino Monaco.
 /*
  Binary Buffer Reverse
  Lino Monaco - 16 March 2007
  
  Just a little extension example using a Windows DLL.
  
  Compile and link declaring USE_TCL_STUBS symbol and including
  tclstub84.lib.
  
  load ./bytereverse.dll
  
  bytereverse <binary buffer to reverse>
  bytepattern <binary buffer to repeat> <repeat number>
  
  It can be loaded and used with tclkit too
 */
 
 #include <tcl.h>
 
 int reverse_ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objvg) {
    int len, p1, p2;
    unsigned char *buffPtr, ch;
 
    Tcl_Obj * resultPtr;
 
    /* Check input parameters */
    if (objc != 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "binary_buffer_to_reverse");
      return TCL_ERROR;
    }
    /* get input byte array ... */
    buffPtr = Tcl_GetByteArrayFromObj(objv[1], &len);
    if (len == 0) {
      return TCL_ERROR;
    }
    /* ... and reverse it */
    p1 = 0;
    p2 = len -1;
    while (p1 < p2) {
      ch = buffPtr[p1];
      buffPtr[p1] = buffPtr[p2];
      buffPtr[p2] = ch;
      p1++;
      p2--;
    }
    
    /* return revesed buffer */
    resultPtr = Tcl_GetObjResult(interp);
    Tcl_SetByteArrayObj(resultPtr, buffPtr, len);
    return TCL_OK;
 }
 
 int pattern_ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objvg) {
    int buffLen, outLen, len;
    int i, j;
    unsigned char *buffPtr;
    unsigned char *outPtr;
 
    Tcl_Obj * resultPtr;
 
    /* Check Input parameters */
    if (objc != 3) {
      Tcl_WrongNumArgs(interp, 1, objv, "binary_buffer_to_repeat repeat_number");
      return TCL_ERROR;
    }
    
    /* get first input parameter */
    buffPtr = Tcl_GetByteArrayFromObj(objv[1], &buffLen);
    if (buffLen == 0) {
      return TCL_ERROR;
    }
 
    /* get second input parameter */
    if (Tcl_GetIntFromObj(interp, objv2, &len) != TCL_OK) {
        return TCL_ERROR;
    }
    
    /* set output buffer length */
    resultPtr = Tcl_GetObjResult(interp);
    outLen = len*buffLen;
    outPtr = Tcl_SetByteArrayLength(resultPtr, outLen);
 
    /* fill output buffer */
    for(i=0; i<len; i++)
      for(j=0; j<buffLen; j++)
        outPtr[i*buffLen + j] = buffPtrj;
 
    /* return output buffer */
    Tcl_SetByteArrayObj(resultPtr, outPtr, outLen);
    return TCL_OK;
 }
 
 int __declspec(dllexport) Bytereverse_Init(Tcl_Interp *interp) {
 
    Tcl_Obj * resultPtr;
    
    /* Initialize the stub interface */
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
      return TCL_ERROR;
    }
 
    /* Create bytereverse command */
    Tcl_CreateObjCommand(interp, "bytereverse", reverse_ObjCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    
    /* Create bytepattern command */
    Tcl_CreateObjCommand(interp, "bytepattern", pattern_ObjCmd,
        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    
    /* Declare bytereverse package*/
    Tcl_PkgProvide(interp, "bytereverse", "1.0");
    return TCL_OK;
 }

HaO: IMHO, 'reverse_ObjCmd' should not modify the byte representation of the input object. It should first check if it is shared and make a copy if so (which is practically always the case).

As an optimization, this object may be directly returned. For this, the string representation must be invalidated.
Tcl_Obj oPtr;
if (Tcl_IsShared(objv[1]))
    oPtr = Tcl_DuplicateObj(objv[1]);
else
    oPtr = objv[1];

buffPtr = Tcl_GetByteArrayFromObj(oPtr, &len);
Tcl_InvalidateStringRep(oPtr);
...
/* return output buffer */
/* Tcl_SetByteArrayObj(resultPtr, outPtr, outLen); */
Tcl_SetObjResult( interp, oPtr);

I hope, the return value reference count is correct in the non-shared case. As Tcl_SetObjResult increments the reference count, this might be wrong...