/*******************************************************************************
 *  BDX: Binary Data eXchange format library
 *  Copyright (C) 1999-2006 Thomas Baier
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 * 
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 * 
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, a copy is available at
 *  http://www.r-project.org/Licenses/
 *
 *  Conversion functions from SEXP to BDX and vice versa.
 *
 ******************************************************************************/

#ifndef  _BDX_SEXP_H_
#include "bdx_SEXP.h"
#endif

#include "bdx.h"
#include "bdx_util.h"
#include "Rinternals.h"
/*#include "rproxy_impl.h" */
#include "com_util.h"
#include <stdio.h>
#include <assert.h>

/*
 * prototypes for internal helper functions
 */
static int EXTPTRSXP2LPSTREAM(RCOM_OBJHANDLE pHandle,
			      LPSTREAM* pStream);
#define getSpecialValueFromLogical(x) getSpecialValueFromInteger((x))
static unsigned long getSpecialValueFromInteger(int pSEXPVal);
static unsigned long getSpecialValueFromDouble(double pSEXPVal);
static double getDoubleFromSpecialValue(unsigned long pSpecialValue);

#define BDX_DM_DEFAULT    0UL
#define BDX_DM_UNDEFINED  ((unsigned long) -1)
#define BDX_DM_NO_SPECIAL 1UL

static unsigned long s_data_mode = BDX_DM_UNDEFINED;

/* ==========================================================================
   Implementation
   ========================================================================== */
