[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 d8e1bf6..192d5f3 100644 (file)
--- 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}
-