X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStixPrim.lhs;h=192d5f3dd0b7f85f45128043fab2f89f1e901375;hb=23c94851fb2c98d345d913d35a5a12bbc3a346bd;hp=d8e1bf61540f775d6e293da5cc6a7c2a29ce3d98;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index d8e1bf6..192d5f3 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -3,19 +3,16 @@
 %
 
 \begin{code}
-#include "HsVersions.h"
-
 module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
 
-import Ubiq{-uitous-}
-import NcgLoop		-- paranoia checking only
+#include "HsVersions.h"
 
 import MachMisc
 import MachRegs
 
 import AbsCSyn
 import AbsCUtils	( getAmodeRep, mixedTypeLocn )
-import CgCompInfo	( spARelToInt, spBRelToInt )
+import Constants	( spARelToInt, spBRelToInt )
 import CostCentre	( noCostCentreAttached )
 import HeapOffs		( hpRelToInt, subOff )
 import Literal		( Literal(..) )
@@ -24,14 +21,16 @@ import PrimOp		( PrimOp(..), isCompareOp, showPrimOp,
 			)
 import PrimRep		( PrimRep(..), isFloatingRep )
 import OrdList		( OrdList )
-import PprStyle		( PprStyle(..) )
 import SMRep		( SMRep(..), SMSpecRepKind, SMUpdateKind )
 import Stix
-import StixMacro	( heapCheck, smStablePtrTable )
+import StixMacro	( heapCheck )
 import StixInteger	{- everything -}
-import UniqSupply	( returnUs, thenUs, UniqSM(..) )
-import Unpretty		( uppBeside, uppPStr, uppInt )
-import Util		( panic )
+import UniqSupply	( returnUs, thenUs, UniqSM )
+import Outputable
+
+#ifdef REALLY_HASKELL_1_3
+ord = fromEnum :: Char -> Int
+#endif
 \end{code}
 
 The main honcho here is primCode, which handles the guts of COpStmts.
@@ -52,7 +51,7 @@ First, the dreaded @ccall@.  We can't handle @casm@s.
 Usually, this compiles to an assignment, but when the left-hand side
 is empty, we just perform the call and ignore the result.
 
-ToDo ADR: modify this to handle Malloc Ptrs.
+ToDo ADR: modify this to handle ForeignObjs.
 
 btw Why not let programmer use casm to provide assembly code instead
 of C code?  ADR
@@ -229,7 +228,7 @@ primCode [lhs] ReadArrayOp [obj, ix]
     in
     returnUs (\xs -> assign : xs)
 
-primCode [lhs] WriteArrayOp [obj, ix, v]
+primCode [] WriteArrayOp [obj, ix, v]
   = let
 	obj' = amodeToStix obj
     	ix' = amodeToStix ix
@@ -263,6 +262,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
@@ -412,9 +421,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
-	      MallocPtrRep -> error "ERROR: native-code generator can't handle Malloc Ptrs (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}
 
@@ -465,10 +475,10 @@ simplePrim [lhs] op rest
 	       ReturnsPrim pk -> pk
 	       _ -> simplePrim_error op
 
-simplePrim _ op _ = simplePrim_error op
+simplePrim as op bs = simplePrim_error op
 
 simplePrim_error op
-    = error ("ERROR: primitive operation `"++showPrimOp PprDebug op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
+    = error ("ERROR: primitive operation `"++showPrimOp op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
 \end{code}
 
 %---------------------------------------------------------------------
@@ -519,7 +529,7 @@ amodeToStix (CTableEntry base off pk)
  -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 
 amodeToStix (CCharLike (CLit (MachChar c)))
-  = StLitLbl (uppBeside (uppPStr SLIT("CHARLIKE_closures+")) (uppInt off))
+  = StLitLbl ((<>) (ptext SLIT("CHARLIKE_closures+")) (int off))
   where
     off = charLikeSize * ord c
 
@@ -599,4 +609,3 @@ flushStdout = StCall SLIT("fflush") VoidRep [StLitLit SLIT("stdout")]
 flushStderr = StCall SLIT("fflush") VoidRep [StLitLit SLIT("stderr")]
 errorIO = StJump (StInd PtrRep (sStLitLbl SLIT("ErrorIO_innards")))
 \end{code}
-