From 9b3d7ebd00f00e953e61dbf62a1045ff7ba910dd Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 17 Dec 2001 18:03:09 +0000 Subject: [PATCH] [project @ 2001-12-17 18:03:08 by sewardj] Redo translation of array indexing primops in order to insert 8 <-> 32 bit casts when dealing with Char arrays. Also facilitate future removal of CMem and MO_{Read,Write}OSBI. In the process, notice and fix a large bogon in x86/sparc implementation of signed and unsigned integer widening. --- ghc/compiler/absCSyn/AbsCUtils.lhs | 356 +++++++++++++++++++---------------- ghc/compiler/absCSyn/MachOp.hs | 14 +- ghc/compiler/absCSyn/PprAbsC.lhs | 3 + ghc/compiler/nativeGen/MachCode.lhs | 6 +- 4 files changed, 214 insertions(+), 165 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index eb5869f..9112cdf 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -590,6 +590,8 @@ 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. ------------------------------------------------------------------------------ @@ -655,20 +657,54 @@ non_void_amode amode VoidRep -> False k -> True -doIndexOffForeignObjOp rep res addr idx - = Just (Just res, MO_ReadOSBI fixedHdrSize rep, [addr,idx]) +-- Helpers for translating various minor variants of array indexing. -doIndexOffAddrOp rep res addr idx - = Just (Just res, MO_ReadOSBI 0 rep, [addr,idx]) +doIndexOffForeignObjOp maybe_post_read_cast rep res addr idx + = mkBasicIndexedRead fixedHdrSize maybe_post_read_cast rep res addr idx -doIndexByteArrayOp rep res addr idx - = Just (Just res, MO_ReadOSBI arrWordsHdrSize rep, [addr,idx]) +doIndexOffAddrOp maybe_post_read_cast rep res addr idx + = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx -doWriteOffAddrOp rep addr idx val - = Just (Nothing, MO_WriteOSBI 0 rep, [addr,idx,val]) +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 ( + CMachOpStmt (Just res) (MO_ReadOSBI offw read_rep) [base,idx] Nothing + ) +mkBasicIndexedRead offw (Just cast_to_mop) read_rep res base idx + = mkTemp read_rep `thenFlt` \ tmp -> + (returnFlt . CSequential) [ + CMachOpStmt (Just tmp) (MO_ReadOSBI offw read_rep) [base,idx] Nothing, + CMachOpStmt (Just res) cast_to_mop [tmp] Nothing + ] + +mkBasicIndexedWrite offw Nothing write_rep base idx val + = returnFlt ( + CMachOpStmt Nothing (MO_WriteOSBI offw write_rep) [base,idx,val] Nothing + ) +mkBasicIndexedWrite offw (Just cast_to_mop) write_rep base idx val + = mkTemp write_rep `thenFlt` \ tmp -> + (returnFlt . CSequential) [ + CMachOpStmt (Just tmp) cast_to_mop [val] Nothing, + CMachOpStmt Nothing (MO_WriteOSBI offw write_rep) [base,idx,tmp] Nothing + ] -doWriteByteArrayOp rep addr idx val - = Just (Nothing, 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 @@ -695,6 +731,11 @@ getBitsPerWordMinus1 ------------------------------------------------------------------------------ +-- 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 @@ -903,174 +944,171 @@ 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 (Just r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) -translateOp [r] IndexArrayOp [obj,ix] - = Just (Just r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix]) -translateOp [] WriteArrayOp [obj,ix,v] - = Just (Nothing, 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 ForeignObjRep 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 diff --git a/ghc/compiler/absCSyn/MachOp.hs b/ghc/compiler/absCSyn/MachOp.hs index 9222f8e..4ac6e8e 100644 --- a/ghc/compiler/absCSyn/MachOp.hs +++ b/ghc/compiler/absCSyn/MachOp.hs @@ -159,6 +159,9 @@ data MachOp | MO_16U_to_NatU | MO_32U_to_NatU + | MO_8U_to_32U -- zero extend + | MO_32U_to_8U -- mask out all but lowest byte + -- Reading/writing arrays | MO_ReadOSBI Int PrimRep -- args: [base_ptr, index_value] | MO_WriteOSBI Int PrimRep -- args: [base_ptr, index_value, value_to_write] @@ -294,6 +297,9 @@ pprMachOp MO_8U_to_NatU = text "MO_8U_to_NatU" pprMachOp MO_16U_to_NatU = text "MO_16U_to_NatU" pprMachOp MO_32U_to_NatU = text "MO_32U_to_NatU" +pprMachOp MO_8U_to_32U = text "MO_8U_to_32U" +pprMachOp MO_32U_to_8U = text "MO_32U_to_8U" + pprMachOp (MO_ReadOSBI offset rep) = text "MO_ReadOSBI" <> parens (int offset <> comma <> ppr rep) pprMachOp (MO_WriteOSBI offset rep) @@ -434,7 +440,7 @@ machOpProps MO_Flt_Sqrt = (Just FloatRep, []) machOpProps MO_Flt_Neg = (Just FloatRep, [inline]) machOpProps MO_32U_to_NatS = (Just IntRep, [inline]) -machOpProps MO_NatS_to_32U = (Just WordRep, [inline]) +machOpProps MO_NatS_to_32U = (Just Word32Rep, [inline]) machOpProps MO_NatS_to_Dbl = (Just DoubleRep, [inline]) machOpProps MO_Dbl_to_NatS = (Just IntRep, [inline]) @@ -461,8 +467,8 @@ machOpProps MO_8U_to_NatU = (Just WordRep, [inline]) machOpProps MO_16U_to_NatU = (Just WordRep, [inline]) machOpProps MO_32U_to_NatU = (Just WordRep, [inline]) +machOpProps MO_8U_to_32U = (Just Word32Rep, [inline]) +machOpProps MO_32U_to_8U = (Just Word8Rep, [inline]) + machOpProps (MO_ReadOSBI offset rep) = (Just rep, [inline]) machOpProps (MO_WriteOSBI offset rep) = (Nothing, [inline]) - - - diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index fd7daf8..d9dcea9 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -762,6 +762,9 @@ pprMachOp_for_C MO_8U_to_NatU = text "(StgWord8)(StgWord)" pprMachOp_for_C MO_16U_to_NatU = text "(StgWord16)(StgWord)" pprMachOp_for_C MO_32U_to_NatU = text "(StgWord32)(StgWord)" +pprMachOp_for_C MO_8U_to_32U = text "(StgWord32)" +pprMachOp_for_C MO_32U_to_8U = text "(StgWord8)" + pprMachOp_for_C (MO_ReadOSBI _ _) = panic "pprMachOp_for_C:MO_ReadOSBI" pprMachOp_for_C (MO_WriteOSBI _ _) = panic "pprMachOp_for_C:MO_WriteOSBI" diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index 58606b9..41a2ac2 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -831,6 +831,7 @@ getRegister (StMachOp mop [x]) -- unary MachOps = case mop of MO_NatS_Neg -> trivialUCode (NEGI L) x MO_Nat_Not -> trivialUCode (NOT L) x + MO_32U_to_8U -> trivialUCode (AND L (OpImm (ImmInt 255))) x MO_Flt_Neg -> trivialUFCode FloatRep (GNEG F) x MO_Dbl_Neg -> trivialUFCode DoubleRep (GNEG DF) x @@ -871,6 +872,7 @@ getRegister (StMachOp mop [x]) -- unary MachOps MO_8S_to_NatS -> integerExtend True 24 x MO_16U_to_NatU -> integerExtend False 16 x MO_16S_to_NatS -> integerExtend True 16 x + MO_8U_to_32U -> integerExtend False 24 x other_op -> getRegister ( @@ -882,7 +884,7 @@ getRegister (StMachOp mop [x]) -- unary MachOps integerExtend signed nBits x = getRegister ( StMachOp (if signed then MO_Nat_Sar else MO_Nat_Shr) - [StInt nBits, StMachOp MO_Nat_Shl [StInt nBits, x]] + [StMachOp MO_Nat_Shl [x, StInt nBits], StInt nBits] ) conversionNop new_rep expr @@ -1270,7 +1272,7 @@ getRegister (StMachOp mop [x]) -- unary PrimOps integerExtend signed nBits x = getRegister ( StMachOp (if signed then MO_Nat_Sar else MO_Nat_Shr) - [StInt nBits, StMachOp MO_Nat_Shl [StInt nBits, x]] + [StMachOp MO_Nat_Shl [x, StInt nBits], StInt nBits] ) conversionNop new_rep expr = getRegister expr `thenNat` \ e_code -> -- 1.7.10.4