From: sof <unknown>
Date: Mon, 25 Aug 1997 21:48:29 +0000 (+0000)
Subject: [project @ 1997-08-25 21:48:29 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~121
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3dc8f1c0f10e06f708e7e4e14184782a02b8a237;p=ghc-hetmet.git

[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
--- 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}