X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Flib%2Fstd%2Fcbits%2Flonglong.c;h=a373786a1d951bee74b78934bd61cb6bed413108;hb=5861bb81decb29ad398c3586f0bba0a1e872ff67;hp=5a7bd55108e7299fe04b688dfb58439bef9764ce;hpb=1fdd21b3cac37f4831d2cb4f4578c80c860a932c;p=ghc-hetmet.git

diff --git a/ghc/lib/std/cbits/longlong.c b/ghc/lib/std/cbits/longlong.c
index 5a7bd55..a373786 100644
--- a/ghc/lib/std/cbits/longlong.c
+++ b/ghc/lib/std/cbits/longlong.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: longlong.c,v 1.3 2001/07/23 15:11:55 simonmar Exp $
+ * $Id: longlong.c,v 1.5 2001/12/07 11:34:48 sewardj Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -63,19 +63,20 @@ 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)
-{return (StgInt64) ((StgWord64) a >> 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 +87,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 = -d[0]; break;
+    default:
+      res = 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 = -d[0]; break;
+    default:
+      res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t)));
+      if (s < 0) res = -res;
+  }
+  return res;
+}
+
 #endif /* SUPPORT_LONG_LONGS */