[project @ 1998-12-18 17:40:31 by simonpj]

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

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 3a87fec..1e297ad 100644 (file)
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -1,14 +1,13 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 
 \begin{code}
-#include "HsVersions.h"
-
 module AsmCodeGen ( writeRealAsm, dumpRealAsm ) where
 
-IMP_Ubiq(){-uitous-}
-IMPORT_1_3(IO(Handle))
+#include "HsVersions.h"
+
+import IO              ( Handle )
 
 import MachMisc
 import MachRegs
@@ -20,11 +19,10 @@ import AbsCSyn              ( AbstractC, MagicId )
 import AsmRegAlloc     ( runRegAllocate )
 import OrdList         ( OrdList )
 import PrimOp          ( commutableOp, PrimOp(..) )
-import PrimRep         ( PrimRep{-instance Eq-} )
 import RegAllocInfo    ( mkMRegsState, MRegsState )
-import Stix            ( StixTree(..), StixReg(..), CodeSegment )
-import UniqSupply      ( returnUs, thenUs, mapUs, SYN_IE(UniqSM) )
-import Unpretty                ( uppPutStr, uppShow, uppAboves, SYN_IE(Unpretty) )
+import Stix            ( StixTree(..), StixReg(..) )
+import UniqSupply      ( returnUs, thenUs, mapUs, initUs, UniqSM, UniqSupply )
+import Outputable      
 \end{code}
 
 The 96/03 native-code generator has machine-independent and
@@ -59,7 +57,7 @@ The machine-dependent bits break down as follows:
     machine instructions.
 
 \item[@PprMach@:] @pprInstr@ turns an @Instr@ into text (well, really
-    an @Unpretty@).
+    an @Doc@).
 
 \item[@RegAllocInfo@:] In the register allocator, we manipulate
     @MRegsState@s, which are @BitSet@s, one bit per machine register.
@@ -75,13 +73,12 @@ The machine-dependent bits break down as follows:
 So, here we go:
 \begin{code}
 writeRealAsm :: Handle -> AbstractC -> UniqSupply -> IO ()
-
 writeRealAsm handle absC us
-  = _scc_ "writeRealAsm" (uppPutStr handle 80 (runNCG absC us))
-
-dumpRealAsm :: AbstractC -> UniqSupply -> String
+  = -- _scc_ "writeRealAsm" 
+    printForAsm handle (initUs us (runNCG absC))
 
-dumpRealAsm absC us = uppShow 80 (runNCG absC us)
+dumpRealAsm :: AbstractC -> UniqSupply -> SDoc
+dumpRealAsm absC us = initUs us (runNCG absC)
 
 runNCG absC
   = genCodeAbstractC absC      `thenUs` \ treelists ->
@@ -93,14 +90,14 @@ runNCG absC
 
 @codeGen@ is the top-level code-generation function:
 \begin{code}
-codeGen :: [[StixTree]] -> UniqSM Unpretty
+codeGen :: [[StixTree]] -> UniqSM SDoc
 
 codeGen trees
   = mapUs genMachCode trees    `thenUs` \ dynamic_codes ->
     let
        static_instrs = scheduleMachCode dynamic_codes
     in
-    returnUs (uppAboves (map pprInstr static_instrs))
+    returnUs (vcat (map pprInstr static_instrs))
 \end{code}
 
 Top level code generator for a chunk of stix code:
@@ -159,8 +156,8 @@ genericOpt (StJump addr) = StJump (genericOpt addr)
 genericOpt (StCondJump addr test)
   = StCondJump addr (genericOpt test)
 
-genericOpt (StCall fn pk args)
-  = StCall fn pk (map genericOpt args)
+genericOpt (StCall fn cconv pk args)
+  = StCall fn cconv pk (map genericOpt args)
 \end{code}
 
 Fold indices together when the types match:
@@ -227,6 +224,7 @@ primOpt op args@[StInt x, StInt y]
        IntNeOp -> StInt (if x /= y then 1 else 0)
        IntLtOp -> StInt (if x < y  then 1 else 0)
        IntLeOp -> StInt (if x <= y then 1 else 0)
+       -- ToDo: WordQuotOp, WordRemOp.
        _ -> StPrim op args
 \end{code}
 
@@ -249,8 +247,8 @@ primOpt op args@[x, y@(StInt 0)]
        IntMulOp -> y
        AndOp    -> y
        OrOp     -> x
+       XorOp    -> x
        SllOp    -> x
-       SraOp    -> x
        SrlOp    -> x
        ISllOp   -> x
        ISraOp   -> x
@@ -272,10 +270,10 @@ primOpt op args@[x, y@(StInt n)]
   = case op of
        IntMulOp -> case exactLog2 n of
            Nothing -> StPrim op args
-           Just p  -> StPrim SllOp [x, StInt p]
+           Just p  -> StPrim ISllOp [x, StInt p]
        IntQuotOp -> case exactLog2 n of
            Nothing -> StPrim op args
-           Just p  -> StPrim SraOp [x, StInt p]
+           Just p  -> StPrim ISrlOp [x, StInt p]
        _ -> StPrim op args
 \end{code}