X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FAsmCodeGen.lhs;h=7da3a0b88421f1a97bb80d7a8d1b201162ea4a51;hb=4c892ba00b965e000246fb1f5954ee73cb1b24c0;hp=3a87fecb4f15104ad167d1bb8da639a8e68b0b63;hpb=1fb1ab5d53a09607e7f6d2450806760688396387;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 3a87fec..7da3a0b 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -1,14 +1,15 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 
 \begin{code}
-#include "HsVersions.h"
+module AsmCodeGen ( nativeCodeGen ) where
 
-module AsmCodeGen ( writeRealAsm, dumpRealAsm ) where
+#include "HsVersions.h"
+#include "nativeGen/NCG.h"
 
-IMP_Ubiq(){-uitous-}
-IMPORT_1_3(IO(Handle))
+import IO		( Handle )
+import List		( intersperse )
 
 import MachMisc
 import MachRegs
@@ -20,11 +21,16 @@ 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(..), pprStixTrees )
+import PrimRep		( isFloatingRep )
+import UniqSupply	( returnUs, thenUs, mapUs, initUs, 
+                          initUs_, UniqSM, UniqSupply )
+import UniqFM		( UniqFM, emptyUFM, addToUFM, lookupUFM )
+import MachMisc		( IF_ARCH_i386(i386_insert_ffrees,) )
+
+import Outputable	
+
 \end{code}
 
 The 96/03 native-code generator has machine-independent and
@@ -59,7 +65,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.
@@ -73,34 +79,36 @@ The machine-dependent bits break down as follows:
 \end{description}
 
 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
-
-dumpRealAsm absC us = uppShow 80 (runNCG absC us)
-
-runNCG absC
-  = genCodeAbstractC absC	`thenUs` \ treelists ->
-    let
-	stix = map (map genericOpt) treelists
-    in
-    codeGen stix
+\begin{code}
+nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc)
+nativeCodeGen absC us
+   = let (stixRaw, us1) = initUs us (genCodeAbstractC absC)
+         stixOpt        = map (map genericOpt) stixRaw
+         insns          = initUs_ us1 (codeGen stixOpt)
+         debug_stix     = vcat (map pprStixTrees stixOpt)
+     in 
+         (debug_stix, insns)
 \end{code}
 
 @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 ->
+codeGen stixFinal
+  = mapUs genMachCode stixFinal	`thenUs` \ dynamic_codes ->
     let
-	static_instrs = scheduleMachCode dynamic_codes
+        fp_kludge :: [Instr] -> [Instr]
+        fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
+
+        static_instrss :: [[Instr]]
+	static_instrss = map fp_kludge (scheduleMachCode dynamic_codes)
+        docs           = map (vcat . map pprInstr) static_instrss       
     in
-    returnUs (uppAboves (map pprInstr static_instrs))
+    returnUs (vcat (intersperse (char ' ' 
+                                 $$ text "# ___stg_split_marker" 
+                                 $$ char ' ') 
+                    docs))
 \end{code}
 
 Top level code generator for a chunk of stix code:
@@ -118,10 +126,10 @@ exposed via the OrdList, but more might occur, so further analysis
 might be needed.
 
 \begin{code}
-scheduleMachCode :: [InstrList] -> [Instr]
+scheduleMachCode :: [InstrList] -> [[Instr]]
 
 scheduleMachCode
-  = concat . map (runRegAllocate freeRegsState reservedRegs)
+  = map (runRegAllocate freeRegsState reservedRegs)
   where
     freeRegsState = mkMRegsState (extractMappedRegNos freeRegs)
 \end{code}
@@ -159,8 +167,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:
@@ -205,7 +213,6 @@ primOpt
 primOpt op arg@[StInt x]
   = case op of
     	IntNegOp -> StInt (-x)
-    	IntAbsOp -> StInt (abs x)
     	_ -> StPrim op arg
 
 primOpt op args@[StInt x, StInt y]
@@ -227,6 +234,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 +257,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 +280,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}