[project @ 1998-03-13 21:03:57 by sof]

New primop: integer2Word#. Only used in fromInteger methods on Word*

diff --git a/ghc/compiler/nativeGen/StixInteger.lhs b/ghc/compiler/nativeGen/StixInteger.lhs
index 5c2f571..37911bc 100644 (file)
--- a/ghc/compiler/nativeGen/StixInteger.lhs
+++ b/ghc/compiler/nativeGen/StixInteger.lhs
@@ -5,7 +5,8 @@
 \begin{code}
 module StixInteger (
        gmpTake1Return1, gmpTake2Return1, gmpTake2Return2, gmpCompare,
-       gmpInteger2Int, gmpInt2Integer, gmpString2Integer,
+       gmpInteger2Int, gmpInteger2Word,
+       gmpInt2Integer, gmpString2Integer,
        encodeFloatingKind, decodeFloatingKind
     ) where
 
@@ -208,6 +209,25 @@ gmpInteger2Int res args@(chp, caa,csa,cda)
     in
     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 
+gmpInteger2Word
+    :: CAddrMode           -- result
+    -> (CAddrMode, CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
+    -> UniqSM StixTreeList
+
+gmpInteger2Word res args@(chp, caa,csa,cda)
+  = let
+       result  = amodeToStix res
+       hp      = amodeToStix chp
+       aa      = amodeToStix caa
+       sa      = amodeToStix csa
+       da      = amodeToStix cda
+
+       (a1,a2,a3) = toStruct hp (aa,sa,da)
+       mpz_get_ui = StCall SLIT("mpz_get_ui") IntRep [hp]
+       r1 = StAssign WordRep result mpz_get_ui
+    in
+    returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
+
 arrayOfData_info = sStLitLbl SLIT("ArrayOfData_info")
 
 --------------

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 192d5f3..0df070d 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -109,6 +109,9 @@ primCode [res] IntegerCmpOp args@[hp, aa1,sa1,da1, aa2,sa2,da2]
 primCode [res] Integer2IntOp arg@[hp, aa,sa,da]
   = gmpInteger2Int res (hp, aa,sa,da)
 
+primCode [res] Integer2WordOp arg@[hp, aa,sa,da]
+  = gmpInteger2Word res (hp, aa,sa,da)
+
 primCode [res] FloatEncodeOp args@[hp, aa,sa,da, expon]
   = encodeFloatingKind FloatRep res (hp, aa,sa,da, expon)
 

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 60050db..59d20ce 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -121,8 +121,8 @@ data PrimOp
 
     | IntegerCmpOp
 
-    | Integer2IntOp  | Int2IntegerOp
-    | Word2IntegerOp
+    | Integer2IntOp  | Integer2WordOp  
+    | Int2IntegerOp  | Word2IntegerOp
     | Addr2IntegerOp -- "Addr" is *always* a literal string
     -- ?? gcd, etc?
 
@@ -372,77 +372,78 @@ tagOf_PrimOp IntegerDivModOp                    = ILIT(110)
 tagOf_PrimOp IntegerNegOp                    = ILIT(111)
 tagOf_PrimOp IntegerCmpOp                    = ILIT(112)
 tagOf_PrimOp Integer2IntOp                   = ILIT(113)
-tagOf_PrimOp Int2IntegerOp                   = ILIT(114)
-tagOf_PrimOp Word2IntegerOp                  = ILIT(115)
-tagOf_PrimOp Addr2IntegerOp                  = ILIT(116)
-tagOf_PrimOp FloatEncodeOp                   = ILIT(117)
-tagOf_PrimOp FloatDecodeOp                   = ILIT(118)
-tagOf_PrimOp DoubleEncodeOp                  = ILIT(119)
-tagOf_PrimOp DoubleDecodeOp                  = ILIT(120)
-tagOf_PrimOp NewArrayOp                              = ILIT(121)
-tagOf_PrimOp (NewByteArrayOp CharRep)        = ILIT(122)
-tagOf_PrimOp (NewByteArrayOp IntRep)         = ILIT(123)
-tagOf_PrimOp (NewByteArrayOp AddrRep)        = ILIT(124)
-tagOf_PrimOp (NewByteArrayOp FloatRep)       = ILIT(125)
-tagOf_PrimOp (NewByteArrayOp DoubleRep)       = ILIT(126)
-tagOf_PrimOp SameMutableArrayOp                      = ILIT(127)
-tagOf_PrimOp SameMutableByteArrayOp          = ILIT(128)
-tagOf_PrimOp ReadArrayOp                     = ILIT(129)
-tagOf_PrimOp WriteArrayOp                    = ILIT(130)
-tagOf_PrimOp IndexArrayOp                    = ILIT(131)
-tagOf_PrimOp (ReadByteArrayOp CharRep)       = ILIT(132)
-tagOf_PrimOp (ReadByteArrayOp IntRep)        = ILIT(133)
-tagOf_PrimOp (ReadByteArrayOp AddrRep)       = ILIT(134)
-tagOf_PrimOp (ReadByteArrayOp FloatRep)       = ILIT(135)
-tagOf_PrimOp (ReadByteArrayOp DoubleRep)      = ILIT(136)
-tagOf_PrimOp (WriteByteArrayOp CharRep)       = ILIT(137)
-tagOf_PrimOp (WriteByteArrayOp IntRep)       = ILIT(138)
-tagOf_PrimOp (WriteByteArrayOp AddrRep)       = ILIT(139)
-tagOf_PrimOp (WriteByteArrayOp FloatRep)      = ILIT(140)
-tagOf_PrimOp (WriteByteArrayOp DoubleRep)     = ILIT(141)
-tagOf_PrimOp (IndexByteArrayOp CharRep)       = ILIT(142)
-tagOf_PrimOp (IndexByteArrayOp IntRep)       = ILIT(143)
-tagOf_PrimOp (IndexByteArrayOp AddrRep)       = ILIT(144)
-tagOf_PrimOp (IndexByteArrayOp FloatRep)      = ILIT(145)
-tagOf_PrimOp (IndexByteArrayOp DoubleRep)     = ILIT(146)
-tagOf_PrimOp (IndexOffAddrOp CharRep)        = ILIT(147)
-tagOf_PrimOp (IndexOffAddrOp IntRep)         = ILIT(148)
-tagOf_PrimOp (IndexOffAddrOp AddrRep)        = ILIT(149)
-tagOf_PrimOp (IndexOffAddrOp FloatRep)       = ILIT(150)
-tagOf_PrimOp (IndexOffAddrOp DoubleRep)       = ILIT(151)
-tagOf_PrimOp (IndexOffForeignObjOp CharRep)   = ILIT(152)
-tagOf_PrimOp (IndexOffForeignObjOp IntRep)    = ILIT(153)
-tagOf_PrimOp (IndexOffForeignObjOp AddrRep)   = ILIT(154)
-tagOf_PrimOp (IndexOffForeignObjOp FloatRep)  = ILIT(155)
-tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(156)
-tagOf_PrimOp UnsafeFreezeArrayOp             = ILIT(157)
-tagOf_PrimOp UnsafeFreezeByteArrayOp         = ILIT(158)
-tagOf_PrimOp NewSynchVarOp                   = ILIT(159)
-tagOf_PrimOp TakeMVarOp                              = ILIT(160)
-tagOf_PrimOp PutMVarOp                       = ILIT(161)
-tagOf_PrimOp ReadIVarOp                              = ILIT(162)
-tagOf_PrimOp WriteIVarOp                     = ILIT(163)
-tagOf_PrimOp MakeForeignObjOp                = ILIT(164)
-tagOf_PrimOp WriteForeignObjOp               = ILIT(165)
-tagOf_PrimOp MakeStablePtrOp                 = ILIT(166)
-tagOf_PrimOp DeRefStablePtrOp                = ILIT(167)
-tagOf_PrimOp (CCallOp _ _ _ _ _)             = ILIT(168)
-tagOf_PrimOp ErrorIOPrimOp                   = ILIT(169)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp       = ILIT(170)
-tagOf_PrimOp SeqOp                           = ILIT(171)
-tagOf_PrimOp ParOp                           = ILIT(172)
-tagOf_PrimOp ForkOp                          = ILIT(173)
-tagOf_PrimOp DelayOp                         = ILIT(174)
-tagOf_PrimOp WaitReadOp                              = ILIT(175)
-tagOf_PrimOp WaitWriteOp                     = ILIT(176)
-tagOf_PrimOp ParGlobalOp                     = ILIT(177)
-tagOf_PrimOp ParLocalOp                              = ILIT(178)
-tagOf_PrimOp ParAtOp                         = ILIT(179)
-tagOf_PrimOp ParAtAbsOp                              = ILIT(180)
-tagOf_PrimOp ParAtRelOp                              = ILIT(181)
-tagOf_PrimOp ParAtForNowOp                   = ILIT(182)
-tagOf_PrimOp CopyableOp                              = ILIT(183)
-tagOf_PrimOp NoFollowOp                              = ILIT(184)
+tagOf_PrimOp Integer2WordOp                  = ILIT(114)
+tagOf_PrimOp Int2IntegerOp                   = ILIT(115)
+tagOf_PrimOp Word2IntegerOp                  = ILIT(116)
+tagOf_PrimOp Addr2IntegerOp                  = ILIT(117)
+tagOf_PrimOp FloatEncodeOp                   = ILIT(118)
+tagOf_PrimOp FloatDecodeOp                   = ILIT(119)
+tagOf_PrimOp DoubleEncodeOp                  = ILIT(120)
+tagOf_PrimOp DoubleDecodeOp                  = ILIT(121)
+tagOf_PrimOp NewArrayOp                              = ILIT(122)
+tagOf_PrimOp (NewByteArrayOp CharRep)        = ILIT(123)
+tagOf_PrimOp (NewByteArrayOp IntRep)         = ILIT(124)
+tagOf_PrimOp (NewByteArrayOp AddrRep)        = ILIT(125)
+tagOf_PrimOp (NewByteArrayOp FloatRep)       = ILIT(126)
+tagOf_PrimOp (NewByteArrayOp DoubleRep)       = ILIT(127)
+tagOf_PrimOp SameMutableArrayOp                      = ILIT(128)
+tagOf_PrimOp SameMutableByteArrayOp          = ILIT(129)
+tagOf_PrimOp ReadArrayOp                     = ILIT(130)
+tagOf_PrimOp WriteArrayOp                    = ILIT(131)
+tagOf_PrimOp IndexArrayOp                    = ILIT(132)
+tagOf_PrimOp (ReadByteArrayOp CharRep)       = ILIT(133)
+tagOf_PrimOp (ReadByteArrayOp IntRep)        = ILIT(134)
+tagOf_PrimOp (ReadByteArrayOp AddrRep)       = ILIT(135)
+tagOf_PrimOp (ReadByteArrayOp FloatRep)       = ILIT(136)
+tagOf_PrimOp (ReadByteArrayOp DoubleRep)      = ILIT(137)
+tagOf_PrimOp (WriteByteArrayOp CharRep)       = ILIT(138)
+tagOf_PrimOp (WriteByteArrayOp IntRep)       = ILIT(139)
+tagOf_PrimOp (WriteByteArrayOp AddrRep)       = ILIT(140)
+tagOf_PrimOp (WriteByteArrayOp FloatRep)      = ILIT(141)
+tagOf_PrimOp (WriteByteArrayOp DoubleRep)     = ILIT(142)
+tagOf_PrimOp (IndexByteArrayOp CharRep)       = ILIT(143)
+tagOf_PrimOp (IndexByteArrayOp IntRep)       = ILIT(144)
+tagOf_PrimOp (IndexByteArrayOp AddrRep)       = ILIT(145)
+tagOf_PrimOp (IndexByteArrayOp FloatRep)      = ILIT(146)
+tagOf_PrimOp (IndexByteArrayOp DoubleRep)     = ILIT(147)
+tagOf_PrimOp (IndexOffAddrOp CharRep)        = ILIT(148)
+tagOf_PrimOp (IndexOffAddrOp IntRep)         = ILIT(149)
+tagOf_PrimOp (IndexOffAddrOp AddrRep)        = ILIT(150)
+tagOf_PrimOp (IndexOffAddrOp FloatRep)       = ILIT(151)
+tagOf_PrimOp (IndexOffAddrOp DoubleRep)       = ILIT(152)
+tagOf_PrimOp (IndexOffForeignObjOp CharRep)   = ILIT(153)
+tagOf_PrimOp (IndexOffForeignObjOp IntRep)    = ILIT(154)
+tagOf_PrimOp (IndexOffForeignObjOp AddrRep)   = ILIT(155)
+tagOf_PrimOp (IndexOffForeignObjOp FloatRep)  = ILIT(156)
+tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(157)
+tagOf_PrimOp UnsafeFreezeArrayOp             = ILIT(158)
+tagOf_PrimOp UnsafeFreezeByteArrayOp         = ILIT(159)
+tagOf_PrimOp NewSynchVarOp                   = ILIT(160)
+tagOf_PrimOp TakeMVarOp                              = ILIT(161)
+tagOf_PrimOp PutMVarOp                       = ILIT(162)
+tagOf_PrimOp ReadIVarOp                              = ILIT(163)
+tagOf_PrimOp WriteIVarOp                     = ILIT(164)
+tagOf_PrimOp MakeForeignObjOp                = ILIT(165)
+tagOf_PrimOp WriteForeignObjOp               = ILIT(166)
+tagOf_PrimOp MakeStablePtrOp                 = ILIT(167)
+tagOf_PrimOp DeRefStablePtrOp                = ILIT(168)
+tagOf_PrimOp (CCallOp _ _ _ _ _)             = ILIT(169)
+tagOf_PrimOp ErrorIOPrimOp                   = ILIT(170)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp       = ILIT(171)
+tagOf_PrimOp SeqOp                           = ILIT(172)
+tagOf_PrimOp ParOp                           = ILIT(173)
+tagOf_PrimOp ForkOp                          = ILIT(174)
+tagOf_PrimOp DelayOp                         = ILIT(175)
+tagOf_PrimOp WaitReadOp                              = ILIT(176)
+tagOf_PrimOp WaitWriteOp                     = ILIT(177)
+tagOf_PrimOp ParGlobalOp                     = ILIT(178)
+tagOf_PrimOp ParLocalOp                              = ILIT(179)
+tagOf_PrimOp ParAtOp                         = ILIT(180)
+tagOf_PrimOp ParAtAbsOp                              = ILIT(181)
+tagOf_PrimOp ParAtRelOp                              = ILIT(182)
+tagOf_PrimOp ParAtForNowOp                   = ILIT(183)
+tagOf_PrimOp CopyableOp                              = ILIT(184)
+tagOf_PrimOp NoFollowOp                              = ILIT(185)
 
 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
 
@@ -563,6 +564,7 @@ allThePrimOps
        IntegerNegOp,
        IntegerCmpOp,
        Integer2IntOp,
+       Integer2WordOp,
        Int2IntegerOp,
        Word2IntegerOp,
        Addr2IntegerOp,
@@ -923,6 +925,9 @@ primOpInfo IntegerDivModOp  = integerDyadic2Results SLIT("divModInteger#")
 primOpInfo Integer2IntOp
   = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
 
+primOpInfo Integer2WordOp
+  = PrimResult SLIT("integer2Word#") [] one_Integer_ty wordPrimTyCon IntRep []
+
 primOpInfo Int2IntegerOp
   = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
 
@@ -1462,7 +1467,7 @@ primOpHeapReq DoubleDecodeOp      = FixedHeapRequired
   or if it returns a ForeignObj.
 
   Hmm..the allocation for makeForeignObj# is known (and fixed), so
-  why dod we need to be so indeterminate about it? --SOF
+  why do we need to be so indeterminate about it? --SOF
 -}
 primOpHeapReq (CCallOp _ _ mayGC@True  _ _) = VariableHeapRequired
 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
