[project @ 1997-08-25 21:48:29 by sof]

ForeignObj support for ccalls; generate code for IndexFooOffForeignObj primops

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index e4168a0..fd20512 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -273,6 +273,16 @@ primCode [lhs] (IndexOffAddrOp pk) [obj, ix]
     in
     returnUs (\xs -> assign : xs)
 
+primCode [lhs] (IndexOffForeignObjOp pk) [obj, ix]
+  = let
+       lhs' = amodeToStix lhs
+       obj' = amodeToStix obj
+       ix' = amodeToStix ix
+       obj'' = StIndex PtrRep obj' foHS
+       assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
+    in
+    returnUs (\xs -> assign : xs)
+
 primCode [] (WriteByteArrayOp pk) [obj, ix, v]
   = let
        obj' = amodeToStix obj
@@ -422,9 +432,10 @@ primCode lhs (CCallOp fn is_asm may_gc arg_tys result_ty) rhs
        let base = amodeToStix' x
        in
            case getAmodeRep x of
-             ArrayRep -> StIndex PtrRep base mutHS
-             ByteArrayRep -> StIndex IntRep base dataHS
-             ForeignObjRep -> error "ERROR: native-code generator can't handle ForeignObjs (yet): use -fvia-C!"
+             ArrayRep      -> StIndex PtrRep base mutHS
+             ByteArrayRep  -> StIndex IntRep base dataHS
+             ForeignObjRep -> StIndex PtrRep base foHS
+                {-error "ERROR: native-code generator can't handle ForeignObjs (yet): use -fvia-C!"-}
              _ -> base
 \end{code}