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 objv) { 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(objv1, &len); if (len == 0) { return TCL_ERROR; } /* ... and reverse it */ p1 = 0; p2 = len -1; while (p1 < p2) { ch = buffPtrp1; buffPtrp1 = buffPtrp2; buffPtrp2 = 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 objv) { 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(objv1, &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++) outPtri*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(objv1)) oPtr = Tcl_DuplicateObj(objv1); else oPtr = objv1; 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...