[project @ 2000-01-24 17:24:23 by sewardj]

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

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 7e92c9f..13a59ef 100644 (file)
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -8,6 +8,7 @@ module AsmCodeGen ( nativeCodeGen ) where
 #include "HsVersions.h"
 
 import IO              ( Handle )
+import List            ( intersperse )
 
 import MachMisc
 import MachRegs
@@ -22,7 +23,8 @@ import PrimOp         ( commutableOp, PrimOp(..) )
 import RegAllocInfo    ( mkMRegsState, MRegsState )
 import Stix            ( StixTree(..), StixReg(..), pprStixTrees )
 import PrimRep         ( isFloatingRep )
-import UniqSupply      ( returnUs, thenUs, mapUs, initUs_, UniqSM, UniqSupply )
+import UniqSupply      ( returnUs, thenUs, mapUs, initUs, 
+                          initUs_, UniqSM, UniqSupply )
 import UniqFM          ( UniqFM, emptyUFM, addToUFM, lookupUFM )
 import Outputable      
 
@@ -76,40 +78,32 @@ The machine-dependent bits break down as follows:
 \end{description}
 
 So, here we go:
-\begin{code}
-nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc, SDoc, SDoc)
-nativeCodeGen absC us = initUs_ us (runNCG absC)
 
-runNCG :: AbstractC -> UniqSM (SDoc, SDoc, SDoc, SDoc)
-runNCG absC
-  = genCodeAbstractC absC      `thenUs` \ stixRaw ->
-    let
-       stixOpt   = map (map genericOpt) stixRaw
-#if i386_TARGET_ARCH
-        stixFinal = map floatFix stixOpt
-#else
-        stixFinal = stixOpt
-#endif
-    in
-        codeGen (stixRaw, stixOpt, stixFinal)
+\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]],[[StixTree]],[[StixTree]]) 
-           -> UniqSM (SDoc, SDoc, SDoc, SDoc)
+codeGen :: [[StixTree]] -> UniqSM SDoc
 
-codeGen (stixRaw, stixOpt, stixFinal)
+codeGen stixFinal
   = mapUs genMachCode stixFinal        `thenUs` \ dynamic_codes ->
     let
-       static_instrs = scheduleMachCode dynamic_codes
+       static_instrss = scheduleMachCode dynamic_codes
+        docs           = map (vcat . map pprInstr) static_instrss       
     in
-    returnUs (
-       text "ppr'd stixRaw",
-       text "ppr'd stixOpt",
-       vcat (map pprStixTrees stixFinal),
-       vcat (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:
@@ -127,10 +121,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}
@@ -293,64 +287,3 @@ Anything else is just too hard.
 \begin{code}
 primOpt op args = StPrim op args
 \end{code}
-
------------------------------------------------------------------------------
-Fix up floating point operations for x86.
-
-The problem is that the code generator can't handle the weird register
-naming scheme for floating point registers on the x86, so we have to
-deal with memory-resident floating point values wherever possible.
-
-We therefore can't stand references to floating-point kinded temporary
-variables, and try to translate them into memory addresses wherever
-possible.
-
-\begin{code}
-floatFix :: [StixTree] -> [StixTree]
-floatFix trees = fltFix emptyUFM trees
-
-fltFix         :: UniqFM StixTree      -- mapping tmp vars to memory locations
-       -> [StixTree]
-       -> [StixTree]
-fltFix locs [] = []
-
--- The case we're interested in: loading a temporary from a memory
--- address.  Eliminate the instruction and replace all future references
--- to the temporary with the memory address.
-fltFix locs ((StAssign rep (StReg (StixTemp uq _)) loc) : trees)
-  | isFloatingRep rep  = trace "found one" $ fltFix (addToUFM locs uq loc) trees
-
-fltFix locs ((StAssign rep src dst) : trees)
-  = StAssign rep (fltFix1 locs src) (fltFix1 locs dst) : fltFix locs trees
-  
-fltFix locs (tree : trees)
-  = fltFix1 locs tree : fltFix locs trees
-
-
-fltFix1 :: UniqFM StixTree -> StixTree -> StixTree
-fltFix1 locs r@(StReg (StixTemp uq rep))
-  | isFloatingRep rep = case lookupUFM locs uq of
-                               Nothing -> panic "fltFix1"
-                               Just tree -> trace "substed" $ tree
-
-fltFix1 locs (StIndex rep l r) =
-  StIndex rep (fltFix1 locs l) (fltFix1 locs r)
-
-fltFix1 locs (StInd rep tree) =
-  StInd rep (fltFix1 locs tree)
-
-fltFix1 locs (StAssign rep dst src) = panic "fltFix1: StAssign"
-
-fltFix1 locs (StJump tree) = StJump (fltFix1 locs tree)
-
-fltFix1 locs (StCondJump lbl tree) =
-  StCondJump lbl (fltFix1 locs tree)
-
-fltFix1 locs (StPrim op trees) = 
-  StPrim op (map (fltFix1 locs) trees)
-
-fltFix1 locs (StCall f conv rep trees) =
-  StCall f conv rep (map (fltFix1 locs) trees)
- 
-fltFix1 locs tree = tree
-\end{code}