/* 05-05-19 | baier | handle BDX_GENERIC */
int BDX2SEXP(BDX_Data const* pBDXData,SEXP* pSEXPData)
{
  SEXP lData = NULL;
  SEXP lDimensions = NULL;
  int lTotalSize = 1;
  int lProtectCount = 0;
  int i;

  assert(pSEXPData != NULL);

  switch(pBDXData->type & BDX_CMASK) {
  case BDX_SCALAR:
    /* no DIM attribute */
    break;
  case BDX_ARRAY:
    /* create DIM attribute */
    PROTECT(lDimensions = allocVector(INTSXP,pBDXData->dim_count));
    lProtectCount++;
    for (i = 0;i < pBDXData->dim_count;i++) {
      INTEGER (lDimensions)[i] = pBDXData->dimensions[i];
      lTotalSize *= pBDXData->dimensions[i];
    }
    break;
  default:
    /* unknown/unsupported type */
    UNPROTECT(lProtectCount);
    return -1;
  }

  /* now allocate the SEXP and copy the data */
  switch(pBDXData->type & BDX_SMASK) {
  case BDX_BOOL:
    lData = PROTECT(allocVector(LGLSXP,lTotalSize));
    lProtectCount++;
    for(i = 0;i < lTotalSize;i++) {
      LOGICAL(lData)[i] = pBDXData->data.raw_data[i].bool_value;
    }
    break;
  case BDX_INT:
    lData = PROTECT(allocVector(INTSXP,lTotalSize));
    lProtectCount++;
    for(i = 0;i < lTotalSize;i++) {
      INTEGER(lData)[i] = pBDXData->data.raw_data[i].int_value;
    }
    break;
  case BDX_DOUBLE:
    lData = PROTECT(allocVector(REALSXP,lTotalSize));
    lProtectCount++;
    for(i = 0;i < lTotalSize;i++) {
      REAL(lData)[i] = pBDXData->data.raw_data[i].double_value;
    }
    break;
  case BDX_STRING:
    lData = PROTECT(allocVector(STRSXP,lTotalSize));
    lProtectCount++;
    for(i = 0;i < lTotalSize;i++)
      SET_STRING_ELT(lData, i, mkChar(pBDXData->data.raw_data[i].string_value));
    break;
  case BDX_POINTER:
    /* BDX_POINTER not supported now, trace the contents */
    BDX_ERR(printf("BDX_POINTER found, value is %p\n",
		   pBDXData->data.raw_data[0].ptr));
    *pSEXPData = NULL;
    UNPROTECT(lProtectCount);
    return -1;
  case BDX_HANDLE:
    /* only single COM object supported (no arrays) */
    if((pBDXData->type & BDX_CMASK) != BDX_SCALAR) {
      BDX_ERR(printf("array of BDX_HANDLE found. Not supported\n"));
      *pSEXPData = NULL;
      UNPROTECT(lProtectCount);
      return -1;
    }

    /* marshalled COM object as an LPSTREAM:
     *
     * 1. unmarshal the object from the stream (IDispatch) using
     *    CoGetInterfaceAndReleaseStream()
     * 2. COM object must be Release()d afterwards
     * 3. Stream still valid. Must be released afterwards
     */
    {
      LPSTREAM lStream = pBDXData->data.raw_data[0].ptr;
      LPDISPATCH lDispatch;
      RCOM_OBJHANDLE lHandle;
#if 1
      HRESULT lRc = CoUnmarshalInterface(lStream,&IID_IDispatch,
					 (void*) &lDispatch);
#else
      HRESULT lRc = CoGetInterfaceAndReleaseStream(lStream,&IID_IDispatch,
						   (void*) &lDispatch);
#endif
      if(FAILED(lRc)) {
	BDX_ERR(printf("unmarshalling stream ptr %p failed with hr=%08x\n",
			  lStream,lRc));
	*pSEXPData = NULL;
	UNPROTECT(lProtectCount);
	return -1;
      }

      /* create SEXP for COM object */
      lHandle = com_addObject (lDispatch);
      lData = com_createSEXP(lHandle);
    }
    break;
  case BDX_SPECIAL:
    lData = PROTECT (allocVector (REALSXP,lTotalSize));
    lProtectCount++;
    for(i = 0;i < lTotalSize;i++) {
      REAL(lData)[i] =
	getDoubleFromSpecialValue(pBDXData->data.raw_data[i].special_value);
    }
    break;
  case BDX_GENERIC:
    /* generic array */
    lData = PROTECT(allocVector(VECSXP,lTotalSize));
    lProtectCount++;
    for(i = 0;i < lTotalSize;i++) {
      SEXP lSEXP = NULL;
      /* handle contents */
      switch(pBDXData->data.raw_data_with_type[i].type & BDX_SMASK) {
      case BDX_BOOL:
	lSEXP = allocVector(LGLSXP,1);
	LOGICAL(lSEXP)[0] =
	  pBDXData->data.raw_data_with_type[i].raw_data.bool_value;
	break;
      case BDX_INT:
	lSEXP = allocVector(INTSXP,1);
	INTEGER(lSEXP)[0] =
	  pBDXData->data.raw_data_with_type[i].raw_data.int_value;
	break;
      case BDX_DOUBLE:
	lSEXP = allocVector(REALSXP,1);
	REAL(lSEXP)[0] =
	  pBDXData->data.raw_data_with_type[i].raw_data.double_value;
	break;
      case BDX_STRING:
        lSEXP = mkString(pBDXData->data.raw_data_with_type[i].raw_data.string_value);
	break;
      case BDX_SPECIAL:
	lSEXP = allocVector(REALSXP,1);
	REAL(lSEXP)[0] =
	  getDoubleFromSpecialValue(pBDXData->data.raw_data_with_type[i].raw_data.special_value);
	break;
      default:
	lSEXP = allocVector(REALSXP,1);
	REAL(lSEXP)[0] = 
	  getDoubleFromSpecialValue(BDX_SV_NULL);
	BDX_ERR(printf("unknown BDX type %d in generic vector element %d, using NA\n",
		       pBDXData->data.raw_data_with_type[i].type & BDX_SMASK,
		       i));
      }
      SET_VECTOR_ELT(lData,i,lSEXP);
    }
    break;
  default:
    /* unknown/unsupported BDX type */
    *pSEXPData = NULL;
    BDX_ERR(printf("unknown BDX type %08x, (SMASK %08x)\n",
		      pBDXData->type,pBDXData->type & BDX_SMASK));
    UNPROTECT(lProtectCount);
    return -1;
  }

  if(lDimensions) {
    setAttrib (lData,R_DimSymbol,lDimensions);
  }

  *pSEXPData = lData;
  UNPROTECT(lProtectCount);

  return 0;
}

