[project @ 2001-07-11 10:20:43 by rrt]

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

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index d85bc69..e98648b 100644 (file)
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -6,9 +6,8 @@
 module AsmCodeGen ( nativeCodeGen ) where
 
 #include "HsVersions.h"
-#include "nativeGen/NCG.h"
+#include "NCG.h"
 
-import IO              ( Handle )
 import List            ( intersperse )
 
 import MachMisc
@@ -17,25 +16,24 @@ import MachCode
 import PprMach
 
 import AbsCStixGen     ( genCodeAbstractC )
-import AbsCSyn         ( AbstractC, MagicId )
+import AbsCSyn         ( AbstractC )
 import AbsCUtils       ( mkAbsCStmtList )
 import AsmRegAlloc     ( runRegAllocate )
 import PrimOp          ( commutableOp, PrimOp(..) )
 import RegAllocInfo    ( findReservedRegs )
 import Stix            ( StixTree(..), StixReg(..), 
-                          pprStixTrees, pprStixTree, CodeSegment(..),
+                          pprStixTrees, pprStixTree, 
                           stixCountTempUses, stixSubst,
-                          NatM, initNat, mapNat,
-                          NatM_State, mkNatM_State,
+                          initNat, mapNat,
+                          mkNatM_State,
                           uniqOfNatM_State, deltaOfNatM_State )
-import PrimRep         ( isFloatingRep, PrimRep(..) )
-import UniqSupply      ( returnUs, thenUs, mapUs, initUs, 
-                          initUs_, UniqSM, UniqSupply,
-                         lazyThenUs, lazyMapUs )
+import UniqSupply      ( returnUs, thenUs, initUs, 
+                          UniqSM, UniqSupply,
+                         lazyMapUs )
 import MachMisc                ( IF_ARCH_i386(i386_insert_ffrees,) )
 
-import OrdList         ( fromOL, concatOL )
-import Outputable      
+import OrdList         ( concatOL )
+import Outputable
 
 \end{code}
 
@@ -97,10 +95,10 @@ nativeCodeGen absC us
          insn_sdoc         = my_vcat insn_sdocs
          stix_sdoc         = vcat stix_sdocs
 
-#        if DEBUG
+#        ifdef NCG_DEBUG
          my_trace m x = trace m x
          my_vcat sds = vcat (intersperse (char ' ' 
-                                          $$ ptext SLIT("# ___stg_split_marker")
+                                          $$ ptext SLIT("# ___ncg_debug_marker")
                                           $$ char ' ') 
                                           sds)
 #        else
@@ -114,13 +112,13 @@ nativeCodeGen absC us
 
 absCtoNat :: AbstractC -> UniqSM (SDoc, SDoc)
 absCtoNat absC
-   = genCodeAbstractC absC                `thenUs` \ stixRaw ->
-     genericOpt stixRaw                   `bind`   \ stixOpt ->
-     genMachCode stixOpt                  `thenUs` \ pre_regalloc ->
-     regAlloc pre_regalloc                `bind`   \ almost_final ->
-     x86fp_kludge almost_final            `bind`   \ final_mach_code ->
-     vcat (map pprInstr final_mach_code)  `bind`   \ final_sdoc ->
-     pprStixTrees stixOpt                 `bind`   \ stix_sdoc ->
+   = _scc_ "genCodeAbstractC" genCodeAbstractC absC        `thenUs` \ stixRaw ->
+     _scc_ "genericOpt"       genericOpt stixRaw           `bind`   \ stixOpt ->
+     _scc_ "genMachCode"      genMachCode stixOpt          `thenUs` \ pre_regalloc ->
+     _scc_ "regAlloc"         regAlloc pre_regalloc        `bind`   \ almost_final ->
+     _scc_ "x86fp_kludge"     x86fp_kludge almost_final    `bind`   \ final_mach_code ->
+     _scc_ "vcat"     vcat (map pprInstr final_mach_code)  `bind`   \ final_sdoc ->
+     _scc_ "pprStixTrees"    pprStixTrees stixOpt          `bind`   \ stix_sdoc ->
      returnUs (stix_sdoc, final_sdoc)
      where
         bind f x = x f
@@ -152,12 +150,10 @@ supply breaks abstraction.  Is that bad?
 genMachCode :: [StixTree] -> UniqSM InstrBlock
 
 genMachCode stmts initial_us
-  = let initial_st         = mkNatM_State initial_us 0
-        (blocks, final_st) = initNat initial_st 
-                                     (mapNat stmt2Instrs stmts)
-        instr_list         = concatOL blocks
-        final_us           = uniqOfNatM_State final_st
-        final_delta        = deltaOfNatM_State final_st
+  = let initial_st             = mkNatM_State initial_us 0
+        (instr_list, final_st) = initNat initial_st (stmtsToInstrs stmts)
+        final_us               = uniqOfNatM_State final_st
+        final_delta            = deltaOfNatM_State final_st
     in
         if   final_delta == 0
         then (instr_list, final_us)
@@ -201,7 +197,7 @@ stixPeep ( t1@(StAssign pka (StReg (StixTemp u pk)) rhs)
    | stixCountTempUses u t2 == 1
      && sum (map (stixCountTempUses u) ts) == 0
    = 
-#    ifdef DEBUG
+#    ifdef NCG_DEBUG
      trace ("nativeGen: inlining " ++ showSDoc (pprStixTree rhs))
 #    endif
            (stixPeep (stixSubst u rhs t2 : ts))
@@ -226,7 +222,7 @@ stixConFold (StInd pk addr) = StInd pk (stixConFold addr)
 stixConFold (StAssign pk dst src)
   = StAssign pk (stixConFold dst) (stixConFold src)
 
-stixConFold (StJump addr) = StJump (stixConFold addr)
+stixConFold (StJump dsts addr) = StJump dsts (stixConFold addr)
 
 stixConFold (StCondJump addr test)
   = StCondJump addr (stixConFold test)
@@ -372,4 +368,4 @@ comparison_ops
        FloatGtOp , FloatGeOp , FloatEqOp , FloatNeOp , FloatLtOp , FloatLeOp,
        DoubleGtOp, DoubleGeOp, DoubleEqOp, DoubleNeOp, DoubleLtOp, DoubleLeOp
      ]
-\end{code}
\ No newline at end of file
+\end{code}