1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
/*
* tclBinary.c --
*
* This file contains the implementation of the "binary" Tcl built-in
* command and the Tcl binary data object.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclBinary.c,v 1.13.4.4 2004/09/30 00:51:32 dgp Exp $
*/
#include "tclInt.h"
#ifdef TCL_NO_MATH
#define fabs(x) (x<0 ? -x : x)
#else
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
/*
* tclBinary.c --
*
* This file contains the implementation of the "binary" Tcl built-in
* command and the Tcl binary data object.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclBinary.c,v 1.13.4.5 2004/10/28 18:46:19 dgp Exp $
*/
#include "tclInt.h"
#ifdef TCL_NO_MATH
#define fabs(x) (x<0 ? -x : x)
#else
|
| ︙ | | | ︙ | |
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
|
int value = 0; /* Current integer value to be packed.
* Initialized to avoid compiler warning. */
char cmd; /* Current format character. */
int count; /* Count associated with current format
* character. */
char *format; /* Pointer to current position in format
* string. */
Tcl_Obj *resultPtr; /* Object holding result buffer. */
unsigned char *buffer; /* Start of result buffer. */
unsigned char *cursor; /* Current position within result buffer. */
unsigned char *maxPos; /* Greatest position within result buffer that
* cursor has visited.*/
char *errorString, *errorValue, *str;
int offset, size, length, index;
static CONST char *options[] = {
|
|
|
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
|
int value = 0; /* Current integer value to be packed.
* Initialized to avoid compiler warning. */
char cmd; /* Current format character. */
int count; /* Count associated with current format
* character. */
char *format; /* Pointer to current position in format
* string. */
Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */
unsigned char *buffer; /* Start of result buffer. */
unsigned char *cursor; /* Current position within result buffer. */
unsigned char *maxPos; /* Greatest position within result buffer that
* cursor has visited.*/
char *errorString, *errorValue, *str;
int offset, size, length, index;
static CONST char *options[] = {
|
| ︙ | | | ︙ | |
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
|
}
/*
* Prepare the result object by preallocating the caclulated
* number of bytes and filling with nulls.
*/
resultPtr = Tcl_GetObjResult(interp);
buffer = Tcl_SetByteArrayLength(resultPtr, length);
memset((VOID *) buffer, 0, (size_t) length);
/*
* Pack the data into the result object. Note that we can skip
* the error checking during this pass, since we have already
* parsed the string once.
|
|
|
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
|
}
/*
* Prepare the result object by preallocating the caclulated
* number of bytes and filling with nulls.
*/
resultPtr = Tcl_NewObj();
buffer = Tcl_SetByteArrayLength(resultPtr, length);
memset((VOID *) buffer, 0, (size_t) length);
/*
* Pack the data into the result object. Note that we can skip
* the error checking during this pass, since we have already
* parsed the string once.
|
| ︙ | | | ︙ | |
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
|
} else {
cursor = buffer + count;
}
break;
}
}
}
break;
}
case BINARY_SCAN: {
int i;
Tcl_Obj *valuePtr, *elementPtr;
Tcl_HashTable numberCacheHash;
Tcl_HashTable *numberCachePtr;
|
>
|
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
|
} else {
cursor = buffer + count;
}
break;
}
}
}
Tcl_SetObjResult(interp, resultPtr);
break;
}
case BINARY_SCAN: {
int i;
Tcl_Obj *valuePtr, *elementPtr;
Tcl_HashTable numberCacheHash;
Tcl_HashTable *numberCachePtr;
|
| ︙ | | | ︙ | |
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
|
}
/*
* Set the result to the last position of the cursor.
*/
done:
Tcl_ResetResult(interp);
Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
DeleteScanNumberCache(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;
|
<
|
|
|
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
|
}
/*
* Set the result to the last position of the cursor.
*/
done:
Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4));
DeleteScanNumberCache(numberCachePtr);
break;
}
}
return TCL_OK;
badValue:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected ", errorString,
" string but got \"", errorValue, "\" instead", NULL);
return TCL_ERROR;
badCount:
errorString = "missing count for \"@\" field specifier";
goto error;
|
| ︙ | | | ︙ | |