From: sof Date: Fri, 13 Mar 1998 21:04:11 +0000 (+0000) Subject: [project @ 1998-03-13 21:03:57 by sof] X-Git-Tag: Approx_2487_patches~861 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=29fe541c75850b58848310e6dd4bd767c41a6a91;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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 --- 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 --- 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.