/* 05-05-24 | baier | VECSXP */
/* 05-06-05 | baier | support for special values (R_NaN,...), generic vectors */
/* 05-06-08 | baier | BDX_SPECIAL for scalars (REALSXP conversions) */
/* 06-02-15 | baier | fixes for COM objects/EXTPTRSXP */
/* 06-06-18 | baier | special values also for LOGICAL and INTEGER */
int SEXP2BDX(struct SEXPREC const* pSexp,BDX_Data** ppBDXData)
{
  BDX_Data* lData;
  SEXP lDimension;
  int lTotalSize = 1;
  int i;
  int lGeneric = 0;
  SEXP sexp = (SEXP) pSexp; /* to get rid of const/non-const warning */
  double lDoubleValue;
  int lLogicalValue;
  int lIntegerValue;

  assert(ppBDXData != NULL);

  *ppBDXData = 0;
  lData = bdx_alloc();

  /*
   * we support the following types at the moment
   *
   *  integer (scalar, vectors and arrays)
   *  real (scalars, vectors and arrays)
   *  logical (scalars, vectors and arrays)
   *  string (scalars, vectors and arrays)
   *  COM objects (IDispatch)
   *  null
   *
   * we should support soon
   *
   *  complex vectors
   *  generic vectors
   * bug: no dimensions stored
   */

  /*
   * zero-length SEXP: this is an error!
   */
  if (LENGTH(sexp) == 0) {
    /* empty/undefined symbol */
    BDX_ERR(printf("SEXP2BDX: SEXP has length 0\n"));
    bdx_free(lData);
    return -6;
  }

  /*
   * find out if the data type is supported
   */
  switch(TYPEOF(sexp)) {
  case NILSXP:
    lData->type |= BDX_SPECIAL;
    break;
  case LGLSXP:
    lData->type |= BDX_BOOL;
    break;
  case INTSXP:
    lData->type |= BDX_INT;
    break;
  case REALSXP:
    lData->type |= BDX_DOUBLE;
    break;
  case EXTPTRSXP:
    lData->type |= BDX_HANDLE;
    break;
  case STRSXP:
    lData->type |= BDX_STRING;
    break;
  case VECSXP:
    /* generic vectors */
    lData->type |= BDX_GENERIC;
    lGeneric = 1;
    break;
  default:
    bdx_free(lData);
    BDX_TRACE(printf("SEXP2BDX: unsupported SEXP type %d\n",
		      TYPEOF(sexp)));
    return -6;
  }

  /*
   * vector/matrix/scalar
   */
  lDimension = getAttrib (sexp,R_DimSymbol);
  PROTECT (lDimension);

  /* get dimension infos, allocate BDX_Dimension[] array */
  if(TYPEOF(lDimension) == INTSXP) {
    /* DIM atribute -> matrix */
    lData->type |= BDX_ARRAY;
    lData->dim_count = LENGTH(lDimension);
    lData->dimensions = (BDX_Dimension*) calloc(lData->dim_count,
						sizeof(BDX_Dimension));
    for (i = 0;i < lData->dim_count;i++) {
      lData->dimensions[i] = INTEGER(lDimension)[i];
      lTotalSize *= lData->dimensions[i];
    }
    /* lData->data.raw_data = (BDX_RawData*) malloc(sizeof(BDX_RawData)); */
  } else if((LENGTH(sexp) == 1) 
	    || (TYPEOF(sexp) == EXTPTRSXP)){
    /* scalar */
    lData->type |= BDX_SCALAR;
    lData->dim_count = 1;
    lData->dimensions = (BDX_Dimension*) malloc(sizeof(BDX_Dimension));
    lData->dimensions[0] = 1;
  } else if(TYPEOF(lDimension) == NILSXP) {
    /* no DIM atribute -> vector (== one-dimensional array) */
    lData->type |= BDX_ARRAY;
    lData->dim_count = 1;
    lData->dimensions = (BDX_Dimension*) malloc(sizeof(BDX_Dimension));
    lData->dimensions[0] = LENGTH(sexp);
    lTotalSize = lData->dimensions[0];
  }

  UNPROTECT(1); /* unlock lDimension */

  if(!lGeneric) {
    /* allocate memory for the data: BDX_RawData or BDX_RawDataWithType */
    lData->data.raw_data = (BDX_RawData*) calloc(lTotalSize,
						 sizeof(BDX_RawData));

    for(i = 0;(i < lTotalSize) && !lGeneric;i++) {
      switch(TYPEOF(sexp)) {
      case NILSXP:
	lData->data.raw_data[i].special_value = BDX_SV_NULL;
	break;
      case LGLSXP:
	/* check special values: R_NaInt */
	lLogicalValue = LOGICAL(sexp)[i];
	if(getSpecialValueFromLogical(lLogicalValue) != BDX_SV_UNK) {
	  lGeneric = 1;
	} else {
	  lData->data.raw_data[i].bool_value = lLogicalValue;
	}
	break;
      case INTSXP:
	/* check special values: R_NaInt */
	lIntegerValue = INTEGER(sexp)[i];
	if(getSpecialValueFromInteger(lIntegerValue) != BDX_SV_UNK) {
	  lGeneric = 1;
	} else {
	  lData->data.raw_data[i].int_value = lIntegerValue;
	}
	break;
      case REALSXP:
	/* check special values: R_NaReal, R_PosInf, R_NaN, R_NegInf */
	lDoubleValue = REAL(sexp)[i];
	if(getSpecialValueFromDouble(lDoubleValue) != BDX_SV_UNK) {
	  lGeneric = 1;
	} else {
	  lData->data.raw_data[i].double_value = lDoubleValue;
	}
	break;
      case EXTPTRSXP:
	/*
	 * according to BDR (mail on r-devel, 05-10-24) an EXTPTRSXP is not
	 * a vector, therefore LENGTH() does not work
	 */
	lTotalSize = 1; 
#if 0
	/* no EXTPTRSXP for arrays */
	if(lTotalSize != 1) {
	  bdx_free(lData);
	  BDX_TRACE(printf("SEXP2BDX[1]: EXTPTRSXP in array with %d elements\n",
			      lTotalSize));
	  return -7;
	}
#endif
	{
	  /* is it a COM object? */
	  RCOM_OBJHANDLE lHandle = com_getHandle(sexp);
	  LPSTREAM lStream = NULL;
	  int lRc = EXTPTRSXP2LPSTREAM(lHandle,&lStream); /* 0 for success */
	  
	  /* COM object is marshalled into stream
	   *
	   * 1. stream object holds reference to IDispatch
	   * 2. reference count is increased in the meanwhile
	   * 3. must use CoGetInterfaceAndReleaseStream() to unmarshal
	   * 4. Release() must be called on object afterwards
	   */
	  if (lRc == 0) {
	    /* we don't support generic pointers */
	    lData->data.raw_data[0].ptr = lStream;
	    lData->type |= BDX_HANDLE;
#if 0
	    if(lStream) {
	      /* marshalled COM object */
	    } else {
	      /* pointer */
	      lData->type |= BDX_POINTER;
	      lData->data.raw_data[0].ptr =
		(unsigned long) R_ExternalPtrAddr(sexp);
	    }
#endif
	  } else {
	    lData->type |= BDX_POINTER;
	    lData->data.raw_data[0].ptr = NULL; /* NULL pointer */
	    BDX_TRACE(printf("SEXP2BDX: error %d marshalling COM object at index %d\n",
				lRc,i));
	    
	  }
	  BDX_TRACE(printf("SEXP2BDX: base=%08x, type=%08x, ptr=%08x\n",
			   lData,lData->type,lData->data.raw_data[0].ptr));
	}
	break;
      case STRSXP:
	lData->data.raw_data[i].string_value = strdup(CHAR(STRING_ELT(sexp,i)));
	if(lData->data.raw_data[i].string_value == NULL) {
	  lData->data.raw_data[i].string_value = strdup("");
	}
	
	break;
      }
    }
  }

  /* VECSXP or REALSXP with special values */
  if(lGeneric) {
    if(lData->data.raw_data) {
      /* memory has been allocated */
      free(lData->data.raw_data);
    }
    if((lData->type & BDX_CMASK) == BDX_SCALAR) {
      /* scalar BDX_SPECIAL */
      lData->type = (lData->type & ~BDX_SMASK) | BDX_SPECIAL;
      lData->data.raw_data[0].special_value =
	getSpecialValueFromDouble(REAL(sexp)[0]);
    } else {
      /* BDX_GENERIC */
      lData->type = (lData->type & ~BDX_SMASK) | BDX_GENERIC;
      lData->data.raw_data_with_type =
	(BDX_RawDataWithType*) calloc(lTotalSize,
				      sizeof(BDX_RawDataWithType));
      switch(TYPEOF(sexp)) {
      case LGLSXP:
	for(i = 0;i < lTotalSize;i++) {
	  lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	  lData->data.raw_data_with_type[i].raw_data.special_value =
	    getSpecialValueFromLogical(LOGICAL(sexp)[i]);
	  if(lData->data.raw_data_with_type[i].raw_data.special_value ==
	     BDX_SV_UNK) {
	    lData->data.raw_data_with_type[i].type = BDX_BOOL;
	    lData->data.raw_data_with_type[i].raw_data.double_value =
	      LOGICAL(sexp)[i];
	  }
	}
	break;
      case INTSXP:
	for(i = 0;i < lTotalSize;i++) {
	  lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	  lData->data.raw_data_with_type[i].raw_data.special_value =
	    getSpecialValueFromInteger(INTEGER(sexp)[i]);
	  if(lData->data.raw_data_with_type[i].raw_data.special_value ==
	     BDX_SV_UNK) {
	    lData->data.raw_data_with_type[i].type = BDX_INT;
	    lData->data.raw_data_with_type[i].raw_data.double_value =
	      LOGICAL(sexp)[i];
	  }
	}
	break;
      case REALSXP:
	for(i = 0;i < lTotalSize;i++) {
	  lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	  lData->data.raw_data_with_type[i].raw_data.special_value =
	    getSpecialValueFromDouble(REAL(sexp)[i]);
	  if(lData->data.raw_data_with_type[i].raw_data.special_value ==
	     BDX_SV_UNK) {
	    lData->data.raw_data_with_type[i].type = BDX_DOUBLE;
	    lData->data.raw_data_with_type[i].raw_data.double_value =
	      REAL(sexp)[i];
	  }
	}
	break;
      default:
	for(i = 0;i < lTotalSize;i++) {
	  SEXP lElementSexp = VECTOR_ELT(sexp,i);
	  switch(TYPEOF(lElementSexp)) {
	  case NILSXP:
	    lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	    lData->data.raw_data_with_type[i].raw_data.special_value = BDX_SV_NULL;
	    break;
	  case LGLSXP:
	    lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	    lData->data.raw_data_with_type[i].raw_data.special_value =
	      getSpecialValueFromLogical(LOGICAL(lElementSexp)[0]);
	    if(lData->data.raw_data_with_type[i].raw_data.special_value == BDX_SV_UNK) {
	      lData->data.raw_data_with_type[i].type = BDX_BOOL;
	      lData->data.raw_data_with_type[i].raw_data.bool_value =
		LOGICAL(lElementSexp)[0];
	    }
	    break;
	  case INTSXP:
	    lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	    lData->data.raw_data_with_type[i].raw_data.special_value =
	      getSpecialValueFromInteger(INTEGER(lElementSexp)[0]);
	    if(lData->data.raw_data_with_type[i].raw_data.special_value == BDX_SV_UNK) {
	      lData->data.raw_data_with_type[i].type = BDX_INT;
	      lData->data.raw_data_with_type[i].raw_data.int_value =
		INTEGER(lElementSexp)[0];
	    }
	    break;
	  case REALSXP:
	    lData->data.raw_data_with_type[i].type = BDX_SPECIAL;
	    lData->data.raw_data_with_type[i].raw_data.special_value =
	      getSpecialValueFromDouble(REAL(lElementSexp)[0]);
	    if(lData->data.raw_data_with_type[i].raw_data.special_value == BDX_SV_UNK) {
	      lData->data.raw_data_with_type[i].type = BDX_DOUBLE;
	      lData->data.raw_data_with_type[i].raw_data.double_value =
		REAL(lElementSexp)[0];
	    }
	    break;
	  case EXTPTRSXP:
	    lData->data.raw_data_with_type[i].type = BDX_HANDLE;
	    /*
	     * according to BDR (mail on r-devel, 05-10-24) an EXTPTRSXP is not
	     * a vector, therefore LENGTH() does not work
	     */
	    lTotalSize = 1; 
	    /* no EXTPTRSXP for arrays */
	    {
	      /* is it a COM object? */
	      RCOM_OBJHANDLE lHandle = com_getHandle(lElementSexp);
	      LPSTREAM lStream = NULL;
	      int lRc = EXTPTRSXP2LPSTREAM(lHandle,&lStream); /* 0 for success */
	      /* COM object is marshalled into stream
	       *
	       * 1. stream object holds reference to IDispatch
	       * 2. reference count is increased in the meanwhile
	       * 3. must use CoGetInterfaceAndReleaseStream() to unmarshal
	       * 4. Release() must be called on object afterwards
	       */
	      if (lRc == 0) {
		/* we don't support generic pointers */
		lData->data.raw_data_with_type[i].raw_data.ptr = lStream;
		lData->type |= BDX_HANDLE;
	      } else {
		lData->type |= BDX_POINTER;
		lData->data.raw_data_with_type[i].raw_data.ptr =
		  NULL; /* NULL pointer */
		BDX_TRACE(printf("SEXP2BDX: error %d marshalling COM object at index %d\n",
				 lRc,i));
	      }
	    }
	    break;
	  case STRSXP:
	    lData->data.raw_data_with_type[i].type = BDX_STRING;
	    lData->data.raw_data_with_type[i].raw_data.string_value =
	      strdup(CHAR(STRING_ELT(lElementSexp,0)));
	    break;
	  default:
	    bdx_free(lData);
	    BDX_TRACE(printf("SEXP2BDX: unsupported SEXP type %d in VECSXP element %d\n",
			     TYPEOF(lElementSexp),i));
	    return -6;
	  }
	}
      }
    }
  }
  *ppBDXData = lData;

  return 0;
}

