#include "tclInt.h"
#include "tclPort.h"
#include <math.h>
#define BINARY_ALL -1
#define BINARY_NOCOUNT -2
#define BINARY_SCAN_MAX_CACHE 260
static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr));
static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
Tcl_Obj *src, unsigned char **cursorPtr));
static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int GetFormatSpec _ANSI_ARGS_((char **formatPtr,
char *cmdPtr, int *countPtr));
static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer,
int type, Tcl_HashTable **numberCachePtr));
static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
Tcl_ObjType tclByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
UpdateStringOfByteArray,
SetByteArrayFromAny
};
typedef struct ByteArray {
int used;
int allocated;
unsigned char bytes[4];
} ByteArray;
#define BYTEARRAY_SIZE(len) \
((unsigned) (sizeof(ByteArray) - 4 + (len)))
#define GET_BYTEARRAY(objPtr) \
((ByteArray *) (objPtr)->internalRep.otherValuePtr)
#define SET_BYTEARRAY(objPtr, baPtr) \
(objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewByteArrayObj
Tcl_Obj *
Tcl_NewByteArrayObj(bytes, length)
CONST unsigned char *bytes;
int length;
{
return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
}
#else
Tcl_Obj *
Tcl_NewByteArrayObj(bytes, length)
CONST unsigned char *bytes;
int length;
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
Tcl_SetByteArrayObj(objPtr, bytes, length);
return objPtr;
}
#endif
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(bytes, length, file, line)
CONST unsigned char *bytes;
int length;
CONST char *file;
int line;
{
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetByteArrayObj(objPtr, bytes, length);
return objPtr;
}
#else
Tcl_Obj *
Tcl_DbNewByteArrayObj(bytes, length, file, line)
CONST unsigned char *bytes;
int length;
CONST char *file;
int line;
{
return Tcl_NewByteArrayObj(bytes, length);
}
#endif
void
Tcl_SetByteArrayObj(objPtr, bytes, length)
Tcl_Obj *objPtr;
CONST unsigned char *bytes;
int length;
{
Tcl_ObjType *typePtr;
ByteArray *byteArrayPtr;
if (Tcl_IsShared(objPtr)) {
panic("Tcl_SetByteArrayObj called with shared object");
}
typePtr = objPtr->typePtr;
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
}
Tcl_InvalidateStringRep(objPtr);
byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
byteArrayPtr->used = length;
byteArrayPtr->allocated = length;
memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
unsigned char *
Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
Tcl_Obj *objPtr;
int *lengthPtr;
{
ByteArray *baPtr;
SetByteArrayFromAny(NULL, objPtr);
baPtr = GET_BYTEARRAY(objPtr);
if (lengthPtr != NULL) {
*lengthPtr = baPtr->used;
}
return (unsigned char *) baPtr->bytes;
}
unsigned char *
Tcl_SetByteArrayLength(objPtr, length)
Tcl_Obj *objPtr;
int length;
{
ByteArray *byteArrayPtr, *newByteArrayPtr;
if (Tcl_IsShared(objPtr)) {
panic("Tcl_SetObjLength called with shared object");
}
if (objPtr->typePtr != &tclByteArrayType) {
SetByteArrayFromAny(NULL, objPtr);
}
byteArrayPtr = GET_BYTEARRAY(objPtr);
if (length > byteArrayPtr->allocated) {
newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
newByteArrayPtr->used = length;
newByteArrayPtr->allocated = length;
memcpy((VOID *) newByteArrayPtr->bytes,
(VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
ckfree((char *) byteArrayPtr);
byteArrayPtr = newByteArrayPtr;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
Tcl_InvalidateStringRep(objPtr);
byteArrayPtr->used = length;
return byteArrayPtr->bytes;
}
static int
SetByteArrayFromAny(interp, objPtr)
Tcl_Interp *interp;
Tcl_Obj *objPtr;
{
Tcl_ObjType *typePtr;
int length;
char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
Tcl_UniChar ch;
typePtr = objPtr->typePtr;
if (typePtr != &tclByteArrayType) {
src = Tcl_GetStringFromObj(objPtr, &length);
srcEnd = src + length;
byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
src += Tcl_UtfToUniChar(src, &ch);
*dst++ = (unsigned char) ch;
}
byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
(*typePtr->freeIntRepProc)(objPtr);
}
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
}
return TCL_OK;
}
static void
FreeByteArrayInternalRep(objPtr)
Tcl_Obj *objPtr;
{
ckfree((char *) GET_BYTEARRAY(objPtr));
}
static void
DupByteArrayInternalRep(srcPtr, copyPtr)
Tcl_Obj *srcPtr;
Tcl_Obj *copyPtr;
{
int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
srcArrayPtr = GET_BYTEARRAY(srcPtr);
length = srcArrayPtr->used;
copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
(size_t) length);
SET_BYTEARRAY(copyPtr, copyArrayPtr);
copyPtr->typePtr = &tclByteArrayType;
}
static void
UpdateStringOfByteArray(objPtr)
Tcl_Obj *objPtr;
{
int i, length, size;
unsigned char *src;
char *dst;
ByteArray *byteArrayPtr;
byteArrayPtr = GET_BYTEARRAY(objPtr);
src = byteArrayPtr->bytes;
length = byteArrayPtr->used;
size = length;
for (i = 0; i < length; i++) {
if ((src[i] == 0) || (src[i] > 127)) {
size++;
}
}
dst = (char *) ckalloc((unsigned) (size + 1));
objPtr->bytes = dst;
objPtr->length = size;
if (size == length) {
memcpy((VOID *) dst, (VOID *) src, (size_t) size);
dst[size] = '\0';
} else {
for (i = 0; i < length; i++) {
dst += Tcl_UniCharToUtf(src[i], dst);
}
*dst = '\0';
}
}
int
Tcl_BinaryObjCmd(dummy, interp, objc, objv)
ClientData dummy;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
int arg;
int value = 0;
char cmd;
int count;
char *format;
Tcl_Obj *resultPtr;
unsigned char *buffer;
unsigned char *cursor;
unsigned char *maxPos;
char *errorString, *errorValue, *str;
int offset, size, length, index;
static CONST char *options[] = {
"format", "scan", NULL
};
enum options {
BINARY_FORMAT, BINARY_SCAN
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case BINARY_FORMAT: {
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
return TCL_ERROR;
}
format = Tcl_GetString(objv[2]);
arg = 3;
offset = 0;
length = 0;
while (*format != '\0') {
str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
break;
}
switch (cmd) {
case 'a':
case 'A':
case 'b':
case 'B':
case 'h':
case 'H': {
if (arg >= objc) {
goto badIndex;
}
if (count == BINARY_ALL) {
Tcl_GetByteArrayFromObj(objv[arg], &count);
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
arg++;
if (cmd == 'a' || cmd == 'A') {
offset += count;
} else if (cmd == 'b' || cmd == 'B') {
offset += (count + 7) / 8;
} else {
offset += (count + 1) / 2;
}
break;
}
case 'c': {
size = 1;
goto doNumbers;
}
case 's':
case 'S': {
size = 2;
goto doNumbers;
}
case 'i':
case 'I': {
size = 4;
goto doNumbers;
}
case 'w':
case 'W': {
size = 8;
goto doNumbers;
}
case 'f': {
size = sizeof(float);
goto doNumbers;
}
case 'd': {
size = sizeof(double);
doNumbers:
if (arg >= objc) {
goto badIndex;
}
if (count == BINARY_NOCOUNT) {
arg++;
count = 1;
} else {
int listc;
Tcl_Obj **listv;
if (Tcl_ListObjGetElements(interp, objv[arg++],
&listc, &listv) != TCL_OK) {
return TCL_ERROR;
}
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
Tcl_AppendResult(interp,
"number of elements in list does not match count",
(char *) NULL);
return TCL_ERROR;
}
}
offset += count*size;
break;
}
case 'x': {
if (count == BINARY_ALL) {
Tcl_AppendResult(interp,
"cannot use \"*\" in format string with \"x\"",
(char *) NULL);
return TCL_ERROR;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
offset += count;
break;
}
case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if ((count > offset) || (count == BINARY_ALL)) {
count = offset;
}
if (offset > length) {
length = offset;
}
offset -= count;
break;
}
case '@': {
if (offset > length) {
length = offset;
}
if (count == BINARY_ALL) {
offset = length;
} else if (count == BINARY_NOCOUNT) {
goto badCount;
} else {
offset = count;
}
break;
}
default: {
errorString = str;
goto badfield;
}
}
}
if (offset > length) {
length = offset;
}
if (length == 0) {
return TCL_OK;
}
resultPtr = Tcl_GetObjResult(interp);
buffer = Tcl_SetByteArrayLength(resultPtr, length);
memset((VOID *) buffer, 0, (size_t) length);
arg = 3;
format = Tcl_GetString(objv[2]);
cursor = buffer;
maxPos = cursor;
while (*format != 0) {
if (!GetFormatSpec(&format, &cmd, &count)) {
break;
}
if ((count == 0) && (cmd != '@')) {
arg++;
continue;
}
switch (cmd) {
case 'a':
case 'A': {
char pad = (char) (cmd == 'a' ? '\0' : ' ');
unsigned char *bytes;
bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
count = length;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
if (length >= count) {
memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) count);
} else {
memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) length);
memset((VOID *) (cursor + length), pad,
(size_t) (count - length));
}
cursor += count;
break;
}
case 'b':
case 'B': {
unsigned char *last;
str = Tcl_GetStringFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
count = length;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
last = cursor + ((count + 7) / 8);
if (count > length) {
count = length;
}
value = 0;
errorString = "binary";
if (cmd == 'B') {
for (offset = 0; offset < count; offset++) {
value <<= 1;
if (str[offset] == '1') {
value |= 1;
} else if (str[offset] != '0') {
errorValue = str;
goto badValue;
}
if (((offset + 1) % 8) == 0) {
*cursor++ = (unsigned char) value;
value = 0;
}
}
} else {
for (offset = 0; offset < count; offset++) {
value >>= 1;
if (str[offset] == '1') {
value |= 128;
} else if (str[offset] != '0') {
errorValue = str;
goto badValue;
}
if (!((offset + 1) % 8)) {
*cursor++ = (unsigned char) value;
value = 0;
}
}
}
if ((offset % 8) != 0) {
if (cmd == 'B') {
value <<= 8 - (offset % 8);
} else {
value >>= 8 - (offset % 8);
}
*cursor++ = (unsigned char) value;
}
while (cursor < last) {
*cursor++ = '\0';
}
break;
}
case 'h':
case 'H': {
unsigned char *last;
int c;
str = Tcl_GetStringFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
count = length;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
last = cursor + ((count + 1) / 2);
if (count > length) {
count = length;
}
value = 0;
errorString = "hexadecimal";
if (cmd == 'H') {
for (offset = 0; offset < count; offset++) {
value <<= 4;
if (!isxdigit(UCHAR(str[offset]))) {
errorValue = str;
goto badValue;
}
c = str[offset] - '0';
if (c > 9) {
c += ('0' - 'A') + 10;
}
if (c > 16) {
c += ('A' - 'a');
}
value |= (c & 0xf);
if (offset % 2) {
*cursor++ = (char) value;
value = 0;
}
}
} else {
for (offset = 0; offset < count; offset++) {
value >>= 4;
if (!isxdigit(UCHAR(str[offset]))) {
errorValue = str;
goto badValue;
}
c = str[offset] - '0';
if (c > 9) {
c += ('0' - 'A') + 10;
}
if (c > 16) {
c += ('A' - 'a');
}
value |= ((c << 4) & 0xf0);
if (offset % 2) {
*cursor++ = (unsigned char)(value & 0xff);
value = 0;
}
}
}
if (offset % 2) {
if (cmd == 'H') {
value <<= 4;
} else {
value >>= 4;
}
*cursor++ = (unsigned char) value;
}
while (cursor < last) {
*cursor++ = '\0';
}
break;
}
case 'c':
case 's':
case 'S':
case 'i':
case 'I':
case 'w':
case 'W':
case 'd':
case 'f': {
int listc, i;
Tcl_Obj **listv;
if (count == BINARY_NOCOUNT) {
listv = (Tcl_Obj**)(objv + arg);
listc = 1;
count = 1;
} else {
Tcl_ListObjGetElements(interp, objv[arg],
&listc, &listv);
if (count == BINARY_ALL) {
count = listc;
}
}
arg++;
for (i = 0; i < count; i++) {
if (FormatNumber(interp, cmd, listv[i], &cursor)
!= TCL_OK) {
return TCL_ERROR;
}
}
break;
}
case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
memset(cursor, 0, (size_t) count);
cursor += count;
break;
}
case 'X': {
if (cursor > maxPos) {
maxPos = cursor;
}
if (count == BINARY_NOCOUNT) {
count = 1;
}
if ((count == BINARY_ALL)
|| (count > (cursor - buffer))) {
cursor = buffer;
} else {
cursor -= count;
}
break;
}
case '@': {
if (cursor > maxPos) {
maxPos = cursor;
}
if (count == BINARY_ALL) {
cursor = maxPos;
} else {
cursor = buffer + count;
}
break;
}
}
}
break;
}
case BINARY_SCAN: {
int i;
Tcl_Obj *valuePtr, *elementPtr;
Tcl_HashTable numberCacheHash;
Tcl_HashTable *numberCachePtr;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"value formatString ?varName varName ...?");
return TCL_ERROR;
}
numberCachePtr = &numberCacheHash;
Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
format = Tcl_GetString(objv[3]);
cursor = buffer;
arg = 4;
offset = 0;
while (*format != '\0') {
str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
goto done;
}
switch (cmd) {
case 'a':
case 'A': {
unsigned char *src;
if (arg >= objc) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
goto badIndex;
}
if (count == BINARY_ALL) {
count = length - offset;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count > (length - offset)) {
goto done;
}
}
src = buffer + offset;
size = count;
if (cmd == 'A') {
while (size > 0) {
if (src[size-1] != '\0' && src[size-1] != ' ') {
break;
}
size--;
}
}
valuePtr = Tcl_NewByteArrayObj(src, size);
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
Tcl_DecrRefCount(valuePtr);
return TCL_ERROR;
}
offset += count;
break;
}
case 'b':
case 'B': {
unsigned char *src;
char *dest;
if (arg >= objc) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
goto badIndex;
}
if (count == BINARY_ALL) {
count = (length - offset) * 8;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count > (length - offset) * 8) {
goto done;
}
}
src = buffer + offset;
valuePtr = Tcl_NewObj();
Tcl_SetObjLength(valuePtr, count);
dest = Tcl_GetString(valuePtr);
if (cmd == 'b') {
for (i = 0; i < count; i++) {
if (i % 8) {
value >>= 1;
} else {
value = *src++;
}
*dest++ = (char) ((value & 1) ? '1' : '0');
}
} else {
for (i = 0; i < count; i++) {
if (i % 8) {
value <<= 1;
} else {
value = *src++;
}
*dest++ = (char) ((value & 0x80) ? '1' : '0');
}
}
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
Tcl_DecrRefCount(valuePtr);
return TCL_ERROR;
}
offset += (count + 7 ) / 8;
break;
}
case 'h':
case 'H': {
char *dest;
unsigned char *src;
int i;
static char hexdigit[] = "0123456789abcdef";
if (arg >= objc) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
goto badIndex;
}
if (count == BINARY_ALL) {
count = (length - offset)*2;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if (count > (length - offset)*2) {
goto done;
}
}
src = buffer + offset;
valuePtr = Tcl_NewObj();
Tcl_SetObjLength(valuePtr, count);
dest = Tcl_GetString(valuePtr);
if (cmd == 'h') {
for (i = 0; i < count; i++) {
if (i % 2) {
value >>= 4;
} else {
value = *src++;
}
*dest++ = hexdigit[value & 0xf];
}
} else {
for (i = 0; i < count; i++) {
if (i % 2) {
value <<= 4;
} else {
value = *src++;
}
*dest++ = hexdigit[(value >> 4) & 0xf];
}
}
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
Tcl_DecrRefCount(valuePtr);
return TCL_ERROR;
}
offset += (count + 1) / 2;
break;
}
case 'c': {
size = 1;
goto scanNumber;
}
case 's':
case 'S': {
size = 2;
goto scanNumber;
}
case 'i':
case 'I': {
size = 4;
goto scanNumber;
}
case 'w':
case 'W': {
size = 8;
goto scanNumber;
}
case 'f': {
size = sizeof(float);
goto scanNumber;
}
case 'd': {
unsigned char *src;
size = sizeof(double);
scanNumber:
if (arg >= objc) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
goto badIndex;
}
if (count == BINARY_NOCOUNT) {
if ((length - offset) < size) {
goto done;
}
valuePtr = ScanNumber(buffer+offset, cmd,
&numberCachePtr);
offset += size;
} else {
if (count == BINARY_ALL) {
count = (length - offset) / size;
}
if ((length - offset) < (count * size)) {
goto done;
}
valuePtr = Tcl_NewObj();
src = buffer+offset;
for (i = 0; i < count; i++) {
elementPtr = ScanNumber(src, cmd,
&numberCachePtr);
src += size;
Tcl_ListObjAppendElement(NULL, valuePtr,
elementPtr);
}
offset += count*size;
}
resultPtr = Tcl_ObjSetVar2(interp, objv[arg],
NULL, valuePtr, TCL_LEAVE_ERR_MSG);
arg++;
if (resultPtr == NULL) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
Tcl_DecrRefCount(valuePtr);
return TCL_ERROR;
}
break;
}
case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if ((count == BINARY_ALL)
|| (count > (length - offset))) {
offset = length;
} else {
offset += count;
}
break;
}
case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
if ((count == BINARY_ALL) || (count > offset)) {
offset = 0;
} else {
offset -= count;
}
break;
}
case '@': {
if (count == BINARY_NOCOUNT) {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
goto badCount;
}
if ((count == BINARY_ALL) || (count > length)) {
offset = length;
} else {
offset = count;
}
break;
}
default: {
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
errorString = str;
goto badfield;
}
}
}
done:
Tcl_ResetResult(interp);
Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
if (numberCachePtr != NULL) {
Tcl_DeleteHashTable(numberCachePtr);
}
break;
}
}
return TCL_OK;
badValue:
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
" string but got \"", errorValue, "\" instead", NULL);
return TCL_ERROR;
badCount:
errorString = "missing count for \"@\" field specifier";
goto error;
badIndex:
errorString = "not enough arguments for all format specifiers";
goto error;
badfield: {
Tcl_UniChar ch;
char buf[TCL_UTF_MAX + 1];
Tcl_UtfToUniChar(errorString, &ch);
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
return TCL_ERROR;
}
error:
Tcl_AppendResult(interp, errorString, NULL);
return TCL_ERROR;
}
static int
GetFormatSpec(formatPtr, cmdPtr, countPtr)
char **formatPtr;
char *cmdPtr;
int *countPtr;
{
while (**formatPtr == ' ') {
(*formatPtr)++;
}
if (!(**formatPtr)) {
return 0;
}
*cmdPtr = **formatPtr;
(*formatPtr)++;
if (**formatPtr == '*') {
(*formatPtr)++;
(*countPtr) = BINARY_ALL;
} else if (isdigit(UCHAR(**formatPtr))) {
(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
} else {
(*countPtr) = BINARY_NOCOUNT;
}
return 1;
}
static int
FormatNumber(interp, type, src, cursorPtr)
Tcl_Interp *interp;
int type;
Tcl_Obj *src;
unsigned char **cursorPtr;
{
long value;
double dvalue;
Tcl_WideInt wvalue;
switch (type) {
case 'd':
case 'f':
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
return TCL_ERROR;
}
if (type == 'd') {
memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
*cursorPtr += sizeof(double);
} else {
float fvalue;
if (fabs(dvalue) > (double)FLT_MAX) {
fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
} else {
fvalue = (float) dvalue;
}
memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
*cursorPtr += sizeof(float);
}
return TCL_OK;
case 'w':
case 'W':
if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (type == 'w') {
*(*cursorPtr)++ = (unsigned char) wvalue;
*(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
} else {
*(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
*(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
*(*cursorPtr)++ = (unsigned char) wvalue;
}
return TCL_OK;
default:
if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
if (type == 'c') {
*(*cursorPtr)++ = (unsigned char) value;
} else if (type == 's') {
*(*cursorPtr)++ = (unsigned char) value;
*(*cursorPtr)++ = (unsigned char) (value >> 8);
} else if (type == 'S') {
*(*cursorPtr)++ = (unsigned char) (value >> 8);
*(*cursorPtr)++ = (unsigned char) value;
} else if (type == 'i') {
*(*cursorPtr)++ = (unsigned char) value;
*(*cursorPtr)++ = (unsigned char) (value >> 8);
*(*cursorPtr)++ = (unsigned char) (value >> 16);
*(*cursorPtr)++ = (unsigned char) (value >> 24);
} else if (type == 'I') {
*(*cursorPtr)++ = (unsigned char) (value >> 24);
*(*cursorPtr)++ = (unsigned char) (value >> 16);
*(*cursorPtr)++ = (unsigned char) (value >> 8);
*(*cursorPtr)++ = (unsigned char) value;
}
return TCL_OK;
}
}
static Tcl_Obj *
ScanNumber(buffer, type, numberCachePtrPtr)
unsigned char *buffer;
int type;
Tcl_HashTable **numberCachePtrPtr;
{
long value;
Tcl_WideInt wvalue;
switch (type) {
case 'c':
value = buffer[0];
if (value & 0x80) {
value |= -0x100;
}
goto returnNumericObject;
case 's':
value = (long) (buffer[0] + (buffer[1] << 8));
goto shortValue;
case 'S':
value = (long) (buffer[1] + (buffer[0] << 8));
shortValue:
if (value & 0x8000) {
value |= -0x10000;
}
goto returnNumericObject;
case 'i':
value = (long) (buffer[0]
+ (buffer[1] << 8)
+ (buffer[2] << 16)
+ (buffer[3] << 24));
goto intValue;
case 'I':
value = (long) (buffer[3]
+ (buffer[2] << 8)
+ (buffer[1] << 16)
+ (buffer[0] << 24));
intValue:
if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
value -= (((unsigned int)1)<<31);
value -= (((unsigned int)1)<<31);
}
returnNumericObject:
if (*numberCachePtrPtr == NULL) {
return Tcl_NewLongObj(value);
} else {
register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
register Tcl_HashEntry *hPtr;
int isNew;
hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew);
if (!isNew) {
return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
}
if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) {
Tcl_DeleteHashTable(tablePtr);
*numberCachePtrPtr = NULL;
return Tcl_NewLongObj(value);
} else {
register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
Tcl_SetHashValue(hPtr, (ClientData) objPtr);
return objPtr;
}
}
case 'w':
value = (long) (buffer[4]
| (buffer[5] << 8)
| (buffer[6] << 16)
| (buffer[7] << 24));
wvalue = ((Tcl_WideInt) value) << 32 | (buffer[0]
| (buffer[1] << 8)
| (buffer[2] << 16)
| (buffer[3] << 24));
return Tcl_NewWideIntObj(wvalue);
case 'W':
value = (long) (buffer[3]
| (buffer[2] << 8)
| (buffer[1] << 16)
| (buffer[0] << 24));
wvalue = ((Tcl_WideInt) value) << 32 | (buffer[7]
| (buffer[6] << 8)
| (buffer[5] << 16)
| (buffer[4] << 24));
return Tcl_NewWideIntObj(wvalue);
case 'f': {
float fvalue;
memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
return Tcl_NewDoubleObj(fvalue);
}
case 'd': {
double dvalue;
memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
return Tcl_NewDoubleObj(dvalue);
}
}
return NULL;
}