[project @ 2000-01-25 16:58:57 by sewardj]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixPrim.lhs

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 11b6cd6..8cb3594 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -149,7 +149,7 @@ primCode [lhs] ReadArrayOp [obj, ix]
        lhs' = amodeToStix lhs
        obj' = amodeToStix obj
        ix' = amodeToStix ix
-       base = StIndex IntRep obj' arrHS
+       base = StIndex IntRep obj' arrPtrsHS
        assign = StAssign PtrRep lhs' (StInd PtrRep (StIndex PtrRep base ix'))
     in
     returnUs (\xs -> assign : xs)
@@ -159,7 +159,7 @@ primCode [] WriteArrayOp [obj, ix, v]
        obj' = amodeToStix obj
        ix' = amodeToStix ix
        v' = amodeToStix v
-       base = StIndex IntRep obj' arrHS
+       base = StIndex IntRep obj' arrPtrsHS
        assign = StAssign PtrRep (StInd PtrRep (StIndex PtrRep base ix')) v'
     in
     returnUs (\xs -> assign : xs)
@@ -174,7 +174,7 @@ primCode [lhs] (ReadByteArrayOp pk) [obj, ix]
        lhs' = amodeToStix lhs
        obj' = amodeToStix obj
        ix' = amodeToStix ix
-       base = StIndex IntRep obj' arrHS
+       base = StIndex IntRep obj' arrWordsHS
        assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
     in
     returnUs (\xs -> assign : xs)
@@ -203,7 +203,7 @@ primCode [] (WriteByteArrayOp pk) [obj, ix, v]
        obj' = amodeToStix obj
        ix' = amodeToStix ix
        v' = amodeToStix v
-       base = StIndex IntRep obj' arrHS
+       base = StIndex IntRep obj' arrWordsHS
        assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
     in
     returnUs (\xs -> assign : xs)
@@ -229,8 +229,8 @@ primCode lhs (CCallOp (Left fn) is_asm may_gc cconv) rhs
        let base = amodeToStix' x
        in
            case getAmodeRep x of
-             ArrayRep      -> StIndex PtrRep base arrHS
-             ByteArrayRep  -> StIndex IntRep base arrHS
+             ArrayRep      -> StIndex PtrRep base arrPtrsHS
+             ByteArrayRep  -> StIndex IntRep base arrWordsHS
              ForeignObjRep -> StIndex PtrRep base fixedHS
              _ -> base
 \end{code}
@@ -352,7 +352,7 @@ amodeToStix (CCharLike (CLit (MachChar c)))
 amodeToStix (CCharLike x)
   = StIndex PtrRep charLike off
   where
-    off = StPrim IntMulOp [amodeToStix x, StInt (toInteger (fixedHdrSize+1))]
+    off = StPrim IntMulOp [amodeToStix x, StInt (toInteger charLikeSize)]
 
 amodeToStix (CIntLike (CLit (MachInt i _)))
   = StLitLbl ((<>) (ptext SLIT("INTLIKE_closure+")) (int off))
@@ -380,10 +380,18 @@ amodeToStix (CMacroExpr _ macro [arg])
   = case macro of
       ENTRY_CODE -> amodeToStix arg
       ARG_TAG    -> amodeToStix arg -- just an integer no. of words
-      GET_TAG    -> StPrim SrlOp 
-                       [StInd WordRep (StPrim IntSubOp [amodeToStix arg,
-                                                        StInt 1]),
+      GET_TAG    -> 
+#ifdef WORDS_BIGENDIAN
+                    StPrim AndOp 
+                       [StInd WordRep (StIndex PtrRep (amodeToStix arg)
+                                                (StInt (toInteger (-1)))),
+                        StInt 65535]
+#else
+                    StPrim SrlOp 
+                       [StInd WordRep (StIndex PtrRep (amodeToStix arg)
+                                                (StInt (toInteger (-1)))),
                         StInt 16]
+#endif
       UPD_FRAME_UPDATEE
          -> StInd PtrRep (StIndex PtrRep (amodeToStix arg) 
                                          (StInt (toInteger uF_UPDATEE)))