X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStixPrim.lhs;h=5da841e95f65a9b8b941f787515a64def7d535de;hb=ce424aecca1c1dfc9bac641707e21ebd646160bc;hp=6f5e37c2abb6417ff2b8999ee827fb479dd75fce;hpb=8f56e4b3b1e22a1f68eede5f9cc1c63a9e19b3fd;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 6f5e37c..5da841e 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -16,15 +16,15 @@ import AbsCUtils ( getAmodeRep, mixedTypeLocn ) import SMRep ( fixedHdrSize ) import Literal ( Literal(..), word2IntLit ) import PrimOp ( PrimOp(..), CCall(..), CCallTarget(..) ) -import PrimRep ( PrimRep(..), isFloatingRep ) +import PrimRep ( PrimRep(..) ) import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM ) import Constants ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE, rESERVED_STACK_WORDS ) import CLabel ( mkIntlikeClosureLabel, mkCharlikeClosureLabel, mkMAP_FROZEN_infoLabel, mkForeignLabel ) +import CallConv ( cCallConv ) import Outputable - -import Char ( ord, isAlpha, isDigit ) +import FastTypes #include "NCG.h" \end{code} @@ -55,8 +55,6 @@ and modify our heap check accordingly. \begin{code} -- NB: ordering of clauses somewhere driven by -- the desire to getting sane patt-matching behavior -primCode res@[sr,dr] IntegerNegOp arg@[sa,da] - = gmpNegate (sr,dr) (sa,da) primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2] = gmpCompare res (sa1,da1, sa2,da2) @@ -81,6 +79,9 @@ primCode [res] Int2WordOp [arg] primCode [res] Word2IntOp [arg] = simpleCoercion IntRep res arg + +primCode [res] AddrToHValueOp [arg] + = simpleCoercion PtrRep res arg \end{code} \begin{code} @@ -181,80 +182,133 @@ 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 Int8Rep ls rs +primCode ls IndexByteArrayOp_Char rs = primCode_ReadByteArrayOp Word8Rep ls rs +primCode ls IndexByteArrayOp_WideChar rs = primCode_ReadByteArrayOp CharRep 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 primCode ls IndexByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs primCode ls IndexByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs +primCode ls IndexByteArrayOp_Int8 rs = primCode_ReadByteArrayOp Int8Rep ls rs +primCode ls IndexByteArrayOp_Int16 rs = primCode_ReadByteArrayOp Int16Rep ls rs +primCode ls IndexByteArrayOp_Int32 rs = primCode_ReadByteArrayOp Int32Rep ls rs primCode ls IndexByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs +primCode ls IndexByteArrayOp_Word8 rs = primCode_ReadByteArrayOp Word8Rep ls rs +primCode ls IndexByteArrayOp_Word16 rs = primCode_ReadByteArrayOp Word16Rep ls rs +primCode ls IndexByteArrayOp_Word32 rs = primCode_ReadByteArrayOp Word32Rep ls rs primCode ls IndexByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs -primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp Int8Rep ls rs +primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp Word8Rep ls rs +primCode ls ReadByteArrayOp_WideChar rs = primCode_ReadByteArrayOp CharRep 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 primCode ls ReadByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs primCode ls ReadByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs +primCode ls ReadByteArrayOp_Int8 rs = primCode_ReadByteArrayOp Int8Rep ls rs +primCode ls ReadByteArrayOp_Int16 rs = primCode_ReadByteArrayOp Int16Rep ls rs +primCode ls ReadByteArrayOp_Int32 rs = primCode_ReadByteArrayOp Int32Rep ls rs primCode ls ReadByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs +primCode ls ReadByteArrayOp_Word8 rs = primCode_ReadByteArrayOp Word8Rep ls rs +primCode ls ReadByteArrayOp_Word16 rs = primCode_ReadByteArrayOp Word16Rep ls rs +primCode ls ReadByteArrayOp_Word32 rs = primCode_ReadByteArrayOp Word32Rep ls rs primCode ls ReadByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep 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 -primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs -primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs -primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs -primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs -primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs +primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp Word8Rep ls rs +primCode ls WriteByteArrayOp_WideChar rs = primCode_WriteByteArrayOp CharRep 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 +primCode ls WriteByteArrayOp_Float rs = primCode_WriteByteArrayOp FloatRep ls rs +primCode ls WriteByteArrayOp_Double rs = primCode_WriteByteArrayOp DoubleRep ls rs +primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs +primCode ls WriteByteArrayOp_Int8 rs = primCode_WriteByteArrayOp Int8Rep ls rs +primCode ls WriteByteArrayOp_Int16 rs = primCode_WriteByteArrayOp Int16Rep ls rs +primCode ls WriteByteArrayOp_Int32 rs = primCode_WriteByteArrayOp Int32Rep ls rs +primCode ls WriteByteArrayOp_Int64 rs = primCode_WriteByteArrayOp Int64Rep ls rs +primCode ls WriteByteArrayOp_Word8 rs = primCode_WriteByteArrayOp Word8Rep ls rs +primCode ls WriteByteArrayOp_Word16 rs = primCode_WriteByteArrayOp Word16Rep ls rs +primCode ls WriteByteArrayOp_Word32 rs = primCode_WriteByteArrayOp Word32Rep ls rs +primCode ls WriteByteArrayOp_Word64 rs = primCode_WriteByteArrayOp Word64Rep ls rs -primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp Int8Rep ls rs +primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs +primCode ls IndexOffAddrOp_WideChar rs = primCode_IndexOffAddrOp CharRep 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 primCode ls IndexOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs primCode ls IndexOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs +primCode ls IndexOffAddrOp_Int8 rs = primCode_IndexOffAddrOp Int8Rep ls rs +primCode ls IndexOffAddrOp_Int16 rs = primCode_IndexOffAddrOp Int16Rep ls rs +primCode ls IndexOffAddrOp_Int32 rs = primCode_IndexOffAddrOp Int32Rep ls rs primCode ls IndexOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs +primCode ls IndexOffAddrOp_Word8 rs = primCode_IndexOffAddrOp Word8Rep ls rs +primCode ls IndexOffAddrOp_Word16 rs = primCode_IndexOffAddrOp Word16Rep ls rs +primCode ls IndexOffAddrOp_Word32 rs = primCode_IndexOffAddrOp Word32Rep ls rs primCode ls IndexOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs -primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp Int8Rep ls rs +primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp Word8Rep ls rs +primCode ls IndexOffForeignObjOp_WideChar rs = primCode_IndexOffForeignObjOp CharRep 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 primCode ls IndexOffForeignObjOp_Float rs = primCode_IndexOffForeignObjOp FloatRep ls rs primCode ls IndexOffForeignObjOp_Double rs = primCode_IndexOffForeignObjOp DoubleRep ls rs primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp StablePtrRep ls rs +primCode ls IndexOffForeignObjOp_Int8 rs = primCode_IndexOffForeignObjOp Int8Rep ls rs +primCode ls IndexOffForeignObjOp_Int16 rs = primCode_IndexOffForeignObjOp Int16Rep ls rs +primCode ls IndexOffForeignObjOp_Int32 rs = primCode_IndexOffForeignObjOp Int32Rep ls rs primCode ls IndexOffForeignObjOp_Int64 rs = primCode_IndexOffForeignObjOp Int64Rep ls rs +primCode ls IndexOffForeignObjOp_Word8 rs = primCode_IndexOffForeignObjOp Word8Rep ls rs +primCode ls IndexOffForeignObjOp_Word16 rs = primCode_IndexOffForeignObjOp Word16Rep ls rs +primCode ls IndexOffForeignObjOp_Word32 rs = primCode_IndexOffForeignObjOp Word32Rep ls rs primCode ls IndexOffForeignObjOp_Word64 rs = primCode_IndexOffForeignObjOp Word64Rep ls rs -primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp Int8Rep ls rs +primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs +primCode ls ReadOffAddrOp_WideChar rs = primCode_IndexOffAddrOp CharRep 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 +primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs +primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs +primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs +primCode ls ReadOffAddrOp_Int8 rs = primCode_IndexOffAddrOp Int8Rep ls rs +primCode ls ReadOffAddrOp_Int16 rs = primCode_IndexOffAddrOp Int16Rep ls rs +primCode ls ReadOffAddrOp_Int32 rs = primCode_IndexOffAddrOp Int32Rep ls rs +primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs +primCode ls ReadOffAddrOp_Word8 rs = primCode_IndexOffAddrOp Word8Rep ls rs +primCode ls ReadOffAddrOp_Word16 rs = primCode_IndexOffAddrOp Word16Rep ls rs +primCode ls ReadOffAddrOp_Word32 rs = primCode_IndexOffAddrOp Word32Rep ls rs +primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs + +primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp Word8Rep ls rs +primCode ls WriteOffAddrOp_WideChar rs = primCode_WriteOffAddrOp CharRep 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 primCode ls WriteOffAddrOp_Float rs = primCode_WriteOffAddrOp FloatRep ls rs primCode ls WriteOffAddrOp_Double rs = primCode_WriteOffAddrOp DoubleRep ls rs primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep ls rs +primCode ls WriteOffAddrOp_Int8 rs = primCode_WriteOffAddrOp Int8Rep ls rs +primCode ls WriteOffAddrOp_Int16 rs = primCode_WriteOffAddrOp Int16Rep ls rs +primCode ls WriteOffAddrOp_Int32 rs = primCode_WriteOffAddrOp Int32Rep ls rs primCode ls WriteOffAddrOp_Int64 rs = primCode_WriteOffAddrOp Int64Rep ls rs +primCode ls WriteOffAddrOp_Word8 rs = primCode_WriteOffAddrOp Word8Rep ls rs +primCode ls WriteOffAddrOp_Word16 rs = primCode_WriteOffAddrOp Word16Rep ls rs +primCode ls WriteOffAddrOp_Word32 rs = primCode_WriteOffAddrOp Word32Rep ls rs primCode ls WriteOffAddrOp_Word64 rs = primCode_WriteOffAddrOp Word64Rep 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 -primCode ls WriteByteArrayOp_Float rs = primCode_WriteByteArrayOp FloatRep ls rs -primCode ls WriteByteArrayOp_Double rs = primCode_WriteByteArrayOp DoubleRep ls rs -primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs -primCode ls WriteByteArrayOp_Int64 rs = primCode_WriteByteArrayOp Int64Rep ls rs -primCode ls WriteByteArrayOp_Word64 rs = primCode_WriteByteArrayOp Word64Rep ls rs - \end{code} ToDo: saving/restoring of volatile regs around ccalls. +JRS, 001113: always do the call of suspendThread and resumeThread as a ccall +rather than inheriting the calling convention of the thing which we're really +calling. + \begin{code} primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs | is_asm = error "ERROR: Native code generator can't handle casm" @@ -267,8 +321,10 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs id = StReg (StixTemp uniq IntRep) suspend = StAssign IntRep id - (StCall SLIT("suspendThread") cconv IntRep [stgBaseReg]) - resume = StCall SLIT("resumeThread") cconv VoidRep [id] + (StCall SLIT("suspendThread") {-no:cconv-} cCallConv + IntRep [stgBaseReg]) + resume = StCall SLIT("resumeThread") {-no:cconv-} cCallConv + VoidRep [id] in returnUs (\xs -> save (suspend : ccall : resume : load xs)) @@ -280,7 +336,7 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs case getAmodeRep x of ArrayRep -> StIndex PtrRep base arrPtrsHS ByteArrayRep -> StIndex IntRep base arrWordsHS - ForeignObjRep -> StIndex PtrRep base fixedHS + ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS) _ -> base ccall = case lhs of @@ -336,6 +392,19 @@ primCode [rr] ReadMutVarOp [aa] returnUs (\xs -> assign : xs) \end{code} +ForeignObj# primops. + +\begin{code} +primCode [rr] ForeignObjToAddrOp [fo] + = let code = StAssign AddrRep (amodeToStix rr) + (StInd AddrRep + (StIndex PtrRep (amodeToStix fo) fixedHS)) + in + returnUs (\xs -> code : xs) + +primCode [] TouchOp [_] = returnUs id +\end{code} + Now the more mundane operations. \begin{code} @@ -464,13 +533,13 @@ amodeToStix am@(CVal rr CharRep) amodeToStix (CVal rr pk) = StInd pk (amodeToStix (CAddr rr)) amodeToStix (CAddr (SpRel off)) - = StIndex PtrRep stgSp (StInt (toInteger IBOX(off))) + = StIndex PtrRep stgSp (StInt (toInteger (iBox off))) amodeToStix (CAddr (HpRel off)) - = StIndex IntRep stgHp (StInt (toInteger (- IBOX(off)))) + = StIndex IntRep stgHp (StInt (toInteger (- (iBox off)))) amodeToStix (CAddr (NodeRel off)) - = StIndex IntRep stgNode (StInt (toInteger IBOX(off))) + = StIndex IntRep stgNode (StInt (toInteger (iBox off))) amodeToStix (CAddr (CIndex base off pk)) = StIndex pk (amodeToStix base) (amodeToStix off) @@ -483,7 +552,7 @@ amodeToStix (CLbl lbl _) = StCLbl lbl -- For CharLike and IntLike, we attempt some trivial constant-folding here. amodeToStix (CCharLike (CLit (MachChar c))) - = StIndex Int8Rep cHARLIKE_closure (StInt (toInteger off)) + = StIndex Word8Rep cHARLIKE_closure (StInt (toInteger off)) where off = charLikeSize * (c - mIN_CHARLIKE) @@ -491,7 +560,7 @@ amodeToStix (CCharLike x) = panic "CCharLike" amodeToStix (CIntLike (CLit (MachInt i))) - = StIndex Int8Rep iNTLIKE_closure (StInt (toInteger off)) + = StIndex Word8Rep iNTLIKE_closure (StInt (toInteger off)) where off = intLikeSize * (fromInteger (i - mIN_INTLIKE)) @@ -552,8 +621,8 @@ cHARLIKE_closure = StCLbl mkCharlikeClosureLabel mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel -- these are the sizes of charLike and intLike closures, in _bytes_. -charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep)) -intLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep)) +charLikeSize = (fixedHdrSize + 1) * (sizeOf PtrRep) +intLikeSize = (fixedHdrSize + 1) * (sizeOf PtrRep) \end{code}