unsigned long bdx_get_datamode()
{
  return s_data_mode;
}
void bdx_set_datamode(unsigned long pDM)
{
  BDX_TRACE(printf("BDX: data mode set to %08x\n",pDM));
  s_data_mode = pDM;
}

static int EXTPTRSXP2LPSTREAM(RCOM_OBJHANDLE pHandle,
			      LPSTREAM* pStream)
{
  IUnknown* lUnk = NULL;
  LPSTREAM lStream = NULL;
  HRESULT hr = E_FAIL;

  if (pHandle == RCOM_NULLHANDLE) {
    return -1;
  }

  /* valid COM object */
  lUnk = (LPUNKNOWN) com_getObject(pHandle);

  /*
   * Marshal interface into stream (can be unmarshalled in any thread of
   * the same process. This may slow down things a bit, but we're on the
   * safe side if the BDX_Data is processed in a thread different from
   * the current one.
   */
  hr = CoMarshalInterThreadInterfaceInStream(&IID_IUnknown,
					     lUnk,
					     &lStream);
  if(FAILED(hr)) {
    BDX_TRACE(printf("SEXP2BDX: error %08x marshalling interface into stream\n",
		     hr));
    return -5;
  } else {
    *pStream = lStream;
  }
  return 0;
}

/* 06-06-24 | baier | NaN also transforms to IEEE double NaN for dm=1 */
static unsigned long getSpecialValueFromDouble(double pSEXPVal)
{
  if(ISNA(pSEXPVal)) {
    return BDX_SV_NA;
  } else if(pSEXPVal == R_PosInf) {
    if(bdx_get_datamode() == BDX_DM_NO_SPECIAL) {
      return BDX_SV_UNK;
    }
    return BDX_SV_INF;
  } else if(ISNAN(pSEXPVal)) {
    if(bdx_get_datamode() == BDX_DM_NO_SPECIAL) {
      return BDX_SV_UNK;
    }
    return BDX_SV_NAN;
  } else if(pSEXPVal == R_NegInf) {
    if(bdx_get_datamode() == BDX_DM_NO_SPECIAL) {
      return BDX_SV_UNK;
    }
    return BDX_SV_NINF;
  }
  return BDX_SV_UNK;
}
static unsigned long getSpecialValueFromInteger(int pSEXPVal)
{
  if(pSEXPVal == R_NaInt) {
    return BDX_SV_NA;
  }
  return BDX_SV_UNK;
}
static double getDoubleFromSpecialValue(unsigned long pSpecialValue)
{
  switch(pSpecialValue) {
  case BDX_SV_NULL:
  case BDX_SV_NA:
    /* NULL and NA both transform to NA */
    return R_NaReal;
  case BDX_SV_DIV0:
  case BDX_SV_INF:
    /* DIV/0 and +Inf transform to +Inf */
    return R_PosInf;
  case BDX_SV_NAN:
    /* NAN is just NaN */
    return R_NaN;
  case BDX_SV_NINF:
    /* -Inf is -Inf */
    return R_NegInf;
  case BDX_SV_UNK:
  default:
    return R_NaReal;
  }
}