[project @ 2005-03-14 15:57:04 by malcolm]

[ghc-base.git] / cbits / longlong.c

diff --git a/cbits/longlong.c b/cbits/longlong.c
index 8118afd..f6e8567 100644 (file)
--- a/cbits/longlong.c
+++ b/cbits/longlong.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: longlong.c,v 1.1 2001/07/31 12:52:37 simonmar Exp $
+ * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -63,19 +63,19 @@ StgWord64 stg_and64      (StgWord64 a, StgWord64 b) {return a & b;}
 StgWord64 stg_or64       (StgWord64 a, StgWord64 b) {return a | b;}
 StgWord64 stg_xor64      (StgWord64 a, StgWord64 b) {return a ^ b;}
 StgWord64 stg_not64      (StgWord64 a)              {return ~a;}
-StgWord64 stg_shiftL64   (StgWord64 a, StgInt b)    {return a << b;}
-StgWord64 stg_shiftRL64  (StgWord64 a, StgInt b)    {return a >> b;}
+StgWord64 stg_uncheckedShiftL64   (StgWord64 a, StgInt b)    {return a << b;}
+StgWord64 stg_uncheckedShiftRL64  (StgWord64 a, StgInt 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
 */
-StgInt64  stg_iShiftL64  (StgInt64 a,  StgInt b)    {return a << b;}
-StgInt64  stg_iShiftRA64 (StgInt64 a,  StgInt b)    {return a >> b;}
-StgInt64  stg_iShiftRL64 (StgInt64 a,  StgInt b)
+StgInt64  stg_uncheckedIShiftL64  (StgInt64 a,  StgInt b)    {return a << b;}
+StgInt64  stg_uncheckedIShiftRA64 (StgInt64 a,  StgInt b)    {return a >> b;}
+StgInt64  stg_uncheckedIShiftRL64 (StgInt64 a,  StgInt b)
 {return (StgInt64) ((StgWord64) a >> b);}
 
-/* Casting between longs and longer longs:
-   (the primops that cast between Integers and long longs are
+/* 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).
 */
 
@@ -86,4 +86,40 @@ StgWord64 stg_wordToWord64  (StgWord   w) {return (StgWord64) w;}
 StgWord   stg_word64ToWord  (StgWord64 w) {return (StgWord)   w;}
 StgInt64  stg_word64ToInt64 (StgWord64 w) {return (StgInt64)  w;}
 
+StgWord64 stg_integerToWord64 (I_ sa, StgByteArray /* Really: mp_limb_t* */ da)
+{ 
+  mp_limb_t* d;
+  I_ s;
+  StgWord64 res;
+  d = (mp_limb_t *)da;
+  s = sa;
+  switch (s) {
+    case  0: res = 0;     break;
+    case  1: res = d[0];  break;
+    case -1: res = -(StgWord64)d[0]; break;
+    default:
+      res = (StgWord64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
+StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da)
+{ 
+  mp_limb_t* d;
+  I_ s;
+  StgInt64 res;
+  d = (mp_limb_t *)da;
+  s = (sa);
+  switch (s) {
+    case  0: res = 0;     break;
+    case  1: res = d[0];  break;
+    case -1: res = -(StgInt64)d[0]; break;
+    default:
+      res = (StgInt64)d[0] + ((StgWord64)d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
 #endif /* SUPPORT_LONG_LONGS */