X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FAsmCodeGen.lhs;h=b1e0d47865bf4fa60877a3f4616c7b524b11bd06;hb=f6c6fcf8e82a1ac6ca3a9e23cf17e01ced38363d;hp=354b3fcdda938dfc7608e6bc362b54de4f9e57f0;hpb=5aaf7975d944b50433a15c08e5b9626a78a95227;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 354b3fc..b1e0d47 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -8,15 +8,13 @@ module AsmCodeGen ( nativeCodeGen ) where
 #include "HsVersions.h"
 #include "NCG.h"
 
-import List		( intersperse )
-
 import MachMisc
 import MachRegs
 import MachCode
 import PprMach
 
 import AbsCStixGen	( genCodeAbstractC )
-import AbsCSyn		( AbstractC )
+import AbsCSyn		( AbstractC, MagicId(..) )
 import AbsCUtils	( mkAbsCStmtList, magicIdPrimRep )
 import AsmRegAlloc	( runRegAllocate )
 import MachOp		( MachOp(..), isCommutableMachOp, isComparisonMachOp )
@@ -25,7 +23,7 @@ import Stix		( StixReg(..), StixStmt(..), StixExpr(..), StixVReg(..),
                           pprStixStmts, pprStixStmt, 
                           stixStmt_CountTempUses, stixStmt_Subst,
                           liftStrings,
-                          initNat, mapNat,
+                          initNat, 
                           mkNatM_State,
                           uniqOfNatM_State, deltaOfNatM_State )
 import UniqSupply	( returnUs, thenUs, initUs, 
@@ -35,9 +33,12 @@ import MachMisc		( IF_ARCH_i386(i386_insert_ffrees,) )
 
 import qualified Pretty
 import Outputable
+import FastString
 
 -- DEBUGGING ONLY
 --import OrdList
+
+import List		( intersperse )
 \end{code}
 
 The 96/03 native-code generator has machine-independent and
@@ -45,9 +46,9 @@ machine-dependent modules (those \tr{#include}'ing \tr{NCG.h}).
 
 This module (@AsmCodeGen@) is the top-level machine-independent
 module.  It uses @AbsCStixGen.genCodeAbstractC@ to produce @StixTree@s
-(defined in module @Stix@), using support code from @StixInfo@ (info
-tables), @StixPrim@ (primitive operations), @StixMacro@ (Abstract C
-macros), and @StixInteger@ (GMP arbitrary-precision operations).
+(defined in module @Stix@), using support code from @StixPrim@
+(primitive operations), @StixMacro@ (Abstract C macros), and
+@StixInteger@ (GMP arbitrary-precision operations).
 
 Before entering machine-dependent land, we do some machine-independent
 @genericOpt@imisations (defined below) on the @StixTree@s.
@@ -228,13 +229,17 @@ stixStmt_ConFold stmt
            -> StAssignReg pk reg (stixExpr_ConFold src)
         StAssignReg pk reg@(StixMagicId mid) src
            -- Replace register leaves with appropriate StixTrees for 
-           -- the given target.
-           -> case get_MagicId_reg_or_addr mid of
-                 Left  realreg 
-                    -> StAssignReg pk reg (stixExpr_ConFold src)
-                 Right baseRegAddr 
-                    -> stixStmt_ConFold
-                          (StAssignMem pk baseRegAddr src)
+           -- the given target. MagicIds which map to a reg on this arch are left unchanged. 
+           -- Assigning to BaseReg is always illegal, so we check for that.
+           -> case mid of { 
+                 BaseReg -> panic "stixStmt_ConFold: assignment to BaseReg";
+                 other ->
+                 case get_MagicId_reg_or_addr mid of
+                    Left  realreg 
+                       -> StAssignReg pk reg (stixExpr_ConFold src)
+                    Right baseRegAddr 
+                       -> stixStmt_ConFold (StAssignMem pk baseRegAddr src)
+              }
         StAssignMem pk addr src
            -> StAssignMem pk (stixExpr_ConFold addr) (stixExpr_ConFold src)
         StVoidable expr
@@ -245,7 +250,7 @@ stixStmt_ConFold stmt
            -> let test_opt = stixExpr_ConFold test
               in 
               if  manifestlyZero test_opt
-              then StComment (_PK_ ("deleted: " ++ showSDoc (pprStixStmt stmt)))
+              then StComment (mkFastString ("deleted: " ++ showSDoc (pprStixStmt stmt)))
               else StCondJump addr (stixExpr_ConFold test)
         StData pk datas
            -> StData pk (map stixExpr_ConFold datas)
@@ -275,11 +280,16 @@ stixExpr_ConFold expr
            -> stixMachOpFold mop (map stixExpr_ConFold args)
         StReg (StixMagicId mid)
            -- Replace register leaves with appropriate StixTrees for 
-           -- the given target.
+           -- the given target.  MagicIds which map to a reg on this arch are left unchanged. 
+           -- For the rest, BaseReg is taken to mean the address of the reg table 
+           -- in MainCapability, and for all others we generate an indirection to 
+           -- its location in the register table.
            -> case get_MagicId_reg_or_addr mid of
                  Left  realreg -> expr
                  Right baseRegAddr 
-                    -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
+                    -> case mid of 
+                          BaseReg -> stixExpr_ConFold baseRegAddr
+                          other   -> stixExpr_ConFold (StInd (magicIdPrimRep mid) baseRegAddr)
         other
            -> other
 \end{code}