From: sewardj <unknown>
Date: Fri, 14 Jan 2000 14:08:55 +0000 (+0000)
Subject: [project @ 2000-01-14 14:08:55 by sewardj]
X-Git-Tag: Approximately_9120_patches~5287
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=95585c35917515db927f0397b58eda4c8525b481;p=ghc-hetmet.git

[project @ 2000-01-14 14:08:55 by sewardj]
primCode: implement DataToTagOp.
---

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 9f01488..588efa7 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -140,7 +140,6 @@ primCode [lhs] SizeofMutableByteArrayOp [rhs]
 Most other array primitives translate to simple indexing.
 
 \begin{code}
-
 primCode lhs@[_] IndexArrayOp args
   = primCode lhs ReadArrayOp args
 
@@ -235,6 +234,26 @@ primCode lhs (CCallOp (Left fn) is_asm may_gc cconv) rhs
 	      _ -> base
 \end{code}
 
+DataToTagOp won't work for 64-bit archs, as it is.
+
+\begin{code}
+primCode [lhs] DataToTagOp [arg]
+  = let lhs'        = amodeToStix lhs
+        arg'        = amodeToStix arg
+        infoptr     = StInd PtrRep arg'
+        word_32     = StInd WordRep (StIndex PtrRep infoptr (StInt (-1)))
+        masked_le32 = StPrim SrlOp [word_32, StInt 16]
+        masked_be32 = StPrim AndOp [word_32, StInt 65535]
+#ifdef WORDS_BIGENDIAN
+        masked      = masked_be32
+#else
+        masked      = masked_le32
+#endif
+        assign      = StAssign IntRep lhs' masked
+    in
+    returnUs (\xs -> assign : xs)
+\end{code}
+
 Now the more mundane operations.
 
 \begin{code}