projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2006-01-09 10:31:14 by simonmar]
[ghc-hetmet.git] / ghc / compiler / codeGen / CgPrimOp.hs
diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
index 5c01903..e59aafd 100644 (file)
--- a/ghc/compiler/codeGen/CgPrimOp.hs
+++ b/ghc/compiler/codeGen/CgPrimOp.hs
@@ -115,13 +115,7 @@ emitPrimOp [res] ReadMutVarOp [mutv] live
 emitPrimOp [] WriteMutVarOp [mutv,var] live
    = stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
 
-emitPrimOp [res] ForeignObjToAddrOp [fo] live
-   = stmtC (CmmAssign res (cmmLoadIndexW fo fixedHdrSize))
-
-emitPrimOp [] WriteForeignObjOp [fo,addr] live
-   = stmtC (CmmStore (cmmOffsetW fo fixedHdrSize) addr)
-
--- #define sizzeofByteArrayzh(r,a) \
+--  #define sizzeofByteArrayzh(r,a) \
 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
 emitPrimOp [res] SizeofByteArrayOp [arg] live
    = stmtC $
@@ -130,25 +124,25 @@ emitPrimOp [res] SizeofByteArrayOp [arg] live
                          CmmLit (mkIntCLit wORD_SIZE)
                        ])
 
--- #define sizzeofMutableByteArrayzh(r,a) \
+--  #define sizzeofMutableByteArrayzh(r,a) \
 --      r = (((StgArrWords *)(a))->words * sizeof(W_))
 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
    = emitPrimOp [res] SizeofByteArrayOp [arg] live
 
 
--- #define touchzh(o)                  /* nothing */
+--  #define touchzh(o)                  /* nothing */
 emitPrimOp [] TouchOp [arg] live
    = nopC
 
--- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
+--  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
 emitPrimOp [res] ByteArrayContents_Char [arg] live
    = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize))
 
--- #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
+--  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
 emitPrimOp [res] StableNameToIntOp [arg] live
    = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize))
 
--- #define eqStableNamezh(r,sn1,sn2)                                   \
+--  #define eqStableNamezh(r,sn1,sn2)                                  \
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp [res] EqStableNameOp [arg1,arg2] live
    = stmtC (CmmAssign res (CmmMachOp mo_wordEq [
@@ -160,11 +154,11 @@ emitPrimOp [res] EqStableNameOp [arg1,arg2] live
 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
    = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2]))
 
--- #define addrToHValuezh(r,a) r=(P_)a
+--  #define addrToHValuezh(r,a) r=(P_)a
 emitPrimOp [res] AddrToHValueOp [arg] live
    = stmtC (CmmAssign res arg)
 
--- #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
+--  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
 emitPrimOp [res] DataToTagOp [arg] live
    = stmtC (CmmAssign res (getConstrTag arg))
 
@@ -173,16 +167,16 @@ emitPrimOp [res] DataToTagOp [arg] live
    objects, even if they are in old space.  When they become immutable,
    they can be removed from this scavenge list.         -}
 
--- #define unsafeFreezzeArrayzh(r,a)
+--  #define unsafeFreezzeArrayzh(r,a)
 --     {
---        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_info);
+--        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
 --       r = a;
 --     }
 emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
             CmmAssign res arg ]
 
--- #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
+--  #define unsafeFreezzeByteArrayzh(r,a)      r=(a)
 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
    = stmtC (CmmAssign res arg)
 
@@ -192,25 +186,6 @@ emitPrimOp [r] ReadArrayOp  [obj,ix]   live  = doReadPtrArrayOp r obj ix
 emitPrimOp [r] IndexArrayOp [obj,ix]   live  = doReadPtrArrayOp r obj ix
 emitPrimOp []  WriteArrayOp [obj,ix,v] live  = doWritePtrArrayOp obj ix v
 