@@ -1478,6 +1483,7 @@ primOpHeapReq MakeStablePtrOp     = VariableHeapRequired
 
 primOpHeapReq IntegerCmpOp     = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
 primOpHeapReq Integer2IntOp            = FixedHeapRequired (intOff mP_STRUCT_SIZE)
+primOpHeapReq Integer2WordOp           = FixedHeapRequired (intOff mP_STRUCT_SIZE)
 primOpHeapReq FloatEncodeOp            = FixedHeapRequired (intOff mP_STRUCT_SIZE)
 primOpHeapReq DoubleEncodeOp           = FixedHeapRequired (intOff mP_STRUCT_SIZE)
 
@@ -1651,6 +1657,7 @@ primOpNeedsWrapper IntegerDivModOp        = True
 primOpNeedsWrapper IntegerNegOp                = True
 primOpNeedsWrapper IntegerCmpOp                = True
 primOpNeedsWrapper Integer2IntOp       = True
+primOpNeedsWrapper Integer2WordOp      = True
 primOpNeedsWrapper Int2IntegerOp       = True
 primOpNeedsWrapper Word2IntegerOp      = True
 primOpNeedsWrapper Addr2IntegerOp      = True

diff --git a/ghc/includes/StgMacros.lh b/ghc/includes/StgMacros.lh
index 44d9a4d..9db42e8 100644 (file)
--- a/ghc/includes/StgMacros.lh
+++ b/ghc/includes/StgMacros.lh
@@ -819,6 +819,17 @@ Coercions:
   (dr) = (B_)(hp);             /* dr is an StgByteArray */                     \
 }
 
