/*
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...
