diff options
author | dkf <dkf@noemail.net> | 2002-02-15 14:28:46 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2002-02-15 14:28:46 (GMT) |
commit | 76f21db3e4ff07d10bc0f4fb6b55feb05b67247a (patch) | |
tree | edaf81ee6d40edeacc9f3e2093ddcb2ba302c620 /generic/tclBinary.c | |
parent | 128a1ec632cd69ee32ae5bb3095470002b277211 (diff) | |
download | tcl-76f21db3e4ff07d10bc0f4fb6b55feb05b67247a.zip tcl-76f21db3e4ff07d10bc0f4fb6b55feb05b67247a.tar.gz tcl-76f21db3e4ff07d10bc0f4fb6b55feb05b67247a.tar.bz2 |
TIP#72 implementation. See ChangeLog for details.
This version builds clean on Solaris/SPARC, with GCC and CC, both with and
without threads and both in 32-bit and 64-bit mode.
FossilOrigin-Name: 8d82de1905ada4c5d06f5fb967721e8b681b7c82
Diffstat (limited to 'generic/tclBinary.c')
-rw-r--r-- | generic/tclBinary.c | 78 |
1 files changed, 72 insertions, 6 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c index f2d9327..c8ff568 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -10,12 +10,12 @@ * 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.11 2002/01/17 04:37:33 dgp Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.12 2002/02/15 14:28:48 dkf Exp $ */ -#include <math.h> #include "tclInt.h" #include "tclPort.h" +#include <math.h> /* * The following constants are used by GetFormatSpec to indicate various @@ -665,6 +665,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) size = 4; goto doNumbers; } + case 'w': + case 'W': { + size = 8; + goto doNumbers; + } case 'f': { size = sizeof(float); goto doNumbers; @@ -945,6 +950,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) case 'S': case 'i': case 'I': + case 'w': + case 'W': case 'd': case 'f': { int listc, i; @@ -1222,6 +1229,11 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) size = 4; goto scanNumber; } + case 'w': + case 'W': { + size = 8; + goto scanNumber; + } case 'f': { size = sizeof(float); goto scanNumber; @@ -1455,8 +1467,11 @@ FormatNumber(interp, type, src, cursorPtr) { long value; double dvalue; + Tcl_WideInt wvalue; - if ((type == 'd') || (type == 'f')) { + switch (type) { + case 'd': + case 'f': /* * For floating point types, we need to copy the data using * memcpy to avoid alignment issues. @@ -1485,7 +1500,38 @@ FormatNumber(interp, type, src, cursorPtr) memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float)); *cursorPtr += sizeof(float); } - } else { + return TCL_OK; + + /* + * Next cases separate from other integer cases because we + * need a different API to get a wide. + */ + 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; } @@ -1508,8 +1554,8 @@ FormatNumber(interp, type, src, cursorPtr) *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) value; } + return TCL_OK; } - return TCL_OK; } /* @@ -1542,6 +1588,7 @@ ScanNumber(buffer, type, numberCachePtrPtr) * different numbers have been scanned. */ { long value; + Tcl_WideInt wvalue; /* * We cannot rely on the compiler to properly sign extend integer values @@ -1630,7 +1677,26 @@ ScanNumber(buffer, type, numberCachePtrPtr) 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)); |