/* -----------------------------------------------------------------------------
 * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
 *
 * (c) The GHC Team, 1998-1999
 *
 * Primitive operations over (64-bit) long longs
 * (only used on 32-bit platforms.)
 *
 * ---------------------------------------------------------------------------*/


/*
Miscellaneous primitive operations on HsInt64 and HsWord64s.
N.B. These are not primops!

Instead of going the normal (boring) route of making the list
of primitive operations even longer to cope with operations
over 64-bit entities, we implement them instead 'out-of-line'.

The primitive ops get their own routine (in C) that implements
the operation, requiring the caller to _ccall_ out. This has
performance implications of course, but we currently don't
expect intensive use of either Int64 or Word64 types.

The exceptions to the rule are primops that cast to and from
64-bit entities (these are defined in PrimOps.h)
*/

#include "Rts.h"

#ifdef SUPPORT_LONG_LONGS

/* Relational operators */

static inline HsBool mkBool(int b) { return b ? HS_BOOL_TRUE : HS_BOOL_FALSE; }

HsBool stg_gtWord64 (HsWord64 a, HsWord64 b) {return mkBool(a >  b);}
HsBool stg_geWord64 (HsWord64 a, HsWord64 b) {return mkBool(a >= b);}
HsBool stg_eqWord64 (HsWord64 a, HsWord64 b) {return mkBool(a == b);}
HsBool stg_neWord64 (HsWord64 a, HsWord64 b) {return mkBool(a != b);}
HsBool stg_ltWord64 (HsWord64 a, HsWord64 b) {return mkBool(a <  b);}
HsBool stg_leWord64 (HsWord64 a, HsWord64 b) {return mkBool(a <= b);}

HsBool stg_gtInt64 (HsInt64 a, HsInt64 b) {return mkBool(a >  b);}
HsBool stg_geInt64 (HsInt64 a, HsInt64 b) {return mkBool(a >= b);}
HsBool stg_eqInt64 (HsInt64 a, HsInt64 b) {return mkBool(a == b);}
HsBool stg_neInt64 (HsInt64 a, HsInt64 b) {return mkBool(a != b);}
HsBool stg_ltInt64 (HsInt64 a, HsInt64 b) {return mkBool(a <  b);}
HsBool stg_leInt64 (HsInt64 a, HsInt64 b) {return mkBool(a <= b);}

/* Arithmetic operators */

HsWord64 stg_remWord64  (HsWord64 a, HsWord64 b) {return a % b;}
HsWord64 stg_quotWord64 (HsWord64 a, HsWord64 b) {return a / b;}

HsInt64 stg_remInt64    (HsInt64 a, HsInt64 b)   {return a % b;}
HsInt64 stg_quotInt64   (HsInt64 a, HsInt64 b)   {return a / b;}
HsInt64 stg_negateInt64 (HsInt64 a)               {return -a;}
HsInt64 stg_plusInt64   (HsInt64 a, HsInt64 b)   {return a + b;}
HsInt64 stg_minusInt64  (HsInt64 a, HsInt64 b)   {return a - b;}
HsInt64 stg_timesInt64  (HsInt64 a, HsInt64 b)   {return a * b;}

/* Logical operators: */

HsWord64 stg_and64      (HsWord64 a, HsWord64 b) {return a & b;}
HsWord64 stg_or64       (HsWord64 a, HsWord64 b) {return a | b;}
HsWord64 stg_xor64      (HsWord64 a, HsWord64 b) {return a ^ b;}
HsWord64 stg_not64      (HsWord64 a)              {return ~a;}

HsWord64 stg_uncheckedShiftL64   (HsWord64 a, HsInt b)    {return a << b;}
HsWord64 stg_uncheckedShiftRL64  (HsWord64 a, HsInt b)    {return a >> b;}
/* Right shifting of signed quantities is not portable in C, so
   the behaviour you'll get from using these primops depends
   on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
*/
HsInt64  stg_uncheckedIShiftL64  (HsInt64 a,  HsInt b)    {return a << b;}
HsInt64  stg_uncheckedIShiftRA64 (HsInt64 a,  HsInt b)    {return a >> b;}
HsInt64  stg_uncheckedIShiftRL64 (HsInt64 a,  HsInt b)
                                    {return (HsInt64) ((HsWord64) a >> b);}

/* Casting between longs and longer longs.
   (the primops that cast from long longs to Integers
   expressed as macros, since these may cause some heap allocation).
*/

HsInt64  stg_intToInt64    (HsInt    i) {return (HsInt64)  i;}
HsInt    stg_int64ToInt    (HsInt64  i) {return (HsInt)    i;}
HsWord64 stg_int64ToWord64 (HsInt64  i) {return (HsWord64) i;}
HsWord64 stg_wordToWord64  (HsWord   w) {return (HsWord64) w;}
HsWord   stg_word64ToWord  (HsWord64 w) {return (HsWord)   w;}
HsInt64  stg_word64ToInt64 (HsWord64 w) {return (HsInt64)  w;}

HsWord64 stg_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da)
{ 
  mp_limb_t* d;
  HsInt s;
  HsWord64 res;
  d = (mp_limb_t *)da;
  s = sa;
  switch (s) {
    case  0: res = 0;     break;
    case  1: res = d[0];  break;
    case -1: res = -(HsWord64)d[0]; break;
    default:
      res = (HsWord64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t)));
      if (s < 0) res = -res;
  }
  return res;
}

HsInt64 stg_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da)
{ 
  mp_limb_t* d;
  HsInt s;
  HsInt64 res;
  d = (mp_limb_t *)da;
  s = (sa);
  switch (s) {
    case  0: res = 0;     break;
    case  1: res = d[0];  break;
    case -1: res = -(HsInt64)d[0]; break;
    default:
      res = (HsInt64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t)));
      if (s < 0) res = -res;
  }
  return res;
}

#endif /* SUPPORT_LONG_LONGS */
