X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCUtils.lhs;h=fef7bf56a7f30e2ba8cf3430abef33870f92f440;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=ab505dfbec9ce23af347f0a35bc899da4fa55846;hpb=530086f648b351281bf1b4bb26b9c2e921645703;p=ghc-hetmet.git diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index ab505df..fef7bf5 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -12,16 +12,22 @@ module AbsCUtils ( getAmodeRep, mixedTypeLocn, mixedPtrLocn, flattenAbsC, - mkAbsCStmtList + mkAbsCStmtList, + shimFCallArg -- printing/forcing stuff comes from PprAbsC ) where #include "HsVersions.h" +#include "../includes/config.h" import AbsCSyn +import Type ( tyConAppTyCon, repType ) +import TysPrim ( foreignObjPrimTyCon, arrayPrimTyCon, + byteArrayPrimTyCon, mutableByteArrayPrimTyCon, + mutableArrayPrimTyCon ) import CLabel ( mkMAP_FROZEN_infoLabel ) import Digraph ( stronglyConnComp, SCC(..) ) -import DataCon ( fIRST_TAG, ConTag ) +import DataCon ( fIRST_TAG, dataConTag ) import Literal ( literalPrimRep, mkMachWord, mkMachInt ) import PrimRep ( getPrimRepSize, PrimRep(..) ) import PrimOp ( PrimOp(..) ) @@ -29,17 +35,15 @@ import MachOp ( MachOp(..), isDefinitelyInlineMachOp ) import Unique ( Unique{-instance Eq-} ) import UniqSupply ( uniqFromSupply, uniqsFromSupply, splitUniqSupply, UniqSupply ) -import CmdLineOpts ( opt_EmitCExternDecls ) -import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety(..), - isDynamicTarget, isCasmTarget, defaultCCallConv ) -import StgSyn ( StgOp(..) ) +import CmdLineOpts ( opt_EmitCExternDecls, opt_Unregisterised ) +import ForeignCall ( ForeignCall(..), CCallSpec(..), isDynamicTarget ) +import StgSyn ( StgOp(..), stgArgType ) +import CoreSyn ( AltCon(..) ) import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize ) -import Maybes ( Maybe012(..) ) import Outputable import Panic ( panic ) import FastTypes - -import Maybe ( isJust, maybeToList ) +import Constants ( wORD_SIZE, wORD_SIZE_IN_BITS ) infixr 9 `thenFlt` \end{code} @@ -107,18 +111,14 @@ mkAbsCStmtList' other r = other : r \end{code} \begin{code} -mkAlgAltsCSwitch :: CAddrMode -> [(ConTag, AbstractC)] -> AbstractC -> AbstractC +mkAlgAltsCSwitch :: CAddrMode -> [(AltCon, AbstractC)] -> AbstractC -mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc - | isJust (nonemptyAbsC deflt_absc) - = CSwitch scrutinee (adjust tagged_alts) deflt_absc - | otherwise - = CSwitch scrutinee (adjust rest) first_alt +mkAlgAltsCSwitch scrutinee ((_,first_alt) : rest_alts) + = CSwitch scrutinee (adjust rest_alts) first_alt where - -- it's ok to convert one of the alts into a default if we don't already have - -- one, because this is an algebraic case and we're guaranteed that the tag - -- will match one of the branches. - ((_,first_alt):rest) = tagged_alts + -- We use the first alt as the default. Either it *is* the DEFAULT, + -- (which is always first if present), or the case is exhaustive, + -- in which case we can use the first as the default anyway -- Adjust the tags in the switch to start at zero. -- This is the convention used by primitive ops which return algebraic @@ -127,8 +127,8 @@ mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc -- We also need to convert to Literals to keep the CSwitch happy adjust tagged_alts - = [ (mkMachWord (toInteger (tag - fIRST_TAG)), abs_c) - | (tag, abs_c) <- tagged_alts ] + = [ (mkMachWord (toInteger (dataConTag dc - fIRST_TAG)), abs_c) + | (DataAlt dc, abs_c) <- tagged_alts ] \end{code} %************************************************************************ @@ -144,14 +144,14 @@ magicIdPrimRep (FloatReg _) = FloatRep magicIdPrimRep (DoubleReg _) = DoubleRep magicIdPrimRep (LongReg kind _) = kind magicIdPrimRep Sp = PtrRep -magicIdPrimRep Su = PtrRep magicIdPrimRep SpLim = PtrRep magicIdPrimRep Hp = PtrRep magicIdPrimRep HpLim = PtrRep magicIdPrimRep CurCostCentre = CostCentreRep magicIdPrimRep VoidReg = VoidRep -magicIdPrimRep CurrentTSO = ThreadIdRep +magicIdPrimRep CurrentTSO = PtrRep magicIdPrimRep CurrentNursery = PtrRep +magicIdPrimRep HpAlloc = WordRep \end{code} %************************************************************************ @@ -177,7 +177,6 @@ getAmodeRep (CIntLike _) = PtrRep getAmodeRep (CLit lit) = literalPrimRep lit getAmodeRep (CMacroExpr kind _ _) = kind getAmodeRep (CJoinPoint _) = panic "getAmodeRep:CJoinPoint" -getAmodeRep (CMem rep addr) = rep \end{code} @mixedTypeLocn@ tells whether an amode identifies an ``StgWord'' @@ -320,11 +319,10 @@ flatAbsC (AbsCStmts s1 s2) returnFlt (mkAbsCStmts inline_s1 inline_s2, mkAbsCStmts top_s1 top_s2) -flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr) - = flatAbsC slow `thenFlt` \ (slow_heres, slow_tops) -> - flat_maybe maybe_fast `thenFlt` \ (fast_heres, fast_tops) -> - returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops, - CClosureInfoAndCode cl_info slow_heres fast_heres descr] +flatAbsC (CClosureInfoAndCode cl_info entry) + = flatAbsC entry `thenFlt` \ (entry_heres, entry_tops) -> + returnFlt (AbsCNop, mkAbstractCs [entry_tops, + CClosureInfoAndCode cl_info entry_heres] ) flatAbsC (CCodeBlock lbl abs_C) @@ -349,8 +347,8 @@ flatAbsC (CSwitch discrim alts deflt) returnFlt ( (tag, alt_heres), alt_tops ) flatAbsC stmt@(COpStmt results (StgFCallOp (CCall ccall@(CCallSpec target _ _)) uniq) args _) - | is_dynamic -- Emit a typedef if its a dynamic call - || (opt_EmitCExternDecls && not (isCasmTarget target)) -- or we want extern decls + | is_dynamic -- Emit a typedef if its a dynamic call + || (opt_EmitCExternDecls) -- or we want extern decls = returnFlt (stmt, CCallTypedef is_dynamic ccall uniq results args) where is_dynamic = isDynamicTarget target @@ -367,7 +365,7 @@ flatAbsC stmt@(CCheck macro amodes code) -- the TICKY_CTR macro always needs to be hoisted out to the top level. -- This is a HACK. flatAbsC stmt@(CCallProfCtrMacro str amodes) - | str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt) + | str == FSLIT("TICK_CTR") = returnFlt (AbsCNop, stmt) | otherwise = returnFlt (stmt, AbsCNop) -- Some statements need no flattening at all: @@ -401,8 +399,8 @@ flatAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs) = COpStmt [] (StgFCallOp - (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str))) - defaultCCallConv PlaySafe)) + (CCall (CCallSpec (CasmTarget (mkFastString (mktxt op_str))) + defaultCCallConv (PlaySafe False))) uu ) [CReg VoidReg] @@ -418,22 +416,16 @@ flatAbsC (CSequential abcs) -- Some statements only make sense at the top level, so we always float -- them. This probably isn't necessary. -flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt) +flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt) -flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt) +flatAbsC stmt@(CSRTDesc _ _ _ _ _) = returnFlt (AbsCNop, stmt) +flatAbsC stmt@(CBitmap _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt) flatAbsC stmt@(CRetVector _ _ _ _) = returnFlt (AbsCNop, stmt) -flatAbsC stmt@(CModuleInitBlock _ _) = returnFlt (AbsCNop, stmt) -\end{code} - -\begin{code} -flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC) -flat_maybe Nothing = returnFlt (Nothing, AbsCNop) -flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) -> - returnFlt (Just heres, tops) +flatAbsC stmt@(CModuleInitBlock _ _ _) = returnFlt (AbsCNop, stmt) \end{code} %************************************************************************ @@ -591,32 +583,40 @@ rrConflictsWithRR s1b s2b rr1 rr2 = rr rr1 rr2 \begin{code} +-- We begin with some helper functions. The main Dude here is +-- dscCOpStmt, defined a little further down. ------------------------------------------------------------------------------ -- Assumes no volatiles +-- Creates +-- res = arg >> (bits-per-word / 2) when little-endian +-- or +-- res = arg & ((1 << (bits-per-word / 2)) - 1) when big-endian +-- +-- In other words, if arg had been stored in memory, makes res the +-- halfword of arg which would have had the higher address. This is +-- why it needs to take into account endianness. +-- mkHalfWord_HIADDR res arg - = mkTemp IntRep `thenFlt` \ t_hw_shift -> - mkTemp WordRep `thenFlt` \ t_hw_mask1 -> + = mkTemp WordRep `thenFlt` \ t_hw_mask1 -> mkTemp WordRep `thenFlt` \ t_hw_mask2 -> - let a_hw_shift - = CMachOpStmt (Just1 t_hw_shift) - MO_Nat_Shl [CBytesPerWord, CLit (mkMachInt 2)] Nothing + let + hw_shift = mkIntCLit (wORD_SIZE_IN_BITS `quot` 2) + +# if WORDS_BIGENDIAN a_hw_mask1 - = CMachOpStmt (Just1 t_hw_mask1) - MO_Nat_Shl [CLit (mkMachWord 1), t_hw_shift] Nothing + = CMachOpStmt t_hw_mask1 + MO_Nat_Shl [CLit (mkMachWord 1), hw_shift] Nothing a_hw_mask2 - = CMachOpStmt (Just1 t_hw_mask2) + = CMachOpStmt t_hw_mask2 MO_Nat_Sub [t_hw_mask1, CLit (mkMachWord 1)] Nothing final -# if WORDS_BIGENDIAN - = CSequential [ a_hw_shift, a_hw_mask1, a_hw_mask2, - CMachOpStmt (Just1 res) MO_Nat_And [arg, t_hw_mask2] Nothing + = CSequential [ a_hw_mask1, a_hw_mask2, + CMachOpStmt res MO_Nat_And [arg, t_hw_mask2] Nothing ] # else - = CSequential [ a_hw_shift, - CMachOpStmt (Just1 res) MO_Nat_Shr [arg, t_hw_shift] Nothing - ] + final = CMachOpStmt res MO_Nat_Shr [arg, hw_shift] Nothing # endif in returnFlt final @@ -628,17 +628,6 @@ mkTemp rep mkTemps = mapFlt mkTemp -mkDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode -mkDerefOff rep base off - | off == 0 -- optimisation - = CMem rep base - | otherwise - = CMem rep (CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep)) - -mkNoDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode -mkNoDerefOff rep base off - = CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep) - -- Sigh. This is done in 3 seperate places. Should be -- commoned up (here, in pprAbsC of COpStmt, and presumably -- somewhere in the NCG). @@ -647,20 +636,76 @@ non_void_amode amode VoidRep -> False k -> True -doIndexOffForeignObjOp rep res addr idx - = Just (Just1 res, MO_ReadOSBI fixedHdrSize rep, [addr,idx]) +-- Helpers for translating various minor variants of array indexing. + +mkDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode +mkDerefOff rep base off + = CVal (CIndex base (CLit (mkMachInt (toInteger off))) rep) rep + +mkNoDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode +mkNoDerefOff rep base off + = CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep) + + +-- Generates an address as follows +-- base + sizeof(machine_word)*offw + sizeof(rep)*idx +mk_OSBI_addr :: Int -> PrimRep -> CAddrMode -> CAddrMode -> RegRelative +mk_OSBI_addr offw rep base idx + = CIndex (CAddr (CIndex base idx rep)) + (CLit (mkMachWord (fromIntegral offw))) + PtrRep -doIndexOffAddrOp rep res addr idx - = Just (Just1 res, MO_ReadOSBI 0 rep, [addr,idx]) +mk_OSBI_ref :: Int -> PrimRep -> CAddrMode -> CAddrMode -> CAddrMode +mk_OSBI_ref offw rep base idx + = CVal (mk_OSBI_addr offw rep base idx) rep -doIndexByteArrayOp rep res addr idx - = Just (Just1 res, MO_ReadOSBI arrWordsHdrSize rep, [addr,idx]) -doWriteOffAddrOp rep addr idx val - = Just (Just0, MO_WriteOSBI 0 rep, [addr,idx,val]) +doIndexOffForeignObjOp maybe_post_read_cast rep res addr idx + = mkBasicIndexedRead 0 maybe_post_read_cast rep res (mkDerefOff WordRep addr fixedHdrSize) idx + +doIndexOffAddrOp maybe_post_read_cast rep res addr idx + = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx + +doIndexByteArrayOp maybe_post_read_cast rep res addr idx + = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx + +doReadPtrArrayOp res addr idx + = mkBasicIndexedRead arrPtrsHdrSize Nothing PtrRep res addr idx + + +doWriteOffAddrOp maybe_pre_write_cast rep addr idx val + = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val + +doWriteByteArrayOp maybe_pre_write_cast rep addr idx val + = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val + +doWritePtrArrayOp addr idx val + = mkBasicIndexedWrite arrPtrsHdrSize Nothing PtrRep addr idx val + + + +mkBasicIndexedRead offw Nothing read_rep res base idx + = returnFlt ( + CAssign res (mk_OSBI_ref offw read_rep base idx) + ) +mkBasicIndexedRead offw (Just cast_to_mop) read_rep res base idx + = mkTemp read_rep `thenFlt` \ tmp -> + (returnFlt . CSequential) [ + CAssign tmp (mk_OSBI_ref offw read_rep base idx), + CMachOpStmt res cast_to_mop [tmp] Nothing + ] + +mkBasicIndexedWrite offw Nothing write_rep base idx val + = returnFlt ( + CAssign (mk_OSBI_ref offw write_rep base idx) val + ) +mkBasicIndexedWrite offw (Just cast_to_mop) write_rep base idx val + = mkTemp write_rep `thenFlt` \ tmp -> + (returnFlt . CSequential) [ + CMachOpStmt tmp cast_to_mop [val] Nothing, + CAssign (mk_OSBI_ref offw write_rep base idx) tmp + ] -doWriteByteArrayOp rep addr idx val - = Just (Just0, MO_WriteOSBI arrWordsHdrSize rep, [addr,idx,val]) -- Simple dyadic op but one for which we need to cast first arg to -- be sure of correctness @@ -668,12 +713,25 @@ translateOp_dyadic_cast1 mop res cast_arg1_to arg1 arg2 vols = mkTemp cast_arg1_to `thenFlt` \ arg1casted -> (returnFlt . CSequential) [ CAssign arg1casted arg1, - CMachOpStmt (Just1 res) mop [arg1casted,arg2] + CMachOpStmt res mop [arg1casted,arg2] (if isDefinitelyInlineMachOp mop then Nothing else Just vols) ] +-- IA64 mangler doesn't place tables next to code +tablesNextToCode :: Bool +#ifdef ia64_TARGET_ARCH +tablesNextToCode = False +#else +tablesNextToCode = not opt_Unregisterised +#endif + ------------------------------------------------------------------------------ +-- This is the main top-level desugarer PrimOps into MachOps. First we +-- handle various awkward cases specially. The remaining easy cases are +-- then handled by translateOp, defined below. + + dscCOpStmt :: [CAddrMode] -- Results -> PrimOp -> [CAddrMode] -- Arguments @@ -681,6 +739,72 @@ dscCOpStmt :: [CAddrMode] -- Results -- (to save/restore around the op) -> FlatM AbstractC + +dscCOpStmt [res_r,res_c] IntAddCOp [aa,bb] vols +{- + With some bit-twiddling, we can define int{Add,Sub}Czh portably in + C, and without needing any comparisons. This may not be the + fastest way to do it - if you have better code, please send it! --SDM + + Return : r = a + b, c = 0 if no overflow, 1 on overflow. + + We currently don't make use of the r value if c is != 0 (i.e. + overflow), we just convert to big integers and try again. This + could be improved by making r and c the correct values for + plugging into a new J#. + + { r = ((I_)(a)) + ((I_)(b)); \ + c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ + >> (BITS_IN (I_) - 1); \ + } + Wading through the mass of bracketry, it seems to reduce to: + c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1) + + SSA-form: + t1 = a^b + t2 = ~t1 + t3 = a^r + t4 = t2 & t3 + c = t4 >>unsigned BITS_IN(I_)-1 +-} + = mkTemps [IntRep,IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3,t4] -> + let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in + (returnFlt . CSequential) [ + CMachOpStmt res_r MO_Nat_Add [aa,bb] Nothing, + CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing, + CMachOpStmt t2 MO_Nat_Not [t1] Nothing, + CMachOpStmt t3 MO_Nat_Xor [aa,res_r] Nothing, + CMachOpStmt t4 MO_Nat_And [t2,t3] Nothing, + CMachOpStmt res_c MO_Nat_Shr [t4, bpw1] Nothing + ] + + +dscCOpStmt [res_r,res_c] IntSubCOp [aa,bb] vols +{- Similarly: + #define subIntCzh(r,c,a,b) \ + { r = ((I_)(a)) - ((I_)(b)); \ + c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \ + >> (BITS_IN (I_) - 1); \ + } + + c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1) + + t1 = a^b + t2 = a^r + t3 = t1 & t2 + c = t3 >>unsigned BITS_IN(I_)-1 +-} + = mkTemps [IntRep,IntRep,IntRep] `thenFlt` \ [t1,t2,t3] -> + let bpw1 = mkIntCLit (wORD_SIZE_IN_BITS - 1) in + (returnFlt . CSequential) [ + CMachOpStmt res_r MO_Nat_Sub [aa,bb] Nothing, + CMachOpStmt t1 MO_Nat_Xor [aa,bb] Nothing, + CMachOpStmt t2 MO_Nat_Xor [aa,res_r] Nothing, + CMachOpStmt t3 MO_Nat_And [t1,t2] Nothing, + CMachOpStmt res_c MO_Nat_Shr [t3, bpw1] Nothing + ] + + -- #define parzh(r,node) r = 1 dscCOpStmt [res] ParOp [arg] vols = returnFlt @@ -716,8 +840,7 @@ dscCOpStmt [res] SizeofByteArrayOp [arg] vols = mkTemp WordRep `thenFlt` \ w -> (returnFlt . CSequential) [ CAssign w (mkDerefOff WordRep arg fixedHdrSize), - CMachOpStmt (Just1 w) - MO_NatU_Mul [w, CBytesPerWord] (Just vols), + CMachOpStmt w MO_NatU_Mul [w, mkIntCLit wORD_SIZE] (Just vols), CAssign res w ] @@ -735,7 +858,7 @@ dscCOpStmt [] TouchOp [arg] vols dscCOpStmt [res] ByteArrayContents_Char [arg] vols = mkTemp PtrRep `thenFlt` \ ptr -> (returnFlt . CSequential) [ - CMachOpStmt (Just1 ptr) MO_NatU_to_NatP [arg] Nothing, + CMachOpStmt ptr MO_NatU_to_NatP [arg] Nothing, CAssign ptr (mkNoDerefOff WordRep ptr arrWordsHdrSize), CAssign res ptr ] @@ -752,7 +875,15 @@ dscCOpStmt [res] EqStableNameOp [arg1,arg2] vols (returnFlt . CSequential) [ CAssign sn1 (mkDerefOff WordRep arg1 fixedHdrSize), CAssign sn2 (mkDerefOff WordRep arg2 fixedHdrSize), - CMachOpStmt (Just1 res) MO_Nat_Eq [sn1,sn2] Nothing + CMachOpStmt res MO_Nat_Eq [sn1,sn2] Nothing + ] + +dscCOpStmt [res] ReallyUnsafePtrEqualityOp [arg1,arg2] vols + = mkTemps [WordRep, WordRep] `thenFlt` \ [w1,w2] -> + (returnFlt . CSequential) [ + CMachOpStmt w1 MO_NatP_to_NatU [arg1] Nothing, + CMachOpStmt w2 MO_NatP_to_NatU [arg2] Nothing, + CMachOpStmt res MO_Nat_Eq [w1,w2] Nothing{- because it's inline? -} ] -- #define addrToHValuezh(r,a) r=(P_)a @@ -761,12 +892,42 @@ dscCOpStmt [res] AddrToHValueOp [arg] vols (CAssign res arg) -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) +-- +-- In the unregisterised case, we don't attempt to compute the location +-- of the tag halfword, just a macro. For this build, fixing on layout +-- info has only got drawbacks. +-- +-- Should this arrangement deeply offend you for some reason, code which +-- computes the offset can be found below also. +-- -- sof 3/02 +-- dscCOpStmt [res] DataToTagOp [arg] vols + | not tablesNextToCode + = returnFlt (CMacroStmt DATA_TO_TAGZH [res,arg]) + | otherwise = mkTemps [PtrRep, WordRep] `thenFlt` \ [t_infoptr, t_theword] -> mkHalfWord_HIADDR res t_theword `thenFlt` \ select_ops -> (returnFlt . CSequential) [ CAssign t_infoptr (mkDerefOff PtrRep arg 0), + {- + Get at the tag within the info table; two cases to consider: + + - reversed info tables next to the entry point code; + one word above the end of the info table (which is + what t_infoptr is really pointing to). + - info tables with their entry points stored somewhere else, + which is how the unregisterised (nee TABLES_NEXT_TO_CODE) + world operates. + + The t_infoptr points to the start of the info table, so add + the length of the info table & subtract one word. + -} CAssign t_theword (mkDerefOff WordRep t_infoptr (-1)), +{- UNUSED - see above comment. + (if opt_Unregisterised then + (fixedItblSize - 1) + else (-1))), +-} select_ops ] @@ -797,12 +958,12 @@ dscCOpStmt [res] UnsafeFreezeByteArrayOp [arg] vols dscCOpStmt [r] AddrRemOp [a1,a2] vols = mkTemp WordRep `thenFlt` \ a1casted -> (returnFlt . CSequential) [ - CMachOpStmt (Just1 a1casted) MO_NatP_to_NatU [a1] Nothing, - CMachOpStmt (Just1 r) MO_NatU_Rem [a1casted,a2] Nothing + CMachOpStmt a1casted MO_NatP_to_NatU [a1] Nothing, + CMachOpStmt r MO_NatU_Rem [a1casted,a2] Nothing ] -- not handled by translateOp because they need casts -dscCOpStmt [r] SllOp [a1,a2] vols +dscCOpStmt [r] SllOp [a1,a2] vols = translateOp_dyadic_cast1 MO_Nat_Shl r WordRep a1 a2 vols dscCOpStmt [r] SrlOp [a1,a2] vols = translateOp_dyadic_cast1 MO_Nat_Shr r WordRep a1 a2 vols @@ -814,330 +975,341 @@ dscCOpStmt [r] ISrlOp [a1,a2] vols dscCOpStmt [r] ISraOp [a1,a2] vols = translateOp_dyadic_cast1 MO_Nat_Sar r IntRep a1 a2 vols +-- Reading/writing pointer arrays --- Handle all others as simply as possible. -dscCOpStmt ress op args vols - = case translateOp ress op args of - Nothing - -> pprPanic "dscCOpStmt: can't translate PrimOp" (ppr op) - Just (maybe_res, mop, args) - -> returnFlt ( - CMachOpStmt maybe_res mop args - (if isDefinitelyInlineMachOp mop then Nothing else Just vols) - ) - - - -translateOp [r] ReadArrayOp [obj,ix] - = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) -translateOp [r] IndexArrayOp [obj,ix] - = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) -translateOp [] WriteArrayOp [obj,ix,v] - = Just (Just0, MO_WriteOSBI arrPtrsHdrSize PtrRep, [obj,ix,v]) +dscCOpStmt [r] ReadArrayOp [obj,ix] vols = doReadPtrArrayOp r obj ix +dscCOpStmt [r] IndexArrayOp [obj,ix] vols = doReadPtrArrayOp r obj ix +dscCOpStmt [] WriteArrayOp [obj,ix,v] vols = doWritePtrArrayOp obj ix v -- IndexXXXoffForeignObj -translateOp [r] IndexOffForeignObjOp_Char [a,i] = doIndexOffForeignObjOp Word8Rep r a i -translateOp [r] IndexOffForeignObjOp_WideChar [a,i] = doIndexOffForeignObjOp Word32Rep r a i -translateOp [r] IndexOffForeignObjOp_Int [a,i] = doIndexOffForeignObjOp IntRep r a i -translateOp [r] IndexOffForeignObjOp_Word [a,i] = doIndexOffForeignObjOp WordRep r a i -translateOp [r] IndexOffForeignObjOp_Addr [a,i] = doIndexOffForeignObjOp AddrRep r a i -translateOp [r] IndexOffForeignObjOp_Float [a,i] = doIndexOffForeignObjOp FloatRep r a i -translateOp [r] IndexOffForeignObjOp_Double [a,i] = doIndexOffForeignObjOp DoubleRep r a i -translateOp [r] IndexOffForeignObjOp_StablePtr [a,i] = doIndexOffForeignObjOp StablePtrRep r a i - -translateOp [r] IndexOffForeignObjOp_Int8 [a,i] = doIndexOffForeignObjOp Int8Rep r a i -translateOp [r] IndexOffForeignObjOp_Int16 [a,i] = doIndexOffForeignObjOp Int16Rep r a i -translateOp [r] IndexOffForeignObjOp_Int32 [a,i] = doIndexOffForeignObjOp Int32Rep r a i -translateOp [r] IndexOffForeignObjOp_Int64 [a,i] = doIndexOffForeignObjOp Int64Rep r a i - -translateOp [r] IndexOffForeignObjOp_Word8 [a,i] = doIndexOffForeignObjOp Word8Rep r a i -translateOp [r] IndexOffForeignObjOp_Word16 [a,i] = doIndexOffForeignObjOp Word16Rep r a i -translateOp [r] IndexOffForeignObjOp_Word32 [a,i] = doIndexOffForeignObjOp Word32Rep r a i -translateOp [r] IndexOffForeignObjOp_Word64 [a,i] = doIndexOffForeignObjOp Word64Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Char [a,i] vols = doIndexOffForeignObjOp (Just MO_8U_to_32U) Word8Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_WideChar [a,i] vols = doIndexOffForeignObjOp Nothing Word32Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Int [a,i] vols = doIndexOffForeignObjOp Nothing IntRep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Word [a,i] vols = doIndexOffForeignObjOp Nothing WordRep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Addr [a,i] vols = doIndexOffForeignObjOp Nothing AddrRep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Float [a,i] vols = doIndexOffForeignObjOp Nothing FloatRep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Double [a,i] vols = doIndexOffForeignObjOp Nothing DoubleRep r a i +dscCOpStmt [r] IndexOffForeignObjOp_StablePtr [a,i] vols = doIndexOffForeignObjOp Nothing StablePtrRep r a i + +dscCOpStmt [r] IndexOffForeignObjOp_Int8 [a,i] vols = doIndexOffForeignObjOp Nothing Int8Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Int16 [a,i] vols = doIndexOffForeignObjOp Nothing Int16Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Int32 [a,i] vols = doIndexOffForeignObjOp Nothing Int32Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Int64 [a,i] vols = doIndexOffForeignObjOp Nothing Int64Rep r a i + +dscCOpStmt [r] IndexOffForeignObjOp_Word8 [a,i] vols = doIndexOffForeignObjOp Nothing Word8Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Word16 [a,i] vols = doIndexOffForeignObjOp Nothing Word16Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Word32 [a,i] vols = doIndexOffForeignObjOp Nothing Word32Rep r a i +dscCOpStmt [r] IndexOffForeignObjOp_Word64 [a,i] vols = doIndexOffForeignObjOp Nothing Word64Rep r a i -- IndexXXXoffAddr -translateOp [r] IndexOffAddrOp_Char [a,i] = doIndexOffAddrOp Word8Rep r a i -translateOp [r] IndexOffAddrOp_WideChar [a,i] = doIndexOffAddrOp Word32Rep r a i -translateOp [r] IndexOffAddrOp_Int [a,i] = doIndexOffAddrOp IntRep r a i -translateOp [r] IndexOffAddrOp_Word [a,i] = doIndexOffAddrOp WordRep r a i -translateOp [r] IndexOffAddrOp_Addr [a,i] = doIndexOffAddrOp AddrRep r a i -translateOp [r] IndexOffAddrOp_Float [a,i] = doIndexOffAddrOp FloatRep r a i -translateOp [r] IndexOffAddrOp_Double [a,i] = doIndexOffAddrOp DoubleRep r a i -translateOp [r] IndexOffAddrOp_StablePtr [a,i] = doIndexOffAddrOp StablePtrRep r a i - -translateOp [r] IndexOffAddrOp_Int8 [a,i] = doIndexOffAddrOp Int8Rep r a i -translateOp [r] IndexOffAddrOp_Int16 [a,i] = doIndexOffAddrOp Int16Rep r a i -translateOp [r] IndexOffAddrOp_Int32 [a,i] = doIndexOffAddrOp Int32Rep r a i -translateOp [r] IndexOffAddrOp_Int64 [a,i] = doIndexOffAddrOp Int64Rep r a i - -translateOp [r] IndexOffAddrOp_Word8 [a,i] = doIndexOffAddrOp Word8Rep r a i -translateOp [r] IndexOffAddrOp_Word16 [a,i] = doIndexOffAddrOp Word16Rep r a i -translateOp [r] IndexOffAddrOp_Word32 [a,i] = doIndexOffAddrOp Word32Rep r a i -translateOp [r] IndexOffAddrOp_Word64 [a,i] = doIndexOffAddrOp Word64Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Char [a,i] vols = doIndexOffAddrOp (Just MO_8U_to_32U) Word8Rep r a i +dscCOpStmt [r] IndexOffAddrOp_WideChar [a,i] vols = doIndexOffAddrOp Nothing Word32Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Int [a,i] vols = doIndexOffAddrOp Nothing IntRep r a i +dscCOpStmt [r] IndexOffAddrOp_Word [a,i] vols = doIndexOffAddrOp Nothing WordRep r a i +dscCOpStmt [r] IndexOffAddrOp_Addr [a,i] vols = doIndexOffAddrOp Nothing AddrRep r a i +dscCOpStmt [r] IndexOffAddrOp_Float [a,i] vols = doIndexOffAddrOp Nothing FloatRep r a i +dscCOpStmt [r] IndexOffAddrOp_Double [a,i] vols = doIndexOffAddrOp Nothing DoubleRep r a i +dscCOpStmt [r] IndexOffAddrOp_StablePtr [a,i] vols = doIndexOffAddrOp Nothing StablePtrRep r a i + +dscCOpStmt [r] IndexOffAddrOp_Int8 [a,i] vols = doIndexOffAddrOp Nothing Int8Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Int16 [a,i] vols = doIndexOffAddrOp Nothing Int16Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Int32 [a,i] vols = doIndexOffAddrOp Nothing Int32Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Int64 [a,i] vols = doIndexOffAddrOp Nothing Int64Rep r a i + +dscCOpStmt [r] IndexOffAddrOp_Word8 [a,i] vols = doIndexOffAddrOp Nothing Word8Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Word16 [a,i] vols = doIndexOffAddrOp Nothing Word16Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Word32 [a,i] vols = doIndexOffAddrOp Nothing Word32Rep r a i +dscCOpStmt [r] IndexOffAddrOp_Word64 [a,i] vols = doIndexOffAddrOp Nothing Word64Rep r a i -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr. -translateOp [r] ReadOffAddrOp_Char [a,i] = doIndexOffAddrOp Word8Rep r a i -translateOp [r] ReadOffAddrOp_WideChar [a,i] = doIndexOffAddrOp Word32Rep r a i -translateOp [r] ReadOffAddrOp_Int [a,i] = doIndexOffAddrOp IntRep r a i -translateOp [r] ReadOffAddrOp_Word [a,i] = doIndexOffAddrOp WordRep r a i -translateOp [r] ReadOffAddrOp_Addr [a,i] = doIndexOffAddrOp AddrRep r a i -translateOp [r] ReadOffAddrOp_Float [a,i] = doIndexOffAddrOp FloatRep r a i -translateOp [r] ReadOffAddrOp_Double [a,i] = doIndexOffAddrOp DoubleRep r a i -translateOp [r] ReadOffAddrOp_StablePtr [a,i] = doIndexOffAddrOp StablePtrRep r a i - -translateOp [r] ReadOffAddrOp_Int8 [a,i] = doIndexOffAddrOp Int8Rep r a i -translateOp [r] ReadOffAddrOp_Int16 [a,i] = doIndexOffAddrOp Int16Rep r a i -translateOp [r] ReadOffAddrOp_Int32 [a,i] = doIndexOffAddrOp Int32Rep r a i -translateOp [r] ReadOffAddrOp_Int64 [a,i] = doIndexOffAddrOp Int64Rep r a i - -translateOp [r] ReadOffAddrOp_Word8 [a,i] = doIndexOffAddrOp Word8Rep r a i -translateOp [r] ReadOffAddrOp_Word16 [a,i] = doIndexOffAddrOp Word16Rep r a i -translateOp [r] ReadOffAddrOp_Word32 [a,i] = doIndexOffAddrOp Word32Rep r a i -translateOp [r] ReadOffAddrOp_Word64 [a,i] = doIndexOffAddrOp Word64Rep r a i - --- WriteXXXoffAddr - -translateOp [] WriteOffAddrOp_Char [a,i,x] = doWriteOffAddrOp Word8Rep a i x -translateOp [] WriteOffAddrOp_WideChar [a,i,x] = doWriteOffAddrOp Word32Rep a i x -translateOp [] WriteOffAddrOp_Int [a,i,x] = doWriteOffAddrOp IntRep a i x -translateOp [] WriteOffAddrOp_Word [a,i,x] = doWriteOffAddrOp WordRep a i x -translateOp [] WriteOffAddrOp_Addr [a,i,x] = doWriteOffAddrOp AddrRep a i x -translateOp [] WriteOffAddrOp_Float [a,i,x] = doWriteOffAddrOp FloatRep a i x -translateOp [] WriteOffAddrOp_ForeignObj [a,i,x] = doWriteOffAddrOp ForeignObjRep a i x -translateOp [] WriteOffAddrOp_Double [a,i,x] = doWriteOffAddrOp DoubleRep a i x -translateOp [] WriteOffAddrOp_StablePtr [a,i,x] = doWriteOffAddrOp StablePtrRep a i x - -translateOp [] WriteOffAddrOp_Int8 [a,i,x] = doWriteOffAddrOp Int8Rep a i x -translateOp [] WriteOffAddrOp_Int16 [a,i,x] = doWriteOffAddrOp Int16Rep a i x -translateOp [] WriteOffAddrOp_Int32 [a,i,x] = doWriteOffAddrOp Int32Rep a i x -translateOp [] WriteOffAddrOp_Int64 [a,i,x] = doWriteOffAddrOp Int64Rep a i x - -translateOp [] WriteOffAddrOp_Word8 [a,i,x] = doWriteOffAddrOp Word8Rep a i x -translateOp [] WriteOffAddrOp_Word16 [a,i,x] = doWriteOffAddrOp Word16Rep a i x -translateOp [] WriteOffAddrOp_Word32 [a,i,x] = doWriteOffAddrOp Word32Rep a i x -translateOp [] WriteOffAddrOp_Word64 [a,i,x] = doWriteOffAddrOp Word64Rep a i x +dscCOpStmt [r] ReadOffAddrOp_Char [a,i] vols = doIndexOffAddrOp (Just MO_8U_to_32U) Word8Rep r a i +dscCOpStmt [r] ReadOffAddrOp_WideChar [a,i] vols = doIndexOffAddrOp Nothing Word32Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Int [a,i] vols = doIndexOffAddrOp Nothing IntRep r a i +dscCOpStmt [r] ReadOffAddrOp_Word [a,i] vols = doIndexOffAddrOp Nothing WordRep r a i +dscCOpStmt [r] ReadOffAddrOp_Addr [a,i] vols = doIndexOffAddrOp Nothing AddrRep r a i +dscCOpStmt [r] ReadOffAddrOp_Float [a,i] vols = doIndexOffAddrOp Nothing FloatRep r a i +dscCOpStmt [r] ReadOffAddrOp_Double [a,i] vols = doIndexOffAddrOp Nothing DoubleRep r a i +dscCOpStmt [r] ReadOffAddrOp_StablePtr [a,i] vols = doIndexOffAddrOp Nothing StablePtrRep r a i + +dscCOpStmt [r] ReadOffAddrOp_Int8 [a,i] vols = doIndexOffAddrOp Nothing Int8Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Int16 [a,i] vols = doIndexOffAddrOp Nothing Int16Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Int32 [a,i] vols = doIndexOffAddrOp Nothing Int32Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Int64 [a,i] vols = doIndexOffAddrOp Nothing Int64Rep r a i + +dscCOpStmt [r] ReadOffAddrOp_Word8 [a,i] vols = doIndexOffAddrOp Nothing Word8Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Word16 [a,i] vols = doIndexOffAddrOp Nothing Word16Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Word32 [a,i] vols = doIndexOffAddrOp Nothing Word32Rep r a i +dscCOpStmt [r] ReadOffAddrOp_Word64 [a,i] vols = doIndexOffAddrOp Nothing Word64Rep r a i -- IndexXXXArray -translateOp [r] IndexByteArrayOp_Char [a,i] = doIndexByteArrayOp Word8Rep r a i -translateOp [r] IndexByteArrayOp_WideChar [a,i] = doIndexByteArrayOp Word32Rep r a i -translateOp [r] IndexByteArrayOp_Int [a,i] = doIndexByteArrayOp IntRep r a i -translateOp [r] IndexByteArrayOp_Word [a,i] = doIndexByteArrayOp WordRep r a i -translateOp [r] IndexByteArrayOp_Addr [a,i] = doIndexByteArrayOp AddrRep r a i -translateOp [r] IndexByteArrayOp_Float [a,i] = doIndexByteArrayOp FloatRep r a i -translateOp [r] IndexByteArrayOp_Double [a,i] = doIndexByteArrayOp DoubleRep r a i -translateOp [r] IndexByteArrayOp_StablePtr [a,i] = doIndexByteArrayOp StablePtrRep r a i - -translateOp [r] IndexByteArrayOp_Int8 [a,i] = doIndexByteArrayOp Int8Rep r a i -translateOp [r] IndexByteArrayOp_Int16 [a,i] = doIndexByteArrayOp Int16Rep r a i -translateOp [r] IndexByteArrayOp_Int32 [a,i] = doIndexByteArrayOp Int32Rep r a i -translateOp [r] IndexByteArrayOp_Int64 [a,i] = doIndexByteArrayOp Int64Rep r a i - -translateOp [r] IndexByteArrayOp_Word8 [a,i] = doIndexByteArrayOp Word8Rep r a i -translateOp [r] IndexByteArrayOp_Word16 [a,i] = doIndexByteArrayOp Word16Rep r a i -translateOp [r] IndexByteArrayOp_Word32 [a,i] = doIndexByteArrayOp Word32Rep r a i -translateOp [r] IndexByteArrayOp_Word64 [a,i] = doIndexByteArrayOp Word64Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Char [a,i] vols = doIndexByteArrayOp (Just MO_8U_to_32U) Word8Rep r a i +dscCOpStmt [r] IndexByteArrayOp_WideChar [a,i] vols = doIndexByteArrayOp Nothing Word32Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Int [a,i] vols = doIndexByteArrayOp Nothing IntRep r a i +dscCOpStmt [r] IndexByteArrayOp_Word [a,i] vols = doIndexByteArrayOp Nothing WordRep r a i +dscCOpStmt [r] IndexByteArrayOp_Addr [a,i] vols = doIndexByteArrayOp Nothing AddrRep r a i +dscCOpStmt [r] IndexByteArrayOp_Float [a,i] vols = doIndexByteArrayOp Nothing FloatRep r a i +dscCOpStmt [r] IndexByteArrayOp_Double [a,i] vols = doIndexByteArrayOp Nothing DoubleRep r a i +dscCOpStmt [r] IndexByteArrayOp_StablePtr [a,i] vols = doIndexByteArrayOp Nothing StablePtrRep r a i + +dscCOpStmt [r] IndexByteArrayOp_Int8 [a,i] vols = doIndexByteArrayOp Nothing Int8Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Int16 [a,i] vols = doIndexByteArrayOp Nothing Int16Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Int32 [a,i] vols = doIndexByteArrayOp Nothing Int32Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Int64 [a,i] vols = doIndexByteArrayOp Nothing Int64Rep r a i + +dscCOpStmt [r] IndexByteArrayOp_Word8 [a,i] vols = doIndexByteArrayOp Nothing Word8Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Word16 [a,i] vols = doIndexByteArrayOp Nothing Word16Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Word32 [a,i] vols = doIndexByteArrayOp Nothing Word32Rep r a i +dscCOpStmt [r] IndexByteArrayOp_Word64 [a,i] vols = doIndexByteArrayOp Nothing Word64Rep r a i -- ReadXXXArray, identical to IndexXXXArray. -translateOp [r] ReadByteArrayOp_Char [a,i] = doIndexByteArrayOp Word8Rep r a i -translateOp [r] ReadByteArrayOp_WideChar [a,i] = doIndexByteArrayOp Word32Rep r a i -translateOp [r] ReadByteArrayOp_Int [a,i] = doIndexByteArrayOp IntRep r a i -translateOp [r] ReadByteArrayOp_Word [a,i] = doIndexByteArrayOp WordRep r a i -translateOp [r] ReadByteArrayOp_Addr [a,i] = doIndexByteArrayOp AddrRep r a i -translateOp [r] ReadByteArrayOp_Float [a,i] = doIndexByteArrayOp FloatRep r a i -translateOp [r] ReadByteArrayOp_Double [a,i] = doIndexByteArrayOp DoubleRep r a i -translateOp [r] ReadByteArrayOp_StablePtr [a,i] = doIndexByteArrayOp StablePtrRep r a i - -translateOp [r] ReadByteArrayOp_Int8 [a,i] = doIndexByteArrayOp Int8Rep r a i -translateOp [r] ReadByteArrayOp_Int16 [a,i] = doIndexByteArrayOp Int16Rep r a i -translateOp [r] ReadByteArrayOp_Int32 [a,i] = doIndexByteArrayOp Int32Rep r a i -translateOp [r] ReadByteArrayOp_Int64 [a,i] = doIndexByteArrayOp Int64Rep r a i - -translateOp [r] ReadByteArrayOp_Word8 [a,i] = doIndexByteArrayOp Word8Rep r a i -translateOp [r] ReadByteArrayOp_Word16 [a,i] = doIndexByteArrayOp Word16Rep r a i -translateOp [r] ReadByteArrayOp_Word32 [a,i] = doIndexByteArrayOp Word32Rep r a i -translateOp [r] ReadByteArrayOp_Word64 [a,i] = doIndexByteArrayOp Word64Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Char [a,i] vols = doIndexByteArrayOp (Just MO_8U_to_32U) Word8Rep r a i +dscCOpStmt [r] ReadByteArrayOp_WideChar [a,i] vols = doIndexByteArrayOp Nothing Word32Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Int [a,i] vols = doIndexByteArrayOp Nothing IntRep r a i +dscCOpStmt [r] ReadByteArrayOp_Word [a,i] vols = doIndexByteArrayOp Nothing WordRep r a i +dscCOpStmt [r] ReadByteArrayOp_Addr [a,i] vols = doIndexByteArrayOp Nothing AddrRep r a i +dscCOpStmt [r] ReadByteArrayOp_Float [a,i] vols = doIndexByteArrayOp Nothing FloatRep r a i +dscCOpStmt [r] ReadByteArrayOp_Double [a,i] vols = doIndexByteArrayOp Nothing DoubleRep r a i +dscCOpStmt [r] ReadByteArrayOp_StablePtr [a,i] vols = doIndexByteArrayOp Nothing StablePtrRep r a i + +dscCOpStmt [r] ReadByteArrayOp_Int8 [a,i] vols = doIndexByteArrayOp Nothing Int8Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Int16 [a,i] vols = doIndexByteArrayOp Nothing Int16Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Int32 [a,i] vols = doIndexByteArrayOp Nothing Int32Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Int64 [a,i] vols = doIndexByteArrayOp Nothing Int64Rep r a i + +dscCOpStmt [r] ReadByteArrayOp_Word8 [a,i] vols = doIndexByteArrayOp Nothing Word8Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Word16 [a,i] vols = doIndexByteArrayOp Nothing Word16Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Word32 [a,i] vols = doIndexByteArrayOp Nothing Word32Rep r a i +dscCOpStmt [r] ReadByteArrayOp_Word64 [a,i] vols = doIndexByteArrayOp Nothing Word64Rep r a i + +-- WriteXXXoffAddr + +dscCOpStmt [] WriteOffAddrOp_Char [a,i,x] vols = doWriteOffAddrOp (Just MO_32U_to_8U) Word8Rep a i x +dscCOpStmt [] WriteOffAddrOp_WideChar [a,i,x] vols = doWriteOffAddrOp Nothing Word32Rep a i x +dscCOpStmt [] WriteOffAddrOp_Int [a,i,x] vols = doWriteOffAddrOp Nothing IntRep a i x +dscCOpStmt [] WriteOffAddrOp_Word [a,i,x] vols = doWriteOffAddrOp Nothing WordRep a i x +dscCOpStmt [] WriteOffAddrOp_Addr [a,i,x] vols = doWriteOffAddrOp Nothing AddrRep a i x +dscCOpStmt [] WriteOffAddrOp_Float [a,i,x] vols = doWriteOffAddrOp Nothing FloatRep a i x +dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing PtrRep a i x +dscCOpStmt [] WriteOffAddrOp_Double [a,i,x] vols = doWriteOffAddrOp Nothing DoubleRep a i x +dscCOpStmt [] WriteOffAddrOp_StablePtr [a,i,x] vols = doWriteOffAddrOp Nothing StablePtrRep a i x + +dscCOpStmt [] WriteOffAddrOp_Int8 [a,i,x] vols = doWriteOffAddrOp Nothing Int8Rep a i x +dscCOpStmt [] WriteOffAddrOp_Int16 [a,i,x] vols = doWriteOffAddrOp Nothing Int16Rep a i x +dscCOpStmt [] WriteOffAddrOp_Int32 [a,i,x] vols = doWriteOffAddrOp Nothing Int32Rep a i x +dscCOpStmt [] WriteOffAddrOp_Int64 [a,i,x] vols = doWriteOffAddrOp Nothing Int64Rep a i x + +dscCOpStmt [] WriteOffAddrOp_Word8 [a,i,x] vols = doWriteOffAddrOp Nothing Word8Rep a i x +dscCOpStmt [] WriteOffAddrOp_Word16 [a,i,x] vols = doWriteOffAddrOp Nothing Word16Rep a i x +dscCOpStmt [] WriteOffAddrOp_Word32 [a,i,x] vols = doWriteOffAddrOp Nothing Word32Rep a i x +dscCOpStmt [] WriteOffAddrOp_Word64 [a,i,x] vols = doWriteOffAddrOp Nothing Word64Rep a i x -- WriteXXXArray -translateOp [] WriteByteArrayOp_Char [a,i,x] = doWriteByteArrayOp Word8Rep a i x -translateOp [] WriteByteArrayOp_WideChar [a,i,x] = doWriteByteArrayOp Word32Rep a i x -translateOp [] WriteByteArrayOp_Int [a,i,x] = doWriteByteArrayOp IntRep a i x -translateOp [] WriteByteArrayOp_Word [a,i,x] = doWriteByteArrayOp WordRep a i x -translateOp [] WriteByteArrayOp_Addr [a,i,x] = doWriteByteArrayOp AddrRep a i x -translateOp [] WriteByteArrayOp_Float [a,i,x] = doWriteByteArrayOp FloatRep a i x -translateOp [] WriteByteArrayOp_Double [a,i,x] = doWriteByteArrayOp DoubleRep a i x -translateOp [] WriteByteArrayOp_StablePtr [a,i,x] = doWriteByteArrayOp StablePtrRep a i x - -translateOp [] WriteByteArrayOp_Int8 [a,i,x] = doWriteByteArrayOp Int8Rep a i x -translateOp [] WriteByteArrayOp_Int16 [a,i,x] = doWriteByteArrayOp Int16Rep a i x -translateOp [] WriteByteArrayOp_Int32 [a,i,x] = doWriteByteArrayOp Int32Rep a i x -translateOp [] WriteByteArrayOp_Int64 [a,i,x] = doWriteByteArrayOp Int64Rep a i x - -translateOp [] WriteByteArrayOp_Word8 [a,i,x] = doWriteByteArrayOp Word8Rep a i x -translateOp [] WriteByteArrayOp_Word16 [a,i,x] = doWriteByteArrayOp Word16Rep a i x -translateOp [] WriteByteArrayOp_Word32 [a,i,x] = doWriteByteArrayOp Word32Rep a i x -translateOp [] WriteByteArrayOp_Word64 [a,i,x] = doWriteByteArrayOp Word64Rep a i x +dscCOpStmt [] WriteByteArrayOp_Char [a,i,x] vols = doWriteByteArrayOp (Just MO_32U_to_8U) Word8Rep a i x +dscCOpStmt [] WriteByteArrayOp_WideChar [a,i,x] vols = doWriteByteArrayOp Nothing Word32Rep a i x +dscCOpStmt [] WriteByteArrayOp_Int [a,i,x] vols = doWriteByteArrayOp Nothing IntRep a i x +dscCOpStmt [] WriteByteArrayOp_Word [a,i,x] vols = doWriteByteArrayOp Nothing WordRep a i x +dscCOpStmt [] WriteByteArrayOp_Addr [a,i,x] vols = doWriteByteArrayOp Nothing AddrRep a i x +dscCOpStmt [] WriteByteArrayOp_Float [a,i,x] vols = doWriteByteArrayOp Nothing FloatRep a i x +dscCOpStmt [] WriteByteArrayOp_Double [a,i,x] vols = doWriteByteArrayOp Nothing DoubleRep a i x +dscCOpStmt [] WriteByteArrayOp_StablePtr [a,i,x] vols = doWriteByteArrayOp Nothing StablePtrRep a i x + +dscCOpStmt [] WriteByteArrayOp_Int8 [a,i,x] vols = doWriteByteArrayOp Nothing Int8Rep a i x +dscCOpStmt [] WriteByteArrayOp_Int16 [a,i,x] vols = doWriteByteArrayOp Nothing Int16Rep a i x +dscCOpStmt [] WriteByteArrayOp_Int32 [a,i,x] vols = doWriteByteArrayOp Nothing Int32Rep a i x +dscCOpStmt [] WriteByteArrayOp_Int64 [a,i,x] vols = doWriteByteArrayOp Nothing Int64Rep a i x + +dscCOpStmt [] WriteByteArrayOp_Word8 [a,i,x] vols = doWriteByteArrayOp Nothing Word8Rep a i x +dscCOpStmt [] WriteByteArrayOp_Word16 [a,i,x] vols = doWriteByteArrayOp Nothing Word16Rep a i x +dscCOpStmt [] WriteByteArrayOp_Word32 [a,i,x] vols = doWriteByteArrayOp Nothing Word32Rep a i x +dscCOpStmt [] WriteByteArrayOp_Word64 [a,i,x] vols = doWriteByteArrayOp Nothing Word64Rep a i x + + +-- Handle all others as simply as possible. +dscCOpStmt ress op args vols + = case translateOp ress op args of + Nothing + -> pprPanic "dscCOpStmt: can't translate PrimOp" (ppr op) + Just (maybe_res, mop, args) + -> returnFlt ( + CMachOpStmt maybe_res mop args + (if isDefinitelyInlineMachOp mop then Nothing else Just vols) + ) -- Native word signless ops -translateOp [r] IntAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2]) -translateOp [r] IntSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2]) -translateOp [r] WordAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2]) -translateOp [r] WordSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2]) -translateOp [r] AddrAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2]) -translateOp [r] AddrSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2]) - -translateOp [r] IntEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] IntNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2]) -translateOp [r] WordEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] WordNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2]) -translateOp [r] AddrEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] AddrNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2]) - -translateOp [r] AndOp [a1,a2] = Just (Just1 r, MO_Nat_And, [a1,a2]) -translateOp [r] OrOp [a1,a2] = Just (Just1 r, MO_Nat_Or, [a1,a2]) -translateOp [r] XorOp [a1,a2] = Just (Just1 r, MO_Nat_Xor, [a1,a2]) -translateOp [r] NotOp [a1] = Just (Just1 r, MO_Nat_Not, [a1]) +translateOp [r] IntAddOp [a1,a2] = Just (r, MO_Nat_Add, [a1,a2]) +translateOp [r] IntSubOp [a1,a2] = Just (r, MO_Nat_Sub, [a1,a2]) +translateOp [r] WordAddOp [a1,a2] = Just (r, MO_Nat_Add, [a1,a2]) +translateOp [r] WordSubOp [a1,a2] = Just (r, MO_Nat_Sub, [a1,a2]) +translateOp [r] AddrAddOp [a1,a2] = Just (r, MO_Nat_Add, [a1,a2]) +translateOp [r] AddrSubOp [a1,a2] = Just (r, MO_Nat_Sub, [a1,a2]) + +translateOp [r] IntEqOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] IntNeOp [a1,a2] = Just (r, MO_Nat_Ne, [a1,a2]) +translateOp [r] WordEqOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] WordNeOp [a1,a2] = Just (r, MO_Nat_Ne, [a1,a2]) +translateOp [r] AddrEqOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] AddrNeOp [a1,a2] = Just (r, MO_Nat_Ne, [a1,a2]) + +translateOp [r] AndOp [a1,a2] = Just (r, MO_Nat_And, [a1,a2]) +translateOp [r] OrOp [a1,a2] = Just (r, MO_Nat_Or, [a1,a2]) +translateOp [r] XorOp [a1,a2] = Just (r, MO_Nat_Xor, [a1,a2]) +translateOp [r] NotOp [a1] = Just (r, MO_Nat_Not, [a1]) -- Native word signed ops -translateOp [r] IntMulOp [a1,a2] = Just (Just1 r, MO_NatS_Mul, [a1,a2]) -translateOp [r] IntQuotOp [a1,a2] = Just (Just1 r, MO_NatS_Quot, [a1,a2]) -translateOp [r] IntRemOp [a1,a2] = Just (Just1 r, MO_NatS_Rem, [a1,a2]) -translateOp [r] IntNegOp [a1] = Just (Just1 r, MO_NatS_Neg, [a1]) +translateOp [r] IntMulOp [a1,a2] = Just (r, MO_NatS_Mul, [a1,a2]) +translateOp [r] IntMulMayOfloOp [a1,a2] = Just (r, MO_NatS_MulMayOflo, [a1,a2]) +translateOp [r] IntQuotOp [a1,a2] = Just (r, MO_NatS_Quot, [a1,a2]) +translateOp [r] IntRemOp [a1,a2] = Just (r, MO_NatS_Rem, [a1,a2]) +translateOp [r] IntNegOp [a1] = Just (r, MO_NatS_Neg, [a1]) -translateOp [r,c] IntAddCOp [a1,a2] = Just (Just2 r c, MO_NatS_AddC, [a1,a2]) -translateOp [r,c] IntSubCOp [a1,a2] = Just (Just2 r c, MO_NatS_SubC, [a1,a2]) -translateOp [r,c] IntMulCOp [a1,a2] = Just (Just2 r c, MO_NatS_MulC, [a1,a2]) +translateOp [r] IntGeOp [a1,a2] = Just (r, MO_NatS_Ge, [a1,a2]) +translateOp [r] IntLeOp [a1,a2] = Just (r, MO_NatS_Le, [a1,a2]) +translateOp [r] IntGtOp [a1,a2] = Just (r, MO_NatS_Gt, [a1,a2]) +translateOp [r] IntLtOp [a1,a2] = Just (r, MO_NatS_Lt, [a1,a2]) -translateOp [r] IntGeOp [a1,a2] = Just (Just1 r, MO_NatS_Ge, [a1,a2]) -translateOp [r] IntLeOp [a1,a2] = Just (Just1 r, MO_NatS_Le, [a1,a2]) -translateOp [r] IntGtOp [a1,a2] = Just (Just1 r, MO_NatS_Gt, [a1,a2]) -translateOp [r] IntLtOp [a1,a2] = Just (Just1 r, MO_NatS_Lt, [a1,a2]) -- Native word unsigned ops -translateOp [r] WordGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2]) -translateOp [r] WordLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2]) -translateOp [r] WordGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2]) -translateOp [r] WordLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2]) +translateOp [r] WordGeOp [a1,a2] = Just (r, MO_NatU_Ge, [a1,a2]) +translateOp [r] WordLeOp [a1,a2] = Just (r, MO_NatU_Le, [a1,a2]) +translateOp [r] WordGtOp [a1,a2] = Just (r, MO_NatU_Gt, [a1,a2]) +translateOp [r] WordLtOp [a1,a2] = Just (r, MO_NatU_Lt, [a1,a2]) -translateOp [r] WordMulOp [a1,a2] = Just (Just1 r, MO_NatU_Mul, [a1,a2]) -translateOp [r] WordQuotOp [a1,a2] = Just (Just1 r, MO_NatU_Quot, [a1,a2]) -translateOp [r] WordRemOp [a1,a2] = Just (Just1 r, MO_NatU_Rem, [a1,a2]) +translateOp [r] WordMulOp [a1,a2] = Just (r, MO_NatU_Mul, [a1,a2]) +translateOp [r] WordQuotOp [a1,a2] = Just (r, MO_NatU_Quot, [a1,a2]) +translateOp [r] WordRemOp [a1,a2] = Just (r, MO_NatU_Rem, [a1,a2]) -translateOp [r] AddrGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2]) -translateOp [r] AddrLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2]) -translateOp [r] AddrGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2]) -translateOp [r] AddrLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2]) +translateOp [r] AddrGeOp [a1,a2] = Just (r, MO_NatU_Ge, [a1,a2]) +translateOp [r] AddrLeOp [a1,a2] = Just (r, MO_NatU_Le, [a1,a2]) +translateOp [r] AddrGtOp [a1,a2] = Just (r, MO_NatU_Gt, [a1,a2]) +translateOp [r] AddrLtOp [a1,a2] = Just (r, MO_NatU_Lt, [a1,a2]) -- 32-bit unsigned ops -translateOp [r] CharEqOp [a1,a2] = Just (Just1 r, MO_32U_Eq, [a1,a2]) -translateOp [r] CharNeOp [a1,a2] = Just (Just1 r, MO_32U_Ne, [a1,a2]) -translateOp [r] CharGeOp [a1,a2] = Just (Just1 r, MO_32U_Ge, [a1,a2]) -translateOp [r] CharLeOp [a1,a2] = Just (Just1 r, MO_32U_Le, [a1,a2]) -translateOp [r] CharGtOp [a1,a2] = Just (Just1 r, MO_32U_Gt, [a1,a2]) -translateOp [r] CharLtOp [a1,a2] = Just (Just1 r, MO_32U_Lt, [a1,a2]) +translateOp [r] CharEqOp [a1,a2] = Just (r, MO_32U_Eq, [a1,a2]) +translateOp [r] CharNeOp [a1,a2] = Just (r, MO_32U_Ne, [a1,a2]) +translateOp [r] CharGeOp [a1,a2] = Just (r, MO_32U_Ge, [a1,a2]) +translateOp [r] CharLeOp [a1,a2] = Just (r, MO_32U_Le, [a1,a2]) +translateOp [r] CharGtOp [a1,a2] = Just (r, MO_32U_Gt, [a1,a2]) +translateOp [r] CharLtOp [a1,a2] = Just (r, MO_32U_Lt, [a1,a2]) -- Double ops -translateOp [r] DoubleEqOp [a1,a2] = Just (Just1 r, MO_Dbl_Eq, [a1,a2]) -translateOp [r] DoubleNeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ne, [a1,a2]) -translateOp [r] DoubleGeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ge, [a1,a2]) -translateOp [r] DoubleLeOp [a1,a2] = Just (Just1 r, MO_Dbl_Le, [a1,a2]) -translateOp [r] DoubleGtOp [a1,a2] = Just (Just1 r, MO_Dbl_Gt, [a1,a2]) -translateOp [r] DoubleLtOp [a1,a2] = Just (Just1 r, MO_Dbl_Lt, [a1,a2]) - -translateOp [r] DoubleAddOp [a1,a2] = Just (Just1 r, MO_Dbl_Add, [a1,a2]) -translateOp [r] DoubleSubOp [a1,a2] = Just (Just1 r, MO_Dbl_Sub, [a1,a2]) -translateOp [r] DoubleMulOp [a1,a2] = Just (Just1 r, MO_Dbl_Mul, [a1,a2]) -translateOp [r] DoubleDivOp [a1,a2] = Just (Just1 r, MO_Dbl_Div, [a1,a2]) -translateOp [r] DoublePowerOp [a1,a2] = Just (Just1 r, MO_Dbl_Pwr, [a1,a2]) - -translateOp [r] DoubleSinOp [a1] = Just (Just1 r, MO_Dbl_Sin, [a1]) -translateOp [r] DoubleCosOp [a1] = Just (Just1 r, MO_Dbl_Cos, [a1]) -translateOp [r] DoubleTanOp [a1] = Just (Just1 r, MO_Dbl_Tan, [a1]) -translateOp [r] DoubleSinhOp [a1] = Just (Just1 r, MO_Dbl_Sinh, [a1]) -translateOp [r] DoubleCoshOp [a1] = Just (Just1 r, MO_Dbl_Cosh, [a1]) -translateOp [r] DoubleTanhOp [a1] = Just (Just1 r, MO_Dbl_Tanh, [a1]) -translateOp [r] DoubleAsinOp [a1] = Just (Just1 r, MO_Dbl_Asin, [a1]) -translateOp [r] DoubleAcosOp [a1] = Just (Just1 r, MO_Dbl_Acos, [a1]) -translateOp [r] DoubleAtanOp [a1] = Just (Just1 r, MO_Dbl_Atan, [a1]) -translateOp [r] DoubleLogOp [a1] = Just (Just1 r, MO_Dbl_Log, [a1]) -translateOp [r] DoubleExpOp [a1] = Just (Just1 r, MO_Dbl_Exp, [a1]) -translateOp [r] DoubleSqrtOp [a1] = Just (Just1 r, MO_Dbl_Sqrt, [a1]) -translateOp [r] DoubleNegOp [a1] = Just (Just1 r, MO_Dbl_Neg, [a1]) +translateOp [r] DoubleEqOp [a1,a2] = Just (r, MO_Dbl_Eq, [a1,a2]) +translateOp [r] DoubleNeOp [a1,a2] = Just (r, MO_Dbl_Ne, [a1,a2]) +translateOp [r] DoubleGeOp [a1,a2] = Just (r, MO_Dbl_Ge, [a1,a2]) +translateOp [r] DoubleLeOp [a1,a2] = Just (r, MO_Dbl_Le, [a1,a2]) +translateOp [r] DoubleGtOp [a1,a2] = Just (r, MO_Dbl_Gt, [a1,a2]) +translateOp [r] DoubleLtOp [a1,a2] = Just (r, MO_Dbl_Lt, [a1,a2]) + +translateOp [r] DoubleAddOp [a1,a2] = Just (r, MO_Dbl_Add, [a1,a2]) +translateOp [r] DoubleSubOp [a1,a2] = Just (r, MO_Dbl_Sub, [a1,a2]) +translateOp [r] DoubleMulOp [a1,a2] = Just (r, MO_Dbl_Mul, [a1,a2]) +translateOp [r] DoubleDivOp [a1,a2] = Just (r, MO_Dbl_Div, [a1,a2]) +translateOp [r] DoublePowerOp [a1,a2] = Just (r, MO_Dbl_Pwr, [a1,a2]) + +translateOp [r] DoubleSinOp [a1] = Just (r, MO_Dbl_Sin, [a1]) +translateOp [r] DoubleCosOp [a1] = Just (r, MO_Dbl_Cos, [a1]) +translateOp [r] DoubleTanOp [a1] = Just (r, MO_Dbl_Tan, [a1]) +translateOp [r] DoubleSinhOp [a1] = Just (r, MO_Dbl_Sinh, [a1]) +translateOp [r] DoubleCoshOp [a1] = Just (r, MO_Dbl_Cosh, [a1]) +translateOp [r] DoubleTanhOp [a1] = Just (r, MO_Dbl_Tanh, [a1]) +translateOp [r] DoubleAsinOp [a1] = Just (r, MO_Dbl_Asin, [a1]) +translateOp [r] DoubleAcosOp [a1] = Just (r, MO_Dbl_Acos, [a1]) +translateOp [r] DoubleAtanOp [a1] = Just (r, MO_Dbl_Atan, [a1]) +translateOp [r] DoubleLogOp [a1] = Just (r, MO_Dbl_Log, [a1]) +translateOp [r] DoubleExpOp [a1] = Just (r, MO_Dbl_Exp, [a1]) +translateOp [r] DoubleSqrtOp [a1] = Just (r, MO_Dbl_Sqrt, [a1]) +translateOp [r] DoubleNegOp [a1] = Just (r, MO_Dbl_Neg, [a1]) -- Float ops -translateOp [r] FloatEqOp [a1,a2] = Just (Just1 r, MO_Flt_Eq, [a1,a2]) -translateOp [r] FloatNeOp [a1,a2] = Just (Just1 r, MO_Flt_Ne, [a1,a2]) -translateOp [r] FloatGeOp [a1,a2] = Just (Just1 r, MO_Flt_Ge, [a1,a2]) -translateOp [r] FloatLeOp [a1,a2] = Just (Just1 r, MO_Flt_Le, [a1,a2]) -translateOp [r] FloatGtOp [a1,a2] = Just (Just1 r, MO_Flt_Gt, [a1,a2]) -translateOp [r] FloatLtOp [a1,a2] = Just (Just1 r, MO_Flt_Lt, [a1,a2]) - -translateOp [r] FloatAddOp [a1,a2] = Just (Just1 r, MO_Flt_Add, [a1,a2]) -translateOp [r] FloatSubOp [a1,a2] = Just (Just1 r, MO_Flt_Sub, [a1,a2]) -translateOp [r] FloatMulOp [a1,a2] = Just (Just1 r, MO_Flt_Mul, [a1,a2]) -translateOp [r] FloatDivOp [a1,a2] = Just (Just1 r, MO_Flt_Div, [a1,a2]) -translateOp [r] FloatPowerOp [a1,a2] = Just (Just1 r, MO_Flt_Pwr, [a1,a2]) - -translateOp [r] FloatSinOp [a1] = Just (Just1 r, MO_Flt_Sin, [a1]) -translateOp [r] FloatCosOp [a1] = Just (Just1 r, MO_Flt_Cos, [a1]) -translateOp [r] FloatTanOp [a1] = Just (Just1 r, MO_Flt_Tan, [a1]) -translateOp [r] FloatSinhOp [a1] = Just (Just1 r, MO_Flt_Sinh, [a1]) -translateOp [r] FloatCoshOp [a1] = Just (Just1 r, MO_Flt_Cosh, [a1]) -translateOp [r] FloatTanhOp [a1] = Just (Just1 r, MO_Flt_Tanh, [a1]) -translateOp [r] FloatAsinOp [a1] = Just (Just1 r, MO_Flt_Asin, [a1]) -translateOp [r] FloatAcosOp [a1] = Just (Just1 r, MO_Flt_Acos, [a1]) -translateOp [r] FloatAtanOp [a1] = Just (Just1 r, MO_Flt_Atan, [a1]) -translateOp [r] FloatLogOp [a1] = Just (Just1 r, MO_Flt_Log, [a1]) -translateOp [r] FloatExpOp [a1] = Just (Just1 r, MO_Flt_Exp, [a1]) -translateOp [r] FloatSqrtOp [a1] = Just (Just1 r, MO_Flt_Sqrt, [a1]) -translateOp [r] FloatNegOp [a1] = Just (Just1 r, MO_Flt_Neg, [a1]) +translateOp [r] FloatEqOp [a1,a2] = Just (r, MO_Flt_Eq, [a1,a2]) +translateOp [r] FloatNeOp [a1,a2] = Just (r, MO_Flt_Ne, [a1,a2]) +translateOp [r] FloatGeOp [a1,a2] = Just (r, MO_Flt_Ge, [a1,a2]) +translateOp [r] FloatLeOp [a1,a2] = Just (r, MO_Flt_Le, [a1,a2]) +translateOp [r] FloatGtOp [a1,a2] = Just (r, MO_Flt_Gt, [a1,a2]) +translateOp [r] FloatLtOp [a1,a2] = Just (r, MO_Flt_Lt, [a1,a2]) + +translateOp [r] FloatAddOp [a1,a2] = Just (r, MO_Flt_Add, [a1,a2]) +translateOp [r] FloatSubOp [a1,a2] = Just (r, MO_Flt_Sub, [a1,a2]) +translateOp [r] FloatMulOp [a1,a2] = Just (r, MO_Flt_Mul, [a1,a2]) +translateOp [r] FloatDivOp [a1,a2] = Just (r, MO_Flt_Div, [a1,a2]) +translateOp [r] FloatPowerOp [a1,a2] = Just (r, MO_Flt_Pwr, [a1,a2]) + +translateOp [r] FloatSinOp [a1] = Just (r, MO_Flt_Sin, [a1]) +translateOp [r] FloatCosOp [a1] = Just (r, MO_Flt_Cos, [a1]) +translateOp [r] FloatTanOp [a1] = Just (r, MO_Flt_Tan, [a1]) +translateOp [r] FloatSinhOp [a1] = Just (r, MO_Flt_Sinh, [a1]) +translateOp [r] FloatCoshOp [a1] = Just (r, MO_Flt_Cosh, [a1]) +translateOp [r] FloatTanhOp [a1] = Just (r, MO_Flt_Tanh, [a1]) +translateOp [r] FloatAsinOp [a1] = Just (r, MO_Flt_Asin, [a1]) +translateOp [r] FloatAcosOp [a1] = Just (r, MO_Flt_Acos, [a1]) +translateOp [r] FloatAtanOp [a1] = Just (r, MO_Flt_Atan, [a1]) +translateOp [r] FloatLogOp [a1] = Just (r, MO_Flt_Log, [a1]) +translateOp [r] FloatExpOp [a1] = Just (r, MO_Flt_Exp, [a1]) +translateOp [r] FloatSqrtOp [a1] = Just (r, MO_Flt_Sqrt, [a1]) +translateOp [r] FloatNegOp [a1] = Just (r, MO_Flt_Neg, [a1]) -- Conversions -translateOp [r] Int2DoubleOp [a1] = Just (Just1 r, MO_NatS_to_Dbl, [a1]) -translateOp [r] Double2IntOp [a1] = Just (Just1 r, MO_Dbl_to_NatS, [a1]) +translateOp [r] Int2DoubleOp [a1] = Just (r, MO_NatS_to_Dbl, [a1]) +translateOp [r] Double2IntOp [a1] = Just (r, MO_Dbl_to_NatS, [a1]) + +translateOp [r] Int2FloatOp [a1] = Just (r, MO_NatS_to_Flt, [a1]) +translateOp [r] Float2IntOp [a1] = Just (r, MO_Flt_to_NatS, [a1]) -translateOp [r] Int2FloatOp [a1] = Just (Just1 r, MO_NatS_to_Flt, [a1]) -translateOp [r] Float2IntOp [a1] = Just (Just1 r, MO_Flt_to_NatS, [a1]) +translateOp [r] Float2DoubleOp [a1] = Just (r, MO_Flt_to_Dbl, [a1]) +translateOp [r] Double2FloatOp [a1] = Just (r, MO_Dbl_to_Flt, [a1]) -translateOp [r] Float2DoubleOp [a1] = Just (Just1 r, MO_Flt_to_Dbl, [a1]) -translateOp [r] Double2FloatOp [a1] = Just (Just1 r, MO_Dbl_to_Flt, [a1]) +translateOp [r] Int2WordOp [a1] = Just (r, MO_NatS_to_NatU, [a1]) +translateOp [r] Word2IntOp [a1] = Just (r, MO_NatU_to_NatS, [a1]) -translateOp [r] Int2WordOp [a1] = Just (Just1 r, MO_NatS_to_NatU, [a1]) -translateOp [r] Word2IntOp [a1] = Just (Just1 r, MO_NatU_to_NatS, [a1]) +translateOp [r] Int2AddrOp [a1] = Just (r, MO_NatS_to_NatP, [a1]) +translateOp [r] Addr2IntOp [a1] = Just (r, MO_NatP_to_NatS, [a1]) -translateOp [r] Int2AddrOp [a1] = Just (Just1 r, MO_NatS_to_NatP, [a1]) -translateOp [r] Addr2IntOp [a1] = Just (Just1 r, MO_NatP_to_NatS, [a1]) +translateOp [r] OrdOp [a1] = Just (r, MO_32U_to_NatS, [a1]) +translateOp [r] ChrOp [a1] = Just (r, MO_NatS_to_32U, [a1]) -translateOp [r] OrdOp [a1] = Just (Just1 r, MO_32U_to_NatS, [a1]) -translateOp [r] ChrOp [a1] = Just (Just1 r, MO_NatS_to_32U, [a1]) +translateOp [r] Narrow8IntOp [a1] = Just (r, MO_8S_to_NatS, [a1]) +translateOp [r] Narrow16IntOp [a1] = Just (r, MO_16S_to_NatS, [a1]) +translateOp [r] Narrow32IntOp [a1] = Just (r, MO_32S_to_NatS, [a1]) -translateOp [r] Narrow8IntOp [a1] = Just (Just1 r, MO_8S_to_NatS, [a1]) -translateOp [r] Narrow16IntOp [a1] = Just (Just1 r, MO_16S_to_NatS, [a1]) -translateOp [r] Narrow32IntOp [a1] = Just (Just1 r, MO_32S_to_NatS, [a1]) +translateOp [r] Narrow8WordOp [a1] = Just (r, MO_8U_to_NatU, [a1]) +translateOp [r] Narrow16WordOp [a1] = Just (r, MO_16U_to_NatU, [a1]) +translateOp [r] Narrow32WordOp [a1] = Just (r, MO_32U_to_NatU, [a1]) -translateOp [r] Narrow8WordOp [a1] = Just (Just1 r, MO_8U_to_NatU, [a1]) -translateOp [r] Narrow16WordOp [a1] = Just (Just1 r, MO_16U_to_NatU, [a1]) -translateOp [r] Narrow32WordOp [a1] = Just (Just1 r, MO_32U_to_NatU, [a1]) +-- Word comparisons masquerading as more exotic things. -translateOp [r] SameMutVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] SameMVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] SameMutableArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] EqForeignObj [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) -translateOp [r] EqStablePtrOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMutVarOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMVarOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMutableArrayOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] EqForeignObj [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) +translateOp [r] EqStablePtrOp [a1,a2] = Just (r, MO_Nat_Eq, [a1,a2]) translateOp _ _ _ = Nothing +\end{code} + +\begin{code} +shimFCallArg arg amode + | tycon == foreignObjPrimTyCon + = CMacroExpr AddrRep ForeignObj_CLOSURE_DATA [amode] + | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon + = CMacroExpr PtrRep PTRS_ARR_CTS [amode] + | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon + = CMacroExpr AddrRep BYTE_ARR_CTS [amode] + | otherwise = amode + where + -- should be a tycon app, since this is a foreign call + tycon = tyConAppTyCon (repType (stgArgType arg)) \end{code}