[project @ 1998-02-05 12:23:33 by simonm]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixPrim.lhs

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index ad04c1d..192d5f3 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -3,19 +3,12 @@
 %
 
 \begin{code}
-#include "HsVersions.h"
-
 module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
 
-IMP_Ubiq(){-uitous-}
-IMPORT_DELOOPER(NcgLoop)               -- paranoia checking only
+#include "HsVersions.h"
 
 import MachMisc
-#if __GLASGOW_HASKELL__ >= 202
-import MachRegs hiding (Addr)
-#else
 import MachRegs
-#endif
 
 import AbsCSyn
 import AbsCUtils       ( getAmodeRep, mixedTypeLocn )
@@ -28,14 +21,12 @@ 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 )
 import StixInteger     {- everything -}
-import UniqSupply      ( returnUs, thenUs, SYN_IE(UniqSM) )
-import Pretty          ( (<>), ptext, int )
-import Util            ( panic )
+import UniqSupply      ( returnUs, thenUs, UniqSM )
+import Outputable
 
 #ifdef REALLY_HASKELL_1_3
 ord = fromEnum :: Char -> Int
@@ -271,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
@@ -420,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
-             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}
 
@@ -476,7 +478,7 @@ simplePrim [lhs] op rest
 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}
 
 %---------------------------------------------------------------------
@@ -607,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}
-