+#define integer2WordZh(r, hp, aa,sa,da)                                                \
+{ MP_INT arg;                                                                  \
+  /* Does not allocate memory */                                               \
+                                                                               \
+  arg.alloc    = (aa);                                                         \
+  arg.size     = (sa);                                                         \
+  arg.d                = (unsigned long int *) (BYTE_ARR_CTS(da));                     \
+                                                                               \
+  (r) = SAFESTGCALL1(I_,(void *, MP_INT *),mpz_get_ui,&arg);                   \
+}
+
 \end{code}
 
 Then there are a few oddments to make life easier:

diff --git a/ghc/lib/exts/Word.lhs b/ghc/lib/exts/Word.lhs
index 4cb94e8..5c80ef2 100644 (file)
--- a/ghc/lib/exts/Word.lhs
+++ b/ghc/lib/exts/Word.lhs
@@ -29,13 +29,11 @@ module Word
        , intToWord32    -- :: Int    -> Word32
        ) where
 
-import PrelBase
-import PrelNum
-import PrelRead
+import GlaExts
 import Ix
 import Bits
-import PrelGHC
 import CCall
+import Numeric (readDec)
 
 -----------------------------------------------------------------------------
 -- The "official" coercion functions
@@ -122,7 +120,7 @@ instance Num Word8 where
       x' = word2Int# x
   abs x         = x
   signum        = signumReal
-  fromInteger (J# a# s# d#) = W8# (intToWord8# (integer2Int# a# s# d#))
+  fromInteger (J# a# s# d#) = W8# (wordToWord8# (integer2Word# a# s# d#))
   fromInt       = intToWord8
 
 instance Bounded Word8 where
@@ -265,7 +263,7 @@ instance Num Word16 where
         x' = word2Int# x
   abs x         = x
   signum        = signumReal
-  fromInteger (J# a# s# d#) = W16# (intToWord16# (integer2Int# a# s# d#))
+  fromInteger (J# a# s# d#) = W16# (wordToWord16# (integer2Word# a# s# d#))
   fromInt       = intToWord16
 
 instance Bounded Word16 where
@@ -391,7 +389,7 @@ instance Num Word32 where
 #endif
   abs x           = x
   signum          = signumReal
-  fromInteger (J# a# s# d#) = W32# (intToWord32# (integer2Int# a# s# d#))
+  fromInteger (J# a# s# d#) = W32# (integer2Word# a# s# d#)
   fromInt (I# x)  = W32# (intToWord32# x)
     -- ToDo: restrict fromInt{eger} range.