[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.

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index eb5869f..9112cdf 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 ->