/*
 ****************************************************************************
 *		Gambit-C foreign function interface Additions
 *
 * This file extends Gambit's gambit-c-2.2/run/c-intf.c file to
 * provide conversion from a 32-bit C integer to a Scheme gennum. That is,
 * if the C number is small enough, it is converted into FIXNUM, otherwise
 * a corresponding BIGNUM is created. There is also a function to go
 * the other way around.
 *
 * Note on BIGNUM representation in Gambit (see gambit-c-2.2/run/header.scm)
 * BIGNUM is a vector16
 *	elem 0    = sign (1 means positive, 0 means negative)
 *	slot 1    = least significant digit (in radix 2^14)
 * 	slot 2... = other digits
 * Thus to pack a 32-bit unsigned integer (that is for sure bigger than 2^19-1)
 * we make-vector16 of four elements and set
 * elem[0] = 1 -- meaning positive BIGNUM
 * elem[1] = x % radix -- least significant digit in radix 2^14
 * elem[2] = (x / radix) % radix -- next significant digit
 * elem[3] = x / radix^2 -- most significant digit
 *
 * $Id: c-intf-add.c,v 1.1 1996/05/03 16:12:03 oleg Exp oleg $
 *
 ****************************************************************************
 */
 
#define ___VERSION 4
#include "gambit.h"

		/* Some definitions pertaining to FIXNUm and BIGNUM	*/
		/* taken from run/header.scm				*/
/*(##define-macro (max-fixnum)        268435455) */
			/* complement of the largest FIXNUM */
#define LARGEST_FIXNUM_COMPL (~(___INT(((unsigned int)(-1)))))
/*(##define-macro (radix)                 16384) ; must be <= sqrt(max fixnum)+1*/
#define RADIX_WIDTH	14
#define RADIX_MINUS_1   16383

			/* Allocate a Scheme vector of size n (bytes)	*/
			/* defined in gambit-c-2.2/run/c-intf.c		*/
extern ___WORD alloc_bvector(int n);

			/* Convert x to FIXNUM or BIGNUM (if big enough)*/
			/* The following code supplants the function	*/
			/* defined in gambit-c-2.2/run/c-intf.c		*/
			/* Unlike the latter, the present function can	*/
			/* handle BIGNUM numbers, too.			*/
			/* The function always returns 0 (success)	*/
int ___uint_to_scmobj(const ___U32 x, ___WORD * obj)
{
  if( x & LARGEST_FIXNUM_COMPL )
  {				/* x is too big: pack into BIGNUM */
    const ___WORD vector = alloc_bvector(4*2);		/* (##make-vector16 4) */
    ___U16* vp = (___U16*)(vector-___tSUBTYPED+___WS);	/* skip the 1st word: header */
    *vp++ = 1; 						/* sign positive */
    *vp++ = x & RADIX_MINUS_1;
    *vp++ = (x >> RADIX_WIDTH) & RADIX_MINUS_1;
    *vp++ = x >> (2*RADIX_WIDTH);
    ___HEADER(vector) = (___HEADER(vector)&___LMASK)+(___sBIGNUM<<___TB);
    return *obj = vector, 0;
  }
  else
   return *obj = ___FIX(x), 0;	    /* small enough to fit into FIXNUM */
}

			/* Convert BIGNUM into a "C" unsigned int	*/
			/* (if fits, of course)				*/
			/* If it doesn't, return 1			*/
static int bignum_to_uint(const ___WORD bignum, unsigned int *xp)
{
  register int i = (___VECTOR16LENGTH(bignum))>>___TB;	/* in U16 words	*/
  ___U16* dp = (___U16*)(bignum-___tSUBTYPED+___WS) + i;/* Digit pointer*/
  unsigned int acc;
  while( --i > 0 && *--dp == 0 )	/* Skip leading zeros (if any)	*/
   ;
  if( i == 0 )
    return *xp = 0, 0;			/* All digits are zero		*/
  acc = *dp;
  if( i > 3 || ( i==3 && acc >= (1<<(32-2*RADIX_WIDTH)) ) )
    return 1;				/* BIGNUM is too big for int	*/
 
  while( --i > 0 )
   acc = (acc<<RADIX_WIDTH) | *--dp;

  if( *--dp == 0 )			/* BIGNUM was negative...	*/
    acc = (unsigned)(-(signed)acc);
  return *xp = acc, 0;
}

			/* Convert a Scheme object to a "C" unsigned int*/
			/* (if possible)				*/
			/* The following code supplants the function	*/
			/* defined in gambit-c-2.2/run/c-intf.c		*/
			/* Unlike the latter, the present function can	*/
			/* handle BIGNUM numbers, too.			*/
			/* The function returns 1 if conversion fails	*/
int ___scmobj_to_uint(___WORD obj, unsigned int *xp)
{
  ___WORD ___temp;		/* scrap for Gambit's macros		*/
  if( ___FIXNUMP(obj) )
    return *xp = ___INT(obj), 0;
  else if( ___BIGNUMP(obj) )
    return bignum_to_uint(obj,xp);
  else
    return 1;			/* Only FIXNUM and BIGNUM can be converted */
}