[project @ 2000-10-12 09:56:52 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 6f5e37c..1f5fde1 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -24,8 +24,6 @@ import CLabel         ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
                          mkMAP_FROZEN_infoLabel, mkForeignLabel )
 import Outputable
 
-import Char            ( ord, isAlpha, isDigit )
-
 #include "NCG.h"
 \end{code}
 
@@ -280,7 +278,7 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
            case getAmodeRep x of
              ArrayRep      -> StIndex PtrRep base arrPtrsHS
              ByteArrayRep  -> StIndex IntRep base arrWordsHS
-             ForeignObjRep -> StIndex PtrRep base fixedHS
+             ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
              _ -> base
 
     ccall = case lhs of
@@ -336,6 +334,19 @@ primCode [rr] ReadMutVarOp [aa]
      returnUs (\xs -> assign : xs)
 \end{code}
 
+ForeignObj# primops.
+
+\begin{code}
+primCode [rr] ForeignObjToAddrOp [fo]
+  = let code =  StAssign AddrRep (amodeToStix rr)
+                  (StInd AddrRep 
+                       (StIndex PtrRep (amodeToStix fo) fixedHS))
+    in
+    returnUs (\xs -> code : xs)
+
+primCode [] TouchOp [_] = returnUs id
+\end{code}
+
 Now the more mundane operations.
 
 \begin{code}