--- IndexXXXoffForeignObj
-
-emitPrimOp res IndexOffForeignObjOp_Char      args live = doIndexOffForeignObjOp (Just mo_u_8ToWord) I8 res args
-emitPrimOp res IndexOffForeignObjOp_WideChar  args live = doIndexOffForeignObjOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res IndexOffForeignObjOp_Int       args live = doIndexOffForeignObjOp Nothing wordRep res args
-emitPrimOp res IndexOffForeignObjOp_Word      args live = doIndexOffForeignObjOp Nothing wordRep res args
-emitPrimOp res IndexOffForeignObjOp_Addr      args live = doIndexOffForeignObjOp Nothing wordRep res args
-emitPrimOp res IndexOffForeignObjOp_Float     args live = doIndexOffForeignObjOp Nothing F32 res args
-emitPrimOp res IndexOffForeignObjOp_Double    args live = doIndexOffForeignObjOp Nothing F64 res args
-emitPrimOp res IndexOffForeignObjOp_StablePtr args live = doIndexOffForeignObjOp Nothing wordRep res args
-emitPrimOp res IndexOffForeignObjOp_Int8      args live = doIndexOffForeignObjOp (Just mo_s_8ToWord) I8  res args
-emitPrimOp res IndexOffForeignObjOp_Int16     args live = doIndexOffForeignObjOp (Just mo_s_16ToWord) I16 res args
-emitPrimOp res IndexOffForeignObjOp_Int32     args live = doIndexOffForeignObjOp (Just mo_s_32ToWord) I32 res args
-emitPrimOp res IndexOffForeignObjOp_Int64     args live = doIndexOffForeignObjOp Nothing I64 res args
-emitPrimOp res IndexOffForeignObjOp_Word8     args live = doIndexOffForeignObjOp (Just mo_u_8ToWord) I8  res args
-emitPrimOp res IndexOffForeignObjOp_Word16    args live = doIndexOffForeignObjOp (Just mo_u_16ToWord) I16 res args
-emitPrimOp res IndexOffForeignObjOp_Word32    args live = doIndexOffForeignObjOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res IndexOffForeignObjOp_Word64    args live = doIndexOffForeignObjOp Nothing I64 res args
-
 -- IndexXXXoffAddr
 
 emitPrimOp res IndexOffAddrOp_Char      args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
@@ -295,7 +270,6 @@ emitPrimOp res WriteOffAddrOp_Int        args live = doWriteOffAddrOp Nothing wo
 emitPrimOp res WriteOffAddrOp_Word       args live = doWriteOffAddrOp Nothing wordRep res args
 emitPrimOp res WriteOffAddrOp_Addr       args live = doWriteOffAddrOp Nothing wordRep res args
 emitPrimOp res WriteOffAddrOp_Float      args live = doWriteOffAddrOp Nothing F32 res args
-emitPrimOp res WriteOffAddrOp_ForeignObj args live = doWriteOffAddrOp Nothing wordRep res args
 emitPrimOp res WriteOffAddrOp_Double     args live = doWriteOffAddrOp Nothing F64 res args
 emitPrimOp res WriteOffAddrOp_StablePtr  args live = doWriteOffAddrOp Nothing wordRep res args
 emitPrimOp res WriteOffAddrOp_Int8       args live = doWriteOffAddrOp (Just mo_WordTo8) I8  res args
@@ -356,6 +330,8 @@ nopOp Int2WordOp     = True
 nopOp Word2IntOp     = True
 nopOp Int2AddrOp     = True
 nopOp Addr2IntOp     = True
+nopOp ChrOp         = True  -- Int# and Char# are rep'd the same
+nopOp OrdOp         = True
 nopOp _                     = False
 
 -- These PrimOps turn into double casts
@@ -477,9 +453,6 @@ translateOp Float2IntOp    = Just (MO_S_Conv F32 wordRep)
 translateOp Float2DoubleOp = Just (MO_S_Conv F32 F64)
 translateOp Double2FloatOp = Just (MO_S_Conv F64 F32)
 
-translateOp OrdOp          = Just (MO_U_Conv I32 wordRep)
-translateOp ChrOp          = Just (MO_U_Conv wordRep I32)
-
 -- Word comparisons masquerading as more exotic things.
 
 translateOp SameMutVarOp           = Just mo_wordEq
@@ -487,7 +460,6 @@ translateOp SameMVarOp             = Just mo_wordEq
 translateOp SameMutableArrayOp     = Just mo_wordEq
 translateOp SameMutableByteArrayOp = Just mo_wordEq
 translateOp SameTVarOp             = Just mo_wordEq
-translateOp EqForeignObj           = Just mo_wordEq
 translateOp EqStablePtrOp          = Just mo_wordEq
 
 translateOp _ = Nothing
@@ -528,12 +500,6 @@ callishOp _ = Nothing
 ------------------------------------------------------------------------------
 -- Helpers for translating various minor variants of array indexing.
 
-doIndexOffForeignObjOp maybe_post_read_cast rep [res] [addr,idx]
-   = mkBasicIndexedRead 0 maybe_post_read_cast rep res 
-       (cmmLoadIndexW addr fixedHdrSize) idx
-doIndexOffForeignObjOp _ _ _ _ 
-   = panic "CgPrimOp: doIndexOffForeignObjOp"
-
 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
    = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
 doIndexOffAddrOp _ _ _ _
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)