1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
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.12 2002/02/15 14:28:48 dkf Exp $
* RCS: @(#) $Id: tclBinary.c,v 1.13 2003/02/21 21:54:11 dkf Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
#include <math.h>
/*
|
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
|
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
|
-
+
|
int type; /* Format character from "binary scan" */
Tcl_HashTable **numberCachePtrPtr;
/* Place to look for cache of scanned
* value objects, or NULL if too many
* different numbers have been scanned. */
{
long value;
Tcl_WideInt wvalue;
Tcl_WideUInt uwvalue;
/*
* We cannot rely on the compiler to properly sign extend integer values
* when we cast from smaller values to larger values because we don't know
* the exact size of the integer types. So, we have to handle sign
* extension explicitly by checking the high bit and padding with 1's as
* needed.
|
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
|
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
|
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
|
register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
/* Don't need to fiddle with refcount... */
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);
uwvalue = ((Tcl_WideUInt) buffer[0])
| (((Tcl_WideUInt) buffer[1]) << 8)
| (((Tcl_WideUInt) buffer[2]) << 16)
| (((Tcl_WideUInt) buffer[3]) << 24)
| (((Tcl_WideUInt) buffer[4]) << 32)
| (((Tcl_WideUInt) buffer[5]) << 40)
| (((Tcl_WideUInt) buffer[6]) << 48)
| (((Tcl_WideUInt) buffer[7]) << 56);
return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
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);
uwvalue = ((Tcl_WideUInt) buffer[7])
| (((Tcl_WideUInt) buffer[6]) << 8)
| (((Tcl_WideUInt) buffer[5]) << 16)
| (((Tcl_WideUInt) buffer[4]) << 24)
| (((Tcl_WideUInt) buffer[3]) << 32)
| (((Tcl_WideUInt) buffer[2]) << 40)
| (((Tcl_WideUInt) buffer[1]) << 48)
| (((Tcl_WideUInt) buffer[0]) << 56);
return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
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;
}
|