import PprMach
import AbsCStixGen ( genCodeAbstractC )
-import AbsCSyn ( AbstractC )
+import AbsCSyn ( AbstractC, MagicId(..) )
import AbsCUtils ( mkAbsCStmtList, magicIdPrimRep )
import AsmRegAlloc ( runRegAllocate )
import MachOp ( MachOp(..), isCommutableMachOp, isComparisonMachOp )
import qualified Pretty
import Outputable
+import FastString
+-- DEBUGGING ONLY
+--import OrdList
\end{code}
The 96/03 native-code generator has machine-independent and
insn_sdoc = my_vcat insn_sdocs
stix_sdoc = vcat stix_sdocs
-# ifdef NCG_DEBUG */
+# ifdef NCG_DEBUG
my_trace m x = trace m x
my_vcat sds = Pretty.vcat (
intersperse (
_scc_ "x86fp_kludge" x86fp_kludge almost_final `bind` \ final_mach_code ->
_scc_ "vcat" Pretty.vcat (map pprInstr final_mach_code) `bind` \ final_sdoc ->
_scc_ "pprStixTrees" pprStixStmts stixOpt `bind` \ stix_sdoc ->
- returnUs (stix_sdoc, final_sdoc)
+ returnUs ({-\_ -> Pretty.vcat (map pprInstr almost_final),-}
+ stix_sdoc, final_sdoc)
where
bind f x = x f
-> 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)
- StAssignMachOp lhss mop args
- -> StAssignMachOp lhss mop (map stixExpr_ConFold args)
StVoidable expr
-> StVoidable (stixExpr_ConFold expr)
StJump dsts addr
-> StJump dsts (stixExpr_ConFold addr)
StCondJump addr test
- -> StCondJump addr (stixExpr_ConFold test)
+ -> let test_opt = stixExpr_ConFold test
+ in
+ if manifestlyZero test_opt
+ then StComment (mkFastString ("deleted: " ++ showSDoc (pprStixStmt stmt)))
+ else StCondJump addr (stixExpr_ConFold test)
StData pk datas
-> StData pk (map stixExpr_ConFold datas)
other
-> other
-
+ where
+ manifestlyZero (StInt 0) = True
+ manifestlyZero other = False
stixExpr_ConFold expr
= case expr of
-> 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}
MO_Nat_Ne -> StInt (if x /= y then 1 else 0)
MO_NatS_Lt -> StInt (if x < y then 1 else 0)
MO_NatS_Le -> StInt (if x <= y then 1 else 0)
+ MO_Nat_Shl | y >= 0 && y < 32 -> do_shl x y
other -> StMachOp mop args
+ where
+ do_shl :: Integer -> Integer -> StixExpr
+ do_shl v 0 = StInt v
+ do_shl v n | n > 0 = do_shl (v*2) (n-1)
\end{code}
When possible, shift the constants to the right-hand side, so that we