X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStixPrim.lhs;h=a78c4d6822077824a920492223c38376cf016d25;hb=4b17269854ccf10df8b3ca1711410a5ca439ea8a;hp=dc3bee7c93869128e3a256ff370625c1cffa4826;hpb=514da0a6391a928e218c82208d9aca089e6caf78;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index dc3bee7..a78c4d6 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -18,7 +18,7 @@ import Literal ( Literal(..), word2IntLit ) import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) ) import PrimRep ( PrimRep(..), isFloatingRep ) import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM ) -import Constants ( mIN_INTLIKE, uF_UPDATEE, bLOCK_SIZE ) +import Constants ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE ) import CLabel ( mkIntlikeClosureLabel, mkCharlikeClosureLabel, mkMAP_FROZEN_infoLabel, mkForeignLabel ) import Outputable @@ -180,7 +180,7 @@ primCode [] WriteForeignObjOp [obj, v] returnUs (\xs -> assign : xs) -- NB: indexing in "pk" units, *not* in bytes (WDP 95/09) -primCode ls IndexByteArrayOp_Char rs = primCode_ReadByteArrayOp CharRep ls rs +primCode ls IndexByteArrayOp_Char rs = primCode_ReadByteArrayOp Int8Rep ls rs primCode ls IndexByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs primCode ls IndexByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs primCode ls IndexByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs @@ -190,7 +190,7 @@ primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRe primCode ls IndexByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs primCode ls IndexByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs -primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp CharRep ls rs +primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp Int8Rep ls rs primCode ls ReadByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs primCode ls ReadByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs primCode ls ReadByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs @@ -200,7 +200,7 @@ primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep primCode ls ReadByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs primCode ls ReadByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs -primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp CharRep ls rs +primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp Int8Rep ls rs primCode ls ReadOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs primCode ls ReadOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs primCode ls ReadOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs @@ -210,7 +210,7 @@ primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs -primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp CharRep ls rs +primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp Int8Rep ls rs primCode ls IndexOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs primCode ls IndexOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs primCode ls IndexOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs @@ -220,7 +220,7 @@ primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep l primCode ls IndexOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs primCode ls IndexOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs -primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp CharRep ls rs +primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp Int8Rep ls rs primCode ls IndexOffForeignObjOp_Int rs = primCode_IndexOffForeignObjOp IntRep ls rs primCode ls IndexOffForeignObjOp_Word rs = primCode_IndexOffForeignObjOp WordRep ls rs primCode ls IndexOffForeignObjOp_Addr rs = primCode_IndexOffForeignObjOp AddrRep ls rs @@ -230,7 +230,7 @@ primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp St primCode ls IndexOffForeignObjOp_Int64 rs = primCode_IndexOffForeignObjOp Int64Rep ls rs primCode ls IndexOffForeignObjOp_Word64 rs = primCode_IndexOffForeignObjOp Word64Rep ls rs -primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp CharRep ls rs +primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp Int8Rep ls rs primCode ls WriteOffAddrOp_Int rs = primCode_WriteOffAddrOp IntRep ls rs primCode ls WriteOffAddrOp_Word rs = primCode_WriteOffAddrOp WordRep ls rs primCode ls WriteOffAddrOp_Addr rs = primCode_WriteOffAddrOp AddrRep ls rs @@ -240,7 +240,7 @@ primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep l primCode ls WriteOffAddrOp_Int64 rs = primCode_WriteOffAddrOp Int64Rep ls rs primCode ls WriteOffAddrOp_Word64 rs = primCode_WriteOffAddrOp Word64Rep ls rs -primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp CharRep ls rs +primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp Int8Rep ls rs primCode ls WriteByteArrayOp_Int rs = primCode_WriteByteArrayOp IntRep ls rs primCode ls WriteByteArrayOp_Word rs = primCode_WriteByteArrayOp WordRep ls rs primCode ls WriteByteArrayOp_Addr rs = primCode_WriteByteArrayOp AddrRep ls rs @@ -482,17 +482,15 @@ amodeToStix (CLbl lbl _) = StCLbl lbl -- For CharLike and IntLike, we attempt some trivial constant-folding here. amodeToStix (CCharLike (CLit (MachChar c))) - = StIndex CharRep cHARLIKE_closure (StInt (toInteger off)) + = StIndex Int8Rep cHARLIKE_closure (StInt (toInteger off)) where - off = charLikeSize * ord c + off = charLikeSize * (c - mIN_CHARLIKE) amodeToStix (CCharLike x) - = StIndex CharRep cHARLIKE_closure off - where - off = StPrim IntMulOp [amodeToStix x, StInt (toInteger charLikeSize)] + = panic "CCharLike" amodeToStix (CIntLike (CLit (MachInt i))) - = StIndex CharRep{-yes,really-} iNTLIKE_closure (StInt (toInteger off)) + = StIndex Int8Rep iNTLIKE_closure (StInt (toInteger off)) where off = intLikeSize * (fromInteger (i - mIN_INTLIKE)) @@ -501,7 +499,7 @@ amodeToStix (CIntLike x) amodeToStix (CLit core) = case core of - MachChar c -> StInt (toInteger (ord c)) + MachChar c -> StInt (toInteger c) MachStr s -> StString s MachAddr a -> StInt a MachInt i -> StInt i