cbits/longlong.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * Primitive operations over (64-bit) long longs
   7  * (only used on 32-bit platforms.)
   8  *
   9  * ---------------------------------------------------------------------------*/
  10
  11
  12 /*
  13 Miscellaneous primitive operations on StgInt64 and StgWord64s.
  14 N.B. These are not primops!
  15
  16 Instead of going the normal (boring) route of making the list
  17 of primitive operations even longer to cope with operations
  18 over 64-bit entities, we implement them instead 'out-of-line'.
  19
  20 The primitive ops get their own routine (in C) that implements
  21 the operation, requiring the caller to _ccall_ out. This has
  22 performance implications of course, but we currently don't
  23 expect intensive use of either Int64 or Word64 types.
  24
  25 The exceptions to the rule are primops that cast to and from
  26 64-bit entities (these are defined in PrimOps.h)
  27 */
  28
  29 #include "Rts.h"
  30
  31 #ifdef SUPPORT_LONG_LONGS
  32
  33 /* Relational operators */
  34
  35 StgBool stg_gtWord64 (StgWord64 a, StgWord64 b) {return a >  b;}
  36 StgBool stg_geWord64 (StgWord64 a, StgWord64 b) {return a >= b;}
  37 StgBool stg_eqWord64 (StgWord64 a, StgWord64 b) {return a == b;}
  38 StgBool stg_neWord64 (StgWord64 a, StgWord64 b) {return a != b;}
  39 StgBool stg_ltWord64 (StgWord64 a, StgWord64 b) {return a <  b;}
  40 StgBool stg_leWord64 (StgWord64 a, StgWord64 b) {return a <= b;}
  41
  42 StgBool stg_gtInt64 (StgInt64 a, StgInt64 b) {return a >  b;}
  43 StgBool stg_geInt64 (StgInt64 a, StgInt64 b) {return a >= b;}
  44 StgBool stg_eqInt64 (StgInt64 a, StgInt64 b) {return a == b;}
  45 StgBool stg_neInt64 (StgInt64 a, StgInt64 b) {return a != b;}
  46 StgBool stg_ltInt64 (StgInt64 a, StgInt64 b) {return a <  b;}
  47 StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;}
  48
  49 /* Arithmetic operators */
  50
  51 StgWord64 stg_remWord64  (StgWord64 a, StgWord64 b) {return a % b;}
  52 StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;}
  53
  54 StgInt64 stg_remInt64    (StgInt64 a, StgInt64 b)   {return a % b;}
  55 StgInt64 stg_quotInt64   (StgInt64 a, StgInt64 b)   {return a / b;}
  56 StgInt64 stg_negateInt64 (StgInt64 a)               {return -a;}
  57 StgInt64 stg_plusInt64   (StgInt64 a, StgInt64 b)   {return a + b;}
  58 StgInt64 stg_minusInt64  (StgInt64 a, StgInt64 b)   {return a - b;}
  59 StgInt64 stg_timesInt64  (StgInt64 a, StgInt64 b)   {return a * b;}
  60
  61 /* Logical operators: */
  62
  63 StgWord64 stg_and64      (StgWord64 a, StgWord64 b) {return a & b;}
  64 StgWord64 stg_or64       (StgWord64 a, StgWord64 b) {return a | b;}
  65 StgWord64 stg_xor64      (StgWord64 a, StgWord64 b) {return a ^ b;}
  66 StgWord64 stg_not64      (StgWord64 a)              {return ~a;}
  67
  68 StgWord64 stg_uncheckedShiftL64   (StgWord64 a, StgInt b)    {return a << b;}
  69 StgWord64 stg_uncheckedShiftRL64  (StgWord64 a, StgInt b)    {return a >> b;}
  70 /* Right shifting of signed quantities is not portable in C, so
  71    the behaviour you'll get from using these primops depends
  72    on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
  73 */
  74 StgInt64  stg_uncheckedIShiftL64  (StgInt64 a,  StgInt b)    {return a << b;}
  75 StgInt64  stg_uncheckedIShiftRA64 (StgInt64 a,  StgInt b)    {return a >> b;}
  76 StgInt64  stg_uncheckedIShiftRL64 (StgInt64 a,  StgInt b)
  77                                     {return (StgInt64) ((StgWord64) a >> b);}
  78
  79 /* Casting between longs and longer longs.
  80    (the primops that cast from long longs to Integers
  81    expressed as macros, since these may cause some heap allocation).
  82 */
  83
  84 StgInt64  stg_intToInt64    (StgInt    i) {return (StgInt64)  i;}
  85 StgInt    stg_int64ToInt    (StgInt64  i) {return (StgInt)    i;}
  86 StgWord64 stg_int64ToWord64 (StgInt64  i) {return (StgWord64) i;}
  87 StgWord64 stg_wordToWord64  (StgWord   w) {return (StgWord64) w;}
  88 StgWord   stg_word64ToWord  (StgWord64 w) {return (StgWord)   w;}
  89 StgInt64  stg_word64ToInt64 (StgWord64 w) {return (StgInt64)  w;}
  90
  91 StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da)
  92 {
  93   mp_limb_t* d;
  94   StgInt s;
  95   StgWord64 res;
  96   d = (mp_limb_t *)da;
  97   s = sa;
  98   switch (s) {
  99     case  0: res = 0;     break;
 100     case  1: res = d[0];  break;
 101     case -1: res = -(StgWord64)d[0]; break;
 102     default:
 103       res = (StgWord64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t)));
 104       if (s < 0) res = -res;
 105   }
 106   return res;
 107 }
 108
 109 StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da)
 110 {
 111   mp_limb_t* d;
 112   StgInt s;
 113   StgInt64 res;
 114   d = (mp_limb_t *)da;
 115   s = (sa);
 116   switch (s) {
 117     case  0: res = 0;     break;
 118     case  1: res = d[0];  break;
 119     case -1: res = -(StgInt64)d[0]; break;
 120     default:
 121       res = (StgInt64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t)));
 122       if (s < 0) res = -res;
 123   }
 124   return res;
 125 }
 126
 127 #endif /* SUPPORT_LONG_LONGS */