/* 
 * 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.21 2004/10/06 05:52:21 dgp Exp $
 * RCS: @(#) $Id: tclBinary.c,v 1.21.4.1 2005/06/13 01:45:42 msofer Exp $
 */

#include "tclInt.h"

#ifdef TCL_NO_MATH
#define fabs(x) (x<0 ? -x : x)
#else
#include <math.h>
#endif

/*
 * The following constants are used by GetFormatSpec to indicate various
 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL -1		/* Use all elements in the argument. */

    switch (type) {
    case 'd':
    case 'q':
    case 'Q':
	/*
	 * Double-precision floating point values.
	 * Tcl_GetDoubleFromObj returns TCL_ERROR for NaN, but
	 * we can check by comparing the object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    if ( src->typePtr != &tclDoubleType ) {
	    return TCL_ERROR;
		return TCL_ERROR;
	    }
	    dvalue = src->internalRep.doubleValue;
	}
	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
	*cursorPtr += sizeof(double);
	return TCL_OK;

    case 'f':
    case 'r':
    case 'R':
	/*
	 * Single-precision floating point values.
	 * Tcl_GetDoubleFromObj returns TCL_ERROR for NaN, but
	 * we can check by comparing the object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    if ( src->typePtr != &tclDoubleType ) {
	    return TCL_ERROR;
		return TCL_ERROR;
	    }
	    dvalue = src->internalRep.doubleValue;
	}

	/*
	 * Because some compilers will generate floating point exceptions
	 * on an overflow cast (e.g. Borland), we restrict the values
	 * to the valid range for float.
	 */