diff options
| -rw-r--r-- | jim-pack.c | 139 | ||||
| -rw-r--r-- | jim_tcl.txt | 21 |
2 files changed, 136 insertions, 24 deletions
@@ -191,9 +191,83 @@ static void JimSetBitsIntLittleEndian(unsigned char *bitvec, jim_wide value, int } /** + * Binary conversion of jim_wide integer to float + * + * Considers the least significant bits of + * jim_wide 'value' as a IEEE float. + * + * Should work for both little- and big-endian platforms. + */ +static float JimIntToFloat(jim_wide value) +{ + int offs; + float val; + + /* Skip offs to get to least significant bytes */ + offs = Jim_IsBigEndian() ? (sizeof(jim_wide) - sizeof(float)) : 0; + + memcpy(&val, (unsigned char *) &value + offs, sizeof(float)); + return val; +} + +/** + * Binary conversion of jim_wide integer to double + * + * Double precision version of JimIntToFloat + */ +static double JimIntToDouble(jim_wide value) +{ + int offs; + double val; + + /* Skip offs to get to least significant bytes */ + offs = Jim_IsBigEndian() ? (sizeof(jim_wide) - sizeof(double)) : 0; + + memcpy(&val, (unsigned char *) &value + offs, sizeof(double)); + return val; +} + +/** + * Binary conversion of float to jim_wide integer + * + * Considers the bits of IEEE float 'value' as integer. + * The integer is zero-extended to jim_wide. + * + * Should work for both little- and big-endian platforms. + */ +static jim_wide JimFloatToInt(float value) +{ + int offs; + jim_wide val = 0; + + /* Skip offs to get to least significant bytes */ + offs = Jim_IsBigEndian() ? (sizeof(jim_wide) - sizeof(float)) : 0; + + memcpy((unsigned char *) &val + offs, &value, sizeof(float)); + return val; +} + +/** + * Binary conversion of double to jim_wide integer + * + * Double precision version of JimFloatToInt + */ +static jim_wide JimDoubleToInt(double value) +{ + int offs; + jim_wide val = 0; + + /* Skip offs to get to least significant bytes */ + offs = Jim_IsBigEndian() ? (sizeof(jim_wide) - sizeof(double)) : 0; + + memcpy((unsigned char *) &val + offs, &value, sizeof(double)); + return val; +} + +/** * [unpack] * - * Usage: unpack binvalue -intbe|-intle|-uintbe|-uintle|-str bitpos bitwidth + * Usage: unpack binvalue -intbe|-intle|-uintbe|-uintle|-floatbe|-floatle|-str bitpos bitwidth * * Unpacks bits from $binvalue at bit position $bitpos and with $bitwidth. * Interprets the value according to the type and returns it. @@ -201,13 +275,15 @@ static void JimSetBitsIntLittleEndian(unsigned char *bitvec, jim_wide value, int static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { int option; - static const char * const options[] = { "-intbe", "-intle", "-uintbe", "-uintle", "-str", NULL }; - enum { OPT_INTBE, OPT_INTLE, OPT_UINTBE, OPT_UINTLE, OPT_STR, }; + static const char * const options[] = { "-intbe", "-intle", "-uintbe", "-uintle", + "-floatbe", "-floatle", "-str", NULL }; + enum { OPT_INTBE, OPT_INTLE, OPT_UINTBE, OPT_UINTLE, OPT_FLOATBE, OPT_FLOATLE, OPT_STR, }; jim_wide pos; jim_wide width; if (argc != 5) { - Jim_WrongNumArgs(interp, 1, argv, "binvalue -intbe|-intle|-uintbe|-uintle|-str bitpos bitwidth"); + Jim_WrongNumArgs(interp, 1, argv, + "binvalue -intbe|-intle|-uintbe|-uintle|-floatbe|-floatle|-str bitpos bitwidth"); return JIM_ERR; } if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { @@ -252,7 +328,7 @@ static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (pos + width > len * 8) { width = len * 8 - pos; } - if (option == OPT_INTBE || option == OPT_UINTBE) { + if (option == OPT_INTBE || option == OPT_UINTBE || option == OPT_FLOATBE) { result = JimBitIntBigEndian(str, pos, width); } else { @@ -261,8 +337,23 @@ static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) if (option == OPT_INTBE || option == OPT_INTLE) { result = JimSignExtend(result, width); } + + } + + if (option == OPT_FLOATBE || option == OPT_FLOATLE) { + double fresult; + if (width == 32) { + fresult = (double) JimIntToFloat(result); + } else if (width == 64) { + fresult = JimIntToDouble(result); + } else { + Jim_SetResultFormatted(interp, "float field has bad bitwidth: %#s", argv[4]); + return JIM_ERR; + } + Jim_SetResult(interp, Jim_NewDoubleObj(interp, fresult)); + } else { + Jim_SetResultInt(interp, result); } - Jim_SetResultInt(interp, result); return JIM_OK; } } @@ -270,7 +361,7 @@ static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) /** * [pack] * - * Usage: pack varname value -intle|-intbe|-str width ?bitoffset? + * Usage: pack varname value -intbe|-intle|-floatle|-floatbe|-str width ?bitoffset? * * Packs the binary representation of 'value' into the variable of the given name. * The value is packed according to the given type, width and bitoffset. @@ -280,30 +371,39 @@ static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { int option; - static const char * const options[] = { "-intle", "-intbe", "-str", NULL }; - enum { OPT_LE, OPT_BE, OPT_STR }; + static const char * const options[] = { "-intle", "-intbe", "-floatle", "-floatbe", + "-str", NULL }; + enum { OPT_LE, OPT_BE, OPT_FLOATLE, OPT_FLOATBE, OPT_STR }; jim_wide pos = 0; jim_wide width; jim_wide value; + double fvalue; Jim_Obj *stringObjPtr; int len; int freeobj = 0; if (argc != 5 && argc != 6) { - Jim_WrongNumArgs(interp, 1, argv, "varName value -intle|-intbe|-str bitwidth ?bitoffset?"); + Jim_WrongNumArgs(interp, 1, argv, + "varName value -intle|-intbe|-floatle|-floatbe|-str bitwidth ?bitoffset?"); return JIM_ERR; } if (Jim_GetEnum(interp, argv[3], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } - if (option != OPT_STR && Jim_GetWide(interp, argv[2], &value) != JIM_OK) { + if ((option == OPT_LE || option == OPT_BE) && + Jim_GetWide(interp, argv[2], &value) != JIM_OK) { + return JIM_ERR; + } + if ((option == OPT_FLOATLE || option == OPT_FLOATBE) && + Jim_GetDouble(interp, argv[2], &fvalue) != JIM_OK) { return JIM_ERR; } if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) { return JIM_ERR; } - if (width <= 0 || (option == OPT_STR && width % 8) || (option != OPT_STR && width > sizeof(jim_wide) * 8)) { - Jim_SetResultFormatted(interp, "bad bitwidth: %#s", argv[5]); + if (width <= 0 || (option == OPT_STR && width % 8) || (option != OPT_STR && width > sizeof(jim_wide) * 8) || + ((option == OPT_FLOATLE || option == OPT_FLOATBE) && width != 32 && width != 64)) { + Jim_SetResultFormatted(interp, "bad bitwidth: %#s", argv[4]); return JIM_ERR; } if (argc == 6) { @@ -342,10 +442,19 @@ static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) */ Jim_AppendString(interp, stringObjPtr, "", 0); - if (option == OPT_BE) { + /* Convert floating point to integer if necessary */ + if (option == OPT_FLOATLE || option == OPT_FLOATBE) { + /* Note that the following is slightly incompatible with Tcl behaviour. + * In Tcl floating overflow gives FLT_MAX (cf. test binary-13.13). + * In Jim Tcl it gives Infinity. This behavior may change. + */ + value = (width == 32) ? JimFloatToInt((float)fvalue) : JimDoubleToInt(fvalue); + } + + if (option == OPT_BE || option == OPT_FLOATBE) { JimSetBitsIntBigEndian((unsigned char *)stringObjPtr->bytes, value, pos, width); } - else if (option == OPT_LE) { + else if (option == OPT_LE || option == OPT_FLOATLE) { JimSetBitsIntLittleEndian((unsigned char *)stringObjPtr->bytes, value, pos, width); } else { diff --git a/jim_tcl.txt b/jim_tcl.txt index 07e5c12..bb197a7 100644 --- a/jim_tcl.txt +++ b/jim_tcl.txt @@ -4662,21 +4662,22 @@ pack: pack, unpack ~~~~~~~~~~~~~~~~~~ The optional 'pack' extension provides commands to encode and decode binary strings. -+*pack* 'varName value' *-intle|-intbe|-str* 'bitwidth ?bitoffset?'+:: ++*pack* 'varName value' *-intle|-intbe|-floatle|-floatbe|-str* 'bitwidth ?bitoffset?'+:: Packs the binary representation of +'value'+ into the variable +'varName'+. The value is packed according to the given type - (integer/string, big-endian/little-endian), width and bit offset. + (integer/floating point/string, big-endian/little-endian), width and bit offset. The variable is created if necessary (like `append`). Ihe variable is expanded if necessary. -+*unpack* 'binvalue' *-intbe|-intle|-uintbe|-uintle|-str* 'bitpos bitwidth'+:: ++*unpack* 'binvalue' *-intbe|-intle|-uintbe|-uintle|-floatbe|-floatle|-str* 'bitpos bitwidth'+:: Unpacks bits from +'binvalue'+ at bit position +'bitpos'+ and with +'bitwidth'+. - Interprets the value according to the type (integer/string, big-endian/little-endian + Interprets the value according to the type (integer/floating point/string, big-endian/little-endian and signed/unsigned) and returns it. For integer types, +'bitwidth'+ - may be up to the size of a Jim Tcl integer (typically 64 bits). For the string type, - both the width and the offset must be on a byte boundary (multiple of 8). Attempting to - access outside the length of the value will return 0 for integer types or the empty string - for the string type. + may be up to the size of a Jim Tcl integer (typically 64 bits). For floating point types, + +'bitwidth'+ may be 32 bits (for single precision numbers) or 64 bits (for double precision). + For the string type, both the width and the offset must be on a byte boundary (multiple of 8). Attempting to + access outside the length of the value will return 0 for integer types, 0.0 for floating point types + or the empty string for the string type. binary ~~~~~~ @@ -4685,7 +4686,9 @@ commands based on the low-level `pack` and `unpack` commands. See the Tcl documentation at: http://www.tcl.tk/man/tcl8.5/TclCmd/binary.htm -Note that packing and unpacking of floating point values is not supported. +Packing and unpacking of floating point values is supported as an experimental feature. +Note that 'binary format' with f/r/R specifiers (single-precision float) uses the value of Infinity + in case of overflow. oo: class, super ~~~~~~~~~~~~~~~~ |